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...

Sorry, wrong patch!

I meant this one,


        Stefan


diff --git a/lisp/help.el b/lisp/help.el
index 014af5141e..1f92c38927 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1,4 +1,4 @@
-;;; help.el --- help commands for Emacs
+;;; help.el --- help commands for Emacs  -*- lexical-binding:t -*-
 
 ;; Copyright (C) 1985-1986, 1993-1994, 1998-2018 Free Software
 ;; Foundation, Inc.
@@ -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,105 @@ 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))
+                   (keyn (when (> (length seq) 0)
+                           (aref seq (1- (length seq)))))
+                   (base (event-basic-type keyn))
+                   (modifiers (event-modifiers keyn)))
+              (cond
+               ((zerop (length seq)))   ;FIXME: Can this happen?
+               ((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 &optional buffer)
+  "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.
-
-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))))
-        (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)))))))
+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 (or buffer (current-buffer)))
+         (info-list
+          (with-current-buffer buf
+            (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)
+                             (describe-key key-list
+                                           (if (buffer-live-p buf) buf)))
+                           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 defn
+          (when (> (length info-list) 1)
+            (with-current-buffer standard-output
+              (insert "\n\n"
+                      ;; FIXME: Can't eval-when-compile, because string
+                      ;; constant in purespace can't have properties!
+                      (propertize "\n" 'face '(:height 0.1 :inverse-video t))
+                      "\n")))
+
+          (princ brief-desc)
+          (when locus
+            (princ (format " (found in %s)" locus)))
+          (princ ", which is ")
+         (describe-function-1 defn))))))

 (defun describe-mode (&optional buffer)
   "Display documentation of current major mode and minor modes.
@@ -1120,7 +1011,7 @@ lookup-minor-mode-from-indicator

 ;;; Automatic resizing of temporary buffers.
 (defcustom temp-buffer-max-height
-  (lambda (buffer)
+  (lambda (_buffer)
     (if (and (display-graphic-p) (eq (selected-window) (frame-root-window)))
        (/ (x-display-pixel-height) (frame-char-height) 2)
       (/ (- (frame-height) 2) 2)))
@@ -1137,7 +1028,7 @@ temp-buffer-max-height
   :version "24.3")
 
 (defcustom temp-buffer-max-width
-  (lambda (buffer)
+  (lambda (_buffer)
     (if (and (display-graphic-p) (eq (selected-window) (frame-root-window)))
        (/ (x-display-pixel-width) (frame-char-width) 2)
       (/ (- (frame-width) 2) 2)))