1 ;;;_ org-choose.el --- decision management for org-mode
5 ;; Copyright (C) 2009-2012 Tom Breton (Tehom)
7 ;; This file is not part of GNU Emacs.
9 ;; Author: Tom Breton (Tehom)
10 ;; Keywords: outlines, convenience
12 ;; This file is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; This file is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to
24 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
29 ; This is code to support decision management. It lets you treat a
30 ; group of sibling items in org-mode as alternatives in a decision.
32 ; There are no user commands in this file. You use it by:
33 ; * Loading it (manually or by M-x customize-apropos org-modules)
35 ;; * Setting up at least one set of TODO keywords with the
36 ;; interpretation "choose" by either:
38 ;; * Using the file directive #+CHOOSE_TODO:
40 ;; * For instance, "#+CHOOSE_TODO: NO(,-) MAYBE(,0) YES"
42 ;; * Or by M-x customize-apropos org-todo-keywords
44 ;; * Operating on single items with the TODO commands.
46 ;; * Use C-S-right to change the keyword set. Use this to change to
47 ;; the "choose" keyword set that you just defined.
49 ;; * Use S-right to advance the TODO mark to the next setting.
51 ;; For "choose", that means you like this alternative more than
52 ;; before. Other alternatives will be automatically demoted to
53 ;; keep your settings consistent.
55 ;; * Use S-left to demote TODO to the previous setting.
57 ;; For "choose", that means you don't like this alternative as much
58 ;; as before. Other alternatives will be automatically promoted,
59 ;; if this item was all that was keeping them down.
61 ;; * All the other TODO commands are available and behave essentially
75 (defstruct (org-choose-mark-data.
(:type list
))
76 "The format of an entry in org-choose-mark-data.
77 Indexes are 0-based or `nil'.
86 (defvar org-choose-mark-data
88 "Alist of information for choose marks.
90 Each entry is an `org-choose-mark-data.'" )
91 (make-variable-buffer-local 'org-choose-mark-data
)
93 ;;;_ . org-choose-filter-one
95 (defun org-choose-filter-one (i)
97 * a canonized version of the string
98 * optionally one symbol"
102 (string-match "(.*)" i
))
106 (end-text (match-beginning 0))
107 (vanilla-text (substring i
0 end-text
))
108 ;;Get the parenthesized part.
109 (match (match-string 0 i
))
110 ;;Remove the parentheses.
111 (args (substring match
1 -
1))
115 ((arglist-x (org-split-string args
",")))
116 ;;When string starts with "," `split-string' doesn't
117 ;;make a first arg, so in that case make one
120 (string-match "^," args
)
123 (decision-arg (second arglist
))
126 ((string= decision-arg
"0")
128 ((string= decision-arg
"+")
130 ((string= decision-arg
"-")
133 (vanilla-arg (first arglist
))
136 (concat vanilla-text
"("vanilla-arg
")")
139 (list vanilla-text vanilla-mark type
)
140 (list vanilla-text vanilla-mark
)))))
142 ;;;_ . org-choose-setup-vars
143 (defun org-choose-setup-vars (bot-lower-range top-upper-range
144 static-default num-items all-mark-texts
)
145 "Add to org-choose-mark-data according to arguments"
150 ;;If there's no bot-lower-range or no default, we don't
153 (if (and static-default bot-lower-range
)
156 ;;If there's no top-upper-range, use the last
159 (or top-upper-range
(1- num-items
)))
161 (1+ (- static-default bot-lower-range
)))
163 (- top-upper-range static-default
))
165 (min upper-range-length lower-range-length
)))
168 (make-org-choose-mark-data.
170 :bot-lower-range bot-lower-range
171 :top-upper-range top-upper-range
172 :range-length range-length
173 :static-default static-default
174 :all-keywords all-mark-texts
))
176 (make-org-choose-mark-data.
181 :static-default
(or static-default
0)
182 :all-keywords all-mark-texts
)))))
184 (dolist (text all-mark-texts
)
185 (pushnew (cons text tail
)
189 (equal (car a
) (car b
)))))))
194 ;;;_ . org-choose-filter-tail
195 (defun org-choose-filter-tail (raw)
196 "Return a translation of RAW to vanilla and set appropriate
197 buffer-local variables.
199 RAW is a list of strings representing the input text of a choose
205 bot-lower-range top-upper-range range-length static-default
)
208 (vanilla-text vanilla-mark
&optional type
)
209 (org-choose-filter-one i
)
211 ((eq type
'bot-lower-range
)
212 (setq bot-lower-range index
))
213 ((eq type
'top-upper-range
)
214 (setq top-upper-range index
))
215 ((eq type
'default-mark
)
216 (setq static-default index
)))
218 (push vanilla-text all-mark-texts
)
219 (push vanilla-mark vanilla-list
)))
221 (org-choose-setup-vars bot-lower-range top-upper-range
222 static-default index
(reverse all-mark-texts
))
223 (nreverse vanilla-list
)))
225 ;;;_ . org-choose-setup-filter
227 (defun org-choose-setup-filter (raw)
228 "A setup filter for choose interpretations."
229 (when (eq (car raw
) 'choose
)
232 (org-choose-filter-tail (cdr raw
)))))
234 ;;;_ . org-choose-conform-after-promotion
235 (defun org-choose-conform-after-promotion (entry-pos keywords highest-ok-ix
)
236 "Conform the current item after another item was promoted"
239 ;;Skip the entry that triggered this by skipping any entry with
240 ;;the same starting position. plist uses the start of the
241 ;;header line as the position, but map no longer does, so we
242 ;;have to go back to the heading.
245 (org-back-to-heading)
250 (org-choose-get-entry-index keywords
)))
251 ;;If the index of the entry exceeds the highest allowable
252 ;;index, change it to that.
254 (> ix highest-ok-ix
))
256 (nth highest-ok-ix keywords
))))))
257 ;;;_ . org-choose-conform-after-demotion
258 (defun org-choose-conform-after-demotion (entry-pos keywords
261 "Conform the current item after another item was demoted."
264 ;;Skip the entry that triggered this.
267 (org-back-to-heading)
272 (org-choose-get-entry-index keywords
)))
273 ;;If the index of the entry was at or above the old allowable
274 ;;position, change it to the new mirror position if there is
279 (>= ix old-highest-ok-ix
))
281 (nth raise-to-ix keywords
))))))
283 ;;;_ , org-choose-keep-sensible (the org-trigger-hook function)
284 (defun org-choose-keep-sensible (change-plist)
285 "Bring the other items back into a sensible state after an item's
286 setting was changed."
288 ( (from (plist-get change-plist
:from
))
289 (to (plist-get change-plist
:to
))
293 (plist-get change-plist
:position
)))
295 (assoc to org-todo-kwd-alist
)))
297 (eq (nth 1 kwd-data
) 'choose
)
301 (assoc to org-choose-mark-data
))
303 (org-choose-mark-data.-all-keywords data
))
305 (org-choose-get-index-in-keywords
309 (org-choose-get-index-in-keywords
313 (org-choose-highest-other-ok
318 ;;The entry doesn't participate in conformance,
319 ;;so give `nil' which does nothing.
320 ((not highest-ok-ix
) nil
)
321 ;;The entry was created or promoted
324 (> new-index old-index
))
326 #'org-choose-conform-after-promotion
329 (t ;;Otherwise the entry was demoted.
335 (org-choose-mark-data.-static-default
338 (org-choose-highest-other-ok
343 #'org-choose-conform-after-demotion
347 old-highest-ok-ix
))))))
350 ;;The funny-looking names are to make variable capture
351 ;;unlikely. (Poor-man's lexical bindings).
352 (destructuring-bind (func-d473 . args-46k
) funcdata
355 (org-choose-get-fn-map-group))
356 ;;We may call `org-todo', so let various hooks
357 ;;`nil' so we don't cause loops.
358 org-after-todo-state-change-hook
361 org-todo-get-default-hook
362 ;;Also let this alist `nil' so we don't log
363 ;;secondary transitions.
366 (funcall map-over-entries
368 (apply func-d473 args-46k
))))))))
371 (set-marker entry-pos nil
)))
375 ;;;_ , Getting the default mark
376 ;;;_ . org-choose-get-index-in-keywords
377 (defun org-choose-get-index-in-keywords (ix all-keywords
)
378 "Return the index of the current entry."
381 (position ix all-keywords
384 ;;;_ . org-choose-get-entry-index
385 (defun org-choose-get-entry-index (all-keywords)
386 "Return index of current entry."
389 ((state (org-entry-get (point) "TODO")))
390 (org-choose-get-index-in-keywords state all-keywords
)))
392 ;;;_ . org-choose-get-fn-map-group
394 (defun org-choose-get-fn-map-group ()
395 "Return a function to map over the group"
398 (require 'org-agenda
) ;; `org-map-entries' seems to need it.
400 (unless (org-up-heading-safe)
401 (error "Choosing is only supported between siblings in a tree, not on top level"))
403 ((level (org-reduced-level (org-outline-level))))
407 (format "LEVEL=%d" level
)
410 ;;;_ . org-choose-get-highest-mark-index
412 (defun org-choose-get-highest-mark-index (keywords)
413 "Get the index of the highest current mark in the group.
414 If there is none, return 0"
418 ;;Func maps over applicable entries.
420 (org-choose-get-fn-map-group))
424 (funcall map-over-entries
426 (org-choose-get-entry-index keywords
))))))
429 (apply #'max indexes-list
)
433 ;;;_ . org-choose-highest-ok
435 (defun org-choose-highest-other-ok (ix data
)
436 "Return the highest index that any choose mark can sensibly have,
437 given that another mark has index IX.
438 DATA must be a `org-choose-mark-data.'."
443 (org-choose-mark-data.-bot-lower-range data
))
445 (org-choose-mark-data.-top-upper-range data
))
447 (org-choose-mark-data.-range-length data
)))
448 (when (and ix bot-lower-range
)
451 (- top-upper-range ix
)))
453 (< range-length delta
)
454 (+ bot-lower-range delta
))))))
456 ;;;_ . org-choose-get-default-mark-index
458 (defun org-choose-get-default-mark-index (data)
459 "Return the index of the default mark in a choose interpretation.
461 DATA must be a `org-choose-mark-data.'."
467 (org-choose-get-highest-mark-index
468 (org-choose-mark-data.-all-keywords data
))))
469 (org-choose-highest-other-ok
470 highest-mark-index data
))
471 (org-choose-mark-data.-static-default data
)))
475 ;;;_ . org-choose-get-mark-N
476 (defun org-choose-get-mark-N (n data
)
477 "Get the text of the nth mark in a choose interpretation."
480 ((l (org-choose-mark-data.-all-keywords data
)))
483 ;;;_ . org-choose-get-default-mark
485 (defun org-choose-get-default-mark (new-mark old-mark
)
486 "Get the default mark IFF in a choose interpretation.
487 NEW-MARK and OLD-MARK are the text of the new and old marks."
492 (assoc old-mark org-todo-kwd-alist
))
494 (assoc new-mark org-todo-kwd-alist
))
500 (eq (nth 1 old-kwd-data
) 'choose
)))
501 (eq (nth 1 new-kwd-data
) 'choose
))))
506 (assoc new-mark org-choose-mark-data
)))
509 (org-choose-get-mark-N
510 (org-choose-get-default-mark-index
513 (error "Somehow got an unrecognizable mark"))))))
515 ;;;_ , Setting it all up
517 (eval-after-load "org"
519 (add-to-list 'org-todo-setup-filter-hook
520 #'org-choose-setup-filter
)
521 (add-to-list 'org-todo-get-default-hook
522 #'org-choose-get-default-mark
)
523 (add-to-list 'org-trigger-hook
524 #'org-choose-keep-sensible
)
525 (add-to-list 'org-todo-interpretation-widgets
526 '(:tag
"Choose (to record decisions)" choose
)
534 (provide 'org-choose
)
536 ;;;_ * Local emacs vars.
537 ;;;_ + Local variables:
542 ;;; org-choose.el ends here