emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* 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.
       [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

* 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).