X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/a0d32c10a6c5fb9ee68f3b6a1f86e388a3b2608b..dc5c3489f44f5bd0a17ee3deef9363387f5b4de5:/lisp/help.el diff --git a/lisp/help.el b/lisp/help.el index d4b5ceacb4..5eef13ff9c 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1,7 +1,7 @@ ;;; help.el --- help commands for Emacs -;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, +;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal @@ -20,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -38,7 +38,57 @@ (add-hook 'temp-buffer-setup-hook 'help-mode-setup) (add-hook 'temp-buffer-show-hook 'help-mode-finish) -(defvar help-map (make-sparse-keymap) +(defvar help-map + (let ((map (make-sparse-keymap))) + (define-key map (char-to-string help-char) 'help-for-help) + (define-key map [help] 'help-for-help) + (define-key map [f1] 'help-for-help) + (define-key map "." 'display-local-help) + (define-key map "?" 'help-for-help) + + (define-key map "\C-c" 'describe-copying) + (define-key map "\C-d" 'describe-distribution) + (define-key map "\C-e" 'view-emacs-problems) + (define-key map "\C-f" 'view-emacs-FAQ) + (define-key map "\C-m" 'view-order-manuals) + (define-key map "\C-n" 'view-emacs-news) + (define-key map "\C-p" 'describe-project) + (define-key map "\C-t" 'view-todo) + (define-key map "\C-w" 'describe-no-warranty) + + ;; This does not fit the pattern, but it is natural given the C-\ command. + (define-key map "\C-\\" 'describe-input-method) + + (define-key map "C" 'describe-coding-system) + (define-key map "F" 'Info-goto-emacs-command-node) + (define-key map "I" 'describe-input-method) + (define-key map "K" 'Info-goto-emacs-key-command-node) + (define-key map "L" 'describe-language-environment) + (define-key map "S" 'info-lookup-symbol) + + (define-key map "a" 'apropos-command) + (define-key map "b" 'describe-bindings) + (define-key map "c" 'describe-key-briefly) + (define-key map "d" 'apropos-documentation) + (define-key map "e" 'view-echo-area-messages) + (define-key map "f" 'describe-function) + (define-key map "h" 'view-hello-file) + + (define-key map "i" 'info) + (define-key map "4i" 'info-other-window) + + (define-key map "k" 'describe-key) + (define-key map "l" 'view-lossage) + (define-key map "m" 'describe-mode) + (define-key map "n" 'view-emacs-news) + (define-key map "p" 'finder-by-keyword) + (define-key map "r" 'info-emacs-manual) + (define-key map "s" 'describe-syntax) + (define-key map "t" 'help-with-tutorial) + (define-key map "w" 'where-is) + (define-key map "v" 'describe-variable) + (define-key map "q" 'help-quit) + map) "Keymap for characters following the Help key.") (define-key global-map (char-to-string help-char) 'help-command) @@ -46,56 +96,11 @@ (define-key global-map [f1] 'help-command) (fset 'help-command help-map) -(define-key help-map (char-to-string help-char) 'help-for-help) -(define-key help-map [help] 'help-for-help) -(define-key help-map [f1] 'help-for-help) -(define-key help-map "?" 'help-for-help) - -(define-key help-map "\C-c" 'describe-copying) -(define-key help-map "\C-d" 'describe-distribution) -(define-key help-map "\C-w" 'describe-no-warranty) -(define-key help-map "\C-p" 'describe-project) -(define-key help-map "a" 'apropos-command) - -(define-key help-map "b" 'describe-bindings) - -(define-key help-map "c" 'describe-key-briefly) -(define-key help-map "k" 'describe-key) - -(define-key help-map "d" 'describe-function) -(define-key help-map "f" 'describe-function) - -(define-key help-map "F" 'view-emacs-FAQ) - -(define-key help-map "i" 'info) -(define-key help-map "4i" 'info-other-window) -(define-key help-map "\C-f" 'Info-goto-emacs-command-node) -(define-key help-map "\C-k" 'Info-goto-emacs-key-command-node) -(define-key help-map "\C-i" 'info-lookup-symbol) - -(define-key help-map "l" 'view-lossage) - -(define-key help-map "m" 'describe-mode) -(define-key help-map "\C-m" 'view-order-manuals) - -(define-key help-map "\C-n" 'view-emacs-news) -(define-key help-map "n" 'view-emacs-news) - -(define-key help-map "p" 'finder-by-keyword) (autoload 'finder-by-keyword "finder" "Find packages matching a given keyword." t) -(define-key help-map "P" 'view-emacs-problems) - -(define-key help-map "s" 'describe-syntax) - -(define-key help-map "t" 'help-with-tutorial) - -(define-key help-map "w" 'where-is) - -(define-key help-map "v" 'describe-variable) - -(define-key help-map "q" 'help-quit) +;; insert-button makes the action nil if it is not store somewhere +(defvar help-button-cache nil) (defun help-quit () @@ -106,17 +111,23 @@ (defvar help-return-method nil "What to do to \"exit\" the help buffer. This is a list - (WINDOW . t) delete the selected window, go to WINDOW. + (WINDOW . t) delete the selected window (and possibly its frame, + see `quit-window' and `View-quit'), go to WINDOW. (WINDOW . quit-window) do quit-window, then select WINDOW. (WINDOW BUF START POINT) display BUF at START, POINT, then select WINDOW.") (defun print-help-return-message (&optional function) "Display or return message saying how to restore windows after help command. -Computes a message and applies the optional argument FUNCTION to it. -If FUNCTION is nil, applies `message' to it, thus printing it." +This function assumes that `standard-output' is the help buffer. +It computes a message, and applies the optional argument FUNCTION to it. +If FUNCTION is nil, it applies `message', thus displaying the message. +In addition, this function sets up `help-return-method', which see, that +specifies what to do when the user exits the help buffer." (and (not (get-buffer-window standard-output)) (let ((first-message - (cond ((special-display-p (buffer-name standard-output)) + (cond ((or + pop-up-frames + (special-display-p (buffer-name standard-output))) (setq help-return-method (cons (selected-window) t)) ;; If the help output buffer is a special display buffer, ;; don't say anything about how to get rid of it. @@ -148,7 +159,8 @@ If FUNCTION is nil, applies `message' to it, thus printing it." (if first-message " ") ;; If the help buffer will go in a separate frame, ;; it's no use mentioning a command to scroll, so don't. - (if (special-display-p (buffer-name standard-output)) + (if (or pop-up-windows + (special-display-p (buffer-name standard-output))) nil (if (same-window-p (buffer-name standard-output)) ;; Say how to scroll this window. @@ -161,54 +173,69 @@ If FUNCTION is nil, applies `message' to it, thus printing it." ;; So keyboard macro definitions are documented correctly (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro)) -(defalias 'help 'help-for-help) -(make-help-screen help-for-help - "a b c C f F C-f i I k C-k l L m n p s t v w C-c C-d C-n C-p C-w; ? for help:" +(defalias 'help 'help-for-help-internal) +;; find-function can find this. +(defalias 'help-for-help 'help-for-help-internal) +;; It can't find this, but nobody will look. +(make-help-screen help-for-help-internal + "a b c C e f F i I k C-k l L m p r s t v w C-c C-d C-f C-n C-p C-t C-w . or ? :" "You have typed %THIS-KEY%, the help character. Type a Help option: \(Use SPC or DEL to scroll through this text. Type \\\\[help-quit] to exit the Help command.) -a command-apropos. Give a substring, and see a list of commands - (functions interactively callable) that contain - that substring. See also the apropos command. +a command-apropos. Give a list of words or a regexp, to get a list of + commands whose names match. See also the apropos command. b describe-bindings. Display table of all key bindings. c describe-key-briefly. Type a command key sequence; it prints the function name that sequence runs. C describe-coding-system. This describes either a specific coding system (if you type its name) or the coding systems currently in use (if you type just RET). -f describe-function. Type a function name and get documentation of it. -C-f Info-goto-emacs-command-node. Type a function name; - it takes you to the Info node for that command. -i info. The info documentation reader. +d apropos-documentation. Give a pattern (a list or words or a regexp), and + see a list of functions, variables, and other items whose built-in + doucmentation string matches that pattern. See also the apropos command. +e view-echo-area-messages. Show the buffer where the echo-area messages + are stored. +f describe-function. Type a function name and get its documentation. +F Info-goto-emacs-command-node. Type a function name; + it takes you to the on-line manual's section that describes + the command. +h Display the HELLO file which illustrates various scripts. +i info. The Info documentation reader: read on-line manuals. I describe-input-method. Describe a specific input method (if you type its name) or the current input method (if you type just RET). -C-i info-lookup-symbol. Display the definition of a specific symbol - as found in the manual for the language this buffer is written in. k describe-key. Type a command key sequence; - it displays the full documentation. -C-k Info-goto-emacs-key-command-node. Type a command key sequence; - it takes you to the Info node for the command bound to that key. + it displays the full documentation for that key sequence. +K Info-goto-emacs-key-command-node. Type a command key sequence; + it takes you to the on-line manual's section that describes + the command bound to that key. l view-lossage. Show last 100 characters you typed. L describe-language-environment. This describes either a specific language environment (if you type its name) or the current language environment (if you type just RET). -m describe-mode. Print documentation of current minor modes, +m describe-mode. Display documentation of current minor modes, and the current major mode, including their special commands. n view-emacs-news. Display news of recent Emacs changes. p finder-by-keyword. Find packages matching a given topic keyword. +r info-emacs-manual. Display the Emacs manual in Info mode. s describe-syntax. Display contents of syntax table, plus explanations. +S info-lookup-symbol. Display the definition of a specific symbol + as found in the manual for the language this buffer is written in. t help-with-tutorial. Select the Emacs learn-by-doing tutorial. v describe-variable. Type name of a variable; it displays the variable's documentation and value. w where-is. Type command name; it prints which keystrokes invoke that command. +. display-local-help. Display any available local help at point + in the echo area. -F Display the frequently asked questions file. -h Display the HELLO file which illustrates various scripts. -C-c Display Emacs copying permission (General Public License). +C-c Display Emacs copying permission (GNU General Public License). C-d Display Emacs ordering information. +C-e Display info about Emacs problems. +C-f Display the Emacs FAQ. +C-m Display how to order printed Emacs manuals. C-n Display news of recent Emacs changes. C-p Display information about the GNU project. +C-t Display the Emacs TODO list. C-w Display information on absence of warranty for GNU Emacs." help-map) @@ -217,32 +244,40 @@ C-w Display information on absence of warranty for GNU Emacs." (defun function-called-at-point () "Return a function around point or else called by the list containing point. If that doesn't give a function, return nil." - (with-syntax-table emacs-lisp-mode-syntax-table - (or (condition-case () - (save-excursion - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (following-char)) ?w) - (eq (char-syntax (following-char)) ?_) - (forward-sexp -1)) - (skip-chars-forward "'") - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj))) - (error nil)) - (condition-case () - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) - (- (point) 1000)) (point-max)) - ;; Move up to surrounding paren, then after the open. - (backward-up-list 1) - (forward-char 1) - ;; If there is space here, this is probably something - ;; other than a real Lisp function call, so ignore it. - (if (looking-at "[ \t]") - (error "Probably not a Lisp function call")) - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj)))) - (error nil))))) + (or (with-syntax-table emacs-lisp-mode-syntax-table + (or (condition-case () + (save-excursion + (or (not (zerop (skip-syntax-backward "_w"))) + (eq (char-syntax (following-char)) ?w) + (eq (char-syntax (following-char)) ?_) + (forward-sexp -1)) + (skip-chars-forward "'") + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (fboundp obj) obj))) + (error nil)) + (condition-case () + (save-excursion + (save-restriction + (narrow-to-region (max (point-min) + (- (point) 1000)) (point-max)) + ;; Move up to surrounding paren, then after the open. + (backward-up-list 1) + (forward-char 1) + ;; If there is space here, this is probably something + ;; other than a real Lisp function call, so ignore it. + (if (looking-at "[ \t]") + (error "Probably not a Lisp function call")) + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (fboundp obj) obj)))) + (error nil)))) + (let* ((str (find-tag-default)) + (sym (if str (intern-soft str)))) + (if (and sym (fboundp sym)) + sym + (save-match-data + (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str)) + (setq sym (intern-soft (match-string 1 str))) + (and (fboundp sym) sym))))))) ;;; `User' help functions @@ -250,7 +285,7 @@ If that doesn't give a function, return nil." (defun describe-distribution () "Display info on how to obtain the latest version of GNU Emacs." (interactive) - (view-find (expand-file-name "DISTRIB" data-directory))) + (view-file (expand-file-name "DISTRIB" data-directory))) (defun describe-copying () "Display info on how you may redistribute copies of GNU Emacs." @@ -293,19 +328,73 @@ of the key sequence that ran this command." (defun view-emacs-news (&optional arg) "Display info on recent changes to Emacs. -With numeric argument, display information on correspondingly older changes." +With argument, display info only for the selected version." (interactive "P") - (let* ((arg (if arg (prefix-numeric-value arg) 0)) - (file (cond ((eq arg 0) "NEWS") - ((eq arg 1) "ONEWS") - (t - (nth (- arg 2) - (nreverse (directory-files data-directory - nil "^ONEWS\\.[0-9]+$" - nil))))))) - (if file - (view-file (expand-file-name file data-directory)) - (error "No such old news")))) + (if (not arg) + (view-file (expand-file-name "NEWS" data-directory)) + (let* ((map (sort + (delete-dups + (apply + 'nconc + (mapcar + (lambda (file) + (with-temp-buffer + (insert-file-contents + (expand-file-name file data-directory)) + (let (res) + (while (re-search-forward + (if (string-match "^ONEWS\\.[0-9]+$" file) + "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" + "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t) + (setq res (cons (list (match-string-no-properties 1) + file) res))) + res))) + (append '("NEWS" "ONEWS") + (directory-files data-directory nil + "^ONEWS\\.[0-9]+$" nil))))) + (lambda (a b) + (string< (car b) (car a))))) + (current (caar map)) + (version (completing-read + (format "Read NEWS for the version (default %s): " current) + (mapcar 'car map) nil nil nil nil current)) + (file (cadr (assoc version map))) + res) + (if (not file) + (error "No news is good news") + (view-file (expand-file-name file data-directory)) + (widen) + (goto-char (point-min)) + (when (re-search-forward + (concat (if (string-match "^ONEWS\\.[0-9]+$" file) + "Changes in \\(?:Emacs\\|version\\)?[ \t]*" + "^\* [^0-9\n]*") version) + nil t) + (beginning-of-line) + (narrow-to-region + (point) + (save-excursion + (while (and (setq res + (re-search-forward + (if (string-match "^ONEWS\\.[0-9]+$" file) + "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" + "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)) + (equal (match-string-no-properties 1) version))) + (or res (goto-char (point-max))) + (beginning-of-line) + (point)))))))) + +(defun view-todo (&optional arg) + "Display the Emacs TODO list." + (interactive "P") + (view-file (expand-file-name "TODO" data-directory))) + +(defun view-echo-area-messages () + "View the log of recent echo-area messages: the `*Messages*' buffer. +The number of messages retained in that buffer +is specified by the variable `message-log-max'." + (interactive) + (switch-to-buffer (get-buffer-create "*Messages*"))) (defun view-order-manuals () "Display the Emacs ORDERS file." @@ -331,19 +420,18 @@ To record all your input on a file, use `open-dribble-file'." (interactive) (help-setup-xref (list #'view-lossage) (interactive-p)) (with-output-to-temp-buffer (help-buffer) - (princ (mapconcat (function (lambda (key) - (if (or (integerp key) - (symbolp key) - (listp key)) - (single-key-description key) - (prin1-to-string key nil)))) + (princ (mapconcat (lambda (key) + (if (or (integerp key) (symbolp key) (listp key)) + (single-key-description key) + (prin1-to-string key nil))) (recent-keys) " ")) (with-current-buffer standard-output (goto-char (point-min)) (while (progn (move-to-column 50) (not (eobp))) - (search-forward " " nil t) - (insert "\n"))) + (when (search-forward " " nil t) + (delete-char -1)) + (insert "\n"))) (print-help-return-message))) @@ -356,7 +444,8 @@ We put that list in a buffer, and display the buffer. The optional argument PREFIX, if non-nil, should be a key sequence; then we display only bindings that start with that prefix. The optional argument BUFFER specifies which buffer's bindings -to display (default, the current buffer)." +to display (default, the current buffer). BUFFER can be a buffer +or a buffer name." (interactive) (or buffer (setq buffer (current-buffer))) (help-setup-xref (list #'describe-bindings prefix buffer) (interactive-p)) @@ -386,23 +475,54 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (let ((fn (function-called-at-point)) (enable-recursive-minibuffers t) val) - (setq val (completing-read (if fn - (format "Where is command (default %s): " fn) - "Where is command: ") - obarray 'commandp t)) - (list (if (equal val "") - fn (intern val)) - current-prefix-arg))) - (let* ((keys (where-is-internal definition overriding-local-map nil nil)) - (keys1 (mapconcat 'key-description keys ", ")) - (standard-output (if insert (current-buffer) t))) - (if insert - (if (> (length keys1) 0) - (princ (format "%s (%s)" keys1 definition)) - (princ (format "M-x %s RET" definition))) - (if (> (length keys1) 0) - (princ (format "%s is on %s" definition keys1)) - (princ (format "%s is not on any key" definition))))) + (setq val (completing-read + (if fn + (format "Where is command (default %s): " fn) + "Where is command: ") + obarray 'commandp t)) + (list (if (equal val "") fn (intern val)) current-prefix-arg))) + (let ((func (indirect-function definition)) + (defs nil) + (standard-output (if insert (current-buffer) t))) + ;; In DEFS, find all symbols that are aliases for DEFINITION. + (mapatoms (lambda (symbol) + (and (fboundp symbol) + (not (eq symbol definition)) + (eq func (condition-case () + (indirect-function symbol) + (error symbol))) + (push symbol defs)))) + ;; Look at all the symbols--first DEFINITION, + ;; then its aliases. + (dolist (symbol (cons definition defs)) + (let* ((remapped (command-remapping symbol)) + (keys (where-is-internal + symbol overriding-local-map nil nil remapped)) + (keys (mapconcat 'key-description keys ", ")) + string) + (setq string + (if insert + (if (> (length keys) 0) + (if remapped + (format "%s (%s) (remapped from %s)" + keys remapped symbol) + (format "%s (%s)" keys symbol)) + (format "M-x %s RET" symbol)) + (if (> (length keys) 0) + (if remapped + (format "%s is remapped to %s which is on %s" + symbol remapped keys) + (format "%s is on %s" symbol keys)) + ;; If this is the command the user asked about, + ;; and it is not on any key, say so. + ;; For other symbols, its aliases, say nothing + ;; about them unless they are on keys. + (if (eq symbol definition) + (format "%s is not on any key" symbol))))) + (when string + (unless (eq symbol definition) + (princ ";\n its alias ")) + (princ string))))) nil) (defun string-key-binding (key) @@ -411,7 +531,8 @@ 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)) + (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)))))) @@ -419,17 +540,60 @@ or `keymap' property, return the binding of KEY in the string's keymap." (when string-info (let* ((string (car string-info)) (pos (cdr string-info)) - (local-map (and (> pos 0) + (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 describe-key-briefly (key &optional insert) +(defun help-key-description (key untranslated) + (let ((string (key-description key))) + (if (or (not untranslated) + (and (eq (aref untranslated 0) ?\e) (not (eq (aref key 0) ?\e)))) + string + (let ((otherstring (key-description untranslated))) + (if (equal string otherstring) + string + (format "%s (translated from %s)" string otherstring)))))) + +(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." - (interactive "kDescribe key briefly: \nP") +If INSERT (the prefix arg) is non-nil, insert the message in the buffer. +If non-nil, UNTRANSLATED is a vector of the untranslated events. +It can also be a number in which case the untranslated events from +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)) + (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)) + (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))) (save-excursion (let ((modifiers (event-modifiers (aref key 0))) (standard-output (if insert (current-buffer) t)) @@ -447,24 +611,70 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (goto-char position))) ;; Ok, now look up the key and name the command. (let ((defn (or (string-key-binding key) - (key-binding key))) - (key-desc (key-description key))) - (if (or (null defn) (integerp 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 insert - "`%s' (`%s')" - (if (windowp window) - "%s at that spot runs the command %s" - "%s runs the command %s")) + (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))))))))) - -(defun describe-key (key) +(defun describe-key (&optional key untranslated up-event) "Display documentation of the function invoked by KEY. -KEY should be a key sequence--when calling from a program, -pass a string or a vector." - (interactive "kDescribe key: ") +KEY can be any kind of a key sequence; it can include keyboard events, +mouse events, and/or menu events. When calling from a program, +pass KEY as a string or a vector. + +If non-nil, UNTRANSLATED is a vector of the corresponding untranslated events. +It can also be a number, in which case the untranslated events from +the last key sequence entered are used. +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)) + (setq key (read-key-sequence "Describe key (or click or menu item): ")) + (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)))) + ;; 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) @@ -478,74 +688,260 @@ pass a string or a vector." (when (windowp window) (set-buffer (window-buffer window)) (goto-char position)) - (let ((defn (or (string-key-binding key) (key-binding key)))) - (if (or (null defn) (integerp defn)) - (message "%s is undefined" (key-description key)) + (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 (key-description key)) + (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) + 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 \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))))))) - (defun describe-mode (&optional buffer) "Display documentation of current major mode and minor modes. -The major mode description comes first, followed by 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." +A brief summary of the minor modes comes first, followed by the +major mode description. This is followed by detailed +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) - (when buffer (set-buffer buffer)) - (help-setup-xref (list #'describe-mode (current-buffer)) (interactive-p)) + (unless buffer (setq buffer (current-buffer))) + (help-setup-xref (list #'describe-mode buffer) + (interactive-p)) + ;; For the sake of help-do-xref and help-xref-go-back, + ;; don't switch buffers before calling `help-buffer'. (with-output-to-temp-buffer (help-buffer) - (when minor-mode-alist - (princ "The major mode is described first. -For minor modes, see following pages.\n\n")) - (princ mode-name) - (princ " mode:\n") - (princ (documentation major-mode)) - (let ((minor-modes minor-mode-alist)) - (while minor-modes - (let* ((minor-mode (car (car minor-modes))) - (indicator (car (cdr (car minor-modes))))) + (with-current-buffer buffer + (let (minor-modes) + ;; Older packages do not register in minor-mode-list but only in + ;; minor-mode-alist. + (dolist (x minor-mode-alist) + (setq x (car x)) + (unless (memq x minor-mode-list) + (push x minor-mode-list))) + ;; Find enabled minor mode we will want to mention. + (dolist (mode minor-mode-list) ;; Document a minor mode if it is listed in minor-mode-alist, - ;; bound locally in this buffer, non-nil, and has a function - ;; definition. - (if (and (boundp minor-mode) - (symbol-value minor-mode) - (fboundp minor-mode)) - (let ((pretty-minor-mode minor-mode)) - (if (string-match "\\(-minor\\)?-mode\\'" - (symbol-name minor-mode)) - (setq pretty-minor-mode - (capitalize - (substring (symbol-name minor-mode) - 0 (match-beginning 0))))) - (while (and indicator (symbolp indicator) - (boundp indicator) - (not (eq indicator (symbol-value indicator)))) - (setq indicator (symbol-value indicator))) - (princ "\n\f\n") - (princ (format "%s minor mode (%s):\n" - pretty-minor-mode - (if indicator - (format "indicator%s" indicator) - "no indicator"))) - (princ (documentation minor-mode))))) - (setq minor-modes (cdr minor-modes)))) - (print-help-return-message))) + ;; non-nil, and has a function definition. + (let ((fmode (or (get mode :minor-mode-function) mode))) + (and (boundp mode) (symbol-value mode) + (fboundp fmode) + (let ((pretty-minor-mode + (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'" + (symbol-name fmode)) + (capitalize + (substring (symbol-name fmode) + 0 (match-beginning 0))) + fmode))) + (push (list fmode pretty-minor-mode + (format-mode-line (assq mode minor-mode-alist))) + minor-modes))))) + (setq minor-modes + (sort minor-modes + (lambda (a b) (string-lessp (cadr a) (cadr b))))) + (when minor-modes + (princ "Summary of 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 + (goto-char (point-max)) + (princ "\n\f\n") + (push (point-marker) help-button-cache) + ;; Document the minor modes fully. + (insert pretty-minor-mode) + (princ (format " minor mode (%s):\n" 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")) + ;; Document the major mode. + (let ((mode mode-name)) + (with-current-buffer standard-output + (let ((start (point))) + (insert (format-mode-line mode)) + (add-text-properties start (point) '(face bold))))) + (princ " mode:\n") + (princ (documentation major-mode))) + (print-help-return-message)))) + + +(defun describe-minor-mode (minor-mode) + "Display documentation of a minor mode given as MINOR-MODE. +MINOR-MODE can be a minor mode symbol or a minor mode indicator string +appeared on the mode-line." + (interactive (list (completing-read + "Minor mode: " + (nconc + (describe-minor-mode-completion-table-for-symbol) + (describe-minor-mode-completion-table-for-indicator) + )))) + (if (symbolp minor-mode) + (setq minor-mode (symbol-name minor-mode))) + (let ((symbols (describe-minor-mode-completion-table-for-symbol)) + (indicators (describe-minor-mode-completion-table-for-indicator))) + (cond + ((member minor-mode symbols) + (describe-minor-mode-from-symbol (intern minor-mode))) + ((member minor-mode indicators) + (describe-minor-mode-from-indicator minor-mode)) + (t + (error "No such minor mode: %s" minor-mode))))) + +;; symbol +(defun describe-minor-mode-completion-table-for-symbol () + ;; In order to list up all minor modes, minor-mode-list + ;; is used here instead of minor-mode-alist. + (delq nil (mapcar 'symbol-name minor-mode-list))) +(defun describe-minor-mode-from-symbol (symbol) + "Display documentation of a minor mode given as a symbol, SYMBOL" + (interactive (list (intern (completing-read + "Minor mode symbol: " + (describe-minor-mode-completion-table-for-symbol))))) + (if (fboundp symbol) + (describe-function symbol) + (describe-variable symbol))) + +;; indicator +(defun describe-minor-mode-completion-table-for-indicator () + (delq nil + (mapcar (lambda (x) + (let ((i (format-mode-line x))) + ;; remove first space if existed + (cond + ((= 0 (length i)) + nil) + ((eq (aref i 0) ?\ ) + (substring i 1)) + (t + i)))) + minor-mode-alist))) +(defun describe-minor-mode-from-indicator (indicator) + "Display documentation of a minor mode specified by INDICATOR. +If you call this function interactively, you can give indicator which +is currently activated with completion." + (interactive (list + (completing-read + "Minor mode indicator: " + (describe-minor-mode-completion-table-for-indicator)))) + (let ((minor-mode (lookup-minor-mode-from-indicator indicator))) + (if minor-mode + (describe-minor-mode-from-symbol minor-mode) + (error "Cannot find minor mode for `%s'" indicator)))) + +(defun lookup-minor-mode-from-indicator (indicator) + "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) ?\ )) + (setq indicator (substring indicator 1))) + (let ((minor-modes minor-mode-alist) + result) + (while minor-modes + (let* ((minor-mode (car (car minor-modes))) + (anindicator (format-mode-line + (car (cdr (car minor-modes)))))) + ;; remove first space if existed + (if (and (stringp anindicator) + (> (length anindicator) 0) + (eq (aref anindicator 0) ?\ )) + (setq anindicator (substring anindicator 1))) + (if (equal indicator anindicator) + (setq result minor-mode + minor-modes nil) + (setq minor-modes (cdr minor-modes))))) + result)) ;;; Automatic resizing of temporary buffers. (defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2)) - "*Maximum height of a window displaying a temporary buffer. + "Maximum height of a window displaying a temporary buffer. This is the maximum height (in text lines) which `resize-temp-buffer-window' will give to a window displaying a temporary buffer. It can also be a function which will be called with the object corresponding @@ -584,8 +980,8 @@ out of view." (funcall temp-buffer-max-height (current-buffer)) temp-buffer-max-height)))) -;; Provide this for the sake of define-minor-mode which generates -;; defcustoms which require 'help'. + (provide 'help) +;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423 ;;; help.el ends here