Re: [PATCH] New org-depend trigger for finding next highest priority/effort item

[Max Mikhanosha <max@openchat.com>]

[-- Attachment #1: Type: text/plain, Size: 8122 bytes --]

Amended patch attached, changes:

- use (eval-when-compile) with require 'cl
- changed include-done to todo-and-done-only
- Added defcustom org-depend-find-next-options for default options
  which are now: from-current,todo-only,priority-up
- cleaned up documentation  

Also attached is updated test file, added #+TODO line since NEXT is
not in default list of keywords.

Content-Disposition: attachment; filename="0011-Add-chain-find-next-trigger-option.patch"][8bit]]
From 6140261b2fe0e15ac36d8222c38790680cd3f9d4 Mon Sep 17 00:00:00 2001
From: Max Mikhanosha <max@openchat.com>
Date: Sun, 24 Jul 2011 14:44:44 -0400
Subject: [PATCH 11/11] Add chain-find-next trigger option.

---
 contrib/lisp/org-depend.el |  145 +++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 143 insertions(+), 2 deletions(-)

diff --git a/contrib/lisp/org-depend.el b/contrib/lisp/org-depend.el
index 089a6a0..77a7c68 100644
--- a/contrib/lisp/org-depend.el
+++ b/contrib/lisp/org-depend.el
@@ -55,7 +55,43 @@
 ;;    - The sibling also gets the same TRIGGER property
 ;;      "chain-siblings-scheduled", so the chain can continue.
 ;;
-;; 3) If the TRIGGER property contains any other words like
+;; 3) If the TRIGGER property contains the string
+;;    "chain-find-next(KEYWORD[,OPTIONS])", then switching that entry
+;;    to DONE do the following:
+;;    - All siblings are of the entry are collected into a temporary
+;;      list and then filtered and sorted according to OPTIONS
+;;    - The first sibling on the list is changed into KEYWORD state
+;;    - The sibling also gets the same TRIGGER property
+;;      "chain-find-next", so the chain can continue.
+;;      
+;;    OPTIONS should be a comma separated string without spaces, and
+;;    can contain following options:
+;;    
+;;    - from-top      the candidate list is all of the siblings in
+;;                    the current subtree
+;;                    
+;;    - from-bottom   candidate list are all siblings from bottom up
+;;    
+;;    - from-current  candidate list are all siblings from current item
+;;                    until end of subtree, then wrapped around from
+;;                    first sibling
+;;                    
+;;    - no-wrap       candidate list are siblings from current one down
+;;    
+;;    - todo-only     Only consider siblings that have a todo keyword
+;;    - 
+;;    - todo-and-done-only
+;;                    Same as above but also include done items.
+;;
+;;    - priority-up   sort by highest priority
+;;    - priority-down sort by lowest priority
+;;    - effort-up     sort by highest effort
+;;    - effort-down   sort by lowest effort
+;;
+;;    Default OPTIONS are from-top 
+;;
+;;
+;; 4) If the TRIGGER property contains any other words like
 ;;    XYZ(KEYWORD), these are treated as entry id's with keywords.  That
 ;;    means Org-mode will search for an entry with the ID property XYZ
 ;;    and switch that entry to KEYWORD as well.
