Browse Source

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
Paul Eggert 6 years ago
parent
commit
a6cead0d21
7 changed files with 37 additions and 45 deletions
  1. 2 2
      lisp/org-agenda.el
  2. 1 2
      lisp/org-capture.el
  3. 4 6
      lisp/org-clock.el
  4. 3 6
      lisp/org-duration.el
  5. 2 2
      lisp/org-macs.el
  6. 2 2
      lisp/org-table.el
  7. 23 25
      lisp/org.el

+ 2 - 2
lisp/org-agenda.el

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

+ 1 - 2
lisp/org-capture.el

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

+ 4 - 6
lisp/org-clock.el

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

+ 3 - 6
lisp/org-duration.el

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

+ 2 - 2
lisp/org-macs.el

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

+ 2 - 2
lisp/org-table.el

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

+ 23 - 25
lisp/org.el

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