Add Tom Breton's org-choose.el as a contributed package
This commit is contained in:
Carsten Dominik
parent
36d39ad374
commit
56692965b7
|
|
@ -14,6 +14,7 @@ org-annotate-file.el --- Annotate a file with org syntax
|
|||
org-annotation-helper.el --- Call remember directly from Firefox/Opera
|
||||
org-bookmark.el --- Links to bookmarks
|
||||
org-browser-url.el --- Store links to webpages directly from Firefox/Opera
|
||||
org-choose.el --- Use TODO keywords to mark decision states
|
||||
org-depend.el --- TODO dependencies for Org-mode
|
||||
org-elisp-symbol.el --- Org links to emacs-lisp symbols
|
||||
org-eval.el --- The <lisp> tag, adapted from Muse
|
||||
|
|
|
|||
|
|
@ -0,0 +1,487 @@
|
|||
;;;_ 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))
|
||||
; CD (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
|
||||
114
lisp/org.el
114
lisp/org.el
|
|
@ -181,6 +181,7 @@ to add the symbol `xyz', and the package must have a call to
|
|||
(const :tag "C annotation-helper: Call Remember directly from Browser" org-annotation-helper)
|
||||
(const :tag "C bookmark: Org links to bookmarks" org-bookmark)
|
||||
(const :tag "C browser-url: Store link, directly from Browser" org-browser-url)
|
||||
(const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
|
||||
(const :tag "C depend: TODO dependencies for Org-mode" org-depend)
|
||||
(const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol)
|
||||
(const :tag "C eval: Include command output as text" org-eval)
|
||||
|
|
@ -1483,6 +1484,14 @@ fast, while still showing the whole path to the entry."
|
|||
: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.")
|
||||
|
||||
(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.
|
||||
|
|
@ -1532,8 +1541,18 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'."
|
|||
(cons
|
||||
(choice
|
||||
:tag "Interpretation"
|
||||
(const :tag "Sequence (cycling hits every state)" sequence)
|
||||
(const :tag "Type (cycling directly to DONE)" type))
|
||||
;;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"))))))
|
||||
|
||||
|
|
@ -3174,7 +3193,7 @@ means to push this value onto the list in the variable.")
|
|||
(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"
|
||||
'("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "CHOOSE_TODO" "COLUMNS"
|
||||
"STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES"
|
||||
"CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE")))
|
||||
(splitre "[ \t]+")
|
||||
|
|
@ -3201,6 +3220,8 @@ means to push this value onto the list in the variable.")
|
|||
(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")
|
||||
|
|
@ -3282,28 +3303,32 @@ means to push this value onto the list in the variable.")
|
|||
(setq kwds (nreverse kwds))
|
||||
(let (inter kws kw)
|
||||
(while (setq kws (pop kwds))
|
||||
(setq inter (pop kws) sep (member "|" kws)
|
||||
kws0 (delete "|" (copy-sequence kws))
|
||||
kwsa nil
|
||||
kws1 (mapcar
|
||||
(lambda (x)
|
||||
;; 1 2
|
||||
(if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x)
|
||||
(progn
|
||||
(setq kw (match-string 1 x)
|
||||
key (and (match-end 2) (match-string 2 x))
|
||||
log (org-extract-log-state-settings x))
|
||||
(push (cons kw (and key (string-to-char key))) kwsa)
|
||||
(and log (push log org-todo-log-states))
|
||||
kw)
|
||||
(error "Invalid TODO keyword %s" x)))
|
||||
kws0)
|
||||
kwsa (if kwsa (append '((:startgroup))
|
||||
(nreverse kwsa)
|
||||
'((:endgroup))))
|
||||
hw (car kws1)
|
||||
dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1))
|
||||
tail (list inter hw (car dws) (org-last dws)))
|
||||
(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
|
||||
kws1 (mapcar
|
||||
(lambda (x)
|
||||
;; 1 2
|
||||
(if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x)
|
||||
(progn
|
||||
(setq kw (match-string 1 x)
|
||||
key (and (match-end 2) (match-string 2 x))
|
||||
log (org-extract-log-state-settings x))
|
||||
(push (cons kw (and key (string-to-char key))) kwsa)
|
||||
(and log (push log org-todo-log-states))
|
||||
kw)
|
||||
(error "Invalid TODO keyword %s" x)))
|
||||
kws0)
|
||||
kwsa (if kwsa (append '((:startgroup))
|
||||
(nreverse kwsa)
|
||||
'((:endgroup))))
|
||||
hw (car kws1)
|
||||
dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1))
|
||||
tail (list inter hw (car dws) (org-last dws))))
|
||||
(add-to-list 'org-todo-heads hw 'append)
|
||||
(push kws1 org-todo-sets)
|
||||
(setq org-done-keywords (append org-done-keywords dws nil))
|
||||
|
|
@ -5126,11 +5151,19 @@ state (TODO by default). Also with prefix arg, force first state."
|
|||
(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) " "))
|
||||
(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))))
|
||||
|
||||
|
|
@ -8357,6 +8390,18 @@ this is nil.")
|
|||
(push (nth 2 e) rtn)))
|
||||
rtn)))))
|
||||
|
||||
(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.
|
||||
|
|
@ -8462,15 +8507,18 @@ For calling through lisp, arg is also interpreted in the following way:
|
|||
((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)
|
||||
(car tail)
|
||||
(if (> (length tail) 0)
|
||||
(or done-word (car org-done-keywords))
|
||||
nil)))
|
||||
(t nil)))
|
||||
(t
|
||||
(car tail))))
|
||||
(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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue