render: move docstring to mode-line with exit-key displayexternals/keymap-popup

2 files changed, 55 insertions, 45 deletions

diff --git a/keymap-popup.el b/keymap-popup.el
index ba48420..26db804 100644
--- a/keymap-popup.el
+++ b/keymap-popup.el
@@ -88,7 +88,13 @@ visibility) when creating the child frame."
 (defcustom keymap-popup-buffer-parameters
   '((buffer-read-only . t)
     (cursor-type . nil)
-    (mode-line-format . nil)
+    (mode-line-format
+     . (" "
+        (:eval (when keymap-popup--active-exit-key
+                 (propertize (format " %s " keymap-popup--active-exit-key)
+                             'face 'keymap-popup-key)))
+        " "
+        (:eval (or keymap-popup--resolved-docstring ""))))
     (header-line-format . nil)
     (tab-line-format . nil)
     (left-margin-width . 1)
@@ -604,19 +610,12 @@ Returns a list of ((col-lines ...) ...) per row, filtering empty groups."
                               when (nth i cols)
                               maximize (keymap-popup--column-width (nth i cols))))))
 
-(defun keymap-popup--render (docstring rows &optional prefix-mode)
-  "Render DOCSTRING and ROWS into a complete popup string.
+(defun keymap-popup--render (rows &optional prefix-mode)
+  "Render ROWS into a complete popup string.
 ROWS is a list of rows, each row a list of groups.
 When PREFIX-MODE is non-nil, highlight :c-u entries and dim others.
 Column widths are aligned across all rows."
-  (let* ((resolved (when docstring
-                     (keymap-popup--resolve-description docstring)))
-         (doc (when resolved
-                (concat (if (text-properties-at 0 resolved)
-                            resolved
-                          (propertize resolved 'face 'font-lock-doc-face))
-                        "\n")))
-         (rendered-rows (keymap-popup--rows-to-columns rows prefix-mode))
+  (let* ((rendered-rows (keymap-popup--rows-to-columns rows prefix-mode))
          (col-widths (keymap-popup--global-col-widths rendered-rows))
          (sections (cl-loop for cols in rendered-rows
                             when cols
@@ -624,7 +623,7 @@ Column widths are aligned across all rows."
                                                (keymap-popup--join-columns
 						cols "   " col-widths)
                                                "\n"))))
-    (concat doc (mapconcat #'identity sections "\n") "\n")))
+    (concat (mapconcat #'identity sections "\n") "\n")))
 
 ;;; Popup state
 
@@ -644,6 +643,10 @@ Switch variables are buffer-local there, so rendering must read
   "Non-nil when C-u prefix mode is active.")
 (defvar-local keymap-popup--reentering nil
   "Non-nil when a sub-menu just popped, preventing cascading exit.")
+(defvar-local keymap-popup--active-exit-key nil
+  "The exit key for the currently active popup.")
+(defvar-local keymap-popup--resolved-docstring nil
+  "Resolved docstring string for mode-line display.")
 (defvar-local keymap-popup--display-backend nil
   "The active display backend plist (:show :fit :hide).")
 
@@ -711,11 +714,10 @@ True for switches, stay-open suffixes, inapt keys, and :keymap entries."
       (keymap-popup--inapt-p descriptions key-str)
       (keymap-popup--keymap-target descriptions key-str)))
 
-(defun keymap-popup--refresh-buffer (buf descriptions &optional docstring prefix-mode)
+(defun keymap-popup--refresh-buffer (buf descriptions &optional prefix-mode)
   "Re-render popup BUF with DESCRIPTIONS, refit via backend.
-DOCSTRING is shown at the top if non-nil.  PREFIX-MODE toggles
-prefix argument highlighting."
-  (let ((content (keymap-popup--render docstring descriptions prefix-mode)))
+PREFIX-MODE toggles prefix argument highlighting."
+  (let ((content (keymap-popup--render descriptions prefix-mode)))
     (with-current-buffer buf
       (let ((inhibit-read-only t))
         (erase-buffer)
@@ -728,14 +730,18 @@ prefix argument highlighting."
 (defun keymap-popup--refresh (buf)
   "Re-render popup BUF from its buffer-local state.
 Renders in the source buffer's context so `symbol-value' for
-switch variables sees the user's buffer-local values."
+switch variables sees the user's buffer-local values.
+Resolves the docstring for mode-line display."
   (when (buffer-live-p buf)
     (let ((source (buffer-local-value 'keymap-popup--source-buffer buf))
           (descs (buffer-local-value 'keymap-popup--active-descriptions buf))
           (doc (buffer-local-value 'keymap-popup--active-docstring buf))
           (prefix (buffer-local-value 'keymap-popup--prefix-mode buf)))
       (with-current-buffer (if (buffer-live-p source) source buf)
-        (keymap-popup--refresh-buffer buf descs doc prefix)))))
+        (with-current-buffer buf
+          (setq-local keymap-popup--resolved-docstring
+                      (when doc (keymap-popup--resolve-description doc))))
+        (keymap-popup--refresh-buffer buf descs prefix)))))
 
 (defun keymap-popup--resolve-key (entry keymap)
   "Resolve ENTRY's :command to a key in KEYMAP.
@@ -865,11 +871,13 @@ Pops the sub-menu stack if non-empty, otherwise tears down."
     (when (buffer-live-p buf)
       (with-current-buffer buf
         (if keymap-popup--stack
-            (pcase-let ((`(:keymap ,km :descriptions ,descs :docstring ,doc)
+            (pcase-let ((`(:keymap ,km :descriptions ,descs :docstring ,doc
+                                   :exit-key ,ek)
                          (pop keymap-popup--stack)))
               (setq-local keymap-popup--active-keymap km
                           keymap-popup--active-descriptions descs
                           keymap-popup--active-docstring doc
+                          keymap-popup--active-exit-key ek
                           keymap-popup--reentering t
                           keymap-popup--prefix-mode nil)
               (keymap-popup--refresh buf))
@@ -931,7 +939,8 @@ Includes keys with entry-level or group-level :inapt-if."
   (with-current-buffer buf
     (push (list :keymap keymap-popup--active-keymap
                 :descriptions keymap-popup--active-descriptions
-                :docstring keymap-popup--active-docstring)
+                :docstring keymap-popup--active-docstring
+                :exit-key keymap-popup--active-exit-key)
           keymap-popup--stack)
     (let* ((raw (keymap-popup--collect-descriptions child-keymap))
            (descs (if (keymap-popup--meta child-keymap 'annotated)
@@ -943,6 +952,7 @@ Includes keys with entry-level or group-level :inapt-if."
       (setq-local keymap-popup--active-keymap child-keymap
                   keymap-popup--active-descriptions descs
                   keymap-popup--active-docstring doc
+                  keymap-popup--active-exit-key exit-key
                   keymap-popup--prefix-mode nil)
       (keymap-popup--refresh buf)
       (set-transient-map
@@ -1064,6 +1074,7 @@ navigation stack.  \\[universal-argument] toggles prefix mode."
                   keymap-popup--active-keymap keymap
                   keymap-popup--active-descriptions descriptions
                   keymap-popup--active-docstring docstring
+                  keymap-popup--active-exit-key exit-key
                   keymap-popup--display-backend backend
                   keymap-popup--stack nil
                   keymap-popup--prefix-mode nil
diff --git a/tests/keymap-popup-tests.el b/tests/keymap-popup-tests.el
index 293e5b1..a5ce3c5 100644
--- a/tests/keymap-popup-tests.el
+++ b/tests/keymap-popup-tests.el
@@ -193,8 +193,7 @@
   (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))
+         (output (keymap-popup--render rows)))
     (should (string-match-p "Actions" output))
     (should (string-match-p "Comment" output))))
 
@@ -204,10 +203,10 @@
                                  :entries (list (list :key "v" :description "Verbose"
                                                       :type 'switch
                                                       :variable 'keymap-popup--test-render-sw))))))
-         (output-off (keymap-popup--render nil rows)))
+         (output-off (keymap-popup--render rows)))
     (should (string-match-p "\\[off\\]" output-off))
     (setq keymap-popup--test-render-sw t)
-    (let ((output-on (keymap-popup--render nil rows)))
+    (let ((output-on (keymap-popup--render rows)))
       (should (string-match-p "\\[on\\]" output-on)))))
 
 (ert-deftest keymap-popup-test-render-if-hidden ()
@@ -215,7 +214,7 @@
                                  :entries (list (list :key "b" :description "Browse"
                                                       :type 'suffix :command 'ignore
                                                       :if (lambda () nil)))))))
-         (output (keymap-popup--render nil rows)))
+         (output (keymap-popup--render rows)))
     (should-not (string-match-p "Browse" output))))
 
 (ert-deftest keymap-popup-test-render-if-shown ()
@@ -223,7 +222,7 @@
                                  :entries (list (list :key "b" :description "Browse"
                                                       :type 'suffix :command 'ignore
                                                       :if (lambda () t)))))))
-         (output (keymap-popup--render nil rows)))
+         (output (keymap-popup--render rows)))
     (should (string-match-p "Browse" output))))
 
 (ert-deftest keymap-popup-test-render-dynamic-description ()
@@ -231,7 +230,7 @@
                                  :entries (list (list :key "d"
                                                       :description (lambda () "Dynamic!")
                                                       :type 'suffix :command 'ignore))))))
-         (output (keymap-popup--render nil rows)))
+         (output (keymap-popup--render rows)))
     (should (string-match-p "Dynamic!" output))))
 
 ;;; Column layout tests
