summaryrefslogtreecommitdiff
path: root/lisp/help.el
diff options
context:
space:
mode:
authorKaroly Lorentey <lorentey@elte.hu>2006-10-14 17:36:28 +0000
committerKaroly Lorentey <lorentey@elte.hu>2006-10-14 17:36:28 +0000
commit12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a (patch)
tree1775f9fd1c92defd8b61304a08ec00da95bc4539 /lisp/help.el
parent3f87f67ee215ffeecbd2f53bd7f342cdf03f47df (diff)
parentf763da8d0808af7c80d72bc586bf4fcf50b37ddd (diff)
downloademacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.tar.gz
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
Diffstat (limited to 'lisp/help.el')
-rw-r--r--lisp/help.el308
1 files changed, 143 insertions, 165 deletions
diff --git a/lisp/help.el b/lisp/help.el
index db76efb01a0..34b1a2fac61 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -309,7 +309,7 @@ If that doesn't give a function, return nil."
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 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
(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 @@ temporarily enables it to allow getting help on disabled items and buttons."
(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 @@ temporarily enables it to allow getting help on disabled items and buttons."
(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 @@ temporarily enables it to allow getting help on disabled items and buttons."
(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 @@ descriptions of the minor modes, each on a separate page.
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))