Backport commit 476066e89 from Emacs

* lisp/org-clock.el (org-clock-out):
* lisp/org.el (org-evaluate-time-range):
Avoid double-rounding of time-related values.  Simplify.
* lisp/org-clock.el (org-resolve-clocks-if-idle):
Use time-since instead of open-coding most of it.
* lisp/org-agenda.el (org-agenda-show-clocking-issues):
* lisp/org-capture.el (org-capture-set-target-location):
* lisp/org-table.el (org-table-sum):
* lisp/org.el (org-babel-load-file, org-2ft, org-time-stamp)
(org-read-date-analyze, org-time-stamp-to-now):
Simplify.

Note(km): Many of the changes from 476066e89 have been dropped for
compatibility with older Emacsen.

Avoid some double-rounding of Lisp timestamps
476066e89d6f0bb87220da690b8a476bf9655b80
Paul Eggert
Fri Feb 22 18:33:57 2019 -0800
This commit is contained in:
Paul Eggert 2019-02-22 18:32:31 -08:00 committed by Kyle Meyer
parent 1b15d5ef8e
commit a6cead0d21
7 changed files with 37 additions and 45 deletions

View File

@ -5879,12 +5879,12 @@ See also the user option `org-agenda-clock-consistency-checks'."
((> dt (* 60 maxtime))
;; a very long clocking chunk
(setq issue (format "Clocking interval is very long: %s"
(org-duration-from-minutes (floor (/ dt 60.))))
(org-duration-from-minutes (floor dt 60)))
face (or (plist-get pl :long-face) face)))
((< dt (* 60 mintime))
;; a very short clocking chunk
(setq issue (format "Clocking interval is very short: %s"
(org-duration-from-minutes (floor (/ dt 60.))))
(org-duration-from-minutes (floor dt 60)))
face (or (plist-get pl :short-face) face)))
((and (> tlend 0) (< ts tlend))
;; Two clock entries are overlapping

View File

@ -1003,8 +1003,7 @@ Store them in the capture property list."
(equal current-prefix-arg 1))
;; Prompt for date.
(let ((prompt-time (org-read-date
nil t nil "Date for tree entry:"
(current-time))))
nil t nil "Date for tree entry:")))
(org-capture-put
:default-time
(cond ((and (or (not (boundp 'org-time-was-given))

View File

@ -1169,8 +1169,7 @@ so long."
org-clock-marker (marker-buffer org-clock-marker))
(let* ((org-clock-user-idle-seconds (org-user-idle-seconds))
(org-clock-user-idle-start
(time-subtract (current-time)
(seconds-to-time org-clock-user-idle-seconds)))
(time-since (seconds-to-time org-clock-user-idle-seconds)))
(org-clock-resolving-clocks-due-to-idleness t))
(if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time))
(org-clock-resolve
@ -1179,9 +1178,8 @@ so long."
(lambda (_)
(format "Clocked in & idle for %.1f mins"
(/ (float-time
(time-subtract (current-time)
org-clock-user-idle-start))
60.0)))
(time-since org-clock-user-idle-start))
60)))
org-clock-user-idle-start)))))
(defvar org-clock-current-task nil "Task currently clocked in.")
@ -1600,7 +1598,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
;; Possibly remove zero time clocks. However, do not add
;; a note associated to the CLOCK line in this case.
(cond ((and org-clock-out-remove-zero-time-clocks
(= (+ h m) 0))
(= 0 h m))
(setq remove t)
(delete-region (line-beginning-position)
(line-beginning-position 2)))

View File

@ -316,11 +316,10 @@ When optional argument CANONICAL is non-nil, ignore
Raise an error if expected format is unknown."
(pcase (or fmt org-duration-format)
(`h:mm
(let ((minutes (floor minutes)))
(format "%d:%02d" (/ minutes 60) (mod minutes 60))))
(format "%d:%02d" (/ minutes 60) (mod minutes 60)))
(`h:mm:ss
(let* ((whole-minutes (floor minutes))
(seconds (floor (* 60 (- minutes whole-minutes)))))
(seconds (mod (* 60 minutes) 60)))
(format "%s:%02d"
(org-duration-from-minutes whole-minutes 'h:mm)
seconds)))
@ -401,9 +400,7 @@ Raise an error if expected format is unknown."
(pcase-let* ((`(,unit . ,required?) units)
(modifier (org-duration--modifier unit canonical)))
(cond ((<= modifier minutes)
(let ((value (if (integerp modifier)
(/ (floor minutes) modifier)
(floor (/ minutes modifier)))))
(let ((value (floor minutes modifier)))
(cl-decf minutes (* value modifier))
(format " %d%s" value unit)))
(required? (concat " 0" unit))

View File

@ -1082,8 +1082,8 @@ nil, just return 0."
((stringp s)
(condition-case nil
(float-time (apply #'encode-time (org-parse-time-string s)))
(error 0.)))
(t 0.)))
(error 0)))
(t 0)))
(defun org-time= (a b)
(let ((a (org-2ft a))

View File

@ -2198,8 +2198,8 @@ If NLAST is a number, only the NLAST fields will actually be summed."
(sres (if (= org-timecnt 0)
(number-to-string res)
(setq diff (* 3600 res)
h (floor (/ diff 3600)) diff (mod diff 3600)
m (floor (/ diff 60)) diff (mod diff 60)
h (floor diff 3600) diff (mod diff 3600)
m (floor diff 60) diff (mod diff 60)
s diff)
(format "%.0f:%02.0f:%02.0f" h m s))))
(kill-new sres)

View File

@ -253,10 +253,10 @@ file to byte-code before it is loaded."
(interactive "fFile to load: \nP")
(let* ((age (lambda (file)
(float-time
(time-subtract (current-time)
(file-attribute-modification-time
(or (file-attributes (file-truename file))
(file-attributes file)))))))
(time-since
(file-attribute-modification-time
(or (file-attributes (file-truename file))
(file-attributes file)))))))
(base-name (file-name-sans-extension file))
(exported-file (concat base-name ".el")))
;; tangle if the Org file is newer than the elisp file
@ -16049,8 +16049,8 @@ non-nil."
((org-at-timestamp-p 'lax) (match-string 0))))
;; Default time is either the timestamp at point or today.
;; When entering a range, only the range start is considered.
(default-time (if (not ts) (current-time)
(apply #'encode-time (org-parse-time-string ts))))
(default-time (and ts
(apply #'encode-time (org-parse-time-string ts))))
(default-input (and ts (org-get-compact-tod ts)))
(repeater (and ts
(string-match "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ts)
@ -16058,13 +16058,13 @@ non-nil."
org-time-was-given
org-end-time-was-given
(time
(and (if (equal arg '(16)) (current-time)
;; Preserve `this-command' and `last-command'.
(let ((this-command this-command)
(last-command last-command))
(org-read-date
arg 'totime nil nil default-time default-input
inactive))))))
(if (equal arg '(16)) (current-time)
;; Preserve `this-command' and `last-command'.
(let ((this-command this-command)
(last-command last-command))
(org-read-date
arg 'totime nil nil default-time default-input
inactive)))))
(cond
((and ts
(memq last-command '(org-time-stamp org-time-stamp-inactive))
@ -16434,7 +16434,7 @@ user."
(when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
(setq ans "+0"))
(when (setq delta (org-read-date-get-relative ans (current-time) org-def))
(when (setq delta (org-read-date-get-relative ans nil org-def))
(setq ans (replace-match "" t t ans)
deltan (car delta)
deltaw (nth 1 delta)
@ -16782,7 +16782,7 @@ Don't touch the rest."
If SECONDS is non-nil, return the difference in seconds."
(let ((fdiff (if seconds #'float-time #'time-to-days)))
(- (funcall fdiff (org-time-string-to-time timestamp-string))
(funcall fdiff (current-time)))))
(funcall fdiff nil))))
(defun org-deadline-close-p (timestamp-string &optional ndays)
"Is the time in TIMESTAMP-STRING close to the current date?"
@ -16964,10 +16964,8 @@ days in order to avoid rounding problems."
(match-end (match-end 0))
(time1 (org-time-string-to-time ts1))
(time2 (org-time-string-to-time ts2))
(t1 (float-time time1))
(t2 (float-time time2))
(diff (abs (- t2 t1)))
(negative (< (- t2 t1) 0))
(diff (abs (float-time (time-subtract time2 time1))))
(negative (time-less-p time2 time1))
;; (ys (floor (* 365 24 60 60)))
(ds (* 24 60 60))
(hs (* 60 60))
@ -16978,14 +16976,14 @@ days in order to avoid rounding problems."
(fh "%02d:%02d")
y d h m align)
(if havetime
(setq ; y (floor (/ diff ys)) diff (mod diff ys)
(setq ; y (floor diff ys) diff (mod diff ys)
y 0
d (floor (/ diff ds)) diff (mod diff ds)
h (floor (/ diff hs)) diff (mod diff hs)
m (floor (/ diff 60)))
(setq ; y (floor (/ diff ys)) diff (mod diff ys)
d (floor diff ds) diff (mod diff ds)
h (floor diff hs) diff (mod diff hs)
m (floor diff 60))
(setq ; y (floor diff ys) diff (mod diff ys)
y 0
d (floor (+ (/ diff ds) 0.5))
d (round diff ds)
h 0 m 0))
(if (not to-buffer)
(message "%s" (org-make-tdiff-string y d h m))