Browse Source

Fix effort calculation in agenda

* lisp/org-agenda.el (org-agenda-get-scheduled): Fix property symbol
in `org-element-property' call.

(org-agenda-get-todos, org-agenda-get-scheduled,
org-agenda-get-timestamps, org-agenda-get-sexps,
org-agenda-get-progress, org-agenda-get-deadlines,
org-agenda-get-blocks, org-agenda-change-all-lines): Pass effort
properties to `org-agenda-format-item'
Ihor Radchenko 4 years ago
parent
commit
d18beb7c6f
1 changed files with 48 additions and 12 deletions
  1. 48 12
      lisp/org-agenda.el

+ 48 - 12
lisp/org-agenda.el

@@ -76,6 +76,9 @@
 (declare-function org-columns-quit              "org-colview" ())
 (declare-function org-columns-quit              "org-colview" ())
 (declare-function diary-date-display-form       "diary-lib"  (&optional type))
 (declare-function diary-date-display-form       "diary-lib"  (&optional type))
 (declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file))
 (declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element--cache-active-p "org-element"
+                  (&optional called-from-cache-change-func-p))
 (declare-function org-habit-insert-consistency-graphs
 (declare-function org-habit-insert-consistency-graphs
 		  "org-habit" (&optional line))
 		  "org-habit" (&optional line))
 (declare-function org-is-habit-p "org-habit" (&optional pom))
 (declare-function org-is-habit-p "org-habit" (&optional pom))
@@ -5587,7 +5590,11 @@ and the timestamp type relevant for the sorting strategy in
 			   (memq 'todo org-agenda-use-tag-inheritance))))
 			   (memq 'todo org-agenda-use-tag-inheritance))))
 	      tags (org-get-tags nil (not inherited-tags))
 	      tags (org-get-tags nil (not inherited-tags))
 	      level (make-string (org-reduced-level (org-outline-level)) ? )
 	      level (make-string (org-reduced-level (org-outline-level)) ? )
-	      txt (org-agenda-format-item "" txt level category tags t)
+	      txt (org-agenda-format-item ""
+                                (org-add-props txt nil
+                                  'effort effort
+                                  'effort-minutes effort-minutes)
+                                level category tags t)
 	      priority (1+ (org-get-priority txt)))
 	      priority (1+ (org-get-priority txt)))
         (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
         (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
 	(org-add-props txt props
 	(org-add-props txt props
@@ -5816,7 +5823,10 @@ displayed in agenda view."
 		   (item
 		   (item
 		    (org-agenda-format-item
 		    (org-agenda-format-item
 		     (and inactive? org-agenda-inactive-leader)
 		     (and inactive? org-agenda-inactive-leader)
-		     head level category tags time-stamp org-ts-regexp habit?)))
+                     (org-add-props head nil
+                       'effort effort
+                       'effort-minutes effort-minutes)
+                     level category tags time-stamp org-ts-regexp habit?)))
 	      (org-add-props item props
 	      (org-add-props item props
 		'priority (if habit?
 		'priority (if habit?
 			      (org-habit-get-priority (org-habit-parse-todo))
 			      (org-habit-get-priority (org-habit-parse-todo))
@@ -5893,7 +5903,11 @@ displayed in agenda view."
 	    (if (string-match "\\S-" r)
 	    (if (string-match "\\S-" r)
 		(setq txt r)
 		(setq txt r)
 	      (setq txt "SEXP entry returned empty string"))
 	      (setq txt "SEXP entry returned empty string"))
-	    (setq txt (org-agenda-format-item extra txt level category tags 'time))
+	    (setq txt (org-agenda-format-item extra
+                                    (org-add-props txt nil
+                                      'effort effort
+                                      'effort-minutes effort-minutes)
+                                    level category tags 'time))
 	    (org-add-props txt props 'org-marker marker
 	    (org-add-props txt props 'org-marker marker
 			   'date date 'todo-state todo-state
 			   'date date 'todo-state todo-state
                            'effort effort 'effort-minutes effort-minutes
                            'effort effort 'effort-minutes effort-minutes
@@ -6049,7 +6063,10 @@ then those holidays will be skipped."
 			(closedp "Closed:    ")
 			(closedp "Closed:    ")
 			(statep (concat "State:     (" state ")"))
 			(statep (concat "State:     (" state ")"))
 			(t (concat "Clocked:   (" clocked  ")")))
 			(t (concat "Clocked:   (" clocked  ")")))
-		       txt level category tags timestr)))
+                       (org-add-props txt nil
+                         'effort effort
+                         'effort-minutes effort-minutes)
+		       level category tags timestr)))
 	  (setq type (cond (closedp "closed")
 	  (setq type (cond (closedp "closed")
 			   (statep "state")
 			   (statep "state")
 			   (t "clock")))
 			   (t "clock")))
@@ -6315,7 +6332,10 @@ specification like [h]h:mm."
 			((and today? (< deadline today)) (format past (- diff)))
 			((and today? (< deadline today)) (format past (- diff)))
 			((and today? (> deadline today)) (format future diff))
 			((and today? (> deadline today)) (format future diff))
 			(t now)))
 			(t now)))
-		     head level category tags time))
+		     (org-add-props head nil
+                       'effort effort
+                       'effort-minutes effort-minutes)
+                     level category tags time))
 		   (face (org-agenda-deadline-face
 		   (face (org-agenda-deadline-face
 			  (- 1 (/ (float diff) (max wdays 1)))))
 			  (- 1 (/ (float diff) (max wdays 1)))))
 		   (upcoming? (and today? (> deadline today)))
 		   (upcoming? (and today? (> deadline today)))
