1 | ;;; timezone.el --- time zone package for GNU Emacs |
---|
2 | |
---|
3 | ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. |
---|
4 | |
---|
5 | ;; Author: Masanobu Umeda |
---|
6 | ;; Maintainer: umerin@mse.kyutech.ac.jp |
---|
7 | ;; Keywords: news |
---|
8 | |
---|
9 | ;; This file is free software; you can redistribute it and/or modify |
---|
10 | ;; it under the terms of the GNU General Public License as published by |
---|
11 | ;; the Free Software Foundation; either version 2, or (at your option) |
---|
12 | ;; any later version. |
---|
13 | |
---|
14 | ;; This file is distributed in the hope that it will be useful, |
---|
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
17 | ;; GNU General Public License for more details. |
---|
18 | |
---|
19 | ;; You should have received a copy of the GNU General Public License |
---|
20 | ;; along with GNU Emacs; see the file COPYING. If not, write to |
---|
21 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
---|
22 | |
---|
23 | ;;; Commentary: |
---|
24 | |
---|
25 | ;; Modified 1 February 1994 by Kyle Jones to fix broken |
---|
26 | ;; timezone-floor function. |
---|
27 | |
---|
28 | ;; Modified 25 January 1994 by Kyle Jones so that it will |
---|
29 | ;; work under version 18 of Emacs. Provided timezone-floor |
---|
30 | ;; and timezone-abs functions. |
---|
31 | |
---|
32 | ;; Modified 4 October 1999 by Yuuichi Teranishi so that it will |
---|
33 | ;; work with old GNUS 3.14.4 under version 18 of Emacs. |
---|
34 | |
---|
35 | ;;; Code: |
---|
36 | |
---|
37 | (defvar timezone-world-timezones |
---|
38 | '(("PST" . -800) |
---|
39 | ("PDT" . -700) |
---|
40 | ("MST" . -700) |
---|
41 | ("MDT" . -600) |
---|
42 | ("CST" . -600) |
---|
43 | ("CDT" . -500) |
---|
44 | ("EST" . -500) |
---|
45 | ("EDT" . -400) |
---|
46 | ("AST" . -400) ;by <clamen@CS.CMU.EDU> |
---|
47 | ("NST" . -330) ;by <clamen@CS.CMU.EDU> |
---|
48 | ("UT" . +000) |
---|
49 | ("GMT" . +000) |
---|
50 | ("BST" . +100) |
---|
51 | ("MET" . +100) |
---|
52 | ("EET" . +200) |
---|
53 | ("JST" . +900) |
---|
54 | ("GMT+1" . +100) ("GMT+2" . +200) ("GMT+3" . +300) |
---|
55 | ("GMT+4" . +400) ("GMT+5" . +500) ("GMT+6" . +600) |
---|
56 | ("GMT+7" . +700) ("GMT+8" . +800) ("GMT+9" . +900) |
---|
57 | ("GMT+10" . +1000) ("GMT+11" . +1100) ("GMT+12" . +1200) ("GMT+13" . +1300) |
---|
58 | ("GMT-1" . -100) ("GMT-2" . -200) ("GMT-3" . -300) |
---|
59 | ("GMT-4" . -400) ("GMT-5" . -500) ("GMT-6" . -600) |
---|
60 | ("GMT-7" . -700) ("GMT-8" . -800) ("GMT-9" . -900) |
---|
61 | ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200)) |
---|
62 | "*Time differentials of timezone from GMT in +-HHMM form. |
---|
63 | This list is obsolescent, and is present only for backwards compatibility, |
---|
64 | because time zone names are ambiguous in practice. |
---|
65 | Use `current-time-zone' instead.") |
---|
66 | |
---|
67 | (defvar timezone-months-assoc |
---|
68 | '(("JAN" . 1)("FEB" . 2)("MAR" . 3) |
---|
69 | ("APR" . 4)("MAY" . 5)("JUN" . 6) |
---|
70 | ("JUL" . 7)("AUG" . 8)("SEP" . 9) |
---|
71 | ("OCT" . 10)("NOV" . 11)("DEC" . 12)) |
---|
72 | "Alist of first three letters of a month and its numerical representation.") |
---|
73 | |
---|
74 | (defun timezone-make-date-arpa-standard (date &optional local timezone) |
---|
75 | "Convert DATE to an arpanet standard date. |
---|
76 | Optional 2nd argument LOCAL specifies the default local timezone of the DATE; |
---|
77 | if nil, GMT is assumed. |
---|
78 | Optional 3rd argument TIMEZONE specifies a time zone to be represented in; |
---|
79 | if nil, the local time zone is assumed." |
---|
80 | (let ((new (timezone-fix-time date local timezone))) |
---|
81 | (timezone-make-arpa-date (aref new 0) (aref new 1) (aref new 2) |
---|
82 | (timezone-make-time-string |
---|
83 | (aref new 3) (aref new 4) (aref new 5)) |
---|
84 | (aref new 6)) |
---|
85 | )) |
---|
86 | |
---|
87 | (defun timezone-make-date-sortable (date &optional local timezone) |
---|
88 | "Convert DATE to a sortable date string. |
---|
89 | Optional 2nd argument LOCAL specifies the default local timezone of the DATE; |
---|
90 | if nil, GMT is assumed. |
---|
91 | Optional 3rd argument TIMEZONE specifies a timezone to be represented in; |
---|
92 | if nil, the local time zone is assumed." |
---|
93 | (let ((new (timezone-fix-time date local timezone))) |
---|
94 | (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2) |
---|
95 | (timezone-make-time-string |
---|
96 | (aref new 3) (aref new 4) (aref new 5))) |
---|
97 | )) |
---|
98 | |
---|
99 | |
---|
100 | ;; |
---|
101 | ;; Parsers and Constructors of Date and Time |
---|
102 | ;; |
---|
103 | |
---|
104 | (defun timezone-make-arpa-date (year month day time &optional timezone) |
---|
105 | "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME. |
---|
106 | Optional argument TIMEZONE specifies a time zone." |
---|
107 | (let ((zone |
---|
108 | (if (listp timezone) |
---|
109 | (let* ((m (timezone-zone-to-minute timezone)) |
---|
110 | (absm (if (< m 0) (- m) m))) |
---|
111 | (format "%c%02d%02d" |
---|
112 | (if (< m 0) ?- ?+) (/ absm 60) (% absm 60))) |
---|
113 | timezone))) |
---|
114 | (format "%02d %s %04d %s %s" |
---|
115 | day |
---|
116 | (capitalize (car (rassq month timezone-months-assoc))) |
---|
117 | year |
---|
118 | time |
---|
119 | zone))) |
---|
120 | |
---|
121 | (defun timezone-make-sortable-date (year month day time) |
---|
122 | "Make sortable date string from YEAR, MONTH, DAY, and TIME." |
---|
123 | (format "%4d%02d%02d%s" |
---|
124 | year month day time)) |
---|
125 | |
---|
126 | (defun timezone-make-time-string (hour minute second) |
---|
127 | "Make time string from HOUR, MINUTE, and SECOND." |
---|
128 | (format "%02d:%02d:%02d" hour minute second)) |
---|
129 | |
---|
130 | (defun timezone-parse-date (date) |
---|
131 | "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE]. |
---|
132 | 19 is prepended to year if necessary. Timezone may be nil if nothing. |
---|
133 | Understands the following styles: |
---|
134 | (1) 14 Apr 89 03:20[:12] [GMT] |
---|
135 | (2) Fri, 17 Mar 89 4:01[:33] [GMT] |
---|
136 | (3) Mon Jan 16 16:12[:37] [GMT] 1989 |
---|
137 | (4) 6 May 1992 1641-JST (Wednesday) |
---|
138 | (5) 22-AUG-1993 10:59:12.82 |
---|
139 | (6) Thu, 11 Apr 16:17:12 91 [MET] |
---|
140 | (7) Mon, 6 Jul 16:47:20 T 1992 [MET]" |
---|
141 | (condition-case nil |
---|
142 | (progn |
---|
143 | ;; Get rid of any text properties. |
---|
144 | (and (stringp date) |
---|
145 | (or (text-properties-at 0 date) |
---|
146 | (next-property-change 0 date)) |
---|
147 | (setq date (copy-sequence date)) |
---|
148 | (set-text-properties 0 (length date) nil date)) |
---|
149 | (let ((date (or date "")) |
---|
150 | (year nil) |
---|
151 | (month nil) |
---|
152 | (day nil) |
---|
153 | (time nil) |
---|
154 | (zone nil)) ;This may be nil. |
---|
155 | (cond ((string-match |
---|
156 | "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date) |
---|
157 | ;; Styles: (6) and (7) without timezone |
---|
158 | (setq year 6 month 3 day 2 time 4 zone nil)) |
---|
159 | ((string-match |
---|
160 | "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) |
---|
161 | ;; Styles: (6) and (7) with timezone and buggy timezone |
---|
162 | (setq year 6 month 3 day 2 time 4 zone 7)) |
---|
163 | ((string-match |
---|
164 | "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date) |
---|
165 | ;; Styles: (1) and (2) without timezone |
---|
166 | (setq year 3 month 2 day 1 time 4 zone nil)) |
---|
167 | ((string-match |
---|
168 | "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) |
---|
169 | ;; Styles: (1) and (2) with timezone and buggy timezone |
---|
170 | (setq year 3 month 2 day 1 time 4 zone 5)) |
---|
171 | ((string-match |
---|
172 | "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date) |
---|
173 | ;; Styles: (3) without timezone |
---|
174 | (setq year 4 month 1 day 2 time 3 zone nil)) |
---|
175 | ((string-match |
---|
176 | "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date) |
---|
177 | ;; Styles: (3) with timezone |
---|
178 | (setq year 5 month 1 day 2 time 3 zone 4)) |
---|
179 | ((string-match |
---|
180 | "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) |
---|
181 | ;; Styles: (4) with timezone |
---|
182 | (setq year 3 month 2 day 1 time 4 zone 5)) |
---|
183 | ((string-match |
---|
184 | "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\.[0-9]+" date) |
---|
185 | ;; Styles: (5) without timezone. |
---|
186 | (setq year 3 month 2 day 1 time 4 zone nil)) |
---|
187 | ) |
---|
188 | (if year |
---|
189 | (progn |
---|
190 | (setq year |
---|
191 | (substring date (match-beginning year) (match-end year))) |
---|
192 | ;; It is now Dec 1992. 8 years before the end of the World. |
---|
193 | (if (< (length year) 4) |
---|
194 | ;; 2 digit years are bogus, so guess the century |
---|
195 | (let ((yr (string-to-int year))) |
---|
196 | (when (>= yr 100) |
---|
197 | ;; What does a three digit year mean? |
---|
198 | (setq yr (- yr 100))) |
---|
199 | (setq year (format "%d%02d" |
---|
200 | (if (< yr 70) |
---|
201 | 20 |
---|
202 | 19) |
---|
203 | yr)))) |
---|
204 | (let ((string (substring date |
---|
205 | (match-beginning month) |
---|
206 | (+ (match-beginning month) 3)))) |
---|
207 | (setq month |
---|
208 | (int-to-string |
---|
209 | (cdr (assoc (upcase string) timezone-months-assoc))))) |
---|
210 | |
---|
211 | (setq day |
---|
212 | (substring date (match-beginning day) (match-end day))) |
---|
213 | (setq time |
---|
214 | (substring date (match-beginning time) (match-end time))))) |
---|
215 | (if zone |
---|
216 | (setq zone |
---|
217 | (substring date (match-beginning zone) (match-end zone)))) |
---|
218 | ;; Return a vector. |
---|
219 | (if year |
---|
220 | (vector year month day time zone) |
---|
221 | (vector "0" "0" "0" "0" nil)) |
---|
222 | ) |
---|
223 | ) |
---|
224 | (t (signal 'error (list "Invalid date string" date))))) |
---|
225 | |
---|
226 | (defun timezone-parse-time (time) |
---|
227 | "Parse TIME (HH:MM:SS) and return a vector [hour minute second]. |
---|
228 | Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM." |
---|
229 | (let ((time (or time "")) |
---|
230 | (hour nil) |
---|
231 | (minute nil) |
---|
232 | (second nil)) |
---|
233 | (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time) |
---|
234 | ;; HH:MM:SS |
---|
235 | (setq hour 1 minute 2 second 3)) |
---|
236 | ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time) |
---|
237 | ;; HH:MM |
---|
238 | (setq hour 1 minute 2 second nil)) |
---|
239 | ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) |
---|
240 | ;; HHMMSS |
---|
241 | (setq hour 1 minute 2 second 3)) |
---|
242 | ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) |
---|
243 | ;; HHMM |
---|
244 | (setq hour 1 minute 2 second nil)) |
---|
245 | ) |
---|
246 | ;; Return [hour minute second] |
---|
247 | (vector |
---|
248 | (if hour |
---|
249 | (substring time (match-beginning hour) (match-end hour)) "0") |
---|
250 | (if minute |
---|
251 | (substring time (match-beginning minute) (match-end minute)) "0") |
---|
252 | (if second |
---|
253 | (substring time (match-beginning second) (match-end second)) "0")) |
---|
254 | )) |
---|
255 | |
---|
256 | |
---|
257 | ;; Miscellaneous |
---|
258 | |
---|
259 | (defun timezone-zone-to-minute (timezone) |
---|
260 | "Translate TIMEZONE to an integer minute offset from GMT. |
---|
261 | TIMEZONE can be a cons cell containing the output of `current-time-zone', |
---|
262 | or an integer of the form +-HHMM, or a time zone name." |
---|
263 | (cond |
---|
264 | ((consp timezone) |
---|
265 | (/ (car timezone) 60)) |
---|
266 | (timezone |
---|
267 | (progn |
---|
268 | (setq timezone |
---|
269 | (or (and (stringp timezone) (cdr (assoc (upcase timezone) timezone-world-timezones))) |
---|
270 | ;; +900 |
---|
271 | timezone)) |
---|
272 | (if (stringp timezone) |
---|
273 | (setq timezone (string-to-int timezone))) |
---|
274 | ;; Taking account of minute in timezone. |
---|
275 | ;; HHMM -> MM |
---|
276 | (let* ((abszone (abs timezone)) |
---|
277 | (minutes (+ (* 60 (/ abszone 100)) (% abszone 100)))) |
---|
278 | (if (< timezone 0) (- minutes) minutes)))) |
---|
279 | (t 0))) |
---|
280 | |
---|
281 | (defun timezone-time-from-absolute (date seconds) |
---|
282 | "Compute the UTC time equivalent to DATE at time SECONDS after midnight. |
---|
283 | Return a list suitable as an argument to `current-time-zone', |
---|
284 | or nil if the date cannot be thus represented. |
---|
285 | DATE is the number of days elapsed since the (imaginary) |
---|
286 | Gregorian date Sunday, December 31, 1 BC." |
---|
287 | (let* ((current-time-origin 719163) |
---|
288 | ;; (timezone-absolute-from-gregorian 1 1 1970) |
---|
289 | (days (- date current-time-origin)) |
---|
290 | (days-1 (/ days 65536)) |
---|
291 | (days-2 (% (/ days 256) 256)) |
---|
292 | (days-3 (% days 256)) |
---|
293 | ;; (seconds-per-day (float 86400)) |
---|
294 | (seconds-per-day-1 1) |
---|
295 | (seconds-per-day-2 81) |
---|
296 | (seconds-per-day-3 128) |
---|
297 | ;; (seconds (+ seconds (* days seconds-per-day))) |
---|
298 | ;; (current-time-arithmetic-base (float 65536)) |
---|
299 | ;; (hi (floor (/ seconds current-time-arithmetic-base))) |
---|
300 | ;; (hibase (* hi current-time-arithmetic-base)) |
---|
301 | ;; (lo (floor (- seconds hibase))) |
---|
302 | (seconds-1 (/ seconds 65536)) |
---|
303 | (seconds-2 (% (/ seconds 256) 256)) |
---|
304 | (seconds-3 (% seconds 256)) |
---|
305 | hi lo |
---|
306 | r |
---|
307 | seconds-per-day*days-1 |
---|
308 | seconds-per-day*days-2 |
---|
309 | seconds-per-day*days-3) |
---|
310 | (setq r (* days-3 seconds-per-day-3) |
---|
311 | seconds-per-day*days-3 (% r 256)) |
---|
312 | (setq r (+ (/ r 256) |
---|
313 | (* days-2 seconds-per-day-3) |
---|
314 | (* days-3 seconds-per-day-2)) |
---|
315 | seconds-per-day*days-2 (% r 256)) |
---|
316 | (setq seconds-per-day*days-1 (+ (/ r 256) |
---|
317 | (* days-1 seconds-per-day-3) |
---|
318 | (* (/ days 256) seconds-per-day-2) |
---|
319 | (* days seconds-per-day-1))) |
---|
320 | (setq r (+ seconds-2 seconds-per-day*days-2) |
---|
321 | seconds-2 (% r 256) |
---|
322 | seconds-1 (+ seconds-1 (/ r 256))) |
---|
323 | (setq lo (+ (* seconds-2 256) |
---|
324 | seconds-3 seconds-per-day*days-3)) |
---|
325 | (setq hi (+ seconds-1 seconds-per-day*days-1)) |
---|
326 | ;; (and (< (abs (- seconds (+ hibase lo))) 2) ; Check for integer overflow. |
---|
327 | ;; (cons hi lo)) |
---|
328 | (cons hi lo) |
---|
329 | )) |
---|
330 | |
---|
331 | (defun timezone-time-zone-from-absolute (date seconds) |
---|
332 | "Compute the local time zone for DATE at time SECONDS after midnight. |
---|
333 | Return a list in the same format as current-time-zone's result, |
---|
334 | or nil if the local time zone could not be computed. |
---|
335 | DATE is the number of days elapsed since the (imaginary) |
---|
336 | Gregorian date Sunday, December 31, 1 BC." |
---|
337 | (and (fboundp 'current-time-zone) |
---|
338 | (let ((utc-time (timezone-time-from-absolute date seconds))) |
---|
339 | (and utc-time |
---|
340 | (let ((zone (current-time-zone utc-time))) |
---|
341 | (and (car zone) zone)))))) |
---|
342 | |
---|
343 | (defsubst timezone-fix-time-1 (year month day hour minute second) |
---|
344 | "Fix date and time. |
---|
345 | For old `timezone-fix-time' function. |
---|
346 | Arguments are YEAR, MONTH, DAY, HOUR, MINUTE and SECOND." |
---|
347 | ;; MINUTE may be larger than 60 or smaller than -60. |
---|
348 | (let ((hour-fix |
---|
349 | (if (< minute 0) |
---|
350 | ;;(/ (- minute 59) 60) (/ minute 60) |
---|
351 | ;; ANSI C compliance about truncation of integer division |
---|
352 | ;; by eggert@twinsun.com (Paul Eggert) |
---|
353 | (- (/ (- 59 minute) 60)) (/ minute 60)))) |
---|
354 | (setq hour (+ hour hour-fix)) |
---|
355 | (setq minute (- minute (* 60 hour-fix)))) |
---|
356 | ;; HOUR may be larger than 24 or smaller than 0. |
---|
357 | (cond ((<= 24 hour) ;24 -> 00 |
---|
358 | (setq hour (- hour 24)) |
---|
359 | (setq day (1+ day)) |
---|
360 | (if (< (timezone-last-day-of-month month year) day) |
---|
361 | (progn |
---|
362 | (setq month (1+ month)) |
---|
363 | (setq day 1) |
---|
364 | (if (< 12 month) |
---|
365 | (progn |
---|
366 | (setq month 1) |
---|
367 | (setq year (1+ year)) |
---|
368 | )) |
---|
369 | ))) |
---|
370 | ((> 0 hour) |
---|
371 | (setq hour (+ hour 24)) |
---|
372 | (setq day (1- day)) |
---|
373 | (if (> 1 day) |
---|
374 | (progn |
---|
375 | (setq month (1- month)) |
---|
376 | (if (> 1 month) |
---|
377 | (progn |
---|
378 | (setq month 12) |
---|
379 | (setq year (1- year)) |
---|
380 | )) |
---|
381 | (setq day (timezone-last-day-of-month month year)) |
---|
382 | ))) |
---|
383 | ) |
---|
384 | (vector year month day hour minute second)) |
---|
385 | |
---|
386 | (defsubst timezone-fix-time-2 (date local timezone) |
---|
387 | "Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector. |
---|
388 | If LOCAL is nil, it is assumed to be GMT. |
---|
389 | If TIMEZONE is nil, use the local time zone." |
---|
390 | (let* ((date (timezone-parse-date date)) |
---|
391 | (year (string-to-int (aref date 0))) |
---|
392 | (year (cond ((< year 50) |
---|
393 | (+ year 2000)) |
---|
394 | ((< year 100) |
---|
395 | (+ year 1900)) |
---|
396 | (t year))) |
---|
397 | (month (string-to-int (aref date 1))) |
---|
398 | (day (string-to-int (aref date 2))) |
---|
399 | (time (timezone-parse-time (aref date 3))) |
---|
400 | (hour (string-to-int (aref time 0))) |
---|
401 | (minute (string-to-int (aref time 1))) |
---|
402 | (second (string-to-int (aref time 2))) |
---|
403 | (local (or (aref date 4) local)) ;Use original if defined |
---|
404 | (timezone |
---|
405 | (or timezone |
---|
406 | (timezone-time-zone-from-absolute |
---|
407 | (timezone-absolute-from-gregorian month day year) |
---|
408 | (+ second (* 60 (+ minute (* 60 hour))))))) |
---|
409 | (diff (- (timezone-zone-to-minute timezone) |
---|
410 | (timezone-zone-to-minute local))) |
---|
411 | (minute (+ minute diff)) |
---|
412 | (hour-fix (floor minute 60))) |
---|
413 | (setq hour (+ hour hour-fix)) |
---|
414 | (setq minute (- minute (* 60 hour-fix))) |
---|
415 | ;; HOUR may be larger than 24 or smaller than 0. |
---|
416 | (cond ((<= 24 hour) ;24 -> 00 |
---|
417 | (setq hour (- hour 24)) |
---|
418 | (setq day (1+ day)) |
---|
419 | (if (< (timezone-last-day-of-month month year) day) |
---|
420 | (progn |
---|
421 | (setq month (1+ month)) |
---|
422 | (setq day 1) |
---|
423 | (if (< 12 month) |
---|
424 | (progn |
---|
425 | (setq month 1) |
---|
426 | (setq year (1+ year)) |
---|
427 | )) |
---|
428 | ))) |
---|
429 | ((> 0 hour) |
---|
430 | (setq hour (+ hour 24)) |
---|
431 | (setq day (1- day)) |
---|
432 | (if (> 1 day) |
---|
433 | (progn |
---|
434 | (setq month (1- month)) |
---|
435 | (if (> 1 month) |
---|
436 | (progn |
---|
437 | (setq month 12) |
---|
438 | (setq year (1- year)) |
---|
439 | )) |
---|
440 | (setq day (timezone-last-day-of-month month year)) |
---|
441 | ))) |
---|
442 | ) |
---|
443 | (vector year month day hour minute second timezone))) |
---|
444 | |
---|
445 | (defun timezone-fix-time (a1 a2 a3 &optional a4 a5 a6) |
---|
446 | "Fix date and time. |
---|
447 | (Old API: A1=YEAR A2=MONTH A3=DAY A4=HOUR A5=MINUTE A6=SECOND). |
---|
448 | Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector. |
---|
449 | If LOCAL is nil, it is assumed to be GMT. |
---|
450 | If TIMEZONE is nil, use the local time zone. |
---|
451 | (New API: A1=DATE A2=LOCAL A3=TIMEZONE)" |
---|
452 | (if a4 |
---|
453 | (timezone-fix-time-1 a1 a2 a3 a4 a5 a6) |
---|
454 | (timezone-fix-time-2 a1 a2 a3))) |
---|
455 | |
---|
456 | ;; Partly copied from Calendar program by Edward M. Reingold. |
---|
457 | ;; Thanks a lot. |
---|
458 | |
---|
459 | (defun timezone-last-day-of-month (month year) |
---|
460 | "The last day in MONTH during YEAR." |
---|
461 | (if (and (= month 2) (timezone-leap-year-p year)) |
---|
462 | 29 |
---|
463 | (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) |
---|
464 | |
---|
465 | (defun timezone-leap-year-p (year) |
---|
466 | "Return t if YEAR is a Gregorian leap year." |
---|
467 | (or (and (zerop (% year 4)) |
---|
468 | (not (zerop (% year 100)))) |
---|
469 | (zerop (% year 400)))) |
---|
470 | |
---|
471 | (defun timezone-day-number (month day year) |
---|
472 | "Return the day number within the year of the date MONTH/DAY/YEAR." |
---|
473 | (let ((day-of-year (+ day (* 31 (1- month))))) |
---|
474 | (if (> month 2) |
---|
475 | (progn |
---|
476 | (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) |
---|
477 | (if (timezone-leap-year-p year) |
---|
478 | (setq day-of-year (1+ day-of-year))))) |
---|
479 | day-of-year)) |
---|
480 | |
---|
481 | (defun timezone-absolute-from-gregorian (month day year) |
---|
482 | "The number of days between the Gregorian date 12/31/1 BC and MONTH/DAY/YEAR. |
---|
483 | The Gregorian date Sunday, December 31, 1 BC is imaginary." |
---|
484 | (+ (timezone-day-number month day year);; Days this year |
---|
485 | (* 365 (1- year));; + Days in prior years |
---|
486 | (/ (1- year) 4);; + Julian leap years |
---|
487 | (- (/ (1- year) 100));; - century years |
---|
488 | (/ (1- year) 400)));; + Gregorian leap years |
---|
489 | |
---|
490 | ;;; @ End. |
---|
491 | ;;; |
---|
492 | |
---|
493 | (require 'product) |
---|
494 | (product-provide (provide 'timezone) (require 'apel-ver)) |
---|
495 | |
---|
496 | ;;; timezone.el ends here |
---|