/[emacs]/emacs/lisp/gnus/time-date.el
ViewVC logotype

Diff of /emacs/lisp/gnus/time-date.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by pj, Sun Jul 15 17:42:53 2001 UTC revision 1.4 by rms, Sun Jan 27 23:30:10 2002 UTC
# Line 32  Line 32 
32    
33  ;;;###autoload  ;;;###autoload
34  (defun date-to-time (date)  (defun date-to-time (date)
35    "Convert DATE into time."    "Parse a string that represents a date-time and return a time value."
36    (condition-case ()    (condition-case ()
37        (apply 'encode-time        (apply 'encode-time
38               (parse-time-string               (parse-time-string
# Line 46  Line 46 
46      (error (error "Invalid date: %s" date))))      (error (error "Invalid date: %s" date))))
47    
48  (defun time-to-seconds (time)  (defun time-to-seconds (time)
49    "Convert TIME to a floating point number."    "Convert time value TIME to a floating point number.
50    You can use `float-time' instead."
51    (+ (* (car time) 65536.0)    (+ (* (car time) 65536.0)
52       (cadr time)       (cadr time)
53       (/ (or (nth 2 time) 0) 1000000.0)))       (/ (or (nth 2 time) 0) 1000000.0)))
54    
55    ;;;###autoload
56  (defun seconds-to-time (seconds)  (defun seconds-to-time (seconds)
57    "Convert SECONDS (a floating point number) to an Emacs time structure."    "Convert SECONDS (a floating point number) to a time value."
58    (list (floor seconds 65536)    (list (floor seconds 65536)
59          (floor (mod seconds 65536))          (floor (mod seconds 65536))
60          (floor (* (- seconds (ffloor seconds)) 1000000))))          (floor (* (- seconds (ffloor seconds)) 1000000))))
61    
62    ;;;###autoload
63  (defun time-less-p (t1 t2)  (defun time-less-p (t1 t2)
64    "Say whether time T1 is less than time T2."    "Say whether time value T1 is less than time value T2."
65    (or (< (car t1) (car t2))    (or (< (car t1) (car t2))
66        (and (= (car t1) (car t2))        (and (= (car t1) (car t2))
67             (< (nth 1 t1) (nth 1 t2)))))             (< (nth 1 t1) (nth 1 t2)))))
68    
69    ;;;###autoload
70  (defun days-to-time (days)  (defun days-to-time (days)
71    "Convert DAYS into time."    "Convert DAYS into a time value."
72    (let* ((seconds (* 1.0 days 60 60 24))    (let* ((seconds (* 1.0 days 60 60 24))
73           (rest (expt 2 16))           (rest (expt 2 16))
74           (ms (condition-case nil (floor (/ seconds rest))           (ms (condition-case nil (floor (/ seconds rest))
# Line 72  Line 76 
76      (list ms (condition-case nil (round (- seconds (* ms rest)))      (list ms (condition-case nil (round (- seconds (* ms rest)))
77                 (range-error (expt 2 16))))))                 (range-error (expt 2 16))))))
78    
79    ;;;###autoload
80  (defun time-since (time)  (defun time-since (time)
81    "Return the time since TIME, which is either an internal time or a date."    "Return the time elapsed since TIME.
82    TIME should be either a time value or a date-time string."
83    (when (stringp time)    (when (stringp time)
84      ;; Convert date strings to internal time.      ;; Convert date strings to internal time.
85      (setq time (date-to-time time)))      (setq time (date-to-time time)))
# Line 83  Line 89 
89      (list (- (+ (car current) (if rest -1 0)) (car time))      (list (- (+ (car current) (if rest -1 0)) (car time))
90            (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))            (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
91    
92  (defun subtract-time (t1 t2)  ;;;###autoload
93    "Subtract two internal times."  (defalias 'subtract-time 'time-subtract)
94    
95    ;;;###autoload
96    (defun time-subtract (t1 t2)
97      "Subtract two time values.
98    Return the difference in the format of a time value."
99    (let ((borrow (< (cadr t1) (cadr t2))))    (let ((borrow (< (cadr t1) (cadr t2))))
100      (list (- (car t1) (car t2) (if borrow 1 0))      (list (- (car t1) (car t2) (if borrow 1 0))
101            (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))            (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
102    
103    ;;;###autoload
104    (defun time-add (t1 t2)
105      "Add two time values.  One should represent a time difference."
106      (let ((high (car t1))
107            (low (if (consp (cdr t1)) (nth 1 t1) (cdr t1)))
108            (micro (if (numberp (car-safe (cdr-safe (cdr t1))))
109                       (nth 2 t1)
110                     0))
111            (high2 (car t2))
112            (low2 (if (consp (cdr t2)) (nth 1 t2) (cdr t2)))
113            (micro2 (if (numberp (car-safe (cdr-safe (cdr t2))))
114                        (nth 2 t2)
115                      0)))
116        ;; Add
117        (setq micro (+ micro micro2))
118        (setq low (+ low low2))
119        (setq high (+ high high2))
120    
121        ;; Normalize
122        ;; `/' rounds towards zero while `mod' returns a positive number,
123        ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))).
124        (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0)))
125        (setq micro (mod micro 1000000))
126        (setq high (+ high (/ low 65536) (if (< low 0) -1 0)))
127        (setq low (logand low 65535))
128    
129        (list high low micro)))
130    
131    ;;;###autoload
132  (defun date-to-day (date)  (defun date-to-day (date)
133    "Return the number of days between year 1 and DATE."    "Return the number of days between year 1 and DATE.
134    DATE should be a date-time string."
135    (time-to-days (date-to-time date)))    (time-to-days (date-to-time date)))
136    
137    ;;;###autoload
138  (defun days-between (date1 date2)  (defun days-between (date1 date2)
139    "Return the number of days between DATE1 and DATE2."    "Return the number of days between DATE1 and DATE2.
140    DATE1 and DATE2 should be date-time strings."
141    (- (date-to-day date1) (date-to-day date2)))    (- (date-to-day date1) (date-to-day date2)))
142    
143    ;;;###autoload
144  (defun date-leap-year-p (year)  (defun date-leap-year-p (year)
145    "Return t if YEAR is a leap year."    "Return t if YEAR is a leap year."
146    (or (and (zerop (% year 4))    (or (and (zerop (% year 4))
147             (not (zerop (% year 100))))             (not (zerop (% year 100))))
148        (zerop (% year 400))))        (zerop (% year 400))))
149    
150    ;;;###autoload
151  (defun time-to-day-in-year (time)  (defun time-to-day-in-year (time)
152    "Return the day number within the year of the date month/day/year."    "Return the day number within the year of the date month/day/year."
153    (let* ((tim (decode-time time))    (let* ((tim (decode-time time))
# Line 116  Line 161 
161          (setq day-of-year (1+ day-of-year))))          (setq day-of-year (1+ day-of-year))))
162      day-of-year))      day-of-year))
163    
164    ;;;###autoload
165  (defun time-to-days (time)  (defun time-to-days (time)
166    "The number of days between the Gregorian date 0001-12-31bce and TIME.    "The number of days between the Gregorian date 0001-12-31bce and TIME.
167    TIME should be a time value.
168  The Gregorian date Sunday, December 31, 1bce is imaginary."  The Gregorian date Sunday, December 31, 1bce is imaginary."
169    (let* ((tim (decode-time time))    (let* ((tim (decode-time time))
170           (month (nth 4 tim))           (month (nth 4 tim))
# Line 131  The Gregorian date Sunday, December 31, Line 178  The Gregorian date Sunday, December 31,
178    
179  ;;;###autoload  ;;;###autoload
180  (defun safe-date-to-time (date)  (defun safe-date-to-time (date)
181    "Parse DATE and return a time structure.    "Parse a string that represents a date-time and return a time value.
182  If DATE is malformed, a zero time will be returned."  If DATE is malformed, return a time value of zeros."
183    (condition-case ()    (condition-case ()
184        (date-to-time date)        (date-to-time date)
185      (error '(0 0))))      (error '(0 0))))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26