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

[Stefan Monnier]

Here's another take on this problem (clearly not intended for emacs-26).

This is also able to provide help on double/triple mouse clicks
(tho I had to resort to ztree to test it because such bindings are very
rare).

What do you guys think?


        Stefan


diff --git a/lisp/help.el b/lisp/help.el
index ac7cf91801..1a38042a51 100644
*** a/lisp/help.el
--- b/lisp/help.el
***************
*** 593,611 ****
            string
          (format "%s (translated from %s)" string otherstring))))))
  
  (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)))
         (modifiers (event-modifiers event))
         (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
!                           (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)
--- 593,618 ----
            string
          (format "%s (translated from %s)" string otherstring))))))
  
+ (defun help--first-event (keyseq)
+   (when (> (length keyseq) 0)
+     (aref key (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)
!       (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" ""))
         (defn (key-binding key t)))
      ;; Handle the case where we faked an entry in "Select and Paste" menu.
      (when (and (eq defn nil)
***************
*** 626,647 ****
           (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.
  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."
    (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)))
  
  (defun help--key-binding-keymap (key &optional accept-default no-remap 
position)
    "Return a keymap holding a binding for KEY within current keymaps.
--- 633,658 ----
           (format "%s%s runs the command %S" key-desc mouse-msg defn)))
       defn event mouse-msg)))
  
! (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.
  
! 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.
!    (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) (pop key-list)))
!                             (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.
***************
*** 706,865 ****
            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.
  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 down-ev)
            ;; 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 "\
  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))
!                   (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 (/ double-click-time 1000.0) t))))))))
!           (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 (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)))))
        ;; 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 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,
  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 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)))))))
  
  (defun describe-mode (&optional buffer)
    "Display documentation of current major mode and minor modes.
--- 717,815 ----
            nil)))))
  
  (defun help-read-key-sequence (&optional no-mouse-movement)
!   "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 (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
!               ;; 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: "))
!                    (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 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-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 ,raw-seq ,brief-desc ,defn ,event ,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 ,raw-seq
!                                             ,brief-desc ,defn ,event ,locus)
!                                           info))
!                                (concat "  " brief-desc)))
!                            info-list
!                            "\n"))
!         (princ "\n\nThey're all described below."))
!       (pcase-dolist (`(,seq ,raw-seq ,brief-desc ,defn ,event ,locus)
!                      info-list)
!         (when (> (length info-list) 1)
!           (princ (format "\n\n----------------- event `%s' 
----------------\n\n"
!                           (key-description seq))))
  
          (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.