@@ -6503,7 +6523,7 @@ scheduled items with an hour specification like [h]h:mm."
 	           (let* ((category (org-get-category))
 	           (let* ((category (org-get-category))
                           (effort (save-match-data
                           (effort (save-match-data
                                     (or (get-text-property (point) 'effort)
                                     (or (get-text-property (point) 'effort)
-                                        (org-element-property org-effort-property el))))
+                                        (org-element-property (intern (concat ":" (upcase org-effort-property))) el))))
                           (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
                           (effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
 		          (inherited-tags
 		          (inherited-tags
 		           (or (eq org-agenda-show-inherited-tags 'always)
 		           (or (eq org-agenda-show-inherited-tags 'always)
@@ -6543,7 +6563,10 @@ scheduled items with an hour specification like [h]h:mm."
 		              (if (and todayp pastschedp)
 		              (if (and todayp pastschedp)
 			          (format past diff)
 			          (format past diff)
 			        first))
 			        first))
-		            head level category tags time nil habitp))
+		            (org-add-props head nil
+                              'effort effort
+                              'effort-minutes effort-minutes)
+                            level category tags time nil habitp))
 		          (face (cond ((and (not habitp) pastschedp)
 		          (face (cond ((and (not habitp) pastschedp)
 				       'org-scheduled-previously)
 				       'org-scheduled-previously)
 			              ((and habitp futureschedp)
 			              ((and habitp futureschedp)
@@ -6725,7 +6748,10 @@ scheduled items with an hour specification like [h]h:mm."
 		         (if (and todayp pastschedp)
 		         (if (and todayp pastschedp)
 			     (format past diff)
 			     (format past diff)
 			   first))
 			   first))
-		       head level category tags time nil habitp))
+		       (org-add-props head nil
+                         'effort effort
+                         'effort-minutes effort-minutes)
+                       level category tags time nil habitp))
 		     (face (cond ((and (not habitp) pastschedp)
 		     (face (cond ((and (not habitp) pastschedp)
 				  'org-scheduled-previously)
 				  'org-scheduled-previously)
 			         ((and habitp futureschedp)
 			         ((and habitp futureschedp)
@@ -6836,7 +6862,10 @@ scheduled items with an hour specification like [h]h:mm."
 			      (nth (if (= d1 d2) 0 1)
 			      (nth (if (= d1 d2) 0 1)
 				   org-agenda-timerange-leaders)
 				   org-agenda-timerange-leaders)
 			      (1+ (- d0 d1)) (1+ (- d2 d1)))
 			      (1+ (- d0 d1)) (1+ (- d2 d1)))
-			     head level category tags
+			     (org-add-props head nil
+                               'effort effort
+                               'effort-minutes effort-minutes)
+                             level category tags
 			     (save-match-data
 			     (save-match-data
 			       (let ((hhmm1 (and (string-match org-ts-regexp1 s1)
 			       (let ((hhmm1 (and (string-match org-ts-regexp1 s1)
 						 (match-string 6 s1)))
 						 (match-string 6 s1)))
@@ -9720,7 +9749,7 @@ the same tree node, and the headline of the tree node in the Org file."
       (org-add-note))))
       (org-add-note))))
 
 
 (defun org-agenda-change-all-lines (newhead hdmarker
 (defun org-agenda-change-all-lines (newhead hdmarker
-					    &optional fixface just-this)
+				  &optional fixface just-this)
   "Change all lines in the agenda buffer which match HDMARKER.
   "Change all lines in the agenda buffer which match HDMARKER.
 The new content of the line will be NEWHEAD (as modified by
 The new content of the line will be NEWHEAD (as modified by
 `org-agenda-format-item').  HDMARKER is checked with
 `org-agenda-format-item').  HDMARKER is checked with
@@ -9734,7 +9763,8 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags."
 	 (org-agenda-buffer (current-buffer))
 	 (org-agenda-buffer (current-buffer))
 	 (thetags (with-current-buffer (marker-buffer hdmarker)
 	 (thetags (with-current-buffer (marker-buffer hdmarker)
 		    (org-get-tags hdmarker)))
 		    (org-get-tags hdmarker)))
-	 props m undone-face done-face finish new dotime level cat tags) ;; pl
+	 props m undone-face done-face finish new dotime level cat tags
+         effort effort-minutes) ;; pl
     (save-excursion
     (save-excursion
       (goto-char (point-max))
       (goto-char (point-max))
       (beginning-of-line 1)
       (beginning-of-line 1)
@@ -9748,6 +9778,8 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags."
 		cat (org-agenda-get-category)
 		cat (org-agenda-get-category)
 		level (org-get-at-bol 'level)
 		level (org-get-at-bol 'level)
 		tags thetags
 		tags thetags
+                effort (org-get-at-bol 'effort)
+                effort-minutes (org-get-at-bol 'effort-minutes)
 		new
 		new
 		(let ((org-prefix-format-compiled
 		(let ((org-prefix-format-compiled
 		       (or (get-text-property (min (1- (point-max)) (point)) 'format)
 		       (or (get-text-property (min (1- (point-max)) (point)) 'format)
@@ -9755,7 +9787,11 @@ If FORCE-TAGS is non-nil, the car of it returns the new tags."
 		      (extra (org-get-at-bol 'extra)))
 		      (extra (org-get-at-bol 'extra)))
 		  (with-current-buffer (marker-buffer hdmarker)
 		  (with-current-buffer (marker-buffer hdmarker)
 		    (org-with-wide-buffer
 		    (org-with-wide-buffer
-		     (org-agenda-format-item extra newhead level cat tags dotime))))
+		     (org-agenda-format-item extra
+                                   (org-add-props newhead nil
+                                     'effort effort
+                                     'effort-minutes effort-minutes)
+                                   level cat tags dotime))))
 		;; pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
 		;; pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
 		undone-face (org-get-at-bol 'undone-face)
 		undone-face (org-get-at-bol 'undone-face)
 		done-face (org-get-at-bol 'done-face))
 		done-face (org-get-at-bol 'done-face))