fix: describe-bindings freeze and crash

lem-tests.asd

@@ -58,6 +58,7 @@
                (:file "syntax-test")
                (:file "syntax-scanner")
                (:file "buffer-list-test")
+               (:file "keymap")
                (:file "popup-window")
                (:file "prompt")
                (:file "cursors")

src/commands/help.lisp

@@ -38,6 +38,7 @@
                                            column-width
                                            (keyseq-to-string kseq)
                                            (symbol-name command)))))
+              (setf keymap nil)
               (terpri s))))
 
 (define-command describe-bindings () ()

src/keymap.lisp

@@ -594,7 +594,7 @@ higher-priority keymap (e.g. vi normal mode remaps self-insert to undefined-key)
                (cond ((or (typep suffix 'keymap)
                           (typep suffix 'prefix))
                       (traverse-node suffix (cons key prefix)))
-                     (t
+                     ((symbolp suffix)
                       (funcall fun (reverse (cons key prefix)) suffix)))))
            (traverse-node (node prefix)
              (cond ((typep node 'keymap)

tests/keymap.lisp

@@ -0,0 +1,62 @@
+(defpackage :lem-tests/keymap-test
+  (:use :cl :rove)
+  (:import-from :lem-core
+                :make-keymap
+                :make-prefix
+                :keymap-add-prefix
+                :make-key
+                :traverse-keymap))
+(in-package :lem-tests/keymap-test)
+
+(defun make-test-keymap-with-closure-suffix ()
+  "A keymap holding one normal symbol binding and one prefix whose
+suffix is a closure -- the shape produced by transient toggle/choice
+infixes."
+  (let ((keymap (make-keymap :description 'test-keymap))
+        (closure (lambda () 'transient-thunk)))
+    (keymap-add-prefix keymap (make-prefix :key (make-key :sym "a")
+                                           :suffix 'real-command))
+    (keymap-add-prefix keymap (make-prefix :key (make-key :sym "b")
+                                           :suffix closure))
+    (values keymap closure)))
+
+(deftest traverse-keymap-skips-non-symbol-suffixes
+  "Regression test for #2100: transient closures (toggle/choice infix
+suffixes) must not be yielded to traverse-keymap callbacks, since
+callers like describe-bindings-internal call symbol-name on the
+result and would signal a type-error on function objects."
+  (multiple-value-bind (keymap closure) (make-test-keymap-with-closure-suffix)
+    (let ((yielded '()))
+      (traverse-keymap keymap
+                       (lambda (kseq cmd)
+                         (declare (ignore kseq))
+                         (push cmd yielded)))
+      (ok (every #'symbolp yielded))
+      (ok (member 'real-command yielded))
+      (ng (member closure yielded)))))
+
+#+sbcl
+(deftest describe-bindings-internal-terminates
+  "Regression test for #2100: describe-bindings-internal used to loop
+forever because the keymap-walk advance was removed but the
+surrounding (loop :while keymap ...) was kept.  Wrap the call in a
+timeout so a regression fails CI cleanly instead of hanging it."
+  (let ((keymap (make-test-keymap-with-closure-suffix))
+        (output nil))
+    (let ((result
+            (handler-case
+                (bordeaux-threads:with-timeout (5)
+                  (setf output
+                        (with-output-to-string (s)
+                          ;; Internal access: this helper is intentionally
+                          ;; not exported (-internal suffix); the test pins
+                          ;; down the regression at the unit level rather
+                          ;; than committing to its stream-printing shape
+                          ;; as a public contract.
+                          (lem-core/commands/help::describe-bindings-internal
+                           s "test" keymap t)))
+                  :ok)
+              (bordeaux-threads:timeout () :timed-out)
+              (error (e) (cons :error e)))))
+      (ok (eq result :ok))
+      (ok (search "real-command" (or output ""))))))