瀏覽代碼

Backport commit 988e37fa0 from Emacs

* lisp/org-agenda.el (org-agenda-get-timestamps, org-agenda-get-progress)
(org-agenda-show-clocking-issues):
* lisp/org-capture.el (org-capture-set-target-location):
* lisp/org-clock.el (org-clock-get-sum-start):
* lisp/org.el (org-current-time, org-store-link)
(org-read-date, org-read-date-display)
(org-display-custom-time, org-timestamp-to-time)
Simplify use of encode-time.
* lisp/org-clock.el (org-clock-in, org-clock-update-time-maybe):
* lisp/org-colview.el (org-columns--age-to-minutes):
* lisp/org-macs.el (org-2ft):
* lisp/org.el (org-get-scheduled-time, org-get-deadline-time)
(org-add-planning-info, org-time-string-to-absolute)
(org-closest-date):
Use org-time-string-to-time instead of doing it by hand with
encode-time.
* lisp/org.el (org-read-date): Avoid extra trip through encode-time.

Simplify use of encode-time
988e37fa0f922b852715671d59a0e3f682373411
Paul Eggert
Sun Feb 10 23:54:35 2019 -0800

Note(km): org-current-time has been modified to use org-time-subtract
and org-time-less-p for backward compatibility.  Some changes from
988e37fa0 have been dropped to keep encode-time's call compatible with
older Emacsen.
Paul Eggert 6 年之前
父節點
當前提交
74bf99502d
共有 6 個文件被更改,包括 41 次插入48 次删除
  1. 6 8
      lisp/org-agenda.el
  2. 3 3
      lisp/org-capture.el
  3. 4 6
      lisp/org-clock.el
  4. 1 1
      lisp/org-colview.el
  5. 1 1
      lisp/org-macs.el
  6. 26 29
      lisp/org.el

+ 6 - 8
lisp/org-agenda.el

@@ -5500,8 +5500,8 @@ displayed in agenda view."
 	    (substring
 	    (substring
 	     (format-time-string
 	     (format-time-string
 	      (car org-time-stamp-formats)
 	      (car org-time-stamp-formats)
-	      (apply #'encode-time	; DATE bound by calendar
-		     (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
+	      (encode-time	; DATE bound by calendar
+	       0 0 0 (nth 1 date) (car date) (nth 2 date)))
 	     1 11))
 	     1 11))
 	   "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
 	   "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
 	   "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
 	   "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
@@ -5751,8 +5751,8 @@ then those holidays will be skipped."
 		   (substring
 		   (substring
 		    (format-time-string
 		    (format-time-string
 		     (car org-time-stamp-formats)
 		     (car org-time-stamp-formats)
-		     (apply 'encode-time  ; DATE bound by calendar
-			    (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
+		     (encode-time  ; DATE bound by calendar
+		      0 0 0 (nth 1 date) (car date) (nth 2 date)))
 		    1 11))))
 		    1 11))))
 	 (org-agenda-search-headline-for-time nil)
 	 (org-agenda-search-headline-for-time nil)
 	 marker hdmarker priority category level tags closedp type
 	 marker hdmarker priority category level tags closedp type
@@ -5872,10 +5872,8 @@ See also the user option `org-agenda-clock-consistency-checks'."
 	      (throw 'next t))
 	      (throw 'next t))
 	    (setq ts (match-string 1)
 	    (setq ts (match-string 1)
 		  te (match-string 3)
 		  te (match-string 3)
-		  ts (float-time
-		      (apply #'encode-time (org-parse-time-string ts)))
-		  te (float-time
-		      (apply #'encode-time (org-parse-time-string te)))
+		  ts (float-time (org-time-string-to-time ts))
+		  te (float-time (org-time-string-to-time te))
 		  dt (- te ts))))
 		  dt (- te ts))))
 	(cond
 	(cond
 	 ((> dt (* 60 maxtime))
 	 ((> dt (* 60 maxtime))

+ 3 - 3
lisp/org-capture.el

@@ -1011,9 +1011,9 @@ Store them in the capture property list."
 			      (not (= (time-to-days prompt-time) (org-today))))
 			      (not (= (time-to-days prompt-time) (org-today))))
 			 ;; Use 00:00 when no time is given for another
 			 ;; Use 00:00 when no time is given for another
 			 ;; date than today?
 			 ;; date than today?
-			 (apply #'encode-time
-				(append `(0 0 ,org-extend-today-until)
-					(cl-cdddr (decode-time prompt-time)))))
+			 (apply #'encode-time 0 0
+				org-extend-today-until
+				(cl-cdddr (decode-time prompt-time))))
 			((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)"
 			((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)"
 				       org-read-date-final-answer)
 				       org-read-date-final-answer)
 			 ;; Replace any time range by its start.
 			 ;; Replace any time range by its start.

