* Re: Advice sought on managing decision alternatives. [not found] <20090122112819.B30E12940C@mail1.panix.com> @ 2009-01-22 22:11 ` Tom Breton (Tehom) 0 siblings, 0 replies; 13+ messages in thread From: Tom Breton (Tehom) @ 2009-01-22 22:11 UTC (permalink / raw) To: emacs-orgmode > P.S. What is you copyright status with the FSF? I believe I'm already good to go. A few years back when I contributed some code to emacs' lread.c, RMS had me sign and send the letter that legally enabled FSF to include it. IIUC, that step only has to be done once for any code contributor. > Your add-on defines a setup function which is actually a *filter* > function. OK, sounds good. And makes it a bit easier to test. > The interaction type does very little indeed inside Org, it > only decides if a cycling command should go to the next > step (sequence) or jump to the first DONE state (type). > I think we should treat any other interaction types like > "sequence" in this respect. Here it would also distinguish chosenness from the other interpretations, but that would be entirely inside org-decisions.el. > I will then add hooks wherever you need them, they will > be called whenever a TODO keyword changes and your code > can react to it. OK. > One important precaution would be to make sure that one does > not end up in infinite loops, so maybe when the hook is called, > bind it dynamically to a nil value while you mess around with > with the status of the siblings. Maybe do the same thing with > the variables that trigger time stamp and note recording. Right. I had already planned to let the hooks to nil; I will do the same for the time stamp and note recording variables. Thanks for the advice. I will code it up and send it. Tom Breton (Tehom) ^ permalink raw reply [flat|nested] 13+ messages in thread
[parent not found: <20090101170227.C707734803@mail2.panix.com>]
* Feature request and patch - blocked TODO to say BLOCKED [not found] <20090101170227.C707734803@mail2.panix.com> @ 2009-01-01 22:53 ` Tom Breton (Tehom) 2009-01-09 8:16 ` Carsten Dominik 0 siblings, 1 reply; 13+ messages in thread From: Tom Breton (Tehom) @ 2009-01-01 22:53 UTC (permalink / raw) To: emacs-orgmode Motivating incident: I had a todo-type item that contained no tasks itself, directly, but linked to other tasks. I arranged it this way in order that those other tasks could be placed neatly in a hierarchy and not appear as "TODO" in two places. I used the org-depend.el BLOCKER code to manage this situation. BTW, it works nicely. But when a task is blocked, the heading is left with no "TODO" marking at all. That's not so bad for sibling tasks, because there's one right above it that says "TODO" (or something). But for distant-link style tasks, IMO it gives a misleading impression that there is nothing to do. I request the following: * Object: One TODO workflow keyword set that relates specially to "BLOCKER". It would be something like (sequence "BLOCKED" "|" "UNBLOCKED"). * Behavior: When a C-c C-t change to a heading is blocked, instead of doing nothing, mark the heading with the first entry in the blockage workflow keyword set. * Behavior: Also do so when there is a blocked C-c C-t change to any heading whose TODO mark is in a state in the blockage workflow keyword set. * Behavior: Ordinarily don't offer the blockage workflow keyword set for C-c C-t and related commands. I append a patch which does this. The change mostly affects org.el, because allowing new TODO keywords requires org.el to know about them, at least in computing some regular expressions. It was also a lot neater to let org-todo react to blocked transitions than to try to make `org-depend-block-todo' do it, which also avoided `org-todo' indirectly calling itself. Summary of changes Added 3 variables: * org-todo-use-blockage-keywords-p :: whether to use this * org-todo-blockage-keywords :: configurable keywords * org-blockage-keywords-1 :: internal Encapsulated part of `org-set-regexps-and-options' as `org-set-todo-constants'. I had to because it needed to be called twice, once for normal keywords and once with a flag for blockage keywords. I used encap-sexp to do it automatically (it's on my site, http://panix.com/~tehom/my-code/), so no code changed, and I kept that comment aligned with the regexp. Made `org-set-regexps-and-options' also process `org-todo-blockage-keywords'. Changed the behavior of org-todo and org-depend-block-todo as described above. Tom Breton (Tehom) *** org-depend.el 2008-12-18 18:26:05.000000000 -0500 --- new-org-depend.el 2009-01-01 17:13:13.000000000 -0500 *************** *** 196,204 **** (unless (eq type 'todo-state-change) ;; We are not handling this kind of change (throw 'return t)) ! (unless (and (not from) (member to org-not-done-keywords)) ! ;; This is not a change from nothing to TODO, ignore it ! (throw 'return t)) ;; OK, the plan is to switch from nothing to TODO ;; Lets see if we will allow it. Find the BLOCKER property --- 196,210 ---- (unless (eq type 'todo-state-change) ;; We are not handling this kind of change (throw 'return t)) ! ;;Act on only the right types of TODO-change: ! (unless ! (or ! ;;A change from a member of the blockage set ! (member from org-todo-blockage-keywords) ! ;;A change from nothing to TODO ! (and (not from) (member to org-not-done-keywords))) ! ;; Otherwise ignore it ! (throw 'return t)) ;; OK, the plan is to switch from nothing to TODO ;; Lets see if we will allow it. Find the BLOCKER property *** old-org.el 2008-12-18 18:26:05.000000000 -0500 --- org.el 2009-01-01 17:25:32.000000000 -0500 *************** *** 1458,1464 **** (const :tag "Type (cycling directly to DONE)" type)) (repeat (string :tag "Keyword")))))) - (defvar org-todo-keywords-1 nil "All TODO and DONE keywords active in a buffer.") (make-variable-buffer-local 'org-todo-keywords-1) --- 1458,1463 ---- *************** *** 1483,1488 **** --- 1482,1494 ---- (make-variable-buffer-local 'org-todo-key-alist) (defvar org-todo-key-trigger nil) (make-variable-buffer-local 'org-todo-key-trigger) + (defvar org-todo-use-blockage-keywords-p t) + (defvar org-todo-blockage-keywords + '(sequence "BLOCKED" "|" "UNBLOCKED") + "Keywords of the blocking workflow keyword set." ) + (defvar org-blockage-keywords-1 nil + "All blockage keywords active in a buffer" ) + (make-variable-buffer-local 'org-blockage-keywords-1) (defcustom org-todo-interpretation 'sequence "Controls how TODO keywords are interpreted. *************** *** 2997,3002 **** --- 3003,3079 ---- set this variable to if the option is found. An optional forth element PUSH means to push this value onto the list in the variable.") + (defun org-set-todo-constants (kwds block) + "" + (let + (inter kws kw) + (while + (setq kws (pop kwds)) + (setq + inter (pop kws) + sep (member "|" kws) + kws0 (delete "|" + (copy-sequence kws)) + kwsa nil + kws1 + (mapcar + (lambda + (x) + (if + ;; 1 2 + (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) + (progn + (setq kw + (match-string 1 x) + key + (and + (match-end 2) + (match-string 2 x)) + log + (org-extract-log-state-settings x)) + (push + (cons kw + (and key + (string-to-char key))) + kwsa) + (and log + (push log org-todo-log-states)) + kw) + (error "Invalid TODO keyword %s" x))) + kws0) + kwsa + (if kwsa + (append + '((:startgroup)) + (nreverse kwsa) + '((:endgroup)))) + hw (car kws1) + dws (if sep + (org-remove-keyword-keys + (cdr sep)) + (last kws1)) + tail (list inter hw + (car dws) + (org-last dws))) + (add-to-list 'org-todo-heads hw 'append) + (push kws1 org-todo-sets) + (setq org-done-keywords + (append org-done-keywords dws nil)) + (setq org-todo-key-alist + (append org-todo-key-alist kwsa)) + (mapc + (lambda + (x) + (push + (cons x tail) + org-todo-kwd-alist)) + kws1) + (if block + (setq org-blockage-keywords-1 + (append org-blockage-keywords-1 kws1 nil))) + (setq org-todo-keywords-1 + (append org-todo-keywords-1 kws1 nil))))) + (defun org-set-regexps-and-options () "Precompute regular expressions for current buffer." (when (org-mode-p) *************** *** 3116,3156 **** (setq kwds (list (cons org-todo-interpretation (default-value 'org-todo-keywords))))) (setq kwds (reverse kwds))) ! (setq kwds (nreverse kwds)) ! (let (inter kws kw) ! (while (setq kws (pop kwds)) ! (setq inter (pop kws) sep (member "|" kws) ! kws0 (delete "|" (copy-sequence kws)) ! kwsa nil ! kws1 (mapcar ! (lambda (x) ! ;; 1 2 ! (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) ! (progn ! (setq kw (match-string 1 x) ! key (and (match-end 2) (match-string 2 x)) ! log (org-extract-log-state-settings x)) ! (push (cons kw (and key (string-to-char key))) kwsa) ! (and log (push log org-todo-log-states)) ! kw) ! (error "Invalid TODO keyword %s" x))) ! kws0) ! kwsa (if kwsa (append '((:startgroup)) ! (nreverse kwsa) ! '((:endgroup)))) ! hw (car kws1) ! dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) ! tail (list inter hw (car dws) (org-last dws))) ! (add-to-list 'org-todo-heads hw 'append) ! (push kws1 org-todo-sets) ! (setq org-done-keywords (append org-done-keywords dws nil)) ! (setq org-todo-key-alist (append org-todo-key-alist kwsa)) ! (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) ! (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) ! (setq org-todo-sets (nreverse org-todo-sets) ! org-todo-kwd-alist (nreverse org-todo-kwd-alist) ! org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist)) ! org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))) ;; Process the constants (when const (let (e cst) --- 3193,3209 ---- (setq kwds (list (cons org-todo-interpretation (default-value 'org-todo-keywords))))) (setq kwds (reverse kwds))) ! ;;(setq kwds (append (nreverse kwds) (list org-todo-blockage-keywords))) ! (org-set-todo-constants (nreverse kwds) nil) ! (when org-todo-use-blockage-keywords-p ! (org-set-todo-constants (list org-todo-blockage-keywords) t)) ! (setq ! org-todo-sets (nreverse org-todo-sets) ! org-todo-kwd-alist (nreverse org-todo-kwd-alist) ! org-todo-key-trigger (delq nil ! (mapcar 'cdr org-todo-key-alist)) ! org-todo-key-alist (org-assign-fast-keys org-todo-key-alist)) ! ;; Process the constants (when const (let (e cst) *************** *** 8222,8232 **** (save-match-data (run-hook-with-args-until-failure 'org-blocker-hook change-plist))) ! (if (interactive-p) ! (error "TODO state change from %s to %s blocked" this state) ! ;; fail silently ! (message "TODO state change from %s to %s blocked" this state) ! (throw 'exit nil)))) (store-match-data match-data) (replace-match next t t) (unless (pos-visible-in-window-p hl-pos) --- 8275,8294 ---- (save-match-data (run-hook-with-args-until-failure 'org-blocker-hook change-plist))) ! (if ! org-todo-use-blockage-keywords-p ! (let ! ((blocked-state (car org-blockage-keywords-1))) ! (setq arg 'none) ! (setq next (concat " " blocked-state " ")) ! (unless ! (string= state blocked-state) ! (message "TODO state change from %s to %s blocked" this state))) ! (if (interactive-p) ! (error "TODO state change from %s to %s blocked" this state) ! ;; fail silently ! (message "TODO state change from %s to %s blocked" this state) ! (throw 'exit nil))))) (store-match-data match-data) (replace-match next t t) (unless (pos-visible-in-window-p hl-pos) ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Feature request and patch - blocked TODO to say BLOCKED 2009-01-01 22:53 ` Feature request and patch - blocked TODO to say BLOCKED Tom Breton (Tehom) @ 2009-01-09 8:16 ` Carsten Dominik 2009-01-19 3:33 ` Advice sought on managing decision alternatives Tom Breton (Tehom) 0 siblings, 1 reply; 13+ messages in thread From: Carsten Dominik @ 2009-01-09 8:16 UTC (permalink / raw) To: Tom Breton (Tehom); +Cc: emacs-orgmode Hi Tom, I am hesitant to apply this relatively complex patch which I have not had the time to study closely enough. I am wondering: Instead of setting a TODO keyword, would it not be simpler and equally effective to set a special tag when an entry is blocked? You could use a bright font to mark this tag, in order to make it obvious. And you could use a custom query to look for blocked items, to see what can be done about them.... - Carsten On Jan 1, 2009, at 11:53 PM, Tom Breton (Tehom) wrote: > > Motivating incident: I had a todo-type item that contained no tasks > itself, directly, but linked to other tasks. I arranged it this way > in order that those other tasks could be placed neatly in a hierarchy > and not appear as "TODO" in two places. I used the org-depend.el > BLOCKER code to manage this situation. BTW, it works nicely. > > But when a task is blocked, the heading is left with no "TODO" marking > at all. That's not so bad for sibling tasks, because there's one > right above it that says "TODO" (or something). But for distant-link > style tasks, IMO it gives a misleading impression that there is > nothing to do. > > I request the following: > > * Object: One TODO workflow keyword set that relates specially to > "BLOCKER". It would be something like (sequence "BLOCKED" "|" > "UNBLOCKED"). > * Behavior: When a C-c C-t change to a heading is blocked, instead of > doing nothing, mark the heading with the first entry in the > blockage workflow keyword set. > * Behavior: Also do so when there is a blocked C-c C-t change to any > heading whose TODO mark is in a state in the blockage workflow > keyword set. > * Behavior: Ordinarily don't offer the blockage workflow keyword set > for C-c C-t and related commands. > > I append a patch which does this. > > The change mostly affects org.el, because allowing new TODO keywords > requires org.el to know about them, at least in computing some regular > expressions. It was also a lot neater to let org-todo react to > blocked transitions than to try to make `org-depend-block-todo' do it, > which also avoided `org-todo' indirectly calling itself. > > Summary of changes > > Added 3 variables: > * org-todo-use-blockage-keywords-p :: whether to use this > * org-todo-blockage-keywords :: configurable keywords > * org-blockage-keywords-1 :: internal > > Encapsulated part of `org-set-regexps-and-options' as > `org-set-todo-constants'. I had to because it needed to be called > twice, once for normal keywords and once with a flag for blockage > keywords. I used encap-sexp to do it automatically (it's on my site, > http://panix.com/~tehom/my-code/), so no code changed, and I kept that > comment aligned with the regexp. > > Made `org-set-regexps-and-options' also process > `org-todo-blockage-keywords'. > > Changed the behavior of org-todo and org-depend-block-todo as > described > above. > > Tom Breton (Tehom) > > *** org-depend.el 2008-12-18 18:26:05.000000000 -0500 > --- new-org-depend.el 2009-01-01 17:13:13.000000000 -0500 > *************** > *** 196,204 **** > (unless (eq type 'todo-state-change) > ;; We are not handling this kind of change > (throw 'return t)) > ! (unless (and (not from) (member to org-not-done-keywords)) > ! ;; This is not a change from nothing to TODO, ignore it > ! (throw 'return t)) > > ;; OK, the plan is to switch from nothing to TODO > ;; Lets see if we will allow it. Find the BLOCKER property > --- 196,210 ---- > (unless (eq type 'todo-state-change) > ;; We are not handling this kind of change > (throw 'return t)) > ! ;;Act on only the right types of TODO-change: > ! (unless > ! (or > ! ;;A change from a member of the blockage set > ! (member from org-todo-blockage-keywords) > ! ;;A change from nothing to TODO > ! (and (not from) (member to org-not-done-keywords))) > ! ;; Otherwise ignore it > ! (throw 'return t)) > > ;; OK, the plan is to switch from nothing to TODO > ;; Lets see if we will allow it. Find the BLOCKER property > *** old-org.el 2008-12-18 18:26:05.000000000 -0500 > --- org.el 2009-01-01 17:25:32.000000000 -0500 > *************** > *** 1458,1464 **** > (const :tag "Type (cycling directly to DONE)" type)) > (repeat > (string :tag "Keyword")))))) > - > (defvar org-todo-keywords-1 nil > "All TODO and DONE keywords active in a buffer.") > (make-variable-buffer-local 'org-todo-keywords-1) > --- 1458,1463 ---- > *************** > *** 1483,1488 **** > --- 1482,1494 ---- > (make-variable-buffer-local 'org-todo-key-alist) > (defvar org-todo-key-trigger nil) > (make-variable-buffer-local 'org-todo-key-trigger) > + (defvar org-todo-use-blockage-keywords-p t) > + (defvar org-todo-blockage-keywords > + '(sequence "BLOCKED" "|" "UNBLOCKED") > + "Keywords of the blocking workflow keyword set." ) > + (defvar org-blockage-keywords-1 nil > + "All blockage keywords active in a buffer" ) > + (make-variable-buffer-local 'org-blockage-keywords-1) > > (defcustom org-todo-interpretation 'sequence > "Controls how TODO keywords are interpreted. > *************** > *** 2997,3002 **** > --- 3003,3079 ---- > set this variable to if the option is found. An optional forth > element > PUSH > means to push this value onto the list in the variable.") > > + (defun org-set-todo-constants (kwds block) > + "" > + (let > + (inter kws kw) > + (while > + (setq kws (pop kwds)) > + (setq > + inter (pop kws) > + sep (member "|" kws) > + kws0 (delete "|" > + (copy-sequence kws)) > + kwsa nil > + kws1 > + (mapcar > + (lambda > + (x) > + (if > + ;; 1 2 > + (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) > + (progn > + (setq kw > + (match-string 1 x) > + key > + (and > + (match-end 2) > + (match-string 2 x)) > + log > + (org-extract-log-state-settings x)) > + (push > + (cons kw > + (and key > + (string-to-char key))) > + kwsa) > + (and log > + (push log org-todo-log-states)) > + kw) > + (error "Invalid TODO keyword %s" x))) > + kws0) > + kwsa > + (if kwsa > + (append > + '((:startgroup)) > + (nreverse kwsa) > + '((:endgroup)))) > + hw (car kws1) > + dws (if sep > + (org-remove-keyword-keys > + (cdr sep)) > + (last kws1)) > + tail (list inter hw > + (car dws) > + (org-last dws))) > + (add-to-list 'org-todo-heads hw 'append) > + (push kws1 org-todo-sets) > + (setq org-done-keywords > + (append org-done-keywords dws nil)) > + (setq org-todo-key-alist > + (append org-todo-key-alist kwsa)) > + (mapc > + (lambda > + (x) > + (push > + (cons x tail) > + org-todo-kwd-alist)) > + kws1) > + (if block > + (setq org-blockage-keywords-1 > + (append org-blockage-keywords-1 kws1 nil))) > + (setq org-todo-keywords-1 > + (append org-todo-keywords-1 kws1 nil))))) > + > (defun org-set-regexps-and-options () > "Precompute regular expressions for current buffer." > (when (org-mode-p) > *************** > *** 3116,3156 **** > (setq kwds (list (cons org-todo-interpretation > (default-value 'org-todo-keywords))))) > (setq kwds (reverse kwds))) > ! (setq kwds (nreverse kwds)) > ! (let (inter kws kw) > ! (while (setq kws (pop kwds)) > ! (setq inter (pop kws) sep (member "|" kws) > ! kws0 (delete "|" (copy-sequence kws)) > ! kwsa nil > ! kws1 (mapcar > ! (lambda (x) > ! ;; 1 2 > ! (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) > ! (progn > ! (setq kw (match-string 1 x) > ! key (and (match-end 2) (match-string 2 x)) > ! log (org-extract-log-state-settings x)) > ! (push (cons kw (and key (string-to-char key))) kwsa) > ! (and log (push log org-todo-log-states)) > ! kw) > ! (error "Invalid TODO keyword %s" x))) > ! kws0) > ! kwsa (if kwsa (append '((:startgroup)) > ! (nreverse kwsa) > ! '((:endgroup)))) > ! hw (car kws1) > ! dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) > ! tail (list inter hw (car dws) (org-last dws))) > ! (add-to-list 'org-todo-heads hw 'append) > ! (push kws1 org-todo-sets) > ! (setq org-done-keywords (append org-done-keywords dws nil)) > ! (setq org-todo-key-alist (append org-todo-key-alist kwsa)) > ! (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) > ! (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) > ! (setq org-todo-sets (nreverse org-todo-sets) > ! org-todo-kwd-alist (nreverse org-todo-kwd-alist) > ! org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key- > alist)) > ! org-todo-key-alist (org-assign-fast-keys org-todo-key- > alist))) > ;; Process the constants > (when const > (let (e cst) > --- 3193,3209 ---- > (setq kwds (list (cons org-todo-interpretation > (default-value 'org-todo-keywords))))) > (setq kwds (reverse kwds))) > ! ;;(setq kwds (append (nreverse kwds) (list > org-todo-blockage-keywords))) > ! (org-set-todo-constants (nreverse kwds) nil) > ! (when org-todo-use-blockage-keywords-p > ! (org-set-todo-constants (list org-todo-blockage-keywords) t)) > ! (setq > ! org-todo-sets (nreverse org-todo-sets) > ! org-todo-kwd-alist (nreverse org-todo-kwd-alist) > ! org-todo-key-trigger (delq nil > ! (mapcar 'cdr org-todo-key-alist)) > ! org-todo-key-alist (org-assign-fast-keys org-todo-key-alist)) > ! > ;; Process the constants > (when const > (let (e cst) > *************** > *** 8222,8232 **** > (save-match-data > (run-hook-with-args-until-failure > 'org-blocker-hook change-plist))) > ! (if (interactive-p) > ! (error "TODO state change from %s to %s blocked" this state) > ! ;; fail silently > ! (message "TODO state change from %s to %s blocked" this > state) > ! (throw 'exit nil)))) > (store-match-data match-data) > (replace-match next t t) > (unless (pos-visible-in-window-p hl-pos) > --- 8275,8294 ---- > (save-match-data > (run-hook-with-args-until-failure > 'org-blocker-hook change-plist))) > ! (if > ! org-todo-use-blockage-keywords-p > ! (let > ! ((blocked-state (car org-blockage-keywords-1))) > ! (setq arg 'none) > ! (setq next (concat " " blocked-state " ")) > ! (unless > ! (string= state blocked-state) > ! (message "TODO state change from %s to %s blocked" this > state))) > ! (if (interactive-p) > ! (error "TODO state change from %s to %s blocked" this state) > ! ;; fail silently > ! (message "TODO state change from %s to %s blocked" this state) > ! (throw 'exit nil))))) > (store-match-data match-data) > (replace-match next t t) > (unless (pos-visible-in-window-p hl-pos) > > > > > _______________________________________________ > Emacs-orgmode mailing list > Remember: use `Reply All' to send replies to the list. > Emacs-orgmode@gnu.org > http://lists.gnu.org/mailman/listinfo/emacs-orgmode ^ permalink raw reply [flat|nested] 13+ messages in thread
* Advice sought on managing decision alternatives. 2009-01-09 8:16 ` Carsten Dominik @ 2009-01-19 3:33 ` Tom Breton (Tehom) 2009-01-22 11:15 ` Carsten Dominik 0 siblings, 1 reply; 13+ messages in thread From: Tom Breton (Tehom) @ 2009-01-19 3:33 UTC (permalink / raw) To: Carsten Dominik; +Cc: emacs-orgmode On my last two requests, Carsten had better ideas and my proposal really benefitted from them. So I'm asking for advice on the design. ****** Rationale When I make a decision, in org-mode, I write down the set of reasonable alternatives that I see, each one as an item. Then I make notes about each one and then choose. Often the process is messy. I sometimes: * add a new alternative later * realize an alternative is fatally flawed and permanently reject it. * choose one but come to regret it. Then I need to unchoose it and then choose another. * Realize that what I thought was an alternative is really a distinct yes/no choice. * Add a related yes/no choice to the group - I could make a new subtree for each new related choice, but usually once I find one related choice, I soon find many, so that's a lot of restructuring for little benefit. ****** The overall idea: So I want a way of keeping track of alternatives and their state of decision. Where possible, I'd like this to automatically stay in a sensible state. Eg, if one alternative is chosen, no other is. ****** A detailed example ******* Item markings For example, each item could be marked from this set of markings: * CHOSEN * Invariant :: The other items are marked NOT CHOSEN or lower * Reaction :: If another item becomes CHOSEN, this item becomes NOT CHOSEN * Reaction :: If another item becomes LEANING TOWARDS, this item becomes MAYBE. * LEANING TOWARDS * Invariant :: The other items are marked MAYBE or lower. * Reaction :: If another item becomes LEANING TOWARDS, this item becomes MAYBE. * MAYBE * The default marking. New items in the group get this marking unless some item is marked CHOSEN, in which case new items get NOT CHOSEN. * Reaction :: If another item becomes CHOSEN, MAYBE becomes NOT CHOSEN. * NOT CHOSEN * Reaction :: If it becomes the case that no item is CHOSEN, NOT CHOSEN items become MAYBE. * If marks are to be changed by moving up and down this "scale", an item could become "NOT CHOSEN" in the course of becoming "REJECTED". This requirement keeps me from adding an invariant that if any item is NOT CHOSEN, exactly one item should be CHOSEN. * REJECTED * Remains marked REJECTED regardless what happens to other items. Notice the symmetry in the constraints: | If any | | then the other | | | item is: | | items can't be | | | | | higher than: | | |----------+---+----------------+---| | CHOSEN | 1 | NOT CHOSEN | 4 | | FAVORED | 2 | MAYBE | 3 | |----------+---+----------------+---| So there are 2 ranges of marks relating to each other in mirror image fashion. If some item is marked in the "CHOSEN" range, other items can't be marked higher than the mirror-corresponding entry in the "NOT CHOSEN" range. I believe that will keep the items collectively in a sensible state. ******* Item grouping A group of items represent alternatives in a decision just if: * they are siblings * they all have a mark from that set. There's plenty of room to expand to other means of grouping items. ****** The plan My tentative plan is this: * Use the TODO position to carry chosenness information * Is that a bad idea? Is there ever a case when an item should be both an alternative in a choice and a normal TODO item? * Re-use the usual TODO manipulation commands to manipulate these marks. * Add a new class of TODO-like mark interpretation * This interpretation is "chosenness" instead of "type" or "sequence". * The spec for it can indicate * The mark that is given to new items by default * The upper range (as above) * The lower range (as above) * Indications * "0" indicates the default mark * "-" indicates the lowest automatically managed mark. * If a low auto mark is not present, no automatic handling is wanted. * "+" indicates the counterpart of the low auto mark, to help indicate the upper range. * Defaults to the last item. * How these marks indicate ranges * the lower range is from the low auto mark to the default mark, inclusive * the upper range is from the mark above the default mark to the high auto mark, inclusive. * EXCEPT that the ranges must be the same length, so truncate the longer one. Truncate it at the default end of it. * If there's no low auto mark, there are no ranges and no automatic handling. * Examples: * (chosenness "REJECTED" "-" "NOT_CHOSEN" "0" "MAYBE" "LEANING_TOWARDS" "+" "CHOSEN") * (chosenness "NO" "0" "MAYBE" "YES") * Set up the regular expressions etc to accept these marks in TODO position. Same thing org-set-regexps-and-options does now, except: * Accept chosenness too. * Don't place chosenness marks in org-done-keywords and org-not-done-keywords * Place chosenness ranges in appropriate buffer-local variables. * In order to keep the marks consistent (as described above), use org-trigger-hook. When some item becomes marked with a mark in the upper range, demote the other items to the mark that occupies the mirror position in the lower range. * Eg, using the first example of marks, when an item is made CHOSEN, demote its siblings to NOT_CHOSEN. * Eg, using the first example of marks, when an item is made LEANING_TOWARDS, demote its siblings to MAYBE. * In order to find the correct default for such an item, add another hook. * It is called just if a default mark is wanted * It (each function on it) returns `nil' or a string. * For chosenness, it acts when * the old mark is `nil' or is from another TODO keyword set * A chosenness keyword set is to be used. ****** Impact on code * Most of this would go in a contrib module to hold the changes. * Name it "org-decisions.el" * This would define and manage the range variables described above. * When it loaded, it would add appropriately to the new variables below. * In org.el * Affecting customizations: * The org-todo-keywords customize would add an interpretation "chosenness" as alternative to "type" and "sequence". * Affecting org-todo * I'd add a hook. * Name it org-todo-get-default-hook * That hook would be called to find a default item. * Affecting org-set-regexps-and-options: * I'd add an alist that associates type to a handler that sets up the various todo variables. * Name it org-set-todo-handlers-alist. * org-set-regexps-and-options would use that list to find a handler where now it processes "type" and "sequence". * The "type" and "sequence" handlers would be the same code that is used now in `org-set-regexps-and-options', excerpted. * Alternatively, I could leave "type" and "sequence" handling where it is as special cases. ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Advice sought on managing decision alternatives. 2009-01-19 3:33 ` Advice sought on managing decision alternatives Tom Breton (Tehom) @ 2009-01-22 11:15 ` Carsten Dominik 2009-01-31 4:21 ` Tom Breton (Tehom) 0 siblings, 1 reply; 13+ messages in thread From: Carsten Dominik @ 2009-01-22 11:15 UTC (permalink / raw) To: Tom Breton (Tehom); +Cc: emacs-orgmode Hi Tom, I went through your draft and I think this is interesting functionality which would be really nice to have. I also see that you have thought carefully on how to implement it and minimize impact on the core code, which I appreciate. I would be happy to to make/accept the following changes to org.el: In addition to SEQ_TODO and TYP_TODO, I could look for similar words. We could even do this in a general way, looking for #+XYZFOOBAR_TODO: and making this call a special function org-todo-setup-xyzfoobar, which could then be defined in add-on packages. As you want to re-use the internal functions Org uses to change states, I would like to change this code as little as possible, even going beyond what you already proposed: My proposal would be: Your add-on defines a setup function which is actually a *filter* function. It gets passed the list of words resulting from parsing the "#+CHOOSE_TODO:" line, or equivalently such a list found in org-todo-keywords. For example: #+CHOOSE_TODO: REJECTED - NOT_CHOSEN 0 MAYBE LEANING_TOWARDS + CHOSEN or #+CHOOSE_TODO: REJECTED(r){-} NOT_CHOSEN(n){0} MAYBE(m) LEANING_TOWARDS(l){+} CHOSEN(c) The format would be entirely up to you, as long as you do the following: The filter function must return a list as it is *normally* expected for TODO keywords, with flags for fast selection and note taking, maybe a "|" entry to separate "DONE" entries from the rest, but any other special stuff of your interface removed, for example: (choseness "REJECTED(r)" "NOT_CHOSEN(n)" "MAYBE(m)" "LEANING_TOWARDS(l)" "|" CHOSEN(c)) Org will then process this return list appropriately, set up keys for fast selection, arranges for notes and time stamps to be recorded etc. The interaction type does very little indeed inside Org, it only decides if a cycling command should go to the next step (sequence) or jump to the first DONE state (type). I think we should treat any other interaction types like "sequence" in this respect. This would be all as far as Org is concerned. No need to change any code at all. I will then add hooks wherever you need them, they will be called whenever a TODO keyword changes and your code can react to it. One important precaution would be to make sure that one does not end up in infinite loops, so maybe when the hook is called, bind it dynamically to a nil value while you mess around with with the status of the siblings. Maybe do the same thing with the variables that trigger time stamp and note recording. What do you think? - Carsten P.S. What is you copyright status with the FSF? On Jan 19, 2009, at 4:33 AM, Tom Breton (Tehom) wrote: > On my last two requests, Carsten had better ideas and my proposal > really benefitted from them. So I'm asking for advice on the design. > > ****** Rationale > > When I make a decision, in org-mode, I write down the set of > reasonable alternatives that I see, each one as an item. Then I make > notes about each one and then choose. > > Often the process is messy. I sometimes: > > * add a new alternative later > * realize an alternative is fatally flawed and permanently reject it. > * choose one but come to regret it. Then I need to unchoose it and > then choose another. > * Realize that what I thought was an alternative is really a distinct > yes/no choice. > * Add a related yes/no choice to the group - I could make a new > subtree for each new related choice, but usually once I find one > related choice, I soon find many, so that's a lot of restructuring > for little benefit. > > ****** The overall idea: > > So I want a way of keeping track of alternatives and their state of > decision. Where possible, I'd like this to automatically stay in a > sensible state. Eg, if one alternative is chosen, no other is. > > ****** A detailed example > > ******* Item markings > > For example, each item could be marked from this set of markings: > > * CHOSEN > * Invariant :: The other items are marked NOT CHOSEN or lower > * Reaction :: If another item becomes CHOSEN, this item becomes NOT > CHOSEN > * Reaction :: If another item becomes LEANING TOWARDS, this item > becomes MAYBE. > > * LEANING TOWARDS > * Invariant :: The other items are marked MAYBE or lower. > * Reaction :: If another item becomes LEANING TOWARDS, this item > becomes MAYBE. > * MAYBE > * The default marking. New items in the group get this marking > unless some item is marked CHOSEN, in which case new items get > NOT CHOSEN. > * Reaction :: If another item becomes CHOSEN, MAYBE becomes NOT > CHOSEN. > * NOT CHOSEN > * Reaction :: If it becomes the case that no item is CHOSEN, NOT > CHOSEN items become MAYBE. > * If marks are to be changed by moving up and down this "scale", an > item could become "NOT CHOSEN" in the course of becoming > "REJECTED". This requirement keeps me from adding an invariant > that if any item is NOT CHOSEN, exactly one item should be > CHOSEN. > > * REJECTED > * Remains marked REJECTED regardless what happens to other items. > > > Notice the symmetry in the constraints: > > | If any | | then the other | | > | item is: | | items can't be | | > | | | higher than: | | > |----------+---+----------------+---| > | CHOSEN | 1 | NOT CHOSEN | 4 | > | FAVORED | 2 | MAYBE | 3 | > |----------+---+----------------+---| > > So there are 2 ranges of marks relating to each other in mirror image > fashion. If some item is marked in the "CHOSEN" range, other items > can't be marked higher than the mirror-corresponding entry in the "NOT > CHOSEN" range. I believe that will keep the items collectively in a > sensible state. > > ******* Item grouping > > A group of items represent alternatives in a decision just if: > > * they are siblings > * they all have a mark from that set. > > There's plenty of room to expand to other means of grouping items. > > ****** The plan > > My tentative plan is this: > > * Use the TODO position to carry chosenness information > * Is that a bad idea? Is there ever a case when an item should be > both an alternative in a choice and a normal TODO item? > * Re-use the usual TODO manipulation commands to manipulate these > marks. > * Add a new class of TODO-like mark interpretation > * This interpretation is "chosenness" instead of "type" or > "sequence". > * The spec for it can indicate > * The mark that is given to new items by default > * The upper range (as above) > * The lower range (as above) > * Indications > * "0" indicates the default mark > * "-" indicates the lowest automatically managed mark. > * If a low auto mark is not present, no automatic handling is > wanted. > * "+" indicates the counterpart of the low auto mark, to help > indicate the upper range. > * Defaults to the last item. > * How these marks indicate ranges > * the lower range is from the low auto mark to the default mark, > inclusive > * the upper range is from the mark above the default mark to the > high auto mark, inclusive. > * EXCEPT that the ranges must be the same length, so truncate the > longer one. Truncate it at the default end of it. > * If there's no low auto mark, there are no ranges and no > automatic > handling. > * Examples: > * (chosenness "REJECTED" "-" "NOT_CHOSEN" "0" "MAYBE" > "LEANING_TOWARDS" "+" "CHOSEN") > * (chosenness "NO" "0" "MAYBE" "YES") > * Set up the regular expressions etc to accept these marks in TODO > position. Same thing org-set-regexps-and-options does now, except: > * Accept chosenness too. > * Don't place chosenness marks in org-done-keywords and > org-not-done-keywords > * Place chosenness ranges in appropriate buffer-local variables. > * In order to keep the marks consistent (as described above), use > org-trigger-hook. When some item becomes marked with a mark in the > upper range, demote the other items to the mark that occupies the > mirror position in the lower range. > * Eg, using the first example of marks, when an item is made > CHOSEN, demote its siblings to NOT_CHOSEN. > * Eg, using the first example of marks, when an item is made > LEANING_TOWARDS, demote its siblings to MAYBE. > * In order to find the correct default for such an item, add another > hook. > * It is called just if a default mark is wanted > * It (each function on it) returns `nil' or a string. > * For chosenness, it acts when > * the old mark is `nil' or is from another TODO keyword set > * A chosenness keyword set is to be used. > > > ****** Impact on code > > * Most of this would go in a contrib module to hold the changes. > * Name it "org-decisions.el" > * This would define and manage the range variables described above. > * When it loaded, it would add appropriately to the new variables > below. > * In org.el > * Affecting customizations: > * The org-todo-keywords customize would add an interpretation > "chosenness" as alternative to "type" and "sequence". > * Affecting org-todo > * I'd add a hook. > * Name it org-todo-get-default-hook > * That hook would be called to find a default item. > * Affecting org-set-regexps-and-options: > * I'd add an alist that associates type to a handler that sets up > the various todo variables. > * Name it org-set-todo-handlers-alist. > * org-set-regexps-and-options would use that list to find a > handler where now it processes "type" and "sequence". > * The "type" and "sequence" handlers would be the same code that > is used now in `org-set-regexps-and-options', excerpted. > * Alternatively, I could leave "type" and "sequence" handling > where it is as special cases. > > > ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Advice sought on managing decision alternatives. 2009-01-22 11:15 ` Carsten Dominik @ 2009-01-31 4:21 ` Tom Breton (Tehom) 2009-01-31 5:41 ` Carsten Dominik 2009-02-06 13:08 ` Carsten Dominik 0 siblings, 2 replies; 13+ messages in thread From: Tom Breton (Tehom) @ 2009-01-31 4:21 UTC (permalink / raw) Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 947 bytes --] Here is org-decisions. "All 68 tests ran successfully". I hope it is satisfactory. If it's not, please let me know. Please find attached: * org-decisions.el * diffs to org.el * test-org-decisions.el. * 6 example files in testing A few notes: ****** Test files I included 6 example files that I used in testing, and my test file test-org-decisions.el. test-org-decisions.el uses my tester rtest, which is unfortunately in flux at the moment. Still, I felt it would be best to make it publicly available. ****** Use of cl I used cl in org-decisions.el. I hope that's not a problem, but if it is I can rewrite the parts that use cl. * pushnew * position * destructuring-bind * defstruct ****** Use of allout org-decisions.el and test-org-decisions.el use allout for structuring. I removed the "mode: allout" line so that they can be read without allout present. Tom Breton (Tehom) [-- Attachment #2: org-decisions.el --] [-- Type: application/octet-stream, Size: 12642 bytes --] ;;;_ org-decisions.el --- decision management for org-mode ;;;_. Headers ;;;_ , License ;; Copyright (C) 2009 Tom Breton (Tehom) ;; Author: Tom Breton (Tehom) ;; Keywords: ;; 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 2, or (at your option) ;; any later version. ;; This file 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., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;;_ , Commentary: ;; ;;;_ , Requires (require 'org) (eval-when-compile (require 'cl)) ;;;_. Body ;;;_ , The variables (defstruct (org-decisions-mark-data. (:type list)) "The format of an entry in org-decisions-mark-data. Indexes are 0-based or `nil'. " keyword bot-lower-range top-upper-range range-length static-default all-keywords) (defvar org-decisions-mark-data () "Alist of information for chosenness marks. Each entry is an `org-decisions-mark-data.'" ) (make-variable-buffer-local 'org-decisions-mark-data) ;;;_ , For setup ;;;_ . org-decisions-filter-one (defun org-decisions-filter-one (i) "Return a list of * a canonized version of the string * optionally one symbol" (if (not (string-match "(.*)" i)) (list i i) (let* ( (end-text (match-beginning 0)) (vanilla-text (substring i 0 end-text)) ;;Get the parenthesized part. (match (match-string 0 i)) ;;Remove the parentheses. (args (substring match 1 -1)) ;;Split it (arglist (let ((arglist-x (split-string args ","))) ;;When string starts with "," `split-string' doesn't ;;make a first arg, so in that case make one ;;manually. (if (string-match "^," args) (cons nil arglist-x) arglist-x))) (decision-arg (second arglist)) (type (cond ((string= decision-arg "0") 'default-mark) ((string= decision-arg "+") 'top-upper-range) ((string= decision-arg "-") 'bot-lower-range) (t nil))) (vanilla-arg (first arglist)) (vanilla-mark (if vanilla-arg (concat vanilla-text "("vanilla-arg")") vanilla-text))) (if type (list vanilla-text vanilla-mark type) (list vanilla-text vanilla-mark))))) ;;;_ . org-decisions-setup-vars (defun org-decisions-setup-vars (bot-lower-range top-upper-range static-default num-items all-mark-texts) "Add to org-decisions-mark-data according to arguments" (let* ( (tail ;;If there's no bot-lower-range or no default, we don't ;;have ranges. (cdr (if (and static-default bot-lower-range) (let* ( ;;If there's no top-upper-range, use the last ;;item. (top-upper-range (or top-upper-range (1- num-items))) (lower-range-length (1+ (- static-default bot-lower-range))) (upper-range-length (- top-upper-range static-default)) (range-length (min upper-range-length lower-range-length))) (make-org-decisions-mark-data. :keyword nil :bot-lower-range bot-lower-range :top-upper-range top-upper-range :range-length range-length :static-default static-default :all-keywords all-mark-texts)) (make-org-decisions-mark-data. :keyword nil :bot-lower-range nil :top-upper-range nil :range-length nil :static-default (or static-default 0) :all-keywords all-mark-texts))))) (dolist (text all-mark-texts) (pushnew (cons text tail) org-decisions-mark-data :test #'(lambda (a b) (equal (car a) (car b))))))) ;;;_ . org-decisions-filter-tail (defun org-decisions-filter-tail (raw) "Return a translation of RAW to vanilla and set appropriate buffer-local variables. RAW is a list of strings representing the input text of a chosenness interpretation." (let ((vanilla-list nil) (all-mark-texts nil) (index 0) bot-lower-range top-upper-range range-length static-default) (dolist (i raw) (destructuring-bind (vanilla-text vanilla-mark &optional type) (org-decisions-filter-one i) (cond ((eq type 'bot-lower-range) (setq bot-lower-range index)) ((eq type 'top-upper-range) (setq top-upper-range index)) ((eq type 'default-mark) (setq static-default index))) (incf index) (push vanilla-text all-mark-texts) (push vanilla-mark vanilla-list))) (org-decisions-setup-vars bot-lower-range top-upper-range static-default index (reverse all-mark-texts)) (nreverse vanilla-list))) ;;;_ . org-decisions-setup-filter (defun org-decisions-setup-filter (raw) "A setup filter for chosenness interpretations." (when (eq (car raw) 'chosenness) (cons 'chosenness (org-decisions-filter-tail (cdr raw))))) ;;;_ . org-decisions-conform-after-promotion (defun org-decisions-conform-after-promotion (entry-pos keywords highest-ok-ix) "" (unless ;;Skip the entry that triggered this by skipping any entry with ;;the same starting position. Both map and plist use the start ;;of the header line as the position, so we can just compare ;;them with `=' (= (point) entry-pos) (let ((ix (org-decisions-get-entry-index keywords))) ;;If the index of the entry exceeds the highest allowable ;;index, change it to that. (when (and ix (> ix highest-ok-ix)) (org-todo (nth highest-ok-ix keywords)))))) ;;;_ . org-decisions-conform-after-demotion (defun org-decisions-conform-after-demotion (entry-pos keywords raise-to-ix old-highest-ok-ix) "" (unless ;;Skip the entry that triggered this. (= (point) entry-pos) (let ((ix (org-decisions-get-entry-index keywords))) ;;If the index of the entry was at or above the old allowable ;;position, change it to the new mirror position if there is ;;one. (when (and ix raise-to-ix (>= ix old-highest-ok-ix)) (org-todo (nth raise-to-ix keywords)))))) ;;;_ , org-decisions-keep-sensible (the trigger-hook function) (defun org-decisions-keep-sensible (change-plist) "" (let* ( (from (plist-get change-plist :from)) (to (plist-get change-plist :to)) (entry-pos (set-marker (make-marker) (plist-get change-plist :position))) (kwd-data (assoc to org-todo-kwd-alist))) (when (eq (nth 1 kwd-data) 'chosenness) (let* ( (data (assoc to org-decisions-mark-data)) (keywords (org-decisions-mark-data.-all-keywords data)) (old-index (org-decisions-get-index-in-keywords from keywords)) (new-index (org-decisions-get-index-in-keywords to keywords)) (highest-ok-ix (org-decisions-highest-other-ok new-index data)) (funcdata (cond ;;The entry doesn't participate in conformance, ;;so give `nil' which does nothing. ((not highest-ok-ix) nil) ;;The entry was created or promoted ((or (not old-index) (> new-index old-index)) (list #'org-decisions-conform-after-promotion entry-pos keywords highest-ok-ix)) (t ;;Otherwise the entry was demoted. (let ( (raise-to-ix (min highest-ok-ix (org-decisions-mark-data.-static-default data))) (old-highest-ok-ix (org-decisions-highest-other-ok old-index data))) (list #'org-decisions-conform-after-demotion entry-pos keywords raise-to-ix old-highest-ok-ix)))))) (if funcdata ;;The funny-looking names are to make variable capture ;;unlikely. (Poor-man's lexical bindings). (destructuring-bind (func-d473 . args-46k) funcdata (let ((map-over-entries (org-decisions-get-fn-map-group)) ;;We may call `org-todo', so let various hooks ;;`nil' so we don't cause loops. org-after-todo-state-change-hook org-trigger-hook org-blocker-hook org-todo-get-default-hook ;;Also let this alist `nil' so we don't log ;;secondary transitions. org-todo-log-states) ;;Map over group (funcall map-over-entries #'(lambda () (apply func-d473 args-46k)))))))) ;;Remove the marker (set-marker entry-pos nil))) ;;;_ , Getting the default mark ;;;_ . org-decisions-get-index-in-keywords (defun org-decisions-get-index-in-keywords (ix all-keywords) "Return index of current entry." (if ix (position ix all-keywords :test #'equal))) ;;;_ . org-decisions-get-entry-index (defun org-decisions-get-entry-index (all-keywords) "Return index of current entry." (let* ((state (org-entry-get (point) "TODO"))) (org-decisions-get-index-in-keywords state all-keywords))) ;;;_ . org-decisions-get-fn-map-group (defun org-decisions-get-fn-map-group () "Return a function to map over the group" #'(lambda (fn) (save-excursion (outline-up-heading-all 1) (save-restriction (org-map-entries fn nil 'tree))))) ;;;_ . org-decisions-get-highest-mark-index (defun org-decisions-get-highest-mark-index (keywords) "Get the index of the highest current mark in the group. If there is none, return 0" (let* ( ;;Func maps over applicable entries. (map-over-entries (org-decisions-get-fn-map-group)) (indexes-list (remove nil (funcall map-over-entries #'(lambda () (org-decisions-get-entry-index keywords)))))) (if indexes-list (apply #'max indexes-list) 0))) ;;;_ . org-decisions-highest-ok (defun org-decisions-highest-other-ok (ix data) "" (let ( (bot-lower-range (org-decisions-mark-data.-bot-lower-range data)) (top-upper-range (org-decisions-mark-data.-top-upper-range data)) (range-length (org-decisions-mark-data.-range-length data))) (when (and ix bot-lower-range) (let* ((delta (- top-upper-range ix))) (unless (< range-length delta) (+ bot-lower-range delta)))))) ;;;_ . org-decisions-get-default-mark-index (defun org-decisions-get-default-mark-index (data) "Get the index of the default mark in a chosenness interpretation. Args are in the same order as the fields of `org-decisions-mark-data.' and have the same meaning." (or (let ((highest-mark-index (org-decisions-get-highest-mark-index (org-decisions-mark-data.-all-keywords data)))) (org-decisions-highest-other-ok highest-mark-index data)) (org-decisions-mark-data.-static-default data))) ;;;_ . org-decisions-get-mark-N (defun org-decisions-get-mark-N (n data) "Get the text of the nth mark in a chosenness interpretation." (let* ((l (org-decisions-mark-data.-all-keywords data))) (nth n l))) ;;;_ . org-decisions-get-default-mark (defun org-decisions-get-default-mark (new-mark old-mark) "Get the default mark IFF in a chosenness interpretation. NEW-MARK and OLD-MARK are the text of the new and old marks." (let* ( (old-kwd-data (assoc old-mark org-todo-kwd-alist)) (new-kwd-data (assoc new-mark org-todo-kwd-alist)) (becomes-chosenness (and (or (not old-kwd-data) (not (eq (nth 1 old-kwd-data) 'chosenness))) (eq (nth 1 new-kwd-data) 'chosenness)))) (when becomes-chosenness (let ((new-mark-data (assoc new-mark org-decisions-mark-data))) (if new-mark (org-decisions-get-mark-N (org-decisions-get-default-mark-index new-mark-data) new-mark-data) (error "Somehow got an unrecognizable mark")))))) ;;;_ , Setting it all up (eval-after-load 'org (progn (add-to-list 'org-todo-setup-filter-hook #'org-decisions-setup-filter) (add-to-list 'org-todo-get-default-hook #'org-decisions-get-default-mark) (add-to-list 'org-trigger-hook #'org-decisions-keep-sensible))) ;;;_. Footers ;;;_ , Provides (provide 'org-decisions) ;;;_ * Local emacs vars. ;;;_ + Local variables: ;;;_ + End: ;;;_ , End ;;; org-decisions.el ends here [-- Attachment #3: org.el.diff --] [-- Type: application/octet-stream, Size: 5799 bytes --] *** old-org.el 2009-01-04 03:01:50.000000000 -0500 --- org.el 2009-01-29 21:09:17.000000000 -0500 *************** *** 1459,1465 **** (choice :tag "Interpretation" (const :tag "Sequence (cycling hits every state)" sequence) ! (const :tag "Type (cycling directly to DONE)" type)) (repeat (string :tag "Keyword")))))) --- 1459,1467 ---- (choice :tag "Interpretation" (const :tag "Sequence (cycling hits every state)" sequence) ! (const :tag "Type (cycling directly to DONE)" type) ! (const :tag "Chosenness (to record decisions)" ! chosenness)) (repeat (string :tag "Keyword")))))) *************** *** 3025,3031 **** (org-set-local 'org-file-properties nil) (org-set-local 'org-file-tags nil) (let ((re (org-make-options-regexp ! '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE"))) (splitre "[ \t]+") --- 3027,3033 ---- (org-set-local 'org-file-properties nil) (org-set-local 'org-file-tags nil) (let ((re (org-make-options-regexp ! '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "CHOOSE_TODO" "COLUMNS" "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE"))) (splitre "[ \t]+") *************** *** 3052,3057 **** --- 3054,3061 ---- (push (cons 'sequence (org-split-string value splitre)) kwds)) ((equal key "TYP_TODO") (push (cons 'type (org-split-string value splitre)) kwds)) + ((equal key "CHOOSE_TODO") + (push (cons 'chosenness (org-split-string value splitre)) kwds)) ((equal key "TAGS") (setq tags (append tags (org-split-string value splitre)))) ((equal key "COLUMNS") *************** *** 3133,3138 **** --- 3137,3148 ---- (setq kwds (nreverse kwds)) (let (inter kws kw) (while (setq kws (pop kwds)) + (let + ((kws + (or + (run-hook-with-args-until-success + 'org-todo-setup-filter-hook kws) + kws))) (setq inter (pop kws) sep (member "|" kws) kws0 (delete "|" (copy-sequence kws)) kwsa nil *************** *** 3154,3160 **** '((:endgroup)))) hw (car kws1) dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) ! tail (list inter hw (car dws) (org-last dws))) (add-to-list 'org-todo-heads hw 'append) (push kws1 org-todo-sets) (setq org-done-keywords (append org-done-keywords dws nil)) --- 3164,3170 ---- '((:endgroup)))) hw (car kws1) dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) ! tail (list inter hw (car dws) (org-last dws)))) (add-to-list 'org-todo-heads hw 'append) (push kws1 org-todo-sets) (setq org-done-keywords (append org-done-keywords dws nil)) *************** *** 4934,4944 **** (org-back-to-heading) (outline-previous-heading) (looking-at org-todo-line-regexp)) (if (or arg (not (match-beginning 2)) (member (match-string 2) org-done-keywords)) ! (insert (car org-todo-keywords-1) " ") ! (insert (match-string 2) " ")) (when org-provide-todo-statistics (org-update-parent-todo-statistics)))) --- 4944,4963 ---- (org-back-to-heading) (outline-previous-heading) (looking-at org-todo-line-regexp)) + (let* + ((new-mark-x (if (or arg (not (match-beginning 2)) (member (match-string 2) org-done-keywords)) ! (car org-todo-keywords-1) ! (match-string 2))) ! (new-mark ! (or ! (run-hook-with-args-until-success ! 'org-todo-get-default-hook new-mark-x nil) ! new-mark-x))) ! (insert new-mark " ")) ! (when org-provide-todo-statistics (org-update-parent-todo-statistics)))) *************** *** 8190,8195 **** --- 8209,8226 ---- :from previous state (keyword as a string), or nil :to new state (keyword as a string), or nil") + (defvar org-todo-setup-filter-hook nil + "Hook for functions that pre-filter todo specs. + + Each function takes a todo spec and returns either `nil' or the spec + transformed into canonical form." ) + + (defvar org-todo-get-default-hook nil + "Hook for functions that get a default item for todo. + + Each function takes arguments (NEW-MARK OLD-MARK) and returns either + `nil' or a string to be used for the todo mark." ) + (defvar org-agenda-headline-snapshot-before-repeat) (defun org-todo (&optional arg) "Change the TODO state of an item. *************** *** 8285,8291 **** ((null member) (or head (car org-todo-keywords-1))) ((equal this final-done-word) nil) ;; -> make empty ((null tail) nil) ;; -> first entry ! ((eq interpret 'sequence) (car tail)) ((memq interpret '(type priority)) (if (eq this-command last-command) --- 8316,8322 ---- ((null member) (or head (car org-todo-keywords-1))) ((equal this final-done-word) nil) ;; -> make empty ((null tail) nil) ;; -> first entry ! ((memq interpret '(sequence chosenness)) (car tail)) ((memq interpret '(type priority)) (if (eq this-command last-command) *************** *** 8294,8299 **** --- 8325,8334 ---- (or done-word (car org-done-keywords)) nil))) (t nil))) + (state (or + (run-hook-with-args-until-success + 'org-todo-get-default-hook state last-state) + state)) (next (if state (concat " " state " ") " ")) (change-plist (list :type 'todo-state-change :from this :to state :position startpos)) [-- Attachment #4: test-org-decisions.el --] [-- Type: application/octet-stream, Size: 47226 bytes --] ;;;_ test-org-decisions.el --- Test code for org-decisions ;;;_. Headers ;;;_ , License ;; Copyright (C) 2009 Tom Breton (Tehom) ;; Author: Tom Breton (Tehom) <tehom@localhost.localdomain> ;; Keywords: lisp ;; 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 2, or (at your option) ;; any later version. ;; This file 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., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;;_ , Commentary: ;; ;;;_ , Requires (require 'rtest-define) (require 'mockbuf) (require 'el-mock) (require 'org) (require 'org-id) (require 'org-decisions) ;;;_. Body ;;;_ , Example files (defconst test-org-decisions:th:examples-dir (rtest:expand-filename-by-load-file "examples") "Directory where examples are" ) (rtest:defexample test-org-decisions:thd:file-simple (expand-file-name "simple.org" test-org-decisions:th:examples-dir)) (rtest:defexample test-org-decisions:thd:file-w-1-chosen (expand-file-name "w-1-chosen.org" test-org-decisions:th:examples-dir)) (rtest:defexample test-org-decisions:thd:file-nonautomatic (expand-file-name "nonautomatic.org" test-org-decisions:th:examples-dir)) (rtest:defexample test-org-decisions:thd:file-w-2-types (expand-file-name "w-2-types.org" test-org-decisions:th:examples-dir)) (rtest:defexample test-org-decisions:thd:file-w-some-nils (expand-file-name "w-some-nils.org" test-org-decisions:th:examples-dir)) (rtest:defexample test-org-decisions:thd:file-nosibs (expand-file-name "no-sibs.org" test-org-decisions:th:examples-dir)) (rtest:defexample test-org-decisions:thd:nofile-1-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-decisions:thd:nofile-1-raw-marks '(chosenness "REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN") "Raw marks") (rtest:defexample test-org-decisions:thd:nofile-1-output-marks '(chosenness "REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN") "Output marks") (rtest:defexample test-org-decisions:thd:nofile-1-setup-args (list nil nil nil 5 test-org-decisions:thd:nofile-1-list-o-marks) "Arguments given to org-decisions-setup-vars" ) (rtest:defexample test-org-decisions:thd:nofile-1-mark-data (mapcar #'(lambda (x) (make-org-decisions-mark-data. :keyword x :bot-lower-range nil :top-upper-range nil :range-length nil :static-default 0 :all-keywords test-org-decisions:thd:nofile-1-list-o-marks)) test-org-decisions:thd:nofile-1-list-o-marks) "The mark data corresponding to nofile-1") (rtest:defexample test-org-decisions:thd:nofile-2-list-o-marks '("ZERO" "ONE" "TWO" "THREE" "FOUR" "FIVE" "SIX")) (rtest:defexample test-org-decisions:thd:nofile-2-raw-marks '(chosenness "ZERO" "ONE" "TWO(b)" "THREE(c,-)" "FOUR(d,0)" "FIVE(e,+)" "SIX(,)") "Raw marks") (rtest:defexample test-org-decisions:thd:nofile-2-output-marks '(chosenness "ZERO" "ONE" "TWO(b)" "THREE(c)" "FOUR(d)" "FIVE(e)" "SIX") "Output marks") (rtest:defexample test-org-decisions:thd:nofile-2-setup-args (list 3 5 4 7 test-org-decisions:thd:nofile-2-list-o-marks) "Arguments given to org-decisions-setup-vars" ) (rtest:defexample test-org-decisions:thd:nofile-2-mark-data (mapcar #'(lambda (x) (make-org-decisions-mark-data. :keyword x :bot-lower-range 3 :top-upper-range 5 :range-length 1 :static-default 4 :all-keywords test-org-decisions:thd:nofile-2-list-o-marks)) test-org-decisions:thd:nofile-2-list-o-marks) "The mark data corresponding to nofile example 2") ;;An example of one that's not automatically managed (rtest:defexample test-org-decisions:thd:nofile-3-raw-marks '(sequence "ZERO" "ONE" "TWO(b)" "THREE(c)" "FOUR(d)" "FIVE(e)" "SIX") "Input marks") (rtest:defexample test-org-decisions:thd:nofile-3-output-marks nil "Output marks") ;;An example where the top of the range is implicit (rtest:defexample test-org-decisions:thd:nofile-4-list-o-marks '("ZERO" "ONE" "TWO" "THREE" "FOUR" "FIVE" "SIX")) (rtest:defexample test-org-decisions:thd:nofile-4-raw-marks '(chosenness "ZERO" "ONE" "TWO(b)" "THREE(c,-)" "FOUR(d,0)" "FIVE(e)" "SIX") "Input marks") (rtest:defexample test-org-decisions:thd:nofile-4-setup-args (list 3 nil 4 7 test-org-decisions:thd:nofile-4-list-o-marks) "Arguments given to org-decisions-setup-vars") (rtest:defexample test-org-decisions:thd:nofile-4-mark-data (mapcar #'(lambda (x) (make-org-decisions-mark-data. :keyword x :bot-lower-range 3 :top-upper-range 6 :range-length 2 :static-default 4 :all-keywords test-org-decisions:thd:nofile-4-list-o-marks)) test-org-decisions:thd:nofile-4-list-o-marks) "The mark data corresponding to nofile example 2") (rtest:defexample test-org-decisions:thd:nofile-4-kwd-alist (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'chosenness "ZERO" "SIX" "SIX")) test-org-decisions:thd:nofile-4-list-o-marks)) (rtest:defexample test-org-decisions:thd:file-simple-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-decisions:thd:file-simple-setup-args (list 1 4 2 5 test-org-decisions:thd:file-simple-list-o-marks) "Arguments given to org-decisions-setup-vars" ) (rtest:defexample test-org-decisions:thd:file-simple-mark-data (mapcar #'(lambda (x) (make-org-decisions-mark-data. :keyword x :bot-lower-range 1 :top-upper-range 4 :range-length 2 :static-default 2 :all-keywords test-org-decisions:thd:file-simple-list-o-marks)) test-org-decisions:thd:file-simple-list-o-marks) "The mark data corresponding to file1") (rtest:defexample test-org-decisions:thd:file-simple-high-ix 3) (rtest:defexample test-org-decisions:thd:file-simple-sib-maybe-id "67a7cbba-c78b-47fe-886a-08a80f67e4ab" "ID of a sibling") (rtest:defexample test-org-decisions:thd:file-simple-sib-maybe-ix 2 "Mark index of that sibling") (rtest:defexample test-org-decisions:thd:file-simple-sib-rejected-id "953d4524-f15e-4198-ab33-5769732f51ad" "ID of another sibling") (rtest:defexample test-org-decisions:thd:file-simple-sib-leaning-id "be01f611-6175-4e40-a3b5-525a9c1e3b4d" "ID of another sibling") (rtest:defexample test-org-decisions:thd:file-simple-sib-not-chosen-id "b7760ac9-e0bf-41a0-9661-720d42670432" "ID of another sibling") (rtest:defexample test-org-decisions:thd:file-simple-parent-id "a13a4b6f-02d6-445c-a38e-7e51b9ba29d4" "ID of the parent of those nodes") (rtest:defexample test-org-decisions:thd:file-simple-original-marks '("MAYBE""REJECTED""LEANING_TOWARDS""NOT_CHOSEN")) (rtest:defexample test-org-decisions:thd:file-w-1-chosen-mark-data test-org-decisions:thd:file-simple-mark-data) (rtest:defexample test-org-decisions:thd:file-w-1-chosen-high-ix 4) (rtest:defexample test-org-decisions:thd:file-w-1-chosen-sib-not-chosen-a-id "b390f9b1-57d0-4a17-9811-47b49fee196f" "ID of a not-chosen sibling") (rtest:defexample test-org-decisions:thd:file-w-1-chosen-sib-maybe-id "5a449704-494c-412f-b21d-8ffe07b8092c" "ID of another not-chosen sibling") (rtest:defexample test-org-decisions:thd:file-w-1-chosen-sib-chosen-id "c0958364-1f99-4dfc-a671-f21bb5f708bb" "ID of the chosen sibling") (rtest:defexample test-org-decisions:thd:file-w-1-chosen-parent-id "b2a6f78c-6199-461b-9850-18980b85b1ab") (rtest:defexample test-org-decisions:thd:file-w-1-chosen-list-o-marks test-org-decisions:thd:file-simple-list-o-marks) (rtest:defexample test-org-decisions:thd:file-w-1-chosen-original-marks '("NOT_CHOSEN" "REJECTED" "CHOSEN " "MAYBE")) (rtest:defexample test-org-decisions:thd:file-nonautomatic-list-o-marks '("NO" "MAYBE_YN" "YES")) (rtest:defexample test-org-decisions:thd:file-nonautomatic-raw-marks '(chosenness "NO" "MAYBE_YN(,0)" "YES")) (rtest:defexample test-org-decisions:thd:file-nonautomatic-setup-args (list nil nil 1 3 test-org-decisions:thd:file-nonautomatic-list-o-marks) "Arguments given to org-decisions-setup-vars") (rtest:defexample test-org-decisions:thd:file-nonautomatic-high-ix 2) (rtest:defexample test-org-decisions:thd:file-nonautomatic-sib-yes-id "6a27cc97-6e65-4c4e-9014-7fbcf27f52fa") (rtest:defexample test-org-decisions:thd:file-nonautomatic-mark-data (mapcar #'(lambda (x) (make-org-decisions-mark-data. :keyword x :bot-lower-range nil :top-upper-range nil :range-length nil :static-default 1 :all-keywords test-org-decisions:thd:file-nonautomatic-list-o-marks) ) test-org-decisions:thd:file-nonautomatic-list-o-marks) "The mark data corresponding to file3") (rtest:defexample test-org-decisions:thd:context:kwd-alist-normal-todo (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'sequence "TODO" "DONE" "DONE")) '("TODO" "DONE")) "A kwd-alist that includes only the 2 normal TODO marks. NB, this is context. It is not *produced* by any test code, it is used to control what marks are understood." ) (rtest:defexample test-org-decisions:thd:context:kwd-alist (append test-org-decisions:thd:context:kwd-alist-normal-todo (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'chosenness "NO" "YES" "YES")) test-org-decisions:thd:file-nonautomatic-list-o-marks)) "A kwd-alist to combines 2 normal TODO marks and the file-nonautomatic marks. NB, this is not *produced* by any test code, it is used to control what marks are understood." ) (rtest:defexample test-org-decisions:thd:context:kwd-alist-simple (append test-org-decisions:thd:context:kwd-alist-normal-todo (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'chosenness "REJECTED" "CHOSEN" "CHOSEN")) test-org-decisions:thd:file-simple-list-o-marks)) "A kwd-alist that includes the marks in simple.org plus 2 normal TODO marks. NB, this is context. It is not *produced* by any test code, it is used to control what marks are understood." ) (rtest:defexample test-org-decisions:thd:file-w-2-types-mark-data (append test-org-decisions:thd:file-simple-mark-data test-org-decisions:thd:file-nonautomatic-mark-data)) (rtest:defexample test-org-decisions:thd:file-w-2-types-t1-high-ix 3) (rtest:defexample test-org-decisions:thd:file-w-2-types-t1-leaning-id "c8e7d7af-15a2-4650-a604-50ade52bd06c") (rtest:defexample test-org-decisions:thd:file-w-2-types-t1-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-decisions:thd:file-w-2-types-t2-high-ix 2) (rtest:defexample test-org-decisions:thd:file-w-2-types-t2-yes-id "02e917f5-ac3d-477f-baf5-7eb7c8961683") (rtest:defexample test-org-decisions:thd:file-w-2-types-t2-list-o-marks '("YES" "MAYBE_YN" "NO")) (rtest:defexample test-org-decisions:thd:file-w-some-nils-high-ix 4) (rtest:defexample test-org-decisions:thd:file-w-some-nils-sib-marked-id "a4e52131-1145-49f5-8b4b-dc4264900a05") (rtest:defexample test-org-decisions:thd:file-w-some-nils-sib-nil-id "d9729468-db22-4870-8969-9500da63d560") (rtest:defexample test-org-decisions:thd:file-w-some-nils-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-decisions:thd:file-nosibs-sib "78fb63fa-4fad-4c7f-aa4a-954ee3431754") (rtest:defexample test-org-decisions:thd:file-nosibs-high-ix 0) ;;;_ , Tests of org-decisions-filter-one (rtest:defexample test-org-decisions:thd:singlemark-1-input-output '("ONE(,0)" ("ONE" "ONE" default-mark)) "Pairs of single marks: Input and output" ) (rtest:defexample test-org-decisions:thd:singlemark-2-input-output '("TWO" ("TWO" "TWO")) "Pairs of single marks: Input and output" ) (rtest:defexample test-org-decisions:thd:singlemark-3-input-output '("THREE(b)" ("THREE" "THREE(b)")) "Pairs of single marks: Input and output") (rtest:defexample test-org-decisions:thd:singlemark-4-input-output '("FOUR(c,0)" ("FOUR" "FOUR(c)" default-mark)) "Pairs of single marks: Input and output") (rtest:defexample test-org-decisions:thd:singlemark-5-input-output '("FIVE(d,+)" ("FIVE" "FIVE(d)" top-upper-range)) "Pairs of single marks: Input and output") (rtest:defexample test-org-decisions:thd:singlemark-6-input-output '("SIX(e,-)" ("SIX" "SIX(e)" bot-lower-range)) "Pairs of single marks: Input and output") (rtest:defexample test-org-decisions:thd:singlemark-7-input-output '("SEVEN(,)" ("SEVEN" "SEVEN")) "Pairs of single marks: Input and output") (rtest:defexample test-org-decisions:thd:singlemark-8-input-output '("EIGHT(x!/@,)" ("EIGHT" "EIGHT(x!/@)")) "Pairs of single marks: Input and output") (rtest:deftest org-decisions-filter-one ( "Does the examples correctly." (equal (org-decisions-filter-one (car test-org-decisions:thd:singlemark-1-input-output)) (second test-org-decisions:thd:singlemark-1-input-output))) ( "Does the examples correctly." (equal (org-decisions-filter-one (car test-org-decisions:thd:singlemark-2-input-output)) (second test-org-decisions:thd:singlemark-2-input-output))) ( "Does the examples correctly." (equal (org-decisions-filter-one (car test-org-decisions:thd:singlemark-3-input-output)) (second test-org-decisions:thd:singlemark-3-input-output))) ( "Does the examples correctly." (equal (org-decisions-filter-one (car test-org-decisions:thd:singlemark-4-input-output)) (second test-org-decisions:thd:singlemark-4-input-output))) ( "Does the examples correctly." (equal (org-decisions-filter-one (car test-org-decisions:thd:singlemark-5-input-output)) (second test-org-decisions:thd:singlemark-5-input-output))) ( "Does the examples correctly." (equal (org-decisions-filter-one (car test-org-decisions:thd:singlemark-6-input-output)) (second test-org-decisions:thd:singlemark-6-input-output))) ( "Does the examples correctly." (equal (org-decisions-filter-one (car test-org-decisions:thd:singlemark-7-input-output)) (second test-org-decisions:thd:singlemark-7-input-output))) ( "Does the examples correctly." (equal (org-decisions-filter-one (car test-org-decisions:thd:singlemark-8-input-output)) (second test-org-decisions:thd:singlemark-8-input-output))) ) ;;;_ , Tests of org-decisions-setup-vars (rtest:deftest org-decisions-setup-vars ( "The `*-setup-args' examples are proper args to `org-decisions-setup-vars'. It sets org-decisions-mark-data correspondingly." (with-temp-buffer (apply #'org-decisions-setup-vars test-org-decisions:thd:nofile-1-setup-args) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:nofile-1-mark-data))) ( "The `*-setup-args' examples are proper args to `org-decisions-setup-vars'. It sets org-decisions-mark-data correspondingly." (with-temp-buffer (apply #'org-decisions-setup-vars test-org-decisions:thd:nofile-2-setup-args) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:nofile-2-mark-data))) ( "The `*-setup-args' examples are proper args to `org-decisions-setup-vars'. It sets org-decisions-mark-data correspondingly." (with-temp-buffer (apply #'org-decisions-setup-vars test-org-decisions:thd:nofile-4-setup-args) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:nofile-4-mark-data))) ( "The `*-setup-args' examples are proper args to `org-decisions-setup-vars'. It sets org-decisions-mark-data correspondingly." (with-temp-buffer (apply #'org-decisions-setup-vars test-org-decisions:thd:file-simple-setup-args) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:file-simple-mark-data))) ( "The `*-setup-args' examples are proper args to `org-decisions-setup-vars'. It sets org-decisions-mark-data correspondingly." (with-temp-buffer (apply #'org-decisions-setup-vars test-org-decisions:thd:file-nonautomatic-setup-args) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:file-nonautomatic-mark-data))) ) ;;;_ , Tests of the setup filter (rtest:deftest org-decisions-setup-filter ;;I'd like to have also tested that output is conformant. But ;;AFAICT no existing predicate reports that, so I'll only test that ;;output matches what's expected, which I'll eyeball. ( "Situation: Called manually, passed data with another interpretation. Response: Return value is `nil'." (equal (with-temp-buffer (org-decisions-setup-filter test-org-decisions:thd:nofile-3-raw-marks)) test-org-decisions:thd:nofile-3-output-marks)) ( "Situation: Called manually, passed known data. Response: Return value is as expected." (equal (with-temp-buffer (org-decisions-setup-filter test-org-decisions:thd:nofile-1-raw-marks)) test-org-decisions:thd:nofile-1-output-marks)) ( "Situation: Called manually, passed known data. Response: Return value is as expected." (equal (with-temp-buffer (org-decisions-setup-filter test-org-decisions:thd:nofile-2-raw-marks)) test-org-decisions:thd:nofile-2-output-marks)) ( "Situation: Called manually, passed known data. Response: Variables have been set up as expected." (with-temp-buffer (org-decisions-setup-filter test-org-decisions:thd:nofile-1-raw-marks) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:nofile-1-mark-data))) ( "Situation: Called manually, passed known data. Response: Variables have been set up as expected." (with-temp-buffer (org-decisions-setup-filter test-org-decisions:thd:nofile-2-raw-marks) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:nofile-2-mark-data))) ( "Situation: Called manually, passed known data. Response: Variables have been set up as expected." (with-temp-buffer (org-decisions-setup-filter test-org-decisions:thd:nofile-4-raw-marks) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:nofile-4-mark-data))) ( "Situation: In temp buffer, given the same marks as for file 3. Response: `org-decisions-mark-data' have been set up as expected." (with-temp-buffer (org-decisions-setup-filter test-org-decisions:thd:file-nonautomatic-raw-marks) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:file-nonautomatic-mark-data))) ( "Situation: `org-decisions-mark-data' has already been set with marks from this set Response: `org-decisions-mark-data' gets the expected value and nothing extra." (with-temp-buffer (let ((org-decisions-mark-data test-org-decisions:thd:file-nonautomatic-mark-data)) (org-decisions-setup-filter test-org-decisions:thd:file-nonautomatic-raw-marks) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:file-nonautomatic-mark-data)))) ( "Situation: `org-decisions-mark-data' has already been set with marks from another set Response: `org-decisions-mark-data' gets the new marks and keeps the marks from the other set." (with-temp-buffer (let ((org-decisions-mark-data test-org-decisions:thd:file-simple-mark-data)) (org-decisions-setup-filter test-org-decisions:thd:file-nonautomatic-raw-marks) (rtest:sets= org-decisions-mark-data (append test-org-decisions:thd:file-simple-mark-data test-org-decisions:thd:file-nonautomatic-mark-data))))) ;;Insinuated tests, so that setup filter is called automatically by ;;setup. ( "Situation: In example file 1. Response: `org-decisions-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-decisions:thd:file-simple) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:file-simple-mark-data))) ( "Situation: In example file 2. Response: `org-decisions-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-decisions:thd:file-w-1-chosen) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:file-w-1-chosen-mark-data))) ( "Situation: In example file 3. Response: `org-decisions-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-decisions:thd:file-nonautomatic) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:file-nonautomatic-mark-data))) ( "Situation: In example file 4. Response: `org-decisions-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-decisions:thd:file-w-2-types) (rtest:sets= org-decisions-mark-data test-org-decisions:thd:file-w-2-types-mark-data)))) ;;;_ , Tests of the function to get default ;;;_ . Test helper ;;;_ . org-decisions:th:in-buffer-at (defmacro* org-decisions:th:in-buffer-at ((&key file id) &rest body) "" `(with-buffer-containing-object (:file ,file) ;;Have to show entries otherwise we might fail to go to them. (show-all) ;;Go to one of the entries. Use `org-find-entry-with-id' so we ;;can't accidentally leave this file, as we could with ;;`org-id-find'. (goto-char (org-find-entry-with-id ,id)) ,@body)) ;;;_ , Tests (put 'org-decisions:th:in-buffer-at 'rtest:test-thru 'org-decisions-get-entry-index) ;;;_ . org-decisions-get-entry-index (rtest:deftest org-decisions-get-entry-index ;;These tests are tests after insinuation. ( "Situation: Point is in a marked entry. Response: Return the index of that entry." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-maybe-id) (equal (org-decisions-get-entry-index test-org-decisions:thd:file-simple-list-o-marks) test-org-decisions:thd:file-simple-sib-maybe-ix))) ( "Situation: Point is in a unmarked entry (nil). Response: Return nil." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-w-some-nils :id test-org-decisions:thd:file-w-some-nils-sib-nil-id) (equal (org-decisions-get-entry-index test-org-decisions:thd:file-w-some-nils-list-o-marks) nil))) ( "Situation: Point is in an entry with a mark from a different set. Response: Return nil." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-w-2-types :id test-org-decisions:thd:file-w-2-types-t2-yes-id) (equal (org-decisions-get-entry-index test-org-decisions:thd:file-w-2-types-t1-list-o-marks) nil))) ) ;;;_ . org-decisions-get-highest-mark-index (rtest:deftest org-decisions-get-highest-mark-index ( "Situation: Point is in one of the sibling entries Response: Returns the highest index." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-maybe-id) (equal (org-decisions-get-highest-mark-index test-org-decisions:thd:file-simple-list-o-marks) test-org-decisions:thd:file-simple-high-ix))) ( "Situation: Point is in a different one of the sibling entries Response: Returns the highest index." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-rejected-id) (equal (org-decisions-get-highest-mark-index test-org-decisions:thd:file-simple-list-o-marks) test-org-decisions:thd:file-simple-high-ix))) ( "Situation: Point is in one of the sibling entries Response: Returns the highest index." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-w-1-chosen :id test-org-decisions:thd:file-w-1-chosen-sib-not-chosen-a-id) (equal (org-decisions-get-highest-mark-index test-org-decisions:thd:file-w-1-chosen-list-o-marks) test-org-decisions:thd:file-w-1-chosen-high-ix))) ( "Situation: Point is in one of the sibling entries Response: Returns the highest index." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-nonautomatic :id test-org-decisions:thd:file-nonautomatic-sib-yes-id) (equal (org-decisions-get-highest-mark-index test-org-decisions:thd:file-nonautomatic-list-o-marks) test-org-decisions:thd:file-nonautomatic-high-ix))) ( "Situation: Point is in one of the sibling entries of one type. Response: Returns the highest index of siblings of that type, ignoring the others." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-w-2-types :id test-org-decisions:thd:file-w-2-types-t1-leaning-id) (equal (org-decisions-get-highest-mark-index test-org-decisions:thd:file-w-2-types-t1-list-o-marks) test-org-decisions:thd:file-w-2-types-t1-high-ix))) ( "Situation: Point is in one of the sibling entries of one type, in a sibling group that has 2 types. Response: Returns the highest index of siblings of that type, ignoring the others." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-w-2-types :id test-org-decisions:thd:file-w-2-types-t2-yes-id) (equal (org-decisions-get-highest-mark-index test-org-decisions:thd:file-w-2-types-t2-list-o-marks) test-org-decisions:thd:file-w-2-types-t2-high-ix))) ( "Situation: Point is in one of the sibling entries. Some entries are nil. Response: Returns the highest index, ignoring the `nil's." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-w-some-nils :id test-org-decisions:thd:file-w-some-nils-sib-marked-id) (equal (org-decisions-get-highest-mark-index test-org-decisions:thd:file-w-some-nils-list-o-marks) test-org-decisions:thd:file-w-some-nils-high-ix))) ( "Situation: There are no entries of chosenness type. Response: Return 0" (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-nosibs :id test-org-decisions:thd:file-nosibs-sib) (equal (org-decisions-get-highest-mark-index test-org-decisions:thd:file-simple-list-o-marks) 0))) ) ;;;_ . org-decisions-get-default-mark-index (put 'org-decisions-get-default-mark-index 'rtest:test-thru 'org-decisions-get-default-mark) ;;;_ . org-decisions-get-mark-N (rtest:deftest org-decisions-get-mark-N ( "Behavior: Gets the corresponding mark from the set." (let ((org-decisions-mark-data test-org-decisions:thd:nofile-4-mark-data)) (equal (org-decisions-get-mark-N 0 (assoc "ONE" org-decisions-mark-data)) "ZERO"))) ( "Behavior: Gets the corresponding mark from the set." (let ((org-decisions-mark-data test-org-decisions:thd:nofile-4-mark-data)) (equal (org-decisions-get-mark-N 4 (assoc "THREE" org-decisions-mark-data)) "FOUR"))) ) ;;;_ . org-decisions-get-default-mark ;;;_ , Test helpers (defun org-decisions-get-default-mark-index:th (new-mark mark-data) "Test helper" (org-decisions-get-default-mark-index (assoc new-mark mark-data))) (defun org-decisions:th:collect-childrens-todo-marks (parent-id) "" (save-excursion (show-all) ;;In case anything got hidden (goto-char (org-find-entry-with-id parent-id)) (save-restriction (org-map-entries #'(lambda () (org-entry-get (point) "TODO")) nil 'tree)))) ;;;_ . Tests of org-decisions:th:collect-childrens-todo-marks (rtest:deftest org-decisions:th:collect-childrens-todo-marks ("Situation: In a known file. Param: The id of the parent entry. Response: Returns the TODO marks of the children." (with-buffer-containing-object (:file test-org-decisions:thd:file-simple) (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-simple-parent-id) test-org-decisions:thd:file-simple-original-marks)))) ;;;_ , Tests (rtest:deftest org-decisions-get-default-mark ( "Situation: we're not going into a chosenness type Response: Return nil, signalling to use the mark we were going to." (let ((org-todo-kwd-alist test-org-decisions:thd:context:kwd-alist)) (equal (org-decisions-get-default-mark nil "DONE") nil))) ( "Situation: We were already in a chosenness type. Response: Return nil, signalling to use the mark we were going to." (let ((org-todo-kwd-alist test-org-decisions:thd:context:kwd-alist)) (equal (org-decisions-get-default-mark "YES" "MAYBE_YN") nil))) ;;These tests test the index return for ;;`org-decisions-get-default-mark-index' and also test the string ;;return for `org-decisions-get-default-mark'. Combining the tests ;;under `and' is not good style but I don't want to write each ;;setup twice. ( "Situation: there are no ranges. Response: return the static default." (let ((org-decisions-mark-data test-org-decisions:thd:file-nonautomatic-mark-data) (org-todo-kwd-alist test-org-decisions:thd:context:kwd-alist)) (with-mock (stub org-decisions-get-highest-mark-index => nil) (and (equal (org-decisions-get-default-mark-index:th "NO" test-org-decisions:thd:file-nonautomatic-mark-data) 1) (equal (org-decisions-get-default-mark "NO" nil) "MAYBE_YN"))))) ( "Situation: no current mark is in the upper range. Response: return the static default." (let ((org-decisions-mark-data test-org-decisions:thd:nofile-4-mark-data) (org-todo-kwd-alist test-org-decisions:thd:nofile-4-kwd-alist)) (with-mock (stub org-decisions-get-highest-mark-index => 2) (and (equal (org-decisions-get-default-mark-index:th "ONE" test-org-decisions:thd:nofile-4-mark-data) 4) (equal (org-decisions-get-default-mark "ONE" nil) "FOUR") )))) ;;Because the static default is at or above the top of lower range, ;;any mirror-wise constraint is a stronger constraint than it. So ;;no additional test is needed for the interaction between those ;;two constraints. ( "Situation: a current mark is in the upper range. Response: return an accordingly lower index.." (let ((org-decisions-mark-data test-org-decisions:thd:nofile-4-mark-data) (org-todo-kwd-alist test-org-decisions:thd:nofile-4-kwd-alist)) (with-mock (stub org-decisions-get-highest-mark-index => 6) (and (equal (org-decisions-get-default-mark-index:th "ONE" test-org-decisions:thd:nofile-4-mark-data) 3) (equal (org-decisions-get-default-mark "ONE" nil) "THREE"))))) ("Situation: Point is on a heading. The only type of TODO in this buffer is a chosenness type. The default type is MAYBE. No sibling mark is higher than LEANING_TOWARDS. Operation: Add a new todo heading. Result: It then has the mark MAYBE." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-maybe-id) (org-insert-todo-heading 1) (equal (org-entry-get (point) "TODO") "MAYBE"))) ("Situation: Point is on a heading with no mark. The only type of TODO in this buffer is a chosenness type. The default type is MAYBE. No sibling mark is higher than LEANING_TOWARDS. Operation: Add a todo mark to the heading. Result: It then has the mark MAYBE." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-maybe-id) (org-insert-heading) (org-todo) (equal (org-entry-get (point) "TODO") "MAYBE"))) ("Situation: Point is on a heading. The only type of TODO in this buffer is a chosenness type. The default type is MAYBE. A sibling mark is CHOSEN The mark NOT_CHOSEN mirrors the mark CHOSEN. Operation: Add a todo mark to the heading. Result: It then has the mark NOT_CHOSEN." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-w-1-chosen :id test-org-decisions:thd:file-w-1-chosen-sib-not-chosen-a-id) (org-insert-heading) (org-todo) (equal (org-entry-get (point) "TODO") "NOT_CHOSEN")))) ;;;_ , Tests of the trigger function ;;;_ . org-decisions-conform-after-promotion ;;;_ , Test helper (defun* org-decisions-conform-after-promotion:th (&key file id mark-data other-was other-changed-to expect demoted) "" (org-decisions:th:in-buffer-at (:file file :id id) (let* ( (data (or (assoc other-changed-to mark-data) (error "Mark-data should contain the entry being changed to"))) (keywords (org-decisions-mark-data.-all-keywords data)) (index (org-decisions-get-index-in-keywords other-changed-to keywords)) (old-index (when other-was (org-decisions-get-index-in-keywords other-was keywords)))) (if demoted (org-decisions-conform-after-demotion 0 ;;Fake position that matches nothing keywords (let ((new-highest (org-decisions-highest-other-ok index data)) (static-default (org-decisions-mark-data.-static-default data))) (if new-highest (min new-highest static-default) static-default)) (org-decisions-highest-other-ok old-index data)) (org-decisions-conform-after-promotion 0 ;;Fake position that matches nothing keywords (org-decisions-highest-other-ok index data)))) (equal (org-entry-get (point) "TODO") expect))) ;;;_ , Tests (rtest:deftest org-decisions-conform-after-promotion ( "Situation: Entry's mark is from some other workflow state. Response: Do nothing." (org-decisions-conform-after-promotion:th :file test-org-decisions:thd:file-w-2-types :id test-org-decisions:thd:file-w-2-types-t2-yes-id :mark-data test-org-decisions:thd:file-w-2-types-mark-data :other-changed-to "CHOSEN" :expect "YES")) ( "Situation: Entry's mark is already lower than the highest allowed index. Response: No change." (org-decisions-conform-after-promotion:th :file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-rejected-id :mark-data test-org-decisions:thd:file-simple-mark-data :other-changed-to "CHOSEN" :expect "REJECTED")) ( "Situation: Entry's mark is higher than the highest allowed index. Response: Demote it." (org-decisions-conform-after-promotion:th :file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-leaning-id :mark-data test-org-decisions:thd:file-simple-mark-data :other-changed-to "LEANING_TOWARDS" :expect "MAYBE")) ) ;;;_ . org-decisions-conform-after-demotion ;;;_ , Tests (rtest:deftest org-decisions-conform-after-demotion ( "Situation: The other entry was not keeping this node below the default. Response: This node is unchanged." (org-decisions-conform-after-promotion:th :file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-maybe-id :mark-data test-org-decisions:thd:file-simple-mark-data :other-was "LEANING_TOWARDS" :other-changed-to "MAYBE" :demoted t :expect "MAYBE")) ( "Situation: The other entry was keeping this node below the default. Response: This node is promoted." (org-decisions-conform-after-promotion:th :file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-maybe-id :mark-data test-org-decisions:thd:file-simple-mark-data :other-was "LEANING_TOWARDS" :other-changed-to "CHOSEN" :demoted t :expect "NOT_CHOSEN")) ( "Situation: The other entry was keeping this node below the default. It was just demoted quite low. Response: This node is promoted only to the default." (org-decisions-conform-after-promotion:th :file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-not-chosen-id :mark-data test-org-decisions:thd:file-simple-mark-data :other-was "CHOSEN" :other-changed-to "REJECTED" :demoted t :expect "MAYBE")) ) ;;;_ . org-decisions-keep-sensible ;;;_ , Helper (defun* org-decisions-keep-sensible:th:manual (&key from to) "" (let (org-blocker-hook) (org-todo to) (org-decisions-keep-sensible (list :from from :to to :position (point-at-bol))))) ;;;_ , Tests (rtest:deftest org-decisions-keep-sensible ;;Non-insinuated tests, `org-decisions-keep-sensible' is just ;;called manually. ( "Operation: An entry's todo mark is changed into a TODO from some other workflow state. Response: No change to our entries." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-rejected-id) (let ((org-todo-kwd-alist test-org-decisions:thd:context:kwd-alist-simple)) (org-decisions-keep-sensible:th:manual :from "RESPONSE:" :to "NOT_CHOSEN")) (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ( "Operation: An entry is promoted, but not high enough to cause inconsistent state. Response: It gets promoted. Other nodes keep their values" (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-rejected-id) (org-decisions-keep-sensible:th:manual :from "RESPONSE:" :to "NOT_CHOSEN") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Leaning_towards becomes Chosen. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-leaning-id) (org-decisions-keep-sensible:th:manual :from "LEANING_TOWARDS" :to "CHOSEN") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-simple-parent-id) '("NOT_CHOSEN""REJECTED""CHOSEN""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Rejected becomes Leaning_towards. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-rejected-id) (org-decisions-keep-sensible:th:manual :from "REJECTED" :to "LEANING_TOWARDS") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-simple-parent-id) '("MAYBE""LEANING_TOWARDS""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was medium-high-marked; it's not high enough to be keeping other nodes down below the default. Operation: That entry is demoted one place. LEANING_TOWARDS becomes MAYBE. Response: It gets demoted. Other nodes are unchanged." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-leaning-id) (org-decisions-keep-sensible:th:manual :from "LEANING_TOWARDS" :to "MAYBE") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-simple-parent-id) '("MAYBE""REJECTED""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted one place. CHOSEN becomes LEANING_TOWARDS. Response: It gets demoted. Nodes that it was holding down are promoted. NOT_CHOSEN becomes MAYBE." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-w-1-chosen :id test-org-decisions:thd:file-w-1-chosen-sib-chosen-id) (org-decisions-keep-sensible:th:manual :from "CHOSEN" :to "LEANING_TOWARDS") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-w-1-chosen-parent-id) '( "MAYBE" "REJECTED" "LEANING_TOWARDS" "MAYBE")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted two places. CHOSEN becomes MAYBE. Response: It gets demoted. Nodes that it was holding down are promoted as if by two one-place operations. NOT_CHOSEN becomes MAYBE." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-w-1-chosen :id test-org-decisions:thd:file-w-1-chosen-sib-chosen-id) (org-decisions-keep-sensible:th:manual :from "CHOSEN" :to "MAYBE") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-w-1-chosen-parent-id) '("MAYBE" "REJECTED" "MAYBE" "MAYBE")))) ;;No tests for the situation where a node is demoted to the middle ;;of the upper range and should both potentially raise some others ;;and lower some others. It's unlikely to be an important ;;situation. YAGNI. ;;Tests of org-decisions after having been insinuated ;;Implicit operations of `org-todo' ( "Operation: An entry is implicitly promoted. Response: It gets promoted to the next value." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-rejected-id) (org-todo) (equal (org-entry-get (point) "TODO") "NOT_CHOSEN"))) ( "Operation: An entry is implicitly promoted, but not high enough to cause inconsistent state. Response: It gets promoted. Other nodes keep their values" (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-rejected-id) (org-todo) (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ;;Tests that operations still behave after insinuation the same as ;;they did manually. ( "Operation: An entry is explicitly promoted, but not high enough to cause inconsistent state. Response: It gets promoted. Other nodes keep their values" (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-rejected-id) (org-todo "NOT_CHOSEN") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Leaning_towards becomes Chosen. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-leaning-id) (org-todo "CHOSEN") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-simple-parent-id) '("NOT_CHOSEN""REJECTED""CHOSEN""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Rejected becomes Leaning_towards. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-rejected-id) (org-todo "LEANING_TOWARDS") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-simple-parent-id) '("MAYBE""LEANING_TOWARDS""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was medium-high-marked; it's not high enough to be keeping other nodes down below the default. Operation: That entry is demoted one place. LEANING_TOWARDS becomes MAYBE. Response: It gets demoted." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-simple :id test-org-decisions:thd:file-simple-sib-leaning-id) (org-todo "MAYBE") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-simple-parent-id) '("MAYBE""REJECTED""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted one place. CHOSEN becomes LEANING_TOWARDS. Response: It gets demoted. Nodes that it was holding down are promoted. NOT_CHOSEN becomes MAYBE." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-w-1-chosen :id test-org-decisions:thd:file-w-1-chosen-sib-chosen-id) (org-todo "LEANING_TOWARDS") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-w-1-chosen-parent-id) '( "MAYBE" "REJECTED" "LEANING_TOWARDS" "MAYBE")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted two places. CHOSEN becomes MAYBE. Response: It gets demoted. Nodes that it was holding down are promoted as if by two one-place operations. NOT_CHOSEN becomes MAYBE." (org-decisions:th:in-buffer-at (:file test-org-decisions:thd:file-w-1-chosen :id test-org-decisions:thd:file-w-1-chosen-sib-chosen-id) (org-todo "MAYBE") (equal (org-decisions:th:collect-childrens-todo-marks test-org-decisions:thd:file-w-1-chosen-parent-id) '("MAYBE" "REJECTED" "MAYBE" "MAYBE")))) ) ;;;_. Footers ;;;_ , Provides (provide 'test-org-decisions) ;;;_ * Local emacs vars. ;;;_ + Local variables: ;;;_ + End: ;;;_ , End ;;; test-org-decisions.el ends here [-- Attachment #5: simple.org --] [-- Type: application/octet-stream, Size: 575 bytes --] #+CHOOSE_TODO: REJECTED(r) NOT_CHOSEN(n,-) MAYBE(,0) LEANING_TOWARDS(l) CHOSEN(c,+) * Parent :PROPERTIES: :ID: a13a4b6f-02d6-445c-a38e-7e51b9ba29d4 :END: ** MAYBE Sib maybe :PROPERTIES: :ID: 67a7cbba-c78b-47fe-886a-08a80f67e4ab :END: ** REJECTED Sib rejected :PROPERTIES: :ID: 953d4524-f15e-4198-ab33-5769732f51ad :END: ** LEANING_TOWARDS Sib leaning :PROPERTIES: :ID: be01f611-6175-4e40-a3b5-525a9c1e3b4d :END: ** NOT_CHOSEN Sib not-chosen :PROPERTIES: :ID: b7760ac9-e0bf-41a0-9661-720d42670432 :END: [-- Attachment #6: w-1-chosen.org --] [-- Type: application/octet-stream, Size: 485 bytes --] #+CHOOSE_TODO: REJECTED(r) NOT_CHOSEN(n,-) MAYBE(,0) LEANING_TOWARDS(l) CHOSEN(c,+) * Parent :PROPERTIES: :ID: b2a6f78c-6199-461b-9850-18980b85b1ab :END: ** NOT_CHOSEN sib-not-chosen-a :PROPERTIES: :ID: b390f9b1-57d0-4a17-9811-47b49fee196f :END: ** REJECTED sib 2 ** CHOSEN sib-chosen :PROPERTIES: :ID: c0958364-1f99-4dfc-a671-f21bb5f708bb :END: ** MAYBE sib-maybe :PROPERTIES: :ID: 5a449704-494c-412f-b21d-8ffe07b8092c :END: [-- Attachment #7: w-2-types.org --] [-- Type: application/octet-stream, Size: 359 bytes --] #+CHOOSE_TODO: REJECTED(r) NOT_CHOSEN(n,-) MAYBE(,0) LEANING_TOWARDS(l) CHOSEN(c,+) #+CHOOSE_TODO: NO MAYBE_YN(,0) YES * Header line ** LEANING_TOWARDS :PROPERTIES: :ID: c8e7d7af-15a2-4650-a604-50ade52bd06c :END: ** REJECTED ** YES :PROPERTIES: :ID: 02e917f5-ac3d-477f-baf5-7eb7c8961683 :END: ** MAYBE_YN ** MAYBE ** NO ** YES [-- Attachment #8: nonautomatic.org --] [-- Type: application/octet-stream, Size: 183 bytes --] #+CHOOSE_TODO: NO MAYBE_YN(,0) YES * Using a non-automatic set of marks ** MAYBE_YN ** YES :PROPERTIES: :ID: 6a27cc97-6e65-4c4e-9014-7fbcf27f52fa :END: ** YES ** NO [-- Attachment #9: no-sibs.org --] [-- Type: application/octet-stream, Size: 193 bytes --] #+CHOOSE_TODO: REJECTED(r) NOT_CHOSEN(n,-) MAYBE(,0) LEANING_TOWARDS(l) CHOSEN(c,+) * Header lines ** The sole entry :PROPERTIES: :ID: 78fb63fa-4fad-4c7f-aa4a-954ee3431754 :END: [-- Attachment #10: w-some-nils.org --] [-- Type: application/octet-stream, Size: 320 bytes --] #+CHOOSE_TODO: REJECTED(r) NOT_CHOSEN(n,-) MAYBE(,0) LEANING_TOWARDS(l) CHOSEN(c,+) * Header line ** CHOSEN entry :PROPERTIES: :ID: a4e52131-1145-49f5-8b4b-dc4264900a05 :END: ** No mark here :PROPERTIES: :ID: d9729468-db22-4870-8969-9500da63d560 :END: ** NOT_CHOSEN ** No mark here either [-- Attachment #11: Type: text/plain, Size: 204 bytes --] _______________________________________________ Emacs-orgmode mailing list Remember: use `Reply All' to send replies to the list. Emacs-orgmode@gnu.org http://lists.gnu.org/mailman/listinfo/emacs-orgmode ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Advice sought on managing decision alternatives. 2009-01-31 4:21 ` Tom Breton (Tehom) @ 2009-01-31 5:41 ` Carsten Dominik 2009-01-31 18:36 ` Tom Breton (Tehom) 2009-02-06 13:08 ` Carsten Dominik 1 sibling, 1 reply; 13+ messages in thread From: Carsten Dominik @ 2009-01-31 5:41 UTC (permalink / raw) To: Tom Breton (Tehom); +Cc: emacs-orgmode Hi Tom, this looks awesome. Right now I am stabilizing everything to make my final release for Emacs 23.1, so it may be a week or two before I get to integrate this. Also, I am interested in the testing environment, and what you made here may end up to be enough to establish a testing framework for Org-mode. If it turns out to be like this, maybe you can make a tutorial on test creation and put that up on Worg? I would be willing to put the code needed for the testing environment into the contrib directory. - Carsten On Jan 31, 2009, at 5:21 AM, Tom Breton (Tehom) wrote: > Here is org-decisions. "All 68 tests ran successfully". I hope it is > satisfactory. If it's not, please let me know. > > Please find attached: > * org-decisions.el > * diffs to org.el > * test-org-decisions.el. > * 6 example files in testing > > A few notes: > > ****** Test files > > I included 6 example files that I used in testing, and my test file > test-org-decisions.el. > > test-org-decisions.el uses my tester rtest, which is unfortunately in > flux at the moment. Still, I felt it would be best to make it > publicly available. > > ****** Use of cl > > I used cl in org-decisions.el. I hope that's not a problem, but if it > is I can rewrite the parts that use cl. > > * pushnew > * position > * destructuring-bind > * defstruct > > ****** Use of allout > > org-decisions.el and test-org-decisions.el use allout for structuring. > I removed the "mode: allout" line so that they can be read without > allout present. > > Tom Breton (Tehom) > <org-decisions.el><org.el.diff><test-org- > decisions.el><simple.org><w-1-chosen.org><w-2- > types.org><nonautomatic.org><no-sibs.org><w-some-nils.org> ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Advice sought on managing decision alternatives. 2009-01-31 5:41 ` Carsten Dominik @ 2009-01-31 18:36 ` Tom Breton (Tehom) 0 siblings, 0 replies; 13+ messages in thread From: Tom Breton (Tehom) @ 2009-01-31 18:36 UTC (permalink / raw) Cc: emacs-orgmode > Hi Tom, > > this looks awesome. > > Right now I am stabilizing everything to make my final release > for Emacs 23.1, so it may be a week or two before I get to > integrate this. Understood. > Also, I am interested in the testing environment, and what > you made here may end up to be enough to establish a testing > framework for Org-mode. > If it turns out to be like this, maybe you can make a tutorial > on test creation and put that up on Worg? I would be willing > to put the code needed for the testing environment into the > contrib directory. Certainly. One thing, once my testing package rtest is in a stable state, I plan to release it on its own, possibly as a sourceforge project. But I have no objection to you also putting in the org contrib directory. Tom Breton (Tehom) ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Advice sought on managing decision alternatives. 2009-01-31 4:21 ` Tom Breton (Tehom) 2009-01-31 5:41 ` Carsten Dominik @ 2009-02-06 13:08 ` Carsten Dominik 2009-02-06 20:07 ` Tom Breton (Tehom) 1 sibling, 1 reply; 13+ messages in thread From: Carsten Dominik @ 2009-02-06 13:08 UTC (permalink / raw) To: Tom Breton (Tehom); +Cc: emacs-orgmode Hi Tom, I am now looking at org-decision and start to integrate it. There is one point I'd like to discuss. My preferred way to do the integration is opening a new hacking door which will not require changes to org.el for other people doing similar stuff. So my idea would be to search for "^#\\+\\(\\([a-zA-Z]+\\)_\\)?TODO" when scanning the buffer, i.e. that any keyword could precede TODO in such a line. I would then like to call the filter hook, using that keyword as interpretation. WIth you patch, we have right now CHOOSE as the prefix choseness as the interpretation org-decision as the name of the module. My request would be to maybe use `choose' also as the interpretation symbol, or, alternatively, CHOSENESS as the prefix. For customizing org-todo-keywords, instead of explicitly offering `choseness', maybe we can use a symbol field where people can type into. That would turn your patch into a generally useful system of hooks where other ideas could be implemented as well. What do you think? - Carsten On Jan 31, 2009, at 5:21 AM, Tom Breton (Tehom) wrote: > Here is org-decisions. "All 68 tests ran successfully". I hope it is > satisfactory. If it's not, please let me know. > > Please find attached: > * org-decisions.el > * diffs to org.el > * test-org-decisions.el. > * 6 example files in testing > > A few notes: > > ****** Test files > > I included 6 example files that I used in testing, and my test file > test-org-decisions.el. > > test-org-decisions.el uses my tester rtest, which is unfortunately in > flux at the moment. Still, I felt it would be best to make it > publicly available. > > ****** Use of cl > > I used cl in org-decisions.el. I hope that's not a problem, but if it > is I can rewrite the parts that use cl. > > * pushnew > * position > * destructuring-bind > * defstruct > > ****** Use of allout > > org-decisions.el and test-org-decisions.el use allout for structuring. > I removed the "mode: allout" line so that they can be read without > allout present. > > Tom Breton (Tehom) > <org-decisions.el><org.el.diff><test-org- > decisions.el><simple.org><w-1-chosen.org><w-2- > types.org><nonautomatic.org><no-sibs.org><w-some-nils.org> ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Advice sought on managing decision alternatives. 2009-02-06 13:08 ` Carsten Dominik @ 2009-02-06 20:07 ` Tom Breton (Tehom) 2009-02-07 0:18 ` Carsten Dominik 0 siblings, 1 reply; 13+ messages in thread From: Tom Breton (Tehom) @ 2009-02-06 20:07 UTC (permalink / raw) Cc: emacs-orgmode > Hi Tom, > [...] > WIth you patch, we have right now > > CHOOSE as the prefix > choseness as the interpretation > org-decision as the name of the module. > > My request would be to maybe use `choose' also as the > interpretation symbol, or, alternatively, CHOSENESS > as the prefix. Yes. I think "choose" is best; the ambiguity between "chosenness" and "choseness" just invited difficulties. Always feel free to suggest alternatives to my naming. Sometimes my initial ideas go in a funny direction. Eg, my initial thinking, which I now abandon, was: * org-DECISIONS.el because it supports decisions. * CHOSENNESS because it's the property the item has of being chosen or not. As William observed, it's grammatically correct but rare. * CHOOSE because I saw that CHOSENNESS has problems. So "choose" it is. I'd like to rename the file org-choose.el as well, now that I think about the naming. Do you want a patch for it? > For customizing org-todo-keywords, instead of explicitly > offering `choseness', maybe we can use a symbol field > where people can type into. It's more flexible but offers less support to the user. Maybe we can have the best of both worlds by restricting the choice to interpretations that available modules support. Ie, something like this: * Object: a variable that holds the names of the interpretation symbols, or of the ones that aren't built in. * Behavior: interested modules add their interpretation symbol to the list * Behavior: When customizing org-todo-keywords, offer the symbols from that list as choices for interpretation symbols. The primary difficulty would be getting widgets to understand that. > That would turn your patch into a generally useful system > of hooks where other ideas could be implemented as well. > > What do you think? Sounds good to me. Tom Breton (Tehom) ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Advice sought on managing decision alternatives. 2009-02-06 20:07 ` Tom Breton (Tehom) @ 2009-02-07 0:18 ` Carsten Dominik 2009-02-07 20:46 ` Tom Breton (Tehom) 0 siblings, 1 reply; 13+ messages in thread From: Carsten Dominik @ 2009-02-07 0:18 UTC (permalink / raw) To: Tom Breton (Tehom); +Cc: emacs-orgmode Hi Tom, On Feb 6, 2009, at 9:07 PM, Tom Breton (Tehom) wrote: >> Hi Tom, >> [...] > >> WIth you patch, we have right now >> >> CHOOSE as the prefix >> choseness as the interpretation >> org-decision as the name of the module. >> >> My request would be to maybe use `choose' also as the >> interpretation symbol, or, alternatively, CHOSENESS >> as the prefix. > > Yes. I think "choose" is best; the ambiguity between "chosenness" and > "choseness" just invited difficulties. > > Always feel free to suggest alternatives to my naming. Sometimes my > initial ideas go in a funny direction. Eg, my initial thinking, > which I > now abandon, was: > > * org-DECISIONS.el because it supports decisions. > * CHOSENNESS because it's the property the item has of being chosen > or not. > As William observed, it's grammatically correct but rare. > * CHOOSE because I saw that CHOSENNESS has problems. > > So "choose" it is. I'd like to rename the file org-choose.el as > well, now > that I think about the naming. Good. > > > Do you want a patch for it? Yes, against current org.el, please, if you do not mind, because I have not yet applied your earlier patch. > > >> For customizing org-todo-keywords, instead of explicitly >> offering `choseness', maybe we can use a symbol field >> where people can type into. > > It's more flexible but offers less support to the user. Maybe we > can have > the best of both worlds by restricting the choice to interpretations > that > available modules support. Ie, something like this: > > * Object: a variable that holds the names of the interpretation > symbols, > or of the ones that aren't built in. > * Behavior: interested modules add their interpretation symbol to > the list > * Behavior: When customizing org-todo-keywords, offer the symbols from > that list as choices for interpretation symbols. This sounds perfect. > The primary difficulty would be getting widgets to understand that. Yes. Right now, I do not know how to do this, therefore my more primitive proposal. Yours is better, if you can make the widget work... - Carsten > > > >> That would turn your patch into a generally useful system >> of hooks where other ideas could be implemented as well. >> >> What do you think? > > Sounds good to me. > > Tom Breton (Tehom) > > > > ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Advice sought on managing decision alternatives. 2009-02-07 0:18 ` Carsten Dominik @ 2009-02-07 20:46 ` Tom Breton (Tehom) 2009-02-08 13:06 ` Carsten Dominik 0 siblings, 1 reply; 13+ messages in thread From: Tom Breton (Tehom) @ 2009-02-07 20:46 UTC (permalink / raw) Cc: emacs-orgmode [-- Attachment #1: Type: text/plain, Size: 1678 bytes --] Hi, Carsten. Here is the new patch to org.el and the new org-choose.el A couple of notes: * As we talked about, "decisions" and "chosenness" are now called "choose" everywhere. * I was able to add the library-aware customization we talked about. * I also added new variable `org-todo-normal-interpretations' - see explanation below. * New test file. Essentially the same, with name replacement. * Didn't append the example files; they are all unchanged from before. ******* About `org-todo-normal-interpretations' You said your idea was to make a generally useful system. I noticed that one thing was still hard-coded. It's the part of org-todo that finds the next entry: (memq interpret '(sequence choose)) ... (memq interpret '(type priority)) If I understand your intentions correctly, new TODO modules should always behave like `sequence' in this respect. So the first line now looks at a variable list. I saw two possible approaches to get this list: * Extract the symbol from `org-todo-interpretations'. It's in there, but: * Con: Of the two obvious ways to extract it, neither is good 1. Parse the widget form the way that wid-edit does, which is hairy 2. Have a policy that every module that adds to it has to put the symbol first, which changes the appearance of widgets and invites mistakes. * Add yet another variable to contain all the "normal" interpretation symbols. I have tentatively chosen the second and coded it. I named the variable `org-todo-normal-interpretations' (as always, feel free to suggest a better name). Tom Breton (Tehom) [-- Attachment #2: org.el.diff --] [-- Type: application/octet-stream, Size: 6650 bytes --] *** old-org.el 2009-01-04 03:01:50.000000000 -0500 --- org.el 2009-02-07 15:13:57.000000000 -0500 *************** *** 1409,1414 **** --- 1409,1426 ---- :tag "Org Progress" :group 'org-time) + (defvar org-todo-interpretation-widgets + '( + (:tag "Sequence (cycling hits every state)" sequence) + (:tag "Type (cycling directly to DONE)" type)) + + "The available interpretation symbols for customizing + `org-todo-keywords'. + Interested libraries should add to this list." ) + (defvar org-todo-normal-interpretations + '(sequence) + "" ) + (defcustom org-todo-keywords '((sequence "TODO" "DONE")) "List of TODO entry keyword sequences and their interpretation. \\<org-mode-map>This is a list of sequences. *************** *** 1458,1465 **** (cons (choice :tag "Interpretation" ! (const :tag "Sequence (cycling hits every state)" sequence) ! (const :tag "Type (cycling directly to DONE)" type)) (repeat (string :tag "Keyword")))))) --- 1470,1487 ---- (cons (choice :tag "Interpretation" ! ;;Quick and dirty way to see ! ;;`org-todo-interpretations'. This takes the ! ;;place of item arguments ! :convert-widget ! (lambda (widget) ! (widget-put widget ! :args (mapcar ! #'(lambda (x) ! (widget-convert ! (cons 'const x))) ! org-todo-interpretation-widgets)) ! widget)) (repeat (string :tag "Keyword")))))) *************** *** 3025,3031 **** (org-set-local 'org-file-properties nil) (org-set-local 'org-file-tags nil) (let ((re (org-make-options-regexp ! '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE"))) (splitre "[ \t]+") --- 3047,3053 ---- (org-set-local 'org-file-properties nil) (org-set-local 'org-file-tags nil) (let ((re (org-make-options-regexp ! '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "CHOOSE_TODO" "COLUMNS" "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE"))) (splitre "[ \t]+") *************** *** 3052,3057 **** --- 3074,3081 ---- (push (cons 'sequence (org-split-string value splitre)) kwds)) ((equal key "TYP_TODO") (push (cons 'type (org-split-string value splitre)) kwds)) + ((equal key "CHOOSE_TODO") + (push (cons 'choose (org-split-string value splitre)) kwds)) ((equal key "TAGS") (setq tags (append tags (org-split-string value splitre)))) ((equal key "COLUMNS") *************** *** 3133,3138 **** --- 3157,3168 ---- (setq kwds (nreverse kwds)) (let (inter kws kw) (while (setq kws (pop kwds)) + (let + ((kws + (or + (run-hook-with-args-until-success + 'org-todo-setup-filter-hook kws) + kws))) (setq inter (pop kws) sep (member "|" kws) kws0 (delete "|" (copy-sequence kws)) kwsa nil *************** *** 3154,3160 **** '((:endgroup)))) hw (car kws1) dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) ! tail (list inter hw (car dws) (org-last dws))) (add-to-list 'org-todo-heads hw 'append) (push kws1 org-todo-sets) (setq org-done-keywords (append org-done-keywords dws nil)) --- 3184,3190 ---- '((:endgroup)))) hw (car kws1) dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) ! tail (list inter hw (car dws) (org-last dws)))) (add-to-list 'org-todo-heads hw 'append) (push kws1 org-todo-sets) (setq org-done-keywords (append org-done-keywords dws nil)) *************** *** 4934,4944 **** (org-back-to-heading) (outline-previous-heading) (looking-at org-todo-line-regexp)) (if (or arg (not (match-beginning 2)) (member (match-string 2) org-done-keywords)) ! (insert (car org-todo-keywords-1) " ") ! (insert (match-string 2) " ")) (when org-provide-todo-statistics (org-update-parent-todo-statistics)))) --- 4964,4983 ---- (org-back-to-heading) (outline-previous-heading) (looking-at org-todo-line-regexp)) + (let* + ((new-mark-x (if (or arg (not (match-beginning 2)) (member (match-string 2) org-done-keywords)) ! (car org-todo-keywords-1) ! (match-string 2))) ! (new-mark ! (or ! (run-hook-with-args-until-success ! 'org-todo-get-default-hook new-mark-x nil) ! new-mark-x))) ! (insert new-mark " ")) ! (when org-provide-todo-statistics (org-update-parent-todo-statistics)))) *************** *** 8190,8195 **** --- 8229,8246 ---- :from previous state (keyword as a string), or nil :to new state (keyword as a string), or nil") + (defvar org-todo-setup-filter-hook nil + "Hook for functions that pre-filter todo specs. + + Each function takes a todo spec and returns either `nil' or the spec + transformed into canonical form." ) + + (defvar org-todo-get-default-hook nil + "Hook for functions that get a default item for todo. + + Each function takes arguments (NEW-MARK OLD-MARK) and returns either + `nil' or a string to be used for the todo mark." ) + (defvar org-agenda-headline-snapshot-before-repeat) (defun org-todo (&optional arg) "Change the TODO state of an item. *************** *** 8285,8291 **** ((null member) (or head (car org-todo-keywords-1))) ((equal this final-done-word) nil) ;; -> make empty ((null tail) nil) ;; -> first entry ! ((eq interpret 'sequence) (car tail)) ((memq interpret '(type priority)) (if (eq this-command last-command) --- 8336,8342 ---- ((null member) (or head (car org-todo-keywords-1))) ((equal this final-done-word) nil) ;; -> make empty ((null tail) nil) ;; -> first entry ! ((memq interpret org-todo-normal-interpretations) (car tail)) ((memq interpret '(type priority)) (if (eq this-command last-command) *************** *** 8294,8299 **** --- 8345,8354 ---- (or done-word (car org-done-keywords)) nil))) (t nil))) + (state (or + (run-hook-with-args-until-success + 'org-todo-get-default-hook state last-state) + state)) (next (if state (concat " " state " ") " ")) (change-plist (list :type 'todo-state-change :from this :to state :position startpos)) [-- Attachment #3: org-choose.el --] [-- Type: application/octet-stream, Size: 12531 bytes --] ;;;_ org-choose.el --- decision management for org-mode ;;;_. Headers ;;;_ , License ;; Copyright (C) 2009 Tom Breton (Tehom) ;; Author: Tom Breton (Tehom) ;; Keywords: ;; 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 2, or (at your option) ;; any later version. ;; This file 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., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;;_ , Commentary: ;; ;;;_ , Requires (require 'org) (eval-when-compile (require 'cl)) ;;;_. Body ;;;_ , The variables (defstruct (org-choose-mark-data. (:type list)) "The format of an entry in org-choose-mark-data. Indexes are 0-based or `nil'. " keyword bot-lower-range top-upper-range range-length static-default all-keywords) (defvar org-choose-mark-data () "Alist of information for choose marks. Each entry is an `org-choose-mark-data.'" ) (make-variable-buffer-local 'org-choose-mark-data) ;;;_ , For setup ;;;_ . org-choose-filter-one (defun org-choose-filter-one (i) "Return a list of * a canonized version of the string * optionally one symbol" (if (not (string-match "(.*)" i)) (list i i) (let* ( (end-text (match-beginning 0)) (vanilla-text (substring i 0 end-text)) ;;Get the parenthesized part. (match (match-string 0 i)) ;;Remove the parentheses. (args (substring match 1 -1)) ;;Split it (arglist (let ((arglist-x (split-string args ","))) ;;When string starts with "," `split-string' doesn't ;;make a first arg, so in that case make one ;;manually. (if (string-match "^," args) (cons nil arglist-x) arglist-x))) (decision-arg (second arglist)) (type (cond ((string= decision-arg "0") 'default-mark) ((string= decision-arg "+") 'top-upper-range) ((string= decision-arg "-") 'bot-lower-range) (t nil))) (vanilla-arg (first arglist)) (vanilla-mark (if vanilla-arg (concat vanilla-text "("vanilla-arg")") vanilla-text))) (if type (list vanilla-text vanilla-mark type) (list vanilla-text vanilla-mark))))) ;;;_ . org-choose-setup-vars (defun org-choose-setup-vars (bot-lower-range top-upper-range static-default num-items all-mark-texts) "Add to org-choose-mark-data according to arguments" (let* ( (tail ;;If there's no bot-lower-range or no default, we don't ;;have ranges. (cdr (if (and static-default bot-lower-range) (let* ( ;;If there's no top-upper-range, use the last ;;item. (top-upper-range (or top-upper-range (1- num-items))) (lower-range-length (1+ (- static-default bot-lower-range))) (upper-range-length (- top-upper-range static-default)) (range-length (min upper-range-length lower-range-length))) (make-org-choose-mark-data. :keyword nil :bot-lower-range bot-lower-range :top-upper-range top-upper-range :range-length range-length :static-default static-default :all-keywords all-mark-texts)) (make-org-choose-mark-data. :keyword nil :bot-lower-range nil :top-upper-range nil :range-length nil :static-default (or static-default 0) :all-keywords all-mark-texts))))) (dolist (text all-mark-texts) (pushnew (cons text tail) org-choose-mark-data :test #'(lambda (a b) (equal (car a) (car b))))))) ;;;_ . org-choose-filter-tail (defun org-choose-filter-tail (raw) "Return a translation of RAW to vanilla and set appropriate buffer-local variables. RAW is a list of strings representing the input text of a choose interpretation." (let ((vanilla-list nil) (all-mark-texts nil) (index 0) bot-lower-range top-upper-range range-length static-default) (dolist (i raw) (destructuring-bind (vanilla-text vanilla-mark &optional type) (org-choose-filter-one i) (cond ((eq type 'bot-lower-range) (setq bot-lower-range index)) ((eq type 'top-upper-range) (setq top-upper-range index)) ((eq type 'default-mark) (setq static-default index))) (incf index) (push vanilla-text all-mark-texts) (push vanilla-mark vanilla-list))) (org-choose-setup-vars bot-lower-range top-upper-range static-default index (reverse all-mark-texts)) (nreverse vanilla-list))) ;;;_ . org-choose-setup-filter (defun org-choose-setup-filter (raw) "A setup filter for choose interpretations." (when (eq (car raw) 'choose) (cons 'choose (org-choose-filter-tail (cdr raw))))) ;;;_ . org-choose-conform-after-promotion (defun org-choose-conform-after-promotion (entry-pos keywords highest-ok-ix) "" (unless ;;Skip the entry that triggered this by skipping any entry with ;;the same starting position. Both map and plist use the start ;;of the header line as the position, so we can just compare ;;them with `=' (= (point) entry-pos) (let ((ix (org-choose-get-entry-index keywords))) ;;If the index of the entry exceeds the highest allowable ;;index, change it to that. (when (and ix (> ix highest-ok-ix)) (org-todo (nth highest-ok-ix keywords)))))) ;;;_ . org-choose-conform-after-demotion (defun org-choose-conform-after-demotion (entry-pos keywords raise-to-ix old-highest-ok-ix) "" (unless ;;Skip the entry that triggered this. (= (point) entry-pos) (let ((ix (org-choose-get-entry-index keywords))) ;;If the index of the entry was at or above the old allowable ;;position, change it to the new mirror position if there is ;;one. (when (and ix raise-to-ix (>= ix old-highest-ok-ix)) (org-todo (nth raise-to-ix keywords)))))) ;;;_ , org-choose-keep-sensible (the trigger-hook function) (defun org-choose-keep-sensible (change-plist) "" (let* ( (from (plist-get change-plist :from)) (to (plist-get change-plist :to)) (entry-pos (set-marker (make-marker) (plist-get change-plist :position))) (kwd-data (assoc to org-todo-kwd-alist))) (when (eq (nth 1 kwd-data) 'choose) (let* ( (data (assoc to org-choose-mark-data)) (keywords (org-choose-mark-data.-all-keywords data)) (old-index (org-choose-get-index-in-keywords from keywords)) (new-index (org-choose-get-index-in-keywords to keywords)) (highest-ok-ix (org-choose-highest-other-ok new-index data)) (funcdata (cond ;;The entry doesn't participate in conformance, ;;so give `nil' which does nothing. ((not highest-ok-ix) nil) ;;The entry was created or promoted ((or (not old-index) (> new-index old-index)) (list #'org-choose-conform-after-promotion entry-pos keywords highest-ok-ix)) (t ;;Otherwise the entry was demoted. (let ( (raise-to-ix (min highest-ok-ix (org-choose-mark-data.-static-default data))) (old-highest-ok-ix (org-choose-highest-other-ok old-index data))) (list #'org-choose-conform-after-demotion entry-pos keywords raise-to-ix old-highest-ok-ix)))))) (if funcdata ;;The funny-looking names are to make variable capture ;;unlikely. (Poor-man's lexical bindings). (destructuring-bind (func-d473 . args-46k) funcdata (let ((map-over-entries (org-choose-get-fn-map-group)) ;;We may call `org-todo', so let various hooks ;;`nil' so we don't cause loops. org-after-todo-state-change-hook org-trigger-hook org-blocker-hook org-todo-get-default-hook ;;Also let this alist `nil' so we don't log ;;secondary transitions. org-todo-log-states) ;;Map over group (funcall map-over-entries #'(lambda () (apply func-d473 args-46k)))))))) ;;Remove the marker (set-marker entry-pos nil))) ;;;_ , Getting the default mark ;;;_ . org-choose-get-index-in-keywords (defun org-choose-get-index-in-keywords (ix all-keywords) "Return index of current entry." (if ix (position ix all-keywords :test #'equal))) ;;;_ . org-choose-get-entry-index (defun org-choose-get-entry-index (all-keywords) "Return index of current entry." (let* ((state (org-entry-get (point) "TODO"))) (org-choose-get-index-in-keywords state all-keywords))) ;;;_ . org-choose-get-fn-map-group (defun org-choose-get-fn-map-group () "Return a function to map over the group" #'(lambda (fn) (save-excursion (outline-up-heading-all 1) (save-restriction (org-map-entries fn nil 'tree))))) ;;;_ . org-choose-get-highest-mark-index (defun org-choose-get-highest-mark-index (keywords) "Get the index of the highest current mark in the group. If there is none, return 0" (let* ( ;;Func maps over applicable entries. (map-over-entries (org-choose-get-fn-map-group)) (indexes-list (remove nil (funcall map-over-entries #'(lambda () (org-choose-get-entry-index keywords)))))) (if indexes-list (apply #'max indexes-list) 0))) ;;;_ . org-choose-highest-ok (defun org-choose-highest-other-ok (ix data) "" (let ( (bot-lower-range (org-choose-mark-data.-bot-lower-range data)) (top-upper-range (org-choose-mark-data.-top-upper-range data)) (range-length (org-choose-mark-data.-range-length data))) (when (and ix bot-lower-range) (let* ((delta (- top-upper-range ix))) (unless (< range-length delta) (+ bot-lower-range delta)))))) ;;;_ . org-choose-get-default-mark-index (defun org-choose-get-default-mark-index (data) "Get the index of the default mark in a choose interpretation. Args are in the same order as the fields of `org-choose-mark-data.' and have the same meaning." (or (let ((highest-mark-index (org-choose-get-highest-mark-index (org-choose-mark-data.-all-keywords data)))) (org-choose-highest-other-ok highest-mark-index data)) (org-choose-mark-data.-static-default data))) ;;;_ . org-choose-get-mark-N (defun org-choose-get-mark-N (n data) "Get the text of the nth mark in a choose interpretation." (let* ((l (org-choose-mark-data.-all-keywords data))) (nth n l))) ;;;_ . org-choose-get-default-mark (defun org-choose-get-default-mark (new-mark old-mark) "Get the default mark IFF in a choose interpretation. NEW-MARK and OLD-MARK are the text of the new and old marks." (let* ( (old-kwd-data (assoc old-mark org-todo-kwd-alist)) (new-kwd-data (assoc new-mark org-todo-kwd-alist)) (becomes-choose (and (or (not old-kwd-data) (not (eq (nth 1 old-kwd-data) 'choose))) (eq (nth 1 new-kwd-data) 'choose)))) (when becomes-choose (let ((new-mark-data (assoc new-mark org-choose-mark-data))) (if new-mark (org-choose-get-mark-N (org-choose-get-default-mark-index new-mark-data) new-mark-data) (error "Somehow got an unrecognizable mark")))))) ;;;_ , Setting it all up (eval-after-load 'org (progn (add-to-list 'org-todo-setup-filter-hook #'org-choose-setup-filter) (add-to-list 'org-todo-get-default-hook #'org-choose-get-default-mark) (add-to-list 'org-trigger-hook #'org-choose-keep-sensible) (add-to-list 'org-todo-interpretation-widgets '(:tag "Choose (to record decisions)" choose)) (add-to-list 'org-todo-normal-interpretations 'choose))) ;;;_. Footers ;;;_ , Provides (provide 'org-choose) ;;;_ * Local emacs vars. ;;;_ + Local variables: ;;;_ + End: ;;;_ , End ;;; org-choose.el ends here [-- Attachment #4: test-org-choose.el --] [-- Type: application/octet-stream, Size: 45687 bytes --] ;;;_ test-org-choose.el --- Test code for org-choose ;;;_. Headers ;;;_ , License ;; Copyright (C) 2009 Tom Breton (Tehom) ;; Author: Tom Breton (Tehom) <tehom@localhost.localdomain> ;; Keywords: lisp ;; 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 2, or (at your option) ;; any later version. ;; This file 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., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;;_ , Commentary: ;; ;;;_ , Requires (require 'rtest-define) (require 'mockbuf) (require 'el-mock) (require 'org) (require 'org-id) (require 'org-choose) ;;;_. Body ;;;_ , Example files (defconst test-org-choose:th:examples-dir (rtest:expand-filename-by-load-file "examples") "Directory where examples are" ) (rtest:defexample test-org-choose:thd:file-simple (expand-file-name "simple.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:file-w-1-chosen (expand-file-name "w-1-chosen.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:file-nonautomatic (expand-file-name "nonautomatic.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:file-w-2-types (expand-file-name "w-2-types.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:file-w-some-nils (expand-file-name "w-some-nils.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:file-nosibs (expand-file-name "no-sibs.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:nofile-1-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-choose:thd:nofile-1-raw-marks '(choose "REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN") "Raw marks") (rtest:defexample test-org-choose:thd:nofile-1-output-marks '(choose "REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN") "Output marks") (rtest:defexample test-org-choose:thd:nofile-1-setup-args (list nil nil nil 5 test-org-choose:thd:nofile-1-list-o-marks) "Arguments given to org-choose-setup-vars" ) (rtest:defexample test-org-choose:thd:nofile-1-mark-data (mapcar #'(lambda (x) (make-org-choose-mark-data. :keyword x :bot-lower-range nil :top-upper-range nil :range-length nil :static-default 0 :all-keywords test-org-choose:thd:nofile-1-list-o-marks)) test-org-choose:thd:nofile-1-list-o-marks) "The mark data corresponding to nofile-1") (rtest:defexample test-org-choose:thd:nofile-2-list-o-marks '("ZERO" "ONE" "TWO" "THREE" "FOUR" "FIVE" "SIX")) (rtest:defexample test-org-choose:thd:nofile-2-raw-marks '(choose "ZERO" "ONE" "TWO(b)" "THREE(c,-)" "FOUR(d,0)" "FIVE(e,+)" "SIX(,)") "Raw marks") (rtest:defexample test-org-choose:thd:nofile-2-output-marks '(choose "ZERO" "ONE" "TWO(b)" "THREE(c)" "FOUR(d)" "FIVE(e)" "SIX") "Output marks") (rtest:defexample test-org-choose:thd:nofile-2-setup-args (list 3 5 4 7 test-org-choose:thd:nofile-2-list-o-marks) "Arguments given to org-choose-setup-vars" ) (rtest:defexample test-org-choose:thd:nofile-2-mark-data (mapcar #'(lambda (x) (make-org-choose-mark-data. :keyword x :bot-lower-range 3 :top-upper-range 5 :range-length 1 :static-default 4 :all-keywords test-org-choose:thd:nofile-2-list-o-marks)) test-org-choose:thd:nofile-2-list-o-marks) "The mark data corresponding to nofile example 2") ;;An example of one that's not automatically managed (rtest:defexample test-org-choose:thd:nofile-3-raw-marks '(sequence "ZERO" "ONE" "TWO(b)" "THREE(c)" "FOUR(d)" "FIVE(e)" "SIX") "Input marks") (rtest:defexample test-org-choose:thd:nofile-3-output-marks nil "Output marks") ;;An example where the top of the range is implicit (rtest:defexample test-org-choose:thd:nofile-4-list-o-marks '("ZERO" "ONE" "TWO" "THREE" "FOUR" "FIVE" "SIX")) (rtest:defexample test-org-choose:thd:nofile-4-raw-marks '(choose "ZERO" "ONE" "TWO(b)" "THREE(c,-)" "FOUR(d,0)" "FIVE(e)" "SIX") "Input marks") (rtest:defexample test-org-choose:thd:nofile-4-setup-args (list 3 nil 4 7 test-org-choose:thd:nofile-4-list-o-marks) "Arguments given to org-choose-setup-vars") (rtest:defexample test-org-choose:thd:nofile-4-mark-data (mapcar #'(lambda (x) (make-org-choose-mark-data. :keyword x :bot-lower-range 3 :top-upper-range 6 :range-length 2 :static-default 4 :all-keywords test-org-choose:thd:nofile-4-list-o-marks)) test-org-choose:thd:nofile-4-list-o-marks) "The mark data corresponding to nofile example 2") (rtest:defexample test-org-choose:thd:nofile-4-kwd-alist (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'choose "ZERO" "SIX" "SIX")) test-org-choose:thd:nofile-4-list-o-marks)) (rtest:defexample test-org-choose:thd:file-simple-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-choose:thd:file-simple-setup-args (list 1 4 2 5 test-org-choose:thd:file-simple-list-o-marks) "Arguments given to org-choose-setup-vars" ) (rtest:defexample test-org-choose:thd:file-simple-mark-data (mapcar #'(lambda (x) (make-org-choose-mark-data. :keyword x :bot-lower-range 1 :top-upper-range 4 :range-length 2 :static-default 2 :all-keywords test-org-choose:thd:file-simple-list-o-marks)) test-org-choose:thd:file-simple-list-o-marks) "The mark data corresponding to file1") (rtest:defexample test-org-choose:thd:file-simple-high-ix 3) (rtest:defexample test-org-choose:thd:file-simple-sib-maybe-id "67a7cbba-c78b-47fe-886a-08a80f67e4ab" "ID of a sibling") (rtest:defexample test-org-choose:thd:file-simple-sib-maybe-ix 2 "Mark index of that sibling") (rtest:defexample test-org-choose:thd:file-simple-sib-rejected-id "953d4524-f15e-4198-ab33-5769732f51ad" "ID of another sibling") (rtest:defexample test-org-choose:thd:file-simple-sib-leaning-id "be01f611-6175-4e40-a3b5-525a9c1e3b4d" "ID of another sibling") (rtest:defexample test-org-choose:thd:file-simple-sib-not-chosen-id "b7760ac9-e0bf-41a0-9661-720d42670432" "ID of another sibling") (rtest:defexample test-org-choose:thd:file-simple-parent-id "a13a4b6f-02d6-445c-a38e-7e51b9ba29d4" "ID of the parent of those nodes") (rtest:defexample test-org-choose:thd:file-simple-original-marks '("MAYBE""REJECTED""LEANING_TOWARDS""NOT_CHOSEN")) (rtest:defexample test-org-choose:thd:file-w-1-chosen-mark-data test-org-choose:thd:file-simple-mark-data) (rtest:defexample test-org-choose:thd:file-w-1-chosen-high-ix 4) (rtest:defexample test-org-choose:thd:file-w-1-chosen-sib-not-chosen-a-id "b390f9b1-57d0-4a17-9811-47b49fee196f" "ID of a not-chosen sibling") (rtest:defexample test-org-choose:thd:file-w-1-chosen-sib-maybe-id "5a449704-494c-412f-b21d-8ffe07b8092c" "ID of another not-chosen sibling") (rtest:defexample test-org-choose:thd:file-w-1-chosen-sib-chosen-id "c0958364-1f99-4dfc-a671-f21bb5f708bb" "ID of the chosen sibling") (rtest:defexample test-org-choose:thd:file-w-1-chosen-parent-id "b2a6f78c-6199-461b-9850-18980b85b1ab") (rtest:defexample test-org-choose:thd:file-w-1-chosen-list-o-marks test-org-choose:thd:file-simple-list-o-marks) (rtest:defexample test-org-choose:thd:file-w-1-chosen-original-marks '("NOT_CHOSEN" "REJECTED" "CHOSEN " "MAYBE")) (rtest:defexample test-org-choose:thd:file-nonautomatic-list-o-marks '("NO" "MAYBE_YN" "YES")) (rtest:defexample test-org-choose:thd:file-nonautomatic-raw-marks '(choose "NO" "MAYBE_YN(,0)" "YES")) (rtest:defexample test-org-choose:thd:file-nonautomatic-setup-args (list nil nil 1 3 test-org-choose:thd:file-nonautomatic-list-o-marks) "Arguments given to org-choose-setup-vars") (rtest:defexample test-org-choose:thd:file-nonautomatic-high-ix 2) (rtest:defexample test-org-choose:thd:file-nonautomatic-sib-yes-id "6a27cc97-6e65-4c4e-9014-7fbcf27f52fa") (rtest:defexample test-org-choose:thd:file-nonautomatic-mark-data (mapcar #'(lambda (x) (make-org-choose-mark-data. :keyword x :bot-lower-range nil :top-upper-range nil :range-length nil :static-default 1 :all-keywords test-org-choose:thd:file-nonautomatic-list-o-marks) ) test-org-choose:thd:file-nonautomatic-list-o-marks) "The mark data corresponding to file3") (rtest:defexample test-org-choose:thd:context:kwd-alist-normal-todo (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'sequence "TODO" "DONE" "DONE")) '("TODO" "DONE")) "A kwd-alist that includes only the 2 normal TODO marks. NB, this is context. It is not *produced* by any test code, it is used to control what marks are understood." ) (rtest:defexample test-org-choose:thd:context:kwd-alist (append test-org-choose:thd:context:kwd-alist-normal-todo (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'choose "NO" "YES" "YES")) test-org-choose:thd:file-nonautomatic-list-o-marks)) "A kwd-alist to combines 2 normal TODO marks and the file-nonautomatic marks. NB, this is not *produced* by any test code, it is used to control what marks are understood." ) (rtest:defexample test-org-choose:thd:context:kwd-alist-simple (append test-org-choose:thd:context:kwd-alist-normal-todo (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'choose "REJECTED" "CHOSEN" "CHOSEN")) test-org-choose:thd:file-simple-list-o-marks)) "A kwd-alist that includes the marks in simple.org plus 2 normal TODO marks. NB, this is context. It is not *produced* by any test code, it is used to control what marks are understood." ) (rtest:defexample test-org-choose:thd:file-w-2-types-mark-data (append test-org-choose:thd:file-simple-mark-data test-org-choose:thd:file-nonautomatic-mark-data)) (rtest:defexample test-org-choose:thd:file-w-2-types-t1-high-ix 3) (rtest:defexample test-org-choose:thd:file-w-2-types-t1-leaning-id "c8e7d7af-15a2-4650-a604-50ade52bd06c") (rtest:defexample test-org-choose:thd:file-w-2-types-t1-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-choose:thd:file-w-2-types-t2-high-ix 2) (rtest:defexample test-org-choose:thd:file-w-2-types-t2-yes-id "02e917f5-ac3d-477f-baf5-7eb7c8961683") (rtest:defexample test-org-choose:thd:file-w-2-types-t2-list-o-marks '("YES" "MAYBE_YN" "NO")) (rtest:defexample test-org-choose:thd:file-w-some-nils-high-ix 4) (rtest:defexample test-org-choose:thd:file-w-some-nils-sib-marked-id "a4e52131-1145-49f5-8b4b-dc4264900a05") (rtest:defexample test-org-choose:thd:file-w-some-nils-sib-nil-id "d9729468-db22-4870-8969-9500da63d560") (rtest:defexample test-org-choose:thd:file-w-some-nils-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-choose:thd:file-nosibs-sib "78fb63fa-4fad-4c7f-aa4a-954ee3431754") (rtest:defexample test-org-choose:thd:file-nosibs-high-ix 0) ;;;_ , Tests of org-choose-filter-one (rtest:defexample test-org-choose:thd:singlemark-1-input-output '("ONE(,0)" ("ONE" "ONE" default-mark)) "Pairs of single marks: Input and output" ) (rtest:defexample test-org-choose:thd:singlemark-2-input-output '("TWO" ("TWO" "TWO")) "Pairs of single marks: Input and output" ) (rtest:defexample test-org-choose:thd:singlemark-3-input-output '("THREE(b)" ("THREE" "THREE(b)")) "Pairs of single marks: Input and output") (rtest:defexample test-org-choose:thd:singlemark-4-input-output '("FOUR(c,0)" ("FOUR" "FOUR(c)" default-mark)) "Pairs of single marks: Input and output") (rtest:defexample test-org-choose:thd:singlemark-5-input-output '("FIVE(d,+)" ("FIVE" "FIVE(d)" top-upper-range)) "Pairs of single marks: Input and output") (rtest:defexample test-org-choose:thd:singlemark-6-input-output '("SIX(e,-)" ("SIX" "SIX(e)" bot-lower-range)) "Pairs of single marks: Input and output") (rtest:defexample test-org-choose:thd:singlemark-7-input-output '("SEVEN(,)" ("SEVEN" "SEVEN")) "Pairs of single marks: Input and output") (rtest:defexample test-org-choose:thd:singlemark-8-input-output '("EIGHT(x!/@,)" ("EIGHT" "EIGHT(x!/@)")) "Pairs of single marks: Input and output") (rtest:deftest org-choose-filter-one ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-1-input-output)) (second test-org-choose:thd:singlemark-1-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-2-input-output)) (second test-org-choose:thd:singlemark-2-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-3-input-output)) (second test-org-choose:thd:singlemark-3-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-4-input-output)) (second test-org-choose:thd:singlemark-4-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-5-input-output)) (second test-org-choose:thd:singlemark-5-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-6-input-output)) (second test-org-choose:thd:singlemark-6-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-7-input-output)) (second test-org-choose:thd:singlemark-7-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-8-input-output)) (second test-org-choose:thd:singlemark-8-input-output))) ) ;;;_ , Tests of org-choose-setup-vars (rtest:deftest org-choose-setup-vars ( "The `*-setup-args' examples are proper args to `org-choose-setup-vars'. It sets org-choose-mark-data correspondingly." (with-temp-buffer (apply #'org-choose-setup-vars test-org-choose:thd:nofile-1-setup-args) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-1-mark-data))) ( "The `*-setup-args' examples are proper args to `org-choose-setup-vars'. It sets org-choose-mark-data correspondingly." (with-temp-buffer (apply #'org-choose-setup-vars test-org-choose:thd:nofile-2-setup-args) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-2-mark-data))) ( "The `*-setup-args' examples are proper args to `org-choose-setup-vars'. It sets org-choose-mark-data correspondingly." (with-temp-buffer (apply #'org-choose-setup-vars test-org-choose:thd:nofile-4-setup-args) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-4-mark-data))) ( "The `*-setup-args' examples are proper args to `org-choose-setup-vars'. It sets org-choose-mark-data correspondingly." (with-temp-buffer (apply #'org-choose-setup-vars test-org-choose:thd:file-simple-setup-args) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-simple-mark-data))) ( "The `*-setup-args' examples are proper args to `org-choose-setup-vars'. It sets org-choose-mark-data correspondingly." (with-temp-buffer (apply #'org-choose-setup-vars test-org-choose:thd:file-nonautomatic-setup-args) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data))) ) ;;;_ , Tests of the setup filter (rtest:deftest org-choose-setup-filter ;;I'd like to have also tested that output is conformant. But ;;AFAICT no existing predicate reports that, so I'll only test that ;;output matches what's expected, which I'll eyeball. ( "Situation: Called manually, passed data with another interpretation. Response: Return value is `nil'." (equal (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-3-raw-marks)) test-org-choose:thd:nofile-3-output-marks)) ( "Situation: Called manually, passed known data. Response: Return value is as expected." (equal (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-1-raw-marks)) test-org-choose:thd:nofile-1-output-marks)) ( "Situation: Called manually, passed known data. Response: Return value is as expected." (equal (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-2-raw-marks)) test-org-choose:thd:nofile-2-output-marks)) ( "Situation: Called manually, passed known data. Response: Variables have been set up as expected." (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-1-raw-marks) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-1-mark-data))) ( "Situation: Called manually, passed known data. Response: Variables have been set up as expected." (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-2-raw-marks) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-2-mark-data))) ( "Situation: Called manually, passed known data. Response: Variables have been set up as expected." (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-4-raw-marks) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-4-mark-data))) ( "Situation: In temp buffer, given the same marks as for file 3. Response: `org-choose-mark-data' have been set up as expected." (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:file-nonautomatic-raw-marks) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data))) ( "Situation: `org-choose-mark-data' has already been set with marks from this set Response: `org-choose-mark-data' gets the expected value and nothing extra." (with-temp-buffer (let ((org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data)) (org-choose-setup-filter test-org-choose:thd:file-nonautomatic-raw-marks) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data)))) ( "Situation: `org-choose-mark-data' has already been set with marks from another set Response: `org-choose-mark-data' gets the new marks and keeps the marks from the other set." (with-temp-buffer (let ((org-choose-mark-data test-org-choose:thd:file-simple-mark-data)) (org-choose-setup-filter test-org-choose:thd:file-nonautomatic-raw-marks) (rtest:sets= org-choose-mark-data (append test-org-choose:thd:file-simple-mark-data test-org-choose:thd:file-nonautomatic-mark-data))))) ;;Insinuated tests, so that setup filter is called automatically by ;;setup. ( "Situation: In example file 1. Response: `org-choose-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-choose:thd:file-simple) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-simple-mark-data))) ( "Situation: In example file 2. Response: `org-choose-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-choose:thd:file-w-1-chosen) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-w-1-chosen-mark-data))) ( "Situation: In example file 3. Response: `org-choose-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-choose:thd:file-nonautomatic) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data))) ( "Situation: In example file 4. Response: `org-choose-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-choose:thd:file-w-2-types) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-w-2-types-mark-data)))) ;;;_ , Tests of the function to get default ;;;_ . Test helper ;;;_ . org-choose:th:in-buffer-at (defmacro* org-choose:th:in-buffer-at ((&key file id) &rest body) "" `(with-buffer-containing-object (:file ,file) ;;Have to show entries otherwise we might fail to go to them. (show-all) ;;Go to one of the entries. Use `org-find-entry-with-id' so we ;;can't accidentally leave this file, as we could with ;;`org-id-find'. (goto-char (org-find-entry-with-id ,id)) ,@body)) ;;;_ , Tests (put 'org-choose:th:in-buffer-at 'rtest:test-thru 'org-choose-get-entry-index) ;;;_ . org-choose-get-entry-index (rtest:deftest org-choose-get-entry-index ;;These tests are tests after insinuation. ( "Situation: Point is in a marked entry. Response: Return the index of that entry." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id) (equal (org-choose-get-entry-index test-org-choose:thd:file-simple-list-o-marks) test-org-choose:thd:file-simple-sib-maybe-ix))) ( "Situation: Point is in a unmarked entry (nil). Response: Return nil." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-some-nils :id test-org-choose:thd:file-w-some-nils-sib-nil-id) (equal (org-choose-get-entry-index test-org-choose:thd:file-w-some-nils-list-o-marks) nil))) ( "Situation: Point is in an entry with a mark from a different set. Response: Return nil." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-2-types :id test-org-choose:thd:file-w-2-types-t2-yes-id) (equal (org-choose-get-entry-index test-org-choose:thd:file-w-2-types-t1-list-o-marks) nil))) ) ;;;_ . org-choose-get-highest-mark-index (rtest:deftest org-choose-get-highest-mark-index ( "Situation: Point is in one of the sibling entries Response: Returns the highest index." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-simple-list-o-marks) test-org-choose:thd:file-simple-high-ix))) ( "Situation: Point is in a different one of the sibling entries Response: Returns the highest index." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-simple-list-o-marks) test-org-choose:thd:file-simple-high-ix))) ( "Situation: Point is in one of the sibling entries Response: Returns the highest index." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-not-chosen-a-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-w-1-chosen-list-o-marks) test-org-choose:thd:file-w-1-chosen-high-ix))) ( "Situation: Point is in one of the sibling entries Response: Returns the highest index." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-nonautomatic :id test-org-choose:thd:file-nonautomatic-sib-yes-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-nonautomatic-list-o-marks) test-org-choose:thd:file-nonautomatic-high-ix))) ( "Situation: Point is in one of the sibling entries of one type. Response: Returns the highest index of siblings of that type, ignoring the others." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-2-types :id test-org-choose:thd:file-w-2-types-t1-leaning-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-w-2-types-t1-list-o-marks) test-org-choose:thd:file-w-2-types-t1-high-ix))) ( "Situation: Point is in one of the sibling entries of one type, in a sibling group that has 2 types. Response: Returns the highest index of siblings of that type, ignoring the others." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-2-types :id test-org-choose:thd:file-w-2-types-t2-yes-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-w-2-types-t2-list-o-marks) test-org-choose:thd:file-w-2-types-t2-high-ix))) ( "Situation: Point is in one of the sibling entries. Some entries are nil. Response: Returns the highest index, ignoring the `nil's." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-some-nils :id test-org-choose:thd:file-w-some-nils-sib-marked-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-w-some-nils-list-o-marks) test-org-choose:thd:file-w-some-nils-high-ix))) ( "Situation: There are no entries of choose type. Response: Return 0" (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-nosibs :id test-org-choose:thd:file-nosibs-sib) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-simple-list-o-marks) 0))) ) ;;;_ . org-choose-get-default-mark-index (put 'org-choose-get-default-mark-index 'rtest:test-thru 'org-choose-get-default-mark) ;;;_ . org-choose-get-mark-N (rtest:deftest org-choose-get-mark-N ( "Behavior: Gets the corresponding mark from the set." (let ((org-choose-mark-data test-org-choose:thd:nofile-4-mark-data)) (equal (org-choose-get-mark-N 0 (assoc "ONE" org-choose-mark-data)) "ZERO"))) ( "Behavior: Gets the corresponding mark from the set." (let ((org-choose-mark-data test-org-choose:thd:nofile-4-mark-data)) (equal (org-choose-get-mark-N 4 (assoc "THREE" org-choose-mark-data)) "FOUR"))) ) ;;;_ . org-choose-get-default-mark ;;;_ , Test helpers (defun org-choose-get-default-mark-index:th (new-mark mark-data) "Test helper" (org-choose-get-default-mark-index (assoc new-mark mark-data))) (defun org-choose:th:collect-childrens-todo-marks (parent-id) "" (save-excursion (show-all) ;;In case anything got hidden (goto-char (org-find-entry-with-id parent-id)) (save-restriction (org-map-entries #'(lambda () (org-entry-get (point) "TODO")) nil 'tree)))) ;;;_ . Tests of org-choose:th:collect-childrens-todo-marks (rtest:deftest org-choose:th:collect-childrens-todo-marks ("Situation: In a known file. Param: The id of the parent entry. Response: Returns the TODO marks of the children." (with-buffer-containing-object (:file test-org-choose:thd:file-simple) (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) test-org-choose:thd:file-simple-original-marks)))) ;;;_ , Tests (rtest:deftest org-choose-get-default-mark ( "Situation: we're not going into a choose type Response: Return nil, signalling to use the mark we were going to." (let ((org-todo-kwd-alist test-org-choose:thd:context:kwd-alist)) (equal (org-choose-get-default-mark nil "DONE") nil))) ( "Situation: We were already in a choose type. Response: Return nil, signalling to use the mark we were going to." (let ((org-todo-kwd-alist test-org-choose:thd:context:kwd-alist)) (equal (org-choose-get-default-mark "YES" "MAYBE_YN") nil))) ;;These tests test the index return for ;;`org-choose-get-default-mark-index' and also test the string ;;return for `org-choose-get-default-mark'. Combining the tests ;;under `and' is not good style but I don't want to write each ;;setup twice. ( "Situation: there are no ranges. Response: return the static default." (let ((org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data) (org-todo-kwd-alist test-org-choose:thd:context:kwd-alist)) (with-mock (stub org-choose-get-highest-mark-index => nil) (and (equal (org-choose-get-default-mark-index:th "NO" test-org-choose:thd:file-nonautomatic-mark-data) 1) (equal (org-choose-get-default-mark "NO" nil) "MAYBE_YN"))))) ( "Situation: no current mark is in the upper range. Response: return the static default." (let ((org-choose-mark-data test-org-choose:thd:nofile-4-mark-data) (org-todo-kwd-alist test-org-choose:thd:nofile-4-kwd-alist)) (with-mock (stub org-choose-get-highest-mark-index => 2) (and (equal (org-choose-get-default-mark-index:th "ONE" test-org-choose:thd:nofile-4-mark-data) 4) (equal (org-choose-get-default-mark "ONE" nil) "FOUR") )))) ;;Because the static default is at or above the top of lower range, ;;any mirror-wise constraint is a stronger constraint than it. So ;;no additional test is needed for the interaction between those ;;two constraints. ( "Situation: a current mark is in the upper range. Response: return an accordingly lower index.." (let ((org-choose-mark-data test-org-choose:thd:nofile-4-mark-data) (org-todo-kwd-alist test-org-choose:thd:nofile-4-kwd-alist)) (with-mock (stub org-choose-get-highest-mark-index => 6) (and (equal (org-choose-get-default-mark-index:th "ONE" test-org-choose:thd:nofile-4-mark-data) 3) (equal (org-choose-get-default-mark "ONE" nil) "THREE"))))) ("Situation: Point is on a heading. The only type of TODO in this buffer is a choose type. The default type is MAYBE. No sibling mark is higher than LEANING_TOWARDS. Operation: Add a new todo heading. Result: It then has the mark MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id) (org-insert-todo-heading 1) (equal (org-entry-get (point) "TODO") "MAYBE"))) ("Situation: Point is on a heading with no mark. The only type of TODO in this buffer is a choose type. The default type is MAYBE. No sibling mark is higher than LEANING_TOWARDS. Operation: Add a todo mark to the heading. Result: It then has the mark MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id) (org-insert-heading) (org-todo) (equal (org-entry-get (point) "TODO") "MAYBE"))) ("Situation: Point is on a heading. The only type of TODO in this buffer is a choose type. The default type is MAYBE. A sibling mark is CHOSEN The mark NOT_CHOSEN mirrors the mark CHOSEN. Operation: Add a todo mark to the heading. Result: It then has the mark NOT_CHOSEN." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-not-chosen-a-id) (org-insert-heading) (org-todo) (equal (org-entry-get (point) "TODO") "NOT_CHOSEN")))) ;;;_ , Tests of the trigger function ;;;_ . org-choose-conform-after-promotion ;;;_ , Test helper (defun* org-choose-conform-after-promotion:th (&key file id mark-data other-was other-changed-to expect demoted) "" (org-choose:th:in-buffer-at (:file file :id id) (let* ( (data (or (assoc other-changed-to mark-data) (error "Mark-data should contain the entry being changed to"))) (keywords (org-choose-mark-data.-all-keywords data)) (index (org-choose-get-index-in-keywords other-changed-to keywords)) (old-index (when other-was (org-choose-get-index-in-keywords other-was keywords)))) (if demoted (org-choose-conform-after-demotion 0 ;;Fake position that matches nothing keywords (let ((new-highest (org-choose-highest-other-ok index data)) (static-default (org-choose-mark-data.-static-default data))) (if new-highest (min new-highest static-default) static-default)) (org-choose-highest-other-ok old-index data)) (org-choose-conform-after-promotion 0 ;;Fake position that matches nothing keywords (org-choose-highest-other-ok index data)))) (equal (org-entry-get (point) "TODO") expect))) ;;;_ , Tests (rtest:deftest org-choose-conform-after-promotion ( "Situation: Entry's mark is from some other workflow state. Response: Do nothing." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-w-2-types :id test-org-choose:thd:file-w-2-types-t2-yes-id :mark-data test-org-choose:thd:file-w-2-types-mark-data :other-changed-to "CHOSEN" :expect "YES")) ( "Situation: Entry's mark is already lower than the highest allowed index. Response: No change." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id :mark-data test-org-choose:thd:file-simple-mark-data :other-changed-to "CHOSEN" :expect "REJECTED")) ( "Situation: Entry's mark is higher than the highest allowed index. Response: Demote it." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-leaning-id :mark-data test-org-choose:thd:file-simple-mark-data :other-changed-to "LEANING_TOWARDS" :expect "MAYBE")) ) ;;;_ . org-choose-conform-after-demotion ;;;_ , Tests (rtest:deftest org-choose-conform-after-demotion ( "Situation: The other entry was not keeping this node below the default. Response: This node is unchanged." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id :mark-data test-org-choose:thd:file-simple-mark-data :other-was "LEANING_TOWARDS" :other-changed-to "MAYBE" :demoted t :expect "MAYBE")) ( "Situation: The other entry was keeping this node below the default. Response: This node is promoted." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id :mark-data test-org-choose:thd:file-simple-mark-data :other-was "LEANING_TOWARDS" :other-changed-to "CHOSEN" :demoted t :expect "NOT_CHOSEN")) ( "Situation: The other entry was keeping this node below the default. It was just demoted quite low. Response: This node is promoted only to the default." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-not-chosen-id :mark-data test-org-choose:thd:file-simple-mark-data :other-was "CHOSEN" :other-changed-to "REJECTED" :demoted t :expect "MAYBE")) ) ;;;_ . org-choose-keep-sensible ;;;_ , Helper (defun* org-choose-keep-sensible:th:manual (&key from to) "" (let (org-blocker-hook) (org-todo to) (org-choose-keep-sensible (list :from from :to to :position (point-at-bol))))) ;;;_ , Tests (rtest:deftest org-choose-keep-sensible ;;Non-insinuated tests, `org-choose-keep-sensible' is just ;;called manually. ( "Operation: An entry's todo mark is changed into a TODO from some other workflow state. Response: No change to our entries." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (let ((org-todo-kwd-alist test-org-choose:thd:context:kwd-alist-simple)) (org-choose-keep-sensible:th:manual :from "RESPONSE:" :to "NOT_CHOSEN")) (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ( "Operation: An entry is promoted, but not high enough to cause inconsistent state. Response: It gets promoted. Other nodes keep their values" (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-choose-keep-sensible:th:manual :from "RESPONSE:" :to "NOT_CHOSEN") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Leaning_towards becomes Chosen. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-leaning-id) (org-choose-keep-sensible:th:manual :from "LEANING_TOWARDS" :to "CHOSEN") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("NOT_CHOSEN""REJECTED""CHOSEN""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Rejected becomes Leaning_towards. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-choose-keep-sensible:th:manual :from "REJECTED" :to "LEANING_TOWARDS") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""LEANING_TOWARDS""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was medium-high-marked; it's not high enough to be keeping other nodes down below the default. Operation: That entry is demoted one place. LEANING_TOWARDS becomes MAYBE. Response: It gets demoted. Other nodes are unchanged." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-leaning-id) (org-choose-keep-sensible:th:manual :from "LEANING_TOWARDS" :to "MAYBE") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""REJECTED""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted one place. CHOSEN becomes LEANING_TOWARDS. Response: It gets demoted. Nodes that it was holding down are promoted. NOT_CHOSEN becomes MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-chosen-id) (org-choose-keep-sensible:th:manual :from "CHOSEN" :to "LEANING_TOWARDS") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-w-1-chosen-parent-id) '( "MAYBE" "REJECTED" "LEANING_TOWARDS" "MAYBE")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted two places. CHOSEN becomes MAYBE. Response: It gets demoted. Nodes that it was holding down are promoted as if by two one-place operations. NOT_CHOSEN becomes MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-chosen-id) (org-choose-keep-sensible:th:manual :from "CHOSEN" :to "MAYBE") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-w-1-chosen-parent-id) '("MAYBE" "REJECTED" "MAYBE" "MAYBE")))) ;;No tests for the situation where a node is demoted to the middle ;;of the upper range and should both potentially raise some others ;;and lower some others. It's unlikely to be an important ;;situation. YAGNI. ;;Tests of org-choose after having been insinuated ;;Implicit operations of `org-todo' ( "Operation: An entry is implicitly promoted. Response: It gets promoted to the next value." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-todo) (equal (org-entry-get (point) "TODO") "NOT_CHOSEN"))) ( "Operation: An entry is implicitly promoted, but not high enough to cause inconsistent state. Response: It gets promoted. Other nodes keep their values" (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-todo) (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ;;Tests that operations still behave after insinuation the same as ;;they did manually. ( "Operation: An entry is explicitly promoted, but not high enough to cause inconsistent state. Response: It gets promoted. Other nodes keep their values" (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-todo "NOT_CHOSEN") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Leaning_towards becomes Chosen. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-leaning-id) (org-todo "CHOSEN") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("NOT_CHOSEN""REJECTED""CHOSEN""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Rejected becomes Leaning_towards. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-todo "LEANING_TOWARDS") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""LEANING_TOWARDS""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was medium-high-marked; it's not high enough to be keeping other nodes down below the default. Operation: That entry is demoted one place. LEANING_TOWARDS becomes MAYBE. Response: It gets demoted." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-leaning-id) (org-todo "MAYBE") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""REJECTED""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted one place. CHOSEN becomes LEANING_TOWARDS. Response: It gets demoted. Nodes that it was holding down are promoted. NOT_CHOSEN becomes MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-chosen-id) (org-todo "LEANING_TOWARDS") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-w-1-chosen-parent-id) '( "MAYBE" "REJECTED" "LEANING_TOWARDS" "MAYBE")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted two places. CHOSEN becomes MAYBE. Response: It gets demoted. Nodes that it was holding down are promoted as if by two one-place operations. NOT_CHOSEN becomes MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-chosen-id) (org-todo "MAYBE") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-w-1-chosen-parent-id) '("MAYBE" "REJECTED" "MAYBE" "MAYBE")))) ) ;;;_. Footers ;;;_ , Provides (provide 'test-org-choose) ;;;_ * Local emacs vars. ;;;_ + Local variables: ;;;_ + End: ;;;_ , End ;;; test-org-choose.el ends here [-- Attachment #5: Type: text/plain, Size: 204 bytes --] _______________________________________________ Emacs-orgmode mailing list Remember: use `Reply All' to send replies to the list. Emacs-orgmode@gnu.org http://lists.gnu.org/mailman/listinfo/emacs-orgmode ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Advice sought on managing decision alternatives. 2009-02-07 20:46 ` Tom Breton (Tehom) @ 2009-02-08 13:06 ` Carsten Dominik 2009-02-08 20:25 ` Tom Breton (Tehom) 0 siblings, 1 reply; 13+ messages in thread From: Carsten Dominik @ 2009-02-08 13:06 UTC (permalink / raw) To: Tom Breton (Tehom); +Cc: emacs-orgmode Hi Tom, I have now added org-choose.el, it is part of the current git status. A few comments: On Feb 7, 2009, at 9:46 PM, Tom Breton (Tehom) wrote: > > Hi, Carsten. Here is the new patch to org.el and the new > org-choose.el > > A couple of notes: > > * As we talked about, "decisions" and "chosenness" are now called > "choose" everywhere. Great. > > * I was able to add the library-aware customization we talked about. This is nice, I earned something new! :convert-widget..... > > * I also added new variable `org-todo-normal-interpretations' - see > explanation below. See my comments below > > * New test file. Essentially the same, with name replacement. I have not run the tests myself yet. > > * Didn't append the example files; they are all unchanged from before. > > ******* About `org-todo-normal-interpretations' > > You said your idea was to make a generally useful system. I noticed > that one thing was still hard-coded. It's the part of org-todo that > finds the next entry: > > (memq interpret '(sequence choose)) > ... > (memq interpret '(type priority)) Yes, this is correct. I appreciate you noticing this additional point where changes have to be made. However, for now I have opted for a different solution: I made the sequence interpretation the last test in the cond chain, so that all interpretations that are not `type' will fall back to this mechanism. I envision that we can add another hook if someone wants an additional way of handling this. I would like to minimize the number of variables where an add-on has to insert itself. I have commented the corresponding line which tries to add to the non-existing variable org-todo-normal-interpretations' in org-choose.el I hope you agree with this solution, if not let me know. I think what is missing now is documentation. It seems to me that there should be some minimal documentation in org-choose.el, and it would be great to get a tutorial on Worg which describes this in more detail. Thanks a lot for this contribution, and for your precision and attention to detail. - Carsten ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Advice sought on managing decision alternatives. 2009-02-08 13:06 ` Carsten Dominik @ 2009-02-08 20:25 ` Tom Breton (Tehom) 2009-02-09 6:42 ` Carsten Dominik 0 siblings, 1 reply; 13+ messages in thread From: Tom Breton (Tehom) @ 2009-02-08 20:25 UTC (permalink / raw) To: Carsten Dominik; +Cc: emacs-orgmode, Tom Breton > Hi Tom, > > I have now added org-choose.el, it is part of the current git status. > > A few comments: > [...] > Yes, this is correct. I appreciate you noticing this additional > point where changes have to be made. > However, for now I have opted for a different solution: I made the > sequence interpretation the last test in the cond chain, so that > all interpretations that are not `type' will fall back to this > mechanism. Great, that's better than my solution. > > I think what is missing now is documentation. It seems to me that > there should be some minimal documentation in org-choose.el, > and it would be great to get a tutorial on Worg which describes > this in more detail. What sort of format are you looking for? [From other email] > I also changed the call to add to the interpretation types > for the widget so that it appends its value to the list, > rather than adding to the front. Hope you agree, > I made this change right in contrib/lisp/org-choose.el Good. It occurred to me shortly after I sent the file that it would be better to append. Tom Breton (Tehom) ^ permalink raw reply [flat|nested] 13+ messages in thread
* Re: Advice sought on managing decision alternatives. 2009-02-08 20:25 ` Tom Breton (Tehom) @ 2009-02-09 6:42 ` Carsten Dominik 0 siblings, 0 replies; 13+ messages in thread From: Carsten Dominik @ 2009-02-09 6:42 UTC (permalink / raw) To: Tom Breton (Tehom); +Cc: emacs-orgmode Hi Tom, On Feb 8, 2009, at 9:25 PM, Tom Breton (Tehom) wrote: >> >> I think what is missing now is documentation. It seems to me that >> there should be some minimal documentation in org-choose.el, >> and it would be great to get a tutorial on Worg which describes >> this in more detail. > > What sort of format are you looking for? Well, some ASCII documentation could be inserted into org-choose.el as a file commentary. If you use a standard header with keywords for the finder (M-x finder-commentary and friends), that would be useful. Tutorials on Worg are usually written in Org, but you can upload any format you like (or send it it me) and we wil publish it there. - Carsten ^ permalink raw reply [flat|nested] 13+ messages in thread
end of thread, other threads:[~2009-02-09 7:31 UTC | newest]
Thread overview: 13+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <20090122112819.B30E12940C@mail1.panix.com>
2009-01-22 22:11 ` Advice sought on managing decision alternatives Tom Breton (Tehom)
[not found] <20090101170227.C707734803@mail2.panix.com>
2009-01-01 22:53 ` Feature request and patch - blocked TODO to say BLOCKED Tom Breton (Tehom)
2009-01-09 8:16 ` Carsten Dominik
2009-01-19 3:33 ` Advice sought on managing decision alternatives Tom Breton (Tehom)
2009-01-22 11:15 ` Carsten Dominik
2009-01-31 4:21 ` Tom Breton (Tehom)
2009-01-31 5:41 ` Carsten Dominik
2009-01-31 18:36 ` Tom Breton (Tehom)
2009-02-06 13:08 ` Carsten Dominik
2009-02-06 20:07 ` Tom Breton (Tehom)
2009-02-07 0:18 ` Carsten Dominik
2009-02-07 20:46 ` Tom Breton (Tehom)
2009-02-08 13:06 ` Carsten Dominik
2009-02-08 20:25 ` Tom Breton (Tehom)
2009-02-09 6:42 ` Carsten Dominik
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/emacs/org-mode.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).