1 ;;; timezone.el --- time zone package for GNU Emacs
3 ;; Copyright (C) 1990-1993, 1996, 1999, 2001-2011 Free Software Foundation, Inc.
5 ;; Author: Masanobu Umeda
6 ;; Maintainer: umerin@mse.kyutech.ac.jp
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 (defvar timezone-world-timezones
37 ("AST" . -
400) ;by <clamen@CS.CMU.EDU>
38 ("NST" . -
330) ;by <clamen@CS.CMU.EDU>
45 ("GMT+1" .
+100) ("GMT+2" .
+200) ("GMT+3" .
+300)
46 ("GMT+4" .
+400) ("GMT+5" .
+500) ("GMT+6" .
+600)
47 ("GMT+7" .
+700) ("GMT+8" .
+800) ("GMT+9" .
+900)
48 ("GMT+10" .
+1000) ("GMT+11" .
+1100) ("GMT+12" .
+1200) ("GMT+13" .
+1300)
49 ("GMT-1" . -
100) ("GMT-2" . -
200) ("GMT-3" . -
300)
50 ("GMT-4" . -
400) ("GMT-5" . -
500) ("GMT-6" . -
600)
51 ("GMT-7" . -
700) ("GMT-8" . -
800) ("GMT-9" . -
900)
52 ("GMT-10" . -
1000) ("GMT-11" . -
1100) ("GMT-12" . -
1200))
53 "*Time differentials of timezone from GMT in +-HHMM form.
54 This list is obsolescent, and is present only for backwards compatibility,
55 because time zone names are ambiguous in practice.
56 Use `current-time-zone' instead.")
58 (defvar timezone-months-assoc
59 '(("JAN" .
1)("FEB" .
2)("MAR" .
3)
60 ("APR" .
4)("MAY" .
5)("JUN" .
6)
61 ("JUL" .
7)("AUG" .
8)("SEP" .
9)
62 ("OCT" .
10)("NOV" .
11)("DEC" .
12))
63 "Alist of first three letters of a month and its numerical representation.")
65 (defun timezone-make-date-arpa-standard (date &optional local timezone
)
66 "Convert DATE to an arpanet standard date.
67 Optional 2nd argument LOCAL specifies the default local timezone of the DATE;
68 if nil, GMT is assumed.
69 Optional 3rd argument TIMEZONE specifies a time zone to be represented in;
70 if nil, the local time zone is assumed."
71 (let ((new (timezone-fix-time date local timezone
)))
72 (timezone-make-arpa-date (aref new
0) (aref new
1) (aref new
2)
73 (timezone-make-time-string
74 (aref new
3) (aref new
4) (aref new
5))
78 (defun timezone-make-date-sortable (date &optional local timezone
)
79 "Convert DATE to a sortable date string.
80 Optional 2nd argument LOCAL specifies the default local timezone of the DATE;
81 if nil, GMT is assumed.
82 Optional 3rd argument TIMEZONE specifies a timezone to be represented in;
83 if nil, the local time zone is assumed."
84 (let ((new (timezone-fix-time date local timezone
)))
85 (timezone-make-sortable-date (aref new
0) (aref new
1) (aref new
2)
86 (timezone-make-time-string
87 (aref new
3) (aref new
4) (aref new
5)))
92 ;; Parsers and Constructors of Date and Time
95 (defun timezone-make-arpa-date (year month day time
&optional timezone
)
96 "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME.
97 Optional argument TIMEZONE specifies a time zone."
100 (let* ((m (timezone-zone-to-minute timezone
))
101 (absm (if (< m
0) (- m
) m
)))
103 (if (< m
0) ?- ?
+) (/ absm
60) (% absm
60)))
105 (format "%02d %s %04d %s %s"
107 (capitalize (car (rassq month timezone-months-assoc
)))
112 (defun timezone-make-sortable-date (year month day time
)
113 "Make sortable date string from YEAR, MONTH, DAY, and TIME."
114 (format "%4d%02d%02d%s"
115 year month day time
))
117 (defun timezone-make-time-string (hour minute second
)
118 "Make time string from HOUR, MINUTE, and SECOND."
119 (format "%02d:%02d:%02d" hour minute second
))
121 (defun timezone-parse-date (date)
122 "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE].
123 Two-digit dates are `windowed'. Those <69 have 2000 added; otherwise 1900
124 is added. Three-digit dates have 1900 added.
125 TIMEZONE is nil for DATEs without a zone field.
127 Understands the following styles:
128 (1) 14 Apr 89 03:20[:12] [GMT]
129 (2) Fri, 17 Mar 89 4:01[:33] [GMT]
130 (3) Mon Jan 16 16:12[:37] [GMT] 1989
131 (4) 6 May 1992 1641-JST (Wednesday)
132 (5) 22-AUG-1993 10:59:12.82
133 (6) Thu, 11 Apr 16:17:12 91 [MET]
134 (7) Mon, 6 Jul 16:47:20 T 1992 [MET]
135 (8) 1996-06-24 21:13:12 [GMT]
136 (9) 1996-06-24 21:13-ZONE
137 (10) 19960624T211312"
138 ;; Get rid of any text properties.
140 (or (text-properties-at 0 date
)
141 (next-property-change 0 date
))
142 (setq date
(copy-sequence date
))
143 (set-text-properties 0 (length date
) nil date
))
144 (let ((date (or date
""))
149 (zone nil
)) ;This may be nil.
151 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date
)
152 ;; Styles: (1) and (2) with timezone and buggy timezone
153 ;; This is most common in mail and news,
154 ;; so it is worth trying first.
155 (setq year
3 month
2 day
1 time
4 zone
5))
157 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date
)
158 ;; Styles: (1) and (2) without timezone
159 (setq year
3 month
2 day
1 time
4 zone nil
))
161 "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date
)
162 ;; Styles: (6) and (7) without timezone
163 (setq year
6 month
3 day
2 time
4 zone nil
))
165 "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date
)
166 ;; Styles: (6) and (7) with timezone and buggy timezone
167 (setq year
6 month
3 day
2 time
4 zone
7))
169 "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date
)
170 ;; Styles: (3) without timezone
171 (setq year
4 month
1 day
2 time
3 zone nil
))
173 "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date
)
174 ;; Styles: (3) with timezone
175 (setq year
5 month
1 day
2 time
3 zone
4))
177 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date
)
178 ;; Styles: (4) with timezone
179 (setq year
3 month
2 day
1 time
4 zone
5))
181 "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?[ \t]+\\([-+a-zA-Z0-9]+\\)" date
)
182 ;; Styles: (5) with timezone.
183 (setq year
3 month
2 day
1 time
4 zone
6))
185 "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?" date
)
186 ;; Styles: (5) without timezone.
187 (setq year
3 month
2 day
1 time
4 zone nil
))
189 "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date
)
190 ;; Styles: (8) with timezone.
191 (setq year
1 month
2 day
3 time
4 zone
5))
193 "\\([0-9]\\{4\\}\\)-?\\([0-9]\\{0,2\\}\\)-?\\([0-9]\\{0,2\\}\\)[T \t]+\\([0-9]\\{0,2\\}:?[0-9]\\{0,2\\}:?[0-9]\\{0,2\\}\\)[ \t]*\\([-+a-zA-Z]+[0-9:]*\\)" date
)
194 ;; Styles: (8) with timezone with a colon in it.
195 (setq year
1 month
2 day
3 time
4 zone
5))
197 "\\([0-9]\\{4\\}\\)-?\\([0-9]\\{0,2\\}\\)-?\\([0-9]\\{0,2\\}\\)[T \t]+\\([0-9]+:?[0-9]+:?[0-9]+\\)" date
)
198 ;; Styles: (8) without timezone.
199 (setq year
1 month
2 day
3 time
4 zone nil
))
203 (setq year
(match-string year date
))
204 ;; Guess ambiguous years. Assume years < 69 don't predate the
205 ;; Unix Epoch, so are 2000+. Three-digit years are assumed to
206 ;; be relative to 1900.
207 (when (< (length year
) 4)
208 (let ((y (string-to-number year
)))
211 (setq year
(int-to-string (+ 1900 y
)))))
213 (if (or (= (aref date
(+ (match-beginning month
) 2)) ?-
)
214 (let ((n (string-to-number
216 (aref date
(+ (match-beginning month
) 2))))))
217 (= (aref (number-to-string n
) 0)
218 (aref date
(+ (match-beginning month
) 2)))))
219 ;; Handle numeric months, spanning exactly two digits.
221 (match-beginning month
)
222 (+ (match-beginning month
) 2))
223 (let* ((string (substring date
224 (match-beginning month
)
225 (+ (match-beginning month
) 3)))
227 (cdr (assoc (upcase string
) timezone-months-assoc
))))
229 (int-to-string monthnum
)))))
230 (setq day
(match-string day date
))
231 (setq time
(match-string time date
)))
232 (when zone
(setq zone
(match-string zone date
)))
235 (vector year month day time zone
)
236 (vector "0" "0" "0" "0" nil
))))
238 (defun timezone-parse-time (time)
239 "Parse TIME (HH:MM:SS) and return a vector [hour minute second].
240 Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM."
241 (let ((time (or time
""))
243 (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time
)
245 (setq hour
1 minute
2 second
3))
246 ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time
)
248 (setq hour
1 minute
2 second nil
))
249 ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time
)
251 (setq hour
1 minute
2 second
3))
252 ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time
)
254 (setq hour
1 minute
2 second nil
))
256 ;; Return [hour minute second]
258 (if hour
(match-string hour time
) "0")
259 (if minute
(match-string minute time
) "0")
260 (if second
(match-string second time
) "0"))))
265 (defun timezone-zone-to-minute (timezone)
266 "Translate TIMEZONE to an integer minute offset from GMT.
267 TIMEZONE can be a cons cell containing the output of `current-time-zone',
268 or an integer of the form +-HHMM, or a time zone name."
271 (/ (car timezone
) 60))
275 (or (cdr (assoc (upcase timezone
) timezone-world-timezones
))
278 (if (stringp timezone
)
279 (setq timezone
(string-to-number timezone
)))
280 ;; Taking account of minute in timezone.
282 (let* ((abszone (abs timezone
))
283 (minutes (+ (* 60 (/ abszone
100)) (% abszone
100))))
284 (if (< timezone
0) (- minutes
) minutes
))))
287 (defun timezone-time-from-absolute (date seconds
)
288 "Compute the UTC time equivalent to DATE at time SECONDS after midnight.
289 Return a list suitable as an argument to `current-time-zone',
290 or nil if the date cannot be thus represented.
291 DATE is the number of days elapsed since the (imaginary)
292 Gregorian date Sunday, December 31, 1 BC."
293 (let* ((current-time-origin 719163)
294 ;; (timezone-absolute-from-gregorian 1 1 1970)
295 (days (- date current-time-origin
))
296 (seconds-per-day (float 86400))
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 (and (< (abs (- seconds
(+ hibase lo
))) 2) ;; Check for integer overflow.
305 (defun timezone-time-zone-from-absolute (date seconds
)
306 "Compute the local time zone for DATE at time SECONDS after midnight.
307 Return a list in the same format as `current-time-zone's result,
308 or nil if the local time zone could not be computed.
309 DATE is the number of days elapsed since the (imaginary)
310 Gregorian date Sunday, December 31, 1 BC."
311 (and (fboundp 'current-time-zone
)
312 (let ((utc-time (timezone-time-from-absolute date seconds
)))
314 (let ((zone (current-time-zone utc-time
)))
315 (and (car zone
) zone
))))))
317 (defun timezone-fix-time (date local timezone
)
318 "Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector.
319 If LOCAL is nil, it is assumed to be GMT.
320 If TIMEZONE is nil, use the local time zone."
321 (let* ((date (timezone-parse-date date
))
322 (year (string-to-number (aref date
0)))
323 (year (cond ((< year
69)
327 ((< year
1000) ; possible 3-digit years.
330 (month (string-to-number (aref date
1)))
331 (day (string-to-number (aref date
2)))
332 (time (timezone-parse-time (aref date
3)))
333 (hour (string-to-number (aref time
0)))
334 (minute (string-to-number (aref time
1)))
335 (second (string-to-number (aref time
2)))
336 (local (or (aref date
4) local
)) ;Use original if defined
339 (timezone-time-zone-from-absolute
340 (timezone-absolute-from-gregorian month day year
)
341 (+ second
(* 60 (+ minute
(* 60 hour
)))))))
342 (diff (- (timezone-zone-to-minute timezone
)
343 (timezone-zone-to-minute local
)))
344 (minute (+ minute diff
))
345 (hour-fix (floor minute
60)))
346 (setq hour
(+ hour hour-fix
))
347 (setq minute
(- minute
(* 60 hour-fix
)))
348 ;; HOUR may be larger than 24 or smaller than 0.
349 (cond ((<= 24 hour
) ;24 -> 00
350 (setq hour
(- hour
24))
352 (when (< (timezone-last-day-of-month month year
) day
)
353 (setq month
(1+ month
))
357 (setq year
(1+ year
)))))
359 (setq hour
(+ hour
24))
362 (setq month
(1- month
))
365 (setq year
(1- year
)))
366 (setq day
(timezone-last-day-of-month month year
)))))
367 (vector year month day hour minute second timezone
)))
369 ;; Partly copied from Calendar program by Edward M. Reingold.
372 (defun timezone-last-day-of-month (month year
)
373 "The last day in MONTH during YEAR."
374 (if (and (= month
2) (timezone-leap-year-p year
))
376 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month
))))
378 (defun timezone-leap-year-p (year)
379 "Return t if YEAR is a Gregorian leap year."
380 (or (and (zerop (% year
4))
381 (not (zerop (% year
100))))
382 (zerop (% year
400))))
384 (defun timezone-day-number (month day year
)
385 "Return the day number within the year of the date month/day/year."
386 (let ((day-of-year (+ day
(* 31 (1- month
)))))
389 (setq day-of-year
(- day-of-year
(/ (+ 23 (* 4 month
)) 10)))
390 (if (timezone-leap-year-p year
)
391 (setq day-of-year
(1+ day-of-year
)))))
394 (defun timezone-absolute-from-gregorian (month day year
)
395 "The number of days between the Gregorian date 12/31/1 BC and month/day/year.
396 The Gregorian date Sunday, December 31, 1 BC is imaginary."
397 (+ (timezone-day-number month day year
);; Days this year
398 (* 365 (1- year
));; + Days in prior years
399 (/ (1- year
) 4);; + Julian leap years
400 (- (/ (1- year
) 100));; - century years
401 (/ (1- year
) 400)));; + Gregorian leap years
405 ;;; timezone.el ends here