@@ -243,7 +242,7 @@
                            (list :name "Beta"
                                  :entries (list (list :key "b" :description "Bbb"
                                                       :type 'suffix :command 'ignore))))))
-         (output (keymap-popup--render nil rows))
+         (output (keymap-popup--render rows))
          (lines (split-string output "\n" t)))
     (should (string-match-p "Alpha" (car lines)))
     (should (string-match-p "Beta" (car lines)))))
@@ -255,7 +254,7 @@
                      (list (list :name "Row2"
                                  :entries (list (list :key "b" :description "Bbb"
                                                       :type 'suffix :command 'ignore))))))
-         (output (keymap-popup--render nil rows)))
+         (output (keymap-popup--render rows)))
     (should (string-match-p "Row1" output))
     (should (string-match-p "Row2" output))
     (let ((lines (split-string output "\n" t)))
@@ -276,7 +275,7 @@
                       (list :name "D"
                             :entries (list (list :key "d" :description "Z"
                                                  :type 'suffix :command 'ignore))))))
-         (output (keymap-popup--render nil rows))
+         (output (keymap-popup--render rows))
          (plain (substring-no-properties output))
          (lines (split-string plain "\n" t)))
     (let ((b-pos (string-match "B" (cl-find-if (lambda (l) (string-match-p "\\bB\\b" l)) lines)))
@@ -369,7 +368,7 @@
                                  :entries (list (list :key "s" :description "Submit"
                                                       :type 'suffix :command 'ignore
                                                       :c-u "force push"))))))
