From 5c4ebb67a263f7dbe91653bdedc4fb1192f4b7a1 Mon Sep 17 00:00:00 2001 From: Thanos Apollo Date: Sun, 26 Apr 2026 03:44:05 +0300 Subject: keymap-popup: Rename macro to keymap-popup-define, add :exit-key --- README.org | 18 +++++++-------- keymap-popup.el | 38 ++++++++++++++++++------------ tests/keymap-popup-tests.el | 56 ++++++++++++++++++++++----------------------- 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) -- cgit v1.0