1 ;;; Timezone package for GNU Emacs
3 ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
5 ;;; Author: Masanobu Umeda
6 ;;; Maintainer: umerin@mse.kyutech.ac.jp
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
28 (defvar timezone-world-timezones
37 ("AST" . -
400) ;by <clamen@CS.CMU.EDU>
38 ("NST" . -
330) ;by <clamen@CS.CMU.EDU>
44 ("GMT+1" .
+100) ("GMT+2" .
+200) ("GMT+3" .
+300)
45 ("GMT+4" .
+400) ("GMT+5" .
+500) ("GMT+6" .
+600)
46 ("GMT+7" .
+700) ("GMT+8" .
+800) ("GMT+9" .
+900)
47 ("GMT+10" .
+1000) ("GMT+11" .
+1100) ("GMT+12" .
+1200) ("GMT+13" .
+1300)
48 ("GMT-1" . -
100) ("GMT-2" . -
200) ("GMT-3" . -
300)
49 ("GMT-4" . -
400) ("GMT-5" . -
500) ("GMT-6" . -
600)
50 ("GMT-7" . -
700) ("GMT-8" . -
800) ("GMT-9" . -
900)
51 ("GMT-10" . -
1000) ("GMT-11" . -
1100) ("GMT-12" . -
1200))
52 "*Time differentials of timezone from GMT in +-HHMM form.
53 This list is obsolescent, and is present only for backwards compatibility,
54 because time zone names are ambiguous in practice.
55 Use `current-time-zone' instead.")
57 (defvar timezone-months-assoc
58 '(("JAN" .
1)("FEB" .
2)("MAR" .
3)
59 ("APR" .
4)("MAY" .
5)("JUN" .
6)
60 ("JUL" .
7)("AUG" .
8)("SEP" .
9)
61 ("OCT" .
10)("NOV" .
11)("DEC" .
12))
62 "Alist of first three letters of a month and its numerical representation.")
64 (defun timezone-make-date-arpa-standard (date &optional local timezone
)
65 "Convert DATE to an arpanet standard date.
66 Optional 1st argument LOCAL specifies the default local timezone of the DATE;
67 if nil, GMT is assumed.
68 Optional 2nd argument TIMEZONE specifies a time zone to be represented in;
69 if nil, the local time zone is assumed."
70 (let ((new (timezone-fix-time date local timezone
)))
71 (timezone-make-arpa-date (aref new
0) (aref new
1) (aref new
2)
72 (timezone-make-time-string
73 (aref new
3) (aref new
4) (aref new
5))
77 (defun timezone-make-date-sortable (date &optional local timezone
)
78 "Convert DATE to a sortable date string.
79 Optional 1st argument LOCAL specifies the default local timezone of the DATE;
80 if nil, GMT is assumed.
81 Optional 2nd argument TIMEZONE specifies a timezone to be represented in;
82 if nil, the local time zone is assumed."
83 (let ((new (timezone-fix-time date local timezone
)))
84 (timezone-make-sortable-date (aref new
0) (aref new
1) (aref new
2)
85 (timezone-make-time-string
86 (aref new
3) (aref new
4) (aref new
5)))
91 ;; Parsers and Constructors of Date and Time
94 (defun timezone-make-arpa-date (year month day time
&optional timezone
)
95 "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME.
96 Optional argument TIMEZONE specifies a time zone."
99 (let* ((m (timezone-zone-to-minute timezone
))
100 (absm (if (< m
0) (- m
) m
)))
102 (if (< m
0) ?- ?
+) (/ absm
60) (% absm
60)))
104 (format "%02d %s %04d %s %s"
106 (capitalize (car (rassq month timezone-months-assoc
)))
111 (defun timezone-make-sortable-date (year month day time
)
112 "Make sortable date string from YEAR, MONTH, DAY, and TIME."
113 (format "%4d%02d%02d%s"
114 year month day time
))
116 (defun timezone-make-time-string (hour minute second
)
117 "Make time string from HOUR, MINUTE, and SECOND."
118 (format "%02d:%02d:%02d" hour minute second
))
120 (defun timezone-parse-date (date)
121 "Parse DATE and return a vector [year month day time timezone].
122 19 is prepended to year if necessary. Timezone may be NIL if nothing.
123 Understand the following styles:
124 (1) 14 Apr 89 03:20[:12] [GMT]
125 (2) Fri, 17 Mar 89 4:01[:33] [GMT]
126 (3) Mon Jan 16 16:12[:37] [GMT] 1989
127 (4) 6 May 1992 1641-JST (Wednesday)"
128 (let ((date (or date
""))
133 (zone nil
)) ;This may be nil.
135 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date
)
136 ;; Styles: (1) and (2) without timezone
137 (setq year
3 month
2 day
1 time
4 zone nil
))
139 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date
)
140 ;; Styles: (1) and (2) with timezone and buggy timezone
141 (setq year
3 month
2 day
1 time
4 zone
5))
143 "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date
)
144 ;; Styles: (3) without timezone
145 (setq year
4 month
1 day
2 time
3 zone nil
))
147 "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date
)
148 ;; Styles: (3) with timezoen
149 (setq year
5 month
1 day
2 time
3 zone
4))
151 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date
)
152 ;; Styles: (4) with timezone
153 (setq year
3 month
2 day
1 time
4 zone
5))
158 (substring date
(match-beginning year
) (match-end year
)))
159 ;; It is now Dec 1992. 8 years before the end of the World.
160 (if (< (length year
) 4)
161 (setq year
(concat "19" (substring year -
2 nil
))))
167 ;; Don't use `match-end' in order to take 3
168 ;; letters from the beginning.
170 (match-beginning month
)
171 (+ (match-beginning month
) 3)))
172 timezone-months-assoc
))))
174 (substring date
(match-beginning day
) (match-end day
)))
176 (substring date
(match-beginning time
) (match-end time
)))))
179 (substring date
(match-beginning zone
) (match-end zone
))))
182 (vector year month day time zone
)
183 (vector "0" "0" "0" "0" nil
))
186 (defun timezone-parse-time (time)
187 "Parse TIME (HH:MM:SS) and return a vector [hour minute second].
188 Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM."
189 (let ((time (or time
""))
193 (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time
)
195 (setq hour
1 minute
2 second
3))
196 ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time
)
198 (setq hour
1 minute
2 second nil
))
199 ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time
)
201 (setq hour
1 minute
2 second
3))
202 ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time
)
204 (setq hour
1 minute
2 second nil
))
206 ;; Return [hour minute second]
209 (substring time
(match-beginning hour
) (match-end hour
)) "0")
211 (substring time
(match-beginning minute
) (match-end minute
)) "0")
213 (substring time
(match-beginning second
) (match-end second
)) "0"))
219 (defun timezone-zone-to-minute (timezone)
220 "Translate TIMEZONE to an integer minute offset from GMT.
221 TIMEZONE can be a cons cell containing the output of current-time-zone,
222 or an integer of the form +-HHMM, or a time zone name."
225 (/ (car timezone
) 60))
229 (or (cdr (assoc (upcase timezone
) timezone-world-timezones
))
232 (if (stringp timezone
)
233 (setq timezone
(string-to-int timezone
)))
234 ;; Taking account of minute in timezone.
236 ;;(+ (* 60 (/ timezone 100)) (% timezone 100))
237 ;; ANSI C compliance about truncation of integer division
238 ;; by eggert@twinsun.com (Paul Eggert)
239 (let* ((abszone (max timezone
(- timezone
)))
240 (minutes (+ (* 60 (/ abszone
100)) (% abszone
100))))
241 (if (< timezone
0) (- minutes
) minutes
))))
244 (defun timezone-time-from-absolute (date seconds
)
245 "Compute the UTC time equivalent to DATE at time SECONDS after midnight.
246 Return a list suitable as an argument to current-time-zone,
247 or nil if the date cannot be thus represented.
248 DATE is the number of days elapsed since the (imaginary)
249 Gregorian date Sunday, December 31, 1 BC."
250 (let* ((current-time-origin 719162)
251 ;; (timezone-absolute-from-gregorian 1 1 1970)
252 (days (- date current-time-origin
))
253 (seconds-per-day (float 86400))
254 (seconds (+ seconds
(* days seconds-per-day
)))
255 (current-time-arithmetic-base (float 65536))
256 (hi (floor (/ seconds current-time-arithmetic-base
)))
257 (hibase (* hi current-time-arithmetic-base
))
258 (lo (floor (- seconds hibase
))))
259 (and (< (abs (- seconds
(+ hibase lo
))) 2) ;; Check for integer overflow.
262 (defun timezone-time-zone-from-absolute (date seconds
)
263 "Compute the local time zone for DATE at time SECONDS after midnight.
264 Return a list in the same format as current-time-zone's result,
265 or nil if the local time zone could not be computed.
266 DATE is the number of days elapsed since the (imaginary)
267 Gregorian date Sunday, December 31, 1 BC."
268 (and (fboundp 'current-time-zone
)
269 (let ((utc-time (timezone-time-from-absolute date seconds
)))
271 (let ((zone (current-time-zone utc-time
)))
272 (and (car zone
) zone
))))))
274 (defun timezone-fix-time (date local timezone
)
275 "Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector.
276 If LOCAL is nil, it is assumed to be GMT.
277 If TIMEZONE is nil, use the local time zone."
278 (let* ((date (timezone-parse-date date
))
279 (year (string-to-int (aref date
0)))
280 (year (if (< year
100) (+ year
1900) year
))
281 (month (string-to-int (aref date
1)))
282 (day (string-to-int (aref date
2)))
283 (time (timezone-parse-time (aref date
3)))
284 (hour (string-to-int (aref time
0)))
285 (minute (string-to-int (aref time
1)))
286 (second (string-to-int (aref time
2)))
287 (local (or (aref date
4) local
)) ;Use original if defined
290 (timezone-time-zone-from-absolute
291 (timezone-absolute-from-gregorian month day year
)
292 (+ second
(* 60 (+ minute
(* 60 hour
)))))))
293 (diff (- (timezone-zone-to-minute timezone
)
294 (timezone-zone-to-minute local
)))
295 (minute (+ minute diff
))
298 ;;(/ (- minute 59) 60) (/ minute 60)
299 ;; ANSI C compliance about truncation of integer division
300 ;; by eggert@twinsun.com (Paul Eggert)
301 (- (/ (- 59 minute
) 60)) (/ minute
60))))
302 (setq hour
(+ hour hour-fix
))
303 (setq minute
(- minute
(* 60 hour-fix
)))
304 ;; HOUR may be larger than 24 or smaller than 0.
305 (cond ((<= 24 hour
) ;24 -> 00
306 (setq hour
(- hour
24))
308 (if (< (timezone-last-day-of-month month year
) day
)
310 (setq month
(1+ month
))
315 (setq year
(1+ year
))
319 (setq hour
(+ hour
24))
323 (setq month
(1- month
))
327 (setq year
(1- year
))
329 (setq day
(timezone-last-day-of-month month year
))
332 (vector year month day hour minute second timezone
)))
334 ;; Partly copied from Calendar program by Edward M. Reingold.
337 (defun timezone-last-day-of-month (month year
)
338 "The last day in MONTH during YEAR."
339 (if (and (= month
2) (timezone-leap-year-p year
))
341 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month
))))
343 (defun timezone-leap-year-p (year)
344 "Returns t if YEAR is a Gregorian leap year."
345 (or (and (zerop (% year
4))
346 (not (zerop (% year
100))))
347 (zerop (% year
400))))
349 (defun timezone-day-number (month day year
)
350 "Return the day number within the year of the date month/day/year."
351 (let ((day-of-year (+ day
(* 31 (1- month
)))))
354 (setq day-of-year
(- day-of-year
(/ (+ 23 (* 4 month
)) 10)))
355 (if (timezone-leap-year-p year
)
356 (setq day-of-year
(1+ day-of-year
)))))
359 (defun timezone-absolute-from-gregorian (month day year
)
360 "The number of days between the Gregorian date 12/31/1 BC and month/day/year.
361 The Gregorian date Sunday, December 31, 1 BC is imaginary."
362 (+ (timezone-day-number month day year
);; Days this year
363 (* 365 (1- year
));; + Days in prior years
364 (/ (1- year
) 4);; + Julian leap years
365 (- (/ (1- year
) 100));; - century years
366 (/ (1- year
) 400)));; + Gregorian leap years
368 ;;; timezone.el ends here