-         (output (keymap-popup--render nil rows)))
+         (output (keymap-popup--render rows)))
     (should (string-match-p "(force push)" output))
     (let ((pos (string-match "(force push)" output)))
       (should (eq (get-text-property pos 'face output) 'shadow)))))
@@ -381,7 +380,7 @@
                                                       :c-u "force")
                                                 (list :key "g" :description "Refresh"
                                                       :type 'suffix :command 'ignore))))))
-         (output (keymap-popup--render nil rows t)))
+         (output (keymap-popup--render rows t)))
     (let ((pos (string-match "(force)" output)))
       (should pos)
       (should-not (eq (get-text-property pos 'face output) 'shadow)))
@@ -395,7 +394,7 @@
                                  :entries (list (list :key "m" :description "Merge"
                                                       :type 'suffix :command 'ignore
                                                       :inapt-if (lambda () t)))))))
-         (output (keymap-popup--render nil rows)))
+         (output (keymap-popup--render rows)))
     (should (string-match-p "Merge" output))
     (let ((pos (string-match "Merge" output)))
       (should (eq (get-text-property pos 'face output) 'keymap-popup-inapt)))))
@@ -405,7 +404,7 @@
                                  :entries (list (list :key "m" :description "Merge"
                                                       :type 'suffix :command 'ignore
                                                       :inapt-if (lambda () nil)))))))
-         (output (keymap-popup--render nil rows)))
+         (output (keymap-popup--render rows)))
     (let ((pos (string-match "Merge" output)))
       (should-not (eq (get-text-property pos 'face output) 'keymap-popup-inapt)))))
 
