parse-time.el 7.57 KB
Newer Older
1
;;; parse-time.el --- parsing time strings
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
2

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2008, 2009  Free Software Foundation, Inc.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
5

6
;; Author: Erik Naggum <erik@naggum.no>
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
7 8 9 10
;; Keywords: util

;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
23 24 25 26 27 28 29 30 31 32 33

;;; Commentary:

;; With the introduction of the `encode-time', `decode-time', and
;; `format-time-string' functions, dealing with time became simpler in
;; Emacs.  However, parsing time strings is still largely a matter of
;; heuristics and no common interface has been designed.

;; `parse-time-string' parses a time in a string and returns a list of 9
;; values, just like `decode-time', where unspecified elements in the
;; string are returned as nil.  `encode-time' may be applied on these
34
;; values to obtain an internal time value.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
35 36 37

;;; Code:

38
(eval-when-compile (require 'cl))	;and ah ain't kiddin' 'bout it
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
39

40
(defvar parse-time-digits (make-vector 256 nil))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
41 42

;; Byte-compiler warnings
43 44
(defvar parse-time-elt)
(defvar parse-time-val)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
45 46 47

(unless (aref parse-time-digits ?0)
  (loop for i from ?0 to ?9
48
    do (aset parse-time-digits i (- i ?0))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
49 50 51 52 53

(defsubst digit-char-p (char)
  (aref parse-time-digits char))

(defsubst parse-time-string-chars (char)
54 55 56 57 58 59 60 61
  (save-match-data
    (let (case-fold-search str)
      (cond ((eq char ?+) 1)
	    ((eq char ?-) -1)
	    ((eq char ?:) ?d)
	    ((string-match "[[:upper:]]" (setq str (string char))) ?A)
	    ((string-match "[[:lower:]]" str) ?a)
	    ((string-match "[[:digit:]]" str) ?0)))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82

(put 'parse-error 'error-conditions '(parse-error error))
(put 'parse-error 'error-message "Parsing error")

(defsubst parse-integer (string &optional start end)
  "[CL] Parse and return the integer in STRING, or nil if none."
  (let ((integer 0)
	(digit 0)
	(index (or start 0))
	(end (or end (length string))))
    (when (< index end)
      (let ((sign (aref string index)))
	(if (or (eq sign ?+) (eq sign ?-))
	    (setq sign (parse-time-string-chars sign)
		  index (1+ index))
	  (setq sign 1))
	(while (and (< index end)
		    (setq digit (digit-char-p (aref string index))))
	  (setq integer (+ (* integer 10) digit)
		index (1+ index)))
	(if (/= index end)
83 84
	    (signal 'parse-error `("not an integer"
				   ,(substring string (or start 0) end)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
	  (* sign integer))))))

(defun parse-time-tokenize (string)
  "Tokenize STRING into substrings."
  (let ((start nil)
	(end (length string))
	(all-digits nil)
	(list ())
	(index 0)
	(c nil))
    (while (< index end)
      (while (and (< index end)		;skip invalid characters
		  (not (setq c (parse-time-string-chars (aref string index)))))
	(incf index))
      (setq start index all-digits (eq c ?0))
      (while (and (< (incf index) end)	;scan valid characters
		  (setq c (parse-time-string-chars (aref string index))))
	(setq all-digits (and all-digits (eq c ?0))))
      (if (<= index end)
	  (push (if all-digits (parse-integer string start index)
		  (substring string start index))
		list)))
    (nreverse list)))

109 110 111
(defvar parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3)
			    ("apr" . 4) ("may" . 5) ("jun" . 6)
			    ("jul" . 7) ("aug" . 8) ("sep" . 9)
112 113 114 115 116 117
			    ("oct" . 10) ("nov" . 11) ("dec" . 12)
			    ("january" . 1) ("february" . 2)
			    ("march" . 3) ("april" . 4) ("june" . 6)
			    ("july" . 7) ("august" . 8)
			    ("september" . 9) ("october" . 10)
			    ("november" . 11) ("december" . 12)))
118
(defvar parse-time-weekdays '(("sun" . 0) ("mon" . 1) ("tue" . 2)
119 120 121 122 123
			      ("wed" . 3) ("thu" . 4) ("fri" . 5)
			      ("sat" . 6) ("sunday" . 0) ("monday" . 1)
			      ("tuesday" . 2) ("wednesday" . 3)
			      ("thursday" . 4) ("friday" . 5)
			      ("saturday" . 6)))
124 125 126 127 128
(defvar parse-time-zoneinfo `(("z" 0) ("ut" 0) ("gmt" 0)
			      ("pst" ,(* -8 3600)) ("pdt" ,(* -7 3600) t)
			      ("mst" ,(* -7 3600)) ("mdt" ,(* -6 3600) t)
			      ("cst" ,(* -6 3600)) ("cdt" ,(* -5 3600) t)
			      ("est" ,(* -5 3600)) ("edt" ,(* -4 3600) t))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
129 130 131 132 133 134
  "(zoneinfo seconds-off daylight-savings-time-p)")

(defvar parse-time-rules
  `(((6) parse-time-weekdays)
    ((3) (1 31))
    ((4) parse-time-months)
135
    ((5) (100 4038))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
136
    ((2 1 0)
137 138 139 140
     ,#'(lambda () (and (stringp parse-time-elt)
			(= (length parse-time-elt) 8)
			(= (aref parse-time-elt 2) ?:)
			(= (aref parse-time-elt 5) ?:)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
141 142
     [0 2] [3 5] [6 8])
    ((8 7) parse-time-zoneinfo
143 144
     ,#'(lambda () (car parse-time-val))
     ,#'(lambda () (cadr parse-time-val)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
145 146
    ((8)
     ,#'(lambda ()
147 148 149 150 151 152 153
	  (and (stringp parse-time-elt)
	       (= 5 (length parse-time-elt))
	       (or (= (aref parse-time-elt 0) ?+)
		   (= (aref parse-time-elt 0) ?-))))
     ,#'(lambda () (* 60 (+ (parse-integer parse-time-elt 3 5)
			    (* 60 (parse-integer parse-time-elt 1 3)))
		      (if (= (aref parse-time-elt 0) ?-) -1 1))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
154
    ((5 4 3)
155 156 157 158
     ,#'(lambda () (and (stringp parse-time-elt)
			(= (length parse-time-elt) 10)
			(= (aref parse-time-elt 4) ?-)
			(= (aref parse-time-elt 7) ?-)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
159
     [0 4] [5 7] [8 10])
160
    ((2 1 0)
161 162 163
     ,#'(lambda () (and (stringp parse-time-elt)
			(= (length parse-time-elt) 5)
			(= (aref parse-time-elt 2) ?:)))
164 165
     [0 2] [3 5] ,#'(lambda () 0))
    ((2 1 0)
166 167 168
     ,#'(lambda () (and (stringp parse-time-elt)
			(= (length parse-time-elt) 4)
			(= (aref parse-time-elt 1) ?:)))
169 170
     [0 1] [2 4] ,#'(lambda () 0))
    ((2 1 0)
171 172 173
     ,#'(lambda () (and (stringp parse-time-elt)
			(= (length parse-time-elt) 7)
			(= (aref parse-time-elt 1) ?:)))
174
     [0 1] [2 4] [5 7])
175 176
    ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt)))
    ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
