X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=timezone.el;h=5e24ab7403d6a77b20a39bd206092292975a5611;hb=949cf1afa5fed82d6385182a8df585fa5fdd6432;hp=333bd9095d1c5a6f53d65900c17a3829cc7d9064;hpb=4605e992219979eb9027c6c3bca1ba0b89038fe4;p=elisp%2Fapel.git

diff --git a/timezone.el b/timezone.el
index 333bd90..5e24ab7 100644
--- a/timezone.el
+++ b/timezone.el
@@ -137,10 +137,10 @@ Understands the following styles:
  (4) 6 May 1992 1641-JST (Wednesday)
  (5) 22-AUG-1993 10:59:12.82
  (6) Thu, 11 Apr 16:17:12 91 [MET]
- (7) Mon, 6  Jul 16:47:20 T 1992 [MET]"
-  (condition-case nil
-      (progn
-  ;; Get rid of any text properties.
+ (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.
   (and (stringp date)
        (or (text-properties-at 0 date)
 	   (next-property-change 0 date))
@@ -153,6 +153,16 @@ Understands the following styles:
 	(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))
@@ -161,14 +171,6 @@ Understands the following styles:
 	   ;; Styles: (6) and (7) with timezone and buggy timezone
 	   (setq year 6 month 3 day 2 time 4 zone 7))
 	  ((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
-	    "\\([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
-	   (setq year 3 month 2 day 1 time 4 zone 5))
-	  ((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))
@@ -181,47 +183,56 @@ Understands the following styles:
 	   ;; 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)
+	    "\\([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]+\\)-\\([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) 4)
-	      ;; 2 digit years are bogus, so guess the century
-	      (let ((yr (string-to-int year)))
-		(when (>= yr 100)
-		  ;; What does a three digit year mean?
-		  (setq yr (- yr 100)))
-		(setq year (format "%d%02d"
-				   (if (< yr 70)
-				       20
-				     19)
-				   yr))))
-	  (let ((string (substring date
-				   (match-beginning month)
-				   (+ (match-beginning month) 3))))
-	    (setq month
-		  (int-to-string
-		   (cdr (assoc (upcase string) timezone-months-assoc)))))
-
-	  (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))))
+    (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.
+      (if (< (length year) 4)
+	  (let ((y (string-to-int year)))
+	    (if (< y 69)
+		(setq y (+ y 100)))
+	    (setq year (int-to-string (+ 1900 y)))))
+      (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)))))
+      (setq day (match-string day date))
+      (setq time (match-string time date)))
+    (if zone (setq zone (match-string zone date)))
     ;; Return a vector.
-    (if year
+    (if (and year month)
 	(vector year month day time zone)
-      (vector "0" "0" "0" "0" nil))
-    )
-  )
-    (t (signal 'error (list "Invalid date string" date)))))
+      (vector "0" "0" "0" "0" nil))))
 
 (defun timezone-parse-time (time)
   "Parse TIME (HH:MM:SS) and return a vector [hour minute second].
@@ -278,6 +289,15 @@ or an integer of the form +-HHMM, or a time zone name."
  	  (if (< timezone 0) (- minutes) minutes))))
      (t 0)))
 
+(defun timezone-floor (arg &optional divisor)
+  "Return the largest integer no grater than ARG.
+With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR."
+  (if (null divisor)
+      (setq divisor 1))
+  (if (< arg 0)
+      (- (/ (- divisor 1 arg) divisor))
+    (/ arg divisor)))
+
 (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',
@@ -288,37 +308,37 @@ Gregorian date Sunday, December 31, 1 BC."
 	    ;; (timezone-absolute-from-gregorian 1 1 1970)
 	 (days (- date current-time-origin))
          (days-1 (/ days 65536))
-         (days-2 (mod (/ days 256) 256))
-	 (days-3 (mod days 256))
+         (days-2 (% (/ days 256) 256))
+	 (days-3 (% days 256))
          ;; (seconds-per-day (float 86400))
 	 (seconds-per-day-1 1)
 	 (seconds-per-day-2 81)
 	 (seconds-per-day-3 128)
 	 ;; (seconds (+ seconds (* days seconds-per-day)))
 	 ;; (current-time-arithmetic-base (float 65536))
-         ;; (hi (floor (/ seconds current-time-arithmetic-base)))
+         ;; (hi (timezone-floor (/ seconds current-time-arithmetic-base)))
          ;; (hibase (* hi current-time-arithmetic-base))
-         ;; (lo (floor (- seconds hibase)))
+         ;; (lo (timezone-floor (- seconds hibase)))
 	 (seconds-1 (/ seconds 65536))
-	 (seconds-2 (mod (/ seconds 256) 256))
-	 (seconds-3 (mod seconds 256))
+	 (seconds-2 (% (/ seconds 256) 256))
+	 (seconds-3 (% seconds 256))
 	 hi lo
          r
 	 seconds-per-day*days-1
 	 seconds-per-day*days-2
 	 seconds-per-day*days-3)
     (setq r (* days-3 seconds-per-day-3)
-	  seconds-per-day*days-3 (mod r 256))
+	  seconds-per-day*days-3 (% r 256))
     (setq r (+ (/ r 256)
 	       (* days-2 seconds-per-day-3)
 	       (* days-3 seconds-per-day-2))
-	  seconds-per-day*days-2 (mod r 256))
+	  seconds-per-day*days-2 (% r 256))
     (setq seconds-per-day*days-1 (+ (/ r 256)
 				    (* days-1 seconds-per-day-3)
 				    (* (/ days 256) seconds-per-day-2)
 				    (* days seconds-per-day-1)))
     (setq r (+ seconds-2 seconds-per-day*days-2)
-	  seconds-2 (mod r 256)
+	  seconds-2 (% r 256)
 	  seconds-1 (+ seconds-1 (/ r 256)))
     (setq lo (+ (* seconds-2 256)
 		seconds-3 seconds-per-day*days-3))
@@ -409,7 +429,7 @@ If TIMEZONE is nil, use the local time zone."
 	 (diff   (- (timezone-zone-to-minute timezone)
 		    (timezone-zone-to-minute local)))
 	 (minute (+ minute diff))
-	 (hour-fix (floor minute 60)))
+	 (hour-fix (timezone-floor minute 60)))
     (setq hour (+ hour hour-fix))
     (setq minute (- minute (* 60 hour-fix)))
     ;; HOUR may be larger than 24 or smaller than 0.