procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Remove some timestamp format assumptions

Browse source 
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.
This commit is contained in:
Paul Eggert 2019-02-22 13:24:16 -08:00
parent 0613e7a38e
commit eba66c1eaf
7 changed files with 48 additions and 83 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
lisp/gnus/gnus-art.el
View file

@ -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

8
lisp/gnus/gnus-demon.el
View file

@ -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)

45
lisp/gnus/gnus-diary.el
View file

@ -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

9
lisp/gnus/nnmaildir.el
View file

@ -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)

18
lisp/net/pop3.el
View file

@ -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)

10
lisp/org/ox-publish.el
View file

@ -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:

8
lisp/vc/vc-hg.el
View file

@ -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)))