Commit | Line | Data |
---|---|---|
715a2ca2 | 1 | ;;; parse-time.el --- parsing time strings |
eec82323 | 2 | |
1fa570af | 3 | ;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
114f9c96 | 4 | ;; 2008, 2009, 2010 Free Software Foundation, Inc. |
eec82323 | 5 | |
a893064d | 6 | ;; Author: Erik Naggum <erik@naggum.no> |
eec82323 LMI |
7 | ;; Keywords: util |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
2ed66575 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
eec82323 | 12 | ;; it under the terms of the GNU General Public License as published by |
2ed66575 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
eec82323 LMI |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
2ed66575 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
eec82323 LMI |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;; With the introduction of the `encode-time', `decode-time', and | |
27 | ;; `format-time-string' functions, dealing with time became simpler in | |
28 | ;; Emacs. However, parsing time strings is still largely a matter of | |
29 | ;; heuristics and no common interface has been designed. | |
30 | ||
31 | ;; `parse-time-string' parses a time in a string and returns a list of 9 | |
32 | ;; values, just like `decode-time', where unspecified elements in the | |
33 | ;; string are returned as nil. `encode-time' may be applied on these | |
183ca06e | 34 | ;; values to obtain an internal time value. |
eec82323 LMI |
35 | |
36 | ;;; Code: | |
37 | ||
16409b0b | 38 | (eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it |
eec82323 | 39 | |
16409b0b | 40 | (defvar parse-time-digits (make-vector 256 nil)) |
eec82323 LMI |
41 | |
42 | ;; Byte-compiler warnings | |
183ca06e RS |
43 | (defvar parse-time-elt) |
44 | (defvar parse-time-val) | |
eec82323 LMI |
45 | |
46 | (unless (aref parse-time-digits ?0) | |
47 | (loop for i from ?0 to ?9 | |
16409b0b | 48 | do (aset parse-time-digits i (- i ?0)))) |
eec82323 | 49 | |
eec82323 LMI |
50 | (defsubst digit-char-p (char) |
51 | (aref parse-time-digits char)) | |
52 | ||
53 | (defsubst parse-time-string-chars (char) | |
81b1f9c9 CY |
54 | (save-match-data |
55 | (let (case-fold-search str) | |
56 | (cond ((eq char ?+) 1) | |
57 | ((eq char ?-) -1) | |
58 | ((eq char ?:) ?d) | |
59 | ((string-match "[[:upper:]]" (setq str (string char))) ?A) | |
60 | ((string-match "[[:lower:]]" str) ?a) | |
61 | ((string-match "[[:digit:]]" str) ?0))))) | |
eec82323 LMI |
62 | |
63 | (put 'parse-error 'error-conditions '(parse-error error)) | |
64 | (put 'parse-error 'error-message "Parsing error") | |
65 | ||
66 | (defsubst parse-integer (string &optional start end) | |
67 | "[CL] Parse and return the integer in STRING, or nil if none." | |
68 | (let ((integer 0) | |
69 | (digit 0) | |
70 | (index (or start 0)) | |
71 | (end (or end (length string)))) | |
72 | (when (< index end) | |
73 | (let ((sign (aref string index))) | |
74 | (if (or (eq sign ?+) (eq sign ?-)) | |
75 | (setq sign (parse-time-string-chars sign) | |
76 | index (1+ index)) | |
77 | (setq sign 1)) | |
78 | (while (and (< index end) | |
79 | (setq digit (digit-char-p (aref string index)))) | |
80 | (setq integer (+ (* integer 10) digit) | |
81 | index (1+ index))) | |
82 | (if (/= index end) | |
16409b0b GM |
83 | (signal 'parse-error `("not an integer" |
84 | ,(substring string (or start 0) end))) | |
eec82323 LMI |
85 | (* sign integer)))))) |
86 | ||
87 | (defun parse-time-tokenize (string) | |
88 | "Tokenize STRING into substrings." | |
89 | (let ((start nil) | |
90 | (end (length string)) | |
91 | (all-digits nil) | |
92 | (list ()) | |
93 | (index 0) | |
94 | (c nil)) | |
95 | (while (< index end) | |
96 | (while (and (< index end) ;skip invalid characters | |
97 | (not (setq c (parse-time-string-chars (aref string index))))) | |
98 | (incf index)) | |
99 | (setq start index all-digits (eq c ?0)) | |
100 | (while (and (< (incf index) end) ;scan valid characters | |
101 | (setq c (parse-time-string-chars (aref string index)))) | |
102 | (setq all-digits (and all-digits (eq c ?0)))) | |
103 | (if (<= index end) | |
104 | (push (if all-digits (parse-integer string start index) | |
105 | (substring string start index)) | |
106 | list))) | |
107 | (nreverse list))) | |
108 | ||
16409b0b GM |
109 | (defvar parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3) |
110 | ("apr" . 4) ("may" . 5) ("jun" . 6) | |
111 | ("jul" . 7) ("aug" . 8) ("sep" . 9) | |
3b738106 CY |
112 | ("oct" . 10) ("nov" . 11) ("dec" . 12) |
113 | ("january" . 1) ("february" . 2) | |
114 | ("march" . 3) ("april" . 4) ("june" . 6) | |
115 | ("july" . 7) ("august" . 8) | |
116 | ("september" . 9) ("october" . 10) | |
117 | ("november" . 11) ("december" . 12))) | |
16409b0b | 118 | (defvar parse-time-weekdays '(("sun" . 0) ("mon" . 1) ("tue" . 2) |
3b738106 CY |
119 | ("wed" . 3) ("thu" . 4) ("fri" . 5) |
120 | ("sat" . 6) ("sunday" . 0) ("monday" . 1) | |
121 | ("tuesday" . 2) ("wednesday" . 3) | |
122 | ("thursday" . 4) ("friday" . 5) | |
123 | ("saturday" . 6))) | |
16409b0b GM |
124 | (defvar parse-time-zoneinfo `(("z" 0) ("ut" 0) ("gmt" 0) |
125 | ("pst" ,(* -8 3600)) ("pdt" ,(* -7 3600) t) | |
126 | ("mst" ,(* -7 3600)) ("mdt" ,(* -6 3600) t) | |
127 | ("cst" ,(* -6 3600)) ("cdt" ,(* -5 3600) t) | |
128 | ("est" ,(* -5 3600)) ("edt" ,(* -4 3600) t)) | |
eec82323 LMI |
129 | "(zoneinfo seconds-off daylight-savings-time-p)") |
130 | ||
131 | (defvar parse-time-rules | |
132 | `(((6) parse-time-weekdays) | |
133 | ((3) (1 31)) | |
134 | ((4) parse-time-months) | |
16409b0b | 135 | ((5) (100 4038)) |
eec82323 | 136 | ((2 1 0) |
183ca06e RS |
137 | ,#'(lambda () (and (stringp parse-time-elt) |
138 | (= (length parse-time-elt) 8) | |
139 | (= (aref parse-time-elt 2) ?:) | |
140 | (= (aref parse-time-elt 5) ?:))) | |
eec82323 LMI |
141 | [0 2] [3 5] [6 8]) |
142 | ((8 7) parse-time-zoneinfo | |
183ca06e RS |
143 | ,#'(lambda () (car parse-time-val)) |
144 | ,#'(lambda () (cadr parse-time-val))) | |
eec82323 LMI |
145 | ((8) |
146 | ,#'(lambda () | |
183ca06e RS |
147 | (and (stringp parse-time-elt) |
148 | (= 5 (length parse-time-elt)) | |
149 | (or (= (aref parse-time-elt 0) ?+) | |
150 | (= (aref parse-time-elt 0) ?-)))) | |
151 | ,#'(lambda () (* 60 (+ (parse-integer parse-time-elt 3 5) | |
152 | (* 60 (parse-integer parse-time-elt 1 3))) | |
153 | (if (= (aref parse-time-elt 0) ?-) -1 1)))) | |
eec82323 | 154 | ((5 4 3) |
183ca06e RS |
155 | ,#'(lambda () (and (stringp parse-time-elt) |
156 | (= (length parse-time-elt) 10) | |
157 | (= (aref parse-time-elt 4) ?-) | |
158 | (= (aref parse-time-elt 7) ?-))) | |
eec82323 | 159 | [0 4] [5 7] [8 10]) |
16409b0b | 160 | ((2 1 0) |
183ca06e RS |
161 | ,#'(lambda () (and (stringp parse-time-elt) |
162 | (= (length parse-time-elt) 5) | |
163 | (= (aref parse-time-elt 2) ?:))) | |
16409b0b GM |
164 | [0 2] [3 5] ,#'(lambda () 0)) |
165 | ((2 1 0) | |
183ca06e RS |
166 | ,#'(lambda () (and (stringp parse-time-elt) |
167 | (= (length parse-time-elt) 4) | |
168 | (= (aref parse-time-elt 1) ?:))) | |
16409b0b GM |
169 | [0 1] [2 4] ,#'(lambda () 0)) |
170 | ((2 1 0) | |
183ca06e RS |
171 | ,#'(lambda () (and (stringp parse-time-elt) |
172 | (= (length parse-time-elt) 7) | |
173 | (= (aref parse-time-elt 1) ?:))) | |
16409b0b | 174 | [0 1] [2 4] [5 7]) |
183ca06e RS |
175 | ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt))) |
176 | ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt)))) | |
eec82323 | 177 | "(slots predicate extractor...)") |
6dc3311d | 178 | ;;;###autoload(put 'parse-time-rules 'risky-local-variable t) |
eec82323 | 179 | |
ec2dc267 | 180 | ;;;###autoload |
eec82323 LMI |
181 | (defun parse-time-string (string) |
182 | "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). | |
183 | The values are identical to those of `decode-time', but any values that are | |
184 | unknown are returned as nil." | |
16409b0b GM |
185 | (let ((time (list nil nil nil nil nil nil nil nil nil)) |
186 | (temp (parse-time-tokenize (downcase string)))) | |
eec82323 | 187 | (while temp |
183ca06e | 188 | (let ((parse-time-elt (pop temp)) |
eec82323 LMI |
189 | (rules parse-time-rules) |
190 | (exit nil)) | |
1fa570af | 191 | (while (and rules (not exit)) |
eec82323 LMI |
192 | (let* ((rule (pop rules)) |
193 | (slots (pop rule)) | |
194 | (predicate (pop rule)) | |
183ca06e | 195 | (parse-time-val)) |
16409b0b | 196 | (when (and (not (nth (car slots) time)) ;not already set |
183ca06e | 197 | (setq parse-time-val (cond ((and (consp predicate) |
16409b0b GM |
198 | (not (eq (car predicate) |
199 | 'lambda))) | |
183ca06e RS |
200 | (and (numberp parse-time-elt) |
201 | (<= (car predicate) parse-time-elt) | |
202 | (<= parse-time-elt (cadr predicate)) | |
203 | parse-time-elt)) | |
16409b0b | 204 | ((symbolp predicate) |
183ca06e | 205 | (cdr (assoc parse-time-elt |
16409b0b GM |
206 | (symbol-value predicate)))) |
207 | ((funcall predicate))))) | |
208 | (setq exit t) | |
209 | (while slots | |
210 | (let ((new-val (and rule | |
211 | (let ((this (pop rule))) | |
212 | (if (vectorp this) | |
213 | (parse-integer | |
183ca06e RS |
214 | parse-time-elt |
215 | (aref this 0) (aref this 1)) | |
16409b0b | 216 | (funcall this)))))) |
183ca06e RS |
217 | (rplaca (nthcdr (pop slots) time) |
218 | (or new-val parse-time-val))))))))) | |
eec82323 LMI |
219 | time)) |
220 | ||
221 | (provide 'parse-time) | |
222 | ||
cbee283d | 223 | ;; arch-tag: 07066094-45a8-4c68-b307-86195e2c1103 |
eec82323 | 224 | ;;; parse-time.el ends here |