X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/fc558e4dede77c46092aeac0b0c180ab5e793bb0..d18a808f42266d6a1873373e6fef9ca6e74a5226:/lisp/help.el diff --git a/lisp/help.el b/lisp/help.el index e416fd3d88..45d84b8897 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1,6 +1,6 @@ ;;; help.el --- help commands for Emacs -;; Copyright (C) 1985, 1986, 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1993, 1994, 1998 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal @@ -18,12 +18,13 @@ ;; GNU General Public License for more details. ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; 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. ;;; Commentary: -;; This code implements GNU Emac's on-line help system, the one invoked by +;; This code implements GNU Emacs' on-line help system, the one invoked by ;;`M-x help-for-help'. ;;; Code: @@ -52,7 +53,7 @@ (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" 'command-apropos) +(define-key help-map "a" 'apropos-command) (define-key help-map "b" 'describe-bindings) @@ -65,8 +66,10 @@ (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) @@ -89,27 +92,51 @@ (define-key help-map "q" 'help-quit) -(defvar help-font-lock-keywords - (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]")) - (list - ;; - ;; The symbol itself. - (list (concat "\\`\\(" name-char "+\\)\\(:\\)?") - '(1 (if (match-beginning 2) - font-lock-function-name-face - font-lock-variable-name-face) - nil t)) - ;; - ;; Words inside `' which tend to be symbol names. - (list (concat "`\\(" sym-char sym-char "+\\)'") - 1 'font-lock-reference-face t) - ;; - ;; CLisp `:' keywords as references. - (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t))) - "Default expressions to highlight in Help mode.") +(define-key help-mode-map [mouse-2] 'help-follow-mouse) +(define-key help-mode-map "\C-c\C-b" 'help-go-back) +(define-key help-mode-map "\C-c\C-c" 'help-follow) +(define-key help-mode-map "\t" 'help-next-ref) +(define-key help-mode-map [backtab] 'help-previous-ref) +(define-key help-mode-map [(shift tab)] 'help-previous-ref) +;; Documentation only, since we use minor-mode-overriding-map-alist. +(define-key help-mode-map "\r" 'help-follow) + +;; Font-locking is incompatible with the new xref stuff. +;(defvar help-font-lock-keywords +; (eval-when-compile +; (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]")) +; (list +; ;; +; ;; The symbol itself. +; (list (concat "\\`\\(" name-char "+\\)\\(\\(:\\)\\|\\('\\)\\)") +; '(1 (if (match-beginning 3) +; font-lock-function-name-face +; font-lock-variable-name-face))) +; ;; +; ;; Words inside `' which tend to be symbol names. +; (list (concat "`\\(" sym-char sym-char "+\\)'") +; 1 'font-lock-constant-face t) +; ;; +; ;; CLisp `:' keywords as references. +; (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-builtin-face t)))) +; "Default expressions to highlight in Help mode.") + +(defvar help-xref-stack nil + "A stack of ways by which to return to help buffers after following xrefs. +Used by `help-follow' and `help-xref-go-back'. +An element looks like (POSITION FUNCTION ARGS...). +To use the element, do (apply FUNCTION ARGS) then (goto-char POSITION).") +(put 'help-xref-stack 'permanent-local t) + +(defvar help-xref-stack-item nil + "An item for `help-follow' in this buffer to push onto `help-xref-stack'. +The format is (FUNCTION ARGS...).") +(put 'help-xref-stack-item 'permanent-local t) + +(setq-default help-xref-stack nil help-xref-stack-item nil) (defun help-mode () - "Major mode for viewing help text. + "Major mode for viewing help text and navigating references in it. Entry to this mode runs the normal hook `help-mode-hook'. Commands: \\{help-mode-map}" @@ -119,18 +146,46 @@ Commands: (setq mode-name "Help") (setq major-mode 'help-mode) (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(help-font-lock-keywords)) + (setq font-lock-defaults nil) ; font-lock would defeat xref (view-mode) + (make-local-variable 'view-no-disable-on-exit) + (setq view-no-disable-on-exit t) + ;; `help-make-xrefs' would be run here if not invoked from + ;; `help-mode-maybe'. (run-hooks 'help-mode-hook)) +(defun help-mode-maybe () + (if (eq major-mode 'fundamental-mode) + (help-mode)) + (when (eq major-mode 'help-mode) + ;; View mode's read-only status of existing *Help* buffer is lost + ;; by with-output-to-temp-buffer. + (toggle-read-only 1) + (help-make-xrefs (current-buffer))) + (setq view-return-to-alist + (list (cons (selected-window) help-return-method)))) + +(add-hook 'temp-buffer-show-hook 'help-mode-maybe) + (defun help-quit () (interactive) nil) -(defun help-with-tutorial () - "Select the Emacs learn-by-doing tutorial." - (interactive) - (let ((file (expand-file-name "~/TUTORIAL"))) +(defun help-with-tutorial (&optional arg) + "Select the Emacs learn-by-doing tutorial. +If there is a tutorial version written in the language +of the selected language environment, that version is used. +If there's no tutorial in that language, `TUTORIAL' is selected. +With arg, you are asked to choose which language." + (interactive "P") + (let ((lang (if arg + (read-language-name 'tutorial "Language: " "English") + (if (get-language-info current-language-environment 'tutorial) + current-language-environment + "English"))) + file filename) + (setq filename (get-language-info lang 'tutorial)) + (setq file (expand-file-name (concat "~/" filename))) (delete-other-windows) (if (get-file-buffer file) (switch-to-buffer (get-file-buffer file)) @@ -138,7 +193,7 @@ Commands: (setq buffer-file-name file) (setq default-directory (expand-file-name "~/")) (setq buffer-auto-save-file-name nil) - (insert-file-contents (expand-file-name "TUTORIAL" data-directory)) + (insert-file-contents (expand-file-name filename data-directory)) (goto-char (point-min)) (search-forward "\n<<") (beginning-of-line) @@ -156,19 +211,13 @@ Commands: (goto-char (point-min)) (set-buffer-modified-p nil)))) -(defun describe-key-briefly (key) - "Print the name of the function KEY invokes. KEY is a string." - (interactive "kDescribe key briefly: ") - ;; If this key seq ends with a down event, discard the - ;; following click or drag event. Otherwise that would - ;; erase the message. - (let ((type (aref key (1- (length key))))) - (if (listp type) (setq type (car type))) - (and (symbolp type) - (memq 'down (event-modifiers type)) - (read-event))) +(defun describe-key-briefly (key &optional insert) + "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") (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 @@ -182,14 +231,24 @@ Commands: (set-buffer (window-buffer window)) (goto-char position))) ;; Ok, now look up the key and name the command. - (let ((defn (key-binding key))) + (let ((defn (key-binding key)) + (key-desc (key-description key))) (if (or (null defn) (integerp defn)) - (message "%s is undefined" (key-description key)) - (message (if (windowp window) - "%s at that spot runs the command %s" - "%s runs the command %s") - (key-description key) - (if (symbolp defn) defn (prin1-to-string defn)))))))) + (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")) + key-desc + (if (symbolp defn) defn (prin1-to-string defn))))))))) + +(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 . 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. @@ -197,35 +256,26 @@ Computes a message and applies the optional argument FUNCTION to it. If FUNCTION is nil, applies `message' to it, thus printing it." (and (not (get-buffer-window standard-output)) (let ((first-message - (cond ((or (member (buffer-name standard-output) - special-display-buffer-names) - (assoc (buffer-name standard-output) - special-display-buffer-names) - (let (found - (tail special-display-regexps) - (name (buffer-name standard-output))) - (while (and tail (not found)) - (if (or (and (consp (car tail)) - (string-match (car (car tail)) name)) - (and (stringp (car tail)) - (string-match (car tail) name))) - (setq found t)) - (setq tail (cdr tail))) - found)) + (cond ((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. ;; First of all, the user will do that with the window ;; manager, not with Emacs. ;; Secondly, the buffer has not been displayed yet, ;; so we don't know whether its frame will be selected. - ;; Even the message about scrolling the help - ;; might be wrong, but it seems worth showing it anyway. nil) ((not (one-window-p t)) + (setq help-return-method + (cons (selected-window) 'quit-window)) "Type \\[switch-to-buffer-other-window] RET to restore the other window.") (pop-up-windows + (setq help-return-method (cons (selected-window) t)) "Type \\[delete-other-windows] to remove help window.") (t + (setq help-return-method + (list (selected-window) (window-buffer) + (window-start) (window-point))) "Type \\[switch-to-buffer] RET to remove help window.")))) (funcall (or function 'message) (concat @@ -235,25 +285,9 @@ 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 (or (member (buffer-name standard-output) - special-display-buffer-names) - (assoc (buffer-name standard-output) - special-display-buffer-names) - (memq t (mapcar '(lambda (elt) - (if (consp elt) - (setq elt (car elt))) - (string-match elt (buffer-name standard-output))) - special-display-regexps))) + (if (special-display-p (buffer-name standard-output)) nil - (if (or (member (buffer-name standard-output) - same-window-buffer-names) - (assoc (buffer-name standard-output) - same-window-buffer-names) - (memq t (mapcar '(lambda (elt) - (if (consp elt) - (setq elt (car elt))) - (string-match elt (buffer-name standard-output))) - same-window-regexps))) + (if (same-window-p (buffer-name standard-output)) ;; Say how to scroll this window. (substitute-command-keys "\\[scroll-up] to scroll the help.") @@ -264,14 +298,6 @@ If FUNCTION is nil, applies `message' to it, thus printing it." (defun describe-key (key) "Display documentation of the function invoked by KEY. KEY is a string." (interactive "kDescribe key: ") - ;; If this key seq ends with a down event, discard the - ;; following click or drag event. Otherwise that would - ;; erase the message. - (let ((type (aref key (1- (length key))))) - (if (listp type) (setq type (car type))) - (and (symbolp type) - (memq 'down (event-modifiers type)) - (read-event))) (save-excursion (let ((modifiers (event-modifiers (aref key 0))) window position) @@ -295,13 +321,8 @@ If FUNCTION is nil, applies `message' to it, thus printing it." (princ " at that spot")) (princ " runs the command ") (prin1 defn) - (princ ":\n") - (if (documentation defn) - (princ (documentation defn)) - (princ "not documented")) - (save-excursion - (set-buffer standard-output) - (help-mode)) + (princ "\n which is ") + (describe-function-1 defn nil) (print-help-return-message))))))) (defun describe-mode () @@ -312,16 +333,14 @@ describes the minor mode." (interactive) (with-output-to-temp-buffer "*Help*" (let ((minor-modes minor-mode-alist) - (locals (buffer-local-variables))) + (first t)) (while minor-modes (let* ((minor-mode (car (car minor-modes))) - (indicator (car (cdr (car minor-modes)))) - (local-binding (assq minor-mode locals))) + (indicator (car (cdr (car minor-modes))))) ;; 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 local-binding - (cdr local-binding) + (if (and (symbol-value minor-mode) (fboundp minor-mode)) (let ((pretty-minor-mode minor-mode)) (if (string-match "-mode$" (symbol-name minor-mode)) @@ -331,17 +350,22 @@ describes the minor mode." 0 (match-beginning 0))))) (while (and indicator (symbolp indicator)) (setq indicator (symbol-value indicator))) - (princ (format "%s minor mode (indicator%s):\n" - pretty-minor-mode indicator)) + (if first + (princ "The minor modes are described first, +followed by the major mode, which is described on the last page.\n\f\n")) + (setq first nil) + (princ (format "%s minor mode (%s):\n" + pretty-minor-mode + (if indicator + (format "indicator%s" indicator) + "no indicator"))) (princ (documentation minor-mode)) - (princ "\n\n")))) + (princ "\n\f\n")))) (setq minor-modes (cdr minor-modes)))) (princ mode-name) (princ " mode:\n") (princ (documentation major-mode)) - (save-excursion - (set-buffer standard-output) - (help-mode)) + (help-setup-xref (list #'help-xref-mode (current-buffer)) (interactive-p)) (print-help-return-message))) ;; So keyboard macro definitions are documented correctly @@ -394,10 +418,14 @@ of the key sequence that ran this command." ;; run describe-prefix-bindings. (setq prefix-help-command 'describe-prefix-bindings) -(defun view-emacs-news () - "Display info on recent changes to Emacs." - (interactive) - (find-file-read-only (expand-file-name "NEWS" data-directory))) +(defun view-emacs-news (&optional arg) + "Display info on recent changes to Emacs. +With numeric argument display information on correspondingly older changes." + (interactive "P") + (let* ((arg (if arg (prefix-numeric-value arg) 0))) + (find-file-read-only + (expand-file-name (concat (make-string arg ?O) "NEWS") + data-directory)))) (defun view-emacs-FAQ () "Display the Emacs Frequently Asked Questions (FAQ) file." @@ -422,12 +450,13 @@ of the key sequence that ran this command." (while (progn (move-to-column 50) (not (eobp))) (search-forward " " nil t) (insert "\n")) - (help-mode)) + (setq help-xref-stack nil + help-xref-stack-item nil)) (print-help-return-message))) (defalias 'help 'help-for-help) (make-help-screen help-for-help - "a b c f C-f i k C-k l m n p s t v w C-c C-d C-n C-w, or ? for more 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:" "You have typed \\[help-command], the help character. Type a Help option: \(Use SPC or DEL to scroll through this text. Type \\\\[help-quit] to exit the Help command.) @@ -437,18 +466,25 @@ a command-apropos. Give a substring, and see a list of commands 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. -F view-emacs-FAQ. Shows emacs frequently asked questions file. i info. The info documentation reader. +I describe-input-method. Describe a specific input method (if you type + its name) or the current input method (if you type just RET). 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. l view-lossage. Shows last 100 characters you typed. -m describe-mode. Print documentation of current major mode, - which describes the commands peculiar to it. +L describe-language-environment. This describes either the 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, + and the current major mode, including their special commands. n view-emacs-news. Shows emacs news file. p finder-by-keyword. Find packages matching a given topic keyword. s describe-syntax. Display contents of syntax table, plus explanations @@ -457,32 +493,40 @@ 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. -C-c print Emacs copying permission (General Public License). -C-d print Emacs ordering information. -C-n print news of recent Emacs changes. -C-p print information about the GNU project. -C-w print information on absence of warranty for GNU Emacs." + +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-d Display Emacs ordering information. +C-n Display news of recent Emacs changes. +C-p Display information about the GNU project. +C-w Display information on absence of warranty for GNU Emacs." help-map) ;; Return a function which is called by the list containing point. ;; If that gives no function, return a function whose name is around point. ;; If that doesn't give a function, return nil. (defun function-called-at-point () - (or (condition-case () - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) (- (point) 1000)) (point-max)) - (backward-up-list 1) - (forward-char 1) - (let (obj) - (setq obj (read (current-buffer))) - (and (symbolp obj) (fboundp obj) obj)))) - (error nil)) - (condition-case () - (let ((stab (syntax-table))) - (unwind-protect + (let ((stab (syntax-table))) + (set-syntax-table emacs-lisp-mode-syntax-table) + (unwind-protect + (or (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) + (setq obj (read (current-buffer))) + (and (symbolp obj) (fboundp obj) obj)))) + (error nil)) + (condition-case () (save-excursion - (set-syntax-table emacs-lisp-mode-syntax-table) (or (not (zerop (skip-syntax-backward "_w"))) (eq (char-syntax (following-char)) ?w) (eq (char-syntax (following-char)) ?_) @@ -490,8 +534,8 @@ C-w print information on absence of warranty for GNU Emacs." (skip-chars-forward "'") (let ((obj (read (current-buffer)))) (and (symbolp obj) (fboundp obj) obj))) - (set-syntax-table stab))) - (error nil)))) + (error nil))) + (set-syntax-table stab)))) (defun describe-function-find-file (function) (let ((files load-history) @@ -511,74 +555,105 @@ C-w print information on absence of warranty for GNU Emacs." (setq val (completing-read (if fn (format "Describe function (default %s): " fn) "Describe function: ") - obarray 'fboundp t)) + obarray 'fboundp t nil nil (symbol-name fn))) (list (if (equal val "") fn (intern val))))) - (with-output-to-temp-buffer "*Help*" - (prin1 function) - (princ ": ") - (let* ((def (symbol-function function)) - file-name - (beg (if (commandp def) "an interactive " "a "))) - (princ (cond ((or (stringp def) - (vectorp def)) - "a keyboard macro") - ((subrp def) - (concat beg "built-in function")) - ((byte-code-function-p def) - (concat beg "compiled Lisp function")) - ((symbolp def) - (format "alias for `%s'" def)) - ((eq (car-safe def) 'lambda) - (concat beg "Lisp function")) - ((eq (car-safe def) 'macro) - "a Lisp macro") - ((eq (car-safe def) 'mocklisp) - "a mocklisp function") - ((eq (car-safe def) 'autoload) - (setq file-name (nth 1 def)) - (format "%s autoloaded Lisp %s" - (if (commandp def) "an interactive" "an") - (if (nth 4 def) "macro" "function") - )) - (t ""))) - (or file-name - (setq file-name (describe-function-find-file function))) - (if file-name + (if function + (with-output-to-temp-buffer "*Help*" + (prin1 function) + ;; Use " is " instead of a colon so that + ;; it is easier to get out the function name using forward-sexp. + (princ " is ") + (describe-function-1 function nil) + (print-help-return-message) + (save-excursion + (set-buffer standard-output) + ;; Return the text we displayed. + (buffer-string))) + (message "You didn't specify a function"))) + +(defun describe-function-1 (function parens) + (let* ((def (symbol-function function)) + file-name string need-close + (beg (if (commandp def) "an interactive " "a "))) + (setq string + (cond ((or (stringp def) + (vectorp def)) + "a keyboard macro") + ((subrp def) + (concat beg "built-in function")) + ((byte-code-function-p def) + (concat beg "compiled Lisp function")) + ((symbolp def) + (while (symbolp (symbol-function def)) + (setq def (symbol-function def))) + (format "alias for `%s'" def)) + ((eq (car-safe def) 'lambda) + (concat beg "Lisp function")) + ((eq (car-safe def) 'macro) + "a Lisp macro") + ((eq (car-safe def) 'mocklisp) + "a mocklisp function") + ((eq (car-safe def) 'autoload) + (setq file-name (nth 1 def)) + (format "%s autoloaded Lisp %s" + (if (commandp def) "an interactive" "an") + (if (nth 4 def) "macro" "function") + )) + (t ""))) + (when (and parens (not (equal string ""))) + (setq need-close t) + (princ "(")) + (princ string) + (or file-name + (setq file-name (describe-function-find-file function))) + (if file-name + (progn + (princ " in `") + ;; We used to add .el to the file name, + ;; but that's completely wrong when the user used load-file. + (princ file-name) + (princ "'") + ;; Make a hyperlink to the library. + (with-current-buffer "*Help*" + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 #'(lambda (arg) + (let ((location + (find-function-noselect arg))) + (pop-to-buffer (car location)) + (goto-char (cdr location)))) + function))))) + (if need-close (princ ")")) + (princ ".") + (terpri) + ;; Handle symbols aliased to other symbols. + (setq def (indirect-function def)) + ;; If definition is a macro, find the function inside it. + (if (eq (car-safe def) 'macro) + (setq def (cdr def))) + (let ((arglist (cond ((byte-code-function-p def) + (car (append def nil))) + ((eq (car-safe def) 'lambda) + (nth 1 def)) + (t t)))) + (if (listp arglist) (progn - (princ " in `") - ;; We used to add .el to the file name, - ;; but that's completely wrong when the user used load-file. - (princ file-name) - (princ "'"))) - (princ ".") - (terpri) - (let ((arglist (cond ((byte-code-function-p def) - (car (append def nil))) - ((eq (car-safe def) 'lambda) - (nth 1 def)) - (t t)))) - (if (listp arglist) - (progn - (princ (cons function - (mapcar (lambda (arg) - (if (memq arg '(&optional &rest)) - arg - (intern (upcase (symbol-name arg))))) - arglist))) - (terpri)))) - (if (documentation function) + (princ (cons function + (mapcar (lambda (arg) + (if (memq arg '(&optional &rest)) + arg + (intern (upcase (symbol-name arg))))) + arglist))) + (terpri)))) + (let ((doc (documentation function))) + (if doc (progn (terpri) - (princ (documentation function))) - (princ "not documented")) - ) - (print-help-return-message) - (save-excursion - (set-buffer standard-output) - (help-mode) - ;; Return the text we displayed. - (buffer-string)))) + (princ doc) + (help-setup-xref (list #'describe-function function) (interactive-p))) + (princ "not documented"))))) +;; We return 0 if we can't find a variable to return. (defun variable-at-point () (condition-case () (let ((stab (syntax-table))) @@ -591,9 +666,10 @@ C-w print information on absence of warranty for GNU Emacs." (forward-sexp -1)) (skip-chars-forward "'") (let ((obj (read (current-buffer)))) - (and (symbolp obj) (boundp obj) obj))) + (or (and (symbolp obj) (boundp obj) obj) + 0))) (set-syntax-table stab))) - (error nil))) + (error 0))) (defun describe-variable (variable) "Display the full documentation of VARIABLE (a symbol). @@ -602,44 +678,98 @@ Returns the documentation as a string, also." (let ((v (variable-at-point)) (enable-recursive-minibuffers t) val) - (setq val (completing-read (if v + (setq val (completing-read (if (symbolp v) (format "Describe variable (default %s): " v) "Describe variable: ") - obarray 'boundp t)) + obarray 'boundp t nil nil + (if (symbolp v) (symbol-name v)))) (list (if (equal val "") v (intern val))))) - (with-output-to-temp-buffer "*Help*" - (prin1 variable) - (if (not (boundp variable)) - (princ " is void") - (princ "'s value is ") - (prin1 (symbol-value variable))) - (terpri) - (if (local-variable-p variable) - (progn - (princ (format "Local in buffer %s; " (buffer-name))) - (if (not (default-boundp variable)) - (princ "globally void") - (princ "global value is ") - (prin1 (default-value variable))) - (terpri))) - (terpri) - (princ "Documentation:") - (terpri) - (let ((doc (documentation-property variable 'variable-documentation))) - (if doc - (princ (substitute-command-keys doc)) - (princ "not documented as a variable."))) - (print-help-return-message) - (save-excursion - (set-buffer standard-output) - (help-mode) - ;; Return the text we displayed. - (buffer-string)))) + (if (symbolp variable) + (let (valvoid) + (with-output-to-temp-buffer "*Help*" + (prin1 variable) + (if (not (boundp variable)) + (progn + (princ " is void") + (terpri) + (setq valvoid t)) + (princ "'s value is ") + (terpri) + (pp (symbol-value variable)) + (terpri)) + (if (local-variable-p variable) + (progn + (princ (format "Local in buffer %s; " (buffer-name))) + (if (not (default-boundp variable)) + (princ "globally void") + (princ "global value is ") + (terpri) + (pp (default-value variable))) + (terpri))) + (terpri) + (save-current-buffer + (set-buffer standard-output) + (if (> (count-lines (point-min) (point-max)) 10) + (progn + (goto-char (point-min)) + (if valvoid + (forward-line 1) + (forward-sexp 1) + (delete-region (point) (progn (end-of-line) (point))) + (insert "'s value is shown below.\n\n") + (save-excursion + (insert "\n\nValue:")))))) + (princ "Documentation:") + (terpri) + (let ((doc (documentation-property variable 'variable-documentation))) + (princ (or doc "not documented as a variable."))) + (help-setup-xref (list #'describe-variable variable) (interactive-p)) + + ;; Make a link to customize if this variable can be customized. + ;; Note, it is not reliable to test for a custom-type property + ;; because those are only present after the var's definition + ;; has been loaded. + (if (user-variable-p variable) + (let ((customize-label "customize")) + (terpri) + (terpri) + (princ (concat "You can " customize-label " this variable.")) + (with-current-buffer "*Help*" + (save-excursion + (re-search-backward + (concat "\\(" customize-label "\\)") nil t) + (help-xref-button 1 #'(lambda (v) + (customize-variable v)) variable) + )))) -(defun where-is (definition) + (print-help-return-message) + (save-excursion + (set-buffer standard-output) + ;; Return the text we displayed. + (buffer-string)))) + (message "You did not specify a variable"))) + +(defun describe-bindings (&optional prefix buffer) + "Show a list of all defined keys, and their definitions. +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)." + (interactive "P") + (or buffer (setq buffer (current-buffer))) + (with-current-buffer buffer + (describe-bindings-internal nil prefix)) + (with-current-buffer "*Help*" + (help-setup-xref (list #'describe-bindings prefix buffer) + (interactive-p)))) + +(defun where-is (definition &optional insert) "Print message listing key sequences that invoke specified command. -Argument is a command definition, usually a symbol with a function definition." +Argument is a command definition, usually a symbol with a function definition. +If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (interactive (let ((fn (function-called-at-point)) (enable-recursive-minibuffers t) @@ -649,35 +779,346 @@ Argument is a command definition, usually a symbol with a function definition." "Where is command: ") obarray 'fboundp t)) (list (if (equal val "") - fn (intern val))))) + fn (intern val)) + current-prefix-arg))) (let* ((keys (where-is-internal definition overriding-local-map nil nil)) - (keys1 (mapconcat 'key-description keys ", "))) - (if (> (length keys1) 0) - (message "%s is on %s" definition keys1) - (message "%s is not on any key" definition))) + (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))))) nil) -(defun locate-library (library &optional nosuffix) - "Show the full path name of Emacs library LIBRARY. +(defun locate-library (library &optional nosuffix path interactive-call) + "Show the precise file name of Emacs library LIBRARY. This command searches the directories in `load-path' like `M-x load-library' to find the file that `M-x load-library RET LIBRARY RET' would load. Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el' -to the specified name LIBRARY (a la calling `load' instead of `load-library')." - (interactive "sLocate library: ") - (catch 'answer - (mapcar - '(lambda (dir) - (mapcar - '(lambda (suf) +to the specified name LIBRARY. + +If the optional third arg PATH is specified, that list of directories +is used instead of `load-path'." + (interactive (list (read-string "Locate library: ") + nil nil + t)) + (let (result) + (catch 'answer + (mapcar + (lambda (dir) + (mapcar + (lambda (suf) (let ((try (expand-file-name (concat library suf) dir))) (and (file-readable-p try) (null (file-directory-p try)) (progn - (message "Library is file %s" try) + (setq result try) (throw 'answer try))))) - (if nosuffix '("") '(".elc" ".el" "")))) - load-path) - (message "No library %s in search path" library) - nil)) + (if nosuffix + '("") + '(".elc" ".el" "") +;;; load doesn't handle this yet. +;;; (let ((basic '(".elc" ".el" "")) +;;; (compressed '(".Z" ".gz" ""))) +;;; ;; If autocompression mode is on, +;;; ;; consider all combinations of library suffixes +;;; ;; and compression suffixes. +;;; (if (rassq 'jka-compr-handler file-name-handler-alist) +;;; (apply 'nconc +;;; (mapcar (lambda (compelt) +;;; (mapcar (lambda (baselt) +;;; (concat baselt compelt)) +;;; basic)) +;;; compressed)) +;;; basic)) + ))) + (or path load-path))) + (and interactive-call + (if result + (message "Library is file %s" result) + (message "No library %s in search path" library))) + result)) + + +;;; Grokking cross-reference information in doc strings and +;;; hyperlinking it. + +;; This may have some scope for extension and the same or something +;; similar should be done for widget doc strings, which currently use +;; another mechanism. + +(defcustom help-highlight-p t + "*If non-nil, `help-make-xrefs' highlight cross-references. +Under a window system it highlights them with face defined by +`help-highlight-face'. On a character terminal highlighted +references look like cross-references in info mode." + :group 'help + :version "20.3" + :type 'boolean) + +(defcustom help-highlight-face 'underline + "Face used by `help-make-xrefs' to highlight cross-references. +Must be previously-defined." + :group 'help + :version "20.3" + :type 'face) + +(defvar help-back-label "[back]" + "Label to use by `help-make-xrefs' for the go-back reference.") + +(defvar help-xref-symbol-regexp + (concat "\\(\\<\\(\\(variable\\|option\\)\\|" + "\\(function\\|command\\)\\|" + "\\(symbol\\)\\)\\s-+\\)?" + ;; Note starting with word-syntax character: + "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'") + "Regexp matching doc string references to symbols. + +The words preceding the quoted symbol can be used in doc strings to +distinguish references to variables, functions and symbols.") + +(defvar help-xref-info-regexp + "\\ (move-to-column col) 0) + (looking-at "\\(\\sw\\|\\s_\\)+$")) + ;; + (let ((sym (intern-soft (match-string 0)))) + (if (fboundp sym) + (help-xref-button + 0 #'describe-function sym)))) + t) + (zerop (forward-line)) + (move-to-column 0))))))) + (set-syntax-table stab)) + ;; Make a back-reference in this buffer if appropriate. + (when help-xref-stack + (goto-char (point-max)) + (save-excursion + (insert "\n\n" help-back-label)) + ;; Just to provide the match data: + (looking-at (concat "\n\n\\(" (regexp-quote help-back-label) "\\)")) + (help-xref-button 1 #'help-xref-go-back (current-buffer)))) + ;; View mode steals RET from us. + (set (make-local-variable 'minor-mode-overriding-map-alist) + (list (cons 'view-mode + (let ((map (make-sparse-keymap))) + (set-keymap-parent map view-mode-map) + (define-key map "\r" 'help-follow) + map)))) + (set-buffer-modified-p old-modified)))) + +(defun help-xref-button (match-number function data) + "Make a hyperlink for cross-reference text previously matched. + +MATCH-NUMBER is the subexpression of interest in the last matched +regexp. FUNCTION is a function to invoke when the button is +activated, applied to DATA. DATA may be a single value or a list. +See `help-make-xrefs'." + (add-text-properties (match-beginning match-number) + (match-end match-number) + (list 'mouse-face 'highlight + 'help-xref (cons function + (if (listp data) + data + (list data))))) + (if help-highlight-p + (put-text-property (match-beginning match-number) + (match-end match-number) + 'face help-highlight-face))) + + +;; Additional functions for (re-)creating types of help buffers. +(defun help-xref-interned (symbol) + "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL. + +Both variable and function documentation are extracted into a single +help buffer." + (let ((fdoc (describe-function symbol))) + (describe-variable symbol) + ;; We now have a help buffer on the variable. Insert the function + ;; text after it. + (goto-char (point-max)) + (insert "\n\n" fdoc)) + (goto-char (point-min)) + (help-setup-xref (list #'help-xref-interned symbol) nil)) + +(defun help-xref-mode (buffer) + "Do a `describe-mode' for the specified BUFFER." + (save-excursion + (set-buffer buffer) + (describe-mode))) + +;;; Navigation/hyperlinking with xrefs + +(defun help-follow-mouse (click) + "Follow the cross-reference that you click on." + (interactive "e") + (let* ((start (event-start click)) + (window (car start)) + (pos (car (cdr start)))) + (with-current-buffer (window-buffer window) + (help-follow pos)))) + +(defun help-xref-go-back (buffer) + "Go back to the previous help buffer text using info on `help-xref-stack'." + (interactive) + (let (item position method args) + (with-current-buffer buffer + (when help-xref-stack + (setq help-xref-stack (cdr help-xref-stack)) ; due to help-follow + (setq item (car help-xref-stack) + position (car item) + method (cadr item) + args (cddr item)) + (setq help-xref-stack (cdr help-xref-stack)))) + (apply method args) + (goto-char position))) + +(defun help-go-back () + (interactive) + (help-follow (1- (point-max)))) + +(defun help-follow (&optional pos) + "Follow cross-reference at POS, defaulting to point. + +For the cross-reference format, see `help-make-xrefs'." + (interactive "d") + (let* ((help-data (or (and (not (= pos (point-max))) + (get-text-property pos 'help-xref)) + (and (not (= pos (point-min))) + (get-text-property (1- pos) 'help-xref)))) + (method (car help-data)) + (args (cdr help-data))) + (setq help-xref-stack (cons (cons (point) help-xref-stack-item) + help-xref-stack)) + (setq help-xref-stack-item nil) + (when help-data + ;; There is a reference at point. Follow it. + (apply method args)))) + +;; For tabbing through buffer. +(defun help-next-ref () + "Find the next help cross-reference in the buffer." + (interactive) + (let (pos) + (while (not pos) + (if (get-text-property (point) 'help-xref) ; move off reference + (goto-char (or (next-single-property-change (point) 'help-xref) + (point)))) + (cond ((setq pos (next-single-property-change (point) 'help-xref)) + (if pos (goto-char pos))) + ((bobp) + (message "No cross references in the buffer.") + (setq pos t)) + (t ; be circular + (goto-char (point-min))))))) + +(defun help-previous-ref () + "Find the previous help cross-reference in the buffer." + (interactive) + (let (pos) + (while (not pos) + (if (get-text-property (point) 'help-xref) ; move off reference + (goto-char (or (previous-single-property-change (point) 'help-xref) + (point)))) + (cond ((setq pos (previous-single-property-change (point) 'help-xref)) + (if pos (goto-char pos))) + ((bobp) + (message "No cross references in the buffer.") + (setq pos t)) + (t ; be circular + (goto-char (point-max))))))) ;;; help.el ends here