timezone.el 15.8 KB
Newer Older
1
;;; timezone.el --- time zone package for GNU Emacs  -- lexical-binding: t -*-
Richard M. Stallman's avatar
Richard M. Stallman committed
2

3
;; Copyright (C) 1990-1993, 1996, 1999, 2001-2019 Free Software
4
;; Foundation, Inc.
5

6
;; Author: Masanobu Umeda <umerin@mse.kyutech.ac.jp>
Richard M. Stallman's avatar
Richard M. Stallman committed
7
;; Keywords: news
Richard M. Stallman's avatar
Richard M. Stallman committed
8 9 10

;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
23

24 25
;;; Commentary:

Richard M. Stallman's avatar
Richard M. Stallman committed
26 27 28 29 30 31 32 33 34 35 36 37 38
;;; Code:

(defvar timezone-world-timezones
  '(("PST" .  -800)
    ("PDT" .  -700)
    ("MST" .  -700)
    ("MDT" .  -600)
    ("CST" .  -600)
    ("CDT" .  -500)
    ("EST" .  -500)
    ("EDT" .  -400)
    ("AST" .  -400)			;by <clamen@CS.CMU.EDU>
    ("NST" .  -330)			;by <clamen@CS.CMU.EDU>
39
    ("UT"  .  +000)
Richard M. Stallman's avatar
Richard M. Stallman committed
40 41 42 43 44 45 46 47 48 49 50 51 52
    ("GMT" .  +000)
    ("BST" .  +100)
    ("MET" .  +100)
    ("EET" .  +200)
    ("JST" .  +900)
    ("GMT+1"  .  +100) ("GMT+2"  .  +200) ("GMT+3"  .  +300)
    ("GMT+4"  .  +400) ("GMT+5"  .  +500) ("GMT+6"  .  +600)
    ("GMT+7"  .  +700) ("GMT+8"  .  +800) ("GMT+9"  .  +900)
    ("GMT+10" . +1000) ("GMT+11" . +1100) ("GMT+12" . +1200) ("GMT+13" . +1300)
    ("GMT-1"  .  -100) ("GMT-2"  .  -200) ("GMT-3"  .  -300)
    ("GMT-4"  .  -400) ("GMT-5"  .  -500) ("GMT-6"  .  -600)
    ("GMT-7"  .  -700) ("GMT-8"  .  -800) ("GMT-9"  .  -900)
    ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200))
53
  "Time differentials of timezone from GMT in +-HHMM form.
54 55 56
This list is obsolescent, and is present only for backwards compatibility,
because time zone names are ambiguous in practice.
Use `current-time-zone' instead.")
Richard M. Stallman's avatar
Richard M. Stallman committed
57 58 59 60 61 62 63 64 65 66

(defvar timezone-months-assoc
  '(("JAN" .  1)("FEB" .  2)("MAR" .  3)
    ("APR" .  4)("MAY" .  5)("JUN" .  6)
    ("JUL" .  7)("AUG" .  8)("SEP" .  9)
    ("OCT" . 10)("NOV" . 11)("DEC" . 12))
  "Alist of first three letters of a month and its numerical representation.")

(defun timezone-make-date-arpa-standard (date &optional local timezone)
  "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 71
if nil, the local time zone is assumed."
  (let ((new (timezone-fix-time date local timezone)))
Richard M. Stallman's avatar
Richard M. Stallman committed
72 73 74
    (timezone-make-arpa-date (aref new 0) (aref new 1) (aref new 2)
			     (timezone-make-time-string
			      (aref new 3) (aref new 4) (aref new 5))
75
			     (aref new 6))))
Richard M. Stallman's avatar
Richard M. Stallman committed
76 77 78

(defun timezone-make-date-sortable (date &optional local timezone)
  "Convert DATE to a sortable date string.
79
Optional 2nd argument LOCAL specifies the default local timezone of the DATE;
80
if nil, GMT is assumed.
81
Optional 3rd argument TIMEZONE specifies a timezone to be represented in;
82 83
if nil, the local time zone is assumed."
  (let ((new (timezone-fix-time date local timezone)))
Richard M. Stallman's avatar
Richard M. Stallman committed
84 85
    (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2)
				 (timezone-make-time-string
86
				  (aref new 3) (aref new 4) (aref new 5)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
87 88 89 90 91 92 93 94 95


;;
;; Parsers and Constructors of Date and Time
;;

(defun timezone-make-arpa-date (year month day time &optional timezone)
  "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME.
Optional argument TIMEZONE specifies a time zone."
96 97 98 99 100 101 102 103 104 105 106 107 108
  (let ((zone
	 (if (listp timezone)
	     (let* ((m (timezone-zone-to-minute timezone))
		    (absm (if (< m 0) (- m) m)))
	       (format "%c%02d%02d"
		       (if (< m 0) ?- ?+) (/ absm 60) (% absm 60)))
	   timezone)))
    (format "%02d %s %04d %s %s"
	    day
	    (capitalize (car (rassq month timezone-months-assoc)))
	    year
	    time
	    zone)))
Richard M. Stallman's avatar
Richard M. Stallman committed
109 110 111 112

(defun timezone-make-sortable-date (year month day time)
  "Make sortable date string from YEAR, MONTH, DAY, and TIME."
  (format "%4d%02d%02d%s"
113
	  year month day time))
Richard M. Stallman's avatar
Richard M. Stallman committed
114 115 116 117 118 119

(defun timezone-make-time-string (hour minute second)
  "Make time string from HOUR, MINUTE, and SECOND."
  (format "%02d:%02d:%02d" hour minute second))

(defun timezone-parse-date (date)
120
  "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE].
121 122 123 124
Two-digit dates are `windowed'.  Those <69 have 2000 added; otherwise 1900
is added.  Three-digit dates have 1900 added.
TIMEZONE is nil for DATEs without a zone field.

