Browse Source

org-agenda: Do not block non-TODO entries

* lisp/org-agenda.el (org-agenda-dim-blocked-tasks): Do not check if an
  entry can be blocked when it doesn't have any TODO keyword.

* lisp/org.el (org-entry-blocked-p): Make sure entry is really an open
  task before even considering it as a blocked task.  Small refactoring.

* testing/lisp/test-org.el (test-org/entry-properties): Update tests.
(test-org/entry-blocked-p): New test.

Reported-by: Bingo UV <right.ho@gmail.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/99544>
Nicolas Goaziou 9 years ago
parent
commit
570b1935e7
3 changed files with 84 additions and 47 deletions
  1. 21 21
      lisp/org-agenda.el
  2. 9 10
      lisp/org.el
  3. 54 16
      testing/lisp/test-org.el

+ 21 - 21
lisp/org-agenda.el

@@ -3857,35 +3857,35 @@ dimming them."
   (interactive "P")
   (when (org-called-interactively-p 'interactive)
     (message "Dim or hide blocked tasks..."))
-  (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo)
-			(delete-overlay o)))
-	(overlays-in (point-min) (point-max)))
+  (dolist (o (overlays-in (point-min) (point-max)))
+    (when (eq (overlay-get o 'org-type) 'org-blocked-todo)
+      (delete-overlay o)))
   (save-excursion
     (let ((inhibit-read-only t)
 	  (org-depend-tag-blocked nil)
-	  (invis (or (not (null invisible))
-		     (eq org-agenda-dim-blocked-tasks 'invisible)))
-	  org-blocked-by-checkboxes
-	  invis1 b e p ov h l)
+	  org-blocked-by-checkboxes)
       (goto-char (point-min))
-      (while (let ((pos (next-single-property-change (point) 'todo-state)))
-	       (and pos (goto-char (1+ pos))))
-	(setq org-blocked-by-checkboxes nil invis1 invis)
+      (while (let ((pos (text-property-not-all
+			 (point) (point-max) 'todo-state nil)))
+	       (when pos (goto-char (1+ pos))))
+	(setq org-blocked-by-checkboxes nil)
 	(let ((marker (org-get-at-bol 'org-hd-marker)))
-	  (when (and marker
+	  (when (and (markerp marker)
 		     (with-current-buffer (marker-buffer marker)
 		       (save-excursion (goto-char marker)
 				       (org-entry-blocked-p))))
-	    (if org-blocked-by-checkboxes (setq invis1 nil))
-	    (setq b (if invis1
-			(max (point-min) (1- (point-at-bol)))
-		      (point-at-bol))
-		  e (point-at-eol)
-		  ov (make-overlay b e))
-	    (if invis1
-		(overlay-put ov 'invisible t)
-	      (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
-	    (overlay-put ov 'org-type 'org-blocked-todo))))))
+	    ;; Entries blocked by checkboxes cannot be made invisible.
+	    ;; See `org-agenda-dim-blocked-tasks' for details.
+	    (let* ((really-invisible
+		    (and (not org-blocked-by-checkboxes)
+			 (or invisible (eq org-agenda-dim-blocked-tasks
+					   'invisible))))
+		   (ov (make-overlay (if really-invisible (line-end-position 0)
+				       (line-beginning-position))
+				     (line-end-position))))
+	      (if really-invisible (overlay-put ov 'invisible t)
+		(overlay-put ov 'face 'org-agenda-dimmed-todo-face))
+	      (overlay-put ov 'org-type 'org-blocked-todo)))))))
   (when (org-called-interactively-p 'interactive)
     (message "Dim or hide blocked tasks...done")))
 

+ 9 - 10
lisp/org.el

@@ -12840,16 +12840,15 @@ changes because there are unchecked boxes in this entry."
       t))) ; do not block
 
 (defun org-entry-blocked-p ()
-  "Is the current entry blocked?"
-  (org-with-silent-modifications
-   (if (org-entry-get nil "NOBLOCKING")
-       nil ;; Never block this entry
-     (not (run-hook-with-args-until-failure
-	   'org-blocker-hook
-	   (list :type 'todo-state-change
-		 :position (point)
-		 :from 'todo
-		 :to 'done))))))
+  "Non-nil if entry at point is blocked."
+  (and (not (org-entry-get nil "NOBLOCKING"))
+       (member (org-entry-get nil "TODO") org-not-done-keywords)
+       (not (run-hook-with-args-until-failure
+	     'org-blocker-hook
+	     (list :type 'todo-state-change
+		   :position (point)
+		   :from 'todo
+		   :to 'done)))))
 
 (defun org-update-statistics-cookies (all)
   "Update the statistics cookie, either from TODO or from checkboxes.

+ 54 - 16
testing/lisp/test-org.el

@@ -1242,6 +1242,49 @@
      (goto-char (point-max))
      (org-in-commented-heading-p t))))
 
+(ert-deftest test-org/entry-blocked-p ()
+  ;; Check other dependencies.
+  (should
+   (org-test-with-temp-text "* TODO Blocked\n** DONE one\n** TODO two"
+     (let ((org-enforce-todo-dependencies t)
+	   (org-blocker-hook
+	    '(org-block-todo-from-children-or-siblings-or-parent)))
+       (org-entry-blocked-p))))
+  (should-not
+   (org-test-with-temp-text "* TODO Blocked\n** DONE one\n** DONE two"
+     (let ((org-enforce-todo-dependencies t)
+	   (org-blocker-hook
+	    '(org-block-todo-from-children-or-siblings-or-parent)))
+       (org-entry-blocked-p))))
+  ;; Entry without a TODO keyword or with a DONE keyword cannot be
+  ;; blocked.
+  (should-not
+   (org-test-with-temp-text "* Blocked\n** TODO one"
+     (let ((org-enforce-todo-dependencies t)
+	   (org-blocker-hook
+	    '(org-block-todo-from-children-or-siblings-or-parent)))
+       (org-entry-blocked-p))))
+  (should-not
+   (org-test-with-temp-text "* DONE Blocked\n** TODO one"
+     (let ((org-enforce-todo-dependencies t)
+	   (org-blocker-hook
+	    '(org-block-todo-from-children-or-siblings-or-parent)))
+       (org-entry-blocked-p))))
+  ;; Follow :ORDERED: specifications.
+  (should
+   (org-test-with-temp-text
+       "* H\n:PROPERTIES:\n:ORDERED: t\n:END:\n** TODO one\n** <point>TODO two"
+     (let ((org-enforce-todo-dependencies t)
+	   (org-blocker-hook
+	    '(org-block-todo-from-children-or-siblings-or-parent)))
+       (org-entry-blocked-p))))
+  (should-not
+   (org-test-with-temp-text
+       "* H\n:PROPERTIES:\n:ORDERED: t\n:END:\n** <point>TODO one\n** DONE two"
+     (let ((org-enforce-todo-dependencies t)
+	   (org-blocker-hook
+	    '(org-block-todo-from-children-or-siblings-or-parent)))
+       (org-entry-blocked-p)))))
 
 
 ;;; Keywords
@@ -3340,22 +3383,17 @@ Paragraph<point>"
   ;; Get "BLOCKED" property.
   (should
    (equal "t"
-	  (org-test-with-temp-text "* Blocked\n** DONE one\n** TODO two"
+	  (org-test-with-temp-text "* TODO Blocked\n** DONE one\n** TODO two"
 	    (let ((org-enforce-todo-dependencies t)
 		  (org-blocker-hook
 		   '(org-block-todo-from-children-or-siblings-or-parent)))
 	      (cdr (assoc "BLOCKED" (org-entry-properties nil "BLOCKED")))))))
   (should
-   (equal "t"
-	  (org-test-with-temp-text "* Blocked\n** DONE one\n** TODO two"
+   (equal ""
+	  (org-test-with-temp-text "* TODO Blocked\n** DONE one\n** DONE two"
 	    (let ((org-enforce-todo-dependencies t)
 		  (org-blocker-hook
 		   '(org-block-todo-from-children-or-siblings-or-parent)))
-	      (cdr (assoc "BLOCKED" (org-entry-properties)))))))
-  (should
-   (equal ""
-	  (org-test-with-temp-text "* Blocked\n** DONE one\n** DONE two"
-	    (let ((org-enforce-todo-dependencies t))
 	      (cdr (assoc "BLOCKED" (org-entry-properties nil "BLOCKED")))))))
   ;; Get "CLOSED", "DEADLINE" and "SCHEDULED" properties.
   (should
@@ -3420,20 +3458,20 @@ Paragraph<point>"
   ;; Get "TIMESTAMP" and "TIMESTAMP_IA" properties.
   (should
    (equal "<2012-03-29 thu.>"
-    (org-test-with-temp-text "* Entry\n<2012-03-29 thu.>"
-      (cdr (assoc "TIMESTAMP" (org-entry-properties))))))
+	  (org-test-with-temp-text "* Entry\n<2012-03-29 thu.>"
+	    (cdr (assoc "TIMESTAMP" (org-entry-properties))))))
   (should
    (equal "[2012-03-29 thu.]"
-    (org-test-with-temp-text "* Entry\n[2012-03-29 thu.]"
-      (cdr (assoc "TIMESTAMP_IA" (org-entry-properties))))))
+	  (org-test-with-temp-text "* Entry\n[2012-03-29 thu.]"
+	    (cdr (assoc "TIMESTAMP_IA" (org-entry-properties))))))
   (should
    (equal "<2012-03-29 thu.>"
-    (org-test-with-temp-text "* Entry\n[2014-03-04 tue.]<2012-03-29 thu.>"
-      (cdr (assoc "TIMESTAMP" (org-entry-properties nil "TIMESTAMP"))))))
+	  (org-test-with-temp-text "* Entry\n[2014-03-04 tue.]<2012-03-29 thu.>"
+	    (cdr (assoc "TIMESTAMP" (org-entry-properties nil "TIMESTAMP"))))))
   (should
    (equal "[2014-03-04 tue.]"
-    (org-test-with-temp-text "* Entry\n<2012-03-29 thu.>[2014-03-04 tue.]"
-      (cdr (assoc "TIMESTAMP_IA" (org-entry-properties nil "TIMESTAMP_IA"))))))
+	  (org-test-with-temp-text "* Entry\n<2012-03-29 thu.>[2014-03-04 tue.]"
+	    (cdr (assoc "TIMESTAMP_IA" (org-entry-properties nil "TIMESTAMP_IA"))))))
   ;; Get standard properties.
   (should
    (equal "1"