177
  "(slots predicate extractor...)")
178
;;;###autoload(put 'parse-time-rules 'risky-local-variable t)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
179

180
;;;###autoload
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
181 182 183 184
(defun parse-time-string (string)
  "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
The values are identical to those of `decode-time', but any values that are
unknown are returned as nil."
185 186
  (let ((time (list nil nil nil nil nil nil nil nil nil))
	(temp (parse-time-tokenize (downcase string))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
187
    (while temp
188
      (let ((parse-time-elt (pop temp))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
189 190
	    (rules parse-time-rules)
	    (exit nil))
Glenn Morris's avatar
Glenn Morris committed
191
	(while (and rules (not exit))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
192 193 194
	  (let* ((rule (pop rules))
		 (slots (pop rule))
		 (predicate (pop rule))
195
		 (parse-time-val))
196
	    (when (and (not (nth (car slots) time)) ;not already set
197
		       (setq parse-time-val (cond ((and (consp predicate)
198 199
					     (not (eq (car predicate)
						      'lambda)))
200 201 202 203
					(and (numberp parse-time-elt)
					     (<= (car predicate) parse-time-elt)
					     (<= parse-time-elt (cadr predicate))
					     parse-time-elt))
204
				       ((symbolp predicate)
205
					(cdr (assoc parse-time-elt
206 207 208 209 210 211 212 213
						    (symbol-value predicate))))
				       ((funcall predicate)))))
	      (setq exit t)
	      (while slots
		(let ((new-val (and rule
				    (let ((this (pop rule)))
				      (if (vectorp this)
					  (parse-integer
214 215
					   parse-time-elt
					   (aref this 0) (aref this 1))
216
					(funcall this))))))
217 218
		  (rplaca (nthcdr (pop slots) time)
			  (or new-val parse-time-val)))))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
219 220 221 222
    time))

(provide 'parse-time)

223
;; arch-tag: 07066094-45a8-4c68-b307-86195e2c1103
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
224
;;; parse-time.el ends here