;;; help.el --- help commands for Emacs
;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help, internal
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
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)))
((<= version 18)
(setq version (format "%d" version)))
((> version emacs-major-version)
- (error "No news about emacs %d (yet)" version))))
+ (error "No news about Emacs %d (yet)" version))))
(let* ((vn (if (stringp version)
(string-to-number version)
version))
"Where is command: ")
obarray 'commandp t))
(list (if (equal val "") fn (intern val)) current-prefix-arg)))
+ (unless definition (error "No command"))
(let ((func (indirect-function definition))
(defs nil)
(standard-output (if insert (current-buffer) t)))
(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)
(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))
(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.
(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 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)))
- (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)))))
\f
(defun describe-mode (&optional buffer)
"Display documentation of current major mode and minor modes.
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))
(sort minor-modes
(lambda (a b) (string-lessp (cadr a) (cadr b)))))
(when minor-modes
- (princ "Summary of minor modes:\n")
+ (princ "Enabled minor modes:\n")
(make-local-variable 'help-button-cache)
(with-current-buffer standard-output
(dolist (mode minor-modes)
(let ((mode-function (nth 0 mode))
(pretty-minor-mode (nth 1 mode))
(indicator (nth 2 mode)))
- (setq indicator (if (zerop (length indicator))
- "no indicator"
- (format "indicator%s" indicator)))
(add-text-properties 0 (length pretty-minor-mode)
'(face bold) pretty-minor-mode)
(save-excursion
(push (point-marker) help-button-cache)
;; Document the minor modes fully.
(insert pretty-minor-mode)
- (princ (format " minor mode (%s):\n" indicator))
+ (princ (format " minor mode (%s):\n"
+ (if (zerop (length indicator))
+ "no indicator"
+ (format "indicator%s"
+ indicator))))
(princ (documentation mode-function)))
- (princ " ")
(insert-button pretty-minor-mode
'action (car help-button-cache)
'follow-link t
'help-echo "mouse-2, RET: show full information")
- (princ (format " minor mode (%s):\n" indicator)))))
- (princ "\n(Full information about these minor modes
-follows the description of the major mode.)\n\n"))
+ (newline)))
+ (forward-line -1)
+ (fill-paragraph nil)
+ (forward-line 1))
+
+ (princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
;; Document the major mode.
(let ((mode mode-name))
(with-current-buffer standard-output
(cond
((= 0 (length i))
nil)
- ((eq (aref i 0) ?\ )
+ ((eq (aref i 0) ?\s)
(substring i 1))
(t
i))))
"Return a minor mode symbol from its indicator on the modeline."
;; remove first space if existed
(if (and (< 0 (length indicator))
- (eq (aref indicator 0) ?\ ))
+ (eq (aref indicator 0) ?\s))
(setq indicator (substring indicator 1)))
(let ((minor-modes minor-mode-alist)
result)
;; remove first space if existed
(if (and (stringp anindicator)
(> (length anindicator) 0)
- (eq (aref anindicator 0) ?\ ))
+ (eq (aref anindicator 0) ?\s))
(setq anindicator (substring anindicator 1)))
(if (equal indicator anindicator)
(setq result minor-mode
(remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
(defun resize-temp-buffer-window ()
- "Resize the current window to fit its contents.
+ "Resize the selected window to fit its contents.
Will not make it higher than `temp-buffer-max-height' nor smaller than
`window-min-height'. Do nothing if it is the only window on its frame, if it
is not as wide as the frame or if some of the window's contents are scrolled
out of view."
(unless (or (one-window-p 'nomini)
(not (pos-visible-in-window-p (point-min)))
- (/= (frame-width) (window-width)))
+ (not (window-full-width-p)))
(fit-window-to-buffer
(selected-window)
(if (functionp temp-buffer-max-height)