diff options
Diffstat (limited to 'lisp/help.el')
| -rw-r--r-- | lisp/help.el | 385 |
1 files changed, 162 insertions, 223 deletions
diff --git a/lisp/help.el b/lisp/help.el index 014af5141e3..4899bc44e03 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 -*- ;; Copyright (C) 1985-1986, 1993-1994, 1998-2018 Free Software ;; Foundation, Inc. @@ -593,19 +593,27 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." string (format "%s (translated from %s)" string otherstring)))))) +(defun help--binding-undefined-p (defn) + (or (null defn) (integerp defn) (equal defn 'undefined))) + (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 (when (> (length key) 0) + (aref key (if (and (symbolp (aref key 0)) + (> (length key) 1) + (consp (aref key 1))) + ;; Look at the second event when the first + ;; is a pseudo-event like `mode-line' or + ;; `left-fringe'. + 1 + 0)))) (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) @@ -621,27 +629,47 @@ Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG)." (list ;; Now describe the key, perhaps as changed. (let ((key-desc (help-key-description key untranslated))) - (if (or (null defn) (integerp defn) (equal defn 'undefined)) + (if (help--binding-undefined-p defn) (format "%s%s is undefined" key-desc mouse-msg) (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 help--filter-info-list (info-list i) + "Drop the undefined keys." + (or + ;; Remove all `undefined' keys. + (delq nil (mapcar (lambda (x) + (unless (help--binding-undefined-p (nth i x)) x)) + info-list)) + ;; If nothing left, then keep one (the last one). + (last info-list))) + +(defun describe-key-briefly (&optional key-list insert untranslated) + "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." + (declare (advertised-calling-convention (key-list &optional insert) "27.1")) (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))) + (when (arrayp key-list) + ;; Old calling convention, changed + (setq key-list (list (cons key-list + (if (numberp untranslated) + (this-single-command-raw-keys) + untranslated))))) + (let* ((info-list (mapcar (lambda (kr) + (help--analyze-key (car kr) (cdr kr))) + key-list)) + (msg (mapconcat #'car (help--filter-info-list info-list 1) "\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 +716,7 @@ function `key-binding'." (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 @@ -706,225 +733,137 @@ function `key-binding'." (throw 'found x)))) 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. +(defun help--read-key-sequence (&optional no-mouse-movement) + "Read a key sequence from the user. +Usually reads a single key sequence, except when that sequence might +hide another one (e.g. a down event, where the user is interested +in getting info about the up event, or a click event, where the user +wants to get info about the double click). +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. <help-echo>) 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)) + (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)))))) -(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 (&optional key-list buffer up-event) + "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. - -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)))))) +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. + +BUFFER is the buffer in which to lookup those keys; it defaults to the +current buffer." + (declare (advertised-calling-convention (key-list &optional buffer) "27.1")) + (interactive (list (help--read-key-sequence))) + (when (arrayp key-list) + ;; Compatibility with old calling convention. + (setq key-list (cons (list key-list) (if up-event (list up-event)))) + (when buffer + (let ((raw (if (numberp buffer) (this-single-command-raw-keys) buffer))) + (setf (cdar (last key-list)) raw))) + (setq buffer nil)) + (let* ((buf (or buffer (current-buffer))) + (on-link + (mapcar (lambda (kr) + (let ((raw (cdr kr))) + (and (not (memq mouse-1-click-follows-link '(nil double))) + (> (length raw) 0) + (eq (car-safe (aref raw 0)) 'mouse-1) + (with-current-buffer buf + (mouse-on-link-p (event-start (aref raw 0))))))) + key-list)) + (info-list + (help--filter-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)) + 2))) + (help-setup-xref (list (lambda (key-list buf) + (describe-key key-list + (if (buffer-live-p buf) buf))) + key-list buf) + (called-interactively-p 'interactive)) + (if (and (<= (length info-list) 1) + (help--binding-undefined-p (nth 2 (car info-list)))) + (message "%s" (nth 1 (car info-list))) (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-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 <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))))))) + (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")) + (when (delq nil on-link) + (princ "\n\nThose are influenced by `mouse-1-click-follows-link'")) + (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 use eval-when-compile because purified + ;; strings lose their text 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 +1059,7 @@ is currently activated with completion." ;;; 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 +1076,7 @@ function is called, the window to be resized is selected." :version "24.3") (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))) |