Blocking: Make it possible that checkboxes block TODO state changes

See the documentation for details.

doc/ChangeLog

@@ -1,3 +1,8 @@
+2009-01-30  Carsten Dominik  <carsten.dominik@gmail.com>
+
+	* org.texi (TODO dependencies): Document TODO dependencies on
+	checkboxes.
+
 2009-01-27  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org.texi (TODO dependencies): New section.

doc/org.texi

@@ -3310,6 +3310,8 @@ necessary, define a special face and use that.
 
 @node TODO dependencies,  , Faces for TODO keywords, TODO extensions
 @subsection TODO dependencies
+@cindex TODO dependencies
+@cindex dependencies, of TODO states
 
 The structure of Org files (hierarchy and lists) makes it easy to define TODO
 dependencies.  Usually, a parent TODO task should not be marked DONE until
@@ -3339,12 +3341,21 @@ blocked until all earlier siblings are marked DONE.  Here is an example:
 @kindex C-c C-x o
 @item C-c C-x o
 Toggle the @code{ORDERED} property of the current entry.
+@kindex C-u C-u C-u C-c C-t
+@item C-u C-u C-u C-c C-t
+Change TODO state, circumventin any state blocking.
 @end table
 
 If you set the variable @code{org-agenda-dim-blocked-tasks}, TODO entries
 that cannot be closed because of such dependencies will be shown in a dimmed
 font or even made invisible in agenda views (@pxref{Agenda Views}).
 
+@cindex checkboxes and TODO dependencies
+You can also block changes of TODO states by looking at checkboxes
+(@pxref{Checkboxes}).  If you set the variable
+@code{org-enforce-todo-checkbox-dependencies}, an entry that has unchecked
+checkboxes will be blocked from switching to DONE.
+
 If you need more complex dependency structures, for example dependencies
 between entries in different trees or files, check out the contributed
 module @file{org-depend.el}.

lisp/ChangeLog

@@ -1,5 +1,9 @@
 2009-01-30  Carsten Dominik  <carsten.dominik@gmail.com>
 
+	* org.el (org-enforce-todo-checkbox-dependencies): New option.
+	(org-block-todo-from-checkboxes): New function.
+	(org-todo): Make tripple prefix arg circumvent blocking.
+
 	* org-timer.el (org-timer): Provide the timer feature.
 
 	* org.el (org-require-autoloaded-modules): Add a few more files to

lisp/org.el

