[elpa] externals/gnorb 16931d7 352/449: New utility function gnorb-select-from-list

[Stefan Monnier]

branch: externals/gnorb
commit 16931d744f39c648538edca5e779c17b813b2b99
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>

    New utility function gnorb-select-from-list
    
    Fixes #26
    
    * gnorb-utils.el (gnorb-select-valid-chars,
      gnorb-select-choice-buffer, gnorb-select-from-list): New function
      and variables for choosing a thing from a list of things.
      (gnorb-select-from-list): Use new function.
    * gnorb-org.el (gnorb-org-trigger-actions): Change default value to
      fit the function.
---
 gnorb-org.el   |  23 ++++++------
 gnorb-utils.el | 112 +++++++++++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 116 insertions(+), 19 deletions(-)

diff --git a/gnorb-org.el b/gnorb-org.el
index 12941ce..0916b83 100644
--- a/gnorb-org.el
+++ b/gnorb-org.el
@@ -39,12 +39,12 @@
   :type 'hook)
 
 (defcustom gnorb-org-trigger-actions
-  '(("todo state" . todo)
-    ("take note" . note)
-    ("don't associate" . no-associate)
-    ("only associate" . associate)
-    ("capture to child" . cap-child)
-    ("capture to sibling" . cap-sib))
+  '((?t "todo state" todo)
+    (?n "take note" note)
+    (?d "don't associate" no-associate)
+    (?o "only associate" associate)
+    (?c "capture to child" cap-child)
+    (?s "capture to sibling" cap-sib))
   "List of potential actions that can be taken on headings.
 
 When triggering an Org heading after receiving or sending a
@@ -64,12 +64,11 @@ The two \"capture\" options will use the value of
 template.
 
 You can also add custom actions to the list. Actions should be a
-cons of a string tag and a symbol indicating a custom function.
-This function will be called on the heading in question, and
-passed a plist containing information about the message from
-which we're triggering."
-  :group 'gnorb-org
-  :type 'list)
+list of three elements: a character key, a string tag and a
+symbol indicating a custom function.  The custom function will be
+called on the heading in question, and passed a plist containing
+information about the message from which we're triggering."
+:group 'gnorb-org :type 'list :version "1.1.3")
 
 (defcustom gnorb-org-msg-id-key "GNORB_MSG_ID"
   "The name of the org property used to store the Message-IDs
diff --git a/gnorb-utils.el b/gnorb-utils.el
index 7933782..4e79204 100644
--- a/gnorb-utils.el
+++ b/gnorb-utils.el
@@ -25,6 +25,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'pcase)
 
 (require 'mailcap)
 (mailcap-parse-mimetypes)
@@ -203,6 +204,105 @@ window."
        (gnus-summary-goto-article artno nil t)
       (signal 'error "Group could not be opened."))))
 
+;; I'd like to suggest this as a general addition to Emacs.  *Very*
+;; tired of abusing `completing-read' for this purpose.
+(defconst gnorb-select-valid-chars
+  (append (number-sequence 97 122)
+         (number-sequence 65 90))
+  "A list of characters that are suitable for using as selection
+  keys.")
+
+(defvar gnorb-select-choice-buffer "*Selections*"
+  "The name of the buffer used to pop up selections.")
+
+(defun gnorb-select-from-list (prompt collection &optional key-func)
+  "Prompt the user to select something from COLLECTION.
+
+Selection can happen in a few different ways, depending on the
+nature of COLLECTION.  Its elements can be:
+
+1. A plain string.  Simply default to `completing-read'.
+
+2. (string object).  The function uses `completing-read' on the
+   strings, returning the selected object.
+
+3. (number object).  As above, but the user enters a number.
+
+4. (character string object).  As #3, but \"string\" is displayed
+   as a string label for object.
+
+5. (number string object).  As above, with numbers.
+
+COLLECTION can be passed in ready-made.  Alternately, KEY-FUNC
+can be provided.  The collection will be constructed by mapping
+this function over the list of objects, and then appending each
+object to the corresponding result.  In other words, KEY-FUNC
+should return one of the types above, minus the final \"object\"
+element.
+
+Alternately, KEY-FUNC can be the symbol 'char, in which case the
+elements of COLLECTION will automatically be keyed to ascending
+characters (52 or fewer), or 'number, which does the same with
+numbers (no upper bound)."
+  (interactive)
+  (let ((len (length collection)))
+    (cl-labels ((pop-up-selections
+                (collection &optional charp)
+                (pop-to-buffer gnorb-select-choice-buffer
+                               '(display-buffer-in-side-window ((side . 
bottom))) t)
+                (dolist (c collection)
+                  (insert (format "%s: %s\n"
+                                  (if charp
+                                      (char-to-string (car c))
+                                    (car c))
+                                  (nth 1 c))))))
+      (setq collection
+           (pcase key-func
+             ((pred null)
+              collection)
+             ('char
+              (if (> len 52)
+                  (error "Use the char option with fewer than 52 items")
+                ;; These distinctions between char/string
+                ;; and number/char are totally manufactured.
+                (seq-mapn #'list gnorb-select-valid-chars collection)))
+             ('number
+              (seq-mapn #'list (number-sequence 1 len) collection))
+             ((and func (pred functionp))
+              (seq-map (lambda (el)
+                         (let ((res (funcall func el)))
+                           (if (atom res)
+                               (list res el)
+                             (append res
+                                     (list el)))))
+                       collection))
+             (_ (error "Invalid key-func: %s" key-func))))
+      ;; We only test the car of collection to see what type it is.  If
+      ;; elements are mismatched, it's not our problem.
+      (unwind-protect
+         (pcase (car collection)
+           ((pred stringp)
+            (completing-read prompt collection nil t))
+           ((pred symbolp)
+            (intern-soft (completing-read prompt collection nil t)))
+           (`(,(pred stringp) ,_)
+            (nth 1 (assoc (completing-read prompt collection nil t)
+                          collection)))
+           ;; Looks like pcase might be the wrong tool for this job.
+           ((or `(,(and c (pred numberp) (guard (memq c 
gnorb-select-valid-chars))) ,_)
+                `(,(and c (pred numberp) (guard (memq c 
gnorb-select-valid-chars))) ,_ ,_))
+            (pop-up-selections collection t)
+            (car (last (assq (read-char
+                              (propertize prompt 'face 'minibuffer-prompt))
+                             collection))))
+           ((or `(,(pred numberp) ,_)
+                `(,(pred numberp) ,_ ,_))
+            (pop-up-selections collection)
+            (car (last (assq (read-number prompt)
+                             collection)))))
+       (when-let ((win (get-buffer-window gnorb-select-choice-buffer)))
+         (quit-window win))))))
+
 (defun gnorb-trigger-todo-action (arg &optional id)
   "Do the actual restore action. Two main things here. First: if
 we were in the agenda when this was called, then keep us in the
@@ -225,13 +325,11 @@ agenda. Then let the user choose an action from the value 
of
         (id (or id
                 (org-with-point-at root-marker
                   (org-id-get-create))))
-        (action (cdr (assoc
-                      (org-completing-read
-                       (format
-                        "Trigger action on %s: "
-                        (gnorb-pretty-outline id))
-                       gnorb-org-trigger-actions nil t)
-                      gnorb-org-trigger-actions))))
+        (action (gnorb-select-from-list
+                 (format
+                  "Trigger action on %s: "
+                  (gnorb-pretty-outline id))
+                 gnorb-org-trigger-actions)))
     (unless agenda-p
       (org-reveal))
     (cl-labels