This commit was generated by cvs2svn to compensate for changes in r5444,

[elisp/gnus.git-] / lisp / parse-time.el

diff --git a/lisp/parse-time.el b/lisp/parse-time.el
index 038541c..e25abbb 100644 (file)
--- a/lisp/parse-time.el
+++ b/lisp/parse-time.el
@@ -38,8 +38,10 @@
 
 (eval-when-compile (require 'cl))              ;and ah ain't kiddin' 'bout it
 
-(defvar parse-time-syntax (make-vector 256 nil))
-(defvar parse-time-digits (make-vector 256 nil))
+(put 'parse-time-syntax 'char-table-extra-slots 0)
+
+(defvar parse-time-syntax (make-char-table 'parse-time-syntax))
+(defvar parse-time-digits (make-char-table 'parse-time-syntax))
 
 ;; Byte-compiler warnings
 (defvar elt)
@@ -47,18 +49,18 @@
 
 (unless (aref parse-time-digits ?0)
   (loop for i from ?0 to ?9
-       do (aset parse-time-digits i (- i ?0))))
+       do (set-char-table-range parse-time-digits i (- i ?0))))
 
 (unless (aref parse-time-syntax ?0)
   (loop for i from ?0 to ?9
-       do (aset parse-time-syntax i ?0))
+       do (set-char-table-range parse-time-syntax i ?0))
   (loop for i from ?A to ?Z
-       do (aset parse-time-syntax i ?A))
+       do (set-char-table-range parse-time-syntax i ?A))
   (loop for i from ?a to ?z
-       do (aset parse-time-syntax i ?a))
-  (aset parse-time-syntax ?+ 1)
-  (aset parse-time-syntax ?- -1)
-  (aset parse-time-syntax ?: ?d)
+       do (set-char-table-range parse-time-syntax i ?a))
+  (set-char-table-range parse-time-syntax ?+ 1)
+  (set-char-table-range parse-time-syntax ?- -1)
+  (set-char-table-range parse-time-syntax ?: ?d)
   )
 
 (defsubst digit-char-p (char)
@@ -87,8 +89,7 @@
          (setq integer (+ (* integer 10) digit)
                index (1+ index)))
        (if (/= index end)
-           (signal 'parse-error `("not an integer"
-                                  ,(substring string (or start 0) end)))
+           (signal 'parse-error `("not an integer" ,(substring string (or start 0) end)))
          (* sign integer))))))
 
 (defun parse-time-tokenize (string)
@@ -113,17 +114,17 @@
                list)))
     (nreverse list)))
 
-(defvar parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3)
-                           ("apr" . 4) ("may" . 5) ("jun" . 6)
-                           ("jul" . 7) ("aug" . 8) ("sep" . 9)
-                           ("oct" . 10) ("nov" . 11) ("dec" . 12)))
-(defvar parse-time-weekdays '(("sun" . 0) ("mon" . 1) ("tue" . 2)
-                             ("wed" . 3) ("thu" . 4) ("fri" . 5) ("sat" . 6)))
-(defvar parse-time-zoneinfo `(("z" 0) ("ut" 0) ("gmt" 0)
-                             ("pst" ,(* -8 3600)) ("pdt" ,(* -7 3600) t)
-                             ("mst" ,(* -7 3600)) ("mdt" ,(* -6 3600) t)
-                             ("cst" ,(* -6 3600)) ("cdt" ,(* -5 3600) t)
-                             ("est" ,(* -5 3600)) ("edt" ,(* -4 3600) t))
+(defvar parse-time-months '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3)
+                           ("Apr" . 4) ("May" . 5) ("Jun" . 6)
+                           ("Jul" . 7) ("Aug" . 8) ("Sep" . 9)
+                           ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)))
+(defvar parse-time-weekdays '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2)
+                             ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6)))
+(defvar parse-time-zoneinfo `(("Z" 0) ("UT" 0) ("GMT" 0)
+                             ("PST" ,(* -8 3600)) ("PDT" ,(* -7 3600) t)
+                             ("MST" ,(* -7 3600)) ("MDT" ,(* -6 3600) t)
+                             ("CST" ,(* -6 3600)) ("CDT" ,(* -5 3600) t)
+                             ("EST" ,(* -5 3600)) ("EDT" ,(* -4 3600) t))
   "(zoneinfo seconds-off daylight-savings-time-p)")
 
 (defvar parse-time-rules
@@ -149,24 +150,11 @@
                            (* 60 (parse-integer elt 1 3)))
                      (if (= (aref elt 0) ?-) -1 1))))
     ((5 4 3)
-     ,#'(lambda () (and (stringp elt)
-                       (= (length elt) 10)
-                       (= (aref elt 4) ?-)
-                       (= (aref elt 7) ?-)))
+     ,#'(lambda () (and (stringp elt) (= (length elt) 10) (= (aref elt 4) ?-) (= (aref elt 7) ?-)))
      [0 4] [5 7] [8 10])
-    ((2 1 0)
+    ((2 1)
      ,#'(lambda () (and (stringp elt) (= (length elt) 5) (= (aref elt 2) ?:)))
-     [0 2] [3 5] ,#'(lambda () 0))
-    ((2 1 0)
-     ,#'(lambda () (and (stringp elt)
-                       (= (length elt) 4)
-                       (= (aref elt 1) ?:)))
-     [0 1] [2 4] ,#'(lambda () 0))
-    ((2 1 0)
-     ,#'(lambda () (and (stringp elt)
-                       (= (length elt) 7)
-                       (= (aref elt 1) ?:)))
-     [0 1] [2 4] [5 7])
+     [0 2] [3 5])
     ((5) (70 99) ,#'(lambda () (+ 1900 elt))))
   "(slots predicate extractor...)")
 
@@ -174,8 +162,8 @@
   "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
 The values are identical to those of `decode-time', but any values that are
 unknown are returned as nil."
-  (let ((time (list nil nil nil nil nil nil nil nil nil))
-       (temp (parse-time-tokenize (downcase string))))
+  (let ((time (list nil nil nil nil nil nil nil nil nil nil))
+       (temp (parse-time-tokenize string)))
     (while temp
       (let ((elt (pop temp))
            (rules parse-time-rules)
@@ -185,27 +173,25 @@ unknown are returned as nil."
                 (slots (pop rule))
                 (predicate (pop rule))
                 (val))
-           (when (and (not (nth (car slots) time)) ;not already set
-                      (setq val (cond ((and (consp predicate)
-                                            (not (eq (car predicate)
-                                                     'lambda)))
-                                       (and (numberp elt)
-                                            (<= (car predicate) elt)
-                                            (<= elt (cadr predicate))
-                                            elt))
-                                      ((symbolp predicate)
-                                       (cdr (assoc elt
-                                                   (symbol-value predicate))))
-                                      ((funcall predicate)))))
-             (setq exit t)
-             (while slots
-               (let ((new-val (and rule
-                                   (let ((this (pop rule)))
-                                     (if (vectorp this)
-                                         (parse-integer
-                                          elt (aref this 0) (aref this 1))
-                                       (funcall this))))))
-                 (rplaca (nthcdr (pop slots) time) (or new-val val)))))))))
+           (if (and (not (nth (car slots) time)) ;not already set
+                    (setq val (cond ((and (consp predicate)
+                                          (not (eq (car predicate) 'lambda)))
+                                     (and (numberp elt)
+                                          (<= (car predicate) elt)
+                                          (<= elt (cadr predicate))
+                                          elt))
+                                    ((symbolp predicate)
+                                     (cdr (assoc elt (symbol-value predicate))))
+                                    ((funcall predicate)))))
+               (progn
+                 (setq exit t)
+                 (while slots
+                   (let ((new-val (and rule
+                                       (let ((this (pop rule)))
+                                         (if (vectorp this)
+                                             (parse-integer elt (aref this 0) (aref this 1))
+                                           (funcall this))))))
+                     (rplaca (nthcdr (pop slots) time) (or new-val val))))))))))
     time))
 
 (provide 'parse-time)