Commit 3aee7be6 authored by Paul Eggert's avatar Paul Eggert

Avoid unnecessary rounding errors in timestamps

Avoid the rounding errors of float-time when it’s easy.  E.g.,
replace (< (float-time a) (float-time b)) with (time-less-p a b).
* lisp/desktop.el (desktop-save):
* lisp/ecomplete.el (ecomplete-add-item):
* lisp/epg.el (epg-wait-for-completion):
* lisp/files.el (dir-locals-find-file, dir-locals-read-from-dir):
* lisp/image-dired.el (image-dired-get-thumbnail-image)
(image-dired-create-thumb-1):
* lisp/info.el (info-insert-file-contents):
* lisp/ls-lisp.el (ls-lisp-format-time):
* lisp/net/ange-ftp.el (ange-ftp-file-newer-than-file-p)
(ange-ftp-verify-visited-file-modtime):
* lisp/net/rcirc.el (rcirc-ctcp-sender-PING):
* lisp/textmodes/remember.el (remember-store-in-mailbox):
* lisp/url/url-cookie.el (url-cookie-expired-p):
Bypass float-time to avoid rounding errors.

* lisp/files.el (dir-locals-find-file):
parent 2bfa4285
......@@ -1046,7 +1046,8 @@ without further confirmation."
(or (not new-modtime) ; nothing to overwrite
(equal desktop-file-modtime new-modtime)
(yes-or-no-p (if desktop-file-modtime
(if (> (float-time new-modtime) (float-time desktop-file-modtime))
(if (time-less-p desktop-file-modtime
new-modtime)
"Desktop file is more recent than the one loaded. Save anyway? "
"Desktop file isn't the one loaded. Overwrite it? ")
"Current desktop was not loaded from a file. Overwrite this desktop file? "))
......
......@@ -55,7 +55,7 @@
(defun ecomplete-add-item (type key text)
(let ((elems (assq type ecomplete-database))
(now (string-to-number (format "%.0f" (float-time))))
(now (string-to-number (format-time-string "%s")))
entry)
(unless elems
(push (setq elems (list type)) ecomplete-database))
......
......@@ -757,9 +757,8 @@ callback data (if any)."
;; Restore Emacs frame on text terminal, when pinentry-curses has terminated.
(if (with-current-buffer (process-buffer (epg-context-process context))
(and epg-agent-file
(> (float-time (or (nth 5 (file-attributes epg-agent-file))
'(0 0 0 0)))
(float-time epg-agent-mtime))))
(time-less-p epg-agent-mtime
(or (nth 5 (file-attributes epg-agent-file)) 0))))
(redraw-frame))
(epg-context-set-result-for
context 'error
......
......@@ -3947,11 +3947,12 @@ This function returns either:
;; The entry MTIME should match the most recent
;; MTIME among matching files.
(and cached-files
(= (float-time (nth 2 dir-elt))
(apply #'max (mapcar (lambda (f)
(float-time
(nth 5 (file-attributes f))))
cached-files))))))
(equal (nth 2 dir-elt)
(let ((latest 0))
(dolist (f cached-files latest)
(let ((f-time (nth 5 (file-attributes f))))
(if (time-less-p latest f-time)
(setq latest f-time)))))))))
;; This cache entry is OK.
dir-elt
;; This cache entry is invalid; clear it.
......@@ -3973,10 +3974,15 @@ Return the new class name, which is a symbol named DIR."
(let* ((class-name (intern dir))
(files (dir-locals--all-files dir))
(read-circle nil)
(success nil)
;; If there was a problem, use the values we could get but
;; don't let the cache prevent future reads.
(latest 0) (success 0)
(variables))
(with-demoted-errors "Error reading dir-locals: %S"
(dolist (file files)
(let ((file-time (nth 5 (file-attributes file))))
(if (time-less-p latest file-time)
(setq latest file-time)))
(with-temp-buffer
(insert-file-contents file)
(condition-case-unless-debug nil
......@@ -3985,18 +3991,9 @@ Return the new class name, which is a symbol named DIR."
variables
(read (current-buffer))))
(end-of-file nil))))
(setq success t))
(setq success latest))
(dir-locals-set-class-variables class-name variables)
(dir-locals-set-directory-class
dir class-name
(seconds-to-time
(if success
(apply #'max (mapcar (lambda (file)
(float-time (nth 5 (file-attributes file))))
files))
;; If there was a problem, use the values we could get but
;; don't let the cache prevent future reads.
0)))
(dir-locals-set-directory-class dir class-name success)
class-name))
(define-obsolete-function-alias 'dir-locals-read-from-file
......
......@@ -582,10 +582,11 @@ Create the thumbnails directory if it does not exist."
"Return the image descriptor for a thumbnail of image file FILE."
(unless (string-match (image-file-name-regexp) file)
(error "%s is not a valid image file" file))
(let ((thumb-file (image-dired-thumb-name file)))
(unless (and (file-exists-p thumb-file)
(<= (float-time (nth 5 (file-attributes file)))
(float-time (nth 5 (file-attributes thumb-file)))))
(let* ((thumb-file (image-dired-thumb-name file))
(thumb-attr (file-attributes thumb-file)))
(when (or (not thumb-attr)
(time-less-p (nth 5 thumb-attr)
(nth 5 (file-attributes file))))
(image-dired-create-thumb file thumb-file))
(create-image thumb-file)
;; (list 'image :type 'jpeg
......@@ -748,10 +749,8 @@ Increase at own risk.")
'image-dired-cmd-create-thumbnail-program)
(let* ((width (int-to-string (image-dired-thumb-size 'width)))
(height (int-to-string (image-dired-thumb-size 'height)))
(modif-time
(format "%.0f"
(ffloor (float-time
(nth 5 (file-attributes original-file))))))
(modif-time (format-time-string
"%s" (nth 5 (file-attributes original-file))))
(thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png"
thumbnail-file))
(spec
......
......@@ -649,7 +649,7 @@ Do the right thing if the file has been compressed or zipped."
(attribs-new (and (stringp fullname) (file-attributes fullname)))
(modtime-new (and attribs-new (nth 5 attribs-new))))
(when (and modtime-old modtime-new
(> (float-time modtime-new) (float-time modtime-old)))
(time-less-p modtime-old modtime-new))
(setq Info-index-nodes (remove (assoc (or Info-current-file filename)
Info-index-nodes)
Info-index-nodes))
......
......@@ -861,7 +861,7 @@ Use the same method as ls to decide whether to show time-of-day or year,
depending on distance between file date and the current time.
All ls time options, namely c, t and u, are handled."
(let* ((time (nth (or time-index 5) file-attr)) ; default is last modtime
(diff (- (float-time time) (float-time)))
(diff (time-subtract time nil))
;; Consider a time to be recent if it is within the past six
;; months. A Gregorian year has 365.2425 * 24 * 60 * 60 ==
;; 31556952 seconds on the average, and half of that is 15778476.
......@@ -878,7 +878,8 @@ All ls time options, namely c, t and u, are handled."
(if (member locale '("C" "POSIX"))
(setq locale nil))
(format-time-string
(if (and (<= past-cutoff diff) (<= diff 0))
(if (and (not (time-less-p diff past-cutoff))
(not (time-less-p 0 diff)))
(if (and locale (not ls-lisp-use-localized-time-format))
"%m-%d %H:%M"
(nth 0 ls-lisp-format-time-list))
......
......@@ -3479,7 +3479,7 @@ system TYPE.")
(f2-mt (nth 5 (file-attributes f2))))
(cond ((null f1-mt) nil)
((null f2-mt) t)
(t (> (float-time f1-mt) (float-time f2-mt)))))
(t (time-less-p f2-mt f1-mt))))
(ange-ftp-real-file-newer-than-file-p f1 f2))))
(defun ange-ftp-file-writable-p (file)
......@@ -3561,7 +3561,7 @@ Value is (0 0) if the modification time cannot be determined."
(let ((file-mdtm (ange-ftp-file-modtime name))
(buf-mdtm (with-current-buffer buf (visited-file-modtime))))
(or (zerop (car file-mdtm))
(<= (float-time file-mdtm) (float-time buf-mdtm))))
(not (time-less-p buf-mdtm file-mdtm))))
(ange-ftp-real-verify-visited-file-modtime buf))))
(defun ange-ftp-file-size (file &optional ascii-mode)
......
......@@ -2333,7 +2333,7 @@ With a prefix arg, prompt for new topic."
(defun rcirc-ctcp-sender-PING (process target _request)
"Send a CTCP PING message to TARGET."
(let ((timestamp (format "%.0f" (float-time))))
(let ((timestamp (format-time-string "%s")))
(rcirc-send-ctcp process target "PING" timestamp)))
(defun rcirc-cmd-me (args &optional process target)
......
......@@ -349,7 +349,7 @@ In which case `remember-mailbox' should be the name of the mailbox.
Each piece of pseudo-mail created will have an `X-Todo-Priority'
field, for the purpose of appropriate splitting."
(let ((who (read-string "Who is this item related to? "))
(moment (format "%.0f" (float-time)))
(moment (format-time-string "%s"))
(desc (remember-buffer-desc))
(text (buffer-string)))
(with-temp-buffer
......
......@@ -161,7 +161,7 @@ telling Microsoft that."
(let ((exp (url-cookie-expires cookie)))
(and (> (length exp) 0)
(condition-case ()
(> (float-time) (float-time (date-to-time exp)))
(time-less-p nil (date-to-time exp))
(error nil)))))
(defun url-cookie-retrieve (host &optional localpart secure)
......
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