X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Ftime-date.el;h=64293500ed28eb1d3b6abbb4b15ddfbd5b2b59c8;hb=74a489ff1213794152d6e13f7a11e16c89f62602;hp=d41145b944d487a485515ebf6923f23b4c720004;hpb=c358f44b1670d12d5eff5fe5a447a19afd34a252;p=gnus diff --git a/lisp/time-date.el b/lisp/time-date.el index d41145b94..64293500e 100644 --- a/lisp/time-date.el +++ b/lisp/time-date.el @@ -1,7 +1,7 @@ ;;; 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, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Masanobu Umeda @@ -9,20 +9,18 @@ ;; 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: @@ -41,6 +39,9 @@ ;;; Code: +;; Only necessary for `declare' when compiling Gnus with Emacs 21. +(eval-when-compile (require 'cl)) + (defmacro with-decoded-time-value (varlist &rest body) "Decode a time value and bind it according to VARLIST, then eval BODY. @@ -97,7 +98,8 @@ and type 2 is the list (HIGH LOW MICRO)." ;;;###autoload (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 @@ -110,13 +112,30 @@ and type 2 is the list (HIGH LOW MICRO)." (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)))) +;; 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 (and (fboundp 'float-time) +;;;###autoload (subrp (symbol-function 'float-time))) +;;;###autoload (progn +;;;###autoload (defalias 'time-to-seconds 'float-time) +;;;###autoload (make-obsolete 'time-to-seconds 'float-time "21.1")) +;;;###autoload (autoload 'time-to-seconds "time-date")) + +(eval-and-compile + (unless (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 time)) + (+ (* 1.0 high 65536) + low + (/ micro 1000000.0)))))) + +(eval-when-compile + (unless (fboundp 'with-no-warnings) + (defmacro with-no-warnings (&rest body) + `(progn ,@body)))) ;;;###autoload (defun seconds-to-time (seconds) @@ -159,7 +178,7 @@ 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)) @@ -177,7 +196,7 @@ Return the difference in the format of a time value." ;;;###autoload (defun time-add (t1 t2) - "Add two time values. One should represent a time difference." + "Add two time values T1 and T2. One should represent a time difference." (with-decoded-time-value ((high low micro type t1) (high2 low2 micro2 type2 t2)) (setq high (+ high high2) @@ -213,7 +232,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)) @@ -240,20 +259,109 @@ The Gregorian date Sunday, December 31, 1bce is imaginary." (- (/ (1- year) 100)) ; - century years (/ (1- year) 400)))) ; + Gregorian leap years -(defun time-to-number-of-days (time) - "Return the number of days represented by TIME. +(eval-and-compile + (if (and (fboundp 'float-time) + (subrp (symbol-function 'float-time))) + (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." + (/ (float-time time) (* 60 60 24))) + (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))) + (/ (with-no-warnings (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) (error '(0 0)))) + +;;;###autoload +(defun format-seconds (string seconds) + "Use format control STRING to format the number SECONDS. +The valid format specifiers are: +%y is the number of (365-day) years. +%d is the number of days. +%h is the number of hours. +%m is the number of minutes. +%s is the number of seconds. +%z is a non-printing control flag (see below). +%% is a literal \"%\". + +Upper-case specifiers are followed by the unit-name (e.g. \"years\"). +Lower-case specifiers return only the unit. + +\"%\" may be followed by a number specifying a width, with an +optional leading \".\" for zero-padding. For example, \"%.3Y\" will +return something of the form \"001 year\". + +The \"%z\" specifier does not print anything. When it is used, specifiers +must be given in order of decreasing size. To the left of \"%z\", nothing +is output until the first non-zero unit is encountered. + +This function does not work for SECONDS greater than `most-positive-fixnum'." + (let ((start 0) + (units '(("y" "year" 31536000) + ("d" "day" 86400) + ("h" "hour" 3600) + ("m" "minute" 60) + ("s" "second" 1) + ("z"))) + (case-fold-search t) + spec match usedunits zeroflag larger prev name unit num zeropos) + (while (string-match "%\\.?[0-9]*\\(.\\)" string start) + (setq start (match-end 0) + spec (match-string 1 string)) + (unless (string-equal spec "%") + ;; `assoc-string' is not available in XEmacs or Emacs 21. So when + ;; compiling Gnus (`time-date.el' is part of Gnus) with XEmacs or + ;; Emacs 21, we get a warning here. But `format-seconds' is not + ;; used anywhere in Gnus so it's not a real problem. --rsteib + (or (setq match (assoc-string spec units t)) + (error "Bad format specifier: `%s'" spec)) + (if (assoc-string spec usedunits t) + (error "Multiple instances of specifier: `%s'" spec)) + (if (string-equal (car match) "z") + (setq zeroflag t) + (unless larger + (setq unit (nth 2 match) + larger (and prev (> unit prev)) + prev unit))) + (push match usedunits))) + (and zeroflag larger + (error "Units are not in decreasing order of size")) + (dolist (u units) + (setq spec (car u) + name (cadr u) + unit (nth 2 u)) + (when (string-match (format "%%\\(\\.?[0-9]+\\)?\\(%s\\)" spec) string) + (if (string-equal spec "z") ; must be last in units + (setq string + (replace-regexp-in-string + "%z" "" + (substring string (min (or zeropos (match-end 0)) + (match-beginning 0))))) + ;; Cf article-make-date-line in gnus-art. + (setq num (floor seconds unit) + seconds (- seconds (* num unit))) + ;; Start position of the first non-zero unit. + (or zeropos + (setq zeropos (unless (zerop num) (match-beginning 0)))) + (setq string + (replace-match + (format (concat "%" (match-string 1 string) "d%s") num + (if (string-equal (match-string 2 string) spec) + "" ; lower-case, no unit-name + (format " %s%s" name + (if (= num 1) "" "s")))) + t t string)))))) + (replace-regexp-in-string "%%" "%" string)) + + (provide 'time-date) -;;; arch-tag: addcf07b-b20a-465b-af72-550b8ac5190f ;;; time-date.el ends here