From 657f6d83b30c1e4f856689b053dc10fb1beb60d3 Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Tue, 30 Jul 2024 19:57:29 +0200
Subject: [PATCH] Improve handling of menu-bar menus in 'help-complete-keys'

---
 lisp/help.el | 46 ++++++++++++++++++++++++++++++++--------------
 1 file changed, 32 insertions(+), 14 deletions(-)

diff --git a/lisp/help.el b/lisp/help.el
index 2985122b6ce..932e93291cd 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -470,36 +470,54 @@ immediate bindings."
   :version "30.1"
   :group 'help)
 
-(defun help-complete-keys-add (s e b &optional p)
+(defun help--complete-keys-add (key val)
+  (setf (alist-get key help--complete-keys-alist nil nil #'equal) val))
+
+(defcustom help-complete-keys-max-depth 3
+  "Maximum length of prefix key sequence to flatten in `help-complete-keys'."
+  :type '(choice (const :tag "No depth limit" t)
+                 (natnum :tag "Maximum depth"))
+  :group 'help)
+
+(defun help-complete-keys-add (s e b &optional p d)
   "Add the binding of event E to B with prefix P to `help--complete-keys-alist'.
 
 S is the source of the binding, either `global', `local', or the name of
 a minor mode."
+  (unless d (setq d help-complete-keys-max-depth))
   (cond
+   ;; ((member p help-complete-keys-prefix-skip-list))
    ((and (symbolp b) (command-remapping b))
     ;; Follow remappings.
-    (help-complete-keys-add s e (command-remapping b) p))
+    (help-complete-keys-add s e (command-remapping b) p d))
    ((and (consp e) (characterp (car e)) (characterp (cdr e)))
     ;; Handle character ranges, ignore intermediate characters.
-    (help-complete-keys-add s (car e) b p)
-    (help-complete-keys-add s (cdr e) b p))
+    (help-complete-keys-add s (car e) b p d)
+    (help-complete-keys-add s (cdr e) b p d))
    ((commandp b)
     ;; Found a command.
-    (setf (alist-get (vconcat p (vector e)) help--complete-keys-alist
-                     nil nil #'equal)
-          (cons b s)))
+    (help--complete-keys-add (vconcat p (vector e)) (cons b s)))
    ((keymapp b)
-    ;; Follow prefix map, unless its the remap map (handled above).
-    (unless (eq e 'remap)
+    ;; Follow prefix map, unless its...
+    (unless (or (eq e 'remap)        ; the remap map (handled above), or
+                (eq b 'yank-menu))   ; not really a keymap.
       (let ((pe (vconcat p (vector e))))
         (when (memq 'nest (ensure-list help-complete-keys-method))
-          (setf (alist-get pe help--complete-keys-alist nil nil #'equal)
-                (cons b s)))
-        (when (memq 'flat (ensure-list help-complete-keys-method))
-          (map-keymap (lambda (ee bb) (help-complete-keys-add s ee bb pe)) b)))))
+          (help--complete-keys-add pe (cons b s)))
+        (when (and (memq 'flat (ensure-list help-complete-keys-method))
+                   (not (equal 0 (setq d (if (numberp d) (1- d) d)))))
+          (map-keymap (lambda (ee bb) (help-complete-keys-add s ee bb pe d)) b)))))
+   ((and (consp b) (stringp (car b)) (cdr b))
+    ;; b is simple menu item.
+    (help-complete-keys-add s e (if (and (consp (cdr b)) (stringp (cadr b)))
+                                    ;; b is (STRING HELP . BINDING)
+                                    (cddr b)
+                                  ;; b is (STRING . BINDING)
+                                  (cdr b))
+                            p d))
    ((eq (car-safe b) 'menu-item)
     ;; b is an extended menu item.  Real binding at `caddr'.
-    (help-complete-keys-add s e (caddr b) p))))
+    (help-complete-keys-add s e (caddr b) p d))))
 
 (defun help--sort-by-command-name (cands)
   "Sort keybinding completion candidates CANDS by command name."
-- 
2.39.5