bug#29478: [Patch] bug#29478: 26.0.90; `C-h k' followed by mouse clicks no longer shows down event

[Stefan Monnier]

>> If you want a patch that applies, the one below should work.
> Thanks.  It needs some more work.  E.g., "C-h k C-mouse-1" signals an
> error:
>
>   help-fns--analyze-function: Symbol’s function definition is void: nil

The patch below fixes this...

> and "C-h k C-mouse-3" followed by a menu selection asks for another
> key or mouse click, although it already has got a full key sequence.

...and this.

> In general, I see the idea is to show both down-mouse-N event and
> mouse-N event, both with "C-h c" and "C-h k".  That could be okay, but
> why show undefined sequences?  E.g, "C-h c S-mouse-1" shows this in
> the echo area:
>
>   <S-down-mouse-1> at that spot runs the command mouse-appearance-menu
>   <S-mouse-1> at that spot is undefined
>
> I'd expect the second line not to appear.

About that, I wrote:

    OTOH, for text-terminals, we add a "(translated from <escape-sequence>)"
    and we could do the same here (that's what my patch originally did, by
    the way, and that's what I've been using all these years since I think
    it's very valuable information), which would say:
    
       <C-H-mouse-1> (translated from <C-H-down-mouse-1> <C-H-mouse-1>)
       at that spot is undefined

but I misremembered, the above also appears in vanilla Emacs.  Regarding
your example:

    <S-down-mouse-1> at that spot runs the command mouse-appearance-menu
    <S-mouse-1> at that spot is undefined

it's hard to do much better: the S-mouse-1 event is eaten by
`mouse-appearance-menu` but it's basically impossible to determine
that automatically.

And if you want to "not show undefined sequences", does that mean we
don't say anything at all for `C-h k M-_` rather than "M-_ is undefined"?
How 'bout `C-h c M-S-double-mouse-1` which with my code says (courtesy
copy-next-command-output (!)):

    <M-S-mouse-1> (translated from <M-S-down-mouse-1> <M-S-mouse-1>) at that 
spot is undefined
    <M-S-double-mouse-1> (translated from <M-S-double-down-mouse-1> 
<M-S-double-mouse-1>) is undefined

We can probably come up with some heuristic to keep "at least one line
of output" or something, but I think it's more useful for the user to
report all the events and their binding or lack thereof since we don't
really know what the user is looking for.

All in all, the behavior provided in the patch below may not be always
100% ideal for everyone, but the code is simpler, more robust, and gives
more information.

The details of the display can still be improved, but it's already an
improvement over what we have now, so if there's no objection I'll
install it as-is.


        Stefan


diff --git a/lisp/help.el b/lisp/help.el
index 014af5141e..b992e21ad2 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -593,19 +593,26 @@ help-key-description
            string
          (format "%s (translated from %s)" string otherstring))))))
 
+(defun help--first-event (keyseq)
+  (when (> (length keyseq) 0)
+    (aref keyseq (if (and (symbolp (aref keyseq 0))
+                         (> (length keyseq) 1)
+                         (consp (aref keyseq 1)))
+                     ;; Look at the second event when the first
+                     ;; is a pseudo-event like `mode-line' of `left-fringe'.
+                    1
+                  0))))
+
 (defun help--analyze-key (key untranslated)
   "Get information about KEY its corresponding UNTRANSLATED events.
 Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG)."
   (if (numberp untranslated)
-      (setq untranslated (this-single-command-raw-keys)))
-  (let* ((event (aref key (if (and (symbolp (aref key 0))
-                                  (> (length key) 1)
-                                  (consp (aref key 1)))
-                             1
-                           0)))
+      (error "Missing `untranslated'!"))
+  (let* ((event (help--first-event key))
         (modifiers (event-modifiers event))
         (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
-                           (memq 'drag modifiers)) " at that spot" ""))
+                           (memq 'drag modifiers))
+                        " at that spot" ""))
         (defn (key-binding key t)))
     ;; Handle the case where we faked an entry in "Select and Paste" menu.
     (when (and (eq defn nil)
@@ -626,22 +633,26 @@ help--analyze-key
          (format "%s%s runs the command %S" key-desc mouse-msg defn)))
      defn event mouse-msg)))
 