+ 4 - 6
lisp/org-clock.el

@@ -1301,8 +1301,7 @@ the default behavior."
 	   (setq ts (concat "[" (match-string 1) "]"))
 	   (setq ts (concat "[" (match-string 1) "]"))
 	   (goto-char (match-end 1))
 	   (goto-char (match-end 1))
 	   (setq org-clock-start-time
 	   (setq org-clock-start-time
-		 (apply 'encode-time
-			(org-parse-time-string (match-string 1))))
+		 (org-time-string-to-time (match-string 1)))
 	   (setq org-clock-effort (org-entry-get (point) org-effort-property))
 	   (setq org-clock-effort (org-entry-get (point) org-effort-property))
 	   (setq org-clock-total-time (org-clock-sum-current-item
 	   (setq org-clock-total-time (org-clock-sum-current-item
 				       (org-clock-get-sum-start))))
 				       (org-clock-get-sum-start))))
@@ -1439,7 +1438,7 @@ The time is always returned as UTC."
 	     (day (nth 3 dt)))
 	     (day (nth 3 dt)))
 	(if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day)))
 	(if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day)))
 	(setf (nth 2 dt) org-extend-today-until)
 	(setf (nth 2 dt) org-extend-today-until)
-	(apply #'encode-time (append (list 0 0) (nthcdr 2 dt)))))
+	(apply #'encode-time 0 0 (nthcdr 2 dt))))
      ((or (equal cmt "all")
      ((or (equal cmt "all")
 	  (and (or (not cmt) (equal cmt "auto"))
 	  (and (or (not cmt) (equal cmt "auto"))
 	       (not lr)))
 	       (not lr)))
@@ -1829,7 +1828,7 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
 			       (org-parse-time-string (match-string 3)))))
 			       (org-parse-time-string (match-string 3)))))
 		   (dt (- (if tend (min te tend) te)
 		   (dt (- (if tend (min te tend) te)
 			  (if tstart (max ts tstart) ts))))
 			  (if tstart (max ts tstart) ts))))
