3872
|
1 ;;; cal-dst.el --- calendar functions for daylight savings rules.
|
|
2
|
|
3 ;; Copyright (C) 1993 Free Software Foundation, Inc.
|
|
4
|
|
5 ;; Author: Paul Eggert <eggert@twinsun.com>
|
|
6 ;; Edward M. Reingold <reingold@cs.uiuc.edu>
|
|
7 ;; Keywords: calendar
|
|
8 ;; Human-Keywords: daylight savings time, calendar, diary, holidays
|
|
9
|
|
10 ;; This file is part of GNU Emacs.
|
|
11
|
|
12 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
13 ;; but WITHOUT ANY WARRANTY. No author or distributor
|
|
14 ;; accepts responsibility to anyone for the consequences of using it
|
|
15 ;; or for whether it serves any particular purpose or works at all,
|
|
16 ;; unless he says so in writing. Refer to the GNU Emacs General Public
|
|
17 ;; License for full details.
|
|
18
|
|
19 ;; Everyone is granted permission to copy, modify and redistribute
|
|
20 ;; GNU Emacs, but only under the conditions described in the
|
|
21 ;; GNU Emacs General Public License. A copy of this license is
|
|
22 ;; supposed to have been given to you along with GNU Emacs so you
|
|
23 ;; can know your rights and responsibilities. It should be in a
|
|
24 ;; file named COPYING. Among other things, the copyright notice
|
|
25 ;; and this notice must be preserved on all copies.
|
|
26
|
|
27 ;;; Commentary:
|
|
28
|
|
29 ;; This collection of functions implements the features of calendar.el and
|
|
30 ;; holiday.el that deal with daylight savings time.
|
|
31
|
|
32 ;; Comments, corrections, and improvements should be sent to
|
|
33 ;; Edward M. Reingold Department of Computer Science
|
|
34 ;; (217) 333-6733 University of Illinois at Urbana-Champaign
|
|
35 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
|
|
36 ;; Urbana, Illinois 61801
|
|
37
|
|
38 ;;; Code:
|
|
39
|
|
40 (require 'calendar)
|
|
41
|
|
42 (defvar calendar-current-time-zone-cache nil
|
|
43 "Cache for result of calendar-current-time-zone.")
|
|
44
|
|
45 (defvar calendar-system-time-basis
|
|
46 (calendar-absolute-from-gregorian '(1 1 1970))
|
|
47 "Absolute date of starting date of system clock.")
|
|
48
|
|
49 (defun calendar-absolute-from-time (x utc-diff)
|
|
50 "Absolute local date of time X; local time is UTC-DIFF seconds from UTC.
|
|
51
|
|
52 X is (HIGH . LOW) or (HIGH LOW . IGNORED) where HIGH and LOW are the
|
|
53 high and low 16 bits, respectively, of the number of seconds since
|
|
54 1970-01-01 00:00:00 UTC, ignoring leap seconds.
|
|
55
|
|
56 Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on
|
|
57 absolute date ABS-DATE is the equivalent moment to X."
|
|
58 (let* ((h (car x))
|
|
59 (xtail (cdr x))
|
|
60 (l (+ utc-diff (if (numberp xtail) xtail (car xtail))))
|
4535
|
61 (u (+ (* 512 (mod h 675)) (floor l 128))))
|
3872
|
62 ;; Overflow is a terrible thing!
|
|
63 (cons (+ calendar-system-time-basis
|
|
64 ;; floor((2^16 h +l) / (60*60*24))
|
4535
|
65 (* 512 (mod h 675)) (floor u 675))
|
3872
|
66 ;; (2^16 h +l) % (60*60*24)
|
4535
|
67 (+ (* (mod u 675) 128) (floor l 128)))))
|
3872
|
68
|
|
69 (defun calendar-time-from-absolute (abs-date s)
|
|
70 "Time of absolute date ABS-DATE, S seconds after midnight.
|
|
71
|
|
72 Returns the pair (HIGH . LOW) where HIGH and LOW are the high and low
|
|
73 16 bits, respectively, of the number of seconds 1970-01-01 00:00:00 UTC,
|
|
74 ignoring leap seconds, that is the equivalent moment to S seconds after
|
|
75 midnight UTC on absolute date ABS-DATE."
|
|
76 (let* ((a (- abs-date calendar-system-time-basis))
|
4535
|
77 (u (+ (* 163 (mod a 512)) (floor s 128))))
|
3872
|
78 ;; Overflow is a terrible thing!
|
|
79 (cons
|
|
80 ;; (60*60*24*a + s) / 2^16
|
4535
|
81 (+ a (* 163 (floor a 512)) (floor u 512))
|
3872
|
82 ;; (60*60*24*a + s) % 2^16
|
4535
|
83 (+ (* 128 (mod u 512)) (mod s 128)))))
|
3872
|
84
|
|
85 (defun calendar-next-time-zone-transition (time)
|
|
86 "Return the time of the next time zone transition after TIME.
|
|
87 Both TIME and the result are acceptable arguments to current-time-zone.
|
|
88 Return nil if no such transition can be found."
|
|
89 (let* ((base 65536);; 2^16 = base of current-time output
|
|
90 (quarter-multiple 120);; approx = (seconds per quarter year) / base
|
|
91 (time-zone (current-time-zone time))
|
|
92 (time-utc-diff (car time-zone))
|
|
93 hi
|
|
94 hi-zone
|
|
95 (hi-utc-diff time-utc-diff)
|
|
96 (quarters '(2 1 3)))
|
|
97 ;; Heuristic: probe the time zone offset in the next three calendar
|
|
98 ;; quarters, looking for a time zone offset different from TIME.
|
|
99 (while (and quarters (eq time-utc-diff hi-utc-diff))
|
|
100 (setq hi (cons (+ (car time) (* (car quarters) quarter-multiple)) 0))
|
|
101 (setq hi-zone (current-time-zone hi))
|
|
102 (setq hi-utc-diff (car hi-zone))
|
|
103 (setq quarters (cdr quarters)))
|
|
104 (and
|
|
105 time-utc-diff
|
|
106 hi-utc-diff
|
|
107 (not (eq time-utc-diff hi-utc-diff))
|
|
108 ;; Now HI is after the next time zone transition.
|
|
109 ;; Set LO to TIME, and then binary search to increase LO and decrease HI
|
|
110 ;; until LO is just before and HI is just after the time zone transition.
|
|
111 (let* ((tail (cdr time))
|
|
112 (lo (cons (car time) (if (numberp tail) tail (car tail))))
|
|
113 probe)
|
|
114 (while
|
|
115 ;; Set PROBE to halfway between LO and HI, rounding down.
|
|
116 ;; If PROBE equals LO, we are done.
|
|
117 (let* ((lsum (+ (cdr lo) (cdr hi)))
|
|
118 (hsum (+ (car lo) (car hi) (/ lsum base)))
|
|
119 (hsumodd (logand 1 hsum)))
|
|
120 (setq probe (cons (/ (- hsum hsumodd) 2)
|
|
121 (/ (+ (* hsumodd base) (% lsum base)) 2)))
|
|
122 (not (equal lo probe)))
|
|
123 ;; Set either LO or HI to PROBE, depending on probe results.
|
|
124 (if (eq (car (current-time-zone probe)) hi-utc-diff)
|
|
125 (setq hi probe)
|
|
126 (setq lo probe)))
|
|
127 hi))))
|
|
128
|
|
129 (defun calendar-time-zone-daylight-rules (abs-date utc-diff)
|
|
130 "Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from UTC.
|
|
131 ABS-DIFF must specify a day that contains a daylight savings transition.
|
|
132 The result has the proper form for calendar-daylight-savings-starts'."
|
|
133 (let* ((date (calendar-gregorian-from-absolute abs-date))
|
|
134 (weekday (% abs-date 7))
|
|
135 (m (extract-calendar-month date))
|
|
136 (d (extract-calendar-day date))
|
|
137 (y (extract-calendar-year date))
|
|
138 (last (calendar-last-day-of-month m y))
|
|
139 (candidate-rules
|
|
140 (append
|
|
141 ;; Day D of month M.
|
|
142 (list (list 'list m d 'year))
|
|
143 ;; The first WEEKDAY of month M.
|
|
144 (if (< d 8)
|
|
145 (list (list 'calendar-nth-named-day 1 weekday m 'year)))
|
|
146 ;; The last WEEKDAY of month M.
|
|
147 (if (> d (- last 7))
|
|
148 (list (list 'calendar-nth-named-day -1 weekday m 'year)))
|
|
149 ;; The first WEEKDAY after day J of month M, for D-6 < J <= D.
|
|
150 (let (l)
|
|
151 (calendar-for-loop j from (max 2 (- d 6)) to (min d (- last 8)) do
|
|
152 (setq l
|
|
153 (cons
|
|
154 (list 'calendar-nth-named-day 1 weekday m 'year j)
|
|
155 l)))
|
|
156 l)
|
|
157 ;; Israel is special.
|
|
158 (if (zerop weekday)
|
|
159 (if (< m 7)
|
|
160 (list
|
|
161 '(calendar-gregorian-from-absolute
|
|
162 (calendar-dayname-on-or-before
|
|
163 0
|
|
164 (calendar-absolute-from-hebrew
|
|
165 (list 1 28 (+ year 3760))))))
|
|
166 (list '(calendar-gregorian-from-absolute
|
|
167 (calendar-dayname-on-or-before
|
|
168 0
|
|
169 (- (calendar-absolute-from-hebrew
|
|
170 (list 7 1 (+ year 3761))) 3))))))))
|
|
171 (prevday-sec (- -1 utc-diff)) ;; last sec of previous local day
|
|
172 last-surviving-rule
|
|
173 (i 1))
|
|
174 ;; Scan through the next few years; take the rule that explains them best.
|
|
175 (while (and candidate-rules (cdr candidate-rules) (<= i 28))
|
|
176 (let ((year (+ y i))
|
|
177 new-rules)
|
|
178 (while candidate-rules
|
|
179 (let* ((rule (car candidate-rules))
|
|
180 (date (calendar-absolute-from-gregorian (eval rule))))
|
|
181 (or (equal (current-time-zone
|
|
182 (calendar-time-from-absolute date prevday-sec))
|
|
183 (current-time-zone
|
|
184 (calendar-time-from-absolute (1+ date) prevday-sec)))
|
|
185 (progn
|
|
186 (setq new-rules (cons rule new-rules))
|
|
187 (setq last-surviving-rule rule))))
|
|
188 (setq candidate-rules (cdr candidate-rules)))
|
|
189 (setq candidate-rules (nreverse new-rules)))
|
|
190 (setq i (1+ i)))
|
|
191 last-surviving-rule))
|
|
192
|
|
193 (defun calendar-current-time-zone ()
|
|
194 "Return UTC difference, dst offset, names and rules for current time zone.
|
|
195
|
|
196 Returns (UTC-DIFF DST-OFFSET STD-ZONE DST-ZONE DST-STARTS DST-ENDS DST-SWITCH),
|
|
197 based on a heuristic probing of what the system knows:
|
|
198
|
|
199 UTC-DIFF is an integer specifying the number of minutes difference between
|
|
200 standard time in the current time zone and Coordinated Universal Time
|
|
201 (Greenwich Mean Time). A negative value means west of Greenwich.
|
|
202 DST-OFFSET is an integer giving the daylight savings time offset in minutes.
|
|
203 STD-ZONE is a string giving the name of the time zone when no seasonal time
|
|
204 adjustment is in effect.
|
|
205 DST-ZONE is a string giving the name of the time zone when there is a seasonal
|
|
206 time adjustment in effect.
|
|
207 DST-STARTS and DST-ENDS are sexps in the variable `year' giving the daylight
|
|
208 savings time start rules, in the form expected by
|
|
209 `calendar-daylight-savings-starts'.
|
|
210 DST-SWITCH is an integer giving the number of minutes after midnight that
|
|
211 daylight savings time starts or ends.
|
|
212
|
|
213 If the local area does not use a seasonal time adjustment, DST-OFFSET and
|
|
214 DST-SWITCH are 0, STD-ZONE and DST-ZONE are equal, and DST-STARTS and DST-ENDS
|
|
215 are nil.
|
|
216
|
|
217 Some operating systems cannot provide all this information to Emacs; in this
|
|
218 case, `calendar-current-time-zone' returns a list containing nil for the data
|
|
219 it can't find."
|
|
220 (or
|
|
221 calendar-current-time-zone-cache
|
|
222 (progn
|
|
223 (message "Checking time zone data...")
|
|
224 (setq
|
|
225 calendar-current-time-zone-cache
|
|
226 (let* ((now (current-time))
|
|
227 (now-zone (current-time-zone now))
|
|
228 (now-utc-diff (car now-zone))
|
|
229 (now-name (car (cdr now-zone)))
|
|
230 (next (calendar-next-time-zone-transition now)))
|
|
231 (if (null next)
|
|
232 (list (and now-utc-diff (/ now-utc-diff 60))
|
|
233 0 now-name now-name nil nil 0)
|
|
234 (let* ((next-zone (current-time-zone next))
|
|
235 (next-utc-diff (car next-zone))
|
|
236 (next-name (car (cdr next-zone)))
|
|
237 (next-absdate-seconds
|
|
238 (calendar-absolute-from-time next now-utc-diff))
|
|
239 (next-transitions
|
|
240 (calendar-time-zone-daylight-rules
|
|
241 (car next-absdate-seconds) now-utc-diff))
|
|
242 (nextnext (calendar-next-time-zone-transition next))
|
|
243 (now-transitions
|
|
244 (calendar-time-zone-daylight-rules
|
|
245 (car (calendar-absolute-from-time nextnext next-utc-diff))
|
|
246 next-utc-diff))
|
|
247 (now-is-std (< now-utc-diff next-utc-diff)))
|
|
248 (list (/ (min now-utc-diff next-utc-diff) 60)
|
|
249 (/ (abs (- now-utc-diff next-utc-diff)) 60)
|
|
250 (if now-is-std now-name next-name)
|
|
251 (if now-is-std next-name now-name)
|
|
252 (if now-is-std next-transitions now-transitions)
|
|
253 (if now-is-std now-transitions next-transitions)
|
|
254 (/ (cdr next-absdate-seconds) 60))))))
|
|
255 (message "Checking time zone data...done")))
|
|
256 calendar-current-time-zone-cache)
|
|
257
|
|
258 ;;; The following six defvars relating to daylight savings time should NOT be
|
|
259 ;;; marked to go into loaddefs.el where they would be evaluated when Emacs is
|
|
260 ;;; dumped. These variables' appropriate values depend on the conditions under
|
|
261 ;;; which the code is INVOKED; so it's inappropriate to initialize them when
|
|
262 ;;; Emacs is dumped---they should be initialized when calendar.el is loaded.
|
|
263
|
|
264 (calendar-current-time-zone)
|
|
265
|
|
266 (defvar calendar-time-zone (car calendar-current-time-zone-cache)
|
|
267 "*Number of minutes difference between local standard time at
|
|
268 `calendar-location-name' and Coordinated Universal (Greenwich) Time. For
|
|
269 example, -300 for New York City, -480 for Los Angeles.")
|
|
270
|
|
271 (defvar calendar-daylight-time-offset
|
|
272 (car (cdr calendar-current-time-zone-cache))
|
|
273 "*Number of minutes difference between daylight savings and standard time.
|
|
274
|
|
275 If the locale never uses daylight savings time, set this to 0.")
|
|
276
|
|
277 (defvar calendar-standard-time-zone-name
|
|
278 (car (nthcdr 2 calendar-current-time-zone-cache))
|
|
279 "*Abbreviated name of standard time zone at `calendar-location-name'.
|
|
280 For example, \"EST\" in New York City, \"PST\" for Los Angeles.")
|
|
281
|
|
282 (defvar calendar-daylight-time-zone-name
|
|
283 (car (nthcdr 3 calendar-current-time-zone-cache))
|
|
284 "*Abbreviated name of daylight-savings time zone at `calendar-location-name'.
|
|
285 For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.")
|
|
286
|
|
287 (defvar calendar-daylight-savings-starts
|
|
288 (car (nthcdr 4 calendar-current-time-zone-cache))
|
|
289 "*Sexp giving the date on which daylight savings time starts.
|
|
290 This is an expression in the variable `year' whose value gives the Gregorian
|
|
291 date in the form (month day year) on which daylight savings time starts. It is
|
|
292 used to determine the starting date of daylight savings time for the holiday
|
|
293 list and for correcting times of day in the solar and lunar calculations.
|
|
294
|
|
295 For example, if daylight savings time is mandated to start on October 1,
|
|
296 you would set `calendar-daylight-savings-starts' to
|
|
297
|
|
298 '(10 1 year)
|
|
299
|
|
300 For a more complex example, daylight savings time begins in Israel on the
|
|
301 first Sunday after Passover ends on Nisan 21:
|
|
302
|
|
303 '(calendar-gregorian-from-absolute
|
|
304 (calendar-dayname-on-or-before
|
|
305 0
|
|
306 (calendar-absolute-from-hebrew (list 1 28 (+ year 3760)))))
|
|
307
|
|
308 because Nisan is the first month in the Hebrew calendar.
|
|
309
|
|
310 If the locale never uses daylight savings time, set this to nil.")
|
|
311
|
|
312 (defvar calendar-daylight-savings-ends
|
|
313 (car (nthcdr 5 calendar-current-time-zone-cache))
|
|
314 "*Sexp giving the date on which daylight savings time ends.
|
|
315 This is an expression in the variable `year' whose value gives the Gregorian
|
|
316 date in the form (month day year) on which daylight savings time ends. It is
|
|
317 used to determine the starting date of daylight savings time for the holiday
|
|
318 list and for correcting times of day in the solar and lunar calculations.
|
|
319
|
|
320 For example, daylight savings time ends in Israel on the Sunday Selichot
|
|
321 begins:
|
|
322
|
|
323 '(calendar-gregorian-from-absolute
|
|
324 (calendar-dayname-on-or-before
|
|
325 0
|
|
326 (- (calendar-absolute-from-hebrew (list 7 1 (+ year 3761))) 3)))
|
|
327
|
|
328 If the locale never uses daylight savings time, set this to nil.")
|
|
329
|
|
330 (defvar calendar-daylight-savings-switchover-time
|
|
331 (car (nthcdr 6 calendar-current-time-zone-cache))
|
|
332 "*Number of minutes after midnight that daylight savings time begins/ends.
|
|
333 If the locale never uses daylight savings time, set this to 0.")
|
|
334
|
|
335 (provide 'cal-dst)
|
|
336
|
|
337 ;;; cal-dst.el ends here
|