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: Tue, 02 Jan 2018 22:56:55 -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> <831sjcfq1v.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1514951779 13496 195.159.176.226 (3 Jan 2018 03:56:19 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 3 Jan 2018 03:56:19 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: acm@muc.de, 29478@debbugs.gnu.org, npostavs@users.sourceforge.net To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Jan 03 04:56:14 2018 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 1eWa9y-0002sn-Or for geb-bug-gnu-emacs@m.gmane.org; Wed, 03 Jan 2018 04:56:11 +0100 Original-Received: from localhost ([::1]:37975 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eWaBx-0008Av-Tq for geb-bug-gnu-emacs@m.gmane.org; Tue, 02 Jan 2018 22:58:13 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48615) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eWaBp-0008Aa-QU for bug-gnu-emacs@gnu.org; Tue, 02 Jan 2018 22:58:08 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eWaBm-0006g3-MN for bug-gnu-emacs@gnu.org; Tue, 02 Jan 2018 22:58:05 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:53255) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1eWaBm-0006fj-Hw for bug-gnu-emacs@gnu.org; Tue, 02 Jan 2018 22:58:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1eWaBm-0007dF-73 for bug-gnu-emacs@gnu.org; Tue, 02 Jan 2018 22:58: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: Wed, 03 Jan 2018 03:58: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.151495182529269 (code B ref 29478); Wed, 03 Jan 2018 03:58:02 +0000 Original-Received: (at 29478) by debbugs.gnu.org; 3 Jan 2018 03:57:05 +0000 Original-Received: from localhost ([127.0.0.1]:33703 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eWaAr-0007c0-3N for submit@debbugs.gnu.org; Tue, 02 Jan 2018 22:57:05 -0500 Original-Received: from pmta11.teksavvy.com ([76.10.157.34]:31846) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eWaAo-0007bV-Fk for 29478@debbugs.gnu.org; Tue, 02 Jan 2018 22:57:03 -0500 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: A2FtEwCZU0xa/2Obs2tdg29GgRSDbYVchgeOJgGCADMBlwqCAQqFNQQCAoQvRBQBAQEBAQEBAQEDaCiFJQEEAVYjBQsLNBIUGA0kijkIsGuDTYo/AQEBAQYBAQEBJIQMiEk2hGGGOQWKUIdQgRSQGot2i1aJcjWHQIpUjC+BPDYjgU8yGggwPYIqgwiBbCOGaCuCHwEBAQ X-IPAS-Result: A2FtEwCZU0xa/2Obs2tdg29GgRSDbYVchgeOJgGCADMBlwqCAQqFNQQCAoQvRBQBAQEBAQEBAQEDaCiFJQEEAVYjBQsLNBIUGA0kijkIsGuDTYo/AQEBAQYBAQEBJIQMiEk2hGGGOQWKUIdQgRSQGot2i1aJcjWHQIpUjC+BPDYjgU8yGggwPYIqgwiBbCOGaCuCHwEBAQ X-IronPort-AV: E=Sophos;i="5.45,500,1508817600"; d="scan'208";a="17184928" Original-Received: from 107-179-155-99.cpe.teksavvy.com (HELO ceviche.home) ([107.179.155.99]) by smtp.teksavvy.com with ESMTP/TLS/DHE-RSA-AES256-GCM-SHA384; 02 Jan 2018 22:56:55 -0500 Original-Received: by ceviche.home (Postfix, from userid 20848) id 83D34662E5; Tue, 2 Jan 2018 22:56:55 -0500 (EST) In-Reply-To: <831sjcfq1v.fsf@gnu.org> (Eli Zaretskii's message of "Sat, 30 Dec 2017 12:50:04 +0200") 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:141737 Archived-At: > This patch doesn't apply to the master branch, so I couldn't test it. It was meant to be read rather than to be applied. If you want a patch that applies, the one below should work. Stefan diff --git a/lisp/help.el b/lisp/help.el index 014af5141e..1d985cb4a6 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. ) 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 , 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.