X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a184d9bf2f49589e62e86311f7256314979eebd3..b336bfcdf39f1e4d35bff4a7bd01d3b4bca8f516:/lisp/timezone.el diff --git a/lisp/timezone.el b/lisp/timezone.el index 3de071a4a7..2fbcbd58b8 100644 --- a/lisp/timezone.el +++ b/lisp/timezone.el @@ -1,6 +1,7 @@ ;;; timezone.el --- time zone package for GNU Emacs -;; Copyright (C) 1990, 1991, 1992, 1993, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1992, 1993, 1996, 1999, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Masanobu Umeda ;; Maintainer: umerin@mse.kyutech.ac.jp @@ -8,10 +9,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,13 +20,11 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . -;;; Code: +;;; Commentary: -(provide 'timezone) +;;; Code: (defvar timezone-world-timezones '(("PST" . -800) @@ -122,7 +121,10 @@ Optional argument TIMEZONE specifies a time zone." (defun timezone-parse-date (date) "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE]. -19 is prepended to year if necessary. Timezone may be nil if nothing. +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. + Understands the following styles: (1) 14 Apr 89 03:20[:12] [GMT] (2) Fri, 17 Mar 89 4:01[:33] [GMT] @@ -132,109 +134,113 @@ Understands the following styles: (6) Thu, 11 Apr 16:17:12 91 [MET] (7) Mon, 6 Jul 16:47:20 T 1992 [MET] (8) 1996-06-24 21:13:12 [GMT] - (9) 1996-06-24 21:13-ZONE" - ;; Get rid of any text properties. + (9) 1996-06-24 21:13-ZONE + (10) 19960624T211312" + ;; Get rid of any text properties. (and (stringp date) (or (text-properties-at 0 date) - (next-property-change 0 date)) + (next-property-change 0 date)) (setq date (copy-sequence date)) (set-text-properties 0 (length date) nil date)) (let ((date (or date "")) - (year nil) - (month nil) - (day nil) - (time nil) - (zone nil)) ;This may be nil. + (year nil) + (month nil) + (day nil) + (time nil) + (zone nil)) ;This may be nil. (cond ((string-match - "\\([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]+" 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]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+\\)[ \t]*\\([-+a-zA-Z0-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]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)" date) - ;; Styles: (8) without timezone. - (setq year 1 month 2 day 3 time 4 zone nil)) - ) - (if year - (progn - (setq year - (substring date (match-beginning year) (match-end year))) - ;; It is now Dec 1992. 8 years before the end of the World. - (if (= (length year) 1) - (setq year (concat "190" (substring year -1 nil))) - (if (< (length year) 4) - (setq year (concat "19" (substring year -2 nil))))) - (setq month - (if (= (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)))) - (if monthnum - (int-to-string monthnum) - nil)))) - (setq day - (substring date (match-beginning day) (match-end day))) - (setq time - (substring date (match-beginning time) (match-end time))))) - (if zone - (setq zone - (substring date (match-beginning zone) (match-end zone)))) + "\\([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)) + ) + + (when year + (setq year (match-string year date)) + ;; Guess ambiguous years. Assume years < 69 don't predate the + ;; Unix Epoch, so are 2000+. Three-digit years are assumed to + ;; be relative to 1900. + (when (< (length year) 4) + (let ((y (string-to-number year))) + (when (< y 69) + (setq y (+ y 100))) + (setq year (int-to-string (+ 1900 y))))) + (setq month + (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))))) + (setq day (match-string day date)) + (setq time (match-string time date))) + (when zone (setq zone (match-string zone date))) ;; Return a vector. (if (and year month) - (vector year month day time zone) - (vector "0" "0" "0" "0" nil)) - )) + (vector year month day time zone) + (vector "0" "0" "0" "0" nil)))) (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 "")) - (hour nil) - (minute nil) - (second nil)) + hour minute second) (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time) ;; HH:MM:SS (setq hour 1 minute 2 second 3)) @@ -250,20 +256,16 @@ Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM." ) ;; Return [hour minute second] (vector - (if hour - (substring time (match-beginning hour) (match-end hour)) "0") - (if minute - (substring time (match-beginning minute) (match-end minute)) "0") - (if second - (substring time (match-beginning second) (match-end second)) "0")) - )) + (if hour (match-string hour time) "0") + (if minute (match-string minute time) "0") + (if second (match-string second time) "0")))) ;; Miscellaneous (defun timezone-zone-to-minute (timezone) "Translate TIMEZONE to an integer minute offset from GMT. -TIMEZONE can be a cons cell containing the output of current-time-zone, +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) @@ -275,7 +277,7 @@ or an integer of the form +-HHMM, or a time zone name." ;; +900 timezone)) (if (stringp timezone) - (setq timezone (string-to-int timezone))) + (setq timezone (string-to-number timezone))) ;; Taking account of minute in timezone. ;; HHMM -> MM (let* ((abszone (abs timezone)) @@ -285,7 +287,7 @@ or an integer of the form +-HHMM, or a time zone name." (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, +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." @@ -303,7 +305,7 @@ Gregorian date Sunday, December 31, 1 BC." (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, +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." @@ -318,18 +320,20 @@ Gregorian date Sunday, December 31, 1 BC." 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 (cond ((< year 50) + (year (string-to-number (aref date 0))) + (year (cond ((< year 69) (+ year 2000)) ((< year 100) (+ year 1900)) + ((< year 1000) ; possible 3-digit years. + (+ year 1900)) (t year))) - (month (string-to-int (aref date 1))) - (day (string-to-int (aref date 2))) + (month (string-to-number (aref date 1))) + (day (string-to-number (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))) + (hour (string-to-number (aref time 0))) + (minute (string-to-number (aref time 1))) + (second (string-to-number (aref time 2))) (local (or (aref date 4) local)) ;Use original if defined (timezone (or timezone @@ -346,30 +350,21 @@ If TIMEZONE is nil, use the local time zone." (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)) - )) - ))) + (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))))) ((> 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)) - ))) - ) + (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))))) (vector year month day hour minute second timezone))) ;; Partly copied from Calendar program by Edward M. Reingold. @@ -382,7 +377,7 @@ If TIMEZONE is nil, use the local time zone." (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) (defun timezone-leap-year-p (year) - "Returns t if YEAR is a Gregorian leap year." + "Return t if YEAR is a Gregorian leap year." (or (and (zerop (% year 4)) (not (zerop (% year 100)))) (zerop (% year 400)))) @@ -406,4 +401,7 @@ The Gregorian date Sunday, December 31, 1 BC is imaginary." (- (/ (1- year) 100));; - century years (/ (1- year) 400)));; + Gregorian leap years +(provide 'timezone) + +;; arch-tag: e23d5bc6-f32d-48ba-8996-323e9d654b3f ;;; timezone.el ends here