summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMax Mikhanosha <max@openchat.com>2011-07-24 14:44:44 -0400
committerBastien Guerry <bzg@altern.org>2011-07-27 13:28:34 +0200
commitb1279dde0fec5e043b294117d9b999eb99be9a0f (patch)
tree3649e852ad063564cfe563b9c6d132d5c8840f88
parent70fab165e1966b32e08ed05776ca19e711d1d1e9 (diff)
downloadorg-mode-b1279dde0fec5e043b294117d9b999eb99be9a0f.tar.gz
Add chain-find-next trigger option.
-rw-r--r--contrib/lisp/org-depend.el145
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)