diff options
| author | Richard M. Stallman | 1993-06-05 09:11:45 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1993-06-05 09:11:45 +0000 |
| commit | d51c3cdaa56970d43c2ebba01a8eb41af323d3ed (patch) | |
| tree | 39485341ffc9ba3b8a2b6d548812342e738929c9 | |
| parent | 553624bf48e4ac40c98cef5de995e5cef95740a3 (diff) | |
| download | emacs-d51c3cdaa56970d43c2ebba01a8eb41af323d3ed.tar.gz emacs-d51c3cdaa56970d43c2ebba01a8eb41af323d3ed.zip | |
*** empty log message ***
| -rw-r--r-- | lisp/timezone.el | 226 |
1 files changed, 142 insertions, 84 deletions
diff --git a/lisp/timezone.el b/lisp/timezone.el index c2f932b16dd..8f3335d17d9 100644 --- a/lisp/timezone.el +++ b/lisp/timezone.el | |||
| @@ -49,7 +49,10 @@ | |||
| 49 | ("GMT-4" . -400) ("GMT-5" . -500) ("GMT-6" . -600) | 49 | ("GMT-4" . -400) ("GMT-5" . -500) ("GMT-6" . -600) |
| 50 | ("GMT-7" . -700) ("GMT-8" . -800) ("GMT-9" . -900) | 50 | ("GMT-7" . -700) ("GMT-8" . -800) ("GMT-9" . -900) |
| 51 | ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200)) | 51 | ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200)) |
| 52 | "*Time differentials of timezone from GMT in hour.") | 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.") | ||
| 53 | 56 | ||
| 54 | (defvar timezone-months-assoc | 57 | (defvar timezone-months-assoc |
| 55 | '(("JAN" . 1)("FEB" . 2)("MAR" . 3) | 58 | '(("JAN" . 1)("FEB" . 2)("MAR" . 3) |
| @@ -60,46 +63,24 @@ | |||
| 60 | 63 | ||
| 61 | (defun timezone-make-date-arpa-standard (date &optional local timezone) | 64 | (defun timezone-make-date-arpa-standard (date &optional local timezone) |
| 62 | "Convert DATE to an arpanet standard date. | 65 | "Convert DATE to an arpanet standard date. |
| 63 | Optional 1st argumetn LOCAL specifies the default local timezone of the DATE. | 66 | Optional 1st argument LOCAL specifies the default local timezone of the DATE; |
| 64 | Optional 2nd argument TIMEZONE specifies a timezone to be represented in." | 67 | if nil, GMT is assumed. |
| 65 | (let* ((date (timezone-parse-date date)) | 68 | Optional 2nd argument TIMEZONE specifies a time zone to be represented in; |
| 66 | (year (string-to-int (aref date 0))) | 69 | if nil, the local time zone is assumed." |
| 67 | (month (string-to-int (aref date 1))) | 70 | (let ((new (timezone-fix-time date local timezone))) |
| 68 | (day (string-to-int (aref date 2))) | ||
| 69 | (time (timezone-parse-time (aref date 3))) | ||
| 70 | (hour (string-to-int (aref time 0))) | ||
| 71 | (minute (string-to-int (aref time 1))) | ||
| 72 | (second (string-to-int (aref time 2))) | ||
| 73 | (local (or (aref date 4) local)) ;Use original if defined | ||
| 74 | (timezone (or timezone local)) | ||
| 75 | (diff (- (timezone-zone-to-minute timezone) | ||
| 76 | (timezone-zone-to-minute local))) | ||
| 77 | (new (timezone-fix-time year month day | ||
| 78 | hour (+ minute diff) second))) | ||
| 79 | (timezone-make-arpa-date (aref new 0) (aref new 1) (aref new 2) | 71 | (timezone-make-arpa-date (aref new 0) (aref new 1) (aref new 2) |
| 80 | (timezone-make-time-string | 72 | (timezone-make-time-string |
| 81 | (aref new 3) (aref new 4) (aref new 5)) | 73 | (aref new 3) (aref new 4) (aref new 5)) |
| 82 | timezone) | 74 | (aref new 6)) |
| 83 | )) | 75 | )) |
| 84 | 76 | ||
| 85 | (defun timezone-make-date-sortable (date &optional local timezone) | 77 | (defun timezone-make-date-sortable (date &optional local timezone) |
| 86 | "Convert DATE to a sortable date string. | 78 | "Convert DATE to a sortable date string. |
| 87 | Optional 1st argumetn LOCAL specifies the default local timezone of the DATE. | 79 | Optional 1st argument LOCAL specifies the default local timezone of the DATE; |
| 88 | Optional 2nd argument TIMEZONE specifies a timezone to be represented in." | 80 | if nil, GMT is assumed. |
| 89 | (let* ((date (timezone-parse-date date)) | 81 | Optional 2nd argument TIMEZONE specifies a timezone to be represented in; |
| 90 | (year (string-to-int (aref date 0))) | 82 | if nil, the local time zone is assumed." |
| 91 | (month (string-to-int (aref date 1))) | 83 | (let ((new (timezone-fix-time date local timezone))) |
| 92 | (day (string-to-int (aref date 2))) | ||
| 93 | (time (timezone-parse-time (aref date 3))) | ||
| 94 | (hour (string-to-int (aref time 0))) | ||
| 95 | (minute (string-to-int (aref time 1))) | ||
| 96 | (second (string-to-int (aref time 2))) | ||
| 97 | (local (or (aref date 4) local)) ;Use original if defined | ||
| 98 | (timezone (or timezone local)) | ||
| 99 | (diff (- (timezone-zone-to-minute timezone) | ||
| 100 | (timezone-zone-to-minute local))) | ||
| 101 | (new (timezone-fix-time year month day | ||
| 102 | hour (+ minute diff) second))) | ||
| 103 | (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2) | 84 | (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2) |
| 104 | (timezone-make-time-string | 85 | (timezone-make-time-string |
| 105 | (aref new 3) (aref new 4) (aref new 5))) | 86 | (aref new 3) (aref new 4) (aref new 5))) |
| @@ -113,21 +94,24 @@ Optional 2nd argument TIMEZONE specifies a timezone to be represented in." | |||
| 113 | (defun timezone-make-arpa-date (year month day time &optional timezone) | 94 | (defun timezone-make-arpa-date (year month day time &optional timezone) |
| 114 | "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME. | 95 | "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME. |
| 115 | Optional argument TIMEZONE specifies a time zone." | 96 | Optional argument TIMEZONE specifies a time zone." |
| 116 | (format "%02d %s %4d %s%s" | 97 | (let ((zone |
| 117 | day | 98 | (if (listp timezone) |
| 118 | (capitalize (car (rassq month timezone-months-assoc))) | 99 | (let* ((m (timezone-zone-to-minute timezone)) |
| 119 | ;;(- year (* (/ year 100) 100)) ;1990 -> 90 | 100 | (absm (if (< m 0) (- m) m))) |
| 120 | (if (< year 100) (+ year 1900) year) ;90->1990 | 101 | (format "%c%02d%02d" |
| 121 | time | 102 | (if (< m 0) ?- ?+) (/ absm 60) (% absm 60))) |
| 122 | (if timezone (concat " " timezone) "") | 103 | timezone))) |
| 123 | )) | 104 | (format "%02d %s %04d %s %s" |
| 105 | day | ||
| 106 | (capitalize (car (rassq month timezone-months-assoc))) | ||
| 107 | year | ||
| 108 | time | ||
| 109 | zone))) | ||
| 124 | 110 | ||
| 125 | (defun timezone-make-sortable-date (year month day time) | 111 | (defun timezone-make-sortable-date (year month day time) |
| 126 | "Make sortable date string from YEAR, MONTH, DAY, and TIME." | 112 | "Make sortable date string from YEAR, MONTH, DAY, and TIME." |
| 127 | (format "%4d%02d%02d%s" | 113 | (format "%4d%02d%02d%s" |
| 128 | ;;(- year (* (/ year 100) 100)) ;1990 -> 90 | 114 | year month day time)) |
| 129 | (if (< year 100) (+ year 1900) year) ;90->1990 | ||
| 130 | month day time)) | ||
| 131 | 115 | ||
| 132 | (defun timezone-make-time-string (hour minute second) | 116 | (defun timezone-make-time-string (hour minute second) |
| 133 | "Make time string from HOUR, MINUTE, and SECOND." | 117 | "Make time string from HOUR, MINUTE, and SECOND." |
| @@ -233,8 +217,13 @@ Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM." | |||
| 233 | ;; Miscellaneous | 217 | ;; Miscellaneous |
| 234 | 218 | ||
| 235 | (defun timezone-zone-to-minute (timezone) | 219 | (defun timezone-zone-to-minute (timezone) |
| 236 | "Translate TIMEZONE (in zone name or integer) to integer minute." | 220 | "Translate TIMEZONE to an integer minute offset from GMT. |
| 237 | (if timezone | 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." | ||
| 223 | (cond | ||
| 224 | ((consp timezone) | ||
| 225 | (/ (car timezone) 60)) | ||
| 226 | (timezone | ||
| 238 | (progn | 227 | (progn |
| 239 | (setq timezone | 228 | (setq timezone |
| 240 | (or (cdr (assoc (upcase timezone) timezone-world-timezones)) | 229 | (or (cdr (assoc (upcase timezone) timezone-world-timezones)) |
| @@ -249,49 +238,99 @@ Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM." | |||
| 249 | ;; by eggert@twinsun.com (Paul Eggert) | 238 | ;; by eggert@twinsun.com (Paul Eggert) |
| 250 | (let* ((abszone (max timezone (- timezone))) | 239 | (let* ((abszone (max timezone (- timezone))) |
| 251 | (minutes (+ (* 60 (/ abszone 100)) (% abszone 100)))) | 240 | (minutes (+ (* 60 (/ abszone 100)) (% abszone 100)))) |
| 252 | (if (< timezone 0) (- minutes) minutes))) | 241 | (if (< timezone 0) (- minutes) minutes)))) |
| 253 | 0)) | 242 | (t 0))) |
| 243 | |||
| 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. | ||
| 260 | (cons hi lo)))) | ||
| 254 | 261 | ||
| 255 | (defun timezone-fix-time (year month day hour minute second) | 262 | (defun timezone-time-zone-from-absolute (date seconds) |
| 256 | "Fix date and time." | 263 | "Compute the local time zone for DATE at time SECONDS after midnight. |
| 257 | ;; MINUTE may be larger than 60 or smaller than -60. | 264 | Return a list in the same format as current-time-zone's result, |
| 258 | (let ((hour-fix | 265 | or nil if the local time zone could not be computed. |
| 259 | (if (< minute 0) | 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))) | ||
| 270 | (and utc-time | ||
| 271 | (let ((zone (current-time-zone utc-time))) | ||
| 272 | (and (car zone) zone)))))) | ||
| 273 | |||
| 274 | (defun timezone-fix-time (date local timezone) | ||
| 275 | "Find the time represented by the string DATE (with default timezone LOCAL), | ||
| 276 | and represent it as a YY-MM-DD-HH-MM-SS-TIMEZONE vector. | ||
| 277 | If LOCAL is nil, it is assumed to be GMT. | ||
| 278 | If TIMEZONE is nil, use the local time zone." | ||
| 279 | (let* ((date (timezone-parse-date date)) | ||
| 280 | (year (string-to-int (aref date 0))) | ||
| 281 | (year (if (< year 100) (+ year 1900) year)) | ||
| 282 | (month (string-to-int (aref date 1))) | ||
| 283 | (day (string-to-int (aref date 2))) | ||
| 284 | (time (timezone-parse-time (aref date 3))) | ||
| 285 | (hour (string-to-int (aref time 0))) | ||
| 286 | (minute (string-to-int (aref time 1))) | ||
| 287 | (second (string-to-int (aref time 2))) | ||
| 288 | (local (or (aref date 4) local)) ;Use original if defined | ||
| 289 | (timezone | ||
| 290 | (or timezone | ||
| 291 | (timezone-time-zone-from-absolute | ||
| 292 | (timezone-absolute-from-gregorian month day year) | ||
| 293 | (+ second (* 60 (+ minute (* 60 hour))))))) | ||
| 294 | (diff (- (timezone-zone-to-minute timezone) | ||
| 295 | (timezone-zone-to-minute local))) | ||
| 296 | (minute (+ minute diff)) | ||
| 297 | (hour-fix | ||
| 298 | (if (< minute 0) | ||
| 260 | ;;(/ (- minute 59) 60) (/ minute 60) | 299 | ;;(/ (- minute 59) 60) (/ minute 60) |
| 261 | ;; ANSI C compliance about truncation of integer division | 300 | ;; ANSI C compliance about truncation of integer division |
| 262 | ;; by eggert@twinsun.com (Paul Eggert) | 301 | ;; by eggert@twinsun.com (Paul Eggert) |
| 263 | (- (/ (- 59 minute) 60)) (/ minute 60)))) | 302 | (- (/ (- 59 minute) 60)) (/ minute 60)))) |
| 264 | (setq hour (+ hour hour-fix)) | 303 | (setq hour (+ hour hour-fix)) |
| 265 | (setq minute (- minute (* 60 hour-fix)))) | 304 | (setq minute (- minute (* 60 hour-fix))) |
| 266 | ;; HOUR may be larger than 24 or smaller than 0. | 305 | ;; HOUR may be larger than 24 or smaller than 0. |
| 267 | (cond ((<= 24 hour) ;24 -> 00 | 306 | (cond ((<= 24 hour) ;24 -> 00 |
| 268 | (setq hour (- hour 24)) | 307 | (setq hour (- hour 24)) |
| 269 | (setq day (1+ day)) | 308 | (setq day (1+ day)) |
| 270 | (if (< (timezone-last-day-of-month month year) day) | 309 | (if (< (timezone-last-day-of-month month year) day) |
| 271 | (progn | 310 | (progn |
| 272 | (setq month (1+ month)) | 311 | (setq month (1+ month)) |
| 273 | (setq day 1) | 312 | (setq day 1) |
| 274 | (if (< 12 month) | 313 | (if (< 12 month) |
| 275 | (progn | 314 | (progn |
| 276 | (setq month 1) | 315 | (setq month 1) |
| 277 | (setq year (1+ year)) | 316 | (setq year (1+ year)) |
| 278 | )) | 317 | )) |
| 279 | ))) | 318 | ))) |
| 280 | ((> 0 hour) | 319 | ((> 0 hour) |
| 281 | (setq hour (+ hour 24)) | 320 | (setq hour (+ hour 24)) |
| 282 | (setq day (1- day)) | 321 | (setq day (1- day)) |
| 283 | (if (> 1 day) | 322 | (if (> 1 day) |
| 284 | (progn | 323 | (progn |
| 285 | (setq month (1- month)) | 324 | (setq month (1- month)) |
| 286 | (if (> 1 month) | 325 | (if (> 1 month) |
| 287 | (progn | 326 | (progn |
| 288 | (setq month 12) | 327 | (setq month 12) |
| 289 | (setq year (1- year)) | 328 | (setq year (1- year)) |
| 290 | )) | 329 | )) |
| 291 | (setq day (timezone-last-day-of-month month year)) | 330 | (setq day (timezone-last-day-of-month month year)) |
| 292 | ))) | 331 | ))) |
| 293 | ) | 332 | ) |
| 294 | (vector year month day hour minute second)) | 333 | (vector year month day hour minute second timezone))) |
| 295 | 334 | ||
| 296 | ;; Partly copied from Calendar program by Edward M. Reingold. | 335 | ;; Partly copied from Calendar program by Edward M. Reingold. |
| 297 | ;; Thanks a lot. | 336 | ;; Thanks a lot. |
| @@ -308,4 +347,23 @@ Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM." | |||
| 308 | (not (zerop (% year 100)))) | 347 | (not (zerop (% year 100)))) |
| 309 | (zerop (% year 400)))) | 348 | (zerop (% year 400)))) |
| 310 | 349 | ||
| 350 | (defun timezone-day-number (month day year) | ||
| 351 | "Return the day number within the year of the date month/day/year." | ||
| 352 | (let ((day-of-year (+ day (* 31 (1- month))))) | ||
| 353 | (if (> month 2) | ||
| 354 | (progn | ||
| 355 | (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) | ||
| 356 | (if (timezone-leap-year-p year) | ||
| 357 | (setq day-of-year (1+ day-of-year))))) | ||
| 358 | day-of-year)) | ||
| 359 | |||
| 360 | (defun timezone-absolute-from-gregorian (month day year) | ||
| 361 | "The number of days between the Gregorian date 12/31/1 BC and month/day/year. | ||
| 362 | The Gregorian date Sunday, December 31, 1 BC is imaginary." | ||
| 363 | (+ (timezone-day-number month day year);; Days this year | ||
| 364 | (* 365 (1- year));; + Days in prior years | ||
| 365 | (/ (1- year) 4);; + Julian leap years | ||
| 366 | (- (/ (1- year) 100));; - century years | ||
| 367 | (/ (1- year) 400)));; + Gregorian leap years | ||
| 368 | |||
| 311 | ;;; timezone.el ends here | 369 | ;;; timezone.el ends here |