421 lines
15 KiB
EmacsLisp
421 lines
15 KiB
EmacsLisp
;;; org-depend.el --- TODO dependencies for Org-mode
|
|
;; Copyright (C) 2008-2017 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.
|
|
|
|
;; This program 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. If not, see <http://www.gnu.org/licenses/>.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;;; 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."
|
|
|
|
;; Refresh the effort text properties
|
|
(org-refresh-properties org-effort-property 'org-effort)
|
|
;; 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 id)
|
|
(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 (get-text-property (point) 'org-effort)))
|
|
(when effort
|
|
(org-duration-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-lt)
|
|
(and effort-down e2-gt)))))
|
|
(priority-down
|
|
(or p1-lt
|
|
(and (equal p1 p2)
|
|
(or (and effort-up e1-lt)
|
|
(and effort-down e2-gt)))))
|
|
(effort-up
|
|
(or e2-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
|