Add keymap-popup.el

2 files changed, 1033 insertions, 0 deletions

diff --git a/keymap-popup.el b/keymap-popup.el
new file mode 100644
index 0000000..95a1b3f
--- /dev/null
+++ b/keymap-popup.el
@@ -0,0 +1,541 @@
+;;; keymap-popup.el --- Described keymaps with popup help  -*- lexical-binding: t; -*-
+
+;; Author: Thanos Apollo
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "29.1"))
+;; Keywords: convenience keymaps
+;; URL: https://thanosapollo.org/projects/keymap-popup
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A single macro `define-described-keymap' that produces both a real
+;; `defvar-keymap' (for direct key dispatch) and stored descriptions
+;; (for a popup help window).  One definition, two uses.
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defgroup keymap-popup nil
+  "Described keymaps with popup help."
+  :group 'convenience)
+
+;;; Faces
+
+(defface keymap-popup-key
+  '((t :inherit help-key-binding))
+  "Face for key bindings in the popup."
+  :group 'keymap-popup)
+
+(defface keymap-popup-group-header
+  '((t :inherit bold))
+  "Face for group headers in the popup."
+  :group 'keymap-popup)
+
+(defface keymap-popup-value
+  '((t :inherit font-lock-string-face :weight bold))
+  "Face for infix values in the popup."
+  :group 'keymap-popup)
+
+;;; Parsers
+
+(defun keymap-popup--extract-props (plist)
+  "Extract known properties from PLIST.
+Recognized keys: :if, :reader, :prompt, :stay-open."
+  (cl-loop for (k v) on plist by #'cddr
+           when (memq k '(:if :reader :prompt :stay-open))
+           append (list k v)))
+
+(defun keymap-popup--parse-entry (key spec)
+  "Parse binding SPEC for KEY into a plist.
+SPEC is (DESCRIPTION COMMAND-OR-TYPE &rest PROPS)."
+  (let* ((description (car spec))
+         (second (cadr spec))
+         (rest (cddr spec)))
+    (pcase second
+      (:switch
+       `(:key ,key :description ,description :type switch
+              :variable ,(car rest)
+              ,@(keymap-popup--extract-props (cdr rest))))
+      (:option
+       `(:key ,key :description ,description :type option
+              :variable ,(car rest)
+              ,@(keymap-popup--extract-props (cdr rest))))
+      (_
+       `(:key ,key :description ,description :type suffix
+              :command ,second
+              ,@(keymap-popup--extract-props rest))))))
+
+(defun keymap-popup--split-groups (bindings)
+  "Split BINDINGS at :group and :row keywords.
+Returns a list of rows, each row a list of (NAME . FLAT-ENTRIES) chunks.
+`:group' starts a new group within the current row.
+`:row' starts a new row."
+  (keymap-popup--split-groups-1 bindings nil nil nil nil))
+
+(defun keymap-popup--split-groups-1 (rest name entries groups rows)
+  "Recursive helper for `keymap-popup--split-groups'.
+REST is remaining bindings, NAME is current group name, ENTRIES
+is accumulated entries (reversed), GROUPS is current row's groups
+\(reversed), ROWS is accumulated rows (reversed)."
+  (let ((flush-group (if entries
+                         (cons (cons name (reverse entries)) groups)
+                       groups)))
+    (cond
+     ((null rest)
+      (reverse (if flush-group
+                    (cons (reverse flush-group) rows)
+                  rows)))
+     ((eq (car rest) :row)
+      (keymap-popup--split-groups-1
+       (cdr rest) nil nil nil
+       (if flush-group (cons (reverse flush-group) rows) rows)))
+     ((eq (car rest) :group)
+      (keymap-popup--split-groups-1
+       (cddr rest) (cadr rest) nil flush-group rows))
+     (t
+      (keymap-popup--split-groups-1
+       (cddr rest) name
+       (cons (cons (car rest) (cadr rest)) entries)
+       groups rows)))))
+
+(defun keymap-popup--parse-chunk (chunk)
+  "Parse CHUNK of (NAME . ((KEY . SPEC) ...)) into a group plist."
+  (let* ((name (car chunk))
+         (pairs (cdr chunk))
+         (entries (mapcar (lambda (pair)
+                            (keymap-popup--parse-entry (car pair) (cdr pair)))
+                          pairs)))
+    (list :name name :entries entries)))
+
+(defun keymap-popup--parse-bindings (bindings)
+  "Parse BINDINGS into a list of rows.
+Each row is a list of group plists with :name and :entries."
+  (mapcar (lambda (row) (mapcar #'keymap-popup--parse-chunk row))
+          (keymap-popup--split-groups bindings)))
+
+;;; Infix generators
+
+(defun keymap-popup--switch-forms (map-name entry)
+  "Return (defvar-local defun) forms for switch ENTRY in MAP-NAME."
+  (let* ((variable (plist-get entry :variable))
+         (description (plist-get entry :description))
+         (fn-name (intern (format "%s--toggle-%s" map-name variable))))
+    (list
+     `(defvar-local ,variable nil)
+     `(defun ,fn-name ()
+        ,(format "Toggle %s." description)
+        (interactive)
+        (setq-local ,variable (not ,variable))
+        (message "%s: %s" ,description (if ,variable "on" "off"))))))
+
+(defun keymap-popup--option-forms (map-name entry)
+  "Return (defvar-local defun) forms for option ENTRY in MAP-NAME."
+  (let* ((variable (plist-get entry :variable))
+         (description (plist-get entry :description))
+         (reader (or (plist-get entry :reader) 'read-string))
+         (prompt (or (plist-get entry :prompt) (format "%s: " description)))
+         (fn-name (intern (format "%s--set-%s" map-name variable))))
+    (list
+     `(defvar-local ,variable nil)
+     `(defun ,fn-name ()
+        ,(format "Set %s." description)
+        (interactive)
+        (setq-local ,variable (,reader ,prompt))
+        (message "%s: %s" ,description ,variable)))))
+
+(defun keymap-popup--entry-command (map-name entry)
+  "Return the command to bind in MAP-NAME's keymap for ENTRY."
+  (pcase (plist-get entry :type)
+    ('suffix (plist-get entry :command))
+    ('switch (intern (format "%s--toggle-%s" map-name (plist-get entry :variable))))
+    ('option (intern (format "%s--set-%s" map-name (plist-get entry :variable))))))
+
+;;; Macro helpers
+
+(defun keymap-popup--build-keymap-pairs (map-name entries)
+  "Build flat key/command list for `defvar-keymap' from ENTRIES.
+MAP-NAME is used to derive generated command names."
+  (cl-loop for entry in entries
+           for cmd = (keymap-popup--entry-command map-name entry)
+           append (list (plist-get entry :key)
+                        (if (symbolp cmd) `#',cmd cmd))))
+
+(defun keymap-popup--build-entry-form (entry)
+  "Build a `list' form for a single ENTRY that evaluates lambdas properly."
+  (let* ((desc (plist-get entry :description))
+         (desc-form (if (and (consp desc) (eq (car desc) 'lambda))
+                        desc
+                      `',desc))
+         (type (plist-get entry :type)))
+    (pcase type
+      ('suffix
+       (let* ((cmd (plist-get entry :command))
+              (cmd-form (if (and (consp cmd) (eq (car cmd) 'lambda))
+                            cmd
+                          `',cmd))
+              (if-pred (plist-get entry :if))
+              (stay-open (plist-get entry :stay-open)))
+         `(list :key ,(plist-get entry :key)
+                :description ,desc-form
+                :type 'suffix
+                :command ,cmd-form
+                ,@(when if-pred (list :if if-pred))
+                ,@(when stay-open (list :stay-open t)))))
+      ('switch
+       (let ((if-pred (plist-get entry :if)))
+         `(list :key ,(plist-get entry :key)
+                :description ,desc-form
+                :type 'switch
+                :variable ',(plist-get entry :variable)
+                ,@(when if-pred (list :if if-pred)))))
+      ('option
+       (let ((if-pred (plist-get entry :if)))
+         `(list :key ,(plist-get entry :key)
+                :description ,desc-form
+                :type 'option
+                :variable ',(plist-get entry :variable)
+                ,@(when if-pred (list :if if-pred))))))))
+
+(defun keymap-popup--build-descriptions-form (rows)
+  "Build a `list' form that constructs descriptions at load time.
+ROWS is a list of rows, each row a list of groups.
+Uses list calls so lambdas get compiled."
+  `(list ,@(mapcar
+            (lambda (row)
+              `(list ,@(mapcar
+                        (lambda (group)
+                          `(list :name ,(plist-get group :name)
+                                 :entries (list ,@(mapcar #'keymap-popup--build-entry-form
+                                                         (plist-get group :entries)))))
+                        row)))
+            rows)))
+
+;;; Macro
+
+(defun keymap-popup--extract-macro-opts (body)
+  "Extract macro options from BODY.
+Returns (DOCSTRING POPUP-KEY BINDINGS) where DOCSTRING and
+POPUP-KEY may be nil.  A string followed by a list is a key
+binding, not a docstring."
+  (let* ((docstring (when (and (stringp (car body))
+                               (not (listp (cadr body))))
+                      (car body)))
+         (rest (if docstring (cdr body) body))
+         (has-popup-key (eq (car rest) :popup-key))
+         (popup-key (if has-popup-key (cadr rest) "h"))
+         (bindings (if has-popup-key (cddr rest) rest)))
+    (list docstring popup-key bindings)))
+
+;;;###autoload
+(defmacro define-described-keymap (name &rest body)
+  "Define NAME as a keymap with embedded descriptions.
+BODY is an optional docstring, optional :popup-key KEY (default
+\"h\"), 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))
+         (bindings (nth 2 opts))
+         (rows (keymap-popup--parse-bindings bindings))
+         (all-entries (cl-loop for row in rows
+                               append (cl-loop for group in row
+                                               append (plist-get group :entries))))
+         (infix-forms (cl-loop for entry in all-entries
+                               append (pcase (plist-get entry :type)
+                                        ('switch (keymap-popup--switch-forms name entry))
+                                        ('option (keymap-popup--option-forms name entry))
+                                        (_ nil))))
+         (keymap-pairs (keymap-popup--build-keymap-pairs name all-entries)))
+    `(progn
+       ,@infix-forms
+       (defvar-keymap ,name
+         ,@(when docstring (list :doc docstring))
+         ,@keymap-pairs
+         ,popup-key (lambda () (interactive) (keymap-popup ',name)))
+       (put ',name 'keymap-popup--descriptions
+            ,(keymap-popup--build-descriptions-form rows)))))
+
+;;; Public API
+
+(defun keymap-popup--group-exists-p (rows group-name)
+  "Return non-nil if GROUP-NAME exists in ROWS."
+  (cl-loop for row in rows
+           thereis (cl-loop for group in row
+                            thereis (equal (plist-get group :name) group-name))))
+
+(defun keymap-popup--append-to-group (rows entry group-name)
+  "Return ROWS with ENTRY appended to groups matching GROUP-NAME."
+  (mapcar (lambda (row)
+            (mapcar (lambda (group)
+                      (if (equal (plist-get group :name) group-name)
+                          (list :name (plist-get group :name)
+                                :entries (append (plist-get group :entries)
+                                                 (list entry)))
+                        group))
+                    row))
+          rows))
+
+(defun keymap-popup--add-entry-to-rows (rows entry group-name)
+  "Return ROWS with ENTRY appended to the group named GROUP-NAME.
+Falls back to the first group if GROUP-NAME is not found."
+  (keymap-popup--append-to-group
+   rows entry
+   (if (keymap-popup--group-exists-p rows group-name)
+       group-name
+     (plist-get (caar rows) :name))))
+
+(defun keymap-popup--remove-key-from-rows (rows key)
+  "Return ROWS with entries matching KEY filtered out."
+  (mapcar (lambda (row)
+            (mapcar (lambda (group)
+                      (list :name (plist-get group :name)
+                            :entries (cl-remove-if
+                                      (lambda (e) (equal (plist-get e :key) key))
+                                      (plist-get group :entries))))
+                    row))
+          rows))
+
+;;;###autoload
+(defun keymap-popup-add-entry (map-symbol key description command &optional group)
+  "Add KEY binding with DESCRIPTION and COMMAND to MAP-SYMBOL.
+GROUP is the group name to add to (nil for the first group).
+Updates both the keymap and the popup descriptions."
+  (or (get map-symbol 'keymap-popup--descriptions)
+      (user-error "No descriptions for `%s'" map-symbol))
+  (keymap-set (symbol-value map-symbol) key command)
+  (let ((entry (list :key key :description description
+                     :type 'suffix :command command)))
+    (put map-symbol 'keymap-popup--descriptions
+         (keymap-popup--add-entry-to-rows
+          (get map-symbol 'keymap-popup--descriptions) entry group))))
+
+;;;###autoload
+(defun keymap-popup-remove-entry (map-symbol key)
+  "Remove KEY binding from MAP-SYMBOL.
+Updates both the keymap and the popup descriptions."
+  (keymap-set (symbol-value map-symbol) key nil)
+  (put map-symbol 'keymap-popup--descriptions
+       (keymap-popup--remove-key-from-rows
+        (get map-symbol 'keymap-popup--descriptions) key)))
+
+;;; Renderer
+
+(defun keymap-popup--resolve-description (desc)
+  "If DESC is a function, call it; otherwise return as-is."
+  (if (functionp desc) (funcall desc) desc))
+
+(defun keymap-popup--render-entry (entry)
+  "Render ENTRY into a formatted line, or nil if :if hides it."
+  (when (or (null (plist-get entry :if))
+            (funcall (plist-get entry :if)))
+    (let* ((desc (keymap-popup--resolve-description
+                  (plist-get entry :description)))
+           (key-str (propertize (plist-get entry :key)
+                                'face 'keymap-popup-key))
+           (value-str (pcase (plist-get entry :type)
+                        ('switch (propertize
+                                  (if (symbol-value (plist-get entry :variable))
+                                      " [on]" " [off]")
+                                  'face 'keymap-popup-value))
+                        ('option (propertize
+                                  (format " =%s"
+                                          (symbol-value (plist-get entry :variable)))
+                                  'face 'keymap-popup-value))
+                        (_ ""))))
+      (format "  %s  %s%s" key-str desc value-str))))
+
+(defun keymap-popup--render-group-lines (group)
+  "Render GROUP into a list of lines (strings).
+Returns nil if the group has no visible entries."
+  (let* ((header (when-let* ((raw-name (plist-get group :name))
+                             (name (keymap-popup--resolve-description raw-name)))
+                   (propertize name 'face 'keymap-popup-group-header)))
+         (lines (cl-loop for entry in (plist-get group :entries)
+                         for line = (keymap-popup--render-entry entry)
+                         when line collect line)))
+    (when lines
+      (if header (cons header lines) lines))))
+
+(defun keymap-popup--string-width-visible (str)
+  "Return the visible width of STR, ignoring text properties."
+  (string-width (substring-no-properties str)))
+
+(defun keymap-popup--pad-line (line width)
+  "Pad LINE with spaces to WIDTH (based on visible characters)."
+  (let ((visible-width (keymap-popup--string-width-visible line)))
+    (if (< visible-width width)
+        (concat line (make-string (- width visible-width) ?\s))
+      line)))
+
+(defun keymap-popup--column-width (col)
+  "Return the max visible width of lines in COL."
+  (cl-loop for line in col
+           maximize (keymap-popup--string-width-visible line)))
+
+(defun keymap-popup--join-columns (columns separator col-widths)
+  "Join COLUMNS side by side with SEPARATOR between them.
+COL-WIDTHS is a list of minimum widths per column position.
+Shorter columns are padded with blank lines."
+  (let* ((max-height (cl-loop for col in columns maximize (length col)))
+         (padded-cols (cl-mapcar
+                       (lambda (col width)
+                         (let ((padded (mapcar (lambda (line)
+                                                (keymap-popup--pad-line line width))
+                                              col))
+                               (blanks (make-list (- max-height (length col))
+                                                  (make-string width ?\s))))
+                           (append padded blanks)))
+                       columns col-widths)))
+    (cl-loop for row from 0 below max-height
+             collect (string-trim-right
+                      (mapconcat (lambda (col) (nth row col))
+                                 padded-cols
+                                 separator)))))
+
+(defun keymap-popup--rows-to-columns (rows)
+  "Render each row of ROWS into its list of column line-lists.
+Returns a list of ((col-lines ...) ...) per row, filtering empty groups."
+  (mapcar (lambda (row)
+            (cl-loop for group in row
+                     for lines = (keymap-popup--render-group-lines group)
+                     when lines collect lines))
+          rows))
+
+(defun keymap-popup--global-col-widths (rendered-rows)
+  "Compute max column width per position across all RENDERED-ROWS."
+  (let ((max-cols (cl-loop for cols in rendered-rows
+                           maximize (length cols))))
+    (cl-loop for i from 0 below max-cols
+             collect (cl-loop for cols in rendered-rows
+                              when (nth i cols)
+                              maximize (keymap-popup--column-width (nth i cols))))))
+
+(defun keymap-popup--render (docstring rows)
+  "Render DOCSTRING and ROWS into a complete popup string.
+ROWS is a list of rows, each row a list of groups.
+Column widths are aligned across all rows."
+  (let* ((doc (when docstring
+                (concat (propertize docstring 'face 'font-lock-doc-face)
+                        "\n")))
+         (rendered-rows (keymap-popup--rows-to-columns rows))
+         (col-widths (keymap-popup--global-col-widths rendered-rows))
+         (sections (cl-loop for cols in rendered-rows
+                            when cols
+                            collect (mapconcat #'identity
+                                              (keymap-popup--join-columns
+                                               cols "   " col-widths)
+                                              "\n"))))
+    (concat doc (mapconcat #'identity sections "\n") "\n")))
+
+;;; Popup display
+
+(defun keymap-popup--find-entry-by-key (descriptions key-str)
+  "Find the entry matching KEY-STR in DESCRIPTIONS.
+DESCRIPTIONS is a list of rows, each row a list of groups.
+Returns the entry plist, or nil."
+  (cl-loop for row in descriptions
+           thereis (cl-loop for group in row
+                            thereis (cl-loop for entry in (plist-get group :entries)
+                                             when (equal (plist-get entry :key) key-str)
+                                             return entry))))
+
+(defun keymap-popup--infix-p (descriptions key-str)
+  "Return non-nil if KEY-STR maps to an infix entry in DESCRIPTIONS."
+  (when-let* ((entry (keymap-popup--find-entry-by-key descriptions key-str)))
+    (memq (plist-get entry :type) '(switch option))))
+
+(defun keymap-popup--stay-open-p (descriptions key-str)
+  "Return non-nil if KEY-STR should keep the popup open.
+True for infixes and suffixes with :stay-open."
+  (when-let* ((entry (keymap-popup--find-entry-by-key descriptions key-str)))
+    (or (memq (plist-get entry :type) '(switch option))
+        (plist-get entry :stay-open))))
+
+(defun keymap-popup--refresh-buffer (buf map-symbol)
+  "Re-render the popup buffer BUF for MAP-SYMBOL."
+  (let* ((descriptions (get map-symbol 'keymap-popup--descriptions))
+         (docstring (documentation-property map-symbol 'variable-documentation))
+         (content (keymap-popup--render docstring descriptions)))
+    (with-current-buffer buf
+      (let ((inhibit-read-only t))
+        (erase-buffer)
+        (insert content)
+        (goto-char (point-min))))))
+
+(defun keymap-popup--prepare-buffer (map-symbol)
+  "Create and populate the popup buffer for MAP-SYMBOL."
+  (let ((buf (get-buffer-create "*keymap-popup*")))
+    (or (get map-symbol 'keymap-popup--descriptions)
+        (user-error "No descriptions for `%s'" map-symbol))
+    (with-current-buffer buf
+      (setq-local buffer-read-only t)
+      (setq-local cursor-type nil)
+      (setq-local mode-line-format nil))
+    (keymap-popup--refresh-buffer buf map-symbol)
+    buf))
+
+(defun keymap-popup--dismiss-p (key _cmd)
+  "Return non-nil if KEY should dismiss the popup.
+The keys `q' and `C-g' always dismiss."
+  (memq key '(?q ?\C-g)))
+
+(defun keymap-popup--read-loop (buf win map-symbol keymap descriptions)
+  "Read keys until a suffix or dismiss key is pressed.
+MAP-SYMBOL identifies the described keymap.  KEYMAP is the live
+keymap for command lookup.  DESCRIPTIONS is the stored metadata.
+Stay-open keys (infixes and :stay-open suffixes) execute and
+re-render BUF in WIN.  Returns the command to dispatch, or nil."
+  (cl-loop for key = (read-key)
+           for key-str = (key-description (vector key))
+           for cmd = (keymap-lookup keymap key-str)
+           when (keymap-popup--dismiss-p key cmd) return nil
+           when (and cmd (keymap-popup--stay-open-p descriptions key-str))
+           do (progn
+                (call-interactively cmd)
+                (keymap-popup--refresh-buffer buf map-symbol)
+                (when (and win (window-live-p win))
+                  (fit-window-to-buffer win)))
+           when (and cmd (not (keymap-popup--stay-open-p descriptions key-str)))
+           return cmd))
+
+;;;###autoload
+(defun keymap-popup (map-symbol)
+  "Show popup help for described keymap MAP-SYMBOL.
+Display in a bottom side window.  Infix keys (switches/options)
+execute and re-render without closing.  Suffix keys and dismiss
+keys close the popup."
+  (interactive)
+  (let* ((buf (keymap-popup--prepare-buffer map-symbol))
+         (keymap (symbol-value map-symbol))
+         (descriptions (get map-symbol 'keymap-popup--descriptions)))
+    (unwind-protect
+        (let* ((win (display-buffer buf
+                                    '(display-buffer-in-side-window
+                                      (side . bottom)
+                                      (window-height . fit-window-to-buffer))))
+               (_ (when win (fit-window-to-buffer win)))
+               (final-cmd (keymap-popup--read-loop
+                           buf win map-symbol keymap descriptions)))
+          (when (and win (window-live-p win))
+            (delete-window win))
+          (when final-cmd
+            (call-interactively final-cmd)))
+      (when (buffer-live-p buf)
+        (kill-buffer buf)))))
+
+(provide 'keymap-popup)
+;;; keymap-popup.el ends here
diff --git a/tests/keymap-popup-tests.el b/tests/keymap-popup-tests.el
new file mode 100644
index 0000000..a5192a4
--- /dev/null
+++ b/tests/keymap-popup-tests.el
@@ -0,0 +1,492 @@
+;;; keymap-popup-tests.el --- Tests -*- lexical-binding: t; -*-
+
+(require 'ert)
+(load (expand-file-name "../keymap-popup.el"
+       (file-name-directory (or load-file-name buffer-file-name))))
+
+;;; Parser tests
+
+(ert-deftest keymap-popup-test-parse-suffix-entry ()
+  "A plain suffix entry parses to type suffix."
+  (let ((result (keymap-popup--parse-entry "c" '("Comment" forgejo-view-comment))))
+    (should (equal (plist-get result :key) "c"))
+    (should (equal (plist-get result :description) "Comment"))
+    (should (equal (plist-get result :command) 'forgejo-view-comment))
+    (should (equal (plist-get result :type) 'suffix))))
+
+(ert-deftest keymap-popup-test-parse-suffix-with-if ()
+  "A suffix with :if stores the predicate."
+  (let* ((pred (lambda () t))
+         (result (keymap-popup--parse-entry "b" `("Browse" forgejo-browse :if ,pred))))
+    (should (equal (plist-get result :type) 'suffix))
+    (should (eq (plist-get result :if) pred))))
+
+(ert-deftest keymap-popup-test-parse-switch-entry ()
+  "A switch entry parses to type switch with variable."
+  (let ((result (keymap-popup--parse-entry "v" '("Verbose" :switch my-verbose-var))))
+    (should (equal (plist-get result :type) 'switch))
+    (should (equal (plist-get result :variable) 'my-verbose-var))))
+
+(ert-deftest keymap-popup-test-parse-option-entry ()
+  "An option entry parses with variable, reader, prompt."
+  (let ((result (keymap-popup--parse-entry "n" '("Count" :option my-count-var
+                                                  :reader read-number :prompt "Count: "))))
+    (should (equal (plist-get result :type) 'option))
+    (should (equal (plist-get result :variable) 'my-count-var))
+    (should (equal (plist-get result :reader) 'read-number))
+    (should (equal (plist-get result :prompt) "Count: "))))
+
+(ert-deftest keymap-popup-test-parse-dynamic-description ()
+  "Dynamic description (function) is preserved."
+  (let* ((desc-fn (lambda () "dynamic"))
+         (result (keymap-popup--parse-entry "d" `(,desc-fn some-command))))
+    (should (functionp (plist-get result :description)))))
+
+(ert-deftest keymap-popup-test-parse-bindings-groups ()
+  "Parse binding list with :group keywords into rows of groups."
+  (let* ((rows (keymap-popup--parse-bindings
+                '(:group "Actions"
+                  "c" ("Comment" forgejo-view-comment)
+                  "r" ("Reply" forgejo-issue-reply)
+                  :group "Navigate"
+                  "g" ("Refresh" forgejo-view-refresh)
+                  "q" ("Quit" quit-window))))
+         (row (car rows)))
+    ;; One row with two groups
+    (should (= (length rows) 1))
+    (should (= (length row) 2))
+    (should (equal (plist-get (car row) :name) "Actions"))
+    (should (= (length (plist-get (car row) :entries)) 2))
+    (should (equal (plist-get (cadr row) :name) "Navigate"))
+    (should (= (length (plist-get (cadr row) :entries)) 2))))
+
+(ert-deftest keymap-popup-test-parse-bindings-no-group ()
+  "Entries before any :group go into unnamed default group."
+  (let* ((rows (keymap-popup--parse-bindings
+                '("c" ("Comment" forgejo-view-comment)
+                  "r" ("Reply" forgejo-issue-reply))))
+         (row (car rows)))
+    (should (= (length rows) 1))
+    (should (= (length row) 1))
+    (should (null (plist-get (car row) :name)))
+    (should (= (length (plist-get (car row) :entries)) 2))))
+
+(ert-deftest keymap-popup-test-parse-bindings-rows ()
+  "Parse binding list with :row keyword into multiple rows."
+  (let ((rows (keymap-popup--parse-bindings
+               '(:group "A"
+                 "a" ("Aaa" ignore)
+                 :group "B"
+                 "b" ("Bbb" ignore)
+                 :row
+                 :group "C"
+                 "c" ("Ccc" ignore)))))
+    (should (= (length rows) 2))
+    ;; First row has 2 groups
+    (should (= (length (car rows)) 2))
+    ;; Second row has 1 group
+    (should (= (length (cadr rows)) 1))
+    (should (equal (plist-get (caar (cdr rows)) :name) "C"))))
+
+;;; Infix generator tests
+
+(ert-deftest keymap-popup-test-switch-forms ()
+  "Generate defvar-local and toggle defun for a switch."
+  (let* ((entry '(:key "v" :description "Verbose" :type switch
+                        :variable my-verbose-var))
+         (forms (keymap-popup--switch-forms 'test-map entry)))
+    (should (= (length forms) 2))
+    (should (eq (car (nth 0 forms)) 'defvar-local))
+    (should (eq (cadr (nth 0 forms)) 'my-verbose-var))
+    (should (eq (car (nth 1 forms)) 'defun))
+    (should (eq (cadr (nth 1 forms)) 'test-map--toggle-my-verbose-var))))
+
+(ert-deftest keymap-popup-test-option-forms ()
+  "Generate defvar-local and setter defun for an option."
+  (let* ((entry '(:key "n" :description "Count" :type option
+                        :variable my-count-var :reader read-number :prompt "Count: "))
+         (forms (keymap-popup--option-forms 'test-map entry)))
+    (should (= (length forms) 2))
+    (should (eq (car (nth 0 forms)) 'defvar-local))
+    (should (eq (cadr (nth 0 forms)) 'my-count-var))
+    (should (eq (car (nth 1 forms)) 'defun))
+    (should (eq (cadr (nth 1 forms)) 'test-map--set-my-count-var))))
+
+(ert-deftest keymap-popup-test-entry-command ()
+  "Derive correct command symbol for each entry type."
+  (should (eq (keymap-popup--entry-command 'map '(:type suffix :command my-cmd))
+              'my-cmd))
+  (should (eq (keymap-popup--entry-command 'map '(:type switch :variable my-var))
+              'map--toggle-my-var))
+  (should (eq (keymap-popup--entry-command 'map '(:type option :variable my-var))
+              'map--set-my-var)))
+
+;;; Macro tests
+
+(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
+           "Test keymap."
+           :group "Actions"
+           "c" ("Comment" ignore)
+           "q" ("Quit" quit-window))
+        t)
+  (should (keymapp keymap-popup--test-map-1))
+  (should (eq (keymap-lookup keymap-popup--test-map-1 "c") #'ignore))
+  (should (eq (keymap-lookup keymap-popup--test-map-1 "q") #'quit-window)))
+
+(ert-deftest keymap-popup-test-macro-stores-descriptions ()
+  "Macro stores descriptions as rows of groups."
+  (eval '(define-described-keymap keymap-popup--test-map-2
+           "Test."
+           :group "A"
+           "c" ("Comment" ignore)
+           :group "B"
+           "g" ("Go" ignore))
+        t)
+  (let* ((descs (get 'keymap-popup--test-map-2 'keymap-popup--descriptions))
+         (row (car descs)))
+    ;; One row with two groups
+    (should (= (length descs) 1))
+    (should (= (length row) 2))
+    (should (equal (plist-get (car row) :name) "A"))
+    (should (equal (plist-get (cadr row) :name) "B"))))
+
+(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
+           "Test."
+           "v" ("Verbose" :switch keymap-popup--test-sw))
+        t)
+  (should (boundp 'keymap-popup--test-sw))
+  (should (fboundp 'keymap-popup--test-map-3--toggle-keymap-popup--test-sw)))
+
+(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
+           "Test."
+           "n" ("Count" :option keymap-popup--test-opt
+                :reader read-number :prompt "N: "))
+        t)
+  (should (boundp 'keymap-popup--test-opt))
+  (should (fboundp 'keymap-popup--test-map-4--set-keymap-popup--test-opt)))
+
+(ert-deftest keymap-popup-test-macro-lambda-command ()
+  "Lambda commands bind directly in the keymap."
+  (eval '(define-described-keymap keymap-popup--test-map-5
+           "Test."
+           "x" ("Run" (lambda () (interactive) (message "running"))))
+        t)
+  (should (functionp (keymap-lookup keymap-popup--test-map-5 "x"))))
+
+(ert-deftest keymap-popup-test-macro-no-docstring ()
+  "Macro works without a docstring."
+  (eval '(define-described-keymap keymap-popup--test-map-nodoc
+           :group "Actions"
+           "c" ("Comment" ignore))
+        t)
+  (should (keymapp keymap-popup--test-map-nodoc))
+  (should (eq (keymap-lookup keymap-popup--test-map-nodoc "c") #'ignore))
+  (let* ((descs (get 'keymap-popup--test-map-nodoc 'keymap-popup--descriptions))
+         (row (car descs)))
+    (should (= (length descs) 1))
+    (should (= (length row) 1))
+    (should (equal (plist-get (car row) :name) "Actions"))))
+
+(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
+           "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
+           :popup-key "?"
+           "c" ("Comment" ignore))
+        t)
+  (should (functionp (keymap-lookup keymap-popup--test-map-custkey "?")))
+  (should (null (keymap-lookup keymap-popup--test-map-custkey "h"))))
+
+;;; Renderer tests
+
+(ert-deftest keymap-popup-test-render-suffix ()
+  "Render suffix entry with key and description."
+  (let* ((rows (list (list (list :name "Actions"
+                                 :entries (list (list :key "c" :description "Comment"
+                                                      :type 'suffix :command 'ignore))))))
+         (output (keymap-popup--render "Test." rows)))
+    (should (string-match-p "Test\\." output))
+    (should (string-match-p "Actions" output))
+    (should (string-match-p "Comment" output))))
+
+(ert-deftest keymap-popup-test-render-switch-value ()
+  "Render switch showing [on]/[off] based on variable."
+  (defvar keymap-popup--test-render-sw nil)
+  (let* ((rows (list (list (list :name nil
+                                 :entries (list (list :key "v" :description "Verbose"
+                                                      :type 'switch
+                                                      :variable 'keymap-popup--test-render-sw))))))
+         (output-off (keymap-popup--render nil rows)))
+    (should (string-match-p "\\[off\\]" output-off))
+    (setq keymap-popup--test-render-sw t)
+    (let ((output-on (keymap-popup--render nil rows)))
+      (should (string-match-p "\\[on\\]" output-on)))))
+
+(ert-deftest keymap-popup-test-render-option-value ()
+  "Render option showing =VALUE."
+  (defvar keymap-popup--test-render-opt 42)
+  (let* ((rows (list (list (list :name nil
+                                 :entries (list (list :key "n" :description "Count"
+                                                      :type 'option
+                                                      :variable 'keymap-popup--test-render-opt))))))
+         (output (keymap-popup--render nil rows)))
+    (should (string-match-p "=42" output))))
+
+(ert-deftest keymap-popup-test-render-if-hidden ()
+  "Entry with :if returning nil is omitted."
+  (let* ((rows (list (list (list :name nil
+                                 :entries (list (list :key "b" :description "Browse"
+                                                      :type 'suffix :command 'ignore
+                                                      :if (lambda () nil)))))))
+         (output (keymap-popup--render nil rows)))
+    (should-not (string-match-p "Browse" output))))
+
+(ert-deftest keymap-popup-test-render-if-shown ()
+  "Entry with :if returning t is included."
+  (let* ((rows (list (list (list :name nil
+                                 :entries (list (list :key "b" :description "Browse"
+                                                      :type 'suffix :command 'ignore
+                                                      :if (lambda () t)))))))
+         (output (keymap-popup--render nil rows)))
+    (should (string-match-p "Browse" output))))
+
+(ert-deftest keymap-popup-test-render-dynamic-description ()
+  "Dynamic description function is called at render time."
+  (let* ((rows (list (list (list :name nil
+                                 :entries (list (list :key "d"
+                                                      :description (lambda () "Dynamic!")
+                                                      :type 'suffix :command 'ignore))))))
+         (output (keymap-popup--render nil rows)))
+    (should (string-match-p "Dynamic!" output))))
+
+;;; Popup function tests
+
+(ert-deftest keymap-popup-test-prepare-buffer ()
+  "Prepare-buffer creates a buffer with rendered content."
+  (eval '(define-described-keymap keymap-popup--test-popup-map
+           "Popup test."
+           :group "Commands"
+           "c" ("Comment" ignore)
+           "q" ("Quit" quit-window))
+        t)
+  (let ((buf (keymap-popup--prepare-buffer 'keymap-popup--test-popup-map)))
+    (unwind-protect
+        (with-current-buffer buf
+          (should (string-match-p "Commands" (buffer-string)))
+          (should (string-match-p "Comment" (buffer-string))))
+      (kill-buffer buf))))
+
+(ert-deftest keymap-popup-test-no-descriptions-error ()
+  "Signal user-error when symbol has no descriptions."
+  (should-error (keymap-popup 'nonexistent-symbol) :type 'user-error))
+
+(ert-deftest keymap-popup-test-dismiss-c-g ()
+  "C-g always dismisses."
+  (should (keymap-popup--dismiss-p ?\C-g #'ignore))
+  (should (keymap-popup--dismiss-p ?\C-g nil)))
+
+(ert-deftest keymap-popup-test-dismiss-q ()
+  "q always dismisses the popup, even if bound in the keymap."
+  (should (keymap-popup--dismiss-p ?q nil))
+  (should (keymap-popup--dismiss-p ?q #'quit-window)))
+
+(ert-deftest keymap-popup-test-no-dismiss-other ()
+  "Other keys do not dismiss."
+  (should-not (keymap-popup--dismiss-p ?c nil))
+  (should-not (keymap-popup--dismiss-p ?c #'ignore)))
+
+;;; Column layout tests
+
+(ert-deftest keymap-popup-test-render-columns-side-by-side ()
+  "Groups in the same row render as side-by-side columns."
+  (let* ((rows (list (list (list :name "Alpha"
+                                 :entries (list (list :key "a" :description "Aaa"
+                                                      :type 'suffix :command 'ignore)))
+                           (list :name "Beta"
+                                 :entries (list (list :key "b" :description "Bbb"
+                                                      :type 'suffix :command 'ignore))))))
+         (output (keymap-popup--render nil rows))
+         (lines (split-string output "\n" t)))
+    (should (string-match-p "Alpha" (car lines)))
+    (should (string-match-p "Beta" (car lines)))))
+
+(ert-deftest keymap-popup-test-render-rows-separated ()
+  "Groups in different rows render on separate lines."
+  (let* ((rows (list (list (list :name "Row1"
+                                 :entries (list (list :key "a" :description "Aaa"
+                                                      :type 'suffix :command 'ignore))))
+                     (list (list :name "Row2"
+                                 :entries (list (list :key "b" :description "Bbb"
+                                                      :type 'suffix :command 'ignore))))))
+         (output (keymap-popup--render nil rows)))
+    (should (string-match-p "Row1" output))
+    (should (string-match-p "Row2" output))
+    ;; Row1 and Row2 should NOT be on the same line
+    (let ((lines (split-string output "\n" t)))
+      (should-not (and (string-match-p "Row1" (car lines))
+                       (string-match-p "Row2" (car lines)))))))
+
+(ert-deftest keymap-popup-test-columns-aligned-across-rows ()
+  "Column positions align across rows."
+  (let* ((rows (list
+                ;; Row 1: short col 1, long col 2
+                (list (list :name "A"
+                            :entries (list (list :key "a" :description "X"
+                                                  :type 'suffix :command 'ignore)))
+                      (list :name "B"
+                            :entries (list (list :key "b" :description "Y"
+                                                  :type 'suffix :command 'ignore))))
+                ;; Row 2: long col 1, short col 2
+                (list (list :name "Longer Name"
+                            :entries (list (list :key "c" :description "Something longer"
+                                                  :type 'suffix :command 'ignore)))
+                      (list :name "D"
+                            :entries (list (list :key "d" :description "Z"
+                                                  :type 'suffix :command 'ignore))))))
+         (output (keymap-popup--render nil rows))
+         (plain (substring-no-properties output))
+         (lines (split-string plain "\n" t)))
+    ;; Find lines containing each second-column header
+    (let ((b-pos (string-match "B" (cl-find-if (lambda (l) (string-match-p "\\bB\\b" l)) lines)))
+          (d-pos (string-match "D" (cl-find-if (lambda (l) (string-match-p "\\bD\\b" l)) lines))))
+      (should b-pos)
+      (should d-pos)
+      (should (= b-pos d-pos)))))
+
+(ert-deftest keymap-popup-test-join-columns ()
+  "Join columns pads shorter columns with blanks."
+  (let* ((col-a '("Header A" "  a  Aaa" "  b  Bbb"))
+         (col-b '("Header B" "  c  Ccc"))
+         (widths (list (keymap-popup--column-width col-a)
+                       (keymap-popup--column-width col-b)))
+         (result (keymap-popup--join-columns (list col-a col-b) "  " widths)))
+    (should (= (length result) 3))
+    (should (string-match-p "Header A" (nth 0 result)))
+    (should (string-match-p "Header B" (nth 0 result)))
+    (should (string-match-p "Bbb" (nth 2 result)))))
+
+;;; Infix detection tests
+
+(ert-deftest keymap-popup-test-find-entry-by-key ()
+  "Find entry by key in descriptions (rows of groups)."
+  (let ((descs (list (list (list :name "G"
+                                 :entries (list (list :key "c" :description "Comment"
+                                                      :type 'suffix :command 'ignore)
+                                                (list :key "v" :description "Verbose"
+                                                      :type 'switch :variable 'some-var)))))))
+    (should (equal (plist-get (keymap-popup--find-entry-by-key descs "c") :type) 'suffix))
+    (should (equal (plist-get (keymap-popup--find-entry-by-key descs "v") :type) 'switch))
+    (should (null (keymap-popup--find-entry-by-key descs "z")))))
+
+(ert-deftest keymap-popup-test-infix-p ()
+  "Correctly identify infix vs suffix entries."
+  (let ((descs (list (list (list :name nil
+                                 :entries (list (list :key "c" :type 'suffix :command 'ignore)
+                                                (list :key "v" :type 'switch :variable 'x)
+                                                (list :key "n" :type 'option :variable 'y)))))))
+    (should-not (keymap-popup--infix-p descs "c"))
+    (should (keymap-popup--infix-p descs "v"))
+    (should (keymap-popup--infix-p descs "n"))
+    (should-not (keymap-popup--infix-p descs "z"))))
+
+;;; 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 test."
+           :group "Actions"
+           "c" ("Comment" ignore)
+           :group "Options"
+           "v" ("Verbose" :switch keymap-popup--test-full-verbose)
+           "n" ("Count" :option keymap-popup--test-full-count
+                :reader read-number :prompt "N: ")
+           :row
+           :group "Navigate"
+           "b" ("Browse" ignore :if (lambda () t))
+           "q" ("Quit" quit-window))
+        t)
+  (should (keymapp keymap-popup--test-full))
+  (should (eq (keymap-lookup keymap-popup--test-full "c") #'ignore))
+  (let ((descs (get 'keymap-popup--test-full 'keymap-popup--descriptions)))
+    ;; Two rows
+    (should (= (length descs) 2)))
+  (let ((buf (keymap-popup--prepare-buffer 'keymap-popup--test-full)))
+    (unwind-protect
+        (with-current-buffer buf
+          (should (string-match-p "Comment" (buffer-string)))
+          (should (string-match-p "\\[off\\]" (buffer-string))))
+      (kill-buffer buf))))
+
+(ert-deftest keymap-popup-test-switch-toggle-roundtrip ()
+  "Toggle command flips buffer-local variable."
+  (eval '(define-described-keymap keymap-popup--test-rt
+           "Test." "v" ("Verbose" :switch keymap-popup--test-rt-sw))
+        t)
+  (with-temp-buffer
+    (should (null keymap-popup--test-rt-sw))
+    (funcall-interactively #'keymap-popup--test-rt--toggle-keymap-popup--test-rt-sw)
+    (should (eq keymap-popup--test-rt-sw t))
+    (funcall-interactively #'keymap-popup--test-rt--toggle-keymap-popup--test-rt-sw)
+    (should (null keymap-popup--test-rt-sw))))
+
+(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
+           "Test."
+           "b" ("Browse" ignore :if (lambda () nil))
+           "c" ("Comment" ignore))
+        t)
+  (let ((buf (keymap-popup--prepare-buffer 'keymap-popup--test-cond)))
+    (unwind-protect
+        (with-current-buffer buf
+          (should-not (string-match-p "Browse" (buffer-string)))
+          (should (string-match-p "Comment" (buffer-string))))
+      (kill-buffer buf))))
+
+;;; Add/remove entry tests
+
+(ert-deftest keymap-popup-test-add-entry ()
+  "Add an entry to an existing described keymap."
+  (eval '(define-described-keymap keymap-popup--test-add
+           :group "Actions"
+           "c" ("Comment" ignore))
+        t)
+  (keymap-popup-add-entry 'keymap-popup--test-add "z" "New" #'forward-char "Actions")
+  (should (eq (keymap-lookup keymap-popup--test-add "z") #'forward-char))
+  (let ((buf (keymap-popup--prepare-buffer 'keymap-popup--test-add)))
+    (unwind-protect
+        (with-current-buffer buf
+          (should (string-match-p "New" (buffer-string))))
+      (kill-buffer buf))))
+
+(ert-deftest keymap-popup-test-remove-entry ()
+  "Remove an entry from an existing described keymap."
+  (eval '(define-described-keymap keymap-popup--test-rm
+           :group "Actions"
+           "c" ("Comment" ignore)
+           "r" ("Reply" ignore))
+        t)
+  (keymap-popup-remove-entry 'keymap-popup--test-rm "r")
+  (should (null (keymap-lookup keymap-popup--test-rm "r")))
+  (let ((buf (keymap-popup--prepare-buffer 'keymap-popup--test-rm)))
+    (unwind-protect
+        (with-current-buffer buf
+          (should (string-match-p "Comment" (buffer-string)))
+          (should-not (string-match-p "Reply" (buffer-string))))
+      (kill-buffer buf))))
+
+(provide 'keymap-popup-tests)
+;;; keymap-popup-tests.el ends here