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

[Max Mikhanosha <max@openchat.com>]

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

org-depend TRIGGER chain-siblings(NEXT) property is hardly usable for
me, because it requires too much effort to keep items nicely sorted.

For example if next headline is already in DONE state, chain-siblings
would still change it. I prefer to sort my items by setting their
priorities and/or effort estimate, leaving DONE items in place for
some time.

Attached patch implements new TRIGGER chain-find-next(NEXT[,options])
trigger, which allows to flexibly select which of the siblings will be
changed to NEXT.

Example: chain-find-next(NEXT,from-current,priority-up,todo-only)


[-- Attachment #2: 0011-Add-chain-find-next-trigger-option.patch --]
[-- Type: application/octet-stream, Size: 7711 bytes --]

From 10ac42d25793eedc595641555186321219818cec 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 |  142 +++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 140 insertions(+), 2 deletions(-)

diff --git a/contrib/lisp/org-depend.el b/contrib/lisp/org-depend.el
index 089a6a0..aa8e728 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-siblings-scheduled", 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
+;;    
+;;    - include-done  include siblings with TODO in `org-done-keywords',
+;;                    they are excluded by default
+;;                      
+;;    - todo-only     Only consider siblings that have TODO only, by default
+;;                    siblings without TODO keyword are considered too
+;;
+;;    - 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,6 +157,7 @@
 ;;
 
 (require 'org)
+(require 'cl)
 
 (defcustom org-depend-tag-blocked t
   "Whether to indicate blocked TODO items by a special tag."
@@ -143,6 +180,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 +223,111 @@ 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
+	  ;; keywords
+	  ;;
+	  ;; include-done => include siblings in DONE todo states
+	  ;; todo-only => only todo items, otherwise will consider items without any todo keyword too
+	  ;; from-top => candidates siblings are in sequential order
+	  ;; from-bottom => candidate siblings are in reverse order
+	  ;; from-current => candidate siblings are from current one down
+	  ;; no-wrap => used together with from current, stop if reached
+	  ;; the end, otherwise it wraps
+	  ;; priority-up => use highest priority
+	  ;; effort-down => use shortest effort
+	  (let* ((org-depend-doing-chain-find-next t)
+		 (kwd (match-string 1 tr))
+		 (options (match-string 2 tr))
+		 (include-done (string-match "include-done" options))
+		 (todo-only (string-match "todo-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 include-done)
+					  (member (second item) org-done-keywords))
+				     (and todo-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