1;;; Timezone 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 8;; This file is part of GNU Emacs. 9 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) 13;; any later version. 14 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. 19 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. 23 24;;; Code: 25 26(provide 'timezone) 27 28(defvar timezone-world-timezones 29 '(("PST" . -800) 30 ("PDT" . -700) 31 ("MST" . -700) 32 ("MDT" . -600) 33 ("CST" . -600) 34 ("CDT" . -500) 35 ("EST" . -500) 36 ("EDT" . -400) 37 ("AST" . -400) ;by <clamen@CS.CMU.EDU> 38 ("NST" . -330) ;by <clamen@CS.CMU.EDU> 39 ("GMT" . +000) 40 ("BST" . +100) 41 ("MET" . +100) 42 ("EET" . +200) 43 ("JST" . +900) 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. 53This list is obsolescent, and is present only for backwards compatibility, 54because time zone names are ambiguous in practice. 55Use `current-time-zone' instead.") 56 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.") 63 64(defun timezone-make-date-arpa-standard (date &optional local timezone) 65 "Convert DATE to an arpanet standard date. 66Optional 1st argument LOCAL specifies the default local timezone of the DATE; 67if nil, GMT is assumed. 68Optional 2nd argument TIMEZONE specifies a time zone to be represented in; 69if 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)) 74 (aref new 6)) 75 )) 76 77(defun timezone-make-date-sortable (date &optional local timezone) 78 "Convert DATE to a sortable date string. 79Optional 1st argument LOCAL specifies the default local timezone of the DATE; 80if nil, GMT is assumed. 81Optional 2nd argument TIMEZONE specifies a timezone to be represented in; 82if 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))) 87 )) 88 89 90;; 91;; Parsers and Constructors of Date and Time 92;; 93 94(defun timezone-make-arpa-date (year month day time &optional timezone) 95 "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME. 96Optional argument TIMEZONE specifies a time zone." 97 (let ((zone 98 (if (listp timezone) 99 (let* ((m (timezone-zone-to-minute timezone)) 100 (absm (if (< m 0) (- m) m))) 101 (format "%c%02d%02d" 102 (if (< m 0) ?- ?+) (/ absm 60) (% absm 60))) 103 timezone))) 104 (format "%02d %s %04d %s %s" 105 day 106 (capitalize (car (rassq month timezone-months-assoc))) 107 year 108 time 109 zone))) 110 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)) 115 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)) 119 120(defun timezone-parse-date (date) 121 "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE]. 12219 is prepended to year if necessary. Timezone may be nil if nothing. 123Understands 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 (5) 22-AUG-1993 10:59:12.82" 129 (let ((date (or date "")) 130 (year nil) 131 (month nil) 132 (day nil) 133 (time nil) 134 (zone nil)) ;This may be nil. 135 (cond ((string-match 136 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date) 137 ;; Styles: (1) and (2) without timezone 138 (setq year 3 month 2 day 1 time 4 zone nil)) 139 ((string-match 140 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) 141 ;; Styles: (1) and (2) with timezone and buggy timezone 142 (setq year 3 month 2 day 1 time 4 zone 5)) 143 ((string-match 144 "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date) 145 ;; Styles: (3) without timezone 146 (setq year 4 month 1 day 2 time 3 zone nil)) 147 ((string-match 148 "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date) 149 ;; Styles: (3) with timezone 150 (setq year 5 month 1 day 2 time 3 zone 4)) 151 ((string-match 152 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) 153 ;; Styles: (4) with timezone 154 (setq year 3 month 2 day 1 time 4 zone 5)) 155 ((string-match 156 "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\.[0-9]+" date) 157 ;; Styles: (5) without timezone. 158 (setq year 3 month 2 day 1 time 4 zone nil)) 159 ) 160 (if year 161 (progn 162 (setq year 163 (substring date (match-beginning year) (match-end year))) 164 ;; It is now Dec 1992. 8 years before the end of the World. 165 (if (< (length year) 4) 166 (setq year (concat "19" (substring year -2 nil)))) 167 (setq month 168 (int-to-string 169 (cdr 170 (assoc 171 (upcase 172 ;; Don't use `match-end' in order to take 3 173 ;; letters from the beginning. 174 (substring date 175 (match-beginning month) 176 (+ (match-beginning month) 3))) 177 timezone-months-assoc)))) 178 (setq day 179 (substring date (match-beginning day) (match-end day))) 180 (setq time 181 (substring date (match-beginning time) (match-end time))))) 182 (if zone 183 (setq zone 184 (substring date (match-beginning zone) (match-end zone)))) 185 ;; Return a vector. 186 (if year 187 (vector year month day time zone) 188 (vector "0" "0" "0" "0" nil)) 189 )) 190 191(defun timezone-parse-time (time) 192 "Parse TIME (HH:MM:SS) and return a vector [hour minute second]. 193Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM." 194 (let ((time (or time "")) 195 (hour nil) 196 (minute nil) 197 (second nil)) 198 (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time) 199 ;; HH:MM:SS 200 (setq hour 1 minute 2 second 3)) 201 ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time) 202 ;; HH:MM 203 (setq hour 1 minute 2 second nil)) 204 ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) 205 ;; HHMMSS 206 (setq hour 1 minute 2 second 3)) 207 ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) 208 ;; HHMM 209 (setq hour 1 minute 2 second nil)) 210 ) 211 ;; Return [hour minute second] 212 (vector 213 (if hour 214 (substring time (match-beginning hour) (match-end hour)) "0") 215 (if minute 216 (substring time (match-beginning minute) (match-end minute)) "0") 217 (if second 218 (substring time (match-beginning second) (match-end second)) "0")) 219 )) 220 221 222;; Miscellaneous 223 224(defun timezone-zone-to-minute (timezone) 225 "Translate TIMEZONE to an integer minute offset from GMT. 226TIMEZONE can be a cons cell containing the output of current-time-zone, 227or an integer of the form +-HHMM, or a time zone name." 228 (cond 229 ((consp timezone) 230 (/ (car timezone) 60)) 231 (timezone 232 (progn 233 (setq timezone 234 (or (cdr (assoc (upcase timezone) timezone-world-timezones)) 235 ;; +900 236 timezone)) 237 (if (stringp timezone) 238 (setq timezone (string-to-int timezone))) 239 ;; Taking account of minute in timezone. 240 ;; HHMM -> MM 241 (let* ((abszone (abs timezone)) 242 (minutes (+ (* 60 (/ abszone 100)) (% abszone 100)))) 243 (if (< timezone 0) (- minutes) minutes)))) 244 (t 0))) 245 246(defun timezone-time-from-absolute (date seconds) 247 "Compute the UTC time equivalent to DATE at time SECONDS after midnight. 248Return a list suitable as an argument to current-time-zone, 249or nil if the date cannot be thus represented. 250DATE is the number of days elapsed since the (imaginary) 251Gregorian date Sunday, December 31, 1 BC." 252 (let* ((current-time-origin 719162) 253 ;; (timezone-absolute-from-gregorian 1 1 1970) 254 (days (- date current-time-origin)) 255 (seconds-per-day (float 86400)) 256 (seconds (+ seconds (* days seconds-per-day))) 257 (current-time-arithmetic-base (float 65536)) 258 (hi (floor (/ seconds current-time-arithmetic-base))) 259 (hibase (* hi current-time-arithmetic-base)) 260 (lo (floor (- seconds hibase)))) 261 (and (< (abs (- seconds (+ hibase lo))) 2) ;; Check for integer overflow. 262 (cons hi lo)))) 263 264(defun timezone-time-zone-from-absolute (date seconds) 265 "Compute the local time zone for DATE at time SECONDS after midnight. 266Return a list in the same format as current-time-zone's result, 267or nil if the local time zone could not be computed. 268DATE is the number of days elapsed since the (imaginary) 269Gregorian date Sunday, December 31, 1 BC." 270 (and (fboundp 'current-time-zone) 271 (let ((utc-time (timezone-time-from-absolute date seconds))) 272 (and utc-time 273 (let ((zone (current-time-zone utc-time))) 274 (and (car zone) zone)))))) 275 276(defun timezone-fix-time (date local timezone) 277 "Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector. 278If LOCAL is nil, it is assumed to be GMT. 279If TIMEZONE is nil, use the local time zone." 280 (let* ((date (timezone-parse-date date)) 281 (year (string-to-int (aref date 0))) 282 (year (if (< year 100) (+ year 1900) year)) 283 (month (string-to-int (aref date 1))) 284 (day (string-to-int (aref date 2))) 285 (time (timezone-parse-time (aref date 3))) 286 (hour (string-to-int (aref time 0))) 287 (minute (string-to-int (aref time 1))) 288 (second (string-to-int (aref time 2))) 289 (local (or (aref date 4) local)) ;Use original if defined 290 (timezone 291 (or timezone 292 (timezone-time-zone-from-absolute 293 (timezone-absolute-from-gregorian month day year) 294 (+ second (* 60 (+ minute (* 60 hour))))))) 295 (diff (- (timezone-zone-to-minute timezone) 296 (timezone-zone-to-minute local))) 297 (minute (+ minute diff)) 298 (hour-fix (floor minute 60))) 299 (setq hour (+ hour hour-fix)) 300 (setq minute (- minute (* 60 hour-fix))) 301 ;; HOUR may be larger than 24 or smaller than 0. 302 (cond ((<= 24 hour) ;24 -> 00 303 (setq hour (- hour 24)) 304 (setq day (1+ day)) 305 (if (< (timezone-last-day-of-month month year) day) 306 (progn 307 (setq month (1+ month)) 308 (setq day 1) 309 (if (< 12 month) 310 (progn 311 (setq month 1) 312 (setq year (1+ year)) 313 )) 314 ))) 315 ((> 0 hour) 316 (setq hour (+ hour 24)) 317 (setq day (1- day)) 318 (if (> 1 day) 319 (progn 320 (setq month (1- month)) 321 (if (> 1 month) 322 (progn 323 (setq month 12) 324 (setq year (1- year)) 325 )) 326 (setq day (timezone-last-day-of-month month year)) 327 ))) 328 ) 329 (vector year month day hour minute second timezone))) 330 331;; Partly copied from Calendar program by Edward M. Reingold. 332;; Thanks a lot. 333 334(defun timezone-last-day-of-month (month year) 335 "The last day in MONTH during YEAR." 336 (if (and (= month 2) (timezone-leap-year-p year)) 337 29 338 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) 339 340(defun timezone-leap-year-p (year) 341 "Returns t if YEAR is a Gregorian leap year." 342 (or (and (zerop (% year 4)) 343 (not (zerop (% year 100)))) 344 (zerop (% year 400)))) 345 346(defun timezone-day-number (month day year) 347 "Return the day number within the year of the date month/day/year." 348 (let ((day-of-year (+ day (* 31 (1- month))))) 349 (if (> month 2) 350 (progn 351 (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) 352 (if (timezone-leap-year-p year) 353 (setq day-of-year (1+ day-of-year))))) 354 day-of-year)) 355 356(defun timezone-absolute-from-gregorian (month day year) 357 "The number of days between the Gregorian date 12/31/1 BC and month/day/year. 358The Gregorian date Sunday, December 31, 1 BC is imaginary." 359 (+ (timezone-day-number month day year);; Days this year 360 (* 365 (1- year));; + Days in prior years 361 (/ (1- year) 4);; + Julian leap years 362 (- (/ (1- year) 100));; - century years 363 (/ (1- year) 400)));; + Gregorian leap years 364 365;;; timezone.el ends here 366