# HG changeset patch # User Richard M. Stallman # Date 739271505 0 # Node ID ddc7da3f66d1c3ad2ee1f67df7ce3c2a91f34071 # Parent b37b09c0b43df36ff89dd22487f3f9286abdc86b *** empty log message *** diff -r b37b09c0b43d -r ddc7da3f66d1 lisp/timezone.el --- a/lisp/timezone.el Sat Jun 05 08:39:42 1993 +0000 +++ b/lisp/timezone.el Sat Jun 05 09:11:45 1993 +0000 @@ -49,7 +49,10 @@ ("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)) - "*Time differentials of timezone from GMT in hour.") + "*Time differentials of timezone from GMT in +-HHMM form. +This list is obsolescent, and is present only for backwards compatibility, +because time zone names are ambiguous in practice. +Use `current-time-zone' instead.") (defvar timezone-months-assoc '(("JAN" . 1)("FEB" . 2)("MAR" . 3) @@ -60,46 +63,24 @@ (defun timezone-make-date-arpa-standard (date &optional local timezone) "Convert DATE to an arpanet standard date. -Optional 1st argumetn LOCAL specifies the default local timezone of the DATE. -Optional 2nd argument TIMEZONE specifies a timezone to be represented in." - (let* ((date (timezone-parse-date date)) - (year (string-to-int (aref date 0))) - (month (string-to-int (aref date 1))) - (day (string-to-int (aref date 2))) - (time (timezone-parse-time (aref date 3))) - (hour (string-to-int (aref time 0))) - (minute (string-to-int (aref time 1))) - (second (string-to-int (aref time 2))) - (local (or (aref date 4) local)) ;Use original if defined - (timezone (or timezone local)) - (diff (- (timezone-zone-to-minute timezone) - (timezone-zone-to-minute local))) - (new (timezone-fix-time year month day - hour (+ minute diff) second))) +Optional 1st argument LOCAL specifies the default local timezone of the DATE; +if nil, GMT is assumed. +Optional 2nd argument TIMEZONE specifies a time zone to be represented in; +if nil, the local time zone is assumed." + (let ((new (timezone-fix-time date local timezone))) (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)) - timezone) + (aref new 6)) )) (defun timezone-make-date-sortable (date &optional local timezone) "Convert DATE to a sortable date string. -Optional 1st argumetn LOCAL specifies the default local timezone of the DATE. -Optional 2nd argument TIMEZONE specifies a timezone to be represented in." - (let* ((date (timezone-parse-date date)) - (year (string-to-int (aref date 0))) - (month (string-to-int (aref date 1))) - (day (string-to-int (aref date 2))) - (time (timezone-parse-time (aref date 3))) - (hour (string-to-int (aref time 0))) - (minute (string-to-int (aref time 1))) - (second (string-to-int (aref time 2))) - (local (or (aref date 4) local)) ;Use original if defined - (timezone (or timezone local)) - (diff (- (timezone-zone-to-minute timezone) - (timezone-zone-to-minute local))) - (new (timezone-fix-time year month day - hour (+ minute diff) second))) +Optional 1st argument LOCAL specifies the default local timezone of the DATE; +if nil, GMT is assumed. +Optional 2nd argument TIMEZONE specifies a timezone to be represented in; +if nil, the local time zone is assumed." + (let ((new (timezone-fix-time date local timezone))) (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2) (timezone-make-time-string (aref new 3) (aref new 4) (aref new 5))) @@ -113,21 +94,24 @@ (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." - (format "%02d %s %4d %s%s" - day - (capitalize (car (rassq month timezone-months-assoc))) - ;;(- year (* (/ year 100) 100)) ;1990 -> 90 - (if (< year 100) (+ year 1900) year) ;90->1990 - time - (if timezone (concat " " timezone) "") - )) + (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))) (defun timezone-make-sortable-date (year month day time) "Make sortable date string from YEAR, MONTH, DAY, and TIME." (format "%4d%02d%02d%s" - ;;(- year (* (/ year 100) 100)) ;1990 -> 90 - (if (< year 100) (+ year 1900) year) ;90->1990 - month day time)) + year month day time)) (defun timezone-make-time-string (hour minute second) "Make time string from HOUR, MINUTE, and SECOND." @@ -233,8 +217,13 @@ ;; Miscellaneous (defun timezone-zone-to-minute (timezone) - "Translate TIMEZONE (in zone name or integer) to integer minute." - (if timezone + "Translate TIMEZONE to an integer minute offset from GMT. +TIMEZONE can be a cons cell containing the output of current-time-zone, +or an integer of the form +-HHMM, or a time zone name." + (cond + ((consp timezone) + (/ (car timezone) 60)) + (timezone (progn (setq timezone (or (cdr (assoc (upcase timezone) timezone-world-timezones)) @@ -249,49 +238,99 @@ ;; by eggert@twinsun.com (Paul Eggert) (let* ((abszone (max timezone (- timezone))) (minutes (+ (* 60 (/ abszone 100)) (% abszone 100)))) - (if (< timezone 0) (- minutes) minutes))) - 0)) + (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. +Return a list suitable as an argument to current-time-zone, +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." + (let* ((current-time-origin 719162) + ;; (timezone-absolute-from-gregorian 1 1 1970) + (days (- date current-time-origin)) + (seconds-per-day (float 86400)) + (seconds (+ seconds (* days seconds-per-day))) + (current-time-arithmetic-base (float 65536)) + (hi (floor (/ seconds current-time-arithmetic-base))) + (hibase (* hi current-time-arithmetic-base)) + (lo (floor (- seconds hibase)))) + (and (< (abs (- seconds (+ hibase lo))) 2) ;; Check for integer overflow. + (cons hi lo)))) -(defun timezone-fix-time (year month day hour minute second) - "Fix date and time." - ;; MINUTE may be larger than 60 or smaller than -60. - (let ((hour-fix - (if (< minute 0) +(defun timezone-time-zone-from-absolute (date seconds) + "Compute the local time zone for DATE at time SECONDS after midnight. +Return a list in the same format as current-time-zone's result, +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) + "Find the time represented by the string DATE (with default timezone LOCAL), +and represent it as a YY-MM-DD-HH-MM-SS-TIMEZONE vector. +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)) + (year (string-to-int (aref date 0))) + (year (if (< year 100) (+ year 1900) year)) + (month (string-to-int (aref date 1))) + (day (string-to-int (aref date 2))) + (time (timezone-parse-time (aref date 3))) + (hour (string-to-int (aref time 0))) + (minute (string-to-int (aref time 1))) + (second (string-to-int (aref time 2))) + (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)) + (hour-fix + (if (< minute 0) ;;(/ (- minute 59) 60) (/ minute 60) ;; ANSI C compliance about truncation of integer division ;; by eggert@twinsun.com (Paul Eggert) (- (/ (- 59 minute) 60)) (/ minute 60)))) (setq hour (+ hour hour-fix)) - (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)) - (if (< (timezone-last-day-of-month month year) day) - (progn - (setq month (1+ month)) - (setq day 1) - (if (< 12 month) - (progn - (setq month 1) - (setq year (1+ year)) - )) - ))) - ((> 0 hour) - (setq hour (+ hour 24)) - (setq day (1- day)) - (if (> 1 day) - (progn - (setq month (1- month)) - (if (> 1 month) - (progn - (setq month 12) - (setq year (1- year)) - )) - (setq day (timezone-last-day-of-month month year)) - ))) - ) - (vector year month day hour minute second)) + (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)) + (if (< (timezone-last-day-of-month month year) day) + (progn + (setq month (1+ month)) + (setq day 1) + (if (< 12 month) + (progn + (setq month 1) + (setq year (1+ year)) + )) + ))) + ((> 0 hour) + (setq hour (+ hour 24)) + (setq day (1- day)) + (if (> 1 day) + (progn + (setq month (1- month)) + (if (> 1 month) + (progn + (setq month 12) + (setq year (1- year)) + )) + (setq day (timezone-last-day-of-month month year)) + ))) + ) + (vector year month day hour minute second timezone))) ;; Partly copied from Calendar program by Edward M. Reingold. ;; Thanks a lot. @@ -308,4 +347,23 @@ (not (zerop (% year 100)))) (zerop (% year 400)))) +(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 + ;;; timezone.el ends here