Correct misspellings.
[elisp/apel.git] / timezone.el
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 \f
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 \f
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-floor (arg &optional divisor)
282   "Return the largest integer no grater than ARG.
283 With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR."
284   (if (null divisor)
285       (setq divisor 1))
286   (if (< arg 0)
287       (- (/ (- divisor 1 arg) divisor))
288     (/ arg divisor)))
289
290 (defun timezone-time-from-absolute (date seconds)
291   "Compute the UTC time equivalent to DATE at time SECONDS after midnight.
292 Return a list suitable as an argument to `current-time-zone',
293 or nil if the date cannot be thus represented.
294 DATE is the number of days elapsed since the (imaginary)
295 Gregorian date Sunday, December 31, 1 BC."
296   (let* ((current-time-origin 719163)
297             ;; (timezone-absolute-from-gregorian 1 1 1970)
298          (days (- date current-time-origin))
299          (days-1 (/ days 65536))
300          (days-2 (% (/ days 256) 256))
301          (days-3 (% days 256))
302          ;; (seconds-per-day (float 86400))
303          (seconds-per-day-1 1)
304          (seconds-per-day-2 81)
305          (seconds-per-day-3 128)
306          ;; (seconds (+ seconds (* days seconds-per-day)))
307          ;; (current-time-arithmetic-base (float 65536))
308          ;; (hi (timezone-floor (/ seconds current-time-arithmetic-base)))
309          ;; (hibase (* hi current-time-arithmetic-base))
310          ;; (lo (timezone-floor (- seconds hibase)))
311          (seconds-1 (/ seconds 65536))
312          (seconds-2 (% (/ seconds 256) 256))
313          (seconds-3 (% seconds 256))
314          hi lo
315          r
316          seconds-per-day*days-1
317          seconds-per-day*days-2
318          seconds-per-day*days-3)
319     (setq r (* days-3 seconds-per-day-3)
320           seconds-per-day*days-3 (% r 256))
321     (setq r (+ (/ r 256)
322                (* days-2 seconds-per-day-3)
323                (* days-3 seconds-per-day-2))
324           seconds-per-day*days-2 (% r 256))
325     (setq seconds-per-day*days-1 (+ (/ r 256)
326                                     (* days-1 seconds-per-day-3)
327                                     (* (/ days 256) seconds-per-day-2)
328                                     (* days seconds-per-day-1)))
329     (setq r (+ seconds-2 seconds-per-day*days-2)
330           seconds-2 (% r 256)
331           seconds-1 (+ seconds-1 (/ r 256)))
332     (setq lo (+ (* seconds-2 256)
333                 seconds-3 seconds-per-day*days-3))
334     (setq hi (+ seconds-1 seconds-per-day*days-1))
335     ;; (and (< (abs (- seconds (+ hibase lo))) 2) ; Check for integer overflow.
336     ;;      (cons hi lo))
337     (cons hi lo)
338     ))
339
340 (defun timezone-time-zone-from-absolute (date seconds)
341   "Compute the local time zone for DATE at time SECONDS after midnight.
342 Return a list in the same format as current-time-zone's result,
343 or nil if the local time zone could not be computed.
344 DATE is the number of days elapsed since the (imaginary)
345 Gregorian date Sunday, December 31, 1 BC."
346    (and (fboundp 'current-time-zone)
347         (let ((utc-time (timezone-time-from-absolute date seconds)))
348           (and utc-time
349                (let ((zone (current-time-zone utc-time)))
350                  (and (car zone) zone))))))
351
352 (defsubst timezone-fix-time-1 (year month day hour minute second)
353   "Fix date and time.
354 For old `timezone-fix-time' function.
355 Arguments are YEAR, MONTH, DAY, HOUR, MINUTE and SECOND."
356   ;; MINUTE may be larger than 60 or smaller than -60.
357   (let ((hour-fix
358          (if (< minute 0)
359              ;;(/ (- minute 59) 60) (/ minute 60)
360              ;; ANSI C compliance about truncation of integer division
361              ;; by eggert@twinsun.com (Paul Eggert)
362              (- (/ (- 59 minute) 60)) (/ minute 60))))
363     (setq hour (+ hour hour-fix))
364     (setq minute (- minute (* 60 hour-fix))))
365   ;; HOUR may be larger than 24 or smaller than 0.
366   (cond ((<= 24 hour)                   ;24 -> 00
367          (setq hour (- hour 24))
368          (setq day  (1+ day))
369          (if (< (timezone-last-day-of-month month year) day)
370              (progn
371                (setq month (1+ month))
372                (setq day 1)
373                (if (< 12 month)
374                    (progn
375                      (setq month 1)
376                      (setq year (1+ year))
377                      ))
378                )))
379         ((> 0 hour)
380          (setq hour (+ hour 24))
381          (setq day  (1- day))
382          (if (> 1 day)
383              (progn
384                (setq month (1- month))
385                (if (> 1 month)
386                    (progn
387                      (setq month 12)
388                      (setq year (1- year))
389                      ))
390                (setq day (timezone-last-day-of-month month year))
391                )))
392         )
393   (vector year month day hour minute second))
394
395 (defsubst timezone-fix-time-2 (date local timezone)
396   "Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector.
397 If LOCAL is nil, it is assumed to be GMT.
398 If TIMEZONE is nil, use the local time zone."
399   (let* ((date   (timezone-parse-date date))
400          (year   (string-to-int (aref date 0)))
401          (year   (cond ((< year 50)
402                         (+ year 2000))
403                        ((< year 100)
404                         (+ year 1900))
405                        (t year)))
406          (month  (string-to-int (aref date 1)))
407          (day    (string-to-int (aref date 2)))
408          (time   (timezone-parse-time (aref date 3)))
409          (hour   (string-to-int (aref time 0)))
410          (minute (string-to-int (aref time 1)))
411          (second (string-to-int (aref time 2)))
412          (local  (or (aref date 4) local)) ;Use original if defined
413          (timezone
414           (or timezone
415               (timezone-time-zone-from-absolute
416                (timezone-absolute-from-gregorian month day year)
417                (+ second (* 60 (+ minute (* 60 hour)))))))
418          (diff   (- (timezone-zone-to-minute timezone)
419                     (timezone-zone-to-minute local)))
420          (minute (+ minute diff))
421          (hour-fix (timezone-floor minute 60)))
422     (setq hour (+ hour hour-fix))
423     (setq minute (- minute (* 60 hour-fix)))
424     ;; HOUR may be larger than 24 or smaller than 0.
425     (cond ((<= 24 hour)                 ;24 -> 00
426            (setq hour (- hour 24))
427            (setq day  (1+ day))
428            (if (< (timezone-last-day-of-month month year) day)
429                (progn
430                  (setq month (1+ month))
431                  (setq day 1)
432                  (if (< 12 month)
433                      (progn
434                        (setq month 1)
435                        (setq year (1+ year))
436                        ))
437                  )))
438           ((> 0 hour)
439            (setq hour (+ hour 24))
440            (setq day  (1- day))
441            (if (> 1 day)
442                (progn
443                  (setq month (1- month))
444                  (if (> 1 month)
445                      (progn
446                        (setq month 12)
447                        (setq year (1- year))
448                        ))
449                  (setq day (timezone-last-day-of-month month year))
450                  )))
451           )
452     (vector year month day hour minute second timezone)))
453
454 (defun timezone-fix-time (a1 a2 a3 &optional a4 a5 a6)
455   "Fix date and time.
456 (Old API: A1=YEAR A2=MONTH A3=DAY A4=HOUR A5=MINUTE A6=SECOND).
457 Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector.
458 If LOCAL is nil, it is assumed to be GMT.
459 If TIMEZONE is nil, use the local time zone.
460 (New API: A1=DATE A2=LOCAL A3=TIMEZONE)"
461   (if a4
462       (timezone-fix-time-1 a1 a2 a3 a4 a5 a6)
463     (timezone-fix-time-2 a1 a2 a3)))
464
465 ;; Partly copied from Calendar program by Edward M. Reingold.
466 ;; Thanks a lot.
467
468 (defun timezone-last-day-of-month (month year)
469   "The last day in MONTH during YEAR."
470   (if (and (= month 2) (timezone-leap-year-p year))
471       29
472     (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
473
474 (defun timezone-leap-year-p (year)
475   "Return t if YEAR is a Gregorian leap year."
476   (or (and (zerop  (% year 4))
477            (not (zerop (% year 100))))
478       (zerop (% year 400))))
479
480 (defun timezone-day-number (month day year)
481   "Return the day number within the year of the date MONTH/DAY/YEAR."
482   (let ((day-of-year (+ day (* 31 (1- month)))))
483     (if (> month 2)
484         (progn
485           (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
486           (if (timezone-leap-year-p year)
487               (setq day-of-year (1+ day-of-year)))))
488     day-of-year))
489
490 (defun timezone-absolute-from-gregorian (month day year)
491   "The number of days between the Gregorian date 12/31/1 BC and MONTH/DAY/YEAR.
492 The Gregorian date Sunday, December 31, 1 BC is imaginary."
493   (+ (timezone-day-number month day year);; Days this year
494      (* 365 (1- year));;        + Days in prior years
495      (/ (1- year) 4);;          + Julian leap years
496      (- (/ (1- year) 100));;    - century years
497      (/ (1- year) 400)));;      + Gregorian leap years
498
499 ;;; @ End.
500 ;;;
501
502 (require 'product)
503 (product-provide (provide 'timezone) (require 'apel-ver))
504
505 ;;; timezone.el ends here