-	      (when (> dt 0) (cl-incf t1 (floor (/ dt 60))))))
+	      (when (> dt 0) (cl-incf t1 (floor dt 60)))))
 	   ((match-end 4)
 	   ((match-end 4)
 	    ;; A naked time.
 	    ;; A naked time.
 	    (setq t1 (+ t1 (string-to-number (match-string 5))
 	    (setq t1 (+ t1 (string-to-number (match-string 5))
@@ -2910,8 +2909,7 @@ Otherwise, return nil."
 		     (<= org-clock-marker (point-at-eol)))
 		     (<= org-clock-marker (point-at-eol)))
 	    ;; The clock is running here
 	    ;; The clock is running here
 	    (setq org-clock-start-time
 	    (setq org-clock-start-time
-		  (apply 'encode-time
-			 (org-parse-time-string (match-string 1))))
+		  (org-time-string-to-time (match-string 1)))
 	    (org-clock-update-mode-line)))
 	    (org-clock-update-mode-line)))
 	 (t
 	 (t
 	  (and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
 	  (and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))

+ 1 - 1
lisp/org-colview.el

@@ -1117,7 +1117,7 @@ as a canonical duration, i.e., using units defined in
   (cond
   (cond
    ((string-match-p org-ts-regexp s)
    ((string-match-p org-ts-regexp s)
     (/ (- org-columns--time
     (/ (- org-columns--time
-	  (float-time (apply #'encode-time (org-parse-time-string s))))
+	  (float-time (org-time-string-to-time s)))
        60))
        60))
    ((org-duration-p s) (org-duration-to-minutes s t)) ;skip user units
    ((org-duration-p s) (org-duration-to-minutes s t)) ;skip user units
    (t (user-error "Invalid age: %S" s))))
    (t (user-error "Invalid age: %S" s))))

+ 1 - 1
lisp/org-macs.el

@@ -1072,7 +1072,7 @@ nil, just return 0."
    ((numberp s) s)
    ((numberp s) s)
    ((stringp s)
    ((stringp s)
     (condition-case nil
     (condition-case nil
-	(float-time (apply #'encode-time (org-parse-time-string s)))
+	(float-time (org-time-string-to-time s))
       (error 0)))
       (error 0)))
    (t 0)))
    (t 0)))
 
 

+ 26 - 29
lisp/org.el

@@ -5636,16 +5636,15 @@ When ROUNDING-MINUTES is not an integer, fall back on the car of
 the rounding returns a past time."
 the rounding returns a past time."
   (let ((r (or (and (integerp rounding-minutes) rounding-minutes)
   (let ((r (or (and (integerp rounding-minutes) rounding-minutes)
 	       (car org-time-stamp-rounding-minutes)))
 	       (car org-time-stamp-rounding-minutes)))
-	(time (decode-time)) res)
+	(now (current-time)))
     (if (< r 1)
     (if (< r 1)
-	(current-time)
-      (setq res
-	    (apply 'encode-time
-		   (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r)))))
-			   (nthcdr 2 time))))
-      (if (and past (< (float-time (time-subtract (current-time) res)) 0))
-	  (seconds-to-time (- (float-time res) (* r 60)))
-	res))))
+	now
+      (let* ((time (decode-time now))
+	     (res (apply #'encode-time 0 (* r (round (nth 1 time) r))
+			 (nthcdr 2 time))))
+	(if (or (not past) (org-time-less-p res now))
+	    res
+	  (org-time-subtract res (* r 60)))))))
 
 
 (defun org-today ()
 (defun org-today ()
   "Return today date, considering `org-extend-today-until'."
   "Return today date, considering `org-extend-today-until'."
@@ -9340,9 +9339,7 @@ non-nil."
 	  (setq link
 	  (setq link
 		(format-time-string
 		(format-time-string
 		 (car org-time-stamp-formats)
 		 (car org-time-stamp-formats)
-		 (apply 'encode-time
-			(list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
-			      nil nil nil))))
+		 (encode-time 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd))))
 	  (org-store-link-props :type "calendar" :date cd)))
 	  (org-store-link-props :type "calendar" :date cd)))
 
 
        ((eq major-mode 'help-mode)
        ((eq major-mode 'help-mode)
@@ -13044,7 +13041,7 @@ for calling org-schedule with, or if there is no scheduling,
 returns nil."
 returns nil."
   (let ((time (org-entry-get pom "SCHEDULED" inherit)))
   (let ((time (org-entry-get pom "SCHEDULED" inherit)))
     (when time
     (when time
-      (apply 'encode-time (org-parse-time-string time)))))
+      (org-time-string-to-time time))))
 
 
 (defun org-get-deadline-time (pom &optional inherit)
 (defun org-get-deadline-time (pom &optional inherit)
   "Get the deadline as a time tuple, of a format suitable for
   "Get the deadline as a time tuple, of a format suitable for
@@ -13052,7 +13049,7 @@ calling org-deadline with, or if there is no scheduling, returns
 nil."
 nil."
   (let ((time (org-entry-get pom "DEADLINE" inherit)))
   (let ((time (org-entry-get pom "DEADLINE" inherit)))
     (when time
     (when time
-      (apply 'encode-time (org-parse-time-string time)))))
+      (org-time-string-to-time time))))
 
 
 (defun org-remove-timestamp-with-keyword (keyword)
 (defun org-remove-timestamp-with-keyword (keyword)
   "Remove all time stamps with KEYWORD in the current entry."
   "Remove all time stamps with KEYWORD in the current entry."
@@ -13111,7 +13108,7 @@ WHAT entry will also be removed."
 				       org-deadline-time-regexp)
 				       org-deadline-time-regexp)
 				     end t)
 				     end t)
 	      (setq ts (match-string 1)
 	      (setq ts (match-string 1)
-		    default-time (apply 'encode-time (org-parse-time-string ts))
+		    default-time (org-time-string-to-time ts)
 		    default-input (and ts (org-get-compact-tod ts)))))))
 		    default-input (and ts (org-get-compact-tod ts)))))))
       (when what
       (when what
 	(setq time
 	(setq time
@@ -16369,13 +16366,14 @@ user."
 		 "range representable on this machine"))
 		 "range representable on this machine"))
       (ding))
       (ding))
 
 
-    ;; One round trip to get rid of 34th of August and stuff like that....
-    (setq final (decode-time (apply 'encode-time final)))
+    (setq final (apply #'encode-time final))
 
 
     (setq org-read-date-final-answer ans)
     (setq org-read-date-final-answer ans)
 
 
     (if to-time
     (if to-time
-	(apply 'encode-time final)
+	final
+      ;; This round-trip gets rid of 34th of August and stuff like that....
+      (setq final (decode-time final))
       (if (and (boundp 'org-time-was-given) org-time-was-given)
       (if (and (boundp 'org-time-was-given) org-time-was-given)
 	  (format "%04d-%02d-%02d %02d:%02d"
 	  (format "%04d-%02d-%02d %02d:%02d"
 		  (nth 5 final) (nth 4 final) (nth 3 final)
 		  (nth 5 final) (nth 4 final) (nth 3 final)
@@ -16405,7 +16403,7 @@ user."
 			  (and (boundp 'org-time-was-given) org-time-was-given))
 			  (and (boundp 'org-time-was-given) org-time-was-given))
 		      (cdr fmts)
 		      (cdr fmts)
 		    (car fmts)))
 		    (car fmts)))
-	     (txt (format-time-string fmt (apply 'encode-time f)))
+	     (txt (format-time-string fmt (apply #'encode-time f)))
 	     (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt))
 	     (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt))
 	     (txt (concat "=> " txt)))
 	     (txt (concat "=> " txt)))
 	(when (and org-end-time-was-given
 	(when (and org-end-time-was-given
@@ -17056,7 +17054,7 @@ signaled."
    (daynr (org-closest-date s daynr prefer))
    (daynr (org-closest-date s daynr prefer))
    (t (time-to-days
    (t (time-to-days
        (condition-case errdata
        (condition-case errdata
-	   (apply #'encode-time (org-parse-time-string s))
+	   (org-time-string-to-time s)
 	 (error (error "Bad timestamp `%s'%s\nError was: %s"
 	 (error (error "Bad timestamp `%s'%s\nError was: %s"
 		       s
 		       s
 		       (if (not (and buffer pos)) ""
 		       (if (not (and buffer pos)) ""
@@ -17154,12 +17152,12 @@ stamp stay unchanged.  In any case, return value is an absolute
 day number."
 day number."
   (if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start))
   (if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start))
       ;; No repeater.  Do not shift time stamp.
       ;; No repeater.  Do not shift time stamp.
-      (time-to-days (apply #'encode-time (org-parse-time-string start)))
+      (time-to-days (org-time-string-to-time start))
     (let ((value (string-to-number (match-string 1 start)))
     (let ((value (string-to-number (match-string 1 start)))
 	  (type (match-string 2 start)))
 	  (type (match-string 2 start)))
       (if (= 0 value)
       (if (= 0 value)
 	  ;; Repeater with a 0-value is considered as void.
 	  ;; Repeater with a 0-value is considered as void.
-	  (time-to-days (apply #'encode-time (org-parse-time-string start)))
+	  (time-to-days (org-time-string-to-time start))
 	(let* ((base (org-date-to-gregorian start))
 	(let* ((base (org-date-to-gregorian start))
 	       (target (org-date-to-gregorian current))
 	       (target (org-date-to-gregorian current))
 	       (sday (calendar-absolute-from-gregorian base))
 	       (sday (calendar-absolute-from-gregorian base))
@@ -22600,13 +22598,12 @@ return an active timestamp."
   "Convert TIMESTAMP object into an Emacs internal time value.
   "Convert TIMESTAMP object into an Emacs internal time value.
 Use end of date range or time range when END is non-nil.
 Use end of date range or time range when END is non-nil.
 Otherwise, use its start."
 Otherwise, use its start."
-  (apply #'encode-time
-	 (cons 0
-	       (mapcar
-		(lambda (prop) (or (org-element-property prop timestamp) 0))
-		(if end '(:minute-end :hour-end :day-end :month-end :year-end)
-		  '(:minute-start :hour-start :day-start :month-start
-				  :year-start))))))
+  (apply #'encode-time 0
+	 (mapcar
+	  (lambda (prop) (or (org-element-property prop timestamp) 0))
+	  (if end '(:minute-end :hour-end :day-end :month-end :year-end)
+	    '(:minute-start :hour-start :day-start :month-start
+			    :year-start)))))
 
 
 (defun org-timestamp-has-time-p (timestamp)
 (defun org-timestamp-has-time-p (timestamp)
   "Non-nil when TIMESTAMP has a time specified."
   "Non-nil when TIMESTAMP has a time specified."