X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ed13681ff17ef0a1f6e2e69449c19d1dbf2bdff6..4e1ede6c01245a650513a72a30eab1246a072a66:/lisp/help.el diff --git a/lisp/help.el b/lisp/help.el index d4a007a218..7ebd131f6f 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, 1999, 2000 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal @@ -25,13 +25,14 @@ ;;; Commentary: ;; This code implements GNU Emacs' on-line help system, the one invoked by -;;`M-x help-for-help'. +;; `M-x help-for-help'. ;;; Code: ;; Get the macro make-help-screen when this is compiled, ;; or run interpreted, but not when the compiled code is loaded. (eval-when-compile (require 'help-macro)) +(eval-when-compile (require 'view)) (defvar help-map (make-sparse-keymap) "Keymap for characters following the Help key.") @@ -66,6 +67,7 @@ (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) @@ -81,6 +83,8 @@ (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) @@ -91,27 +95,38 @@ (define-key help-map "q" 'help-quit) -(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-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) + +(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...), where POSITION is +`(POINT . BUFFER-NAME)'. +To use the element, do (apply FUNCTION ARGS) then goto the point in +the named buffer.") +(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) + +(defcustom help-mode-hook nil + "Hook run by `help-mode'." + :type 'hook + :group 'help) (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}" @@ -121,19 +136,33 @@ 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))) +(defun help-mode-setup () + (help-mode) + (setq buffer-read-only nil)) + +(add-hook 'temp-buffer-setup-hook 'help-mode-setup) + +(defun help-mode-finish () + (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) +(add-hook 'temp-buffer-show-hook 'help-mode-finish) (defun help-quit () + "Just exit from the Help command's command loop." (interactive) nil) @@ -142,15 +171,15 @@ Commands: 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 select which language." +With arg, you are asked to choose which language." (interactive "P") - (let (lang filename file) - (if arg - (or (setq lang (read-language-name 'tutorial "Language: ")) - (error "No tutorial file of the specified language")) - (setq lang current-language-environment)) - (setq filename (or (get-language-info lang 'tutorial) - "TUTORIAL")) + (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) @@ -177,18 +206,23 @@ With arg, you are asked to select which language." (goto-char (point-min)) (set-buffer-modified-p nil)))) +(defun mode-line-key-binding (key) + "Value is the binding of KEY in the mode line or nil if none." + (let (string-info defn) + (when (and (eq 'mode-line (aref key 0)) + (consp (setq string-info (nth 4 (event-start (aref key 1)))))) + (let* ((string (car string-info)) + (pos (cdr string-info)) + (local-map (and (> pos 0) + (< pos (length string)) + (get-text-property pos 'local-map string)))) + (setq defn (and local-map (lookup-key local-map key))))) + defn)) + (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") - ;; 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))) (standard-output (if insert (current-buffer) t)) @@ -205,18 +239,26 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (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 (or (mode-line-key-binding key) + (key-binding key))) (key-desc (key-description key))) (if (or (null defn) (integerp defn)) (princ (format "%s is undefined" key-desc)) (princ (format (if insert - "%s (%s)" + "`%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. Computes a message and applies the optional argument FUNCTION to it. @@ -224,6 +266,7 @@ If FUNCTION is nil, applies `message' to it, thus printing it." (and (not (get-buffer-window standard-output)) (let ((first-message (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 @@ -231,18 +274,27 @@ If FUNCTION is nil, applies `message' to it, thus printing it." ;; Secondly, the buffer has not been displayed yet, ;; so we don't know whether its frame will be selected. nil) + (display-buffer-reuse-frames + (setq help-return-method (cons (selected-window) + 'quit-window)) + 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 (if first-message - (substitute-command-keys first-message) - "") - (if first-message " " "") + (substitute-command-keys first-message)) + (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)) @@ -258,14 +310,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) @@ -280,7 +324,7 @@ If FUNCTION is nil, applies `message' to it, thus printing it." (progn (set-buffer (window-buffer window)) (goto-char position))) - (let ((defn (key-binding key))) + (let ((defn (or (mode-line-key-binding key) (key-binding key)))) (if (or (null defn) (integerp defn)) (message "%s is undefined" (key-description key)) (with-output-to-temp-buffer "*Help*" @@ -289,30 +333,36 @@ If FUNCTION is nil, applies `message' to it, thus printing it." (princ " at that spot")) (princ " runs the command ") (prin1 defn) - (princ "\n") - (let ((doc (documentation defn))) - (if doc - (progn (terpri) - (princ doc)) - (princ "not documented"))) + (princ "\n which is ") + (describe-function-1 defn nil (interactive-p)) (print-help-return-message))))))) (defun describe-mode () "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." (interactive) (with-output-to-temp-buffer "*Help*" - (let ((minor-modes minor-mode-alist) - (first t)) + (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)) + (help-setup-xref (list #'help-xref-mode (current-buffer)) (interactive-p)) + (let ((minor-modes minor-mode-alist)) (while minor-modes (let* ((minor-mode (car (car minor-modes))) (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 (symbol-value minor-mode) + (if (and (boundp minor-mode) + (symbol-value minor-mode) (fboundp minor-mode)) (let ((pretty-minor-mode minor-mode)) (if (string-match "-mode$" (symbol-name minor-mode)) @@ -320,23 +370,18 @@ describes the minor mode." (capitalize (substring (symbol-name minor-mode) 0 (match-beginning 0))))) - (while (and indicator (symbolp indicator)) + (while (and indicator (symbolp indicator) + (boundp indicator) + (not (eq indicator (symbol-value indicator)))) (setq indicator (symbol-value 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 "\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)) - (princ "\n\f\n")))) + (princ (documentation minor-mode))))) (setq minor-modes (cdr minor-modes)))) - (princ mode-name) - (princ " mode:\n") - (princ (documentation major-mode)) (print-help-return-message))) ;; So keyboard macro definitions are documented correctly @@ -389,15 +434,32 @@ 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)) + (file (cond ((eq arg 0) "NEWS") + ((eq arg 1) "ONEWS") + (t + (nth (- arg 2) + (nreverse (directory-files data-directory + nil "^NEWS\\.[0-9]+$" + nil))))))) + (if file + (find-file-read-only (expand-file-name file data-directory)) + (error "No such old news")))) (defun view-emacs-FAQ () "Display the Emacs Frequently Asked Questions (FAQ) file." (interactive) - (find-file-read-only (expand-file-name "FAQ" data-directory))) +;;; (find-file-read-only (expand-file-name "FAQ" data-directory)) + (info "(efaq)")) + +(defun view-emacs-problems () + "Display info on known problems with Emacs and possible workarounds." + (interactive) + (view-file (expand-file-name "PROBLEMS" data-directory))) (defun view-lossage () "Display last 100 input keystrokes." @@ -416,13 +478,15 @@ of the key sequence that ran this command." (goto-char (point-min)) (while (progn (move-to-column 50) (not (eobp))) (search-forward " " nil t) - (insert "\n"))) + (insert "\n")) + (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 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: + "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 @@ -440,17 +504,19 @@ C-f Info-goto-emacs-command-node. Type a function name; 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). +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. -l view-lossage. Shows last 100 characters you typed. +l view-lossage. Show last 100 characters you typed. 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. +n view-emacs-news. Display news of recent Emacs changes. p finder-by-keyword. Find packages matching a given topic keyword. s describe-syntax. Display contents of syntax table, plus explanations t help-with-tutorial. Select the Emacs learn-by-doing tutorial. @@ -468,41 +534,57 @@ 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 () - (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 - (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))) - (set-syntax-table stab)))) - -(defun describe-function-find-file (function) + "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))))) + +(defvar symbol-file-load-history-loaded nil + "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'. +That file records the part of `load-history' for preloaded files, +which is cleared out before dumping to make Emacs smaller.") + +(defun symbol-file (function) + "Return the input source from which FUNCTION was loaded. +The value is normally a string that was passed to `load': +either an absolute file name, or a library name +\(with no directory name and no `.el' or `.elc' at the end). +It can also be nil, if the definition is not associated with any file." + (unless symbol-file-load-history-loaded + (load (expand-file-name + ;; fns-XX.YY.ZZ.el does not work on DOS filesystem. + (if (eq system-type 'ms-dos) + "fns.el" + (format "fns-%s.el" emacs-version)) + exec-directory) + ;; The file name fns-%s.el already has a .el extension. + nil nil t) + (setq symbol-file-load-history-loaded t)) (let ((files load-history) file functions) (while files @@ -529,64 +611,7 @@ C-w Display information on absence of warranty for GNU Emacs." ;; Use " is " instead of a colon so that ;; it is easier to get out the function name using forward-sexp. (princ " is ") - (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 - (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* ((inner-function (if (and (listp def) 'macro) - (cdr def) - def)) - (arglist (cond ((byte-code-function-p inner-function) - (car (append inner-function nil))) - ((eq (car-safe inner-function) 'lambda) - (nth 1 inner-function)) - (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)))) - (let ((doc (documentation function))) - (if doc - (progn (terpri) - (princ doc)) - (princ "not documented")))) + (describe-function-1 function nil (interactive-p)) (print-help-return-message) (save-excursion (set-buffer standard-output) @@ -594,85 +619,329 @@ C-w Display information on absence of warranty for GNU Emacs." (buffer-string))) (message "You didn't specify a function"))) -;; We return 0 if we can't find a variable to return. +(defun describe-function-1 (function parens interactive-p) + (let* ((def (if (symbolp function) + (symbol-function 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) + (if (eq 'unevalled (cdr (subr-arity def))) + (concat beg "special form") + (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 "an 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 %s" + (if (commandp def) "an interactive" "an") + (if (eq (nth 4 def) 'keymap) "keymap" + (if (nth 4 def) "Lisp macro" "Lisp function")) + )) + ;; perhaps use keymapp here instead + ((eq (car-safe def) 'keymap) + (let ((is-full nil) + (elts (cdr-safe def))) + (while elts + (if (char-table-p (car-safe elts)) + (setq is-full t + elts nil)) + (setq elts (cdr-safe elts))) + (if is-full + "a full keymap" + "a sparse keymap"))) + (t ""))) + (when (and parens (not (equal string ""))) + (setq need-close t) + (princ "(")) + (princ string) + (with-current-buffer "*Help*" + (save-excursion + (save-match-data + (if (re-search-backward "alias for `\\([^`']+\\)'" nil t) + (help-xref-button 1 #'describe-function def + "mouse-2, RET: describe this function"))))) + (or file-name + (setq file-name (symbol-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 + "mouse-2, RET: find function's definition"))))) + (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)) + ((and (eq (car-safe def) 'autoload) + (not (eq (nth 4 def) 'keymap))) + (concat "[Arg list not available until " + "function definition is loaded.]")) + (t t)))) + (cond ((listp arglist) + (princ (cons (if (symbolp function) function "anonymous") + (mapcar (lambda (arg) + (if (memq arg '(&optional &rest)) + arg + (intern (upcase (symbol-name arg))))) + arglist))) + (terpri)) + ((stringp arglist) + (princ arglist) + (terpri)))) + (let ((doc (documentation function))) + (if doc + (progn (terpri) + (princ doc) + (if (subrp (symbol-function function)) + (with-current-buffer standard-output + (beginning-of-line) + ;; Builtins get the calling sequence at the end of + ;; the doc string. Move it to the same place as + ;; for other functions. + + ;; In cases where `function' has been fset to a + ;; subr we can't search for function's name in + ;; the doc string. Kluge round that using the + ;; printed representation. The arg list then + ;; shows the wrong function name, but that + ;; might be a useful hint. + (let* ((rep (prin1-to-string def)) + (name (progn + (string-match " \\([^ ]+\\)>$" rep) + (match-string 1 rep)))) + (if (looking-at (format "(%s[ )]" name)) + (let ((start (point-marker))) + (goto-char (point-min)) + (forward-paragraph) + (insert-buffer-substring (current-buffer) start) + (insert ?\n) + (delete-region (1- start) (point-max))) + (goto-char (point-min)) + (forward-paragraph) + (insert + "[Missing arglist. Please make a bug report.]\n"))) + (goto-char (point-max)))) + (help-setup-xref (list #'describe-function function) + interactive-p)) + (princ "not documented"))))) + (defun variable-at-point () + "Return the bound variable symbol found around point. +Return 0 if there is no such symbol." (condition-case () - (let ((stab (syntax-table))) - (unwind-protect - (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)) ?_) - (forward-sexp -1)) - (skip-chars-forward "'") - (let ((obj (read (current-buffer)))) - (or (and (symbolp obj) (boundp obj) obj) - 0))) - (set-syntax-table stab))) + (with-syntax-table emacs-lisp-mode-syntax-table + (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)))) + (or (and (symbolp obj) (boundp obj) obj) + 0)))) (error 0))) -(defun describe-variable (variable) +(defun help-xref-on-pp (from to) + "Add xrefs for symbols in `pp's output between FROM and TO." + (let ((ost (syntax-table))) + (unwind-protect + (save-excursion + (save-restriction + (set-syntax-table emacs-lisp-mode-syntax-table) + (narrow-to-region from to) + (goto-char (point-min)) + (while (not (eobp)) + (cond + ((looking-at "\"") (forward-sexp 1)) + ((looking-at "#<") (search-forward ">" nil 'move)) + ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)") + (let* ((sym (intern-soft (match-string 1))) + (fn (cond ((fboundp sym) #'describe-function) + ((or (memq sym '(t nil)) + (keywordp sym)) + nil) + ((and sym (boundp sym)) + #'describe-variable)))) + (when fn (help-xref-button 1 fn sym))) + (goto-char (match-end 1))) + (t (forward-char 1)))))) + (set-syntax-table ost)))) + +(defun describe-variable (variable &optional buffer) "Display the full documentation of VARIABLE (a symbol). -Returns the documentation as a string, also." - (interactive +Returns the documentation as a string, also. +If VARIABLE has a buffer-local value in BUFFER (default to the current buffer), +it is displayed along with the global value." + (interactive (let ((v (variable-at-point)) (enable-recursive-minibuffers t) val) (setq val (completing-read (if (symbolp v) - (format "Describe variable (default %s): " v) + (format + "Describe variable (default %s): " v) "Describe variable: ") - obarray 'boundp t nil nil (symbol-name v))) + obarray 'boundp t nil nil + (if (symbolp v) (symbol-name v)))) (list (if (equal val "") v (intern val))))) - (if (symbolp variable) - (let (valvoid) + (unless (bufferp buffer) (setq buffer (current-buffer))) + (if (not (symbolp variable)) + (message "You did not specify a variable") + (let (valvoid) + (with-current-buffer buffer (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)) + (let ((val (symbol-value variable))) + (with-current-buffer standard-output + (princ "'s value is ") + (terpri) + (let ((from (point))) + (pp val) + (help-xref-on-pp from (point)))))) + (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))) + (let ((val (default-value variable))) + (with-current-buffer standard-output + (princ "global value is ") + (terpri) + ;; Fixme: pp can take an age if you happen to + ;; ask for a very large expression. We should + ;; probably print it raw once and check it's a + ;; sensible size before prettyprinting. -- fx + (let ((from (point))) + (pp val) + (help-xref-on-pp from (point)))))) (terpri))) (terpri) - (save-current-buffer - (set-buffer standard-output) + (with-current-buffer standard-output (if (> (count-lines (point-min) (point-max)) 10) (progn + ;; Note that setting the syntax table like below + ;; makes forward-sexp move over a `'s' at the end + ;; of a symbol. + (set-syntax-table emacs-lisp-mode-syntax-table) (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") + (insert " 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 (current-buffer)) + (interactive-p)) + + ;; Make a link to customize if this variable can be customized. + ;; Note, it is not reliable to test only for a custom-type property + ;; because those are only present after the var's definition + ;; has been loaded. + (if (or (get variable 'custom-type) ; after defcustom + (get variable 'custom-loads) ; from loaddefs.el + (get variable 'standard-value)) ; from cus-start.el + (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) + (if help-xref-stack + (pop help-xref-stack)) + (customize-variable v)) + variable + "mouse-2, RET: customize variable"))))) + ;; Make a hyperlink to the library if appropriate. (Don't + ;; change the format of the buffer's initial line in case + ;; anything expects the current format.) + (let ((file-name (symbol-file variable))) + (when file-name + (princ "\n\nDefined in `") + (princ file-name) + (princ "'.") + (with-current-buffer "*Help*" + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button + 1 (lambda (arg) + (let ((location + (find-variable-noselect arg))) + (pop-to-buffer (car location)) + (goto-char (cdr location)))) + variable "mouse-2, RET: find variable's 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"))) + (buffer-string))))))) + +(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. + "Print message listing key sequences that invoke the command 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 @@ -682,7 +951,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (setq val (completing-read (if fn (format "Where is command (default %s): " fn) "Where is command: ") - obarray 'fboundp t)) + obarray 'commandp t)) (list (if (equal val "") fn (intern val)) current-prefix-arg))) @@ -706,15 +975,19 @@ Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el' to the specified name LIBRARY. If the optional third arg PATH is specified, that list of directories -is used instead of `load-path'." +is used instead of `load-path'. + +When called from a program, the file name is normaly returned as a +string. When run interactively, the argument INTERACTIVE-CALL is t, +and the file name is displayed in the echo area." (interactive (list (read-string "Locate library: ") nil nil t)) (let (result) (catch 'answer - (mapcar + (mapc (lambda (dir) - (mapcar + (mapc (lambda (suf) (let ((try (expand-file-name (concat library suf) dir))) (and (file-readable-p try) @@ -747,4 +1020,552 @@ is used instead of `load-path'." (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'." + :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 (purecopy "[back]") + "Label to use by `help-make-xrefs' for the go-back reference.") + +(defconst help-xref-symbol-regexp + (purecopy (concat "\\(\\<\\(\\(variable\\|option\\)\\|" + "\\(function\\|command\\)\\|" + "\\(face\\)\\|" + "\\(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.") + +(defconst help-xref-mule-regexp nil + "Regexp matching doc string references to MULE-related keywords. + +It is usually nil, and is temporarily bound to an appropriate regexp +when help commands related to multilingual environment (e.g., +`describe-coding-system') are invoked.") + + +(defconst help-xref-info-regexp + (purecopy "\\<[Ii]nfo[ \t\n]+node[ \t\n]+`\\([^']+\\)'") + "Regexp matching doc string references to an Info node.") + +(defun help-setup-xref (item interactive-p) + "Invoked from commands using the \"*Help*\" buffer to install some xref info. + +ITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help +buffer after following a reference. INTERACTIVE-P is non-nil if the +calling command was invoked interactively. In this case the stack of +items for help buffer \"back\" buttons is cleared." + (if interactive-p + (setq help-xref-stack nil)) + (setq help-xref-stack-item item)) + +(defvar help-xref-following nil + "Non-nil when following a help cross-reference.") + +(defun help-make-xrefs (&optional buffer) + "Parse and hyperlink documentation cross-references in the given BUFFER. + +Find cross-reference information in a buffer and, if +`help-highlight-p' is non-nil, highlight it with face defined by +`help-highlight-face'; activate such cross references for selection +with `help-follow'. Cross-references have the canonical form `...' +and the type of reference may be disambiguated by the preceding +word(s) used in `help-xref-symbol-regexp'. + +If the variable `help-xref-mule-regexp' is non-nil, find also +cross-reference information related to multilingual environment +\(e.g., coding-systems). This variable is also used to disambiguate +the type of reference as the same way as `help-xref-symbol-regexp'. + +A special reference `back' is made to return back through a stack of +help buffers. Variable `help-back-label' specifies the text for +that." + (interactive "b") + (save-excursion + (set-buffer (or buffer (current-buffer))) + (goto-char (point-min)) + ;; Skip the header-type info, though it might be useful to parse + ;; it at some stage (e.g. "function in `library'"). + (forward-paragraph) + (let ((old-modified (buffer-modified-p))) + (let ((stab (syntax-table)) + (case-fold-search t) + (inhibit-read-only t)) + (set-syntax-table emacs-lisp-mode-syntax-table) + ;; The following should probably be abstracted out. + (unwind-protect + (progn + ;; Info references + (save-excursion + (while (re-search-forward help-xref-info-regexp nil t) + (let ((data (match-string 1))) + (save-match-data + (unless (string-match "^([^)]+)" data) + (setq data (concat "(emacs)" data)))) + (help-xref-button 1 #'info data + "mouse-2, RET: read this Info node")))) + ;; Mule related keywords. Do this before trying + ;; `help-xref-symbol-regexp' because some of Mule + ;; keywords have variable or function definitions. + (if help-xref-mule-regexp + (save-excursion + (while (re-search-forward help-xref-mule-regexp nil t) + (let* ((data (match-string 7)) + (sym (intern-soft data))) + (cond + ((match-string 3) ; coding system + (and sym (coding-system-p sym) + (help-xref-button + 7 #'describe-coding-system sym + "mouse-2, RET: describe this coding system"))) + ((match-string 4) ; input method + (and (assoc data input-method-alist) + (help-xref-button + 7 #'describe-input-method data + "mouse-2, RET: describe this input method"))) + ((or (match-string 5) (match-string 6)) ; charset + (and sym (charsetp sym) + (help-xref-button + 7 #'describe-character-set sym + "mouse-2, RET: describe this character set"))) + ((assoc data input-method-alist) + (help-xref-button + 7 #'describe-input-method data + "mouse-2, RET: describe this input method")) + ((and sym (coding-system-p sym)) + (help-xref-button + 7 #'describe-coding-system sym + "mouse-2, RET: describe this coding system")) + ((and sym (charsetp sym)) + (help-xref-button + 7 #'describe-character-set sym + "mouse-2, RET: describe this character set"))))))) + ;; Quoted symbols + (save-excursion + (while (re-search-forward help-xref-symbol-regexp nil t) + (let* ((data (match-string 7)) + (sym (intern-soft data))) + (if sym + (cond + ((match-string 3) ; `variable' &c + (and (boundp sym) ; `variable' doesn't ensure + ; it's actually bound + (help-xref-button + 7 #'describe-variable sym + "mouse-2, RET: describe this variable"))) + ((match-string 4) ; `function' &c + (and (fboundp sym) ; similarly + (help-xref-button + 7 #'describe-function sym + "mouse-2, RET: describe this function"))) + ((match-string 5) ; `face' + (and (facep sym) + (help-xref-button 7 #'describe-face sym + "mouse-2, RET: describe this face"))) + ((match-string 6)) ; nothing for symbol + ((and (boundp sym) (fboundp sym)) + ;; We can't intuit whether to use the + ;; variable or function doc -- supply both. + (help-xref-button + 7 #'help-xref-interned sym + "mouse-2, RET: describe this symbol")) + ((boundp sym) + (help-xref-button + 7 #'describe-variable sym + "mouse-2, RET: describe this variable")) + ((fboundp sym) + (help-xref-button + 7 #'describe-function sym + "mouse-2, RET: describe this function")) + ((facep sym) + (help-xref-button + 7 #'describe-face sym))))))) + ;; An obvious case of a key substitution: + (save-excursion + (while (re-search-forward + ;; Assume command name is only word characters + ;; and dashes to get things like `use M-x foo.'. + "\\= (current-column) col) + (looking-at "\\(\\sw\\|-\\)+$")) + (let ((sym (intern-soft (match-string 0)))) + (if (fboundp sym) + (help-xref-button + 0 #'describe-function sym + "mouse-2, RET: describe this function")))) + (zerop (forward-line))))))))) + (set-syntax-table stab)) + ;; Make a back-reference in this buffer if appropriate. + (when (and help-xref-following 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 &optional help-echo) + "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'. +If optional arg HELP-ECHO is supplied, it is used as a help string." + ;; Don't mung properties we've added specially in some instances. + (unless (get-text-property (match-beginning match-number) 'help-xref) + (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-echo + (put-text-property (match-beginning match-number) + (match-end match-number) + 'help-echo help-echo)) + (if help-highlight-p + (put-text-property (match-beginning match-number) + (match-end match-number) + 'face help-highlight-face)))) + +(defun help-insert-xref-button (string function data &optional help-echo) + "Insert STRING and make a hyperlink from cross-reference text on it. + +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'. +If optional arg HELP-ECHO is supplied, it is used as a help string." + (let ((pos (point))) + (insert string) + (goto-char pos) + (search-forward string) + (help-xref-button 0 function data help-echo))) + + + +;; 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 (when (fboundp symbol) (describe-function symbol))) + (facedoc (when (facep symbol) (describe-face symbol)))) + (when (or (boundp symbol) (not fdoc)) + (describe-variable symbol) + ;; We now have a help buffer on the variable. Insert the function + ;; text before it. + (when (or fdoc facedoc) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (when fdoc + (insert fdoc "\n\n")) + (when facedoc + (insert (make-string 30 ?-) "\n\n" (symbol-name symbol) + " is also a " "face." "\n\n" facedoc "\n\n")) + (insert (make-string 30 ?-) "\n\n" (symbol-name symbol) + " is also a " "variable." "\n\n")) + (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) + "From BUFFER, go back to previous help buffer text using `help-xref-stack'." + (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 (pop help-xref-stack) + position (car item) + method (cadr item) + args (cddr item)))) + (apply method args) + ;; We assume that the buffer we just recreated has the saved name, + ;; which might not always be true. + (when (get-buffer (cdr position)) + (with-current-buffer (cdr position) + (goto-char (car position)))))) + +(defun help-go-back () + "Invoke the [back] button (if any) in the Help mode buffer." + (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") + (unless pos + (setq pos (point))) + (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)) + ;; check if the symbol under point is a function or variable + (let ((sym + (intern + (save-excursion + (goto-char pos) (skip-syntax-backward "w_") + (buffer-substring (point) + (progn (skip-syntax-forward "w_") + (point))))))) + (when (or (boundp sym) (fboundp sym)) + (list #'help-xref-interned sym))))) + (method (car help-data)) + (args (cdr help-data))) + (when help-data + (setq help-xref-stack (cons (cons (cons pos (buffer-name)) + help-xref-stack-item) + help-xref-stack)) + (setq help-xref-stack-item nil) + ;; There is a reference at point. Follow it. + (let ((help-xref-following t)) + (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))))))) + + +;;; 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. +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 +to the buffer to be displayed as argument and should return an integer +positive number." + :type '(choice integer function) + :group 'help + :version "20.4") + +(define-minor-mode temp-buffer-resize-mode + "Toggle the mode which makes windows smaller for temporary buffers. +With prefix argument ARG, turn the resizing of windows displaying temporary +buffers on if ARG is positive or off otherwise. +This makes the window the right height for its contents, but never +more than `temp-buffer-max-height' nor less than `window-min-height'. +This applies to `help', `apropos' and `completion' buffers, and some others." + nil nil nil :global t :group 'help + (if temp-buffer-resize-mode + ;; `help-mode-maybe' may add a `back' button and thus increase the + ;; text size, so `resize-temp-buffer-window' must be run *after* it. + (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) + (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))) + +(defun resize-temp-buffer-window () + "Resize the current 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))) + (let* ((max-height (if (functionp temp-buffer-max-height) + (funcall temp-buffer-max-height (current-buffer)) + temp-buffer-max-height)) + (win-height (1- (window-height))) + (min-height (1- window-min-height)) + (text-height (count-screen-lines)) + (new-height (max (min text-height max-height) min-height))) + (enlarge-window (- new-height win-height))))) + +;; `help-manyarg-func-alist' is defined primitively (in doc.c). +;; New primitives with `MANY' or `UNEVALLED' arglists should be added +;; to this alist. +;; The parens and function name are redundant, but it's messy to add +;; them in `documentation'. + +;; This will find any missing items: +;; (let (l) +;; (mapatoms (lambda (x) +;; (if (and (fboundp x) +;; (subrp (symbol-function x)) +;; (not (numberp (cdr (subr-arity (symbol-function x))))) +;; (not (assq x help-manyarg-func-alist))) +;; (push x l)))) +;; l) +(defconst help-manyarg-func-alist + (purecopy + '((list . "(list &rest OBJECTS)") + (vector . "(vector &rest OBJECTS)") + (make-byte-code . "(make-byte-code &rest ELEMENTS)") + (call-process + . "(call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)") + (call-process-region + . "(call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS)") + (string . "(string &rest CHARACTERS)") + (+ . "(+ &rest NUMBERS-OR-MARKERS)") + (- . "(- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS)") + (* . "(* &rest NUMBERS-OR-MARKERS)") + (/ . "(/ DIVIDEND DIVISOR &rest DIVISORS)") + (max . "(max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)") + (min . "(min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)") + (logand . "(logand &rest INTS-OR-MARKERS)") + (logior . "(logior &rest INTS-OR-MARKERS)") + (logxor . "(logxor &rest INTS-OR-MARKERS)") + (encode-time + . "(encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE)") + (insert . "(insert &rest ARGS)") + (insert-and-inherit . "(insert-and-inherit &rest ARGS)") + (insert-before-markers . "(insert-before-markers &rest ARGS)") + (message . "(message STRING &rest ARGUMENTS)") + (message-box . "(message-box STRING &rest ARGUMENTS)") + (message-or-box . "(message-or-box STRING &rest ARGUMENTS)") + (propertize . "(propertize STRING &rest PROPERTIES)") + (format . "(format STRING &rest OBJECTS)") + (apply . "(apply FUNCTION &rest ARGUMENTS)") + (run-hooks . "(run-hooks &rest HOOKS)") + (run-hook-with-args . "(run-hook-with-args HOOK &rest ARGS)") + (run-hook-with-args-until-failure + . "(run-hook-with-args-until-failure HOOK &rest ARGS)") + (run-hook-with-args-until-success + . "(run-hook-with-args-until-success HOOK &rest ARGS)") + (funcall . "(funcall FUNCTION &rest ARGUMENTS)") + (append . "(append &rest SEQUENCES)") + (concat . "(concat &rest SEQUENCES)") + (vconcat . "(vconcat vconcat)") + (nconc . "(nconc &rest LISTS)") + (widget-apply . "(widget-apply WIDGET PROPERTY &rest ARGS)") + (make-hash-table . "(make-hash-table &rest KEYWORD-ARGS)") + (insert-string . "(insert-string &rest ARGS)") + (start-process . "(start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS)") + (setq-default . "(setq-default SYMBOL VALUE [SYMBOL VALUE...])") + (save-excursion . "(save-excursion &rest BODY)") + (save-current-buffer . "(save-current-buffer &rest BODY)") + (save-restriction . "(save-restriction &rest BODY)") + (or . "(or CONDITIONS ...)") + (and . "(and CONDITIONS ...)") + (if . "(if COND THEN ELSE...)") + (cond . "(cond CLAUSES...)") + (progn . "(progn BODY ...)") + (prog1 . "(prog1 FIRST BODY...)") + (prog2 . "(prog2 X Y BODY...)") + (setq . "(setq SYM VAL SYM VAL ...)") + (quote . "(quote ARG)") + (function . "(function ARG)") + (defun . "(defun NAME ARGLIST [DOCSTRING] BODY...)") + (defmacro . "(defmacro NAME ARGLIST [DOCSTRING] BODY...)") + (defvar . "(defvar SYMBOL [INITVALUE DOCSTRING])") + (defconst . "(defconst SYMBOL INITVALUE [DOCSTRING])") + (let* . "(let* VARLIST BODY...)") + (let . "(let VARLIST BODY...)") + (while . "(while TEST BODY...)") + (catch . "(catch TAG BODY...)") + (unwind-protect . "(unwind-protect BODYFORM UNWINDFORMS...)") + (condition-case . "(condition-case VAR BODYFORM HANDLERS...)") + (track-mouse . "(track-mouse BODY ...)") + (ml-if . "(ml-if COND THEN ELSE...)") + (ml-provide-prefix-argument . "(ml-provide-prefix-argument ARG1 ARG2)") + (ml-prefix-argument-loop . "(ml-prefix-argument-loop ...)") + (with-output-to-temp-buffer + . "(with-output-to-temp-buffer BUFFNAME BODY ...)") + (save-window-excursion . "(save-window-excursion BODY ...)") + (find-operation-coding-system + . "(find-operation-coding-system OPERATION ARGUMENTS ...)") + (insert-before-markers-and-inherit + . "(insert-before-markers-and-inherit &rest ARGS)")))) + ;;; help.el ends here