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):
This commit is contained in:
parent
2bfa42855b
commit
3aee7be62e
11 changed files with 35 additions and 38 deletions
|
@ -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)
|
||||
|
|
Loading…
Add table
Reference in a new issue