-(defun describe-key-briefly (&optional key insert untranslated)
-  "Print the name of the function KEY invokes.  KEY is a string.
+(defun describe-key-briefly (key-list &optional insert)
+  "Print the name of the functions KEY-LIST invokes.
+KEY-LIST is a list of pairs (SEQ . RAW-SEQ) of key sequences, where
+RAW-SEQ is the untranslated form of the key sequence SEQ.
 If INSERT (the prefix arg) is non-nil, insert the message in the buffer.
-If non-nil, UNTRANSLATED is a vector of the untranslated events.
-It can also be a number in which case the untranslated events from
-the last key hit are used.
 
-If KEY is a menu item or a tool-bar button that is disabled, this command
-temporarily enables it to allow getting help on disabled items and buttons."
+While reading KEY-LIST interactively, this command temporarily enables
+menu items or tool-bar buttons that are disabled to allow getting help
+on them."
   (interactive
    ;; Ignore mouse movement events because it's too easy to miss the
    ;; message while moving the mouse.
-   (pcase-let ((`(,key ,_up-event) (help-read-key-sequence 
'no-mouse-movement)))
-     `(,key ,current-prefix-arg 1)))
-  (princ (car (help--analyze-key key untranslated))
-         (if insert (current-buffer) standard-output)))
+   (let ((key-list (help-read-key-sequence 'no-mouse-movement)))
+     `(,key-list ,current-prefix-arg)))
+  (let ((msg (mapconcat (lambda (x)
+                          (pcase-let ((`(,seq . ,raw-seq) x))
+                            (car (help--analyze-key seq raw-seq))))
+                        key-list
+                        "\n")))
+    (if insert (insert msg) (message "%s" msg))))
 
 (defun help--key-binding-keymap (key &optional accept-default no-remap 
position)
   "Return a keymap holding a binding for KEY within current keymaps.
@@ -688,8 +699,7 @@ help--binding-locus
                                               (format "%s-map" mode)))))
                                        minor-mode-map-alist))
                                 (list 'global-map
-                                      (intern-soft (format "%s-map" 
major-mode)))))
-              found)
+                                      (intern-soft (format "%s-map" 
major-mode))))))
           ;; Look into these advertised symbols first.
           (dolist (sym advertised-syms)
             (when (and
@@ -707,224 +717,98 @@ help--binding-locus
           nil)))))
 
 (defun help-read-key-sequence (&optional no-mouse-movement)
-  "Reads a key sequence from the user.
-Returns a list of the form (KEY UP-EVENT), where KEY is the key
-sequence, and UP-EVENT is the up-event that was discarded by
-reading KEY, or nil.
+  "Read \"a\" key sequence from the user.
+Return a list of elements of the form (SEQ . RAW-SEQ), where SEQ is a key
+sequence, and RAW-SEQ is its untranslated form.
 If NO-MOUSE-MOVEMENT is non-nil, ignore key sequences starting
 with `mouse-movement' events."
   (let ((enable-disabled-menus-and-buttons t)
         (cursor-in-echo-area t)
         saved-yank-menu)
     (unwind-protect
-        (let (key keys down-ev discarded-up)
+        (let (last-modifiers key-list)
           ;; If yank-menu is empty, populate it temporarily, so that
           ;; "Select and Paste" menu can generate a complete event.
           (when (null (cdr yank-menu))
             (setq saved-yank-menu (copy-sequence yank-menu))
             (menu-bar-update-yank-menu "(any string)" nil))
           (while
-              (pcase (setq key (read-key-sequence "\
+              ;; Read at least one key-sequence.
+              (or (null key-list)
+                  ;; After a down event, also read the (presumably) following
+                  ;; up-event.
+                  (memq 'down last-modifiers)
+                  ;; After a click, see if a double click is on the way.
+                  (and (memq 'click last-modifiers)
+                       (not (sit-for (/ double-click-time 1000.0) t))))
+            (let* ((seq (read-key-sequence "\
 Describe the following key, mouse click, or menu item: "))
-                ((and (pred vectorp) (let `(,key0 . ,_) (aref key 0))
-                      (guard (symbolp key0)) (let keyname (symbol-name key0)))
-                 (or
-                  (and no-mouse-movement
-                       (string-match "mouse-movement" keyname))
-                  (progn (push key keys) nil)
-                  (and (string-match "\\(mouse\\|down\\|click\\|drag\\)"
-                                     keyname)
-                       (progn
-                         ;; Discard events (e.g. <help-echo>) which might
-                         ;; spuriously trigger the `sit-for'.
-                         (sleep-for 0.01)
-                         (while (read-event nil nil 0.01))
-                         (not (sit-for
-                               (if (numberp double-click-time)
-                                   (/ double-click-time 1000.0)
-                                 3.0)
-                               t))))))))
-          ;; When we have a sequence of mouse events, discard the most
-          ;; recent ones till we find one with a binding.
-          (let ((keys-1 keys))
-            (while (and keys-1
-                        (not (key-binding (car keys-1))))
-              ;; If we discard the last event, and this was a mouse
-              ;; up, remember this.
-              (if (and (eq keys-1 keys)
-                       (vectorp (car keys-1))
-                       (let* ((last-idx (1- (length (car keys-1))))
-                              (last (aref (car keys-1) last-idx)))
-                         (and (eventp last)
-                              (memq 'click (event-modifiers last)))))
-                  (setq discarded-up t))
-              (setq keys-1 (cdr keys-1)))
-            (if keys-1
-                (setq key (car keys-1))))
-          (list
-           key
-           ;; If KEY is a down-event, read and include the
-           ;; corresponding up-event.  Note that there are also
-           ;; down-events on scroll bars and mode lines: the actual
-           ;; event then is in the second element of the vector.
-           (and (not discarded-up) ; Don't attempt to ignore the up-event 
twice.
-                (vectorp key)
-                (let ((last-idx (1- (length key))))
-                  (and (eventp (aref key last-idx))
-                       (memq 'down (event-modifiers (aref key last-idx)))))
-                (or (and (eventp (setq down-ev (aref key 0)))
-                         (memq 'down (event-modifiers down-ev))
-                         ;; However, for the C-down-mouse-2 popup
-                         ;; menu, there is no subsequent up-event.  In
-                         ;; this case, the up-event is the next
-                         ;; element in the supplied vector.
-                         (= (length key) 1))
-                    (and (> (length key) 1)
-                         (eventp (setq down-ev (aref key 1)))
-                         (memq 'down (event-modifiers down-ev))))
-                (if (and (terminal-parameter nil 'xterm-mouse-mode)
-                         (equal (terminal-parameter nil 'xterm-mouse-last-down)
-                                down-ev))
-                    (aref (read-key-sequence-vector nil) 0)
-                  (read-event)))))
+                   (raw-seq (this-single-command-raw-keys))
+                   (key0 (when (> (length seq) 0)
+                           (aref seq 0)))
+                   (base (event-basic-type key0))
+                   (modifiers (event-modifiers key0)))
+              (cond
+               ((and no-mouse-movement (eq base 'mouse-movement)) nil)
+               ((eq base 'help-echo) nil)
+               (t
+                (setq last-modifiers modifiers)
+                (push (cons seq raw-seq) key-list)))))
+          (nreverse key-list))
       ;; Put yank-menu back as it was, if we changed it.
       (when saved-yank-menu
         (setq yank-menu (copy-sequence saved-yank-menu))
         (fset 'yank-menu (cons 'keymap yank-menu))))))
 
-(defun help-downify-mouse-event-type (base)
-  "Add \"down-\" to BASE if it is not already there.
-BASE is a symbol, a mouse event type.  If the modification is done,
-return the new symbol.  Otherwise return nil."
-  (let ((base-s (symbol-name base)))
-    ;; Note: the order of the components in the following string is
-    ;; determined by `apply_modifiers_uncached' in src/keyboard.c.
-    (string-match "\\(A-\\)?\
-\\(C-\\)?\
-\\(H-\\)?\
-\\(M-\\)?\
-\\(S-\\)?\
-\\(s-\\)?\
-\\(double-\\)?\
-\\(triple-\\)?\
-\\(up-\\)?\
-\\(\\(down-\\)?\\)\
-\\(drag-\\)?" base-s)
-    (when (and (null (match-beginning 11)) ; "down-"
-               (null (match-beginning 12))) ; "drag-"
-      (intern (replace-match "down-" t t base-s 10)) )))
-
-(defun describe-key (&optional key untranslated up-event)
-  "Display documentation of the function invoked by KEY.
-KEY can be any kind of a key sequence; it can include keyboard events,
+(defun describe-key (key-list)
+  "Display documentation of the function invoked by KEY-LIST.
+KEY-LIST can be any kind of a key sequence; it can include keyboard events,
 mouse events, and/or menu events.  When calling from a program,
-pass KEY as a string or a vector.
-
-If non-nil, UNTRANSLATED is a vector of the corresponding untranslated events.
-It can also be a number, in which case the untranslated events from
-the last key sequence entered are used.
-UP-EVENT is the up-event that was discarded by reading KEY, or nil.
+pass KEY-LIST as a list of elements (SEQ . RAW-SEQ) where SEQ is
+a key-sequence and RAW-SEQ is its untranslated form.
+
+While reading KEY-LIST interactively, this command temporarily enables
+menu items or tool-bar buttons that are disabled to allow getting help
+on them."
+  (interactive (list (help-read-key-sequence)))
+  (let ((buf (current-buffer))
+        (info-list
+         (mapcar (lambda (x)
+                   (pcase-let* ((`(,seq . ,raw-seq) x)
+                                (`(,brief-desc ,defn ,event ,_mouse-msg)
+                                 (help--analyze-key seq raw-seq))
+                                (locus
+                                 (help--binding-locus seq (event-start 
event))))
+                     `(,seq ,brief-desc ,defn ,locus)))
+                 key-list)))
+    (help-setup-xref (list (lambda (key-list)
+                             (with-current-buffer (if (buffer-live-p buf)
+                                                      buf (current-buffer))
+                               (describe-key key-list)))
+                           key-list)
+                    (called-interactively-p 'interactive))
+    (with-help-window (help-buffer)
+      (when (> (length info-list) 1)
+        ;; FIXME: Make this into clickable hyperlinks.
+        (princ "There were several key-sequences:\n\n")
+        (princ (mapconcat (lambda (info)
+                             (pcase-let ((`(,_seq ,brief-desc ,_defn ,_locus)
+                                          info))
+                               (concat "  " brief-desc)))
+                           info-list
+                           "\n"))
+        (princ "\n\nThey're all described below."))
+      (pcase-dolist (`(,seq ,brief-desc ,defn ,locus)
+                     info-list)
+        (when (> (length info-list) 1)
+          (princ (format "\n\n----------------- event `%s' 
----------------\n\n"
+                          (key-description seq))))
 
-If KEY is a menu item or a tool-bar button that is disabled, this command
-temporarily enables it to allow getting help on disabled items and buttons."
-  (interactive
-   (pcase-let ((`(,key ,up-event) (help-read-key-sequence)))
-     `(,key ,(prefix-numeric-value current-prefix-arg) ,up-event)))
-  (pcase-let ((`(,brief-desc ,defn ,event ,mouse-msg)
-               (help--analyze-key key untranslated))
-              (defn-up nil) (defn-up-tricky nil)
-              (key-locus-up nil) (key-locus-up-tricky nil)
-              (mouse-1-remapped nil) (mouse-1-tricky nil)
-              (ev-type nil))
-    (if (or (null defn)
-            (integerp defn)
-            (equal defn 'undefined))
-        (message "%s" brief-desc)
-      (help-setup-xref (list #'describe-function defn)
-                      (called-interactively-p 'interactive))
-      ;; Need to do this before erasing *Help* buffer in case event
-      ;; is a mouse click in an existing *Help* buffer.
-      (when up-event
-       (setq ev-type (event-basic-type up-event))
-       (let ((sequence (vector up-event)))
-         (when (and (eq ev-type 'mouse-1)
-                    mouse-1-click-follows-link
-                    (not (eq mouse-1-click-follows-link 'double))
-                    (setq mouse-1-remapped
-                          (mouse-on-link-p (event-start up-event))))
-           (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link)
-                                     (> mouse-1-click-follows-link 0)))
-           (cond ((stringp mouse-1-remapped)
-                  (setq sequence mouse-1-remapped))
-                 ((vectorp mouse-1-remapped)
-                  (setcar up-event (elt mouse-1-remapped 0)))
-                 (t (setcar up-event 'mouse-2))))
-         (setq defn-up (key-binding sequence nil nil (event-start up-event)))
-          (setq key-locus-up (help--binding-locus sequence (event-start 
up-event)))
-         (when mouse-1-tricky
-           (setq sequence (vector up-event))
-           (aset sequence 0 'mouse-1)
-           (setq defn-up-tricky (key-binding sequence nil nil (event-start 
up-event)))
-            (setq key-locus-up-tricky (help--binding-locus sequence 
(event-start up-event))))))
-      (with-help-window (help-buffer)
         (princ brief-desc)
-        (let ((key-locus (help--binding-locus key (event-start event))))
-          (when key-locus
-            (princ (format " (found in %s)" key-locus))))
+        (when locus
+          (princ (format " (found in %s)" locus)))
         (princ ", which is ")
-       (describe-function-1 defn)
-        (when (vectorp key)
-          (let* ((last (1- (length key)))
-                 (elt (aref key last))
-                 (elt-1 (if (listp elt) (copy-sequence elt) elt))
-                 key-1 down-event-type)
-            (when (and (listp elt-1)
-                       (symbolp (car elt-1))
-                       (setq down-event-type (help-downify-mouse-event-type
-                                              (car elt-1))))
-              (setcar elt-1 down-event-type)
-              (setq key-1 (vector elt-1))
-              (when (key-binding key-1)
-                (princ (format "
-
-For documentation of the corresponding mouse down event <%s>,
-click and hold the mouse button longer than %s second(s)."
-                               down-event-type (if (numberp double-click-time)
-                                                   (/ double-click-time 1000.0)
-                                                 3)))))))
-       (when up-event
-         (unless (or (null defn-up)
-                     (integerp defn-up)
-                     (equal defn-up 'undefined))
-           (princ (format "
-
------------------ up-event %s----------------
-
-%s%s%s runs the command %S%s, which is "
-                          (if mouse-1-tricky "(short click) " "")
-                          (key-description (vector up-event))
-                          mouse-msg
-                          (if mouse-1-remapped
-                               " is remapped to <mouse-2>, which" "")
-                          defn-up (if key-locus-up
-                                       (format " (found in %s)" key-locus-up)
-                                     "")))
-           (describe-function-1 defn-up))
-         (unless (or (null defn-up-tricky)
-                     (integerp defn-up-tricky)
-                     (eq defn-up-tricky 'undefined))
-           (princ (format "
-
------------------ up-event (long click) ----------------
-
-Pressing <%S>%s for longer than %d milli-seconds
-runs the command %S%s, which is "
-                          ev-type mouse-msg
-                          mouse-1-click-follows-link
-                          defn-up-tricky (if key-locus-up-tricky
-                                              (format " (found in %s)" 
key-locus-up-tricky)
-                                            "")))
-           (describe-function-1 defn-up-tricky)))))))
+       (describe-function-1 defn)))))

 (defun describe-mode (&optional buffer)
   "Display documentation of current major mode and minor modes.