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:
parent
1b15d5ef8e
commit
a6cead0d21
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
30
lisp/org.el
30
lisp/org.el
|
@ -253,7 +253,7 @@ file to byte-code before it is loaded."
|
|||
(interactive "fFile to load: \nP")
|
||||
(let* ((age (lambda (file)
|
||||
(float-time
|
||||
(time-subtract (current-time)
|
||||
(time-since
|
||||
(file-attribute-modification-time
|
||||
(or (file-attributes (file-truename file))
|
||||
(file-attributes file)))))))
|
||||
|
@ -16049,7 +16049,7 @@ 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)
|
||||
(default-time (and ts
|
||||
(apply #'encode-time (org-parse-time-string ts))))
|
||||
(default-input (and ts (org-get-compact-tod ts)))
|
||||
(repeater (and ts
|
||||
|
@ -16058,13 +16058,13 @@ non-nil."
|
|||
org-time-was-given
|
||||
org-end-time-was-given
|
||||
(time
|
||||
(and (if (equal arg '(16)) (current-time)
|
||||
(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))))))
|
||||
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))
|
||||
|
|
Loading…
Reference in New Issue