Mercurial > emacs
changeset 72995:eacc6e3eac06
(describe-key-briefly, describe-key): Simplify printing
of descriptions by using format and %S. Fix "is undefined"
messages to say "at that spot" for mouse events.
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Tue, 19 Sep 2006 13:59:27 +0000 |
parents | 37a6a866d6bf |
children | 81a0345d360d |
files | lisp/help.el |
diffstat | 1 files changed, 93 insertions(+), 105 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/help.el Tue Sep 19 13:59:13 2006 +0000 +++ b/lisp/help.el Tue Sep 19 13:59:27 2006 +0000 @@ -594,33 +594,26 @@ (aref key 0))) (modifiers (event-modifiers event)) (standard-output (if insert (current-buffer) t)) - (mousep - (or (memq 'click modifiers) (memq 'down modifiers) - (memq 'drag modifiers)))) - ;; Ok, now look up the key and name the command. - (let ((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 is undefined" key-desc)) - (princ (format (if mousep - "%s at that spot runs the command %s" - "%s runs the command %s") - key-desc - (if (symbolp defn) defn (prin1-to-string defn)))))))) + (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))))) (defun describe-key (&optional key untranslated up-event) "Display documentation of the function invoked by KEY. @@ -671,93 +664,88 @@ 1 0))) (modifiers (event-modifiers event)) - (mousep (or (memq 'click modifiers) (memq 'down modifiers) - (memq 'drag modifiers))) + (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers) + (memq 'drag modifiers)) " at that spot" "")) (defn (key-binding key t)) 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. - (if (and (eq defn nil) + (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 is undefined" (help-key-description key untranslated)) - (help-setup-xref (list #'describe-function defn) (interactive-p)) - ;; 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 untranslated + (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) + (help-setup-xref (list #'describe-function defn) (interactive-p)) + ;; 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. + (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 + (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))) + (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)))))) + (with-output-to-temp-buffer (help-buffer) + (princ (help-key-description key untranslated)) + (princ (format "\ +%s runs the command %S + which is " + mouse-msg defn)) + (describe-function-1 defn) (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))) - (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)))))) - (with-output-to-temp-buffer (help-buffer) - (princ (help-key-description key untranslated)) - (if mousep - (princ " at that spot")) - (princ " runs the command ") - (prin1 defn) - (princ "\n which is ") - (describe-function-1 defn) - (when up-event - (let ((hdr "\n\n-------------- up event ---------------\n\n")) - (setq defn defn-up) - (unless (or (null defn) - (integerp defn) - (equal defn 'undefined)) - (princ (if mouse-1-tricky - "\n\n----------------- up-event (short click) ----------------\n\n" - hdr)) - (setq hdr nil) - (princ (symbol-name ev-type)) - (if mousep - (princ " at that spot")) - (if mouse-1-remapped - (princ " is remapped to <mouse-2>\n which" )) - (princ " runs the command ") - (prin1 defn) - (princ "\n which is ") - (describe-function-1 defn)) - (when mouse-1-tricky - (setq defn defn-up-tricky) - (unless (or (null defn) - (integerp defn) - (eq defn 'undefined)) - (princ (or hdr - "\n\n----------------- up-event (long click) ----------------\n\n")) - (princ "Pressing mouse-1") - (if mousep - (princ " at that spot")) - (princ (format " for longer than %d milli-seconds\n" - mouse-1-click-follows-link)) - (princ " runs the command ") - (prin1 defn) - (princ "\n which is ") - (describe-function-1 defn))))) - (print-help-return-message))))) + (unless (or (null defn-up) + (integerp defn-up) + (equal defn-up 'undefined)) + (princ (format " + +----------------- up-event %s---------------- + +<%S>%s%s runs the command %S + which is " + (if mouse-1-tricky "(short click) " "") + ev-type mouse-msg + (if mouse-1-remapped + " is remapped to <mouse-2>\nwhich" "") + defn-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 + which is " + ev-type mouse-msg + mouse-1-click-follows-link + defn-up-tricky)) + (describe-function-1 defn-up-tricky))) + (print-help-return-message))))) (defun describe-mode (&optional buffer) "Display documentation of current major mode and minor modes.