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 |
|
|
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 |
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) |
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) |
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) |