diff options
author | Bastien Guerry <bzg@altern.org> | 2011-12-31 09:30:13 +0100 |
---|---|---|
committer | Bastien Guerry <bzg@altern.org> | 2011-12-31 09:30:13 +0100 |
commit | d1b5b65c47cf5b61766d5d9e01ee2eb08ae09dc9 (patch) | |
tree | 9466eedef785f24d6b0bf53f66cae286378f2425 | |
parent | a6c95474d3ef70d5c7e3f2529ef64eb0ee0bb456 (diff) | |
parent | e621dfc36a182a4a4fc1c039cf3cf4e6c76868cd (diff) | |
download | org-mode-d1b5b65c47cf5b61766d5d9e01ee2eb08ae09dc9.tar.gz |
Merge branch '5-org-todo-loop'
-rw-r--r-- | lisp/org.el | 377 |
1 files changed, 192 insertions, 185 deletions
diff --git a/lisp/org.el b/lisp/org.el index 43b2bfe..5e0adc7 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -11191,194 +11191,201 @@ For calling through lisp, arg is also interpreted in the following way: \"WAITING\" -> switch to the specified keyword, but only if it really is a member of `org-todo-keywords'." (interactive "P") - (if (equal arg '(16)) (setq arg 'nextset)) - (let ((org-blocker-hook org-blocker-hook) - (case-fold-search nil)) - (when (equal arg '(64)) - (setq arg nil org-blocker-hook nil)) - (when (and org-blocker-hook - (or org-inhibit-blocking - (org-entry-get nil "NOBLOCKING"))) - (setq org-blocker-hook nil)) - (save-excursion - (catch 'exit - (org-back-to-heading t) - (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) - (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)")) - (looking-at "\\(?: *\\|[ \t]*$\\)")) - (let* ((match-data (match-data)) - (startpos (point-at-bol)) - (logging (save-match-data (org-entry-get nil "LOGGING" t t))) - (org-log-done org-log-done) - (org-log-repeat org-log-repeat) - (org-todo-log-states org-todo-log-states) - (org-inhibit-logging - (if (equal arg 0) - (progn (setq arg nil) 'note) org-inhibit-logging)) - (this (match-string 1)) - (hl-pos (match-beginning 0)) - (head (org-get-todo-sequence-head this)) - (ass (assoc head org-todo-kwd-alist)) - (interpret (nth 1 ass)) - (done-word (nth 3 ass)) - (final-done-word (nth 4 ass)) - (last-state (or this "")) - (completion-ignore-case t) - (member (member this org-todo-keywords-1)) - (tail (cdr member)) - (state (cond - ((and org-todo-key-trigger - (or (and (equal arg '(4)) - (eq org-use-fast-todo-selection 'prefix)) - (and (not arg) org-use-fast-todo-selection - (not (eq org-use-fast-todo-selection - 'prefix))))) - ;; Use fast selection - (org-fast-todo-selection)) - ((and (equal arg '(4)) - (or (not org-use-fast-todo-selection) - (not org-todo-key-trigger))) - ;; Read a state with completion - (org-icompleting-read - "State: " (mapcar (lambda(x) (list x)) - org-todo-keywords-1) - nil t)) - ((eq arg 'right) - (if this - (if tail (car tail) nil) - (car org-todo-keywords-1))) - ((eq arg 'left) - (if (equal member org-todo-keywords-1) - nil + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let (org-loop-over-headlines-in-active-region) + (org-map-entries + `(org-todo ,arg) + org-loop-over-headlines-in-active-region + 'region + (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (if (equal arg '(16)) (setq arg 'nextset)) + (let ((org-blocker-hook org-blocker-hook) + (case-fold-search nil)) + (when (equal arg '(64)) + (setq arg nil org-blocker-hook nil)) + (when (and org-blocker-hook + (or org-inhibit-blocking + (org-entry-get nil "NOBLOCKING"))) + (setq org-blocker-hook nil)) + (save-excursion + (catch 'exit + (org-back-to-heading t) + (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) + (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)")) + (looking-at "\\(?: *\\|[ \t]*$\\)")) + (let* ((match-data (match-data)) + (startpos (point-at-bol)) + (logging (save-match-data (org-entry-get nil "LOGGING" t t))) + (org-log-done org-log-done) + (org-log-repeat org-log-repeat) + (org-todo-log-states org-todo-log-states) + (org-inhibit-logging + (if (equal arg 0) + (progn (setq arg nil) 'note) org-inhibit-logging)) + (this (match-string 1)) + (hl-pos (match-beginning 0)) + (head (org-get-todo-sequence-head this)) + (ass (assoc head org-todo-kwd-alist)) + (interpret (nth 1 ass)) + (done-word (nth 3 ass)) + (final-done-word (nth 4 ass)) + (last-state (or this "")) + (completion-ignore-case t) + (member (member this org-todo-keywords-1)) + (tail (cdr member)) + (state (cond + ((and org-todo-key-trigger + (or (and (equal arg '(4)) + (eq org-use-fast-todo-selection 'prefix)) + (and (not arg) org-use-fast-todo-selection + (not (eq org-use-fast-todo-selection + 'prefix))))) + ;; Use fast selection + (org-fast-todo-selection)) + ((and (equal arg '(4)) + (or (not org-use-fast-todo-selection) + (not org-todo-key-trigger))) + ;; Read a state with completion + (org-icompleting-read + "State: " (mapcar (lambda(x) (list x)) + org-todo-keywords-1) + nil t)) + ((eq arg 'right) (if this - (nth (- (length org-todo-keywords-1) - (length tail) 2) - org-todo-keywords-1) - (org-last org-todo-keywords-1)))) - ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) - (setq arg nil))) ; hack to fall back to cycling - (arg - ;; user or caller requests a specific state - (cond - ((equal arg "") nil) - ((eq arg 'none) nil) - ((eq arg 'done) (or done-word (car org-done-keywords))) - ((eq arg 'nextset) - (or (car (cdr (member head org-todo-heads))) - (car org-todo-heads))) - ((eq arg 'previousset) - (let ((org-todo-heads (reverse org-todo-heads))) + (if tail (car tail) nil) + (car org-todo-keywords-1))) + ((eq arg 'left) + (if (equal member org-todo-keywords-1) + nil + (if this + (nth (- (length org-todo-keywords-1) + (length tail) 2) + org-todo-keywords-1) + (org-last org-todo-keywords-1)))) + ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) + (setq arg nil))) ; hack to fall back to cycling + (arg + ;; user or caller requests a specific state + (cond + ((equal arg "") nil) + ((eq arg 'none) nil) + ((eq arg 'done) (or done-word (car org-done-keywords))) + ((eq arg 'nextset) (or (car (cdr (member head org-todo-heads))) - (car org-todo-heads)))) - ((car (member arg org-todo-keywords-1))) - ((stringp arg) - (error "State `%s' not valid in this file" arg)) - ((nth (1- (prefix-numeric-value arg)) - org-todo-keywords-1)))) - ((null member) (or head (car org-todo-keywords-1))) - ((equal this final-done-word) nil) ;; -> make empty - ((null tail) nil) ;; -> first entry - ((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 - (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)) - dolog now-done-p) - (when org-blocker-hook + (car org-todo-heads))) + ((eq arg 'previousset) + (let ((org-todo-heads (reverse org-todo-heads))) + (or (car (cdr (member head org-todo-heads))) + (car org-todo-heads)))) + ((car (member arg org-todo-keywords-1))) + ((stringp arg) + (error "State `%s' not valid in this file" arg)) + ((nth (1- (prefix-numeric-value arg)) + org-todo-keywords-1)))) + ((null member) (or head (car org-todo-keywords-1))) + ((equal this final-done-word) nil) ;; -> make empty + ((null tail) nil) ;; -> first entry + ((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 + (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)) + dolog now-done-p) + (when org-blocker-hook + (setq org-last-todo-state-is-todo + (not (member this org-done-keywords))) + (unless (save-excursion + (save-match-data + (org-with-wide-buffer + (run-hook-with-args-until-failure + 'org-blocker-hook change-plist)))) + (if (org-called-interactively-p 'interactive) + (error "TODO state change from %s to %s blocked" this state) + ;; fail silently + (message "TODO state change from %s to %s blocked" this state) + (throw 'exit nil)))) + (store-match-data match-data) + (replace-match next t t) + (unless (pos-visible-in-window-p hl-pos) + (message "TODO state changed to %s" (org-trim next))) + (unless head + (setq head (org-get-todo-sequence-head state) + ass (assoc head org-todo-kwd-alist) + interpret (nth 1 ass) + done-word (nth 3 ass) + final-done-word (nth 4 ass))) + (when (memq arg '(nextset previousset)) + (message "Keyword-Set %d/%d: %s" + (- (length org-todo-sets) -1 + (length (memq (assoc state org-todo-sets) org-todo-sets))) + (length org-todo-sets) + (mapconcat 'identity (assoc state org-todo-sets) " "))) (setq org-last-todo-state-is-todo - (not (member this org-done-keywords))) - (unless (save-excursion - (save-match-data - (org-with-wide-buffer - (run-hook-with-args-until-failure - 'org-blocker-hook change-plist)))) - (if (org-called-interactively-p 'interactive) - (error "TODO state change from %s to %s blocked" this state) - ;; fail silently - (message "TODO state change from %s to %s blocked" this state) - (throw 'exit nil)))) - (store-match-data match-data) - (replace-match next t t) - (unless (pos-visible-in-window-p hl-pos) - (message "TODO state changed to %s" (org-trim next))) - (unless head - (setq head (org-get-todo-sequence-head state) - ass (assoc head org-todo-kwd-alist) - interpret (nth 1 ass) - done-word (nth 3 ass) - final-done-word (nth 4 ass))) - (when (memq arg '(nextset previousset)) - (message "Keyword-Set %d/%d: %s" - (- (length org-todo-sets) -1 - (length (memq (assoc state org-todo-sets) org-todo-sets))) - (length org-todo-sets) - (mapconcat 'identity (assoc state org-todo-sets) " "))) - (setq org-last-todo-state-is-todo - (not (member state org-done-keywords))) - (setq now-done-p (and (member state org-done-keywords) - (not (member this org-done-keywords)))) - (and logging (org-local-logging logging)) - (when (and (or org-todo-log-states org-log-done) - (not (eq org-inhibit-logging t)) - (not (memq arg '(nextset previousset)))) - ;; we need to look at recording a time and note - (setq dolog (or (nth 1 (assoc state org-todo-log-states)) - (nth 2 (assoc this org-todo-log-states)))) - (if (and (eq dolog 'note) (eq org-inhibit-logging 'note)) - (setq dolog 'time)) - (when (and state - (member state org-not-done-keywords) - (not (member this org-not-done-keywords))) - ;; This is now a todo state and was not one before - ;; If there was a CLOSED time stamp, get rid of it. - (org-add-planning-info nil nil 'closed)) - (when (and now-done-p org-log-done) - ;; It is now done, and it was not done before - (org-add-planning-info 'closed (org-current-effective-time)) - (if (and (not dolog) (eq 'note org-log-done)) - (org-add-log-setup 'done state this 'findpos 'note))) - (when (and state dolog) - ;; This is a non-nil state, and we need to log it - (org-add-log-setup 'state state this 'findpos dolog))) - ;; Fixup tag positioning - (org-todo-trigger-tag-changes state) - (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) - (when org-provide-todo-statistics - (org-update-parent-todo-statistics)) - (run-hooks 'org-after-todo-state-change-hook) - (if (and arg (not (member state org-done-keywords))) - (setq head (org-get-todo-sequence-head state))) - (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) - ;; Do we need to trigger a repeat? - (when now-done-p - (when (boundp 'org-agenda-headline-snapshot-before-repeat) - ;; This is for the agenda, take a snapshot of the headline. - (save-match-data - (setq org-agenda-headline-snapshot-before-repeat - (org-get-heading)))) - (org-auto-repeat-maybe state)) - ;; Fixup cursor location if close to the keyword - (if (and (outline-on-heading-p) - (not (bolp)) - (save-excursion (beginning-of-line 1) - (looking-at org-todo-line-regexp)) - (< (point) (+ 2 (or (match-end 2) (match-end 1))))) - (progn - (goto-char (or (match-end 2) (match-end 1))) - (and (looking-at " ") (just-one-space)))) - (when org-trigger-hook - (save-excursion - (run-hook-with-args 'org-trigger-hook change-plist)))))))) + (not (member state org-done-keywords))) + (setq now-done-p (and (member state org-done-keywords) + (not (member this org-done-keywords)))) + (and logging (org-local-logging logging)) + (when (and (or org-todo-log-states org-log-done) + (not (eq org-inhibit-logging t)) + (not (memq arg '(nextset previousset)))) + ;; we need to look at recording a time and note + (setq dolog (or (nth 1 (assoc state org-todo-log-states)) + (nth 2 (assoc this org-todo-log-states)))) + (if (and (eq dolog 'note) (eq org-inhibit-logging 'note)) + (setq dolog 'time)) + (when (and state + (member state org-not-done-keywords) + (not (member this org-not-done-keywords))) + ;; This is now a todo state and was not one before + ;; If there was a CLOSED time stamp, get rid of it. + (org-add-planning-info nil nil 'closed)) + (when (and now-done-p org-log-done) + ;; It is now done, and it was not done before + (org-add-planning-info 'closed (org-current-effective-time)) + (if (and (not dolog) (eq 'note org-log-done)) + (org-add-log-setup 'done state this 'findpos 'note))) + (when (and state dolog) + ;; This is a non-nil state, and we need to log it + (org-add-log-setup 'state state this 'findpos dolog))) + ;; Fixup tag positioning + (org-todo-trigger-tag-changes state) + (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) + (when org-provide-todo-statistics + (org-update-parent-todo-statistics)) + (run-hooks 'org-after-todo-state-change-hook) + (if (and arg (not (member state org-done-keywords))) + (setq head (org-get-todo-sequence-head state))) + (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) + ;; Do we need to trigger a repeat? + (when now-done-p + (when (boundp 'org-agenda-headline-snapshot-before-repeat) + ;; This is for the agenda, take a snapshot of the headline. + (save-match-data + (setq org-agenda-headline-snapshot-before-repeat + (org-get-heading)))) + (org-auto-repeat-maybe state)) + ;; Fixup cursor location if close to the keyword + (if (and (outline-on-heading-p) + (not (bolp)) + (save-excursion (beginning-of-line 1) + (looking-at org-todo-line-regexp)) + (< (point) (+ 2 (or (match-end 2) (match-end 1))))) + (progn + (goto-char (or (match-end 2) (match-end 1))) + (and (looking-at " ") (just-one-space)))) + (when org-trigger-hook + (save-excursion + (run-hook-with-args 'org-trigger-hook change-plist))))))))) (defun org-block-todo-from-children-or-siblings-or-parent (change-plist) "Block turning an entry into a TODO, using the hierarchy. |