/[emacs]/emacs/lisp/calendar/parse-time.el
ViewVC logotype

Diff of /emacs/lisp/calendar/parse-time.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by eliz, Fri Feb 1 18:13:49 2002 UTC revision 1.6.4.1 by miles, Fri Apr 4 06:20:16 2003 UTC
# Line 32  Line 32 
32  ;; `parse-time-string' parses a time in a string and returns a list of 9  ;; `parse-time-string' parses a time in a string and returns a list of 9
33  ;; values, just like `decode-time', where unspecified elements in the  ;; values, just like `decode-time', where unspecified elements in the
34  ;; string are returned as nil.  `encode-time' may be applied on these  ;; string are returned as nil.  `encode-time' may be applied on these
35  ;; valuse to obtain an internal time value.  ;; values to obtain an internal time value.
36    
37  ;;; Code:  ;;; Code:
38    
# Line 42  Line 42 
42  (defvar parse-time-digits (make-vector 256 nil))  (defvar parse-time-digits (make-vector 256 nil))
43    
44  ;; Byte-compiler warnings  ;; Byte-compiler warnings
45  (defvar elt)  (defvar parse-time-elt)
46  (defvar val)  (defvar parse-time-val)
47    
48  (unless (aref parse-time-digits ?0)  (unless (aref parse-time-digits ?0)
49    (loop for i from ?0 to ?9    (loop for i from ?0 to ?9
# Line 132  Line 132 
132      ((4) parse-time-months)      ((4) parse-time-months)
133      ((5) (100 4038))      ((5) (100 4038))
134      ((2 1 0)      ((2 1 0)
135       ,#'(lambda () (and (stringp elt)       ,#'(lambda () (and (stringp parse-time-elt)
136                          (= (length elt) 8)                          (= (length parse-time-elt) 8)
137                          (= (aref elt 2) ?:)                          (= (aref parse-time-elt 2) ?:)
138                          (= (aref elt 5) ?:)))                          (= (aref parse-time-elt 5) ?:)))
139       [0 2] [3 5] [6 8])       [0 2] [3 5] [6 8])
140      ((8 7) parse-time-zoneinfo      ((8 7) parse-time-zoneinfo
141       ,#'(lambda () (car val))       ,#'(lambda () (car parse-time-val))
142       ,#'(lambda () (cadr val)))       ,#'(lambda () (cadr parse-time-val)))
143      ((8)      ((8)
144       ,#'(lambda ()       ,#'(lambda ()
145            (and (stringp elt)            (and (stringp parse-time-elt)
146                 (= 5 (length elt))                 (= 5 (length parse-time-elt))
147                 (or (= (aref elt 0) ?+) (= (aref elt 0) ?-))))                 (or (= (aref parse-time-elt 0) ?+)
148       ,#'(lambda () (* 60 (+ (parse-integer elt 3 5)                     (= (aref parse-time-elt 0) ?-))))
149                              (* 60 (parse-integer elt 1 3)))       ,#'(lambda () (* 60 (+ (parse-integer parse-time-elt 3 5)
150                        (if (= (aref elt 0) ?-) -1 1))))                              (* 60 (parse-integer parse-time-elt 1 3)))
151                          (if (= (aref parse-time-elt 0) ?-) -1 1))))
152      ((5 4 3)      ((5 4 3)
153       ,#'(lambda () (and (stringp elt)       ,#'(lambda () (and (stringp parse-time-elt)
154                          (= (length elt) 10)                          (= (length parse-time-elt) 10)
155                          (= (aref elt 4) ?-)                          (= (aref parse-time-elt 4) ?-)
156                          (= (aref elt 7) ?-)))                          (= (aref parse-time-elt 7) ?-)))
157       [0 4] [5 7] [8 10])       [0 4] [5 7] [8 10])
158      ((2 1 0)      ((2 1 0)
159       ,#'(lambda () (and (stringp elt) (= (length elt) 5) (= (aref elt 2) ?:)))       ,#'(lambda () (and (stringp parse-time-elt)
160                            (= (length parse-time-elt) 5)
161                            (= (aref parse-time-elt 2) ?:)))
162       [0 2] [3 5] ,#'(lambda () 0))       [0 2] [3 5] ,#'(lambda () 0))
163      ((2 1 0)      ((2 1 0)
164       ,#'(lambda () (and (stringp elt)       ,#'(lambda () (and (stringp parse-time-elt)
165                          (= (length elt) 4)                          (= (length parse-time-elt) 4)
166                          (= (aref elt 1) ?:)))                          (= (aref parse-time-elt 1) ?:)))
167       [0 1] [2 4] ,#'(lambda () 0))       [0 1] [2 4] ,#'(lambda () 0))
168      ((2 1 0)      ((2 1 0)
169       ,#'(lambda () (and (stringp elt)       ,#'(lambda () (and (stringp parse-time-elt)
170                          (= (length elt) 7)                          (= (length parse-time-elt) 7)
171                          (= (aref elt 1) ?:)))                          (= (aref parse-time-elt 1) ?:)))
172       [0 1] [2 4] [5 7])       [0 1] [2 4] [5 7])
173      ((5) (50 110) ,#'(lambda () (+ 1900 elt)))      ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt)))
174      ((5) (0 49) ,#'(lambda () (+ 2000 elt))))      ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt))))
175    "(slots predicate extractor...)")    "(slots predicate extractor...)")
176    
177  (defun parse-time-string (string)  (defun parse-time-string (string)
# Line 178  unknown are returned as nil." Line 181  unknown are returned as nil."
181    (let ((time (list nil nil nil nil nil nil nil nil nil))    (let ((time (list nil nil nil nil nil nil nil nil nil))
182          (temp (parse-time-tokenize (downcase string))))          (temp (parse-time-tokenize (downcase string))))
183      (while temp      (while temp
184        (let ((elt (pop temp))        (let ((parse-time-elt (pop temp))
185              (rules parse-time-rules)              (rules parse-time-rules)
186              (exit nil))              (exit nil))
187          (while (and (not (null rules)) (not exit))          (while (and (not (null rules)) (not exit))
188            (let* ((rule (pop rules))            (let* ((rule (pop rules))
189                   (slots (pop rule))                   (slots (pop rule))
190                   (predicate (pop rule))                   (predicate (pop rule))
191                   (val))                   (parse-time-val))
192              (when (and (not (nth (car slots) time)) ;not already set              (when (and (not (nth (car slots) time)) ;not already set
193                         (setq val (cond ((and (consp predicate)                         (setq parse-time-val (cond ((and (consp predicate)
194                                               (not (eq (car predicate)                                               (not (eq (car predicate)
195                                                        'lambda)))                                                        'lambda)))
196                                          (and (numberp elt)                                          (and (numberp parse-time-elt)
197                                               (<= (car predicate) elt)                                               (<= (car predicate) parse-time-elt)
198                                               (<= elt (cadr predicate))                                               (<= parse-time-elt (cadr predicate))
199                                               elt))                                               parse-time-elt))
200                                         ((symbolp predicate)                                         ((symbolp predicate)
201                                          (cdr (assoc elt                                          (cdr (assoc parse-time-elt
202                                                      (symbol-value predicate))))                                                      (symbol-value predicate))))
203                                         ((funcall predicate)))))                                         ((funcall predicate)))))
204                (setq exit t)                (setq exit t)
# Line 204  unknown are returned as nil." Line 207  unknown are returned as nil."
207                                      (let ((this (pop rule)))                                      (let ((this (pop rule)))
208                                        (if (vectorp this)                                        (if (vectorp this)
209                                            (parse-integer                                            (parse-integer
210                                             elt (aref this 0) (aref this 1))                                             parse-time-elt
211                                               (aref this 0) (aref this 1))
212                                          (funcall this))))))                                          (funcall this))))))
213                    (rplaca (nthcdr (pop slots) time) (or new-val val)))))))))                    (rplaca (nthcdr (pop slots) time)
214                              (or new-val parse-time-val)))))))))
215      time))      time))
216    
217  (provide 'parse-time)  (provide 'parse-time)

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.6.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26