diff options
| author | Jim Blandy | 1993-06-22 03:22:40 +0000 |
|---|---|---|
| committer | Jim Blandy | 1993-06-22 03:22:40 +0000 |
| commit | a92ade89ed525d377e9bf2162e77a0b4bc2d1bef (patch) | |
| tree | af3606f51c0c27a4645eafd176a8a915af38866a | |
| parent | 354d06443ef97ebf36e64e8ca329d5553aab06a6 (diff) | |
| download | emacs-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.el | 88 |
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 | |||
| 68 | A pseudo-pattern is a list of expressions that can involve the keywords | ||
| 69 | `12-hours', `24-hours', and `minutes', all numbers in string form, | ||
| 70 | and `am-pm' and `time-zone', both alphabetic strings. | ||
| 71 | |||
| 72 | For example, the form | ||
| 73 | |||
| 74 | '(24-hours \":\" minutes | ||
| 75 | (if time-zone \" (\") time-zone (if time-zone \")\")) | ||
| 76 | |||
| 77 | would 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. | ||
| 82 | For 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. | ||
| 87 | For 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'. | ||
| 98 | Default 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." | |||
| 335 | solstice; K=2, fall equinox; K=3, winter solstice. Accurate to within | 368 | solstice; K=2, fall equinox; K=3, winter solstice. Accurate to within |
| 336 | several minutes." | 369 | several 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. |
| 440 | Requires floating point." | 474 | Requires 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 |