Mercurial > emacs
annotate lisp/gnus/parse-time.el @ 26804:ce54b1d60246
*** empty log message ***
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 10 Dec 1999 21:52:33 +0000 |
parents | e8c4bdc27fc2 |
children | a0e2fa7d8bb7 |
rev | line source |
---|---|
17493 | 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 | |
19489
e8c4bdc27fc2
Require cl only at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
39 (eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it |
17493 | 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 |