mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-24 10:38:38 +00:00
*** empty log message ***
This commit is contained in:
parent
553624bf48
commit
d51c3cdaa5
226
lisp/timezone.el
226
lisp/timezone.el
@ -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 @@ Optional 2nd argument TIMEZONE specifies a timezone to be represented in."
|
||||
(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 @@ Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM."
|
||||
;; 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 @@ Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM."
|
||||
;; 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-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-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-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 @@ Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM."
|
||||
(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
|
||||
|
Loading…
Reference in New Issue
Block a user