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: Fri, 26 Jan 2018 17:00:15 -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> <83zi5q997a.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Trace: blaine.gmane.org 1517003982 12798 195.159.176.226 (26 Jan 2018 21:59:42 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 26 Jan 2018 21:59:42 +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 Fri Jan 26 22:59:37 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 1efC1l-0001qx-8Z for geb-bug-gnu-emacs@m.gmane.org; Fri, 26 Jan 2018 22:59:17 +0100 Original-Received: from localhost ([::1]:57064 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1efC3l-0007Ub-Ny for geb-bug-gnu-emacs@m.gmane.org; Fri, 26 Jan 2018 17:01:21 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51903) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1efC3a-0007U3-C9 for bug-gnu-emacs@gnu.org; Fri, 26 Jan 2018 17:01:14 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1efC3V-0006on-CH for bug-gnu-emacs@gnu.org; Fri, 26 Jan 2018 17:01:10 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:36215) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1efC3V-0006oe-88 for bug-gnu-emacs@gnu.org; Fri, 26 Jan 2018 17:01:05 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1efC3S-0006Hz-DM for bug-gnu-emacs@gnu.org; Fri, 26 Jan 2018 17:01:04 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 26 Jan 2018 22:01: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.151700402224121 (code B ref 29478); Fri, 26 Jan 2018 22:01:02 +0000 Original-Received: (at 29478) by debbugs.gnu.org; 26 Jan 2018 22:00:22 +0000 Original-Received: from localhost ([127.0.0.1]:44112 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1efC2n-0006Gy-5l for submit@debbugs.gnu.org; Fri, 26 Jan 2018 17:00:22 -0500 Original-Received: from chene.dit.umontreal.ca ([132.204.246.20]:59123) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1efC2k-0006Gp-9I for 29478@debbugs.gnu.org; Fri, 26 Jan 2018 17:00:19 -0500 Original-Received: from pastel.home (lechon.iro.umontreal.ca [132.204.27.242]) by chene.dit.umontreal.ca (8.14.7/8.14.1) with ESMTP id w0QM0Fn8020420; Fri, 26 Jan 2018 17:00:15 -0500 Original-Received: by pastel.home (Postfix, from userid 20848) id 7F46D60608; Fri, 26 Jan 2018 17:00:15 -0500 (EST) In-Reply-To: <83zi5q997a.fsf@gnu.org> (Eli Zaretskii's message of "Sat, 06 Jan 2018 19:40:57 +0200") 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, RV6209=0 X-NAI-Spam-Version: 2.3.0.9418 : core <6209> : inlines <6344> : streams <1777185> : uri <2580057> 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:142560 Archived-At: >> 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=E2=80=99s function definition is voi= d: 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: > > at that spot runs the command mouse-appearance-menu > 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 )" 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: =20=20=20=20 (translated from ) at that spot is undefined but I misremembered, the above also appears in vanilla Emacs. Regarding your example: at that spot runs the command mouse-appearance-menu 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 (!)): (translated from ) at tha= t spot is undefined (translated from ) 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)))))) =20 +(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))) =20 -(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. =20 -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-movem= ent))) - `(,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)))) =20 (defun help--key-binding-keymap (key &optional accept-default no-remap pos= ition) "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))))) =20 (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) follow= ing + ;; 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 key= 0))) - (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. - (=3D (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)))))) =20 -(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 eve= nts. -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 eve= nt)))) + `(,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 ,_loc= us) + 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)))) =20 -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-ev= ent))) - (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-t= ime) - (/ double-click-time 10= 00.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.