Commit | Line | Data |
---|---|---|
eec82323 LMI |
1 | ;;; parse-time.el --- Parsing time strings |
2 | ||
3 | ;; Copyright (C) 1996 by Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Erik Naggum <erik@arcana.naggum.no> | |
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 | |
35 | ;; valuse to obtain an internal time value. | |
36 | ||
37 | ;;; Code: | |
38 | ||
0e6bb54e | 39 | (eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it |
eec82323 LMI |
40 | |
41 | (put 'parse-time-syntax 'char-table-extra-slots 0) | |
42 | ||
43 | (defvar parse-time-syntax (make-char-table 'parse-time-syntax)) | |
44 | (defvar parse-time-digits (make-char-table 'parse-time-syntax)) | |
45 | ||
46 | ;; Byte-compiler warnings | |
47 | (defvar elt) | |
48 | (defvar val) | |
49 | ||
50 | (unless (aref parse-time-digits ?0) | |
51 | (loop for i from ?0 to ?9 | |
52 | do (set-char-table-range parse-time-digits i (- i ?0)))) | |
53 | ||
54 | (unless (aref parse-time-syntax ?0) | |
55 | (loop for i from ?0 to ?9 | |
56 | do (set-char-table-range parse-time-syntax i ?0)) | |
57 | (loop for i from ?A to ?Z | |
58 | do (set-char-table-range parse-time-syntax i ?A)) | |
59 | (loop for i from ?a to ?z | |
60 | do (set-char-table-range parse-time-syntax i ?a)) | |
61 | (set-char-table-range parse-time-syntax ?+ 1) | |
62 | (set-char-table-range parse-time-syntax ?- -1) | |
63 | (set-char-table-range parse-time-syntax ?: ?d) | |
64 | ) | |
65 | ||
66 | (defsubst digit-char-p (char) | |
67 | (aref parse-time-digits char)) | |
68 | ||
69 | (defsubst parse-time-string-chars (char) | |
70 | (aref parse-time-syntax char)) | |
71 | ||
72 | (put 'parse-error 'error-conditions '(parse-error error)) | |
73 | (put 'parse-error 'error-message "Parsing error") | |
74 | ||
75 | (defsubst parse-integer (string &optional start end) | |
76 | "[CL] Parse and return the integer in STRING, or nil if none." | |
77 | (let ((integer 0) | |
78 | (digit 0) | |
79 | (index (or start 0)) | |
80 | (end (or end (length string)))) | |
81 | (when (< index end) | |
82 | (let ((sign (aref string index))) | |
83 | (if (or (eq sign ?+) (eq sign ?-)) | |
84 | (setq sign (parse-time-string-chars sign) | |
85 | index (1+ index)) | |
86 | (setq sign 1)) | |
87 | (while (and (< index end) | |
88 | (setq digit (digit-char-p (aref string index)))) | |
89 | (setq integer (+ (* integer 10) digit) | |
90 | index (1+ index))) | |
91 | (if (/= index end) | |
92 | (signal 'parse-error `("not an integer" ,(substring string (or start 0) end))) | |
93 | (* sign integer)))))) | |
94 | ||
95 | (defun parse-time-tokenize (string) | |
96 | "Tokenize STRING into substrings." | |
97 | (let ((start nil) | |
98 | (end (length string)) | |
99 | (all-digits nil) | |
100 | (list ()) | |
101 | (index 0) | |
102 | (c nil)) | |
103 | (while (< index end) | |
104 | (while (and (< index end) ;skip invalid characters | |
105 | (not (setq c (parse-time-string-chars (aref string index))))) | |
106 | (incf index)) | |
107 | (setq start index all-digits (eq c ?0)) | |
108 | (while (and (< (incf index) end) ;scan valid characters | |
109 | (setq c (parse-time-string-chars (aref string index)))) | |
110 | (setq all-digits (and all-digits (eq c ?0)))) | |
111 | (if (<= index end) | |
112 | (push (if all-digits (parse-integer string start index) | |
113 | (substring string start index)) | |
114 | list))) | |
115 | (nreverse list))) | |
116 | ||
117 | (defvar parse-time-months '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) | |
118 | ("Apr" . 4) ("May" . 5) ("Jun" . 6) | |
119 | ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) | |
120 | ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))) | |
121 | (defvar parse-time-weekdays '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) | |
122 | ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) | |
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)) | |
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) | |
134 | ((5) (1970 2038)) | |
135 | ((2 1 0) | |
136 | ,#'(lambda () (and (stringp elt) | |
137 | (= (length elt) 8) | |
138 | (= (aref elt 2) ?:) | |
139 | (= (aref elt 5) ?:))) | |
140 | [0 2] [3 5] [6 8]) | |
141 | ((8 7) parse-time-zoneinfo | |
142 | ,#'(lambda () (car val)) | |
143 | ,#'(lambda () (cadr val))) | |
144 | ((8) | |
145 | ,#'(lambda () | |
146 | (and (stringp elt) | |
147 | (= 5 (length elt)) | |
148 | (or (= (aref elt 0) ?+) (= (aref elt 0) ?-)))) | |
149 | ,#'(lambda () (* 60 (+ (parse-integer elt 3 5) | |
150 | (* 60 (parse-integer elt 1 3))) | |
151 | (if (= (aref elt 0) ?-) -1 1)))) | |
152 | ((5 4 3) | |
153 | ,#'(lambda () (and (stringp elt) (= (length elt) 10) (= (aref elt 4) ?-) (= (aref elt 7) ?-))) | |
154 | [0 4] [5 7] [8 10]) | |
155 | ((2 1) | |
156 | ,#'(lambda () (and (stringp elt) (= (length elt) 5) (= (aref elt 2) ?:))) | |
157 | [0 2] [3 5]) | |
158 | ((5) (70 99) ,#'(lambda () (+ 1900 elt)))) | |
159 | "(slots predicate extractor...)") | |
160 | ||
161 | (defun parse-time-string (string) | |
162 | "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). | |
163 | The values are identical to those of `decode-time', but any values that are | |
164 | unknown are returned as nil." | |
165 | (let ((time (list nil nil nil nil nil nil nil nil nil nil)) | |
166 | (temp (parse-time-tokenize string))) | |
167 | (while temp | |
168 | (let ((elt (pop temp)) | |
169 | (rules parse-time-rules) | |
170 | (exit nil)) | |
171 | (while (and (not (null rules)) (not exit)) | |
172 | (let* ((rule (pop rules)) | |
173 | (slots (pop rule)) | |
174 | (predicate (pop rule)) | |
175 | (val)) | |
176 | (if (and (not (nth (car slots) time)) ;not already set | |
177 | (setq val (cond ((and (consp predicate) | |
178 | (not (eq (car predicate) 'lambda))) | |
179 | (and (numberp elt) | |
180 | (<= (car predicate) elt) | |
181 | (<= elt (cadr predicate)) | |
182 | elt)) | |
183 | ((symbolp predicate) | |
184 | (cdr (assoc elt (symbol-value predicate)))) | |
185 | ((funcall predicate))))) | |
186 | (progn | |
187 | (setq exit t) | |
188 | (while slots | |
189 | (let ((new-val (and rule | |
190 | (let ((this (pop rule))) | |
191 | (if (vectorp this) | |
192 | (parse-integer elt (aref this 0) (aref this 1)) | |
193 | (funcall this)))))) | |
194 | (rplaca (nthcdr (pop slots) time) (or new-val val)))))))))) | |
195 | time)) | |
196 | ||
197 | (provide 'parse-time) | |
198 | ||
199 | ;;; parse-time.el ends here |