X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fparse-time.el;h=e6bac898d93357cb8912daaf672d3b5968d02a28;hp=038541ccb1c456005ba932405c6f76bbd8707aa0;hb=8b5af94e55ef83ee46b42d32d92fa1ce95dcacf5;hpb=04c881031d5fb4ede1c190fe88f6b84c1663b66e diff --git a/lisp/parse-time.el b/lisp/parse-time.el index 038541ccb..e6bac898d 100644 --- a/lisp/parse-time.el +++ b/lisp/parse-time.el @@ -1,16 +1,17 @@ -;;; parse-time.el --- Parsing time strings +;;; parse-time.el --- parsing time strings -;; Copyright (C) 1996 by Free Software Foundation, Inc. +;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008 Free Software Foundation, Inc. -;; Author: Erik Naggum +;; Author: Erik Naggum ;; Keywords: util ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -18,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -32,30 +31,30 @@ ;; `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 -;; valuse to obtain an internal time value. +;; values to obtain an internal time value. ;;; Code: -(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it +(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it (defvar parse-time-syntax (make-vector 256 nil)) (defvar parse-time-digits (make-vector 256 nil)) ;; Byte-compiler warnings -(defvar elt) -(defvar val) +(defvar parse-time-elt) +(defvar parse-time-val) (unless (aref parse-time-digits ?0) (loop for i from ?0 to ?9 - do (aset parse-time-digits i (- i ?0)))) + do (aset parse-time-digits i (- i ?0)))) (unless (aref parse-time-syntax ?0) (loop for i from ?0 to ?9 - do (aset parse-time-syntax i ?0)) + do (aset parse-time-syntax i ?0)) (loop for i from ?A to ?Z - do (aset parse-time-syntax i ?A)) + do (aset parse-time-syntax i ?A)) (loop for i from ?a to ?z - do (aset parse-time-syntax i ?a)) + do (aset parse-time-syntax i ?a)) (aset parse-time-syntax ?+ 1) (aset parse-time-syntax ?- -1) (aset parse-time-syntax ?: ?d) @@ -65,7 +64,8 @@ (aref parse-time-digits char)) (defsubst parse-time-string-chars (char) - (aref parse-time-syntax char)) + (and (< char (length parse-time-syntax)) + (aref parse-time-syntax char))) (put 'parse-error 'error-conditions '(parse-error error)) (put 'parse-error 'error-message "Parsing error") @@ -130,46 +130,51 @@ `(((6) parse-time-weekdays) ((3) (1 31)) ((4) parse-time-months) - ((5) (1970 2038)) + ((5) (100 4038)) ((2 1 0) - ,#'(lambda () (and (stringp elt) - (= (length elt) 8) - (= (aref elt 2) ?:) - (= (aref elt 5) ?:))) + ,#'(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 8) + (= (aref parse-time-elt 2) ?:) + (= (aref parse-time-elt 5) ?:))) [0 2] [3 5] [6 8]) ((8 7) parse-time-zoneinfo - ,#'(lambda () (car val)) - ,#'(lambda () (cadr val))) + ,#'(lambda () (car parse-time-val)) + ,#'(lambda () (cadr parse-time-val))) ((8) ,#'(lambda () - (and (stringp elt) - (= 5 (length elt)) - (or (= (aref elt 0) ?+) (= (aref elt 0) ?-)))) - ,#'(lambda () (* 60 (+ (parse-integer elt 3 5) - (* 60 (parse-integer elt 1 3))) - (if (= (aref elt 0) ?-) -1 1)))) + (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)))) ((5 4 3) - ,#'(lambda () (and (stringp elt) - (= (length elt) 10) - (= (aref elt 4) ?-) - (= (aref elt 7) ?-))) + ,#'(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 10) + (= (aref parse-time-elt 4) ?-) + (= (aref parse-time-elt 7) ?-))) [0 4] [5 7] [8 10]) ((2 1 0) - ,#'(lambda () (and (stringp elt) (= (length elt) 5) (= (aref elt 2) ?:))) + ,#'(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 5) + (= (aref parse-time-elt 2) ?:))) [0 2] [3 5] ,#'(lambda () 0)) ((2 1 0) - ,#'(lambda () (and (stringp elt) - (= (length elt) 4) - (= (aref elt 1) ?:))) + ,#'(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 4) + (= (aref parse-time-elt 1) ?:))) [0 1] [2 4] ,#'(lambda () 0)) ((2 1 0) - ,#'(lambda () (and (stringp elt) - (= (length elt) 7) - (= (aref elt 1) ?:))) + ,#'(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 7) + (= (aref parse-time-elt 1) ?:))) [0 1] [2 4] [5 7]) - ((5) (70 99) ,#'(lambda () (+ 1900 elt)))) + ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt))) + ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt)))) "(slots predicate extractor...)") +;;;###autoload (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 @@ -177,24 +182,24 @@ unknown are returned as nil." (let ((time (list nil nil nil nil nil nil nil nil nil)) (temp (parse-time-tokenize (downcase string)))) (while temp - (let ((elt (pop temp)) + (let ((parse-time-elt (pop temp)) (rules parse-time-rules) (exit nil)) - (while (and (not (null rules)) (not exit)) + (while (and rules (not exit)) (let* ((rule (pop rules)) (slots (pop rule)) (predicate (pop rule)) - (val)) + (parse-time-val)) (when (and (not (nth (car slots) time)) ;not already set - (setq val (cond ((and (consp predicate) + (setq parse-time-val (cond ((and (consp predicate) (not (eq (car predicate) 'lambda))) - (and (numberp elt) - (<= (car predicate) elt) - (<= elt (cadr predicate)) - elt)) + (and (numberp parse-time-elt) + (<= (car predicate) parse-time-elt) + (<= parse-time-elt (cadr predicate)) + parse-time-elt)) ((symbolp predicate) - (cdr (assoc elt + (cdr (assoc parse-time-elt (symbol-value predicate)))) ((funcall predicate))))) (setq exit t) @@ -203,11 +208,14 @@ unknown are returned as nil." (let ((this (pop rule))) (if (vectorp this) (parse-integer - elt (aref this 0) (aref this 1)) + parse-time-elt + (aref this 0) (aref this 1)) (funcall this)))))) - (rplaca (nthcdr (pop slots) time) (or new-val val))))))))) + (rplaca (nthcdr (pop slots) time) + (or new-val parse-time-val))))))))) time)) (provide 'parse-time) +;; arch-tag: 07066094-45a8-4c68-b307-86195e2c1103 ;;; parse-time.el ends here