keymap-popup: Rename macro to keymap-popup-define, add :exit-key

3 files changed, 60 insertions, 52 deletions

diff --git a/README.org b/README.org
index cfe35e2..94c2425 100644
--- a/README.org
+++ b/README.org
@@ -7,7 +7,7 @@ Requires Emacs 29.1+.
 ** Usage
 
 #+begin_src emacs-lisp
-  (define-described-keymap my-mode-map
+  (keymap-popup-define my-mode-map
     "My mode commands."
     :group "Actions"
     "c" ("Comment" my-comment)
@@ -27,7 +27,7 @@ Press =h= for the popup.
 ** Infixes
 
 #+begin_src emacs-lisp
-  (define-described-keymap my-list-map
+  (keymap-popup-define my-list-map
     :group "Options"
     "V" ("Verbose" :switch my-verbose-var)
     "n" ("Limit" :option my-limit-var :reader read-number :prompt "Limit: ")
@@ -44,13 +44,13 @@ without closing it.
 ** Sub-menus
 
 #+begin_src emacs-lisp
-  (define-described-keymap my-metadata-map
+  (keymap-popup-define my-metadata-map
     :group "Add"
     "l" ("Label" my-add-label)
     "a" ("Assignee" my-add-assignee)
     "m" ("Milestone" my-set-milestone))
 
-  (define-described-keymap my-view-map
+  (keymap-popup-define my-view-map
     :group "Actions"
     "c" ("Comment" my-comment)
     "a" ("Metadata" :keymap my-metadata-map)
@@ -63,19 +63,19 @@ Press =a= to enter the sub-menu.  =q= or =C-g= goes back.
 ** Inheritance
 
 #+begin_src emacs-lisp
-  (define-described-keymap view-base-map
+  (keymap-popup-define view-base-map
     :group "Common"
     "g" ("Refresh" my-refresh)
     "b" ("Browse" my-browse)
     "q" ("Quit" quit-window))
 
-  (define-described-keymap issue-view-map
+  (keymap-popup-define issue-view-map
     :parent view-base-map
     :group "Issue"
     "c" ("Comment" my-comment)
     "x" ("Close" my-close))
 
-  (define-described-keymap pull-view-map
+  (keymap-popup-define pull-view-map
     :parent view-base-map
     :group "Pull Request"
     "c" ("Comment" my-comment)
@@ -89,7 +89,7 @@ and parent.
 ** Conditional and inapt entries
 
 #+begin_src emacs-lisp
-  (define-described-keymap my-map
+  (keymap-popup-define my-map
     :group "Actions"
     "c" ("Comment" my-comment)
     ;; hidden when verbose is off
@@ -101,7 +101,7 @@ and parent.
 ** Prefix argument
 
 #+begin_src emacs-lisp
-  (define-described-keymap my-map
+  (keymap-popup-define my-map
     :group "Actions"
     "s" ("Submit" my-submit :c-u "force push")
     "g" ("Refresh" my-refresh))
diff --git a/keymap-popup.el b/keymap-popup.el
index 077a5f4..d737773 100644
--- a/keymap-popup.el
+++ b/keymap-popup.el
@@ -21,7 +21,7 @@
 
 ;;; Commentary:
 
-;; A single macro `define-described-keymap' that produces both a real
+;; A single macro `keymap-popup-define' that produces both a real
 ;; `defvar-keymap' (for direct key dispatch) and stored descriptions
 ;; (for a popup help window).  One definition, two uses.
 
@@ -252,32 +252,37 @@ Uses list calls so lambdas get compiled."
 
 (defun keymap-popup--extract-macro-opts (body)
   "Extract macro options from BODY.
-Returns (DOCSTRING POPUP-KEY PARENT BINDINGS).  A string followed
-by a list is a key binding, not a docstring."
+Returns (DOCSTRING POPUP-KEY EXIT-KEY PARENT BINDINGS).
+A string followed by a list is a key binding, not a docstring."
   (let* ((docstring (when (and (stringp (car body))
-                               (not (listp (cadr body))))
+                               (or (null (cadr body))
+                                   (not (listp (cadr body)))))
                       (car body)))
          (rest (if docstring (cdr body) body))
          (popup-pair (keymap-popup--consume-keyword rest :popup-key))
          (popup-key (if popup-pair (car popup-pair) "h"))
          (rest (if popup-pair (cdr popup-pair) rest))
+         (exit-pair (keymap-popup--consume-keyword rest :exit-key))
+         (exit-key (if exit-pair (car exit-pair) ?q))
+         (rest (if exit-pair (cdr exit-pair) rest))
          (parent-pair (keymap-popup--consume-keyword rest :parent))
          (parent (when parent-pair (car parent-pair)))
          (bindings (if parent-pair (cdr parent-pair) rest)))
-    (list docstring popup-key parent bindings)))
+    (list docstring popup-key exit-key parent bindings)))
 
 ;;;###autoload
-(defmacro define-described-keymap (name &rest body)
+(defmacro keymap-popup-define (name &rest body)
   "Define NAME as a keymap with embedded descriptions.
 BODY is an optional docstring, optional :popup-key KEY (default
-\"h\"), optional :parent KEYMAP, followed by :group keywords and
-KEY (DESC ...) pairs."
+\"h\"), optional :exit-key CHAR (default ?q), optional :parent
+KEYMAP, followed by :group keywords and KEY (DESC ...) pairs."
   (declare (indent 1))
   (let* ((opts (keymap-popup--extract-macro-opts body))
          (docstring (nth 0 opts))
          (popup-key (nth 1 opts))
-         (parent (nth 2 opts))
-         (bindings (nth 3 opts))
+         (exit-key (nth 2 opts))
+         (parent (nth 3 opts))
+         (bindings (nth 4 opts))
          (rows (keymap-popup--parse-bindings bindings))
          (all-entries (cl-loop for row in rows
                                append (cl-loop for group in row
@@ -297,6 +302,7 @@ KEY (DESC ...) pairs."
          ,popup-key (lambda () (interactive) (keymap-popup ',name)))
        (put ',name 'keymap-popup--descriptions
             ,(keymap-popup--build-descriptions-form rows))
+       (put ',name 'keymap-popup--exit-key ,exit-key)
        ,@(when parent
            `((put ',name 'keymap-popup--parent ',parent))))))
 
@@ -574,10 +580,11 @@ Includes descriptions inherited from parent keymaps."
      (documentation-property map-symbol 'variable-documentation))
     buf))
 
-(defun keymap-popup--read-loop (buf win keymap descriptions docstring)
+(defun keymap-popup--read-loop (buf win keymap descriptions docstring exit-key)
   "Read keys in BUF displayed in WIN until a suffix or dismiss.
 KEYMAP is the live keymap for command lookup.  DESCRIPTIONS is the
 stored row metadata.  DOCSTRING is shown at the top of the popup.
+EXIT-KEY is the character that dismisses the popup (default ?q).
 Supports nested :keymap entries via a stack of (DESCS . KEYMAP)
 pairs.  Prefix argument mode is toggled with `universal-argument'.
 Returns (CMD . PREFIX-ARG) or nil on dismiss."
@@ -607,8 +614,8 @@ Returns (CMD . PREFIX-ARG) or nil on dismiss."
                         current-keymap (cdr prev)))
                 (keymap-popup--refresh-buffer buf win current-descs docstring))
                (t (cl-return nil)))
-           ;; q: pop stack or dismiss
-           else when (eq key ?q)
+           ;; Exit key: pop stack or dismiss
+           else when (eq key exit-key)
            do (if stack
                   (let ((prev (pop stack)))
                     (setq current-descs (car prev)
@@ -645,14 +652,15 @@ keys close the popup."
   (let* ((buf (keymap-popup--prepare-buffer map-symbol))
          (keymap (symbol-value map-symbol))
          (descriptions (keymap-popup--collect-descriptions map-symbol))
-         (docstring (documentation-property map-symbol 'variable-documentation)))
+         (docstring (documentation-property map-symbol 'variable-documentation))
+         (exit-key (or (get map-symbol 'keymap-popup--exit-key) ?q)))
     (unwind-protect
         (let* ((win (display-buffer buf
                                     (append keymap-popup-display-action
                                             '((window-height . fit-window-to-buffer)))))
                (_ (when win (fit-window-to-buffer win)))
                (result (keymap-popup--read-loop
-                        buf win keymap descriptions docstring)))
+                        buf win keymap descriptions docstring exit-key)))
           (when (and win (window-live-p win))
             (delete-window win))
           (when result
diff --git a/tests/keymap-popup-tests.el b/tests/keymap-popup-tests.el
index cb49ca2..2630d50 100644
--- a/tests/keymap-popup-tests.el
+++ b/tests/keymap-popup-tests.el
@@ -125,7 +125,7 @@
 
 (ert-deftest keymap-popup-test-macro-creates-keymap ()
   "Macro creates a valid keymap with correct bindings."
-  (eval '(define-described-keymap keymap-popup--test-map-1
+  (eval '(keymap-popup-define keymap-popup--test-map-1
            "Test keymap."
            :group "Actions"
            "c" ("Comment" ignore)
@@ -137,7 +137,7 @@
 
 (ert-deftest keymap-popup-test-macro-stores-descriptions ()
   "Macro stores descriptions as rows of groups."
-  (eval '(define-described-keymap keymap-popup--test-map-2
+  (eval '(keymap-popup-define keymap-popup--test-map-2
            "Test."
            :group "A"
            "c" ("Comment" ignore)
@@ -154,7 +154,7 @@
 
 (ert-deftest keymap-popup-test-macro-switch-infix ()
   "Macro generates toggle command and binds it for switches."
-  (eval '(define-described-keymap keymap-popup--test-map-3
+  (eval '(keymap-popup-define keymap-popup--test-map-3
            "Test."
            "v" ("Verbose" :switch keymap-popup--test-sw))
         t)
@@ -163,7 +163,7 @@
 
 (ert-deftest keymap-popup-test-macro-option-infix ()
   "Macro generates setter command and binds it for options."
-  (eval '(define-described-keymap keymap-popup--test-map-4
+  (eval '(keymap-popup-define keymap-popup--test-map-4
            "Test."
            "n" ("Count" :option keymap-popup--test-opt
                 :reader read-number :prompt "N: "))
@@ -173,7 +173,7 @@
 
 (ert-deftest keymap-popup-test-macro-lambda-command ()
   "Lambda commands bind directly in the keymap."
-  (eval '(define-described-keymap keymap-popup--test-map-5
+  (eval '(keymap-popup-define keymap-popup--test-map-5
            "Test."
            "x" ("Run" (lambda () (interactive) (message "running"))))
         t)
@@ -181,7 +181,7 @@
 
 (ert-deftest keymap-popup-test-macro-no-docstring ()
   "Macro works without a docstring."
-  (eval '(define-described-keymap keymap-popup--test-map-nodoc
+  (eval '(keymap-popup-define keymap-popup--test-map-nodoc
            :group "Actions"
            "c" ("Comment" ignore))
         t)
@@ -195,14 +195,14 @@
 
 (ert-deftest keymap-popup-test-macro-default-popup-key ()
   "Popup is bound to h by default."
-  (eval '(define-described-keymap keymap-popup--test-map-defkey
+  (eval '(keymap-popup-define keymap-popup--test-map-defkey
            "c" ("Comment" ignore))
         t)
   (should (functionp (keymap-lookup keymap-popup--test-map-defkey "h"))))
 
 (ert-deftest keymap-popup-test-macro-custom-popup-key ()
   "Popup key can be customized with :popup-key."
-  (eval '(define-described-keymap keymap-popup--test-map-custkey
+  (eval '(keymap-popup-define keymap-popup--test-map-custkey
            :popup-key "?"
            "c" ("Comment" ignore))
         t)
@@ -275,7 +275,7 @@
 
 (ert-deftest keymap-popup-test-prepare-buffer ()
   "Prepare-buffer creates a buffer with rendered content."
-  (eval '(define-described-keymap keymap-popup--test-popup-map
+  (eval '(keymap-popup-define keymap-popup--test-popup-map
            "Popup test."
            :group "Commands"
            "c" ("Comment" ignore)
@@ -390,8 +390,8 @@
 ;;; Integration tests
 
 (ert-deftest keymap-popup-test-full-definition ()
-  "Full define-described-keymap with all entry types works end-to-end."
-  (eval '(define-described-keymap keymap-popup--test-full
+  "Full keymap-popup-define with all entry types works end-to-end."
+  (eval '(keymap-popup-define keymap-popup--test-full
            "Full test."
            :group "Actions"
            "c" ("Comment" ignore)
@@ -418,7 +418,7 @@
 
 (ert-deftest keymap-popup-test-switch-toggle-roundtrip ()
   "Toggle command flips buffer-local variable."
-  (eval '(define-described-keymap keymap-popup--test-rt
+  (eval '(keymap-popup-define keymap-popup--test-rt
            "Test." "v" ("Verbose" :switch keymap-popup--test-rt-sw))
         t)
   (with-temp-buffer
@@ -430,7 +430,7 @@
 
 (ert-deftest keymap-popup-test-conditional-hidden-in-popup ()
   "Entry with :if nil hidden from rendered popup."
-  (eval '(define-described-keymap keymap-popup--test-cond
+  (eval '(keymap-popup-define keymap-popup--test-cond
            "Test."
            "b" ("Browse" ignore :if (lambda () nil))
            "c" ("Comment" ignore))
@@ -446,7 +446,7 @@
 
 (ert-deftest keymap-popup-test-add-entry ()
   "Add an entry to an existing described keymap."
-  (eval '(define-described-keymap keymap-popup--test-add
+  (eval '(keymap-popup-define keymap-popup--test-add
            :group "Actions"
            "c" ("Comment" ignore))
         t)
@@ -460,7 +460,7 @@
 
 (ert-deftest keymap-popup-test-remove-entry ()
   "Remove an entry from an existing described keymap."
-  (eval '(define-described-keymap keymap-popup--test-rm
+  (eval '(keymap-popup-define keymap-popup--test-rm
            :group "Actions"
            "c" ("Comment" ignore)
            "r" ("Reply" ignore))
@@ -478,7 +478,7 @@
 
 (ert-deftest keymap-popup-test-if-on-switch ()
   "Switch with :if is hidden from popup when predicate returns nil."
-  (eval '(define-described-keymap keymap-popup--test-if-sw
+  (eval '(keymap-popup-define keymap-popup--test-if-sw
            "v" ("Verbose" :switch keymap-popup--test-if-sw-var
                 :if (lambda () nil)))
         t)
@@ -493,7 +493,7 @@
 
 (ert-deftest keymap-popup-test-if-on-option ()
   "Option with :if is hidden from popup when predicate returns nil."
-  (eval '(define-described-keymap keymap-popup--test-if-opt
+  (eval '(keymap-popup-define keymap-popup--test-if-opt
            "n" ("Count" :option keymap-popup--test-if-opt-var
                 :reader read-number :prompt "N: "
                 :if (lambda () nil)))
@@ -507,7 +507,7 @@
 
 (ert-deftest keymap-popup-test-stay-open-in-descriptions ()
   "Suffix with :stay-open stores the flag in descriptions."
-  (eval '(define-described-keymap keymap-popup--test-stay
+  (eval '(keymap-popup-define keymap-popup--test-stay
            "g" ("Refresh" ignore :stay-open t))
         t)
   (let* ((descs (get 'keymap-popup--test-stay 'keymap-popup--descriptions))
@@ -516,7 +516,7 @@
 
 (ert-deftest keymap-popup-test-popup-key-with-docstring ()
   "Docstring and :popup-key work together."
-  (eval '(define-described-keymap keymap-popup--test-pkdoc
+  (eval '(keymap-popup-define keymap-popup--test-pkdoc
            "My commands."
            :popup-key "?"
            :group "Actions"
@@ -530,7 +530,7 @@
 
 (ert-deftest keymap-popup-test-dynamic-group-name ()
   "Group name can be a function called at render time."
-  (eval '(define-described-keymap keymap-popup--test-dyngrp
+  (eval '(keymap-popup-define keymap-popup--test-dyngrp
            :group (lambda () "Dynamic Group")
            "c" ("Comment" ignore))
         t)
@@ -613,12 +613,12 @@
 ;;; Parent inheritance tests
 
 (ert-deftest keymap-popup-test-parent-keymap-bindings ()
-  (eval '(define-described-keymap keymap-popup--test-parent
+  (eval '(keymap-popup-define keymap-popup--test-parent
            :group "Common"
            "g" ("Refresh" ignore)
            "q" ("Quit" quit-window))
         t)
-  (eval '(define-described-keymap keymap-popup--test-child
+  (eval '(keymap-popup-define keymap-popup--test-child
            :parent keymap-popup--test-parent
            :group "Child"
            "c" ("Comment" ignore))
@@ -630,11 +630,11 @@
 
 (ert-deftest keymap-popup-test-parent-descriptions-merged ()
   "Popup shows descriptions from both child and parent."
-  (eval '(define-described-keymap keymap-popup--test-parent2
+  (eval '(keymap-popup-define keymap-popup--test-parent2
            :group "Common"
            "g" ("Refresh" ignore))
         t)
-  (eval '(define-described-keymap keymap-popup--test-child2
+  (eval '(keymap-popup-define keymap-popup--test-child2
            :parent keymap-popup--test-parent2
            :group "Child"
            "c" ("Comment" ignore))
@@ -649,16 +649,16 @@
       (kill-buffer buf))))
 
 (ert-deftest keymap-popup-test-collect-descriptions-chain ()
-  (eval '(define-described-keymap keymap-popup--test-grandparent
+  (eval '(keymap-popup-define keymap-popup--test-grandparent
            :group "GP"
            "g" ("Go" ignore))
         t)
-  (eval '(define-described-keymap keymap-popup--test-mid
+  (eval '(keymap-popup-define keymap-popup--test-mid
            :parent keymap-popup--test-grandparent
            :group "Mid"
            "m" ("Mid cmd" ignore))
         t)
-  (eval '(define-described-keymap keymap-popup--test-leaf
+  (eval '(keymap-popup-define keymap-popup--test-leaf
            :parent keymap-popup--test-mid
            :group "Leaf"
            "l" ("Leaf cmd" ignore))
@@ -699,7 +699,7 @@
 
 (ert-deftest keymap-popup-test-inapt-via-macro ()
   "Inapt entries work through the macro."
-  (eval '(define-described-keymap keymap-popup--test-inapt-map
+  (eval '(keymap-popup-define keymap-popup--test-inapt-map
            "m" ("Merge" ignore :inapt-if (lambda () t))
            "c" ("Comment" ignore))
         t)