Commit eba66c1e authored by Paul Eggert's avatar Paul Eggert

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