Browse Source

Improve TODO selection if some keys are present in several sequences

* lisp/org.el (org-todo): Give the current state as an
argument to `org-fast-todo-selection'.
(org-fast-todo-selection): Accept current state as an
argument.  Use that state to find out to which TODO sequence
the current state belongs and use that to make the right
choice if selection keys are not unique globally.  For
example, if you have a task sequence, and a project sequence,
you could use the "d" selection key in both sequences to
switch to the appropriate DONE (or e.g. PRDN) state.
Carsten Dominik 6 years ago
parent
commit
de3faf0767
1 changed files with 14 additions and 7 deletions
  1. 14 7
      lisp/org.el

+ 14 - 7
lisp/org.el

@@ -10062,7 +10062,7 @@ When called through ELisp, arg is also interpreted in the following way:
 					    (not (eq org-use-fast-todo-selection
 					    (not (eq org-use-fast-todo-selection
 						     'prefix)))))
 						     'prefix)))))
 			      ;; Use fast selection.
 			      ;; Use fast selection.
-			      (org-fast-todo-selection))
+			      (org-fast-todo-selection this))
 			     ((and (equal arg '(4))
 			     ((and (equal arg '(4))
 				   (or (not org-use-fast-todo-selection)
 				   (or (not org-use-fast-todo-selection)
 				       (not org-todo-key-trigger)))
 				       (not org-todo-key-trigger)))
@@ -10570,10 +10570,13 @@ right sequence."
       (car org-todo-keywords-1))
       (car org-todo-keywords-1))
      (t (nth 2 (assoc kwd org-todo-kwd-alist))))))
      (t (nth 2 (assoc kwd org-todo-kwd-alist))))))
 
 
-(defun org-fast-todo-selection ()
+(defun org-fast-todo-selection (&optional current-state)
   "Fast TODO keyword selection with single keys.
   "Fast TODO keyword selection with single keys.
-Returns the new TODO keyword, or nil if no state change should occur."
+Returns the new TODO keyword, or nil if no state change should occur.
+When CURRENT-STATE is given and selection letters are not unique globally,
+prefer a state in the current sequence over on in another sequence."
   (let* ((fulltable org-todo-key-alist)
   (let* ((fulltable org-todo-key-alist)
+	 (head (org-get-todo-sequence-head current-state))
 	 (done-keywords org-done-keywords) ;; needed for the faces.
 	 (done-keywords org-done-keywords) ;; needed for the faces.
 	 (maxlen (apply 'max (mapcar
 	 (maxlen (apply 'max (mapcar
 			      (lambda (x)
 			      (lambda (x)
@@ -10582,8 +10585,8 @@ Returns the new TODO keyword, or nil if no state change should occur."
 	 (expert nil)
 	 (expert nil)
 	 (fwidth (+ maxlen 3 1 3))
 	 (fwidth (+ maxlen 3 1 3))
 	 (ncol (/ (- (window-width) 4) fwidth))
 	 (ncol (/ (- (window-width) 4) fwidth))
-	 tg cnt e c tbl
-	 groups ingroup)
+	 tg cnt e c tbl subtable
+	 groups ingroup in-current-sequence)
     (save-excursion
     (save-excursion
       (save-window-excursion
       (save-window-excursion
 	(if expert
 	(if expert
@@ -10601,7 +10604,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
 	      (insert "\n"))
 	      (insert "\n"))
 	    (insert "{ "))
 	    (insert "{ "))
 	   ((equal e '(:endgroup))
 	   ((equal e '(:endgroup))
-	    (setq ingroup nil cnt 0)
+	    (setq ingroup nil cnt 0 in-current-sequence nil)
 	    (insert "}\n"))
 	    (insert "}\n"))
 	   ((equal e '(:newline))
 	   ((equal e '(:newline))
 	    (unless (= cnt 0)
 	    (unless (= cnt 0)
@@ -10613,7 +10616,9 @@ Returns the new TODO keyword, or nil if no state change should occur."
 		(setq tbl (cdr tbl)))))
 		(setq tbl (cdr tbl)))))
 	   (t
 	   (t
 	    (setq tg (car e) c (cdr e))
 	    (setq tg (car e) c (cdr e))
+	    (if (equal tg head) (setq in-current-sequence t))
 	    (when ingroup (push tg (car groups)))
 	    (when ingroup (push tg (car groups)))
+	    (when in-current-sequence (push e subtable))
 	    (setq tg (org-add-props tg nil 'face
 	    (setq tg (org-add-props tg nil 'face
 				    (org-get-todo-face tg)))
 				    (org-get-todo-face tg)))
 	    (when (and (= cnt 0) (not ingroup)) (insert "  "))
 	    (when (and (= cnt 0) (not ingroup)) (insert "  "))
@@ -10630,12 +10635,14 @@ Returns the new TODO keyword, or nil if no state change should occur."
 	(unless expert (org-fit-window-to-buffer))
 	(unless expert (org-fit-window-to-buffer))
 	(message "[a-z..]:Set [SPC]:clear")
 	(message "[a-z..]:Set [SPC]:clear")
 	(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
 	(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
+	(setq subtable (nreverse subtable))
 	(cond
 	(cond
 	 ((or (= c ?\C-g)
 	 ((or (= c ?\C-g)
 	      (and (= c ?q) (not (rassoc c fulltable))))
 	      (and (= c ?q) (not (rassoc c fulltable))))
 	  (setq quit-flag t))
 	  (setq quit-flag t))
 	 ((= c ?\ ) nil)
 	 ((= c ?\ ) nil)
-	 ((setq e (rassoc c fulltable) tg (car e))
+	 ((setq e (or (rassoc c subtable) (rassoc c fulltable))
+		tg (car e))
 	  tg)
 	  tg)
 	 (t (setq quit-flag t)))))))
 	 (t (setq quit-flag t)))))))