emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: "Tom Breton (Tehom)" <tehom@panix.com>
Cc: emacs-orgmode@gnu.org
Subject: Re: Advice sought on managing decision alternatives.
Date: Fri, 30 Jan 2009 23:21:12 -0500 (EST)	[thread overview]
Message-ID: <1057.24.63.22.246.1233375672.squirrel@mail.panix.com> (raw)
In-Reply-To: <E218B346-8A32-4D6E-83FD-5F1C95063DD4@uva.nl>

[-- 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

  reply	other threads:[~2009-01-31  4:21 UTC|newest]

Thread overview: 56+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [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-15  2:34     ` Tom Breton (Tehom)
2009-01-17  8:01       ` 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) [this message]
2009-01-31  5:41           ` Carsten Dominik
2009-01-31 18:36             ` Tom Breton (Tehom)
2009-02-01 15:54               ` James TD Smith
2009-02-06 13:08           ` Carsten Dominik
2009-02-06 16:16             ` William Henney
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
2009-02-10  3:14                         ` Docs submitted (Was Re: Advice sought on managing decision alternatives.) Tom Breton (Tehom)
2009-02-10  7:55                           ` Carsten Dominik
2009-02-24  0:51                             ` org-choose bugfix Tom Breton (Tehom)
2009-02-24  3:05                               ` Manish
2009-04-07  0:13                                 ` Tom Breton (Tehom)
2009-04-08 13:13                                   ` Carsten Dominik
2009-02-24  5:51                               ` Carsten Dominik
2009-02-10  8:46                           ` Docs submitted (Was Re: Advice sought on managing decision alternatives.) Manish
2009-02-10  9:12                             ` Carsten Dominik
2009-02-10 10:26                               ` Manish
2009-02-10 22:48                                 ` Tom Breton (Tehom)
2009-02-12 12:50                                   ` Manish
2009-02-12 20:13                                     ` Tom Breton (Tehom)
2009-02-13  4:23                                       ` Manish
2009-02-12 20:55                                     ` Patch " Tom Breton (Tehom)
2009-02-13  4:38                                       ` Manish
2009-02-11  1:08                                 ` Tom Breton (Tehom)
2009-02-11 10:34                                   ` Carsten Dominik
2009-02-11 21:41                                     ` Tom Breton (Tehom)
2009-02-11 23:38                                       ` Nick Dokos
2009-02-12  4:17                                         ` Tom Breton (Tehom)
2009-02-11 23:44                                       ` Carsten Dominik
2009-02-12  4:27                                         ` Tom Breton (Tehom)
2009-02-12 15:49                                           ` Nick Dokos
2009-02-12 20:32                                             ` Tom Breton (Tehom)
2009-02-12 21:25                                               ` Nick Dokos
2009-02-11 12:29                                   ` Carsten Dominik
2009-02-11 14:58                                     ` Docs submitted Bernt Hansen
2009-02-11 17:33                                       ` Samuel Wales
2009-02-11 15:38                                     ` Docs submitted (Was Re: Advice sought on managing decision alternatives.) Daniel Clemente
2009-02-11 15:41                                       ` Carsten Dominik
2009-02-11 20:02                                     ` Tom Breton (Tehom)
2009-02-11 23:45                                       ` Carsten Dominik
2009-02-11  1:45                                 ` Slight fix to update-org.sh Tom Breton (Tehom)
2009-02-10 23:19                               ` Docs submitted (Was Re: Advice sought on managing decision alternatives.) Tom Breton (Tehom)
2009-02-11 10:34                                 ` Carsten Dominik
2009-02-10 22:45                             ` Tom Breton (Tehom)
     [not found] <20090122112819.B30E12940C@mail1.panix.com>
2009-01-22 22:11 ` Advice sought on managing decision alternatives Tom Breton (Tehom)

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1057.24.63.22.246.1233375672.squirrel@mail.panix.com \
    --to=tehom@panix.com \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
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).