Commit | Line | Data |
---|---|---|
715a2ca2 | 1 | ;;; parse-time.el --- parsing time strings |
eec82323 | 2 | |
ba318903 | 3 | ;; Copyright (C) 1996, 2000-2014 Free Software Foundation, Inc. |
eec82323 | 4 | |
a893064d | 5 | ;; Author: Erik Naggum <erik@naggum.no> |
eec82323 LMI |
6 | ;; Keywords: util |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
2ed66575 | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
eec82323 | 11 | ;; it under the terms of the GNU General Public License as published by |
2ed66575 GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
eec82323 LMI |
14 | |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
2ed66575 | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
eec82323 LMI |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; With the introduction of the `encode-time', `decode-time', and | |
26 | ;; `format-time-string' functions, dealing with time became simpler in | |
27 | ;; Emacs. However, parsing time strings is still largely a matter of | |
28 | ;; heuristics and no common interface has been designed. | |
29 | ||
30 | ;; `parse-time-string' parses a time in a string and returns a list of 9 | |
31 | ;; values, just like `decode-time', where unspecified elements in the | |
32 | ;; string are returned as nil. `encode-time' may be applied on these | |
183ca06e | 33 | ;; values to obtain an internal time value. |
eec82323 LMI |
34 | |
35 | ;;; Code: | |
36 | ||
a464a6c7 | 37 | (eval-when-compile (require 'cl-lib)) |
eec82323 | 38 | |
16409b0b | 39 | (defvar parse-time-digits (make-vector 256 nil)) |
eec82323 LMI |
40 | |
41 | ;; Byte-compiler warnings | |
183ca06e RS |
42 | (defvar parse-time-elt) |
43 | (defvar parse-time-val) | |
eec82323 LMI |
44 | |
45 | (unless (aref parse-time-digits ?0) | |
a464a6c7 SM |
46 | (cl-loop for i from ?0 to ?9 |
47 | do (aset parse-time-digits i (- i ?0)))) | |
eec82323 | 48 | |
eec82323 LMI |
49 | (defsubst digit-char-p (char) |
50 | (aref parse-time-digits char)) | |
51 | ||
52 | (defsubst parse-time-string-chars (char) | |
81b1f9c9 CY |
53 | (save-match-data |
54 | (let (case-fold-search str) | |
55 | (cond ((eq char ?+) 1) | |
56 | ((eq char ?-) -1) | |
57 | ((eq char ?:) ?d) | |
58 | ((string-match "[[:upper:]]" (setq str (string char))) ?A) | |
59 | ((string-match "[[:lower:]]" str) ?a) | |
60 | ((string-match "[[:digit:]]" str) ?0))))) | |
eec82323 LMI |
61 | |
62 | (put 'parse-error 'error-conditions '(parse-error error)) | |
63 | (put 'parse-error 'error-message "Parsing error") | |
64 | ||
65 | (defsubst parse-integer (string &optional start end) | |
66 | "[CL] Parse and return the integer in STRING, or nil if none." | |
67 | (let ((integer 0) | |
68 | (digit 0) | |
69 | (index (or start 0)) | |
70 | (end (or end (length string)))) | |
71 | (when (< index end) | |
72 | (let ((sign (aref string index))) | |
73 | (if (or (eq sign ?+) (eq sign ?-)) | |
74 | (setq sign (parse-time-string-chars sign) | |
75 | index (1+ index)) | |
76 | (setq sign 1)) | |
77 | (while (and (< index end) | |
78 | (setq digit (digit-char-p (aref string index)))) | |
79 | (setq integer (+ (* integer 10) digit) | |
80 | index (1+ index))) | |
81 | (if (/= index end) | |
16409b0b GM |
82 | (signal 'parse-error `("not an integer" |
83 | ,(substring string (or start 0) end))) | |
eec82323 LMI |
84 | (* sign integer)))))) |
85 | ||
86 | (defun parse-time-tokenize (string) | |
87 | "Tokenize STRING into substrings." | |
88 | (let ((start nil) | |
89 | (end (length string)) | |
90 | (all-digits nil) | |
91 | (list ()) | |
92 | (index 0) | |
93 | (c nil)) | |
94 | (while (< index end) | |
a464a6c7 | 95 | (while (and (< index end) ;Skip invalid characters. |
eec82323 | 96 | (not (setq c (parse-time-string-chars (aref string index))))) |
a464a6c7 | 97 | (cl-incf index)) |
eec82323 | 98 | (setq start index all-digits (eq c ?0)) |
a464a6c7 | 99 | (while (and (< (cl-incf index) end) ;Scan valid characters. |
eec82323 LMI |
100 | (setq c (parse-time-string-chars (aref string index)))) |
101 | (setq all-digits (and all-digits (eq c ?0)))) | |
102 | (if (<= index end) | |
103 | (push (if all-digits (parse-integer string start index) | |
104 | (substring string start index)) | |
105 | list))) | |
106 | (nreverse list))) | |
107 | ||
16409b0b GM |
108 | (defvar parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3) |
109 | ("apr" . 4) ("may" . 5) ("jun" . 6) | |
110 | ("jul" . 7) ("aug" . 8) ("sep" . 9) | |
3b738106 CY |
111 | ("oct" . 10) ("nov" . 11) ("dec" . 12) |
112 | ("january" . 1) ("february" . 2) | |
113 | ("march" . 3) ("april" . 4) ("june" . 6) | |
114 | ("july" . 7) ("august" . 8) | |
115 | ("september" . 9) ("october" . 10) | |
116 | ("november" . 11) ("december" . 12))) | |
16409b0b | 117 | (defvar parse-time-weekdays '(("sun" . 0) ("mon" . 1) ("tue" . 2) |
3b738106 CY |
118 | ("wed" . 3) ("thu" . 4) ("fri" . 5) |
119 | ("sat" . 6) ("sunday" . 0) ("monday" . 1) | |
120 | ("tuesday" . 2) ("wednesday" . 3) | |
121 | ("thursday" . 4) ("friday" . 5) | |
122 | ("saturday" . 6))) | |
16409b0b GM |
123 | (defvar parse-time-zoneinfo `(("z" 0) ("ut" 0) ("gmt" 0) |
124 | ("pst" ,(* -8 3600)) ("pdt" ,(* -7 3600) t) | |
125 | ("mst" ,(* -7 3600)) ("mdt" ,(* -6 3600) t) | |
126 | ("cst" ,(* -6 3600)) ("cdt" ,(* -5 3600) t) | |
127 | ("est" ,(* -5 3600)) ("edt" ,(* -4 3600) t)) | |
eec82323 LMI |
128 | "(zoneinfo seconds-off daylight-savings-time-p)") |
129 | ||
130 | (defvar parse-time-rules | |
131 | `(((6) parse-time-weekdays) | |
132 | ((3) (1 31)) | |
133 | ((4) parse-time-months) | |
16409b0b | 134 | ((5) (100 4038)) |
eec82323 | 135 | ((2 1 0) |
183ca06e RS |
136 | ,#'(lambda () (and (stringp parse-time-elt) |
137 | (= (length parse-time-elt) 8) | |
138 | (= (aref parse-time-elt 2) ?:) | |
139 | (= (aref parse-time-elt 5) ?:))) | |
eec82323 LMI |
140 | [0 2] [3 5] [6 8]) |
141 | ((8 7) parse-time-zoneinfo | |
183ca06e RS |
142 | ,#'(lambda () (car parse-time-val)) |
143 | ,#'(lambda () (cadr parse-time-val))) | |
eec82323 LMI |
144 | ((8) |
145 | ,#'(lambda () | |
183ca06e RS |
146 | (and (stringp parse-time-elt) |
147 | (= 5 (length parse-time-elt)) | |
148 | (or (= (aref parse-time-elt 0) ?+) | |
149 | (= (aref parse-time-elt 0) ?-)))) | |
150 | ,#'(lambda () (* 60 (+ (parse-integer parse-time-elt 3 5) | |
151 | (* 60 (parse-integer parse-time-elt 1 3))) | |
152 | (if (= (aref parse-time-elt 0) ?-) -1 1)))) | |
eec82323 | 153 | ((5 4 3) |
183ca06e RS |
154 | ,#'(lambda () (and (stringp parse-time-elt) |
155 | (= (length parse-time-elt) 10) | |
156 | (= (aref parse-time-elt 4) ?-) | |
157 | (= (aref parse-time-elt 7) ?-))) | |
eec82323 | 158 | [0 4] [5 7] [8 10]) |
16409b0b | 159 | ((2 1 0) |
183ca06e RS |
160 | ,#'(lambda () (and (stringp parse-time-elt) |
161 | (= (length parse-time-elt) 5) | |
162 | (= (aref parse-time-elt 2) ?:))) | |
16409b0b GM |
163 | [0 2] [3 5] ,#'(lambda () 0)) |
164 | ((2 1 0) | |
183ca06e RS |
165 | ,#'(lambda () (and (stringp parse-time-elt) |
166 | (= (length parse-time-elt) 4) | |
167 | (= (aref parse-time-elt 1) ?:))) | |
16409b0b GM |
168 | [0 1] [2 4] ,#'(lambda () 0)) |
169 | ((2 1 0) | |
183ca06e RS |
170 | ,#'(lambda () (and (stringp parse-time-elt) |
171 | (= (length parse-time-elt) 7) | |
172 | (= (aref parse-time-elt 1) ?:))) | |
16409b0b | 173 | [0 1] [2 4] [5 7]) |
183ca06e RS |
174 | ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt))) |
175 | ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt)))) | |
eec82323 | 176 | "(slots predicate extractor...)") |
6dc3311d | 177 | ;;;###autoload(put 'parse-time-rules 'risky-local-variable t) |
eec82323 | 178 | |
ec2dc267 | 179 | ;;;###autoload |
eec82323 LMI |
180 | (defun parse-time-string (string) |
181 | "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). | |
182 | The values are identical to those of `decode-time', but any values that are | |
183 | unknown are returned as nil." | |
16409b0b GM |
184 | (let ((time (list nil nil nil nil nil nil nil nil nil)) |
185 | (temp (parse-time-tokenize (downcase string)))) | |
eec82323 | 186 | (while temp |
183ca06e | 187 | (let ((parse-time-elt (pop temp)) |
eec82323 LMI |
188 | (rules parse-time-rules) |
189 | (exit nil)) | |
1fa570af | 190 | (while (and rules (not exit)) |
eec82323 LMI |
191 | (let* ((rule (pop rules)) |
192 | (slots (pop rule)) | |
193 | (predicate (pop rule)) | |
183ca06e | 194 | (parse-time-val)) |
16409b0b | 195 | (when (and (not (nth (car slots) time)) ;not already set |
f008086f AS |
196 | (setq parse-time-val |
197 | (cond ((and (consp predicate) | |
198 | (not (eq (car predicate) | |
199 | 'lambda))) | |
200 | (and (numberp parse-time-elt) | |
201 | (<= (car predicate) parse-time-elt) | |
202 | (<= parse-time-elt (cadr predicate)) | |
203 | parse-time-elt)) | |
204 | ((symbolp predicate) | |
205 | (cdr (assoc parse-time-elt | |
206 | (symbol-value predicate)))) | |
207 | ((funcall predicate))))) | |
16409b0b GM |
208 | (setq exit t) |
209 | (while slots | |
f008086f AS |
210 | (let ((new-val (if rule |
211 | (let ((this (pop rule))) | |
212 | (if (vectorp this) | |
213 | (parse-integer | |
214 | parse-time-elt | |
215 | (aref this 0) (aref this 1)) | |
216 | (funcall this))) | |
217 | parse-time-val))) | |
218 | (rplaca (nthcdr (pop slots) time) new-val)))))))) | |
eec82323 LMI |
219 | time)) |
220 | ||
7a31038f G |
221 | (defconst parse-time-iso8601-regexp |
222 | (let* ((dash "-?") | |
223 | (colon ":?") | |
224 | (4digit "\\([0-9][0-9][0-9][0-9]\\)") | |
225 | (2digit "\\([0-9][0-9]\\)") | |
226 | (date-fullyear 4digit) | |
227 | (date-month 2digit) | |
228 | (date-mday 2digit) | |
229 | (time-hour 2digit) | |
230 | (time-minute 2digit) | |
231 | (time-second 2digit) | |
232 | (time-secfrac "\\(\\.[0-9]+\\)?") | |
233 | (time-numoffset (concat "[-+]\\(" time-hour "\\):" time-minute)) | |
234 | (time-offset (concat "Z" time-numoffset)) | |
235 | (partial-time (concat time-hour colon time-minute colon time-second | |
236 | time-secfrac)) | |
237 | (full-date (concat date-fullyear dash date-month dash date-mday)) | |
238 | (full-time (concat partial-time time-offset)) | |
239 | (date-time (concat full-date "T" full-time))) | |
240 | (list (concat "^" full-date) | |
241 | (concat "T" partial-time) | |
242 | (concat "Z" time-numoffset))) | |
243 | "List of regular expressions matching ISO 8601 dates. | |
244 | 1st regular expression matches the date. | |
245 | 2nd regular expression matches the time. | |
246 | 3rd regular expression matches the (optional) timezone specification.") | |
247 | ||
248 | (defun parse-iso8601-time-string (date-string) | |
249 | (let* ((date-re (nth 0 parse-time-iso8601-regexp)) | |
250 | (time-re (nth 1 parse-time-iso8601-regexp)) | |
251 | (tz-re (nth 2 parse-time-iso8601-regexp)) | |
252 | re-start | |
253 | time seconds minute hour fractional-seconds | |
254 | day month year day-of-week dst tz) | |
255 | ;; We need to populate 'time' with | |
256 | ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) | |
257 | ||
258 | ;; Nobody else handles iso8601 correctly, let's do it ourselves. | |
259 | (when (string-match date-re date-string re-start) | |
260 | (setq year (string-to-number (match-string 1 date-string)) | |
261 | month (string-to-number (match-string 2 date-string)) | |
262 | day (string-to-number (match-string 3 date-string)) | |
263 | re-start (match-end 0)) | |
264 | (when (string-match time-re date-string re-start) | |
265 | (setq hour (string-to-number (match-string 1 date-string)) | |
266 | minute (string-to-number (match-string 2 date-string)) | |
267 | seconds (string-to-number (match-string 3 date-string)) | |
268 | fractional-seconds (string-to-number (or | |
269 | (match-string 4 date-string) | |
270 | "0")) | |
271 | re-start (match-end 0)) | |
272 | (when (string-match tz-re date-string re-start) | |
273 | (setq tz (match-string 1 date-string))) | |
274 | (setq time (list seconds minute hour day month year day-of-week dst tz)))) | |
275 | ||
276 | ;; Fall back to having Gnus do fancy things for us. | |
277 | (when (not time) | |
278 | (setq time (parse-time-string date-string))) | |
279 | ||
280 | (and time | |
281 | (apply 'encode-time time)))) | |
282 | ||
eec82323 LMI |
283 | (provide 'parse-time) |
284 | ||
285 | ;;; parse-time.el ends here |