# HG changeset patch # User Jim Blandy # Date 740719513 0 # Node ID 923a207e7967045491c6424fd4020bffd0224436 # Parent a9f9a058567fd36ca6c0c7bc384096d3732ceaec * cal-dst.el: New file. (calendar-/, calendar-%, calendar-absolute-from-time, calendar-time-from-absolute, calendar-next-time-zone-transition, calendar-time-zone-daylight-rules): New functions. (calendar-current-time-zone): Moved from calendar.el and rewritten. (calendar-current-time-zone-cache): New variable. (calendar-current-time-zone, calendar-time-zone, calendar-daylight-time-offset, calendar-standard-time-zone-name, calendar-daylight-time-zone-name, calendar-daylight-savings-starts, calendar-daylight-savings-ends, calendar-daylight-savings-switchover-time): Moved from calendar.el. diff -r a9f9a058567f -r 923a207e7967 lisp/calendar/cal-dst.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/calendar/cal-dst.el Tue Jun 22 03:25:13 1993 +0000 @@ -0,0 +1,352 @@ +;;; cal-dst.el --- calendar functions for daylight savings rules. + +;; Copyright (C) 1993 Free Software Foundation, Inc. + +;; Author: Paul Eggert +;; Edward M. Reingold +;; Keywords: calendar +;; Human-Keywords: daylight savings time, calendar, diary, holidays + +;; This file is part of GNU Emacs. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; GNU Emacs, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + +;;; Commentary: + +;; This collection of functions implements the features of calendar.el and +;; holiday.el that deal with daylight savings time. + +;; Comments, corrections, and improvements should be sent to +;; Edward M. Reingold Department of Computer Science +;; (217) 333-6733 University of Illinois at Urbana-Champaign +;; reingold@cs.uiuc.edu 1304 West Springfield Avenue +;; Urbana, Illinois 61801 + +;;; Code: + +(require 'calendar) + +(defvar calendar-current-time-zone-cache nil + "Cache for result of calendar-current-time-zone.") + +(defvar calendar-system-time-basis + (calendar-absolute-from-gregorian '(1 1 1970)) + "Absolute date of starting date of system clock.") + +(defun calendar-/ (a b) + "Floor(A/B) = the greatest integer not greater than A divided by B. +A and B be must both be integers, and B must be positive." + (if (< a 0) + (- (/ (- b 1 a) b)) + (/ a b))) + +(defun calendar-% (a b) + "A modulo B; always nonnegative. +A and B be must both be integers, and B must be positive." + (let ((m (% a b))) + (if (< m 0) + (+ m b) + m))) + +(defun calendar-absolute-from-time (x utc-diff) + "Absolute local date of time X; local time is UTC-DIFF seconds from UTC. + +X is (HIGH . LOW) or (HIGH LOW . IGNORED) where HIGH and LOW are the +high and low 16 bits, respectively, of the number of seconds since +1970-01-01 00:00:00 UTC, ignoring leap seconds. + +Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on +absolute date ABS-DATE is the equivalent moment to X." + (let* ((h (car x)) + (xtail (cdr x)) + (l (+ utc-diff (if (numberp xtail) xtail (car xtail)))) + (u (+ (* 512 (calendar-% h 675)) (calendar-/ l 128)))) + ;; Overflow is a terrible thing! + (cons (+ calendar-system-time-basis + ;; floor((2^16 h +l) / (60*60*24)) + (* 512 (calendar-/ h 675)) (calendar-/ u 675)) + ;; (2^16 h +l) % (60*60*24) + (+ (* (calendar-% u 675) 128) (calendar-% l 128))))) + +(defun calendar-time-from-absolute (abs-date s) + "Time of absolute date ABS-DATE, S seconds after midnight. + +Returns the pair (HIGH . LOW) where HIGH and LOW are the high and low +16 bits, respectively, of the number of seconds 1970-01-01 00:00:00 UTC, +ignoring leap seconds, that is the equivalent moment to S seconds after +midnight UTC on absolute date ABS-DATE." + (let* ((a (- abs-date calendar-system-time-basis)) + (u (+ (* 163 (calendar-% a 512)) (calendar-/ s 128)))) + ;; Overflow is a terrible thing! + (cons + ;; (60*60*24*a + s) / 2^16 + (+ a (* 163 (calendar-/ a 512)) (calendar-/ u 512)) + ;; (60*60*24*a + s) % 2^16 + (+ (* 128 (calendar-% u 512)) (calendar-% s 128))))) + +(defun calendar-next-time-zone-transition (time) + "Return the time of the next time zone transition after TIME. +Both TIME and the result are acceptable arguments to current-time-zone. +Return nil if no such transition can be found." + (let* ((base 65536);; 2^16 = base of current-time output + (quarter-multiple 120);; approx = (seconds per quarter year) / base + (time-zone (current-time-zone time)) + (time-utc-diff (car time-zone)) + hi + hi-zone + (hi-utc-diff time-utc-diff) + (quarters '(2 1 3))) + ;; Heuristic: probe the time zone offset in the next three calendar + ;; quarters, looking for a time zone offset different from TIME. + (while (and quarters (eq time-utc-diff hi-utc-diff)) + (setq hi (cons (+ (car time) (* (car quarters) quarter-multiple)) 0)) + (setq hi-zone (current-time-zone hi)) + (setq hi-utc-diff (car hi-zone)) + (setq quarters (cdr quarters))) + (and + time-utc-diff + hi-utc-diff + (not (eq time-utc-diff hi-utc-diff)) + ;; Now HI is after the next time zone transition. + ;; Set LO to TIME, and then binary search to increase LO and decrease HI + ;; until LO is just before and HI is just after the time zone transition. + (let* ((tail (cdr time)) + (lo (cons (car time) (if (numberp tail) tail (car tail)))) + probe) + (while + ;; Set PROBE to halfway between LO and HI, rounding down. + ;; If PROBE equals LO, we are done. + (let* ((lsum (+ (cdr lo) (cdr hi))) + (hsum (+ (car lo) (car hi) (/ lsum base))) + (hsumodd (logand 1 hsum))) + (setq probe (cons (/ (- hsum hsumodd) 2) + (/ (+ (* hsumodd base) (% lsum base)) 2))) + (not (equal lo probe))) + ;; Set either LO or HI to PROBE, depending on probe results. + (if (eq (car (current-time-zone probe)) hi-utc-diff) + (setq hi probe) + (setq lo probe))) + hi)))) + +(defun calendar-time-zone-daylight-rules (abs-date utc-diff) + "Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from UTC. +ABS-DIFF must specify a day that contains a daylight savings transition. +The result has the proper form for calendar-daylight-savings-starts'." + (let* ((date (calendar-gregorian-from-absolute abs-date)) + (weekday (% abs-date 7)) + (m (extract-calendar-month date)) + (d (extract-calendar-day date)) + (y (extract-calendar-year date)) + (last (calendar-last-day-of-month m y)) + (candidate-rules + (append + ;; Day D of month M. + (list (list 'list m d 'year)) + ;; The first WEEKDAY of month M. + (if (< d 8) + (list (list 'calendar-nth-named-day 1 weekday m 'year))) + ;; The last WEEKDAY of month M. + (if (> d (- last 7)) + (list (list 'calendar-nth-named-day -1 weekday m 'year))) + ;; The first WEEKDAY after day J of month M, for D-6 < J <= D. + (let (l) + (calendar-for-loop j from (max 2 (- d 6)) to (min d (- last 8)) do + (setq l + (cons + (list 'calendar-nth-named-day 1 weekday m 'year j) + l))) + l) + ;; Israel is special. + (if (zerop weekday) + (if (< m 7) + (list + '(calendar-gregorian-from-absolute + (calendar-dayname-on-or-before + 0 + (calendar-absolute-from-hebrew + (list 1 28 (+ year 3760)))))) + (list '(calendar-gregorian-from-absolute + (calendar-dayname-on-or-before + 0 + (- (calendar-absolute-from-hebrew + (list 7 1 (+ year 3761))) 3)))))))) + (prevday-sec (- -1 utc-diff)) ;; last sec of previous local day + last-surviving-rule + (i 1)) + ;; Scan through the next few years; take the rule that explains them best. + (while (and candidate-rules (cdr candidate-rules) (<= i 28)) + (let ((year (+ y i)) + new-rules) + (while candidate-rules + (let* ((rule (car candidate-rules)) + (date (calendar-absolute-from-gregorian (eval rule)))) + (or (equal (current-time-zone + (calendar-time-from-absolute date prevday-sec)) + (current-time-zone + (calendar-time-from-absolute (1+ date) prevday-sec))) + (progn + (setq new-rules (cons rule new-rules)) + (setq last-surviving-rule rule)))) + (setq candidate-rules (cdr candidate-rules))) + (setq candidate-rules (nreverse new-rules))) + (setq i (1+ i))) + last-surviving-rule)) + +(defun calendar-current-time-zone () + "Return UTC difference, dst offset, names and rules for current time zone. + +Returns (UTC-DIFF DST-OFFSET STD-ZONE DST-ZONE DST-STARTS DST-ENDS DST-SWITCH), +based on a heuristic probing of what the system knows: + +UTC-DIFF is an integer specifying the number of minutes difference between + standard time in the current time zone and Coordinated Universal Time + (Greenwich Mean Time). A negative value means west of Greenwich. +DST-OFFSET is an integer giving the daylight savings time offset in minutes. +STD-ZONE is a string giving the name of the time zone when no seasonal time + adjustment is in effect. +DST-ZONE is a string giving the name of the time zone when there is a seasonal + time adjustment in effect. +DST-STARTS and DST-ENDS are sexps in the variable `year' giving the daylight + savings time start rules, in the form expected by + `calendar-daylight-savings-starts'. +DST-SWITCH is an integer giving the number of minutes after midnight that + daylight savings time starts or ends. + +If the local area does not use a seasonal time adjustment, DST-OFFSET and +DST-SWITCH are 0, STD-ZONE and DST-ZONE are equal, and DST-STARTS and DST-ENDS +are nil. + +Some operating systems cannot provide all this information to Emacs; in this +case, `calendar-current-time-zone' returns a list containing nil for the data +it can't find." + (or + calendar-current-time-zone-cache + (progn + (message "Checking time zone data...") + (setq + calendar-current-time-zone-cache + (let* ((now (current-time)) + (now-zone (current-time-zone now)) + (now-utc-diff (car now-zone)) + (now-name (car (cdr now-zone))) + (next (calendar-next-time-zone-transition now))) + (if (null next) + (list (and now-utc-diff (/ now-utc-diff 60)) + 0 now-name now-name nil nil 0) + (let* ((next-zone (current-time-zone next)) + (next-utc-diff (car next-zone)) + (next-name (car (cdr next-zone))) + (next-absdate-seconds + (calendar-absolute-from-time next now-utc-diff)) + (next-transitions + (calendar-time-zone-daylight-rules + (car next-absdate-seconds) now-utc-diff)) + (nextnext (calendar-next-time-zone-transition next)) + (now-transitions + (calendar-time-zone-daylight-rules + (car (calendar-absolute-from-time nextnext next-utc-diff)) + next-utc-diff)) + (now-is-std (< now-utc-diff next-utc-diff))) + (list (/ (min now-utc-diff next-utc-diff) 60) + (/ (abs (- now-utc-diff next-utc-diff)) 60) + (if now-is-std now-name next-name) + (if now-is-std next-name now-name) + (if now-is-std next-transitions now-transitions) + (if now-is-std now-transitions next-transitions) + (/ (cdr next-absdate-seconds) 60)))))) + (message "Checking time zone data...done"))) + calendar-current-time-zone-cache) + +;;; The following six defvars relating to daylight savings time should NOT be +;;; marked to go into loaddefs.el where they would be evaluated when Emacs is +;;; dumped. These variables' appropriate values depend on the conditions under +;;; which the code is INVOKED; so it's inappropriate to initialize them when +;;; Emacs is dumped---they should be initialized when calendar.el is loaded. + +(calendar-current-time-zone) + +(defvar calendar-time-zone (car calendar-current-time-zone-cache) + "*Number of minutes difference between local standard time at +`calendar-location-name' and Coordinated Universal (Greenwich) Time. For +example, -300 for New York City, -480 for Los Angeles.") + +(defvar calendar-daylight-time-offset + (car (cdr calendar-current-time-zone-cache)) + "*Number of minutes difference between daylight savings and standard time. + +If the locale never uses daylight savings time, set this to 0.") + +(defvar calendar-standard-time-zone-name + (car (nthcdr 2 calendar-current-time-zone-cache)) + "*Abbreviated name of standard time zone at `calendar-location-name'. +For example, \"EST\" in New York City, \"PST\" for Los Angeles.") + +(defvar calendar-daylight-time-zone-name + (car (nthcdr 3 calendar-current-time-zone-cache)) + "*Abbreviated name of daylight-savings time zone at `calendar-location-name'. +For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.") + +(defvar calendar-daylight-savings-starts + (car (nthcdr 4 calendar-current-time-zone-cache)) + "*Sexp giving the date on which daylight savings time starts. +This is an expression in the variable `year' whose value gives the Gregorian +date in the form (month day year) on which daylight savings time starts. It is +used to determine the starting date of daylight savings time for the holiday +list and for correcting times of day in the solar and lunar calculations. + +For example, if daylight savings time is mandated to start on October 1, +you would set `calendar-daylight-savings-starts' to + + '(10 1 year) + +For a more complex example, daylight savings time begins in Israel on the +first Sunday after Passover ends on Nisan 21: + + '(calendar-gregorian-from-absolute + (calendar-dayname-on-or-before + 0 + (calendar-absolute-from-hebrew (list 1 28 (+ year 3760))))) + +because Nisan is the first month in the Hebrew calendar. + +If the locale never uses daylight savings time, set this to nil.") + +(defvar calendar-daylight-savings-ends + (car (nthcdr 5 calendar-current-time-zone-cache)) + "*Sexp giving the date on which daylight savings time ends. +This is an expression in the variable `year' whose value gives the Gregorian +date in the form (month day year) on which daylight savings time ends. It is +used to determine the starting date of daylight savings time for the holiday +list and for correcting times of day in the solar and lunar calculations. + +For example, daylight savings time ends in Israel on the Sunday Selichot +begins: + + '(calendar-gregorian-from-absolute + (calendar-dayname-on-or-before + 0 + (- (calendar-absolute-from-hebrew (list 7 1 (+ year 3761))) 3))) + +If the locale never uses daylight savings time, set this to nil.") + +(defvar calendar-daylight-savings-switchover-time + (car (nthcdr 6 calendar-current-time-zone-cache)) + "*Number of minutes after midnight that daylight savings time begins/ends. +If the locale never uses daylight savings time, set this to 0.") + +(provide 'cal-dst) + +;;; cal-dst.el ends here