125
Understands the following styles:
Richard M. Stallman's avatar
Richard M. Stallman committed
126 127 128
 (1) 14 Apr 89 03:20[:12] [GMT]
 (2) Fri, 17 Mar 89 4:01[:33] [GMT]
 (3) Mon Jan 16 16:12[:37] [GMT] 1989
129
 (4) 6 May 1992 1641-JST (Wednesday)
130 131
 (5) 22-AUG-1993 10:59:12.82
 (6) Thu, 11 Apr 16:17:12 91 [MET]
132
 (7) Mon, 6  Jul 16:47:20 T 1992 [MET]
133
 (8) 1996-06-24 21:13:12 [GMT]
134 135 136
 (9) 1996-06-24 21:13-ZONE
 (10) 19960624T211312"
  ;; Get rid of any text properties.
137 138
  (and (stringp date)
       (or (text-properties-at 0 date)
139
           (next-property-change 0 date))
140 141
       (setq date (copy-sequence date))
       (set-text-properties 0 (length date) nil date))
Richard M. Stallman's avatar
Richard M. Stallman committed
142
  (let ((date (or date ""))
143 144 145 146 147
        (year nil)
        (month nil)
        (day nil)
        (time nil)
        (zone nil))			;This may be nil.
Richard M. Stallman's avatar
Richard M. Stallman committed
148
    (cond ((string-match
149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199
            "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
           ;; Styles: (1) and (2) with timezone and buggy timezone
           ;; This is most common in mail and news,
           ;; so it is worth trying first.
           (setq year 3 month 2 day 1 time 4 zone 5))
          ((string-match
            "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date)
           ;; Styles: (1) and (2) without timezone
           (setq year 3 month 2 day 1 time 4 zone nil))
          ((string-match
            "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date)
           ;; Styles: (6) and (7) without timezone
           (setq year 6 month 3 day 2 time 4 zone nil))
          ((string-match
            "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
           ;; Styles: (6) and (7) with timezone and buggy timezone
           (setq year 6 month 3 day 2 time 4 zone 7))
          ((string-match
            "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date)
           ;; Styles: (3) without timezone
           (setq year 4 month 1 day 2 time 3 zone nil))
          ((string-match
            "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date)
           ;; Styles: (3) with timezone
           (setq year 5 month 1 day 2 time 3 zone 4))
          ((string-match
            "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
           ;; Styles: (4) with timezone
           (setq year 3 month 2 day 1 time 4 zone 5))
          ((string-match
            "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
           ;; Styles: (5) with timezone.
           (setq year 3 month 2 day 1 time 4 zone 6))
          ((string-match
            "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?" date)
           ;; Styles: (5) without timezone.
           (setq year 3 month 2 day 1 time 4 zone nil))
          ((string-match
            "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
           ;; Styles: (8) with timezone.
           (setq year 1 month 2 day 3 time 4 zone 5))
          ((string-match
            "\\([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)
           ;; Styles: (8) with timezone with a colon in it.
           (setq year 1 month 2 day 3 time 4 zone 5))
          ((string-match
            "\\([0-9]\\{4\\}\\)-?\\([0-9]\\{0,2\\}\\)-?\\([0-9]\\{0,2\\}\\)[T \t]+\\([0-9]+:?[0-9]+:?[0-9]+\\)" date)
           ;; Styles: (8) without timezone.
           (setq year 1 month 2 day 3 time 4 zone nil))
          )

Dave Love's avatar
Dave Love committed
200 201
    (when year
      (setq year (match-string year date))
202
      ;; Guess ambiguous years.  Assume years < 69 don't predate the
203 204
      ;; Unix Epoch, so are 2000+.  Three-digit years are assumed to
      ;; be relative to 1900.
205 206 207 208 209
      (when (< (length year) 4)
        (let ((y (string-to-number year)))
          (when (< y 69)
            (setq y (+ y 100)))
          (setq year (int-to-string (+ 1900 y)))))
Dave Love's avatar
Dave Love committed
210
      (setq month
211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227
            (if (or (= (aref date (+ (match-beginning month) 2)) ?-)
                    (let ((n (string-to-number
                              (char-to-string
                               (aref date (+ (match-beginning month) 2))))))
                      (= (aref (number-to-string n) 0)
                         (aref date (+ (match-beginning month) 2)))))
                ;; Handle numeric months, spanning exactly two digits.
                (substring date
                           (match-beginning month)
                           (+ (match-beginning month) 2))
              (let* ((string (substring date
                                        (match-beginning month)
                                        (+ (match-beginning month) 3)))
                     (monthnum
                      (cdr (assoc (upcase string) timezone-months-assoc))))
                (when monthnum
                  (int-to-string monthnum)))))
Dave Love's avatar
Dave Love committed
228 229
      (setq day (match-string day date))
      (setq time (match-string time date)))
230
    (when zone (setq zone (match-string zone date)))
Richard M. Stallman's avatar
Richard M. Stallman committed
231
    ;; Return a vector.
232
    (if (and year month)
233
        (vector year month day time zone)
Dave Love's avatar
Dave Love committed
234
      (vector "0" "0" "0" "0" nil))))
Richard M. Stallman's avatar
Richard M. Stallman committed
235 236 237 238 239

(defun timezone-parse-time (time)
  "Parse TIME (HH:MM:SS) and return a vector [hour minute second].
Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM."
  (let ((time (or time ""))
Dave Love's avatar
Dave Love committed
240
	hour minute second)
Richard M. Stallman's avatar
Richard M. Stallman committed
241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
    (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time)
	   ;; HH:MM:SS
	   (setq hour 1 minute 2 second 3))
	  ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time)
	   ;; HH:MM
	   (setq hour 1 minute 2 second nil))
	  ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time)
	   ;; HHMMSS
	   (setq hour 1 minute 2 second 3))
	  ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time)
	   ;; HHMM
	   (setq hour 1 minute 2 second nil))
	  )
    ;; Return [hour minute second]
    (vector
Dave Love's avatar
Dave Love committed
256 257 258
     (if hour (match-string hour time) "0")
     (if minute (match-string minute time) "0")
     (if second (match-string second time) "0"))))
Richard M. Stallman's avatar
Richard M. Stallman committed
259 260 261 262 263


;; Miscellaneous

(defun timezone-zone-to-minute (timezone)
264
  "Translate TIMEZONE to an integer minute offset from GMT.
265
TIMEZONE can be a cons cell containing the output of `current-time-zone',
266 267 268 269 270
or an integer of the form +-HHMM, or a time zone name."
  (cond
     ((consp timezone)
      (/ (car timezone) 60))
     (timezone
Richard M. Stallman's avatar
Richard M. Stallman committed
271 272 273 274 275 276
      (progn
	(setq timezone
	      (or (cdr (assoc (upcase timezone) timezone-world-timezones))
		  ;; +900
		  timezone))
	(if (stringp timezone)
277
	    (setq timezone (string-to-number timezone)))
Richard M. Stallman's avatar
Richard M. Stallman committed
278 279
	;; Taking account of minute in timezone.
	;; HHMM -> MM
280
	(let* ((abszone (abs timezone))
Richard M. Stallman's avatar
Richard M. Stallman committed
281
 	       (minutes (+ (* 60 (/ abszone 100)) (% abszone 100))))
282 283 284 285 286
 	  (if (< timezone 0) (- minutes) minutes))))
     (t 0)))

(defun timezone-time-from-absolute (date seconds)
  "Compute the UTC time equivalent to DATE at time SECONDS after midnight.
287
Return a list suitable as an argument to `current-time-zone',
288 289 290
or nil if the date cannot be thus represented.
DATE is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
291
  (let* ((current-time-origin 719163)
292 293 294
	    ;; (timezone-absolute-from-gregorian 1 1 1970)
	 (days (- date current-time-origin))
	 (seconds-per-day (float 86400))
295 296 297
	 (day-seconds (* days seconds-per-day)))
    (condition-case nil (time-add day-seconds seconds)
      (range-error))))
Richard M. Stallman's avatar
Richard M. Stallman committed
298

299 300
(defun timezone-time-zone-from-absolute (date seconds)
  "Compute the local time zone for DATE at time SECONDS after midnight.
301
Return a list in the same format as `current-time-zone's result,
302 303 304 305 306 307 308 309 310 311
or nil if the local time zone could not be computed.
DATE is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
   (and (fboundp 'current-time-zone)
	(let ((utc-time (timezone-time-from-absolute date seconds)))
	  (and utc-time
	       (let ((zone (current-time-zone utc-time)))
		 (and (car zone) zone))))))

(defun timezone-fix-time (date local timezone)
Richard M. Stallman's avatar
Richard M. Stallman committed
312
  "Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector.
313 314 315
If LOCAL is nil, it is assumed to be GMT.
If TIMEZONE is nil, use the local time zone."
  (let* ((date   (timezone-parse-date date))
316
	 (year   (string-to-number (aref date 0)))
317
	 (year	 (cond ((< year 69)
318 319 320
			(+ year 2000))
		       ((< year 100)
			(+ year 1900))
321 322
		       ((< year 1000)	; possible 3-digit years.
			(+ year 1900))
323
		       (t year)))
324 325
	 (month  (string-to-number (aref date 1)))
	 (day    (string-to-number (aref date 2)))
326
	 (time   (timezone-parse-time (aref date 3)))
327 328 329
	 (hour   (string-to-number (aref time 0)))
	 (minute (string-to-number (aref time 1)))
	 (second (string-to-number (aref time 2)))
330 331 332 333 334 335 336 337 338
	 (local  (or (aref date 4) local)) ;Use original if defined
	 (timezone
	  (or timezone
	      (timezone-time-zone-from-absolute
	       (timezone-absolute-from-gregorian month day year)
	       (+ second (* 60 (+ minute (* 60 hour)))))))
	 (diff   (- (timezone-zone-to-minute timezone)
		    (timezone-zone-to-minute local)))
	 (minute (+ minute diff))
339
	 (hour-fix (floor minute 60)))
Richard M. Stallman's avatar
Richard M. Stallman committed
340
    (setq hour (+ hour hour-fix))
341 342 343 344 345
    (setq minute (- minute (* 60 hour-fix)))
    ;; HOUR may be larger than 24 or smaller than 0.
    (cond ((<= 24 hour)			;24 -> 00
	   (setq hour (- hour 24))
	   (setq day  (1+ day))
346 347 348 349 350 351
	   (when (< (timezone-last-day-of-month month year) day)
	     (setq month (1+ month))
	     (setq day 1)
	     (when (< 12 month)
	       (setq month 1)
	       (setq year (1+ year)))))
352 353 354
	  ((> 0 hour)
	   (setq hour (+ hour 24))
	   (setq day  (1- day))
355 356 357 358 359 360
	   (when (> 1 day)
	     (setq month (1- month))
	     (when (> 1 month)
	       (setq month 12)
	       (setq year (1- year)))
	     (setq day (timezone-last-day-of-month month year)))))
361
    (vector year month day hour minute second timezone)))
Richard M. Stallman's avatar
Richard M. Stallman committed
362 363 364 365 366 367 368 369 370 371 372

;; Partly copied from Calendar program by Edward M. Reingold.
;; Thanks a lot.

(defun timezone-last-day-of-month (month year)
  "The last day in MONTH during YEAR."
  (if (and (= month 2) (timezone-leap-year-p year))
      29
    (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))

(defun timezone-leap-year-p (year)
373
  "Return t if YEAR is a Gregorian leap year."
Richard M. Stallman's avatar
Richard M. Stallman committed
374 375 376
  (or (and (zerop  (% year 4))
	   (not (zerop (% year 100))))
      (zerop (% year 400))))
377

378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396
(defun timezone-day-number (month day year)
  "Return the day number within the year of the date month/day/year."
  (let ((day-of-year (+ day (* 31 (1- month)))))
    (if (> month 2)
	(progn
	  (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
	  (if (timezone-leap-year-p year)
	      (setq day-of-year (1+ day-of-year)))))
    day-of-year))

(defun timezone-absolute-from-gregorian (month day year)
  "The number of days between the Gregorian date 12/31/1 BC and month/day/year.
The Gregorian date Sunday, December 31, 1 BC is imaginary."
  (+ (timezone-day-number month day year);; Days this year
     (* 365 (1- year));;	+ Days in prior years
     (/ (1- year) 4);;		+ Julian leap years
     (- (/ (1- year) 100));;	- century years
     (/ (1- year) 400)));;	+ Gregorian leap years

Dave Love's avatar
Dave Love committed
397 398
(provide 'timezone)

399
;;; timezone.el ends here