X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Ftime-date.el;h=b04cfcd9fe41ac21d9619d1e0861d6ee0bfecb76;hb=0b06b1140cae4b466e4d0119d2070a628c02aa2b;hp=829bff877dd11d6ea6d0227776206fe076859a3e;hpb=74b1068d524ae91c4acc8e43372386789a694ebd;p=gnus diff --git a/lisp/time-date.el b/lisp/time-date.el index 829bff877..b04cfcd9f 100644 --- a/lisp/time-date.el +++ b/lisp/time-date.el @@ -1,7 +1,6 @@ ;;; time-date.el --- Date and time handling functions -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -;; 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1998-2014 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu Umeda @@ -9,35 +8,32 @@ ;; 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 3, 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 -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; 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 -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: -;; Time values come in three formats. The oldest format is a cons +;; Time values come in several formats. The oldest format is a cons ;; cell of the form (HIGH . LOW). This format is obsolete, but still -;; supported. The two other formats are the lists (HIGH LOW) and -;; (HIGH LOW MICRO). The first two formats specify HIGH * 2^16 + LOW -;; seconds; the third format specifies HIGH * 2^16 + LOW + MICRO / -;; 1000000 seconds. We should have 0 <= MICRO < 1000000 and 0 <= LOW -;; < 2^16. If the time value represents a point in time, then HIGH is -;; nonnegative. If the time value is a time difference, then HIGH can -;; be negative as well. The macro `with-decoded-time-value' and the -;; function `encode-time-value' make it easier to deal with these -;; three formats. See `time-subtract' for an example of how to use -;; them. +;; supported. The other formats are the lists (HIGH LOW), (HIGH LOW +;; USEC), and (HIGH LOW USEC PSEC). These formats specify the time +;; value equal to HIGH * 2^16 + LOW + USEC * 10^-6 + PSEC * 10^-12 +;; seconds, where missing components are treated as zero. HIGH can be +;; negative, either because the value is a time difference, or because +;; the machine supports negative time stamps that fall before the epoch. +;; The macro `with-decoded-time-value' and the function +;; `encode-time-value' make it easier to deal with these formats. +;; See `time-subtract' for an example of how to use them. ;;; Code: @@ -47,13 +43,15 @@ The value of the last form in BODY is returned. Each element of the list VARLIST is a list of the form -\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [TYPE-SYMBOL] TIME-VALUE). +\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [PICO-SYMBOL [TYPE-SYMBOL]] TIME-VALUE). The time value TIME-VALUE is decoded and the result it bound to the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL. +The optional PICO-SYMBOL is bound to the picoseconds part. The optional TYPE-SYMBOL is bound to the type of the time value. Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH -LOW), and type 2 is the list (HIGH LOW MICRO)." +LOW), type 2 is the list (HIGH LOW MICRO), and type 3 is the +list (HIGH LOW MICRO PICO)." (declare (indent 1) (debug ((&rest (symbolp symbolp symbolp &or [symbolp form] form)) body))) @@ -62,6 +60,8 @@ LOW), and type 2 is the list (HIGH LOW MICRO)." (high (pop elt)) (low (pop elt)) (micro (pop elt)) + (pico (unless (<= (length elt) 2) + (pop elt))) (type (unless (eq (length elt) 1) (pop elt))) (time-value (car elt)) @@ -69,72 +69,118 @@ LOW), and type 2 is the list (HIGH LOW MICRO)." `(let* ,(append `((,gensym ,time-value) (,high (pop ,gensym)) ,low ,micro) + (when pico `(,pico)) (when type `(,type))) (if (consp ,gensym) (progn (setq ,low (pop ,gensym)) (if ,gensym - ,(append `(setq ,micro (car ,gensym)) - (when type `(,type 2))) + (progn + (setq ,micro (car ,gensym)) + ,(cond (pico + `(if (cdr ,gensym) + ,(append `(setq ,pico (cadr ,gensym)) + (when type `(,type 3))) + ,(append `(setq ,pico 0) + (when type `(,type 2))))) + (type + `(setq type 2)))) ,(append `(setq ,micro 0) + (when pico `(,pico 0)) (when type `(,type 1))))) ,(append `(setq ,low ,gensym ,micro 0) + (when pico `(,pico 0)) (when type `(,type 0)))) (with-decoded-time-value ,varlist ,@body))) `(progn ,@body))) -(defun encode-time-value (high low micro type) - "Encode HIGH, LOW, and MICRO into a time value of type TYPE. +(defun encode-time-value (high low micro pico &optional type) + "Encode HIGH, LOW, MICRO, and PICO into a time value of type TYPE. Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH LOW), -and type 2 is the list (HIGH LOW MICRO)." +type 2 is (HIGH LOW MICRO), and type 3 is (HIGH LOW MICRO PICO). + +For backward compatibility, if only four arguments are given, +it is assumed that PICO was omitted and should be treated as zero." (cond ((eq type 0) (cons high low)) ((eq type 1) (list high low)) - ((eq type 2) (list high low micro)))) + ((eq type 2) (list high low micro)) + ((eq type 3) (list high low micro pico)) + ((null type) (encode-time-value high low micro 0 pico)))) (autoload 'parse-time-string "parse-time") (autoload 'timezone-make-date-arpa-standard "timezone") ;;;###autoload +;; `parse-time-string' isn't sufficiently general or robust. It fails +;; to grok some of the formats that timezone does (e.g. dodgy +;; post-2000 stuff from some Elms) and either fails or returns bogus +;; values. timezone-make-date-arpa-standard should help. (defun date-to-time (date) - "Parse a string that represents a date-time and return a time value." + "Parse a string DATE that represents a date-time and return a time value. +If DATE lacks timezone information, GMT is assumed." (condition-case () - (apply 'encode-time - (parse-time-string - ;; `parse-time-string' isn't sufficiently general or - ;; robust. It fails to grok some of the formats that - ;; timezone does (e.g. dodgy post-2000 stuff from some - ;; Elms) and either fails or returns bogus values. Lars - ;; reverted this change, but that loses non-trivially - ;; often for me. -- fx - (timezone-make-date-arpa-standard date))) - (error (error "Invalid date: %s" date)))) - -(defun time-to-seconds (time) - "Convert time value TIME to a floating point number. -You can use `float-time' instead." - (with-decoded-time-value ((high low micro time)) - (+ (* 1.0 high 65536) - low - (/ micro 1000000.0)))) + (apply 'encode-time (parse-time-string date)) + (error (condition-case () + (apply 'encode-time + (parse-time-string + (timezone-make-date-arpa-standard date))) + (error (error "Invalid date: %s" date)))))) + +;; Bit of a mess. Emacs has float-time since at least 21.1. +;; This file is synced to Gnus, and XEmacs packages may have been written +;; using time-to-seconds from the Gnus library. +;;;###autoload(if (or (featurep 'emacs) +;;;###autoload (and (fboundp 'float-time) +;;;###autoload (subrp (symbol-function 'float-time)))) +;;;###autoload (defalias 'time-to-seconds 'float-time) +;;;###autoload (autoload 'time-to-seconds "time-date")) + +(eval-when-compile + (or (featurep 'emacs) + (and (fboundp 'float-time) + (subrp (symbol-function 'float-time))) + (defun time-to-seconds (time) + "Convert time value TIME to a floating point number." + (with-decoded-time-value ((high low micro pico type time)) + (+ (* 1.0 high 65536) + low + (/ (+ (* micro 1e6) pico) 1e12)))))) ;;;###autoload (defun seconds-to-time (seconds) "Convert SECONDS (a floating point number) to a time value." - (list (floor seconds 65536) - (floor (mod seconds 65536)) - (floor (* (- seconds (ffloor seconds)) 1000000)))) + (let* ((usec (* 1000000 (mod seconds 1))) + (ps (round (* 1000000 (mod usec 1)))) + (us (floor usec)) + (lo (floor (mod seconds 65536))) + (hi (floor seconds 65536))) + (if (eq ps 1000000) + (progn + (setq ps 0) + (setq us (1+ us)) + (if (eq us 1000000) + (progn + (setq us 0) + (setq lo (1+ lo)) + (if (eq lo 65536) + (progn + (setq lo 0) + (setq hi (1+ hi)))))))) + (list hi lo us ps))) ;;;###autoload (defun time-less-p (t1 t2) - "Say whether time value T1 is less than time value T2." - (with-decoded-time-value ((high1 low1 micro1 t1) - (high2 low2 micro2 t2)) + "Return non-nil if time value T1 is earlier than time value T2." + (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1) + (high2 low2 micro2 pico2 type2 t2)) (or (< high1 high2) (and (= high1 high2) (or (< low1 low2) (and (= low1 low2) - (< micro1 micro2))))))) + (or (< micro1 micro2) + (and (= micro1 micro2) + (< pico1 pico2))))))))) ;;;###autoload (defun days-to-time (days) @@ -159,38 +205,46 @@ TIME should be either a time value or a date-time string." ;;;###autoload (defun time-subtract (t1 t2) - "Subtract two time values. + "Subtract two time values, T1 minus T2. Return the difference in the format of a time value." - (with-decoded-time-value ((high low micro type t1) - (high2 low2 micro2 type2 t2)) + (with-decoded-time-value ((high low micro pico type t1) + (high2 low2 micro2 pico2 type2 t2)) (setq high (- high high2) low (- low low2) micro (- micro micro2) + pico (- pico pico2) type (max type type2)) + (when (< pico 0) + (setq micro (1- micro) + pico (+ pico 1000000))) (when (< micro 0) (setq low (1- low) micro (+ micro 1000000))) (when (< low 0) (setq high (1- high) low (+ low 65536))) - (encode-time-value high low micro type))) + (encode-time-value high low micro pico type))) ;;;###autoload (defun time-add (t1 t2) - "Add two time values. One should represent a time difference." - (with-decoded-time-value ((high low micro type t1) - (high2 low2 micro2 type2 t2)) + "Add two time values T1 and T2. One should represent a time difference." + (with-decoded-time-value ((high low micro pico type t1) + (high2 low2 micro2 pico2 type2 t2)) (setq high (+ high high2) low (+ low low2) micro (+ micro micro2) + pico (+ pico pico2) type (max type type2)) + (when (>= pico 1000000) + (setq micro (1+ micro) + pico (- pico 1000000))) (when (>= micro 1000000) (setq low (1+ low) micro (- micro 1000000))) (when (>= low 65536) (setq high (1+ high) low (- low 65536))) - (encode-time-value high low micro type))) + (encode-time-value high low micro pico type))) ;;;###autoload (defun date-to-day (date) @@ -213,7 +267,7 @@ DATE1 and DATE2 should be date-time strings." ;;;###autoload (defun time-to-day-in-year (time) - "Return the day number within the year of the date month/day/year." + "Return the day number within the year corresponding to TIME." (let* ((tim (decode-time time)) (month (nth 4 tim)) (day (nth 3 tim)) @@ -231,10 +285,8 @@ DATE1 and DATE2 should be date-time strings." TIME should be a time value. The Gregorian date Sunday, December 31, 1bce is imaginary." (let* ((tim (decode-time time)) - (month (nth 4 tim)) - (day (nth 3 tim)) (year (nth 5 tim))) - (+ (time-to-day-in-year time) ; Days this year + (+ (time-to-day-in-year time) ; Days this year (* 365 (1- year)) ; + Days in prior years (/ (1- year) 4) ; + Julian leap years (- (/ (1- year) 100)) ; - century years @@ -242,12 +294,17 @@ The Gregorian date Sunday, December 31, 1bce is imaginary." (defun time-to-number-of-days (time) "Return the number of days represented by TIME. -The number of days will be returned as a floating point number." - (/ (time-to-seconds time) (* 60 60 24))) +Returns a floating point number." + (/ (funcall (eval-when-compile + (if (or (featurep 'emacs) + (and (fboundp 'float-time) + (subrp (symbol-function 'float-time)))) + 'float-time + 'time-to-seconds)) time) (* 60 60 24))) ;;;###autoload (defun safe-date-to-time (date) - "Parse a string that represents a date-time and return a time value. + "Parse a string DATE that represents a date-time and return a time value. If DATE is malformed, return a time value of zeros." (condition-case () (date-to-time date) @@ -291,9 +348,9 @@ This function does not work for SECONDS greater than `most-positive-fixnum'." (setq start (match-end 0) spec (match-string 1 string)) (unless (string-equal spec "%") - (or (setq match (assoc-string spec units t)) + (or (setq match (assoc (downcase spec) units)) (error "Bad format specifier: `%s'" spec)) - (if (assoc-string spec usedunits t) + (if (assoc (downcase spec) usedunits) (error "Multiple instances of specifier: `%s'" spec)) (if (string-equal (car match) "z") (setq zeroflag t) @@ -331,8 +388,24 @@ This function does not work for SECONDS greater than `most-positive-fixnum'." t t string)))))) (replace-regexp-in-string "%%" "%" string)) +(defvar seconds-to-string + (list (list 1 "ms" 0.001) + (list 100 "s" 1) + (list (* 60 100) "m" 60.0) + (list (* 3600 30) "h" 3600.0) + (list (* 3600 24 400) "d" (* 3600.0 24.0)) + (list nil "y" (* 365.25 24 3600))) + "Formatting used by the function `seconds-to-string'.") +;;;###autoload +(defun seconds-to-string (delay) + "Convert the time interval in seconds to a short string." + (cond ((> 0 delay) (concat "-" (seconds-to-string (- delay)))) + ((= 0 delay) "0s") + (t (let ((sts seconds-to-string) here) + (while (and (car (setq here (pop sts))) + (<= (car here) delay))) + (concat (format "%.2f" (/ delay (car (cddr here)))) (cadr here)))))) (provide 'time-date) -;;; arch-tag: addcf07b-b20a-465b-af72-550b8ac5190f ;;; time-date.el ends here