From: Paul Eggert Date: Fri, 22 Feb 2019 21:24:16 +0000 (-0800) Subject: Remove some timestamp format assumptions X-Git-Tag: emacs-27.0.90~3558 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=eba66c1eafeef6512259c9b46face2b03c7433b8;p=emacs.git 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. --- diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 191f623afa3..0ea156118c6 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 4ae4c65d835..b9cb8eb71ce 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 51e39958798..ceb0d4a30da 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 9df2292e783..d7117a1ce20 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 3aac5b5c45c..cd6a113bffe 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 cd49cd0afc5..bc86a4d5635 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 342c6d214cd..6b17e861dda 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)))