Explorar el Código

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 hace 10 años
padre
commit
62ec8c0a48
Se han modificado 2 ficheros con 87 adiciones y 71 borrados
  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))))))