Refactor `org-fast-todo-selection'

* lisp/org.el (org-fast-todo-selection): Refactor the function, adding
commentary and renaming variables to more readable names.

lisp/org.el

@@ -9797,88 +9797,123 @@ right sequence."
       (car org-todo-keywords-1))
      (t (nth 2 (assoc kwd org-todo-kwd-alist))))))
 
-(defun org-fast-todo-selection (&optional current-state)
+(defun org-fast-todo-selection (&optional current-todo-keyword)
   "Fast TODO keyword selection with single keys.
 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."
+When CURRENT-TODO-KEYWORD is given and selection letters are not
-  (let* ((fulltable org-todo-key-alist)
+unique globally, prefer a state in the current todo keyword sequence
-	 (head (org-get-todo-sequence-head current-state))
+where CURRENT-TODO-KEYWORD belongs over on in another sequence."
-	 (done-keywords org-done-keywords) ;; needed for the faces.
+  (let* ((todo-alist org-todo-key-alist) ; copy from the original Org buffer.
-	 (maxlen (apply 'max (mapcar
+         (todo-alist-tail todo-alist)
-			      (lambda (x)
+         ;; TODO keyword sequence that takes priority in case if there is binding collision.
-				(if (stringp (car x)) (string-width (car x)) 0))
+	 (preferred-sequence-head (org-get-todo-sequence-head current-todo-keyword))
-			      fulltable)))
+         in-preferred-sequence preferred-todo-alist
-	 (expert (equal org-use-fast-todo-selection 'expert))
+	 (done-keywords org-done-keywords) ;; needed for the faces when calling `org-get-todo-face'.
-	 (prompt "")
+	 (expert-interface (equal org-use-fast-todo-selection 'expert))
-	 (fwidth (+ maxlen 3 1 3))
+	 (prompt "") ; Additional expert prompt, listing todo keyword bindings.
-	 (ncol (/ (- (window-width) 4) fwidth))
+         ;; Max width occupied by a single todo record in the completion buffer.
-	 tg cnt e c tbl subtable
+         (field-width
-	 groups ingroup in-current-sequence)
+          (+ 3 ; keep space for "[c]" binding.
+             1 ; ensure that there is at least one space between adjacent todo fields.
+             3 ; FIXME: likely coped from `org-fast-tag-selection'
+             ;; The longest todo keyword.
+             (apply 'max (mapcar
+			  (lambda (x)
+			    (if (stringp (car x)) (string-width (car x)) 0))
+			  org-todo-key-alist))))
+         field-number ; current todo keyword column in the completion buffer.
+         todo-binding-spec todo-keyword todo-char input-char)
+    ;; Display todo selection dialogue, read the user input, and return.
     (save-excursion
       (save-window-excursion
-	(if expert
+        ;; Select todo keyword list buffer, and display it unless EXPERT-INTERFACE.
+	(if expert-interface
 	    (set-buffer (get-buffer-create " *Org todo*"))
 	  (delete-other-windows)
 	  (set-window-buffer (split-window-vertically) (get-buffer-create " *Org todo*"))
 	  (org-switch-to-buffer-other-window " *Org todo*"))
+        ;; Fill text in *Org todo* buffer.
 	(erase-buffer)
+        ;; Copy `org-done-keywords' from the original Org buffer to be
+        ;; used by `org-get-todo-face'.
 	(setq-local org-done-keywords done-keywords)
-	(setq tbl fulltable cnt 0)
+        ;; Show todo keyword sequences and bindings in a grid.
-	(while (setq e (pop tbl))
+        ;; Each todo keyword in the grid occupies FIELD-WIDTH characters.
-	  (cond
+        ;; The keywords are filled up to `window-width'.
-	   ((equal e '(:startgroup))
+	(setq field-number 0)
-	    (push '() groups) (setq ingroup t)
+	(while (setq todo-binding-spec (pop todo-alist-tail))
-	    (unless (= cnt 0)
+	  (pcase todo-binding-spec
-	      (setq cnt 0)
+            ;; Group keywords as { KWD1 KWD2 ... }
-	      (insert "\n"))
+	    (`(:startgroup)
-	    (setq prompt (concat prompt "{"))
+	     (unless (= field-number 0)
-	    (insert "{ "))
+	       (setq field-number 0)
-	   ((equal e '(:endgroup))
+	       (insert "\n"))
-	    (setq ingroup nil cnt 0 in-current-sequence nil)
+	     (setq prompt (concat prompt "{"))
-	    (setq prompt (concat prompt "}"))
+	     (insert "{ "))
-	    (insert "}\n"))
+	    (`(:endgroup)
-	   ((equal e '(:newline))
+	     (setq field-number 0
-	    (unless (= cnt 0)
+                   ;; End of a group.  Reset flag indicating preferred keyword sequence.
-	      (setq cnt 0)
+                   in-preferred-sequence nil)
-	      (insert "\n")
+	     (setq prompt (concat prompt "}"))
-	      (setq e (car tbl))
+	     (insert "}\n"))
-	      (while (equal (car tbl) '(:newline))
+	    (`(:newline)
-		(insert "\n")
+	     (unless (= field-number 0)
-		(setq tbl (cdr tbl)))))
+	       (insert "\n")
-	   (t
+	       (setq field-number 0)
-	    (setq tg (car e) c (cdr e))
+	       (setq todo-binding-spec (car todo-alist-tail))
-	    (if (equal tg head) (setq in-current-sequence t))
+	       (while (equal (car todo-alist-tail) '(:newline))
-	    (when ingroup (push tg (car groups)))
+		 (insert "\n")
-	    (when in-current-sequence (push e subtable))
+		 (pop todo-alist-tail))))
-	    (setq tg (org-add-props tg nil 'face
+	    (_
-				    (org-get-todo-face tg)))
+	     (setq todo-keyword (car todo-binding-spec)
-	    (when (and (= cnt 0) (not ingroup)) (insert "  "))
+                   todo-char (cdr todo-binding-spec))
-	    (setq prompt (concat prompt "[" (char-to-string c) "] " tg " "))
+             ;; For the first keyword in a preferred sequence, set flag.
-	    (insert "[" c "] " tg (make-string
+	     (if (equal todo-keyword preferred-sequence-head)
-				   (- fwidth 4 (length tg)) ?\ ))
+                 (setq in-preferred-sequence t))
-	    (when (and (= (setq cnt (1+ cnt)) ncol)
+             ;; Store the preferred todo keyword sequence.
-		       ;; Avoid lines with just a closing delimiter.
+	     (when in-preferred-sequence (push todo-binding-spec preferred-todo-alist))
-		       (not (equal (car tbl) '(:endgroup))))
+             ;; Assign face to the todo keyword.
-	      (insert "\n")
+	     (setq todo-keyword
-	      (when ingroup (insert "  "))
+                   (org-add-props
-	      (setq cnt 0)))))
+                       todo-keyword nil
+                     'face (org-get-todo-face todo-keyword)))
+	     (when (= field-number 0) (insert "  "))
+	     (setq prompt (concat prompt "[" (char-to-string todo-char) "] " todo-keyword " "))
+	     (insert "[" todo-char "] " todo-keyword
+                     ;; Fill spaces up to FIELD-WIDTH.
+                     (make-string
+		      (- field-width 4 (length todo-keyword)) ?\ ))
+             ;; Last column in the row.
+	     (when (and (= (setq field-number (1+ field-number))
+                           (/ (- (window-width) 4) field-width))
+		        ;; Avoid lines with just a closing delimiter.
+		        (not (equal (car todo-alist-tail) '(:endgroup))))
+	       (insert "\n")
+	       (setq field-number 0)))))
 	(insert "\n")
 	(goto-char (point-min))
-	(unless expert (org-fit-window-to-buffer))
+	(unless expert-interface (org-fit-window-to-buffer))
 	(message (concat "[a-z..]:Set [SPC]:clear"
-			 (if expert (concat "\n" prompt) "")))
+			 (if expert-interface (concat "\n" prompt) "")))
-	(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
+        ;; Read the todo keyword input and exit.
-	(setq subtable (nreverse subtable))
+	(setq input-char
+              (let ((inhibit-quit t)) ; intercept C-g.
+                (read-char-exclusive)))
+        ;; Restore the original keyword order.  Previously, it was reversed using `push'.
+	(setq preferred-todo-alist (nreverse preferred-todo-alist))
 	(cond
-	 ((or (= c ?\C-g)
+	 ((equal input-char ?\s) nil)
-	      (and (= c ?q) (not (rassoc c fulltable))))
+         ((or (= input-char ?\C-g)
-	  (setq quit-flag t))
+	      (and (= input-char ?q) (not (rassoc input-char todo-alist))))
-	 ((= c ?\ ) nil)
+          (signal 'quit nil))
-	 ((setq e (or (rassoc c subtable) (rassoc c fulltable))
+	 ((setq todo-binding-spec (or
-		tg (car e))
+                                   ;; Prefer bindings from todo sequence containing CURRENT-TODO-KEYWORD.
-	  tg)
+                                   (rassoc input-char preferred-todo-alist)
-	 (t (setq quit-flag t)))))))
+                                   (rassoc input-char todo-alist))
+	        todo-keyword (car todo-binding-spec))
+	  todo-keyword)
+         (t (signal 'quit nil)))))))
 
 (defun org-entry-is-todo-p ()
   (member (org-get-todo-state) org-not-done-keywords))