Browse Source

org-colview: Fix `org-columns-compute' with inlinetasks

* lisp/org-colview.el (org-columns-compute): Properly summarize values
  obtained through inline tasks.

* testing/lisp/test-org-colview.el (test-org-colview/columns-update):
  Add test.

Previously, the summary of values from inline tasks was added to to the
summary of values from children.
Nicolas Goaziou 5 years ago
parent
commit
62ec8c0a48
2 changed files with 87 additions and 71 deletions
  1. 63 70
      lisp/org-colview.el
  2. 24 1
      testing/lisp/test-org-colview.el

+ 63 - 70
lisp/org-colview.el

@@ -44,6 +44,7 @@
 (defvar org-agenda-columns-compute-summary-properties)
 (defvar org-agenda-columns-show-summaries)
 (defvar org-agenda-view-columns-initially)
+(defvar org-inlinetask-min-level)
 
 ;;; Configuration
 
@@ -954,82 +955,74 @@ display, or in the #+COLUMNS line of the current buffer."
 			    (org-columns--overlay-text
 			     displayed format width property value))))))))))
 
-(defvar org-inlinetask-min-level
-  (if (featurep 'org-inlinetask) org-inlinetask-min-level 15))
-
 ;;;###autoload
 (defun org-columns-compute (property)
-  "Sum the values of property PROPERTY hierarchically, for the entire buffer."
+  "Summarize the values of property PROPERTY hierarchically."
   (interactive)
-  (let* ((re org-outline-regexp-bol)
-	 (lmax 30)		    ; Does anyone use deeper levels???
+  (let* ((lmax (if (org-bound-and-true-p org-inlinetask-min-level)
+		   (1+ org-inlinetask-min-level)
+		 30))			;Hard-code deepest level.
 	 (lvals (make-vector lmax nil))
-	 (lflag (make-vector lmax nil))
+	 (spec (assoc-string property org-columns-current-fmt-compiled t))
+	 (format (nth 4 spec))
+	 (printf (nth 5 spec))
+	 (fun (nth 6 spec))
 	 (level 0)
-	 (ass (assoc-string property org-columns-current-fmt-compiled t))
-	 (format (nth 4 ass))
-	 (printf (nth 5 ass))
-	 (fun (nth 6 ass))
-	 (beg org-columns-top-level-marker)
 	 (inminlevel org-inlinetask-min-level)
-	 (last-level org-inlinetask-min-level)
-	 val valflag flag end sumpos sum-alist sum str str1 useval)
-    (save-excursion
-      ;; Find the region to compute
-      (goto-char beg)
-      (setq end (condition-case nil (org-end-of-subtree t) (error (point-max))))
-      (goto-char end)
-      ;; Walk the tree from the back and do the computations
-      (while (re-search-backward re beg t)
-	(setq sumpos (match-beginning 0)
-	      last-level (if (not (or (zerop level) (eq level inminlevel)))
-			     level last-level)
-	      level (org-outline-level)
-	      val (org-entry-get nil property)
-	      valflag (org-string-nw-p val))
-	(cond
-	 ((< level last-level)
-	  ;; Put the sum of lower levels here as a property.  If
-	  ;; values are estimates, use an appropriate sum function.
-	  (setq sum (funcall (if (eq fun 'org-columns--estimate-combine)
-				 #'org-columns--estimate-combine
-			       #'+)
-			     (if (and (/= last-level inminlevel)
-				      (aref lvals last-level))
-				 (apply fun (aref lvals last-level))
-			       0)
-			     (if (aref lvals inminlevel)
-				 (apply fun (aref lvals inminlevel))
-			       0))
-		flag (or (aref lflag last-level) ; any valid entries from children?
-			 (aref lflag inminlevel)) ; or inline tasks?
-		str (org-columns-number-to-string sum format printf)
-		str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
-		useval (if flag str1 (if valflag val ""))
-		sum-alist (get-text-property sumpos 'org-summaries))
-	  (let ((old (assoc-string property sum-alist t)))
-	    (if old (setcdr old useval)
-	      (push (cons property useval) sum-alist)
-	      (org-with-silent-modifications
-	       (add-text-properties sumpos (1+ sumpos)
-				    (list 'org-summaries sum-alist)))))
-	  (when (and val (not (equal val (if flag str val))))
-	    (org-entry-put nil property (if flag str val)))
-	  ;; add current to current level accumulator
-	  (when (or flag valflag)
-	    (push (if flag sum (org-columns-string-to-number val format))
-		  (aref lvals level))
-	    (aset lflag level t))
-	  ;; clear accumulators for deeper levels
-	  (loop for l from (1+ level) to (1- lmax) do
-		(aset lvals l nil)
-		(aset lflag l nil)))
-	 ((>= level last-level)
-	  ;; add what we have here to the accumulator for this level
-	  (when valflag
-	    (push (org-columns-string-to-number val format) (aref lvals level))
-	    (aset lflag level t)))
-	 (t (error "This should not happen")))))))
+	 (last-level org-inlinetask-min-level))
+    (org-with-wide-buffer
+     ;; Find the region to compute.
+     (goto-char org-columns-top-level-marker)
+     (goto-char (condition-case nil (org-end-of-subtree t) (error (point-max))))
+     ;; Walk the tree from the back and do the computations.
+     (while (re-search-backward
+	     org-outline-regexp-bol org-columns-top-level-marker t)
+       (unless (or (= level 0) (eq level inminlevel))
+	 (setq last-level level))
+       (setq level (org-reduced-level (org-outline-level)))
+       (let* ((pos (match-beginning 0))
+	      (value (org-entry-get nil property))
+	      (value-set (org-string-nw-p value)))
+	 (cond
+	  ((< level last-level)
+	   ;; Collect values from lower levels and inline tasks here
+	   ;; and summarize them using FUN.  Store them as text
+	   ;; property.
+	   (let* ((summary
+		   (let ((all (append (and (/= last-level inminlevel)
+					   (aref lvals last-level))
+				      (aref lvals inminlevel))))
+		     (and all (apply fun all))))
+		  (str (and summary (org-columns-number-to-string
+				     summary format printf))))
+	     (let* ((summaries-alist (get-text-property pos 'org-summaries))
+		    (old (assoc-string property summaries-alist t))
+		    (new (cond
+			  (summary (propertize str 'org-computed t 'face 'bold))
+			  (value-set value)
+			  (t ""))))
+	       (if old (setcdr old new)
+		 (push (cons property new) summaries-alist)
+		 (org-with-silent-modifications
+		  (add-text-properties pos (1+ pos)
+				       (list 'org-summaries summaries-alist)))))
+	     ;; When PROPERTY is set in current node, but its value
+	     ;; doesn't match the one computed, use the latter
+	     ;; instead.
+	     (when (and value str (not (equal value str)))
+	       (org-entry-put nil property str))
+	     ;; Add current to current level accumulator.
+	     (when (or summary value-set)
+	       (push (or summary (org-columns-string-to-number value format))
+		     (aref lvals level)))
+	     ;; Clear accumulators for deeper levels.
+	     (cl-loop for l from (1+ level) to (1- lmax) do
+		      (aset lvals l nil))))
+	  (value-set
+	   ;; Add what we have here to the accumulator for this level.
+	   (push (org-columns-string-to-number value format)
+		 (aref lvals level)))
+	  (t nil)))))))
 
 (defun org-columns-redo ()
   "Construct the column display again."

+ 24 - 1
testing/lisp/test-org-colview.el

@@ -535,7 +535,30 @@
       (search-forward ":A: ")
       (insert "very long ")
       (org-columns-update "A")
-      (get-char-property (point-min) 'display)))))
+      (get-char-property (point-min) 'display))))
+  ;; Values obtained from inline tasks are at the same level as those
+  ;; obtained from children of the current node.
+  (when (featurep 'org-inlinetask)
+    (should
+     (equal
+      "2"
+      (org-test-with-temp-text
+	  "* H
+*************** Inline task
+:PROPERTIES:
+:A: 2
+:END:
+*************** END
+** Children
+:PROPERTIES:
+:A: 3
+:END:
+"
+	(let ((org-columns-default-format "%A{min}")
+	      (org-columns-ellipses "..")
+	      (org-inlinetask-min-level 15))
+	  (org-columns))
+	(get-char-property (point-min) 'org-columns-value))))))