diff options
Diffstat (limited to 'contrib/lisp/org-depend.el')
| -rw-r--r-- | contrib/lisp/org-depend.el | 420 |
1 files changed, 420 insertions, 0 deletions
diff --git a/contrib/lisp/org-depend.el b/contrib/lisp/org-depend.el new file mode 100644 index 0000000..d741dbe --- /dev/null +++ b/contrib/lisp/org-depend.el @@ -0,0 +1,420 @@ +;;; org-depend.el --- TODO dependencies for Org-mode +;; Copyright (C) 2008-2012 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 0.08 +;; +;; This file is not part of GNU Emacs. +;; +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; WARNING: This file is just a PROOF OF CONCEPT, not a supported part +;; of Org-mode. +;; +;; This is an example implementation of TODO dependencies in Org-mode. +;; It uses the new hooks in version 5.13 of Org-mode, +;; `org-trigger-hook' and `org-blocker-hook'. +;; +;; It implements the following: +;; +;; Triggering +;; ---------- +;; +;; 1) If an entry contains a TRIGGER property that contains the string +;; "chain-siblings(KEYWORD)", then switching that entry to DONE does +;; do the following: +;; - The sibling following this entry switched to todo-state KEYWORD. +;; - The sibling also gets a TRIGGER property "chain-sibling(KEYWORD)", +;; property, to make sure that, when *it* is DONE, the chain will +;; continue. +;; +;; 2) If an entry contains a TRIGGER property that contains the string +;; "chain-siblings-scheduled", then switching that entry to DONE does +;; the following actions, similarly to "chain-siblings(KEYWORD)": +;; - The sibling receives the same scheduled time as the entry +;; marked as DONE (or, in the case, in which there is no scheduled +;; time, the sibling does not get any either). +;; - The sibling also gets the same TRIGGER property +;; "chain-siblings-scheduled", so the chain can continue. +;; +;; 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. +;; +;; Blocking +;; -------- +;; +;; 1) If an entry contains a BLOCKER property that contains the word +;; "previous-sibling", the sibling above the current entry is +;; checked when you try to mark it DONE. If it is still in a TODO +;; state, the current state change is blocked. +;; +;; 2) If the BLOCKER property contains any other words, these are +;; treated as entry id's. That means Org-mode will search for an +;; entry with the ID property exactly equal to this word. If any +;; of these entries is not yet marked DONE, the current state change +;; will be blocked. +;; +;; 3) Whenever a state change is blocked, an org-mark is pushed, so that +;; you can find the offending entry with `C-c &'. +;; +;;; Example: +;; +;; When trying this example, make sure that the settings for TODO keywords +;; have been activated, i.e. include the following line and press C-c C-c +;; on the line before working with the example: +;; +;; #+TYP_TODO: TODO NEXT | DONE +;; +;; * TODO Win a million in Las Vegas +;; The "third" TODO (see above) cannot become a TODO without this money. +;; +;; :PROPERTIES: +;; :ID: I-cannot-do-it-without-money +;; :END: +;; +;; * Do this by doing a chain of TODO's +;; ** NEXT This is the first in this chain +;; :PROPERTIES: +;; :TRIGGER: chain-siblings(NEXT) +;; :END: +;; +;; ** This is the second in this chain +;; +;; ** This is the third in this chain +;; :PROPERTIES: +;; :BLOCKER: I-cannot-do-it-without-money +;; :END: +;; +;; ** This is the forth in this chain +;; When this is DONE, we will also trigger entry XYZ-is-my-id +;; :PROPERTIES: +;; :TRIGGER: XYZ-is-my-id(TODO) +;; :END: +;; +;; ** This is the fifth in this chain +;; +;; * Start writing report +;; :PROPERTIES: +;; :ID: XYZ-is-my-id +;; :END: +;; +;; + +(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." + `(catch 'exit + (save-excursion + (goto-char pos) + ;; find the sibling, exit if no more siblings + (condition-case nil + (outline-forward-same-level 1) + (error (throw 'exit t))) + ;; mark the sibling TODO + ,@rest + ;; make sure the sibling will continue the chain + (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: + +- If the current entry contains a TRIGGER property that contains + \"chain-siblings(KEYWORD)\", it goes to the next sibling, marks it + KEYWORD and also installs the \"chain-sibling\" trigger to continue + the chain. +- If the current entry contains a TRIGGER property that contains + \"chain-siblings-scheduled\", we go to the next sibling and copy + the scheduled time from the current task, also installing the property + in the sibling. +- Any other word (space-separated) like XYZ(KEYWORD) in the TRIGGER + property is seen as an entry id. Org-mode finds the entry with the + corresponding ID property and switches it to the state TODO as well." + + ;; Get information from the plist + (let* ((type (plist-get change-plist :type)) + (pos (plist-get change-plist :position)) + (from (plist-get change-plist :from)) + (to (plist-get change-plist :to)) + (org-log-done nil) ; IMPROTANT!: no logging during automatic trigger! + trigger triggers tr p1 kwd) + (catch 'return + (unless (eq type 'todo-state-change) + ;; We are only handling todo-state-change.... + (throw 'return t)) + (unless (and (member from org-not-done-keywords) + (member to org-done-keywords)) + ;; This is not a change from TODO to DONE, ignore it + (throw 'return t)) + + ;; OK, we just switched from a TODO state to a DONE state + ;; Lets see if this entry has a TRIGGER property. + ;; If yes, split it up on whitespace. + (setq trigger (org-entry-get pos "TRIGGER") + triggers (and trigger (org-split-string trigger "[ \t]+"))) + + ;; 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) + kwd (match-string 2 tr) + p1 (org-find-entry-with-id id)) + (when p1 + ;; there is an entry with this ID, mark it TODO + (save-excursion + (goto-char p1) + (org-todo kwd)))) + ((string-match "\\`chain-siblings-scheduled\\'" tr) + (let ((time (org-get-scheduled-time pos))) + (when time + (org-depend-act-on-sibling + "chain-siblings-scheduled" + (org-schedule nil time)))))))))) + +(defun org-depend-block-todo (change-plist) + "Block turning an entry into a TODO. +This checks for a BLOCKER property in an entry and checks +all the entries listed there. If any of them is not done, +block changing the current entry into a TODO entry. If the property contains +the word \"previous-sibling\", the sibling above the current entry is checked. +Any other words are treated as entry id's. If an entry exists with the +this ID property, that entry is also checked." + ;; Get information from the plist + (let* ((type (plist-get change-plist :type)) + (pos (plist-get change-plist :position)) + (from (plist-get change-plist :from)) + (to (plist-get change-plist :to)) + (org-log-done nil) ; IMPROTANT!: no logging during automatic trigger + blocker blockers bl p1 + (proceed-p + (catch 'return + ;; If this is not a todo state change, or if this entry is + ;; DONE, do not block + (when (or (not (eq type 'todo-state-change)) + (member from (cons 'done org-done-keywords)) + (member to (cons 'todo org-not-done-keywords)) + (not to)) + (throw 'return t)) + + ;; OK, the plan is to switch from nothing to TODO + ;; Lets see if we will allow it. Find the BLOCKER property + ;; and split it on whitespace. + (setq blocker (org-entry-get pos "BLOCKER") + blockers (and blocker (org-split-string blocker "[ \t]+"))) + + ;; go through all the blockers + (while (setq bl (pop blockers)) + (cond + ((equal bl "previous-sibling") + ;; the sibling is required to be DONE. + (catch 'ignore + (save-excursion + (goto-char pos) + ;; find the older sibling, exit if no more siblings + (condition-case nil + (outline-backward-same-level 1) + (error (throw 'ignore t))) + ;; Check if this entry is not yet done and block + (unless (org-entry-is-done-p) + ;; return nil, to indicate that we block the change! + (org-mark-ring-push) + (throw 'return nil))))) + + ((setq p1 (org-find-entry-with-id bl)) + ;; there is an entry with this ID, check it out + (save-excursion + (goto-char p1) + (unless (org-entry-is-done-p) + ;; return nil, to indicate that we block the change! + (org-mark-ring-push) + (throw 'return nil)))))) + t ; return t to indicate that we are not blocking + ))) + (when org-depend-tag-blocked + (org-toggle-tag "blocked" (if proceed-p 'off 'on))) + + proceed-p)) + +(add-hook 'org-trigger-hook 'org-depend-trigger-todo) +(add-hook 'org-blocker-hook 'org-depend-block-todo) + +(provide 'org-depend) + +;;; org-depend.el ends here |