mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-02 08:22:22 +00:00
Refactor key describing commands
* lisp/help.el (help-read-key-sequence, help--analyze-key): New functions, extracted from `describe-key' and `describe-key-briefly'. (describe-key, describe-key-briefly): Use them.
This commit is contained in:
Noam Postavsky
parent
0ad5fd4b6c
commit
2bd32ede1c
251
lisp/help.el
251
lisp/help.el
@ -593,6 +593,39 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
|
||||
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)
|
||||
(stringp (aref key (1- (length key))))
|
||||
(eq (key-binding (substring key 0 -1)) 'yank-menu))
|
||||
(setq defn 'menu-bar-select-yank))
|
||||
;; Don't bother user with strings from (e.g.) the select-paste menu.
|
||||
(when (stringp (aref key (1- (length key))))
|
||||
(aset key (1- (length key)) "(any string)"))
|
||||
(when (and untranslated
|
||||
(stringp (aref untranslated (1- (length untranslated)))))
|
||||
(aset untranslated (1- (length untranslated)) "(any string)"))
|
||||
(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))
|
||||
(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.
|
||||
If INSERT (the prefix arg) is non-nil, insert the message in the buffer.
|
||||
@ -603,73 +636,10 @@ 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
|
||||
(let ((enable-disabled-menus-and-buttons t)
|
||||
(cursor-in-echo-area t)
|
||||
saved-yank-menu)
|
||||
(unwind-protect
|
||||
(let (key)
|
||||
;; 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
|
||||
(progn
|
||||
(setq key (read-key-sequence "Describe the following key, mouse click, or menu item: "))
|
||||
(and (vectorp key)
|
||||
(consp (aref key 0))
|
||||
(symbolp (car (aref key 0)))
|
||||
(string-match "\\(mouse\\|down\\|click\\|drag\\)"
|
||||
(symbol-name (car (aref key 0))))
|
||||
(not (sit-for (/ double-click-time 1000.0) t)))))
|
||||
;; Clear the echo area message (Bug#7014).
|
||||
(message nil)
|
||||
;; If KEY is a down-event, read and discard 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)))))
|
||||
(read-event))
|
||||
(list
|
||||
key
|
||||
(if current-prefix-arg (prefix-numeric-value current-prefix-arg))
|
||||
1))
|
||||
;; 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))))))
|
||||
(if (numberp untranslated)
|
||||
(setq untranslated (this-single-command-raw-keys)))
|
||||
(let* ((event (if (and (symbolp (aref key 0))
|
||||
(> (length key) 1)
|
||||
(consp (aref key 1)))
|
||||
(aref key 1)
|
||||
(aref key 0)))
|
||||
(modifiers (event-modifiers event))
|
||||
(standard-output (if insert (current-buffer) standard-output))
|
||||
(mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
|
||||
(memq 'drag modifiers)) " at that spot" ""))
|
||||
(defn (key-binding key t))
|
||||
key-desc)
|
||||
;; Handle the case where we faked an entry in "Select and Paste" menu.
|
||||
(if (and (eq defn nil)
|
||||
(stringp (aref key (1- (length key))))
|
||||
(eq (key-binding (substring key 0 -1)) 'yank-menu))
|
||||
(setq defn 'menu-bar-select-yank))
|
||||
;; Don't bother user with strings from (e.g.) the select-paste menu.
|
||||
(if (stringp (aref key (1- (length key))))
|
||||
(aset key (1- (length key)) "(any string)"))
|
||||
(if (and (> (length untranslated) 0)
|
||||
(stringp (aref untranslated (1- (length untranslated)))))
|
||||
(aset untranslated (1- (length untranslated)) "(any string)"))
|
||||
;; Now describe the key, perhaps as changed.
|
||||
(setq key-desc (help-key-description key untranslated))
|
||||
(if (or (null defn) (integerp defn) (equal defn 'undefined))
|
||||
(princ (format "%s%s is undefined" key-desc mouse-msg))
|
||||
(princ (format "%s%s runs the command %S" key-desc mouse-msg defn)))))
|
||||
(pcase-let ((`(,key ,_up-event) (help-read-key-sequence)))
|
||||
`(,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.
|
||||
@ -734,6 +704,55 @@ function `key-binding'."
|
||||
(throw 'found x))))
|
||||
nil)))))
|
||||
|
||||
(defun help-read-key-sequence ()
|
||||
"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."
|
||||
(let ((enable-disabled-menus-and-buttons t)
|
||||
(cursor-in-echo-area t)
|
||||
saved-yank-menu)
|
||||
(unwind-protect
|
||||
(let (key)
|
||||
;; 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)))
|
||||
(and (string-match "\\(mouse\\|down\\|click\\|drag\\)"
|
||||
keyname)
|
||||
(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 (aref key 0))
|
||||
(memq 'down (event-modifiers (aref key 0)))
|
||||
;; 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 (aref key 1))
|
||||
(memq 'down (event-modifiers (aref key 1)))))
|
||||
(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,
|
||||
@ -748,83 +767,20 @@ 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
|
||||
(let ((enable-disabled-menus-and-buttons t)
|
||||
(cursor-in-echo-area t)
|
||||
saved-yank-menu)
|
||||
(unwind-protect
|
||||
(let (key)
|
||||
;; 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
|
||||
(progn
|
||||
(setq key (read-key-sequence "Describe the following key, mouse click, or menu item: "))
|
||||
(and (vectorp key)
|
||||
(consp (aref key 0))
|
||||
(symbolp (car (aref key 0)))
|
||||
(string-match "\\(mouse\\|down\\|click\\|drag\\)"
|
||||
(symbol-name (car (aref key 0))))
|
||||
(not (sit-for (/ double-click-time 1000.0) t)))))
|
||||
(list
|
||||
key
|
||||
(prefix-numeric-value current-prefix-arg)
|
||||
;; 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 (aref key 0))
|
||||
(memq 'down (event-modifiers (aref key 0)))
|
||||
;; 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 (aref key 1))
|
||||
(memq 'down (event-modifiers (aref key 1)))))
|
||||
(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))))))
|
||||
(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))
|
||||
key-locus key-locus-up key-locus-up-tricky
|
||||
defn-up defn-up-tricky ev-type
|
||||
mouse-1-remapped mouse-1-tricky)
|
||||
|
||||
;; Handle the case where we faked an entry in "Select and Paste" menu.
|
||||
(when (and (eq defn nil)
|
||||
(stringp (aref key (1- (length key))))
|
||||
(eq (key-binding (substring key 0 -1)) 'yank-menu))
|
||||
(setq defn 'menu-bar-select-yank))
|
||||
(if (or (null defn) (integerp defn) (equal defn 'undefined))
|
||||
(message "%s%s is undefined"
|
||||
(help-key-description key untranslated) mouse-msg)
|
||||
(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))
|
||||
;; Don't bother user with strings from (e.g.) the select-paste menu.
|
||||
(when (stringp (aref key (1- (length key))))
|
||||
(aset key (1- (length key)) "(any string)"))
|
||||
(when (and untranslated
|
||||
(stringp (aref untranslated (1- (length untranslated)))))
|
||||
(aset untranslated (1- (length untranslated))
|
||||
"(any string)"))
|
||||
;; Need to do this before erasing *Help* buffer in case event
|
||||
;; is a mouse click in an existing *Help* buffer.
|
||||
(when up-event
|
||||
@ -849,13 +805,12 @@ temporarily enables it to allow getting help on disabled items and buttons."
|
||||
(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))))))
|
||||
(setq key-locus (help--binding-locus key (event-start event)))
|
||||
(with-help-window (help-buffer)
|
||||
(princ (help-key-description key untranslated))
|
||||
(princ (format "%s runs the command %S%s, which is "
|
||||
mouse-msg defn (if key-locus
|
||||
(format " (found in %s)" key-locus)
|
||||
"")))
|
||||
(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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user