aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Blandy1993-06-22 03:22:40 +0000
committerJim Blandy1993-06-22 03:22:40 +0000
commita92ade89ed525d377e9bf2162e77a0b4bc2d1bef (patch)
treeaf3606f51c0c27a4645eafd176a8a915af38866a
parent354d06443ef97ebf36e64e8ca329d5553aab06a6 (diff)
downloademacs-a92ade89ed525d377e9bf2162e77a0b4bc2d1bef.tar.gz
emacs-a92ade89ed525d377e9bf2162e77a0b4bc2d1bef.zip
* solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed
solar-equinoxes-solstices. (calendar-time-display-form, calendar-latitude, calendar-longitude): Moved from calendar.el. (calendar-time-zone, calendar-standard-time-zone-name, calendar-daylight-time-zone-name, calendar-daylight-savings-starts, calendar-daylight-savings-ends): Take default values from calendar-current-time-zone, instead of being overwritten in open code if they were set to nil. (solar-time-string): Subtract calendar-daylight-time-offset when computing dst-ends. Avoid rounding errors when rounding time to the nearest minute.
-rw-r--r--lisp/calendar/solar.el88
1 files changed, 61 insertions, 27 deletions
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 24681df7b4f..139ec0d16b8 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -27,7 +27,8 @@
27;;; Commentary: 27;;; Commentary:
28 28
29;; This collection of functions implements the features of calendar.el and 29;; This collection of functions implements the features of calendar.el and
30;; diary.el that deal with sunrise/sunset and equinoxes/solstices. 30;; diary.el that deal with times of day, sunrise/sunset, and
31;; eqinoxes/solstices.
31 32
32;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical 33;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical
33;; Almanac Office, United States Naval Observatory, Washington, 1984 and 34;; Almanac Office, United States Naval Observatory, Washington, 1984 and
@@ -56,7 +57,45 @@
56 (require 'lisp-float-type) 57 (require 'lisp-float-type)
57 (error "Solar calculations impossible since floating point is unavailable.")) 58 (error "Solar calculations impossible since floating point is unavailable."))
58 59
59(require 'calendar) 60(require 'cal-dst)
61
62;;;###autoload
63(defvar calendar-time-display-form
64 '(12-hours ":" minutes am-pm
65 (if time-zone " (") time-zone (if time-zone ")"))
66 "*The pseudo-pattern that governs the way a time of day is formatted.
67
68A pseudo-pattern is a list of expressions that can involve the keywords
69`12-hours', `24-hours', and `minutes', all numbers in string form,
70and `am-pm' and `time-zone', both alphabetic strings.
71
72For example, the form
73
74 '(24-hours \":\" minutes
75 (if time-zone \" (\") time-zone (if time-zone \")\"))
76
77would give military-style times like `21:07 (UTC)'.")
78
79;;;###autoload
80(defvar calendar-latitude nil
81 "*Latitude of `calendar-location-name' in degrees, + north, - south.
82For example, 40.7 for New York City.")
83
84;;;###autoload
85(defvar calendar-longitude nil
86 "*Longitude of `calendar-location-name' in degrees, + east, - west.
87For example, -74.0 for New York City.")
88
89;;;###autoload
90(defvar calendar-location-name
91 '(let ((float-output-format "%.1f"))
92 (format "%s%s, %s%s"
93 (abs calendar-latitude)
94 (if (> calendar-latitude 0) "N" "S")
95 (abs calendar-longitude)
96 (if (> calendar-longitude 0) "E" "W")))
97 "*Expression evaluating to name of `calendar-longitude', calendar-latitude'.
98Default value is just the latitude, longitude pair.")
60 99
61(defun solar-setup () 100(defun solar-setup ()
62 "Prompt user for latitude, longitude, and time zone." 101 "Prompt user for latitude, longitude, and time zone."
@@ -237,19 +276,20 @@ savings time according to `calendar-daylight-savings-starts',
237`calendar-daylight-savings-ends', `calendar-daylight-switchover-time', and 276`calendar-daylight-savings-ends', `calendar-daylight-switchover-time', and
238`calendar-daylight-savings-offset'." 277`calendar-daylight-savings-offset'."
239 (let* ((year (extract-calendar-year date)) 278 (let* ((year (extract-calendar-year date))
240 (abs-date-and-time (+ (calendar-absolute-from-gregorian date) 279 (time (round (* 60 time)))
241 (/ time 24.0))) 280 (rounded-abs-date (+ (calendar-absolute-from-gregorian date)
242 (rounded-abs-date (+ abs-date-and-time (/ 1.0 60 24 2)));; half min 281 (/ time 60.0 24.0)))
243 (dst-change-over
244 (/ (eval calendar-daylight-savings-switchover-time) 60.0 24.0))
245 (dst-starts (and calendar-daylight-savings-starts 282 (dst-starts (and calendar-daylight-savings-starts
246 (+ (calendar-absolute-from-gregorian 283 (+ (calendar-absolute-from-gregorian
247 (eval calendar-daylight-savings-starts)) 284 (eval calendar-daylight-savings-starts))
248 dst-change-over))) 285 (/ calendar-daylight-savings-switchover-time
286 60.0 24.0))))
249 (dst-ends (and calendar-daylight-savings-ends 287 (dst-ends (and calendar-daylight-savings-ends
250 (+ (calendar-absolute-from-gregorian 288 (+ (calendar-absolute-from-gregorian
251 (eval calendar-daylight-savings-ends)) 289 (eval calendar-daylight-savings-ends))
252 dst-change-over))) 290 (/ (- calendar-daylight-savings-switchover-time
291 calendar-daylight-time-offset)
292 60.0 24.0))))
253 (dst (and (not (eq style 'standard)) 293 (dst (and (not (eq style 'standard))
254 (or (eq style 'daylight) 294 (or (eq style 'daylight)
255 (and dst-starts dst-ends 295 (and dst-starts dst-ends
@@ -263,20 +303,13 @@ savings time according to `calendar-daylight-savings-starts',
263 (<= dst-starts rounded-abs-date)) 303 (<= dst-starts rounded-abs-date))
264 (and dst-ends (not dst-starts) 304 (and dst-ends (not dst-starts)
265 (< rounded-abs-date dst-ends))))) 305 (< rounded-abs-date dst-ends)))))
266 (time (if dst
267 (+ time (/ (eval calendar-daylight-time-offset) 60.0))
268 time))
269 (time-zone (if dst 306 (time-zone (if dst
270 calendar-daylight-time-zone-name 307 calendar-daylight-time-zone-name
271 calendar-standard-time-zone-name)) 308 calendar-standard-time-zone-name))
272 (24-hours (truncate time)) 309 (time (+ time (if dst calendar-daylight-time-offset 0)))
273 (minutes (round (* 60 (- time 24-hours)))) 310 (24-hours (/ time 60))
274 (24-hours (if (= minutes 60) (1+ 24-hours) 24-hours)) 311 (minutes (format "%02d" (% time 60)))
275 (minutes (if (= minutes 60) 0 minutes)) 312 (12-hours (format "%d" (1+ (% (+ 24-hours 11) 12))))
276 (minutes (format "%02d" minutes))
277 (12-hours (format "%d" (if (> 24-hours 12)
278 (- 24-hours 12)
279 (if (= 24-hours 0) 12 24-hours))))
280 (am-pm (if (>= 24-hours 12) "pm" "am")) 313 (am-pm (if (>= 24-hours 12) "pm" "am"))
281 (24-hours (format "%02d" 24-hours))) 314 (24-hours (format "%02d" 24-hours)))
282 (mapconcat 'eval calendar-time-display-form ""))) 315 (mapconcat 'eval calendar-time-display-form "")))
@@ -335,6 +368,7 @@ Value is only an approximation."
335solstice; K=2, fall equinox; K=3, winter solstice. Accurate to within 368solstice; K=2, fall equinox; K=3, winter solstice. Accurate to within
336several minutes." 369several minutes."
337 (let ((date (list (+ 3 (* k 3)) 21 year)) 370 (let ((date (list (+ 3 (* k 3)) 21 year))
371 app
338 (correction 1000)) 372 (correction 1000))
339 (while (> correction 0.00001) 373 (while (> correction 0.00001)
340 (setq app (solar-mod (solar-apparent-longitude-of-sun date) 360.0)) 374 (setq app (solar-mod (solar-apparent-longitude-of-sun date) 360.0))
@@ -382,10 +416,10 @@ This function is suitable for execution in a .emacs file."
382 (if (> calendar-longitude 0) "E" "W"))))) 416 (if (> calendar-longitude 0) "E" "W")))))
383 (calendar-standard-time-zone-name 417 (calendar-standard-time-zone-name
384 (if (< arg 16) calendar-standard-time-zone-name 418 (if (< arg 16) calendar-standard-time-zone-name
385 (cond ((= calendar-time-zone 0) "UT") 419 (cond ((= calendar-time-zone 0) "UTC")
386 ((< calendar-time-zone 0) 420 ((< calendar-time-zone 0)
387 (format "UT%dmin" calendar-time-zone)) 421 (format "UTC%dmin" calendar-time-zone))
388 (t (format "UT+%dmin" calendar-time-zone))))) 422 (t (format "UTC+%dmin" calendar-time-zone)))))
389 (calendar-daylight-savings-starts 423 (calendar-daylight-savings-starts
390 (if (< arg 16) calendar-daylight-savings-starts)) 424 (if (< arg 16) calendar-daylight-savings-starts))
391 (calendar-daylight-savings-ends 425 (calendar-daylight-savings-ends
@@ -435,16 +469,16 @@ No diary entry if there is no sunset on that date."
435 (if light (format "%s Sabbath candle lighting" 469 (if light (format "%s Sabbath candle lighting"
436 (solar-time-string light date)))))) 470 (solar-time-string light date))))))
437 471
438(defun calendar-holiday-function-solar-equinoxes-solstices () 472(defun solar-equinoxes-solstices ()
439 "Date and time of equinoxes and solstices, if visible in the calendar window. 473 "Date and time of equinoxes and solstices, if visible in the calendar window.
440Requires floating point." 474Requires floating point."
441 (let* ((m displayed-month) 475 (let ((m displayed-month)
442 (y displayed-year)) 476 (y displayed-year))
443 (increment-calendar-month m y (cond ((= 1 (% m 3)) -1) 477 (increment-calendar-month m y (cond ((= 1 (% m 3)) -1)
444 ((= 2 (% m 3)) 1) 478 ((= 2 (% m 3)) 1)
445 (t 0))) 479 (t 0)))
446 (let* ((calendar-standard-time-zone-name 480 (let* ((calendar-standard-time-zone-name
447 (if calendar-time-zone calendar-standard-time-zone-name "UT")) 481 (if calendar-time-zone calendar-standard-time-zone-name "UTC"))
448 (calendar-daylight-savings-starts 482 (calendar-daylight-savings-starts
449 (if calendar-time-zone calendar-daylight-savings-starts)) 483 (if calendar-time-zone calendar-daylight-savings-starts))
450 (calendar-daylight-savings-ends 484 (calendar-daylight-savings-ends