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:37:22 -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 1517006187 20096 195.159.176.226 (26 Jan 2018 22:36:27 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 26 Jan 2018 22:36:27 +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 23:36:22 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 1efCbR-00044y-OU for geb-bug-gnu-emacs@m.gmane.org; Fri, 26 Jan 2018 23:36:10 +0100 Original-Received: from localhost ([::1]:59385 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1efCdS-0006xT-8x for geb-bug-gnu-emacs@m.gmane.org; Fri, 26 Jan 2018 17:38:14 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:58939) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1efCdK-0006xA-1V for bug-gnu-emacs@gnu.org; Fri, 26 Jan 2018 17:38:08 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1efCdG-0001zH-Rt for bug-gnu-emacs@gnu.org; Fri, 26 Jan 2018 17:38:06 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:36233) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1efCdG-0001z4-NG for bug-gnu-emacs@gnu.org; Fri, 26 Jan 2018 17:38:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1efCdG-00077u-B6 for bug-gnu-emacs@gnu.org; Fri, 26 Jan 2018 17:38: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: Fri, 26 Jan 2018 22:38: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.151700624727353 (code B ref 29478); Fri, 26 Jan 2018 22:38:02 +0000 Original-Received: (at 29478) by debbugs.gnu.org; 26 Jan 2018 22:37:27 +0000 Original-Received: from localhost ([127.0.0.1]:44130 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1efCcg-000777-IU for submit@debbugs.gnu.org; Fri, 26 Jan 2018 17:37:27 -0500 Original-Received: from pruche.dit.umontreal.ca ([132.204.246.22]:53739) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1efCce-00076y-BC for 29478@debbugs.gnu.org; Fri, 26 Jan 2018 17:37:25 -0500 Original-Received: from pastel.home (lechon.iro.umontreal.ca [132.204.27.242]) by pruche.dit.umontreal.ca (8.14.7/8.14.1) with ESMTP id w0QMbMah030950; Fri, 26 Jan 2018 17:37:22 -0500 Original-Received: by pastel.home (Postfix, from userid 20848) id 65CB460608; Fri, 26 Jan 2018 17:37:22 -0500 (EST) In-Reply-To: (Stefan Monnier's message of "Fri, 26 Jan 2018 17:00:15 -0500") 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 <1777187> : uri <2580078> 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:142563 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 vo= id: 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 -*- =20 ;; 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)))))) =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,105 @@ 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)) + (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)))))) =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 &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 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. - -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)))) - (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))))))) +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 ,_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 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") =20 (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)))