Commit | Line | Data |
---|---|---|
e716fd62 | 1 | ;;; cal-dst.el --- calendar functions for daylight saving rules |
3e03d7c7 | 2 | |
a20b3848 | 3 | ;; Copyright (C) 1993, 1994, 1995, 1996, 2001, 2002, 2003, 2004, 2005, |
8b72699e | 4 | ;; 2006, 2007, 2008 Free Software Foundation, Inc. |
3e03d7c7 JB |
5 | |
6 | ;; Author: Paul Eggert <eggert@twinsun.com> | |
71ea27ee | 7 | ;; Edward M. Reingold <reingold@cs.uiuc.edu> |
dbfca9c4 | 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
3e03d7c7 | 9 | ;; Keywords: calendar |
e716fd62 | 10 | ;; Human-Keywords: daylight saving time, calendar, diary, holidays |
3e03d7c7 JB |
11 | |
12 | ;; This file is part of GNU Emacs. | |
13 | ||
59243403 RS |
14 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
15 | ;; it under the terms of the GNU General Public License as published by | |
075969b4 | 16 | ;; the Free Software Foundation; either version 3, or (at your option) |
59243403 RS |
17 | ;; any later version. |
18 | ||
3e03d7c7 | 19 | ;; GNU Emacs is distributed in the hope that it will be useful, |
59243403 RS |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
23 | ||
24 | ;; You should have received a copy of the GNU General Public License | |
b578f267 | 25 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
3a35cf56 LK |
26 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
27 | ;; Boston, MA 02110-1301, USA. | |
3e03d7c7 JB |
28 | |
29 | ;;; Commentary: | |
30 | ||
b1c57079 | 31 | ;; See calendar.el. |
3e03d7c7 | 32 | |
3e03d7c7 JB |
33 | ;;; Code: |
34 | ||
35 | (require 'calendar) | |
36 | ||
ec1ee609 GM |
37 | |
38 | (defgroup calendar-dst nil | |
39 | "Options related to Daylight Saving Time." | |
40 | :prefix "calendar-" | |
41 | :group 'calendar) | |
42 | ||
43 | ||
cd72c399 GM |
44 | (defcustom calendar-dst-check-each-year-flag t |
45 | "Non-nil means to check each year for DST transitions as needed. | |
f3f4e600 | 46 | Otherwise assume the next two transitions found after the |
cd72c399 | 47 | current date apply to all years. This is faster, but not always |
e716fd62 | 48 | correct, since the dates of daylight saving transitions sometimes |
cd72c399 GM |
49 | change." |
50 | :type 'boolean | |
51 | :version "22.1" | |
76db8823 | 52 | :group 'calendar-dst) |
cd72c399 | 53 | |
ec1ee609 GM |
54 | ;;;###autoload |
55 | (put 'calendar-daylight-savings-starts 'risky-local-variable t) | |
56 | (defcustom calendar-daylight-savings-starts '(calendar-dst-starts year) | |
57 | "Sexp giving the date on which daylight saving time starts. | |
58 | This is an expression in the variable `year' whose value gives the Gregorian | |
59 | date in the form (month day year) on which daylight saving time starts. It is | |
60 | used to determine the starting date of daylight saving time for the holiday | |
61 | list and for correcting times of day in the solar and lunar calculations. | |
62 | ||
63 | For example, if daylight saving time is mandated to start on October 1, | |
64 | you would set `calendar-daylight-savings-starts' to | |
65 | ||
66 | '(10 1 year) | |
67 | ||
68 | If it starts on the first Sunday in April, you would set it to | |
69 | ||
70 | '(calendar-nth-named-day 1 0 4 year) | |
71 | ||
72 | If the locale never uses daylight saving time, set this to nil." | |
73 | :type 'sexp | |
74 | :group 'calendar-dst) | |
75 | ||
76 | ;;;###autoload | |
77 | (put 'calendar-daylight-savings-ends 'risky-local-variable t) | |
78 | (defcustom calendar-daylight-savings-ends '(calendar-dst-ends year) | |
79 | "Sexp giving the date on which daylight saving time ends. | |
80 | This is an expression in the variable `year' whose value gives the Gregorian | |
81 | date in the form (month day year) on which daylight saving time ends. It is | |
82 | used to determine the starting date of daylight saving time for the holiday | |
83 | list and for correcting times of day in the solar and lunar calculations. | |
84 | ||
85 | For example, if daylight saving time ends on the last Sunday in October: | |
86 | ||
87 | '(calendar-nth-named-day -1 0 10 year) | |
88 | ||
89 | If the locale never uses daylight saving time, set this to nil." | |
90 | :type 'sexp | |
91 | :group 'calendar-dst) | |
92 | ||
93 | ;;; More defcustoms below. | |
94 | ||
95 | ||
3e03d7c7 | 96 | (defvar calendar-current-time-zone-cache nil |
ed589f9a | 97 | "Cache for result of `calendar-current-time-zone'.") |
76db8823 GM |
98 | ;; It gets eval'd, eg by calendar-dst-starts. |
99 | ;;;###autoload | |
100 | (put 'calendar-current-time-zone-cache 'risky-local-variable t) | |
3e03d7c7 JB |
101 | |
102 | (defvar calendar-system-time-basis | |
103 | (calendar-absolute-from-gregorian '(1 1 1970)) | |
104 | "Absolute date of starting date of system clock.") | |
105 | ||
3e03d7c7 JB |
106 | (defun calendar-absolute-from-time (x utc-diff) |
107 | "Absolute local date of time X; local time is UTC-DIFF seconds from UTC. | |
108 | ||
109 | X is (HIGH . LOW) or (HIGH LOW . IGNORED) where HIGH and LOW are the | |
110 | high and low 16 bits, respectively, of the number of seconds since | |
111 | 1970-01-01 00:00:00 UTC, ignoring leap seconds. | |
112 | ||
113 | Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on | |
114 | absolute date ABS-DATE is the equivalent moment to X." | |
115 | (let* ((h (car x)) | |
71ea27ee | 116 | (xtail (cdr x)) |
3e03d7c7 | 117 | (l (+ utc-diff (if (numberp xtail) xtail (car xtail)))) |
4cc1b78a | 118 | (u (+ (* 512 (mod h 675)) (floor l 128)))) |
3e03d7c7 JB |
119 | ;; Overflow is a terrible thing! |
120 | (cons (+ calendar-system-time-basis | |
71ea27ee GM |
121 | ;; floor((2^16 h +l) / (60*60*24)) |
122 | (* 512 (floor h 675)) (floor u 675)) | |
123 | ;; (2^16 h +l) mod (60*60*24) | |
124 | (+ (* (mod u 675) 128) (mod l 128))))) | |
3e03d7c7 JB |
125 | |
126 | (defun calendar-time-from-absolute (abs-date s) | |
127 | "Time of absolute date ABS-DATE, S seconds after midnight. | |
128 | ||
ec9b5635 | 129 | Returns the list (HIGH LOW) where HIGH and LOW are the high and low |
3e03d7c7 JB |
130 | 16 bits, respectively, of the number of seconds 1970-01-01 00:00:00 UTC, |
131 | ignoring leap seconds, that is the equivalent moment to S seconds after | |
132 | midnight UTC on absolute date ABS-DATE." | |
133 | (let* ((a (- abs-date calendar-system-time-basis)) | |
4cc1b78a | 134 | (u (+ (* 163 (mod a 512)) (floor s 128)))) |
3e03d7c7 | 135 | ;; Overflow is a terrible thing! |
ec9b5635 | 136 | (list |
3ac14ca0 | 137 | ;; floor((60*60*24*a + s) / 2^16) |
4cc1b78a | 138 | (+ a (* 163 (floor a 512)) (floor u 512)) |
3ac14ca0 | 139 | ;; (60*60*24*a + s) mod 2^16 |
4cc1b78a | 140 | (+ (* 128 (mod u 512)) (mod s 128))))) |
3e03d7c7 JB |
141 | |
142 | (defun calendar-next-time-zone-transition (time) | |
143 | "Return the time of the next time zone transition after TIME. | |
311cc551 | 144 | Both TIME and the result are acceptable arguments to `current-time-zone'. |
3e03d7c7 | 145 | Return nil if no such transition can be found." |
fd32e5b9 GM |
146 | (let* ((base 65536) ; 2^16 = base of current-time output |
147 | (quarter-multiple 120) ; approx = (seconds per quarter year) / base | |
71ea27ee GM |
148 | (time-zone (current-time-zone time)) |
149 | (time-utc-diff (car time-zone)) | |
3e03d7c7 | 150 | hi |
71ea27ee | 151 | hi-zone |
3e03d7c7 JB |
152 | (hi-utc-diff time-utc-diff) |
153 | (quarters '(2 1 3))) | |
154 | ;; Heuristic: probe the time zone offset in the next three calendar | |
155 | ;; quarters, looking for a time zone offset different from TIME. | |
156 | (while (and quarters (eq time-utc-diff hi-utc-diff)) | |
4b8683c7 GM |
157 | (setq hi (cons (+ (car time) (* (car quarters) quarter-multiple)) 0) |
158 | hi-zone (current-time-zone hi) | |
159 | hi-utc-diff (car hi-zone) | |
160 | quarters (cdr quarters))) | |
3e03d7c7 JB |
161 | (and |
162 | time-utc-diff | |
163 | hi-utc-diff | |
164 | (not (eq time-utc-diff hi-utc-diff)) | |
165 | ;; Now HI is after the next time zone transition. | |
166 | ;; Set LO to TIME, and then binary search to increase LO and decrease HI | |
167 | ;; until LO is just before and HI is just after the time zone transition. | |
168 | (let* ((tail (cdr time)) | |
71ea27ee GM |
169 | (lo (cons (car time) (if (numberp tail) tail (car tail)))) |
170 | probe) | |
3e03d7c7 | 171 | (while |
71ea27ee GM |
172 | ;; Set PROBE to halfway between LO and HI, rounding down. |
173 | ;; If PROBE equals LO, we are done. | |
174 | (let* ((lsum (+ (cdr lo) (cdr hi))) | |
175 | (hsum (+ (car lo) (car hi) (/ lsum base))) | |
176 | (hsumodd (logand 1 hsum))) | |
177 | (setq probe (cons (/ (- hsum hsumodd) 2) | |
178 | (/ (+ (* hsumodd base) (% lsum base)) 2))) | |
179 | (not (equal lo probe))) | |
180 | ;; Set either LO or HI to PROBE, depending on probe results. | |
181 | (if (eq (car (current-time-zone probe)) hi-utc-diff) | |
182 | (setq hi probe) | |
183 | (setq lo probe))) | |
3e03d7c7 JB |
184 | hi)))) |
185 | ||
d80c2c18 | 186 | (autoload 'calendar-persian-to-absolute "cal-persia") |
06e3b7ae | 187 | |
3e03d7c7 JB |
188 | (defun calendar-time-zone-daylight-rules (abs-date utc-diff) |
189 | "Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from UTC. | |
e716fd62 CY |
190 | ABS-DATE must specify a day that contains a daylight saving transition. |
191 | The result has the proper form for `calendar-daylight-savings-starts'." | |
3e03d7c7 | 192 | (let* ((date (calendar-gregorian-from-absolute abs-date)) |
71ea27ee | 193 | (weekday (% abs-date 7)) |
e803eab7 GM |
194 | (m (calendar-extract-month date)) |
195 | (d (calendar-extract-day date)) | |
196 | (y (calendar-extract-year date)) | |
3e03d7c7 | 197 | (last (calendar-last-day-of-month m y)) |
ff35f3b8 GM |
198 | j rlist |
199 | (candidate-rules ; these return Gregorian dates | |
71ea27ee GM |
200 | (append |
201 | ;; Day D of month M. | |
ff35f3b8 | 202 | `((list ,m ,d year)) |
71ea27ee | 203 | ;; The first WEEKDAY of month M. |
3e03d7c7 | 204 | (if (< d 8) |
ff35f3b8 | 205 | `((calendar-nth-named-day 1 ,weekday ,m year))) |
71ea27ee | 206 | ;; The last WEEKDAY of month M. |
3e03d7c7 | 207 | (if (> d (- last 7)) |
ff35f3b8 GM |
208 | `((calendar-nth-named-day -1 ,weekday ,m year))) |
209 | (progn | |
210 | ;; The first WEEKDAY after day J of month M, for D-6 < J <= D. | |
211 | (setq j (1- (max 2 (- d 6)))) | |
212 | (while (<= (setq j (1+ j)) (min d (- last 8))) | |
213 | (push `(calendar-nth-named-day 1 ,weekday ,m year ,j) rlist)) | |
214 | rlist) | |
71ea27ee | 215 | ;; 01-01 and 07-01 for this year's Persian calendar. |
ff35f3b8 | 216 | ;; FIXME what does the Persian calendar have to do with this? |
71ea27ee GM |
217 | (if (and (= m 3) (<= 20 d) (<= d 21)) |
218 | '((calendar-gregorian-from-absolute | |
d80c2c18 | 219 | (calendar-persian-to-absolute `(1 1 ,(- year 621)))))) |
71ea27ee GM |
220 | (if (and (= m 9) (<= 22 d) (<= d 23)) |
221 | '((calendar-gregorian-from-absolute | |
d80c2c18 | 222 | (calendar-persian-to-absolute `(7 1 ,(- year 621)))))))) |
fd32e5b9 | 223 | (prevday-sec (- -1 utc-diff)) ; last sec of previous local day |
ff35f3b8 GM |
224 | (year (1+ y)) |
225 | new-rules) | |
6bc457fe | 226 | ;; Scan through the next few years until only one rule remains. |
ff35f3b8 GM |
227 | (while (cdr candidate-rules) |
228 | (dolist (rule candidate-rules) | |
229 | ;; The rule we return should give a Gregorian date, but here | |
230 | ;; we require an absolute date. The following is for efficiency. | |
231 | (setq date (cond ((eq (car rule) 'calendar-nth-named-day) | |
232 | (eval (cons 'calendar-nth-named-absday (cdr rule)))) | |
233 | ((eq (car rule) 'calendar-gregorian-from-absolute) | |
234 | (eval (cdr rule))) | |
235 | (t (calendar-absolute-from-gregorian (eval rule))))) | |
236 | (or (equal (current-time-zone | |
237 | (calendar-time-from-absolute date prevday-sec)) | |
238 | (current-time-zone | |
239 | (calendar-time-from-absolute (1+ date) prevday-sec))) | |
240 | (setq new-rules (cons rule new-rules)))) | |
241 | ;; If no rules remain, just use the first candidate rule; | |
242 | ;; it's wrong in general, but it's right for at least one year. | |
243 | (setq candidate-rules (if new-rules (nreverse new-rules) | |
244 | (list (car candidate-rules))) | |
4f1c166c GM |
245 | new-rules nil |
246 | year (1+ year))) | |
6bc457fe | 247 | (car candidate-rules))) |
3e03d7c7 | 248 | |
cd72c399 GM |
249 | ;; TODO it might be better to extract this information directly from |
250 | ;; the system timezone database. But cross-platform...? | |
251 | ;; See thread | |
252 | ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2006-11/msg00060.html | |
253 | (defun calendar-dst-find-data (&optional time) | |
e716fd62 | 254 | "Find data on the first daylight saving time transitions after TIME. |
cd72c399 GM |
255 | TIME defaults to `current-time'. Return value is as described |
256 | for `calendar-current-time-zone'." | |
257 | (let* ((t0 (or time (current-time))) | |
258 | (t0-zone (current-time-zone t0)) | |
259 | (t0-utc-diff (car t0-zone)) | |
4b8683c7 | 260 | (t0-name (cadr t0-zone))) |
cd72c399 GM |
261 | (if (not t0-utc-diff) |
262 | ;; Little or no time zone information is available. | |
263 | (list nil nil t0-name t0-name nil nil nil nil) | |
264 | (let* ((t1 (calendar-next-time-zone-transition t0)) | |
265 | (t2 (and t1 (calendar-next-time-zone-transition t1)))) | |
266 | (if (not t2) | |
e716fd62 | 267 | ;; This locale does not have daylight saving time. |
cd72c399 | 268 | (list (/ t0-utc-diff 60) 0 t0-name t0-name nil nil 0 0) |
e716fd62 | 269 | ;; Use heuristics to find daylight saving parameters. |
cd72c399 GM |
270 | (let* ((t1-zone (current-time-zone t1)) |
271 | (t1-utc-diff (car t1-zone)) | |
4b8683c7 | 272 | (t1-name (cadr t1-zone)) |
cd72c399 GM |
273 | (t1-date-sec (calendar-absolute-from-time t1 t0-utc-diff)) |
274 | (t2-date-sec (calendar-absolute-from-time t2 t1-utc-diff)) | |
275 | ;; TODO When calendar-dst-check-each-year-flag is non-nil, | |
276 | ;; the rules can be simpler than they currently are. | |
277 | (t1-rules (calendar-time-zone-daylight-rules | |
278 | (car t1-date-sec) t0-utc-diff)) | |
279 | (t2-rules (calendar-time-zone-daylight-rules | |
280 | (car t2-date-sec) t1-utc-diff)) | |
281 | (t1-time (/ (cdr t1-date-sec) 60)) | |
282 | (t2-time (/ (cdr t2-date-sec) 60))) | |
283 | (cons | |
284 | (/ (min t0-utc-diff t1-utc-diff) 60) | |
285 | (cons | |
286 | (/ (abs (- t0-utc-diff t1-utc-diff)) 60) | |
287 | (if (< t0-utc-diff t1-utc-diff) | |
288 | (list t0-name t1-name t1-rules t2-rules t1-time t2-time) | |
289 | (list t1-name t0-name t2-rules t1-rules t2-time t1-time) | |
290 | ))))))))) | |
291 | ||
292 | (defvar calendar-dst-transition-cache nil | |
e716fd62 | 293 | "Internal cal-dst variable storing date of daylight saving time transitions. |
cd72c399 GM |
294 | Value is a list with elements of the form (YEAR START END), where |
295 | START and END are expressions that when evaluated return the | |
311cc551 | 296 | start and end dates (respectively) for DST in YEAR. Used by the |
cd72c399 GM |
297 | function `calendar-dst-find-startend'.") |
298 | ||
299 | (defun calendar-dst-find-startend (year) | |
e716fd62 | 300 | "Find the dates in YEAR on which daylight saving time starts and ends. |
cd72c399 GM |
301 | Returns a list (YEAR START END), where START and END are |
302 | expressions that when evaluated return the start and end dates, | |
303 | respectively. This function first attempts to use pre-calculated | |
304 | data from `calendar-dst-transition-cache', otherwise it calls | |
325c2dd1 GM |
305 | `calendar-dst-find-data' (and adds the results to the cache). |
306 | If dates in YEAR cannot be handled by `encode-time' (e.g. if they | |
307 | are too large to be represented as a lisp integer), then rather | |
308 | than an error this function returns the result appropriate for | |
309 | the current year." | |
cd72c399 GM |
310 | (let ((e (assoc year calendar-dst-transition-cache)) |
311 | f) | |
312 | (or e | |
313 | (progn | |
325c2dd1 GM |
314 | (setq e (calendar-dst-find-data |
315 | (condition-case nil | |
316 | (encode-time 1 0 0 1 1 year) | |
317 | (error | |
318 | (encode-time 1 0 0 1 1 (nth 5 (decode-time)))))) | |
cd72c399 GM |
319 | f (nth 4 e) |
320 | e (list year f (nth 5 e)) | |
321 | calendar-dst-transition-cache | |
322 | (append calendar-dst-transition-cache (list e))) | |
323 | e)))) | |
324 | ||
3e03d7c7 JB |
325 | (defun calendar-current-time-zone () |
326 | "Return UTC difference, dst offset, names and rules for current time zone. | |
327 | ||
6bc457fe PE |
328 | Returns (UTC-DIFF DST-OFFSET STD-ZONE DST-ZONE DST-STARTS DST-ENDS |
329 | DST-STARTS-TIME DST-ENDS-TIME), based on a heuristic probing of what the | |
330 | system knows: | |
3e03d7c7 JB |
331 | |
332 | UTC-DIFF is an integer specifying the number of minutes difference between | |
333 | standard time in the current time zone and Coordinated Universal Time | |
334 | (Greenwich Mean Time). A negative value means west of Greenwich. | |
e716fd62 | 335 | DST-OFFSET is an integer giving the daylight saving time offset in minutes. |
3e03d7c7 JB |
336 | STD-ZONE is a string giving the name of the time zone when no seasonal time |
337 | adjustment is in effect. | |
338 | DST-ZONE is a string giving the name of the time zone when there is a seasonal | |
339 | time adjustment in effect. | |
340 | DST-STARTS and DST-ENDS are sexps in the variable `year' giving the daylight | |
e716fd62 | 341 | saving time start and end rules, in the form expected by |
3e03d7c7 | 342 | `calendar-daylight-savings-starts'. |
6bc457fe | 343 | DST-STARTS-TIME and DST-ENDS-TIME are integers giving the number of minutes |
e716fd62 | 344 | after midnight that daylight saving time starts and ends. |
3e03d7c7 | 345 | |
6bc457fe PE |
346 | If the local area does not use a seasonal time adjustment, STD-ZONE and |
347 | DST-ZONE are equal, and all the DST-* integer variables are 0. | |
3e03d7c7 JB |
348 | |
349 | Some operating systems cannot provide all this information to Emacs; in this | |
350 | case, `calendar-current-time-zone' returns a list containing nil for the data | |
351 | it can't find." | |
cd72c399 GM |
352 | (unless calendar-current-time-zone-cache |
353 | (setq calendar-current-time-zone-cache (calendar-dst-find-data)))) | |
3e03d7c7 | 354 | |
ec1ee609 GM |
355 | |
356 | ;; Following options should be set based on conditions when the code | |
357 | ;; is invoked, so are not suitable for dumping into loaddefs.el. They | |
358 | ;; default to US Eastern time if time zone info is not available. | |
3e03d7c7 JB |
359 | |
360 | (calendar-current-time-zone) | |
361 | ||
ec1ee609 | 362 | (defcustom calendar-time-zone (or (car calendar-current-time-zone-cache) -300) |
311cc551 | 363 | "Number of minutes difference between local standard time and UTC. |
ec1ee609 GM |
364 | For example, -300 for New York City, -480 for Los Angeles." |
365 | :type 'integer | |
366 | :group 'calendar-dst) | |
3e03d7c7 | 367 | |
ec1ee609 | 368 | (defcustom calendar-daylight-time-offset |
4b8683c7 | 369 | (or (cadr calendar-current-time-zone-cache) 60) |
ec1ee609 GM |
370 | "Number of minutes difference between daylight saving and standard time. |
371 | If the locale never uses daylight saving time, set this to 0." | |
372 | :type 'integer | |
373 | :group 'calendar-dst) | |
3e03d7c7 | 374 | |
ec1ee609 | 375 | (defcustom calendar-standard-time-zone-name |
4b8683c7 | 376 | (or (nth 2 calendar-current-time-zone-cache) "EST") |
ec1ee609 GM |
377 | "Abbreviated name of standard time zone at `calendar-location-name'. |
378 | For example, \"EST\" in New York City, \"PST\" for Los Angeles." | |
379 | :type 'string | |
380 | :group 'calendar-dst) | |
3e03d7c7 | 381 | |
ec1ee609 | 382 | (defcustom calendar-daylight-time-zone-name |
4b8683c7 | 383 | (or (nth 3 calendar-current-time-zone-cache) "EDT") |
ec1ee609 GM |
384 | "Abbreviated name of daylight saving time zone at `calendar-location-name'. |
385 | For example, \"EDT\" in New York City, \"PDT\" for Los Angeles." | |
386 | :type 'string | |
387 | :group 'calendar-dst) | |
388 | ||
389 | (defcustom calendar-daylight-savings-starts-time | |
4b8683c7 | 390 | (or (nth 6 calendar-current-time-zone-cache) 120) |
ec1ee609 GM |
391 | "Number of minutes after midnight that daylight saving time starts." |
392 | :type 'integer | |
393 | :group 'calendar-dst) | |
394 | ||
395 | (defcustom calendar-daylight-savings-ends-time | |
4b8683c7 | 396 | (or (nth 7 calendar-current-time-zone-cache) |
ec1ee609 GM |
397 | calendar-daylight-savings-starts-time) |
398 | "Number of minutes after midnight that daylight saving time ends." | |
399 | :type 'integer | |
400 | :group 'calendar-dst) | |
a1506d29 | 401 | |
cd72c399 GM |
402 | |
403 | (defun calendar-dst-starts (year) | |
e716fd62 | 404 | "Return the date of YEAR on which daylight saving time starts. |
cd72c399 GM |
405 | This function respects the value of `calendar-dst-check-each-year-flag'." |
406 | (or (let ((expr (if calendar-dst-check-each-year-flag | |
407 | (cadr (calendar-dst-find-startend year)) | |
408 | (nth 4 calendar-current-time-zone-cache)))) | |
409 | (if expr (eval expr))) | |
71ea27ee | 410 | ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. |
cd72c399 | 411 | (and (not (zerop calendar-daylight-time-offset)) |
ed589f9a | 412 | (calendar-nth-named-day 2 0 3 year)))) |
cd72c399 GM |
413 | |
414 | (defun calendar-dst-ends (year) | |
e716fd62 | 415 | "Return the date of YEAR on which daylight saving time ends. |
cd72c399 GM |
416 | This function respects the value of `calendar-dst-check-each-year-flag'." |
417 | (or (let ((expr (if calendar-dst-check-each-year-flag | |
418 | (nth 2 (calendar-dst-find-startend year)) | |
419 | (nth 5 calendar-current-time-zone-cache)))) | |
420 | (if expr (eval expr))) | |
71ea27ee | 421 | ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. |
cd72c399 | 422 | (and (not (zerop calendar-daylight-time-offset)) |
ed589f9a | 423 | (calendar-nth-named-day 1 0 11 year)))) |
cd72c399 | 424 | |
76db8823 | 425 | ;; used by calc, solar. |
ec230951 | 426 | (defun dst-in-effect (date) |
e716fd62 | 427 | "True if on absolute DATE daylight saving time is in effect. |
021edd45 | 428 | Fractional part of DATE is local standard time of day." |
e803eab7 | 429 | (let* ((year (calendar-extract-year |
ec230951 | 430 | (calendar-gregorian-from-absolute (floor date)))) |
021edd45 ER |
431 | (dst-starts-gregorian (eval calendar-daylight-savings-starts)) |
432 | (dst-ends-gregorian (eval calendar-daylight-savings-ends)) | |
433 | (dst-starts (and dst-starts-gregorian | |
ec230951 | 434 | (+ (calendar-absolute-from-gregorian |
021edd45 | 435 | dst-starts-gregorian) |
ec230951 ER |
436 | (/ calendar-daylight-savings-starts-time |
437 | 60.0 24.0)))) | |
021edd45 | 438 | (dst-ends (and dst-ends-gregorian |
ec230951 | 439 | (+ (calendar-absolute-from-gregorian |
021edd45 | 440 | dst-ends-gregorian) |
ec230951 ER |
441 | (/ (- calendar-daylight-savings-ends-time |
442 | calendar-daylight-time-offset) | |
443 | 60.0 24.0))))) | |
021edd45 ER |
444 | (and dst-starts dst-ends |
445 | (if (< dst-starts dst-ends) | |
446 | (and (<= dst-starts date) (< date dst-ends)) | |
447 | (or (<= dst-starts date) (< date dst-ends)))))) | |
ec230951 | 448 | |
76db8823 | 449 | ;; used by calc, lunar, solar. |
ec230951 ER |
450 | (defun dst-adjust-time (date time &optional style) |
451 | "Adjust, to account for dst on DATE, decimal fraction standard TIME. | |
452 | Returns a list (date adj-time zone) where `date' and `adj-time' are the values | |
453 | adjusted for `zone'; here `date' is a list (month day year), `adj-time' is a | |
454 | decimal fraction time, and `zone' is a string. | |
455 | ||
456 | Optional parameter STYLE forces the result time to be standard time when its | |
e716fd62 | 457 | value is 'standard and daylight saving time (if available) when its value is |
ec230951 ER |
458 | 'daylight. |
459 | ||
e716fd62 | 460 | Conversion to daylight saving time is done according to |
ec230951 ER |
461 | `calendar-daylight-savings-starts', `calendar-daylight-savings-ends', |
462 | `calendar-daylight-savings-starts-time', | |
06e3b7ae | 463 | `calendar-daylight-savings-ends-time', and `calendar-daylight-time-offset'." |
ec230951 | 464 | (let* ((rounded-abs-date (+ (calendar-absolute-from-gregorian date) |
71ea27ee | 465 | (/ (round (* 60 time)) 60.0 24.0))) |
ec230951 | 466 | (dst (dst-in-effect rounded-abs-date)) |
71ea27ee GM |
467 | (time-zone (if dst |
468 | calendar-daylight-time-zone-name | |
469 | calendar-standard-time-zone-name)) | |
470 | (time (+ rounded-abs-date | |
ec230951 ER |
471 | (if dst (/ calendar-daylight-time-offset 24.0 60.0) 0)))) |
472 | (list (calendar-gregorian-from-absolute (truncate time)) | |
473 | (* 24.0 (- time (truncate time))) | |
474 | time-zone))) | |
475 | ||
3e03d7c7 JB |
476 | (provide 'cal-dst) |
477 | ||
c07e258b | 478 | ;; arch-tag: a141d204-213c-4ca5-bdc6-f9df3aa92aad |
3e03d7c7 | 479 | ;;; cal-dst.el ends here |