From mboxrd@z Thu Jan 1 00:00:00 1970 From: Max Mikhanosha Subject: Re: [PATCH] New org-depend trigger for finding next highest priority/effort item Date: Tue, 26 Jul 2011 19:34:18 -0400 Message-ID: <877h7462h1.wl%max@openchat.com> References: <87k4b7fqu3.wl%max@openchat.com> <874o29tg8h.fsf@gnu.org> Mime-Version: 1.0 (generated by SEMI 1.14.6 - "Maruoka") Content-Type: multipart/mixed; boundary="Multipart_Tue_Jul_26_19:34:18_2011-1" Content-Transfer-Encoding: 7bit Return-path: Received: from eggs.gnu.org ([140.186.70.92]:53557) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Qlr8n-0003EO-V8 for emacs-orgmode@gnu.org; Tue, 26 Jul 2011 19:34:22 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Qlr8m-0000Xu-IC for emacs-orgmode@gnu.org; Tue, 26 Jul 2011 19:34:21 -0400 Received: from p84-72.acedsl.com ([66.114.84.72]:60343 helo=momoland.openchat.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Qlr8m-0000Xh-4o for emacs-orgmode@gnu.org; Tue, 26 Jul 2011 19:34:20 -0400 In-Reply-To: <874o29tg8h.fsf@gnu.org> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Bastien Cc: emacs-orgmode@gnu.org --Multipart_Tue_Jul_26_19:34:18_2011-1 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: quoted-printable 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 =20 Also attached is updated test file, added #+TODO line since NEXT is not in default list of keywords. Content-Disposition: attachment; filename=3D"0011-Add-chain-find-next-trigg= er-option.patch"][8bit]] =46rom 6140261b2fe0e15ac36d8222c38790680cd3f9d4 Mon Sep 17 00:00:00 2001 From: Max Mikhanosha 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. +;; =20 +;; OPTIONS should be a comma separated string without spaces, and +;; can contain following options: +;; =20 +;; - from-top the candidate list is all of the siblings in +;; the current subtree +;; =20 +;; - from-bottom candidate list are all siblings from bottom up +;; =20 +;; - from-current candidate list are all siblings from current item +;; until end of subtree, then wrapped around from +;; first sibling +;; =20 +;; - no-wrap candidate list are siblings from current one down +;; =20 +;; - todo-only Only consider siblings that have a todo keyword +;; -=20 +;; - 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=20 +;; +;; +;; 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 @@ ;; =20 (require 'org) +(eval-when-compile + (require 'cl)) =20 (defcustom org-depend-tag-blocked t "Whether to indicate blocked TODO items by a special tag." :group 'org :type 'boolean) =20 +(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 siblin= g." (org-entry-add-to-multivalued-property nil "TRIGGER" ,trigger-val)))) =20 +(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) --=20 1.7.3.4 --Multipart_Tue_Jul_26_19:34:18_2011-1 Content-Type: text/plain; charset=US-ASCII --Multipart_Tue_Jul_26_19:34:18_2011-1 Content-Type: application/octet-stream Content-Disposition: attachment; filename="org-depend-chain-find-next-test.org" Content-Transfer-Encoding: quoted-printable #+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 --Multipart_Tue_Jul_26_19:34:18_2011-1--