Commit | Line | Data |
---|---|---|
715a2ca2 | 1 | ;;; parse-time.el --- parsing time strings |
eec82323 | 2 | |
16409b0b | 3 | ;; Copyright (C) 1996, 2000 by 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 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
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 | |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
27 | ;; With the introduction of the `encode-time', `decode-time', and | |
28 | ;; `format-time-string' functions, dealing with time became simpler in | |
29 | ;; Emacs. However, parsing time strings is still largely a matter of | |
30 | ;; heuristics and no common interface has been designed. | |
31 | ||
32 | ;; `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 | |
34 | ;; string are returned as nil. `encode-time' may be applied on these | |
183ca06e | 35 | ;; values to obtain an internal time value. |
eec82323 LMI |
36 | |
37 | ;;; Code: | |
38 | ||
16409b0b | 39 | (eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it |
eec82323 | 40 | |
16409b0b GM |
41 | (defvar parse-time-syntax (make-vector 256 nil)) |
42 | (defvar parse-time-digits (make-vector 256 nil)) | |
eec82323 LMI |
43 | |
44 | ;; Byte-compiler warnings | |
183ca06e RS |
45 | (defvar parse-time-elt) |
46 | (defvar parse-time-val) | |
eec82323 LMI |
47 | |
48 | (unless (aref parse-time-digits ?0) | |
49 | (loop for i from ?0 to ?9 | |
16409b0b | 50 | do (aset parse-time-digits i (- i ?0)))) |
eec82323 LMI |
51 | |
52 | (unless (aref parse-time-syntax ?0) | |
53 | (loop for i from ?0 to ?9 | |
16409b0b | 54 | do (aset parse-time-syntax i ?0)) |
eec82323 | 55 | (loop for i from ?A to ?Z |
16409b0b | 56 | do (aset parse-time-syntax i ?A)) |
eec82323 | 57 | (loop for i from ?a to ?z |
16409b0b GM |
58 | do (aset parse-time-syntax i ?a)) |
59 | (aset parse-time-syntax ?+ 1) | |
60 | (aset parse-time-syntax ?- -1) | |
61 | (aset parse-time-syntax ?: ?d) | |
eec82323 LMI |
62 | ) |
63 | ||
64 | (defsubst digit-char-p (char) | |
65 | (aref parse-time-digits char)) | |
66 | ||
67 | (defsubst parse-time-string-chars (char) | |
68 | (aref parse-time-syntax char)) | |
69 | ||
70 | (put 'parse-error 'error-conditions '(parse-error error)) | |
71 | (put 'parse-error 'error-message "Parsing error") | |
72 | ||
73 | (defsubst parse-integer (string &optional start end) | |
74 | "[CL] Parse and return the integer in STRING, or nil if none." | |
75 | (let ((integer 0) | |
76 | (digit 0) | |
77 | (index (or start 0)) | |
78 | (end (or end (length string)))) | |
79 | (when (< index end) | |
80 | (let ((sign (aref string index))) | |
81 | (if (or (eq sign ?+) (eq sign ?-)) | |
82 | (setq sign (parse-time-string-chars sign) | |
83 | index (1+ index)) | |
84 | (setq sign 1)) | |
85 | (while (and (< index end) | |
86 | (setq digit (digit-char-p (aref string index)))) | |
87 | (setq integer (+ (* integer 10) digit) | |
88 | index (1+ index))) | |
89 | (if (/= index end) | |
16409b0b GM |
90 | (signal 'parse-error `("not an integer" |
91 | ,(substring string (or start 0) end))) | |
eec82323 LMI |
92 | (* sign integer)))))) |
93 | ||
94 | (defun parse-time-tokenize (string) | |
95 | "Tokenize STRING into substrings." | |
96 | (let ((start nil) | |
97 | (end (length string)) | |
98 | (all-digits nil) | |
99 | (list ()) | |
100 | (index 0) | |
101 | (c nil)) | |
102 | (while (< index end) | |
103 | (while (and (< index end) ;skip invalid characters | |
104 | (not (setq c (parse-time-string-chars (aref string index))))) | |
105 | (incf index)) | |
106 | (setq start index all-digits (eq c ?0)) | |
107 | (while (and (< (incf index) end) ;scan valid characters | |
108 | (setq c (parse-time-string-chars (aref string index)))) | |
109 | (setq all-digits (and all-digits (eq c ?0)))) | |
110 | (if (<= index end) | |
111 | (push (if all-digits (parse-integer string start index) | |
112 | (substring string start index)) | |
113 | list))) | |
114 | (nreverse list))) | |
115 | ||
16409b0b GM |
116 | (defvar parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3) |
117 | ("apr" . 4) ("may" . 5) ("jun" . 6) | |
118 | ("jul" . 7) ("aug" . 8) ("sep" . 9) | |
119 | ("oct" . 10) ("nov" . 11) ("dec" . 12))) | |
120 | (defvar parse-time-weekdays '(("sun" . 0) ("mon" . 1) ("tue" . 2) | |
121 | ("wed" . 3) ("thu" . 4) ("fri" . 5) ("sat" . 6))) | |
122 | (defvar parse-time-zoneinfo `(("z" 0) ("ut" 0) ("gmt" 0) | |
123 | ("pst" ,(* -8 3600)) ("pdt" ,(* -7 3600) t) | |
124 | ("mst" ,(* -7 3600)) ("mdt" ,(* -6 3600) t) | |
125 | ("cst" ,(* -6 3600)) ("cdt" ,(* -5 3600) t) | |
126 | ("est" ,(* -5 3600)) ("edt" ,(* -4 3600) t)) | |
eec82323 LMI |
127 | "(zoneinfo seconds-off daylight-savings-time-p)") |
128 | ||
129 | (defvar parse-time-rules | |
130 | `(((6) parse-time-weekdays) | |
131 | ((3) (1 31)) | |
132 | ((4) parse-time-months) | |
16409b0b | 133 | ((5) (100 4038)) |
eec82323 | 134 | ((2 1 0) |
183ca06e RS |
135 | ,#'(lambda () (and (stringp parse-time-elt) |
136 | (= (length parse-time-elt) 8) | |
137 | (= (aref parse-time-elt 2) ?:) | |
138 | (= (aref parse-time-elt 5) ?:))) | |
eec82323 LMI |
139 | [0 2] [3 5] [6 8]) |
140 | ((8 7) parse-time-zoneinfo | |
183ca06e RS |
141 | ,#'(lambda () (car parse-time-val)) |
142 | ,#'(lambda () (cadr parse-time-val))) | |
eec82323 LMI |
143 | ((8) |
144 | ,#'(lambda () | |
183ca06e RS |
145 | (and (stringp parse-time-elt) |
146 | (= 5 (length parse-time-elt)) | |
147 | (or (= (aref parse-time-elt 0) ?+) | |
148 | (= (aref parse-time-elt 0) ?-)))) | |
149 | ,#'(lambda () (* 60 (+ (parse-integer parse-time-elt 3 5) | |
150 | (* 60 (parse-integer parse-time-elt 1 3))) | |
151 | (if (= (aref parse-time-elt 0) ?-) -1 1)))) | |
eec82323 | 152 | ((5 4 3) |
183ca06e RS |
153 | ,#'(lambda () (and (stringp parse-time-elt) |
154 | (= (length parse-time-elt) 10) | |
155 | (= (aref parse-time-elt 4) ?-) | |
156 | (= (aref parse-time-elt 7) ?-))) | |
eec82323 | 157 | [0 4] [5 7] [8 10]) |
16409b0b | 158 | ((2 1 0) |
183ca06e RS |
159 | ,#'(lambda () (and (stringp parse-time-elt) |
160 | (= (length parse-time-elt) 5) | |
161 | (= (aref parse-time-elt 2) ?:))) | |
16409b0b GM |
162 | [0 2] [3 5] ,#'(lambda () 0)) |
163 | ((2 1 0) | |
183ca06e RS |
164 | ,#'(lambda () (and (stringp parse-time-elt) |
165 | (= (length parse-time-elt) 4) | |
166 | (= (aref parse-time-elt 1) ?:))) | |
16409b0b GM |
167 | [0 1] [2 4] ,#'(lambda () 0)) |
168 | ((2 1 0) | |
183ca06e RS |
169 | ,#'(lambda () (and (stringp parse-time-elt) |
170 | (= (length parse-time-elt) 7) | |
171 | (= (aref parse-time-elt 1) ?:))) | |
16409b0b | 172 | [0 1] [2 4] [5 7]) |
183ca06e RS |
173 | ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt))) |
174 | ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt)))) | |
eec82323 LMI |
175 | "(slots predicate extractor...)") |
176 | ||
177 | (defun parse-time-string (string) | |
178 | "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). | |
179 | The values are identical to those of `decode-time', but any values that are | |
180 | unknown are returned as nil." | |
16409b0b GM |
181 | (let ((time (list nil nil nil nil nil nil nil nil nil)) |
182 | (temp (parse-time-tokenize (downcase string)))) | |
eec82323 | 183 | (while temp |
183ca06e | 184 | (let ((parse-time-elt (pop temp)) |
eec82323 LMI |
185 | (rules parse-time-rules) |
186 | (exit nil)) | |
187 | (while (and (not (null rules)) (not exit)) | |
188 | (let* ((rule (pop rules)) | |
189 | (slots (pop rule)) | |
190 | (predicate (pop rule)) | |
183ca06e | 191 | (parse-time-val)) |
16409b0b | 192 | (when (and (not (nth (car slots) time)) ;not already set |
183ca06e | 193 | (setq parse-time-val (cond ((and (consp predicate) |
16409b0b GM |
194 | (not (eq (car predicate) |
195 | 'lambda))) | |
183ca06e RS |
196 | (and (numberp parse-time-elt) |
197 | (<= (car predicate) parse-time-elt) | |
198 | (<= parse-time-elt (cadr predicate)) | |
199 | parse-time-elt)) | |
16409b0b | 200 | ((symbolp predicate) |
183ca06e | 201 | (cdr (assoc parse-time-elt |
16409b0b GM |
202 | (symbol-value predicate)))) |
203 | ((funcall predicate))))) | |
204 | (setq exit t) | |
205 | (while slots | |
206 | (let ((new-val (and rule | |
207 | (let ((this (pop rule))) | |
208 | (if (vectorp this) | |
209 | (parse-integer | |
183ca06e RS |
210 | parse-time-elt |
211 | (aref this 0) (aref this 1)) | |
16409b0b | 212 | (funcall this)))))) |
183ca06e RS |
213 | (rplaca (nthcdr (pop slots) time) |
214 | (or new-val parse-time-val))))))))) | |
eec82323 LMI |
215 | time)) |
216 | ||
217 | (provide 'parse-time) | |
218 | ||
219 | ;;; parse-time.el ends here |