Commit | Line | Data |
---|---|---|
3afbc435 | 1 | ;;; cal-dst.el --- calendar functions for daylight savings rules |
3e03d7c7 | 2 | |
12154b44 | 3 | ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc. |
3e03d7c7 JB |
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 | ||
59243403 RS |
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation; either version 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
3e03d7c7 | 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
59243403 RS |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 | ;; Boston, MA 02111-1307, USA. | |
3e03d7c7 JB |
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) | |
12154b44 | 41 | (require 'cal-persia) |
3e03d7c7 JB |
42 | |
43 | (defvar calendar-current-time-zone-cache nil | |
44 | "Cache for result of calendar-current-time-zone.") | |
45 | ||
46 | (defvar calendar-system-time-basis | |
47 | (calendar-absolute-from-gregorian '(1 1 1970)) | |
48 | "Absolute date of starting date of system clock.") | |
49 | ||
3e03d7c7 JB |
50 | (defun calendar-absolute-from-time (x utc-diff) |
51 | "Absolute local date of time X; local time is UTC-DIFF seconds from UTC. | |
52 | ||
53 | X is (HIGH . LOW) or (HIGH LOW . IGNORED) where HIGH and LOW are the | |
54 | high and low 16 bits, respectively, of the number of seconds since | |
55 | 1970-01-01 00:00:00 UTC, ignoring leap seconds. | |
56 | ||
57 | Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on | |
58 | absolute date ABS-DATE is the equivalent moment to X." | |
59 | (let* ((h (car x)) | |
60 | (xtail (cdr x)) | |
61 | (l (+ utc-diff (if (numberp xtail) xtail (car xtail)))) | |
4cc1b78a | 62 | (u (+ (* 512 (mod h 675)) (floor l 128)))) |
3e03d7c7 JB |
63 | ;; Overflow is a terrible thing! |
64 | (cons (+ calendar-system-time-basis | |
65 | ;; floor((2^16 h +l) / (60*60*24)) | |
6bc457fe | 66 | (* 512 (floor h 675)) (floor u 675)) |
3ac14ca0 RS |
67 | ;; (2^16 h +l) mod (60*60*24) |
68 | (+ (* (mod u 675) 128) (mod l 128))))) | |
3e03d7c7 JB |
69 | |
70 | (defun calendar-time-from-absolute (abs-date s) | |
71 | "Time of absolute date ABS-DATE, S seconds after midnight. | |
72 | ||
73 | Returns the pair (HIGH . LOW) where HIGH and LOW are the high and low | |
74 | 16 bits, respectively, of the number of seconds 1970-01-01 00:00:00 UTC, | |
75 | ignoring leap seconds, that is the equivalent moment to S seconds after | |
76 | midnight UTC on absolute date ABS-DATE." | |
77 | (let* ((a (- abs-date calendar-system-time-basis)) | |
4cc1b78a | 78 | (u (+ (* 163 (mod a 512)) (floor s 128)))) |
3e03d7c7 JB |
79 | ;; Overflow is a terrible thing! |
80 | (cons | |
3ac14ca0 | 81 | ;; floor((60*60*24*a + s) / 2^16) |
4cc1b78a | 82 | (+ a (* 163 (floor a 512)) (floor u 512)) |
3ac14ca0 | 83 | ;; (60*60*24*a + s) mod 2^16 |
4cc1b78a | 84 | (+ (* 128 (mod u 512)) (mod s 128))))) |
3e03d7c7 JB |
85 | |
86 | (defun calendar-next-time-zone-transition (time) | |
87 | "Return the time of the next time zone transition after TIME. | |
88 | Both TIME and the result are acceptable arguments to current-time-zone. | |
89 | Return nil if no such transition can be found." | |
90 | (let* ((base 65536);; 2^16 = base of current-time output | |
91 | (quarter-multiple 120);; approx = (seconds per quarter year) / base | |
92 | (time-zone (current-time-zone time)) | |
93 | (time-utc-diff (car time-zone)) | |
94 | hi | |
95 | hi-zone | |
96 | (hi-utc-diff time-utc-diff) | |
97 | (quarters '(2 1 3))) | |
98 | ;; Heuristic: probe the time zone offset in the next three calendar | |
99 | ;; quarters, looking for a time zone offset different from TIME. | |
100 | (while (and quarters (eq time-utc-diff hi-utc-diff)) | |
101 | (setq hi (cons (+ (car time) (* (car quarters) quarter-multiple)) 0)) | |
102 | (setq hi-zone (current-time-zone hi)) | |
103 | (setq hi-utc-diff (car hi-zone)) | |
104 | (setq quarters (cdr quarters))) | |
105 | (and | |
106 | time-utc-diff | |
107 | hi-utc-diff | |
108 | (not (eq time-utc-diff hi-utc-diff)) | |
109 | ;; Now HI is after the next time zone transition. | |
110 | ;; Set LO to TIME, and then binary search to increase LO and decrease HI | |
111 | ;; until LO is just before and HI is just after the time zone transition. | |
112 | (let* ((tail (cdr time)) | |
113 | (lo (cons (car time) (if (numberp tail) tail (car tail)))) | |
114 | probe) | |
115 | (while | |
116 | ;; Set PROBE to halfway between LO and HI, rounding down. | |
117 | ;; If PROBE equals LO, we are done. | |
118 | (let* ((lsum (+ (cdr lo) (cdr hi))) | |
119 | (hsum (+ (car lo) (car hi) (/ lsum base))) | |
120 | (hsumodd (logand 1 hsum))) | |
121 | (setq probe (cons (/ (- hsum hsumodd) 2) | |
122 | (/ (+ (* hsumodd base) (% lsum base)) 2))) | |
123 | (not (equal lo probe))) | |
124 | ;; Set either LO or HI to PROBE, depending on probe results. | |
125 | (if (eq (car (current-time-zone probe)) hi-utc-diff) | |
126 | (setq hi probe) | |
127 | (setq lo probe))) | |
128 | hi)))) | |
129 | ||
130 | (defun calendar-time-zone-daylight-rules (abs-date utc-diff) | |
131 | "Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from UTC. | |
12154b44 | 132 | ABS-DATE must specify a day that contains a daylight savings transition. |
3e03d7c7 JB |
133 | The result has the proper form for calendar-daylight-savings-starts'." |
134 | (let* ((date (calendar-gregorian-from-absolute abs-date)) | |
135 | (weekday (% abs-date 7)) | |
136 | (m (extract-calendar-month date)) | |
137 | (d (extract-calendar-day date)) | |
138 | (y (extract-calendar-year date)) | |
139 | (last (calendar-last-day-of-month m y)) | |
140 | (candidate-rules | |
141 | (append | |
142 | ;; Day D of month M. | |
143 | (list (list 'list m d 'year)) | |
144 | ;; The first WEEKDAY of month M. | |
145 | (if (< d 8) | |
146 | (list (list 'calendar-nth-named-day 1 weekday m 'year))) | |
147 | ;; The last WEEKDAY of month M. | |
148 | (if (> d (- last 7)) | |
149 | (list (list 'calendar-nth-named-day -1 weekday m 'year))) | |
150 | ;; The first WEEKDAY after day J of month M, for D-6 < J <= D. | |
151 | (let (l) | |
152 | (calendar-for-loop j from (max 2 (- d 6)) to (min d (- last 8)) do | |
153 | (setq l | |
154 | (cons | |
155 | (list 'calendar-nth-named-day 1 weekday m 'year j) | |
156 | l))) | |
12154b44 PE |
157 | l) |
158 | ;; 01-01 and 07-01 for this year's Persian calendar. | |
159 | (if (and (= m 3) (<= 20 d) (<= d 21)) | |
160 | '((calendar-gregorian-from-absolute | |
161 | (calendar-absolute-from-persian | |
162 | (list 1 1 (- year 621)))))) | |
163 | (if (and (= m 9) (<= 22 d) (<= d 23)) | |
164 | '((calendar-gregorian-from-absolute | |
165 | (calendar-absolute-from-persian | |
166 | (list 7 1 (- year 621)))))))) | |
3e03d7c7 | 167 | (prevday-sec (- -1 utc-diff)) ;; last sec of previous local day |
6bc457fe PE |
168 | (year (1+ y))) |
169 | ;; Scan through the next few years until only one rule remains. | |
170 | (while | |
171 | (let ((rules candidate-rules) | |
172 | new-rules) | |
173 | (while | |
174 | (let* | |
175 | ((rule (car rules)) | |
176 | (date | |
177 | ;; The following is much faster than | |
178 | ;; (calendar-absolute-from-gregorian (eval rule)). | |
179 | (cond ((eq (car rule) 'calendar-nth-named-day) | |
180 | (eval (cons 'calendar-nth-named-absday (cdr rule)))) | |
181 | ((eq (car rule) 'calendar-gregorian-from-absolute) | |
182 | (eval (car (cdr rule)))) | |
183 | (t (let ((g (eval rule))) | |
184 | (calendar-absolute-from-gregorian g)))))) | |
185 | (or (equal | |
186 | (current-time-zone | |
187 | (calendar-time-from-absolute date prevday-sec)) | |
188 | (current-time-zone | |
189 | (calendar-time-from-absolute (1+ date) prevday-sec))) | |
190 | (setq new-rules (cons rule new-rules))) | |
191 | (setq rules (cdr rules)))) | |
192 | ;; If no rules remain, just use the first candidate rule; | |
193 | ;; it's wrong in general, but it's right for at least one year. | |
194 | (setq candidate-rules (if new-rules (nreverse new-rules) | |
195 | (list (car candidate-rules)))) | |
196 | (setq year (1+ year)) | |
197 | (cdr candidate-rules))) | |
198 | (car candidate-rules))) | |
3e03d7c7 JB |
199 | |
200 | (defun calendar-current-time-zone () | |
201 | "Return UTC difference, dst offset, names and rules for current time zone. | |
202 | ||
6bc457fe PE |
203 | Returns (UTC-DIFF DST-OFFSET STD-ZONE DST-ZONE DST-STARTS DST-ENDS |
204 | DST-STARTS-TIME DST-ENDS-TIME), based on a heuristic probing of what the | |
205 | system knows: | |
3e03d7c7 JB |
206 | |
207 | UTC-DIFF is an integer specifying the number of minutes difference between | |
208 | standard time in the current time zone and Coordinated Universal Time | |
209 | (Greenwich Mean Time). A negative value means west of Greenwich. | |
210 | DST-OFFSET is an integer giving the daylight savings time offset in minutes. | |
211 | STD-ZONE is a string giving the name of the time zone when no seasonal time | |
212 | adjustment is in effect. | |
213 | DST-ZONE is a string giving the name of the time zone when there is a seasonal | |
214 | time adjustment in effect. | |
215 | DST-STARTS and DST-ENDS are sexps in the variable `year' giving the daylight | |
6bc457fe | 216 | savings time start and end rules, in the form expected by |
3e03d7c7 | 217 | `calendar-daylight-savings-starts'. |
6bc457fe PE |
218 | DST-STARTS-TIME and DST-ENDS-TIME are integers giving the number of minutes |
219 | after midnight that daylight savings time starts and ends. | |
3e03d7c7 | 220 | |
6bc457fe PE |
221 | If the local area does not use a seasonal time adjustment, STD-ZONE and |
222 | DST-ZONE are equal, and all the DST-* integer variables are 0. | |
3e03d7c7 JB |
223 | |
224 | Some operating systems cannot provide all this information to Emacs; in this | |
225 | case, `calendar-current-time-zone' returns a list containing nil for the data | |
226 | it can't find." | |
227 | (or | |
228 | calendar-current-time-zone-cache | |
6bc457fe PE |
229 | (setq |
230 | calendar-current-time-zone-cache | |
231 | (let* ((t0 (current-time)) | |
232 | (t0-zone (current-time-zone t0)) | |
233 | (t0-utc-diff (car t0-zone)) | |
234 | (t0-name (car (cdr t0-zone)))) | |
235 | (if (not t0-utc-diff) | |
236 | ;; Little or no time zone information is available. | |
237 | (list nil nil t0-name t0-name nil nil nil nil) | |
238 | (let* ((t1 (calendar-next-time-zone-transition t0)) | |
239 | (t2 (and t1 (calendar-next-time-zone-transition t1)))) | |
240 | (if (not t2) | |
241 | ;; This locale does not have daylight savings time. | |
242 | (list (/ t0-utc-diff 60) 0 t0-name t0-name nil nil 0 0) | |
243 | ;; Use heuristics to find daylight savings parameters. | |
244 | (let* ((t1-zone (current-time-zone t1)) | |
245 | (t1-utc-diff (car t1-zone)) | |
246 | (t1-name (car (cdr t1-zone))) | |
247 | (t1-date-sec (calendar-absolute-from-time t1 t0-utc-diff)) | |
248 | (t2-date-sec (calendar-absolute-from-time t2 t1-utc-diff)) | |
249 | (t1-rules (calendar-time-zone-daylight-rules | |
250 | (car t1-date-sec) t0-utc-diff)) | |
251 | (t2-rules (calendar-time-zone-daylight-rules | |
252 | (car t2-date-sec) t1-utc-diff)) | |
253 | (t1-time (/ (cdr t1-date-sec) 60)) | |
254 | (t2-time (/ (cdr t2-date-sec) 60))) | |
255 | (cons | |
256 | (/ (min t0-utc-diff t1-utc-diff) 60) | |
257 | (cons | |
258 | (/ (abs (- t0-utc-diff t1-utc-diff)) 60) | |
259 | (if (< t0-utc-diff t1-utc-diff) | |
38c8f5d3 RS |
260 | (list t0-name t1-name t1-rules t2-rules t1-time t2-time) |
261 | (list t1-name t0-name t2-rules t1-rules t2-time t1-time) | |
6bc457fe | 262 | ))))))))))) |
3e03d7c7 | 263 | |
ec230951 | 264 | ;;; The following eight defvars relating to daylight savings time should NOT be |
3e03d7c7 JB |
265 | ;;; marked to go into loaddefs.el where they would be evaluated when Emacs is |
266 | ;;; dumped. These variables' appropriate values depend on the conditions under | |
267 | ;;; which the code is INVOKED; so it's inappropriate to initialize them when | |
268 | ;;; Emacs is dumped---they should be initialized when calendar.el is loaded. | |
6bc457fe | 269 | ;;; They default to US Eastern time if time zone info is not available. |
3e03d7c7 JB |
270 | |
271 | (calendar-current-time-zone) | |
272 | ||
6bc457fe | 273 | (defvar calendar-time-zone (or (car calendar-current-time-zone-cache) -300) |
3e03d7c7 JB |
274 | "*Number of minutes difference between local standard time at |
275 | `calendar-location-name' and Coordinated Universal (Greenwich) Time. For | |
276 | example, -300 for New York City, -480 for Los Angeles.") | |
277 | ||
278 | (defvar calendar-daylight-time-offset | |
6bc457fe | 279 | (or (car (cdr calendar-current-time-zone-cache)) 60) |
3e03d7c7 JB |
280 | "*Number of minutes difference between daylight savings and standard time. |
281 | ||
282 | If the locale never uses daylight savings time, set this to 0.") | |
283 | ||
284 | (defvar calendar-standard-time-zone-name | |
6bc457fe | 285 | (or (car (nthcdr 2 calendar-current-time-zone-cache)) "EST") |
3e03d7c7 JB |
286 | "*Abbreviated name of standard time zone at `calendar-location-name'. |
287 | For example, \"EST\" in New York City, \"PST\" for Los Angeles.") | |
288 | ||
289 | (defvar calendar-daylight-time-zone-name | |
6bc457fe | 290 | (or (car (nthcdr 3 calendar-current-time-zone-cache)) "EDT") |
3e03d7c7 JB |
291 | "*Abbreviated name of daylight-savings time zone at `calendar-location-name'. |
292 | For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.") | |
293 | ||
cd2d091a RS |
294 | ;;;###autoload |
295 | (put 'calendar-daylight-savings-starts 'risky-local-variable t) | |
3e03d7c7 | 296 | (defvar calendar-daylight-savings-starts |
6bc457fe PE |
297 | (or (car (nthcdr 4 calendar-current-time-zone-cache)) |
298 | (and (not (zerop calendar-daylight-time-offset)) | |
299 | '(calendar-nth-named-day 1 0 4 year))) | |
3e03d7c7 JB |
300 | "*Sexp giving the date on which daylight savings time starts. |
301 | This is an expression in the variable `year' whose value gives the Gregorian | |
302 | date in the form (month day year) on which daylight savings time starts. It is | |
303 | used to determine the starting date of daylight savings time for the holiday | |
304 | list and for correcting times of day in the solar and lunar calculations. | |
305 | ||
306 | For example, if daylight savings time is mandated to start on October 1, | |
307 | you would set `calendar-daylight-savings-starts' to | |
308 | ||
309 | '(10 1 year) | |
310 | ||
d6fc04a8 | 311 | If it starts on the first Sunday in April, you would set it to |
3e03d7c7 | 312 | |
d6fc04a8 | 313 | '(calendar-nth-named-day 1 0 4 year) |
3e03d7c7 JB |
314 | |
315 | If the locale never uses daylight savings time, set this to nil.") | |
316 | ||
cd2d091a | 317 | ;;;###autoload |
1e608384 | 318 | (put 'calendar-daylight-savings-ends 'risky-local-variable t) |
3e03d7c7 | 319 | (defvar calendar-daylight-savings-ends |
6bc457fe PE |
320 | (or (car (nthcdr 5 calendar-current-time-zone-cache)) |
321 | (and (not (zerop calendar-daylight-time-offset)) | |
322 | '(calendar-nth-named-day -1 0 10 year))) | |
3e03d7c7 JB |
323 | "*Sexp giving the date on which daylight savings time ends. |
324 | This is an expression in the variable `year' whose value gives the Gregorian | |
325 | date in the form (month day year) on which daylight savings time ends. It is | |
326 | used to determine the starting date of daylight savings time for the holiday | |
327 | list and for correcting times of day in the solar and lunar calculations. | |
328 | ||
d6fc04a8 | 329 | For example, if daylight savings time ends on the last Sunday in October: |
3e03d7c7 | 330 | |
d6fc04a8 | 331 | '(calendar-nth-named-day -1 0 10 year) |
3e03d7c7 JB |
332 | |
333 | If the locale never uses daylight savings time, set this to nil.") | |
334 | ||
6bc457fe PE |
335 | (defvar calendar-daylight-savings-starts-time |
336 | (or (car (nthcdr 6 calendar-current-time-zone-cache)) 120) | |
337 | "*Number of minutes after midnight that daylight savings time starts.") | |
338 | ||
339 | (defvar calendar-daylight-savings-ends-time | |
340 | (or (car (nthcdr 7 calendar-current-time-zone-cache)) | |
341 | calendar-daylight-savings-starts-time) | |
342 | "*Number of minutes after midnight that daylight savings time ends.") | |
3e03d7c7 | 343 | |
ec230951 ER |
344 | (defun dst-in-effect (date) |
345 | "True if on absolute DATE daylight savings time is in effect. | |
021edd45 | 346 | Fractional part of DATE is local standard time of day." |
ec230951 ER |
347 | (let* ((year (extract-calendar-year |
348 | (calendar-gregorian-from-absolute (floor date)))) | |
021edd45 ER |
349 | (dst-starts-gregorian (eval calendar-daylight-savings-starts)) |
350 | (dst-ends-gregorian (eval calendar-daylight-savings-ends)) | |
351 | (dst-starts (and dst-starts-gregorian | |
ec230951 | 352 | (+ (calendar-absolute-from-gregorian |
021edd45 | 353 | dst-starts-gregorian) |
ec230951 ER |
354 | (/ calendar-daylight-savings-starts-time |
355 | 60.0 24.0)))) | |
021edd45 | 356 | (dst-ends (and dst-ends-gregorian |
ec230951 | 357 | (+ (calendar-absolute-from-gregorian |
021edd45 | 358 | dst-ends-gregorian) |
ec230951 ER |
359 | (/ (- calendar-daylight-savings-ends-time |
360 | calendar-daylight-time-offset) | |
361 | 60.0 24.0))))) | |
021edd45 ER |
362 | (and dst-starts dst-ends |
363 | (if (< dst-starts dst-ends) | |
364 | (and (<= dst-starts date) (< date dst-ends)) | |
365 | (or (<= dst-starts date) (< date dst-ends)))))) | |
ec230951 ER |
366 | |
367 | (defun dst-adjust-time (date time &optional style) | |
368 | "Adjust, to account for dst on DATE, decimal fraction standard TIME. | |
369 | Returns a list (date adj-time zone) where `date' and `adj-time' are the values | |
370 | adjusted for `zone'; here `date' is a list (month day year), `adj-time' is a | |
371 | decimal fraction time, and `zone' is a string. | |
372 | ||
373 | Optional parameter STYLE forces the result time to be standard time when its | |
374 | value is 'standard and daylight savings time (if available) when its value is | |
375 | 'daylight. | |
376 | ||
377 | Conversion to daylight savings time is done according to | |
378 | `calendar-daylight-savings-starts', `calendar-daylight-savings-ends', | |
379 | `calendar-daylight-savings-starts-time', | |
380 | `calendar-daylight-savings-ends-time', and | |
381 | `calendar-daylight-savings-offset'." | |
382 | ||
383 | (let* ((rounded-abs-date (+ (calendar-absolute-from-gregorian date) | |
384 | (/ (round (* 60 time)) 60.0 24.0))) | |
385 | (dst (dst-in-effect rounded-abs-date)) | |
386 | (time-zone (if dst | |
387 | calendar-daylight-time-zone-name | |
388 | calendar-standard-time-zone-name)) | |
389 | (time (+ rounded-abs-date | |
390 | (if dst (/ calendar-daylight-time-offset 24.0 60.0) 0)))) | |
391 | (list (calendar-gregorian-from-absolute (truncate time)) | |
392 | (* 24.0 (- time (truncate time))) | |
393 | time-zone))) | |
394 | ||
3e03d7c7 JB |
395 | (provide 'cal-dst) |
396 | ||
397 | ;;; cal-dst.el ends here |