From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.bugs Subject: bug#29478: [Patch] bug#29478: 26.0.90; `C-h k' followed by mouse clicks no longer shows down event Date: Sun, 24 Dec 2017 01:52:26 -0500 Message-ID: References: <20171128221036.GC14868@ACM> <83o9ni3l3i.fsf@gnu.org> <83bmji2xye.fsf@gnu.org> <83tvwzubez.fsf@gnu.org> <20171222220549.GC8072@ACM> <833741lr0t.fsf@gnu.org> <20171223111726.GA6618@ACM> <20171223210407.GC6618@ACM> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1514098282 19444 195.159.176.226 (24 Dec 2017 06:51:22 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sun, 24 Dec 2017 06:51:22 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: 29478@debbugs.gnu.org, npostavs@users.sourceforge.net To: Alan Mackenzie Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun Dec 24 07:51:18 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eT07s-0004Ng-PM for geb-bug-gnu-emacs@m.gmane.org; Sun, 24 Dec 2017 07:51:13 +0100 Original-Received: from localhost ([::1]:34667 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eT09p-000224-Uh for geb-bug-gnu-emacs@m.gmane.org; Sun, 24 Dec 2017 01:53:13 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:37325) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eT09h-00021O-Qt for bug-gnu-emacs@gnu.org; Sun, 24 Dec 2017 01:53:07 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eT09e-0000Ky-MN for bug-gnu-emacs@gnu.org; Sun, 24 Dec 2017 01:53:05 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:41196) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1eT09e-0000Kt-Hu for bug-gnu-emacs@gnu.org; Sun, 24 Dec 2017 01:53:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1eT09e-0002Tx-4K for bug-gnu-emacs@gnu.org; Sun, 24 Dec 2017 01:53:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 24 Dec 2017 06:53:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 29478 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: confirmed Original-Received: via spool by 29478-submit@debbugs.gnu.org id=B29478.15140983529507 (code B ref 29478); Sun, 24 Dec 2017 06:53:02 +0000 Original-Received: (at 29478) by debbugs.gnu.org; 24 Dec 2017 06:52:32 +0000 Original-Received: from localhost ([127.0.0.1]:49877 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eT09A-0002TG-0o for submit@debbugs.gnu.org; Sun, 24 Dec 2017 01:52:32 -0500 Original-Received: from pruche.dit.umontreal.ca ([132.204.246.22]:44293) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eT097-0002T7-A2 for 29478@debbugs.gnu.org; Sun, 24 Dec 2017 01:52:31 -0500 Original-Received: from ceviche.home (lechon.iro.umontreal.ca [132.204.27.242]) by pruche.dit.umontreal.ca (8.14.7/8.14.1) with ESMTP id vBO6qQid019920; Sun, 24 Dec 2017 01:52:27 -0500 Original-Received: by ceviche.home (Postfix, from userid 20848) id 66A14662FC; Sun, 24 Dec 2017 01:52:26 -0500 (EST) In-Reply-To: <20171223210407.GC6618@ACM> (Alan Mackenzie's message of "Sat, 23 Dec 2017 21:04:07 +0000") X-NAI-Spam-Flag: NO X-NAI-Spam-Threshold: 5 X-NAI-Spam-Score: 0 X-NAI-Spam-Rules: 2 Rules triggered EDT_SA_DN_PASS=0, RV6186=0 X-NAI-Spam-Version: 2.3.0.9418 : core <6186> : inlines <6281> : streams <1774012> : uri <2556446> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:141445 Archived-At: 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. ) 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 , 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.