@@ -121,12 +157,20 @@
 ;;
 
 (require 'org)
+(eval-when-compile
+  (require 'cl))
 
 (defcustom org-depend-tag-blocked t
   "Whether to indicate blocked TODO items by a special tag."
   :group 'org
   :type 'boolean)
 
+(defcustom org-depend-find-next-options
+  "from-current,todo-only,priority-up"
+  "Default options for chain-find-next trigger"
+  :group 'org
+  :type 'string)
+
 (defmacro org-depend-act-on-sibling (trigger-val &rest rest)
   "Perform a set of actions on the next sibling, if it exists,
 copying the sibling spec TRIGGER-VAL to the next sibling."
@@ -143,6 +187,8 @@ copying the sibling spec TRIGGER-VAL to the next sibling."
        (org-entry-add-to-multivalued-property
         nil "TRIGGER" ,trigger-val))))
 
+(defvar org-depend-doing-chain-find-next nil)
+
 (defun org-depend-trigger-todo (change-plist)
   "Trigger new TODO entries after the current is switched to DONE.
 This does two different kinds of triggers:
@@ -184,12 +230,107 @@ This does two different kinds of triggers:
       ;; Go through all the triggers
       (while (setq tr (pop triggers))
 	(cond
+	 ((and (not org-depend-doing-chain-find-next)
+	       (string-match "\\`chain-find-next(\\b\\(.+?\\)\\b\\(.*\\))\\'" tr))
+	  ;; smarter sibling selection
+	  (let* ((org-depend-doing-chain-find-next t)
+		 (kwd (match-string 1 tr))
+		 (options (match-string 2 tr))
+		 (options (if (or (null options)
+				  (equal options ""))
+			      org-depend-find-next-options
+			    options))
+		 (todo-only (string-match "todo-only" options))
+		 (todo-and-done-only (string-match "todo-and-done-only"
+						   options))
+		 (from-top (string-match "from-top" options))
+		 (from-bottom (string-match "from-bottom" options))
+		 (from-current (string-match "from-current" options))
+		 (no-wrap (string-match "no-wrap" options))
+		 (priority-up (string-match "priority-up" options))
+		 (priority-down (string-match "priority-down" options))
+		 (effort-up (string-match "effort-up" options))
+		 (effort-down (string-match "effort-down" options)))
+	    (save-excursion
+	      (org-back-to-heading t)
+	      (let ((this-item (point)))
+		;; go up to the parent headline, then advance to next child
+		(org-up-heading-safe)
+		(let ((end (save-excursion (org-end-of-subtree t)
+					   (point)))
+		      (done nil)
+		      (items '()))
+		  (outline-next-heading)
+		  (while (not done)
+		    (if (not (looking-at org-complex-heading-regexp))
+			(setq done t)
+		      (let ((todo-kwd (match-string 2))
+			    (tags (match-string 5))
+			    (priority (org-get-priority (or (match-string 3) "")))
+			    (effort (when (or effort-up effort-down)
+				      (let ((effort (org-get-effort)))
+					(when effort
+					  (org-duration-string-to-minutes effort))))))
+			(push (list (point) todo-kwd priority tags effort)
+			      items))
+		      (unless (org-goto-sibling)
+			(setq done t))))
+		  ;; massage the list according to options
+		  (setq items
+			(cond (from-top (nreverse items))
+			      (from-bottom items)
+			      ((or from-current no-wrap)
+			       (let* ((items (nreverse items))
+				      (pos (position this-item items :key #'first))
+				      (items-before (subseq items 0 pos))
+				      (items-after (subseq items pos)))
+				 (if no-wrap items-after
+				   (append items-after items-before))))
+			      (t (nreverse items))))
+		  (setq items (remove-if
+			       (lambda (item)
+				 (or (equal (first item) this-item)
+				     (and (not todo-and-done-only)
+					  (member (second item) org-done-keywords))
+				     (and (or todo-only
+					      todo-and-done-only)
+					  (null (second item)))))
+			       items))
+		  (setq items
+			(sort
+			 items
+			 (lambda (item1 item2)
+			   (let* ((p1 (third item1))
+				  (p2 (third item2))
+				  (e1 (fifth item1))
+				  (e2 (fifth item2))
+				  (p1-lt (< p1 p2))
+				  (p1-gt (> p1 p2))
+				  (e1-lt (and e1 (or (not e2) (< e1 e2))))
+				  (e2-gt (and e2 (or (not e1) (> e1 e2)))))
+			     (cond (priority-up
+				    (or p1-gt
+					(and (equal p1 p2)
+					     (or (and effort-up e1-gt)
+						 (and effort-down e1-lt)))))
+				   (priority-down
+				    (or p1-lt
+					(and (equal p1 p2)
+					     (or (and effort-up e1-gt)
+						 (and effort-down e1-lt)))))
+				   (effort-up
+				    (or e1-gt (and (equal e1 e2) p1-gt)))
+				   (effort-down
+				    (or e1-lt (and (equal e1 e2) p1-gt))))))))
+		  (when items
+		    (goto-char (first (first items)))
+		    (org-entry-add-to-multivalued-property nil "TRIGGER" tr)
+		    (org-todo kwd)))))))
 	 ((string-match "\\`chain-siblings(\\(.*?\\))\\'" tr)
 	  ;; This is a TODO chain of siblings
 	  (setq kwd (match-string 1 tr))
           (org-depend-act-on-sibling (format "chain-siblings(%s)" kwd)
                                      (org-todo kwd)))
-
 	 ((string-match "\\`\\(\\S-+\\)(\\(.*?\\))\\'" tr)
 	  ;; This seems to be ENTRY_ID(KEYWORD)
 	  (setq id (match-string 1 tr)
-- 
1.7.3.4


[-- Attachment #2: Type: text/plain, Size: 1 bytes --]



[-- Attachment #3: org-depend-chain-find-next-test.org --]
[-- Type: application/octet-stream, Size: 2576 bytes --]

#+TODO: TODO NEXT | DONE CANCELED

* Default
** TODO Item 1
** TODO Item 2
** TODO Item 3
** TODO Item 4
** NEXT Item 5 Current (mark me done)
   :PROPERTIES:
   :TRIGGER:  chain-find-next(NEXT)
   :END:
** TODO Item 6
** Item 7
** TODO Item 8
** DONE Item 9
* from-top (same as default)
** TODO Item 1
** TODO Item 2
** TODO Item 3
** TODO Item 4
** NEXT Item 5 Current (mark me done)
   :PROPERTIES:
   :TRIGGER:  chain-find-next(NEXT,from-top)
   :END:
** TODO Item 6
** Item 7
** TODO Item 8
** DONE Item 9
* from-bottom
** TODO Item 1
** TODO Item 2
** TODO Item 3
** TODO Item 4
** NEXT Item 5 Current (mark me done)
   :PROPERTIES:
   :TRIGGER:  chain-find-next(NEXT,from-bottom)
   :END:
** TODO Item 6
** Item 7
** TODO Item 8
** DONE Item 9
* from-current,priority-up
** TODO Item 1
** TODO Item 2
** TODO Item 3
** TODO [#A] Item 4
** NEXT Item 5 Current (mark me done)
   :PROPERTIES:
   :TRIGGER:  chain-find-next(NEXT,from-current,priority-up)
   :END:
** TODO Item 6
** Item 7
** TODO [#B] Item 8
** DONE Item 9
* from-current,no-wrap,priority-up
** TODO Item 1
** TODO Item 2
** TODO Item 3
** TODO [#A] Item 4
** NEXT Item 5 Current (mark me done)
   :PROPERTIES:
   :TRIGGER:  chain-find-next(NEXT,from-current,no-wrap,priority-up)
   :END:
** TODO Item 6
** Item 7
** TODO [#B] Item 8
** DONE Item 9
* from-current, without todo-only
** TODO Item 1
** TODO Item 2
** TODO Item 3
** TODO Item 4
** NEXT Item 5 Current (mark me done)
   :PROPERTIES:
   :TRIGGER:  chain-find-next(NEXT,from-current)
   :END:
** Item 6
** Item 7
** TODO Item 8
** DONE Item 9
* from-current, with todo-only
** TODO Item 1
** TODO Item 2
** TODO Item 3
** TODO Item 4
** NEXT Item 5 Current (mark me done)
   :PROPERTIES:
   :TRIGGER:  chain-find-next(NEXT,from-current,todo-only)
   :END:
** Item 6
** Item 7
** TODO Item 8
** DONE Item 9
* from-current without include-done
** TODO Item 1
** TODO Item 2
** TODO Item 3
** TODO Item 4
** NEXT Item 5 Current (mark me done)
   :PROPERTIES:
   :TRIGGER:  chain-find-next(NEXT,from-current)
   :END:
** DONE Item 6
   CLOSED: [2011-07-26 Tue 17:49]
** Item 7
** TODO Item 8
** DONE Item 9
* from-current with include-done
** TODO Item 1
** TODO Item 2
** TODO Item 3
** TODO Item 4
** NEXT Item 5 Current (mark me done)
   :PROPERTIES:
   :TRIGGER:  chain-find-next(NEXT,from-current,todo-and-done-only)
   :END:
** DONE Item 6
   CLOSED: [2011-07-26 Tue 17:49]
** Item 7
** TODO Item 8
** DONE Item 9
* end