@@ -413,7 +412,7 @@
   (let* ((rows (list (list (list :name nil
                                  :entries (list (list :key "a" :description "Sub"
                                                       :type 'keymap :target 'x))))))
-         (output (keymap-popup--render nil rows)))
+         (output (keymap-popup--render rows)))
     (let ((pos (string-match "Sub" output)))
       (should (eq (get-text-property pos 'face output) 'keymap-popup-submenu)))))
 
@@ -426,7 +425,7 @@
                            (list :name "Hidden" :if (lambda () nil)
                                  :entries (list (list :key "b" :description "Beta"
                                                       :type 'suffix :command 'ignore))))))
-         (output (keymap-popup--render nil rows)))
+         (output (keymap-popup--render rows)))
     (should (string-match-p "Alpha" output))
     (should-not (string-match-p "Beta" output))))
 
@@ -434,7 +433,7 @@
   (let* ((rows (list (list (list :name "Shown" :if (lambda () t)
                                  :entries (list (list :key "a" :description "Alpha"
                                                       :type 'suffix :command 'ignore))))))
-         (output (keymap-popup--render nil rows)))
+         (output (keymap-popup--render rows)))
     (should (string-match-p "Alpha" output))
     (should (string-match-p "Shown" output))))
 
@@ -445,7 +444,7 @@
                                                       :type 'suffix :command 'ignore)
                                                 (list :key "b" :description "Beta"
                                                       :type 'suffix :command 'ignore))))))
-         (output (keymap-popup--render nil rows)))
+         (output (keymap-popup--render rows)))
     (let ((pos-a (string-match "Alpha" output))
           (pos-b (string-match "Beta" output)))
       (should (eq (get-text-property pos-a 'face output) 'keymap-popup-inapt))
@@ -506,7 +505,7 @@
         t)
   (let* ((descs (keymap-popup--meta keymap-popup--test-dyngrp
                                     'descriptions))
-         (output (keymap-popup--render nil descs)))
+         (output (keymap-popup--render descs)))
     (should (string-match-p "Dynamic Group" output))))
 
 ;;; Parent inheritance tests
@@ -565,7 +564,7 @@
         t)
   (let* ((descs (keymap-popup--meta keymap-popup--test-inapt-map
                                     'descriptions))
-         (output (keymap-popup--render nil descs)))
+         (output (keymap-popup--render descs)))
     (let ((pos (string-match "Merge" output)))
       (should pos)
       (should (eq (get-text-property pos 'face output) 'keymap-popup-inapt)))
@@ -579,7 +578,7 @@
         t)
   (let* ((descs (keymap-popup--meta keymap-popup--test-group-inapt-map
                                     'descriptions))
-         (output (keymap-popup--render nil descs))
+         (output (keymap-popup--render descs))
          (pos (string-match "Alpha" output)))
     (should pos)
     (should (eq (get-text-property pos 'face output) 'keymap-popup-inapt))))
@@ -593,7 +592,7 @@
         t)
   (let* ((descs (keymap-popup--meta keymap-popup--test-group-if-map
                                     'descriptions))
-         (output (keymap-popup--render nil descs)))
+         (output (keymap-popup--render descs)))
     (should-not (string-match-p "Alpha" output))
     (should (string-match-p "Beta" output))))
 
@@ -605,7 +604,7 @@
   (should (keymap-lookup keymap-popup--test-if-sw "v"))
   (let* ((descs (keymap-popup--meta keymap-popup--test-if-sw
                                     'descriptions))
-         (output (keymap-popup--render nil descs)))
+         (output (keymap-popup--render descs)))
     (should-not (string-match-p "Verbose" output))))
 
 ;;; Wrapper map tests
@@ -675,7 +674,7 @@
   (should (eq (keymap-lookup keymap-popup--test-add "z") #'forward-char))
   (let* ((descs (keymap-popup--meta keymap-popup--test-add
                                     'descriptions))
-         (output (keymap-popup--render nil descs)))
+         (output (keymap-popup--render descs)))
     (should (string-match-p "New" output))))
 
 (ert-deftest keymap-popup-test-remove-entry ()
@@ -688,7 +687,7 @@
   (should (null (keymap-lookup keymap-popup--test-rm "r")))
   (let* ((descs (keymap-popup--meta keymap-popup--test-rm
                                     'descriptions))
-         (output (keymap-popup--render nil descs)))
+         (output (keymap-popup--render descs)))
     (should (string-match-p "Comment" output))
     (should-not (string-match-p "Reply" output))))