[Emacs-diffs] master eba66c1: Remove some timestamp format assumptions

[Paul Eggert]

branch: master
commit eba66c1eafeef6512259c9b46face2b03c7433b8
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    Remove some timestamp format assumptions
    
    Don’t assume that current-time and plain encode-time return
    timestamps in (HI LO US PS) format.
    * lisp/gnus/gnus-art.el (article-make-date-line)
    (article-lapsed-string):
    * lisp/gnus/gnus-demon.el (gnus-demon-time-to-step):
    * lisp/gnus/gnus-diary.el (gnus-user-format-function-d):
    * lisp/gnus/nnmaildir.el (nnmaildir-request-expire-articles):
    * lisp/net/pop3.el (pop3-uidl-dele):
    * lisp/org/ox-publish.el (org-publish-sitemap):
    * lisp/vc/vc-hg.el (vc-hg-state-fast):
    Simplify and remove assumptions about timestamp format.
    * lisp/gnus/gnus-art.el (article-lapsed-string):
    * lisp/gnus/gnus-diary.el (gnus-user-format-function-d):
    Do not worry about time-subtract returning nil; that's not possible.
    * lisp/gnus/gnus-diary.el (gnus-user-format-function-d):
    Avoid race due to duplicate current-time calls.
    * lisp/vc/vc-hg.el (vc-hg--time-to-integer): Remove; no longer used.
---
 lisp/gnus/gnus-art.el   | 33 ++++++++-------------------------
 lisp/gnus/gnus-demon.el |  8 +++-----
 lisp/gnus/gnus-diary.el | 45 +++++++++++++++++++++------------------------
 lisp/gnus/nnmaildir.el  |  9 +--------
 lisp/net/pop3.el        | 18 ++++++++----------
 lisp/org/ox-publish.el  | 10 ++++------
 lisp/vc/vc-hg.el        |  8 +++-----
 7 files changed, 48 insertions(+), 83 deletions(-)

diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 191f623..0ea1561 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3540,18 +3540,11 @@ possible values."
          (concat "Date: " (message-make-date time)))
         ;; Convert to Universal Time.
         ((eq type 'ut)
-         (concat "Date: "
-                 (substring
-                  (message-make-date
-                   (let* ((e (parse-time-string date))
-                          (tm (encode-time e))
-                          (ms (car tm))
-                          (ls (- (cadr tm) (car (current-time-zone time)))))
-                     (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
-                           ((> ls 65535) (list (1+ ms) (- ls 65536)))
-                           (t (list ms ls)))))
-                  0 -5)
-                 "UT"))
+         (let ((system-time-locale "C"))
+           (format-time-string
+            "Date: %a, %d %b %Y %T UT"
+            (encode-time (parse-time-string date))
+            t)))
         ;; Get the original date from the article.
         ((eq type 'original)
          (concat "Date: " (if (string-match "\n+$" date)
@@ -3569,13 +3562,7 @@ possible values."
              (concat "Date: " (format-time-string format time)))))
         ;; ISO 8601.
         ((eq type 'iso8601)
-         (let ((tz (car (current-time-zone time))))
-           (concat
-            "Date: "
-            (format-time-string "%Y%m%dT%H%M%S" time)
-            (format "%s%02d%02d"
-                    (if (> tz 0) "+" "-") (/ (abs tz) 3600)
-                    (/ (% (abs tz) 3600) 60)))))
+         (format-time-string "Date: %Y%m%dT%H%M%S%z" time))
         ;; Do a lapsed format.
         ((eq type 'lapsed)
          (concat "Date: " (article-lapsed-string time)))
@@ -3624,17 +3611,13 @@ possible values."
   ;; If the date is seriously mangled, the timezone functions are
   ;; liable to bug out, so we ignore all errors.
   (let* ((real-time (time-subtract nil time))
-        (real-sec (and real-time
-                       (+ (* (float (car real-time)) 65536)
-                          (cadr real-time))))
-        (sec (and real-time (abs real-sec)))
+        (real-sec (float-time real-time))
+        (sec (abs real-sec))
         (segments 0)
         num prev)
     (unless max-segments
       (setq max-segments (length article-time-units)))
     (cond
-     ((null real-time)
-      "Unknown")
      ((zerop sec)
       "Now")
      (t
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 4ae4c65..b9cb8eb 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -192,11 +192,9 @@ marked with SPECIAL."
                            (elt nowParts 6)
                            (elt nowParts 7)
                            (elt nowParts 8)))
-        ;; calculate number of seconds between NOW and THEN
-        (diff (+ (* 65536 (- (car then) (car now)))
-                 (- (cadr then) (cadr now)))))
-    ;; return number of timesteps in the number of seconds
-    (round (/ diff gnus-demon-timestep))))
+        (diff (float-time (time-subtract then now))))
+    ;; Return number of timesteps in the number of seconds.
+    (round diff gnus-demon-timestep)))
 
 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
 
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index 51e3995..ceb0d4a 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -159,32 +159,29 @@ There are currently two built-in format functions:
   ;; Code partly stolen from article-make-date-line
   (let* ((extras (mail-header-extra header))
         (sched (gnus-diary-header-schedule extras))
-        (occur (nndiary-next-occurrence sched (current-time)))
         (now (current-time))
+        (occur (nndiary-next-occurrence sched now))
         (real-time (time-subtract occur now)))
-    (if (null real-time)
-       "?????"
-      (let* ((sec (+ (* (float (car real-time)) 65536) (cadr real-time)))
-            (past (< sec 0))
-            delay)
-       (and past (setq sec (- sec)))
-       (unless (zerop sec)
-         ;; This is a bit convoluted, but basically we go through the time
-         ;; units for years, weeks, etc, and divide things to see whether
-         ;; that results in positive answers.
-         (let ((units `((year . ,(* 365.25 24 3600))
-                        (month . ,(* 31 24 3600))
-                        (week . ,(* 7 24 3600))
-                        (day . ,(* 24 3600))
-                        (hour . 3600)
-                        (minute . 60)))
-               unit num)
-           (while (setq unit (pop units))
-             (unless (zerop (setq num (ffloor (/ sec (cdr unit)))))
-               (setq delay (append delay `((,(floor num) . ,(car unit))))))
-             (setq sec (- sec (* num (cdr unit)))))))
-       (funcall gnus-diary-delay-format-function past delay)))
-    ))
+    (let* ((sec (encode-time real-time 'integer))
+          (past (< sec 0))
+          delay)
+      (and past (setq sec (- sec)))
+      (unless (zerop sec)
+       ;; This is a bit convoluted, but basically we go through the time
+       ;; units for years, weeks, etc, and divide things to see whether
+       ;; that results in positive answers.
+       (let ((units `((year . ,(round (* 365.25 24 3600)))
+                      (month . ,(* 31 24 3600))
+                      (week . ,(* 7 24 3600))
+                      (day . ,(* 24 3600))
+                      (hour . 3600)
+                      (minute . 60)))
+             unit num)
+         (while (setq unit (pop units))
+           (unless (zerop (setq num (floor sec (cdr unit))))
+             (setq delay (append delay `((,num . ,(car unit))))))
+           (setq sec (mod sec (cdr unit))))))
+      (funcall gnus-diary-delay-format-function past delay))))
 
 ;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any
 ;; message, with all fields set to nil here. I don't know what it is for, and
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 9df2292..d7117a1 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1577,14 +1577,7 @@ This variable is set by `nnmaildir-request-article'.")
       (when no-force
        (unless (integerp time) ;; handle 'never
          (throw 'return (gnus-uncompress-range ranges)))
-       (setq boundary (current-time)
-             high (- (car boundary) (/ time 65536))
-             low (- (cadr boundary) (% time 65536)))
-       (if (< low 0)
-           (setq low (+ low 65536)
-                 high (1- high)))
-       (setcar (cdr boundary) low)
-       (setcar boundary high))
+       (setq boundary (time-subtract nil time)))
       (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
            dir (nnmaildir--srvgrp-dir dir gname)
            dir (nnmaildir--cur dir)
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index 3aac5b5..cd6a113 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -180,8 +180,8 @@ Shorter values mean quicker response, but are more CPU 
intensive.")
 ;;  ("SERVER_B" ("USER_B1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
 ;;              ("USER_B2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...)
 ;;              ...))
-;; Where TIMESTAMP is the most significant two digits of an Emacs time,
-;; i.e. the return value of `current-time'.
+;; Where TIMESTAMP is an Emacs time value (HI LO) representing the
+;; number of seconds (+ (ash HI 16) LO).
 
 ;;;###autoload
 (defun pop3-movemail (file)
@@ -380,7 +380,9 @@ Use streaming commands."
 (defun pop3-uidl-dele (process)
   "Delete messages according to `pop3-leave-mail-on-server'.
 Return non-nil if it is necessary to update the local UIDL file."
-  (let* ((ctime (current-time))
+  (let* ((ctime (encode-time nil 'list))
+        (age-limit (and (numberp pop3-leave-mail-on-server)
+                        (* 86400 pop3-leave-mail-on-server)))
         (srvr (assoc pop3-mailhost pop3-uidl-saved))
         (saved (assoc pop3-maildrop (cdr srvr)))
         i uidl mod new tstamp dele)
@@ -397,17 +399,13 @@ Return non-nil if it is necessary to update the local 
UIDL file."
           (setq new (mapcan (lambda (elt) (list elt ctime)) pop3-uidl))))
     (when new (setq mod t))
     ;; List expirable messages and delete them from the data to be saved.
-    (setq ctime (when (numberp pop3-leave-mail-on-server)
-                 (/ (+ (* (car ctime) 65536.0) (cadr ctime)) 86400))
-         i (1- (length saved)))
+    (setq i (1- (length saved)))
     (while (> i 0)
       (if (member (setq uidl (nth (1- i) saved)) pop3-uidl)
          (progn
            (setq tstamp (nth i saved))
-           (if (and ctime
-                    (> (- ctime (/ (+ (* (car tstamp) 65536.0) (cadr tstamp))
-                                   86400))
-                       pop3-leave-mail-on-server))
+           (if (and age-limit
+                    (time-less-p age-limit (time-subtract ctime tstamp)))
                ;; Mails to delete.
                (progn
                  (setq mod t)
diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el
index cd49cd0..bc86a4d 100644
--- a/lisp/org/ox-publish.el
+++ b/lisp/org/ox-publish.el
@@ -793,13 +793,11 @@ Default for SITEMAP-FILENAME is `sitemap.org'."
                           (not (string-lessp B A))))))
                ((or `anti-chronologically `chronologically)
                 (let* ((adate (org-publish-find-date a project))
-                       (bdate (org-publish-find-date b project))
-                       (A (+ (ash (car adate) 16) (cadr adate)))
-                       (B (+ (ash (car bdate) 16) (cadr bdate))))
+                       (bdate (org-publish-find-date b project)))
                   (setq retval
-                        (if (eq sort-files 'chronologically)
-                            (<= A B)
-                          (>= A B)))))
+                        (not (if (eq sort-files 'chronologically)
+                                 (time-less-p bdate adate)
+                               (time-less-p adate bdate))))))
                (`nil nil)
                (_ (user-error "Invalid sort value %s" sort-files)))
              ;; Directory-wise wins:
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 342c6d2..6b17e861 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -923,9 +923,6 @@ FILENAME must be the file's true absolute name."
       (setf ignored (string-match (pop patterns) filename)))
     ignored))
 
-(defun vc-hg--time-to-integer (ts)
-  (+ (* 65536 (car ts)) (cadr ts)))
-
 (defvar vc-hg--cached-ignore-patterns nil
   "Cached pre-parsed hg ignore patterns.")
 
@@ -1046,8 +1043,9 @@ hg binary."
                (let ((vc-hg-size (nth 2 dirstate-entry))
                      (vc-hg-mtime (nth 3 dirstate-entry))
                      (fs-size (file-attribute-size stat))
-                     (fs-mtime (vc-hg--time-to-integer
-                               (file-attribute-modification-time stat))))
+                    (fs-mtime (encode-time
+                               (file-attribute-modification-time stat)
+                               'integer)))
                  (if (and (eql vc-hg-size fs-size) (eql vc-hg-mtime fs-mtime))
                      'up-to-date
                    'edited)))