Mercurial > emacs
diff lisp/help.el @ 83542:2d56e13fd23d
Merged from emacs@sv.gnu.org
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-413
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-414
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-415
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-416
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-417
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-418
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-419
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-420
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-421
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-422
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-423
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-424
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-425
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-426
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-427
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-428
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-429
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-430
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-431
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-432
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-433
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-434
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-435
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-436
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-437
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-438
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-439
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-440
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-441
lisp/url/url-methods.el: Fix format error when http_proxy is empty string
* emacs@sv.gnu.org/emacs--devo--0--patch-442
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-443
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-444
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-445
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-446
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-447
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-448
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-449
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-450
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-451
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-452
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-453
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-454
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-455
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-456
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-457
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-458
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-459
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-460
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-461
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-462
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-463
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-464
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-465
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-466
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-467
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-468
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-469
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-470
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-471
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-472
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-473
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-128
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-129
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-130
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-131
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-132
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-133
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-134
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-135
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-136
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-137
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-138
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-139
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-140
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-141
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-142
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-143
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-144
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-145
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-146
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-147
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-148
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-149
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-582
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Sat, 14 Oct 2006 17:36:28 +0000 |
parents | b4697c34c8fd |
children | 6a147e17a7cd 8dd8c8286063 |
line wrap: on
line diff
--- a/lisp/help.el Sat Oct 14 16:56:21 2006 +0000 +++ b/lisp/help.el Sat Oct 14 17:36:28 2006 +0000 @@ -309,7 +309,7 @@ The prefix described consists of all but the last event of the key sequence that ran this command." (interactive) - (let* ((key (this-command-keys))) + (let ((key (this-command-keys))) (describe-bindings (if (stringp key) (substring key 0 (1- (length key))) @@ -535,28 +535,6 @@ (princ string))))) nil) -(defun string-key-binding (key) - "Value is the binding of KEY in a string. -If KEY is an event on a string, and that string has a `local-map' -or `keymap' property, return the binding of KEY in the string's keymap." - (let* ((defn nil) - (start (when (vectorp key) - (if (memq (aref key 0) - '(mode-line header-line left-margin right-margin)) - (event-start (aref key 1)) - (and (consp (aref key 0)) - (event-start (aref key 0)))))) - (string-info (and (consp start) (nth 4 start)))) - (when string-info - (let* ((string (car string-info)) - (pos (cdr string-info)) - (local-map (and (>= pos 0) - (< pos (length string)) - (or (get-text-property pos 'local-map string) - (get-text-property pos 'keymap string))))) - (setq defn (and local-map (lookup-key local-map key))))) - defn)) - (defun help-key-description (key untranslated) (let ((string (key-description key))) (if (or (not untranslated) @@ -589,11 +567,14 @@ (menu-bar-update-yank-menu "(any string)" nil)) (setq key (read-key-sequence "Describe key (or click or menu item): ")) ;; If KEY is a down-event, read and discard the - ;; corresponding up-event. - (if (and (vectorp key) - (eventp (elt key 0)) - (memq 'down (event-modifiers (elt key 0)))) - (read-event)) + ;; 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)) @@ -604,46 +585,33 @@ (fset 'yank-menu (cons 'keymap yank-menu)))))) (if (numberp untranslated) (setq untranslated (this-single-command-raw-keys))) - (save-excursion - (let ((modifiers (event-modifiers (aref key 0))) - (standard-output (if insert (current-buffer) t)) - window position) - ;; For a mouse button event, go to the button it applies to - ;; to get the right key bindings. And go to the right place - ;; in case the keymap depends on where you clicked. - (if (or (memq 'click modifiers) (memq 'down modifiers) - (memq 'drag modifiers)) - (setq window (posn-window (event-start (aref key 0))) - position (posn-point (event-start (aref key 0))))) - (if (windowp window) - (progn - (set-buffer (window-buffer window)) - (goto-char position))) - ;; Ok, now look up the key and name the command. - (let ((defn (or (string-key-binding key) - (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 (windowp window) - "%s at that spot runs the command %s" - "%s runs the command %s") - key-desc - (if (symbolp defn) defn (prin1-to-string defn))))))))) + (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) t)) + (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. @@ -673,109 +641,119 @@ (list key (prefix-numeric-value current-prefix-arg) - ;; If KEY is a down-event, read the corresponding up-event - ;; and use it as the third argument. - (if (and (vectorp key) - (eventp (elt key 0)) - (memq 'down (event-modifiers (elt key 0)))) - (read-event)))) + ;; 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))))) + (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))) - (save-excursion - (let ((modifiers (event-modifiers (aref key 0))) - window position) - ;; For a mouse button event, go to the button it applies to - ;; to get the right key bindings. And go to the right place - ;; in case the keymap depends on where you clicked. - (if (or (memq 'click modifiers) (memq 'down modifiers) - (memq 'drag modifiers)) - (setq window (posn-window (event-start (aref key 0))) - position (posn-point (event-start (aref key 0))))) - (when (windowp window) - (set-buffer (window-buffer window)) - (goto-char position)) - (let ((defn (or (string-key-binding key) (key-binding key t)))) - ;; 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)) - (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 - (stringp (aref untranslated (1- (length untranslated))))) - (aset untranslated (1- (length untranslated)) - "(any string)")) - (with-output-to-temp-buffer (help-buffer) - (princ (help-key-description key untranslated)) - (if (windowp window) - (princ " at that spot")) - (princ " runs the command ") - (prin1 defn) - (princ "\n which is ") - (describe-function-1 defn) - (when up-event - (let ((type (event-basic-type up-event)) - (hdr "\n\n-------------- up event ---------------\n\n") - defn sequence - mouse-1-tricky mouse-1-remapped) - (setq sequence (vector up-event)) - (when (and (eq type 'mouse-1) - (windowp window) + (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)) + 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) + (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. + (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 + (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 - (not (eq mouse-1-click-follows-link 'double)) - (setq mouse-1-remapped - (with-current-buffer (window-buffer window) - (mouse-on-link-p (posn-point - (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 (or (string-key-binding sequence) - (key-binding sequence))) - (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 type)) - (if (windowp window) - (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 - (setcar up-event 'mouse-1) - (setq defn (or (string-key-binding (vector up-event)) - (key-binding (vector up-event)))) - (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 (windowp window) - (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))))))) + 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. @@ -786,7 +764,7 @@ For this to work correctly for a minor mode, the mode's indicator variable \(listed in `minor-mode-alist') must also be a function whose documentation describes the minor mode." - (interactive) + (interactive "@") (unless buffer (setq buffer (current-buffer))) (help-setup-xref (list #'describe-mode buffer) (interactive-p))