@@ -1641,8 +1641,27 @@ restart emacs after changing the value."
   :set (lambda (var val)
 	 (set var val)
 	 (if val
-	     (add-hook 'org-blocker-hook 'org-block-todo-from-children-or-siblings)
+	     (add-hook 'org-blocker-hook
-	   (remove-hook 'org-blocker-hook 'org-block-todo-from-children-or-siblings)))
+		       'org-block-todo-from-children-or-siblings)
+	   (remove-hook 'org-blocker-hook
+			'org-block-todo-from-children-or-siblings)))
+  :group 'org-todo
+  :type 'boolean)
+
+(defcustom org-enforce-todo-checkbox-dependencies nil
+  "Non-nil means, unchecked boxes will block switching the parent to DONE.
+When this is nil, checkboxes have no influence on switching TODO states.
+When non-nil, you first need to check off all check boxes before the TODO
+entry can be switched to DONE.
+You need to set this variable through the customize interface, or to
+restart emacs after changing the value."
+  :set (lambda (var val)
+	 (set var val)
+	 (if val
+	     (add-hook 'org-blocker-hook
+		       'org-block-todo-from-checkboxes)
+	   (remove-hook 'org-blocker-hook
+			'org-block-todo-from-checkboxes)))
   :group 'org-todo
   :type 'boolean)
 
@@ -8332,6 +8351,7 @@ DONE are present, add TODO at the beginning of the heading.
 With C-u prefix arg, use completion to determine the new state.
 With numeric prefix arg, switch to that state.
 With a double C-u prefix, switch to the next set of TODO keywords (nextset).
+With a tripple C-u prefix, circumvent any state blocking.
 
 For calling through lisp, arg is also interpreted in the following way:
 'none             -> empty state
@@ -8343,169 +8363,176 @@ For calling through lisp, arg is also interpreted in the following way:
                      really is a member of `org-todo-keywords'."
   (interactive "P")
   (if (equal arg '(16)) (setq arg 'nextset))
-  (save-excursion
+  (let ((org-blocker-hook org-blocker-hook))
-    (catch 'exit
+    (when (equal arg '(64))
-      (org-back-to-heading)
+      (setq arg nil org-blocker-hook nil))
-      (if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
+    (save-excursion
-      (or (looking-at (concat " +" org-todo-regexp " *"))
+      (catch 'exit
-	  (looking-at " *"))
+	(org-back-to-heading)
-      (let* ((match-data (match-data))
+	(if (looking-at outline-regexp) (goto-char (1- (match-end 0))))
-	     (startpos (point-at-bol))
+	(or (looking-at (concat " +" org-todo-regexp " *"))
-	     (logging (save-match-data (org-entry-get nil "LOGGING" t)))
+	    (looking-at " *"))
-	     (org-log-done org-log-done)
+	(let* ((match-data (match-data))
-	     (org-log-repeat org-log-repeat)
+	       (startpos (point-at-bol))
-	     (org-todo-log-states org-todo-log-states)
+	       (logging (save-match-data (org-entry-get nil "LOGGING" t)))
-	     (this (match-string 1))
+	       (org-log-done org-log-done)
-	     (hl-pos (match-beginning 0))
+	       (org-log-repeat org-log-repeat)
-	     (head (org-get-todo-sequence-head this))
+	       (org-todo-log-states org-todo-log-states)
-	     (ass (assoc head org-todo-kwd-alist))
+	       (this (match-string 1))
-	     (interpret (nth 1 ass))
+	       (hl-pos (match-beginning 0))
-	     (done-word (nth 3 ass))
+	       (head (org-get-todo-sequence-head this))
-	     (final-done-word (nth 4 ass))
+	       (ass (assoc head org-todo-kwd-alist))
-	     (last-state (or this ""))
+	       (interpret (nth 1 ass))
-	     (completion-ignore-case t)
+	       (done-word (nth 3 ass))
-	     (member (member this org-todo-keywords-1))
+	       (final-done-word (nth 4 ass))
-	     (tail (cdr member))
+	       (last-state (or this ""))
-	     (state (cond
+	       (completion-ignore-case t)
-		     ((and org-todo-key-trigger
+	       (member (member this org-todo-keywords-1))
-			   (or (and (equal arg '(4)) (eq org-use-fast-todo-selection 'prefix))
+	       (tail (cdr member))
-			       (and (not arg) org-use-fast-todo-selection
+	       (state (cond
-				    (not (eq org-use-fast-todo-selection 'prefix)))))
+		       ((and org-todo-key-trigger
-		      ;; Use fast selection
+			     (or (and (equal arg '(4))
-		      (org-fast-todo-selection))
+				      (eq org-use-fast-todo-selection 'prefix))
-		     ((and (equal arg '(4))
+				 (and (not arg) org-use-fast-todo-selection
-			   (or (not org-use-fast-todo-selection)
+				      (not (eq org-use-fast-todo-selection
-			       (not org-todo-key-trigger)))
+					       'prefix)))))
-		      ;; Read a state with completion
+			;; Use fast selection
-		      (org-ido-completing-read "State: " (mapcar (lambda(x) (list x))
+			(org-fast-todo-selection))
-							 org-todo-keywords-1)
+		       ((and (equal arg '(4))
-				       nil t))
+			     (or (not org-use-fast-todo-selection)
-		     ((eq arg 'right)
+				 (not org-todo-key-trigger)))
-		      (if this
+			;; Read a state with completion
-			  (if tail (car tail) nil)
+			(org-ido-completing-read
-			(car org-todo-keywords-1)))
+			 "State: " (mapcar (lambda(x) (list x))
-		     ((eq arg 'left)
+					   org-todo-keywords-1)
-		      (if (equal member org-todo-keywords-1)
+			 nil t))
-			  nil
+		       ((eq arg 'right)
 			(if this
-			    (nth (- (length org-todo-keywords-1) (length tail) 2)
+			    (if tail (car tail) nil)
-				 org-todo-keywords-1)
+			  (car org-todo-keywords-1)))
-			  (org-last org-todo-keywords-1))))
+		       ((eq arg 'left)
-		     ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
+			(if (equal member org-todo-keywords-1)
-			   (setq arg nil))) ; hack to fall back to cycling
+			    nil
-		     (arg
+			  (if this
-		      ;; user or caller requests a specific state
+			      (nth (- (length org-todo-keywords-1)
-		      (cond
+				      (length tail) 2)
-		       ((equal arg "") nil)
+				   org-todo-keywords-1)
-		       ((eq arg 'none) nil)
+			    (org-last org-todo-keywords-1))))
-		       ((eq arg 'done) (or done-word (car org-done-keywords)))
+		       ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
-		       ((eq arg 'nextset)
+			     (setq arg nil))) ; hack to fall back to cycling
-			(or (car (cdr (member head org-todo-heads)))
+		       (arg
-			    (car org-todo-heads)))
+			;; user or caller requests a specific state
-		       ((eq arg 'previousset)
+			(cond
-			(let ((org-todo-heads (reverse org-todo-heads)))
+			 ((equal arg "") nil)
+			 ((eq arg 'none) nil)
+			 ((eq arg 'done) (or done-word (car org-done-keywords)))
+			 ((eq arg 'nextset)
 			  (or (car (cdr (member head org-todo-heads)))
-			      (car org-todo-heads))))
+			      (car org-todo-heads)))
-		       ((car (member arg org-todo-keywords-1)))
+			 ((eq arg 'previousset)
-		       ((nth (1- (prefix-numeric-value arg))
+			  (let ((org-todo-heads (reverse org-todo-heads)))
-			     org-todo-keywords-1))))
+			    (or (car (cdr (member head org-todo-heads)))
-		     ((null member) (or head (car org-todo-keywords-1)))
+				(car org-todo-heads))))
-		     ((equal this final-done-word) nil) ;; -> make empty
+			 ((car (member arg org-todo-keywords-1)))
-		     ((null tail) nil) ;; -> first entry
+			 ((nth (1- (prefix-numeric-value arg))
-		     ((eq interpret 'sequence)
+			       org-todo-keywords-1))))
-		      (car tail))
+		       ((null member) (or head (car org-todo-keywords-1)))
-		     ((memq interpret '(type priority))
+		       ((equal this final-done-word) nil) ;; -> make empty
-		      (if (eq this-command last-command)
+		       ((null tail) nil) ;; -> first entry
-			  (car tail)
+		       ((eq interpret 'sequence)
-			(if (> (length tail) 0)
+			(car tail))
-			    (or done-word (car org-done-keywords))
+		       ((memq interpret '(type priority))
-			  nil)))
+			(if (eq this-command last-command)
-		     (t nil)))
+			    (car tail)
-	     (next (if state (concat " " state " ") " "))
+			  (if (> (length tail) 0)
-	     (change-plist (list :type 'todo-state-change :from this :to state
+			      (or done-word (car org-done-keywords))
-				 :position startpos))
+			    nil)))
-	     dolog now-done-p)
+		       (t nil)))
-	(when org-blocker-hook
+	       (next (if state (concat " " state " ") " "))
+	       (change-plist (list :type 'todo-state-change :from this :to state
+				   :position startpos))
+	       dolog now-done-p)
+	  (when org-blocker-hook
+	    (setq org-last-todo-state-is-todo
+		  (not (member this org-done-keywords)))
+	    (unless (save-excursion
+		      (save-match-data
+			(run-hook-with-args-until-failure
+			 'org-blocker-hook change-plist)))
+	      (if (interactive-p)
+		  (error "TODO state change from %s to %s blocked" this state)
+		;; fail silently
+		(message "TODO state change from %s to %s blocked" this state)
+		(throw 'exit nil))))
+	  (store-match-data match-data)
+	  (replace-match next t t)
+	  (unless (pos-visible-in-window-p hl-pos)
+	    (message "TODO state changed to %s" (org-trim next)))
+	  (unless head
+	    (setq head (org-get-todo-sequence-head state)
+		  ass (assoc head org-todo-kwd-alist)
+		  interpret (nth 1 ass)
+		  done-word (nth 3 ass)
+		  final-done-word (nth 4 ass)))
+	  (when (memq arg '(nextset previousset))
+	    (message "Keyword-Set %d/%d: %s"
+		     (- (length org-todo-sets) -1
+			(length (memq (assoc state org-todo-sets) org-todo-sets)))
+		     (length org-todo-sets)
+		     (mapconcat 'identity (assoc state org-todo-sets) " ")))
 	  (setq org-last-todo-state-is-todo
-		(not (member this org-done-keywords)))
+		(not (member state org-done-keywords)))
-	  (unless (save-excursion
+	  (setq now-done-p (and (member state org-done-keywords)
-		    (save-match-data
+				(not (member this org-done-keywords))))
-		      (run-hook-with-args-until-failure
+	  (and logging (org-local-logging logging))
-		       'org-blocker-hook change-plist)))
+	  (when (and (or org-todo-log-states org-log-done)
-	    (if (interactive-p)
+		     (not (memq arg '(nextset previousset))))
-		(error "TODO state change from %s to %s blocked" this state)
+	    ;; we need to look at recording a time and note
-	      ;; fail silently
+	    (setq dolog (or (nth 1 (assoc state org-todo-log-states))
-	      (message "TODO state change from %s to %s blocked" this state)
+			    (nth 2 (assoc this org-todo-log-states))))
-	      (throw 'exit nil))))
+	    (when (and state
-	(store-match-data match-data)
+		       (member state org-not-done-keywords)
-	(replace-match next t t)
+		       (not (member this org-not-done-keywords)))
-	(unless (pos-visible-in-window-p hl-pos)
+	      ;; This is now a todo state and was not one before
-	  (message "TODO state changed to %s" (org-trim next)))
+	      ;; If there was a CLOSED time stamp, get rid of it.
-	(unless head
+	      (org-add-planning-info nil nil 'closed))
-	  (setq head (org-get-todo-sequence-head state)
+	    (when (and now-done-p org-log-done)
-		ass (assoc head org-todo-kwd-alist)
+	      ;; It is now done, and it was not done before
-		interpret (nth 1 ass)
+	      (org-add-planning-info 'closed (org-current-time))
-		done-word (nth 3 ass)
+	      (if (and (not dolog) (eq 'note org-log-done))
-		final-done-word (nth 4 ass)))
+		  (org-add-log-setup 'done state 'findpos 'note)))
-	(when (memq arg '(nextset previousset))
+	    (when (and state dolog)
-	  (message "Keyword-Set %d/%d: %s"
+	      ;; This is a non-nil state, and we need to log it
-		   (- (length org-todo-sets) -1
+	      (org-add-log-setup 'state state 'findpos dolog)))
-		      (length (memq (assoc state org-todo-sets) org-todo-sets)))
+	  ;; Fixup tag positioning
-		   (length org-todo-sets)
+	  (org-todo-trigger-tag-changes state)
-		   (mapconcat 'identity (assoc state org-todo-sets) " ")))
+	  (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
-	(setq org-last-todo-state-is-todo
+	  (when org-provide-todo-statistics
-	      (not (member state org-done-keywords)))
+	    (org-update-parent-todo-statistics))
-	(setq now-done-p (and (member state org-done-keywords)
+	  (run-hooks 'org-after-todo-state-change-hook)
-			      (not (member this org-done-keywords))))
+	  (if (and arg (not (member state org-done-keywords)))
-	(and logging (org-local-logging logging))
+	      (setq head (org-get-todo-sequence-head state)))
-	(when (and (or org-todo-log-states org-log-done)
+	  (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
-		   (not (memq arg '(nextset previousset))))
+	  ;; Do we need to trigger a repeat?
-	  ;; we need to look at recording a time and note
+	  (when now-done-p
-	  (setq dolog (or (nth 1 (assoc state org-todo-log-states))
+	    (when (boundp 'org-agenda-headline-snapshot-before-repeat)
-			  (nth 2 (assoc this org-todo-log-states))))
+	      ;; This is for the agenda, take a snapshot of the headline.
-	  (when (and state
+	      (save-match-data
-		     (member state org-not-done-keywords)
+		(setq org-agenda-headline-snapshot-before-repeat
-		     (not (member this org-not-done-keywords)))
+		      (org-get-heading))))
-	    ;; This is now a todo state and was not one before
+	    (org-auto-repeat-maybe state))
-	    ;; If there was a CLOSED time stamp, get rid of it.
+	  ;; Fixup cursor location if close to the keyword
-	    (org-add-planning-info nil nil 'closed))
+	  (if (and (outline-on-heading-p)
-	  (when (and now-done-p org-log-done)
+		   (not (bolp))
-	    ;; It is now done, and it was not done before
+		   (save-excursion (beginning-of-line 1)
-	    (org-add-planning-info 'closed (org-current-time))
+				   (looking-at org-todo-line-regexp))
-	    (if (and (not dolog) (eq 'note org-log-done))
+		   (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
-		(org-add-log-setup 'done state 'findpos 'note)))
+	      (progn
-	  (when (and state dolog)
+		(goto-char (or (match-end 2) (match-end 1)))
-	    ;; This is a non-nil state, and we need to log it
+		(just-one-space)))
-	    (org-add-log-setup 'state state 'findpos dolog)))
+	  (when org-trigger-hook
-	;; Fixup tag positioning
+	    (save-excursion
-	(org-todo-trigger-tag-changes state)
+	      (run-hook-with-args 'org-trigger-hook change-plist))))))))
-	(and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
-	(when org-provide-todo-statistics
-	  (org-update-parent-todo-statistics))
-	(run-hooks 'org-after-todo-state-change-hook)
-	(if (and arg (not (member state org-done-keywords)))
-	    (setq head (org-get-todo-sequence-head state)))
-	(put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
-	;; Do we need to trigger a repeat?
-	(when now-done-p
-	  (when (boundp 'org-agenda-headline-snapshot-before-repeat)
-	    ;; This is for the agenda, take a snapshot of the headline.
-	    (save-match-data
-	      (setq org-agenda-headline-snapshot-before-repeat
-		    (org-get-heading))))
-	  (org-auto-repeat-maybe state))
-	;; Fixup cursor location if close to the keyword
-	(if (and (outline-on-heading-p)
-		 (not (bolp))
-		 (save-excursion (beginning-of-line 1)
-				 (looking-at org-todo-line-regexp))
-		 (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
-	    (progn
-	      (goto-char (or (match-end 2) (match-end 1)))
-	      (just-one-space)))
-	(when org-trigger-hook
-	  (save-excursion
-	    (run-hook-with-args 'org-trigger-hook change-plist)))))))
 
 (defun org-block-todo-from-children-or-siblings (change-plist)
   "Block turning an entry into a TODO, using the hierarchy.
@@ -8522,7 +8549,9 @@ changes.  Such blocking occurs when:
     ;; do not block
     (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
 	      (member (plist-get change-plist :from)
-		      (cons 'done org-done-keywords)))
+		      (cons 'done org-done-keywords))
+	      (member (plist-get change-plist :to)
+		      (cons 'todo org-not-done-keywords)))
       (throw 'dont-block t))
     ;; If this task has children, and any are undone, it's blocked
     (save-excursion
@@ -8573,6 +8602,31 @@ changes.  Such blocking occurs when:
       (org-entry-put nil "ORDERED" "t")
       (message "Subtasks must be completed in sequence"))))
 
+(defun org-block-todo-from-checkboxes (change-plist)
+  "Block turning an entry into a TODO, using checkboxes.
+This checks whether the current task should be blocked from state
+changes because there are uncheckd boxes in this entry."
+  (catch 'dont-block
+    ;; If this is not a todo state change, or if this entry is already DONE,
+    ;; do not block
+    (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
+	      (member (plist-get change-plist :from)
+		      (cons 'done org-done-keywords))
+	      (member (plist-get change-plist :to)
+		      (cons 'todo org-not-done-keywords)))
+      (throw 'dont-block t))
+    ;; If this task has checkboxes that are not checked, it's blocked
+    (save-excursion
+      (org-back-to-heading t)
+      (let ((beg (point)) end)
+	(outline-next-heading)
+	(setq end (point))
+	(goto-char beg)
+	(if (re-search-forward "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\[[- ]\\]"
+			       end t)
+	    (throw 'dont-block nil))))
+    t)) ; do not block
+
 (defun org-update-parent-todo-statistics ()
   "Update any statistics cookie in the parent of the current headline."
   (interactive)