X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3b622b44f577cd321d2ea3fae7096d4fba5a2e52..ae48944514a529eb78caff789171393fa6c82287:/lisp/help-fns.el diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 7fe85001c3..ae7a60cf55 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1,7 +1,7 @@ ;;; help-fns.el --- Complex help functions -;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, +;; 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal @@ -20,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -42,18 +42,13 @@ 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." +With ARG, you are asked to choose which language." (interactive "P") (let ((lang (if arg - (progn - ;; Display a completion list right away - ;; to guide the user. - (with-output-to-temp-buffer "*Completions*" - (display-completion-list - (all-completions "" language-info-alist - (lambda (elm) - (and (listp elm) (assq 'tutorial elm)))))) - (read-language-name 'tutorial "Language: " "English")) + (let ((minibuffer-setup-hook minibuffer-setup-hook)) + (add-hook 'minibuffer-setup-hook + 'minibuffer-completion-help) + (read-language-name 'tutorial "Language: " "English")) (if (get-language-info current-language-environment 'tutorial) current-language-environment "English"))) @@ -68,6 +63,7 @@ With arg, you are asked to choose which language." (setq default-directory (expand-file-name "~/")) (setq buffer-auto-save-file-name nil) (insert-file-contents (expand-file-name filename data-directory)) + (hack-local-variables) (goto-char (point-min)) (search-forward "\n<<") (beginning-of-line) @@ -96,18 +92,19 @@ With arg, you are asked to choose which language." (newline n)) ;; Some people get confused by the large gap. (newline (/ n 2)) - + ;; Skip the [...] line (don't delete it). (forward-line 1) (newline (- n (/ n 2))))) (goto-char (point-min)) + (setq buffer-undo-list nil) (set-buffer-modified-p nil)))) ;;;###autoload (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. +This command searches the directories in `load-path' like `\\[load-library]' +to find the file that `\\[load-library] RET LIBRARY RET' would load. Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes' to the specified name LIBRARY. @@ -117,22 +114,19 @@ 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: ") + (interactive (list (completing-read "Locate library: " + 'locate-file-completion + (cons load-path load-suffixes)) nil nil t)) - (catch 'answer - (dolist (dir (or path load-path)) - (dolist (suf (append (unless nosuffix load-suffixes) '(""))) - (let ((try (expand-file-name (concat library suf) dir))) - (and (file-readable-p try) - (null (file-directory-p try)) - (progn - (if interactive-call - (message "Library is file %s" (abbreviate-file-name try))) - (throw 'answer try)))))) + (let ((file (locate-file library + (or path load-path) + (append (unless nosuffix load-suffixes) '(""))))) (if interactive-call - (message "No library %s in search path" library)) - nil)) + (if file + (message "Library is file %s" (abbreviate-file-name file)) + (message "No library %s in search path" library))) + file)) ;; Functions @@ -165,22 +159,43 @@ and the file name is displayed in the echo area." ;; Return the text we displayed. (buffer-string)))))) -(defun help-split-fundoc (doc &optional def) - "Split a function docstring DOC into the actual doc and the usage info. -Return (USAGE . DOC) or nil if there's no usage info." - ;; Builtins get the calling sequence at the end of the doc string. +(defun help-split-fundoc (docstring def) + "Split a function DOCSTRING into the actual doc and the usage info. +Return (USAGE . DOC) or nil if there's no usage info. +DEF is the function whose usage we're looking for in DOCSTRING." + ;; Functions can get the calling sequence at the end of the doc string. ;; 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 (if (string-match " \\([^ ]+\\)>$" rep) - (match-string 1 rep) "fun"))) - (if (string-match (format "^(%s[ )].*\\'" (regexp-quote name)) doc) - (cons (match-string 0 doc) - (substring doc 0 (match-beginning 0)))))) + ;; function's name in the doc string so we use `fn' as the anonymous + ;; function name instead. + (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring)) + (cons (format "(%s%s" + ;; Replace `fn' with the actual function name. + (if (consp def) "anonymous" def) + (match-string 1 docstring)) + (substring docstring 0 (match-beginning 0))))) + +(defun help-add-fundoc-usage (docstring arglist) + "Add the usage info to DOCSTRING. +If DOCSTRING already has a usage info, then just return it unchanged. +The usage info is built from ARGLIST. DOCSTRING can be nil. +ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." + (unless (stringp docstring) (setq docstring "Not documented")) + (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring) (eq arglist t)) + docstring + (concat docstring + (if (string-match "\n?\n\\'" docstring) + (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "") + "\n\n") + (if (and (stringp arglist) + (string-match "\\`([^ ]+\\(.*\\))\\'" arglist)) + (concat "(fn" (match-string 1 arglist) ")") + (format "%S" (help-make-usage 'fn arglist)))))) (defun help-function-arglist (def) + ;; Handle symbols aliased to other symbols. + (if (and (symbolp def) (fboundp def)) (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))) (cond ((byte-code-function-p def) (aref def 0)) ((eq (car-safe def) 'lambda) (nth 1 def)) @@ -191,12 +206,113 @@ Return (USAGE . DOC) or nil if there's no usage info." (defun help-make-usage (function arglist) (cons (if (symbolp function) function 'anonymous) (mapcar (lambda (arg) - (if (not (symbolp arg)) arg + (if (not (symbolp arg)) + (if (and (consp arg) (symbolp (car arg))) + ;; CL style default values for optional args. + (cons (intern (upcase (symbol-name (car arg)))) + (cdr arg)) + arg) (let ((name (symbol-name arg))) (if (string-match "\\`&" name) arg (intern (upcase name)))))) arglist))) +;; Could be this, if we make symbol-file do the work below. +;; (defun help-C-file-name (subr-or-var kind) +;; "Return the name of the C file where SUBR-OR-VAR is defined. +;; KIND should be `var' for a variable or `subr' for a subroutine." +;; (symbol-file (if (symbolp subr-or-var) subr-or-var +;; (subr-name subr-or-var)) +;; (if (eq kind 'var) 'defvar 'defun))) +;;;###autoload +(defun help-C-file-name (subr-or-var kind) + "Return the name of the C file where SUBR-OR-VAR is defined. +KIND should be `var' for a variable or `subr' for a subroutine." + (let ((docbuf (get-buffer-create " *DOC*")) + (name (if (eq 'var kind) + (concat "V" (symbol-name subr-or-var)) + (concat "F" (subr-name subr-or-var))))) + (with-current-buffer docbuf + (goto-char (point-min)) + (if (eobp) + (insert-file-contents-literally + (expand-file-name internal-doc-file-name doc-directory))) + (let ((file (catch 'loop + (while t + (let ((pnt (search-forward (concat "" name "\n")))) + (re-search-backward "S\\(.*\\)") + (let ((file (match-string 1))) + (if (member file build-files) + (throw 'loop file) + (goto-char pnt)))))))) + (if (string-match "\\.\\(o\\|obj\\)\\'" file) + (setq file (replace-match ".c" t t file))) + (if (string-match "\\.c\\'" file) + (concat "src/" file) + file))))) + +;;;###autoload +(defface help-argument-name '((((supports :slant italic)) :inherit italic)) + "Face to highlight argument names in *Help* buffers." + :group 'help) + +(defun help-default-arg-highlight (arg) + "Default function to highlight arguments in *Help* buffers. +It returns ARG in face `help-argument-name'; ARG is also +downcased if it displays differently than the default +face (according to `face-differs-from-default-p')." + (propertize (if (face-differs-from-default-p 'help-argument-name) + (downcase arg) + arg) + 'face 'help-argument-name)) + +(defun help-do-arg-highlight (doc args) + (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table) + (modify-syntax-entry ?\- "w") + (while args + (let ((arg (prog1 (car args) (setq args (cdr args))))) + (setq doc (replace-regexp-in-string + ;; This is heuristic, but covers all common cases + ;; except ARG1-ARG2 + (concat "\\<" ; beginning of word + "\\(?:[a-z-]*-\\)?" ; for xxx-ARG + "\\(" + (regexp-quote arg) + "\\)" + "\\(?:es\\|s\\|th\\)?" ; for ARGth, ARGs + "\\(?:-[a-z-]+\\)?" ; for ARG-xxx + "\\>") ; end of word + (help-default-arg-highlight arg) + doc t t 1)))) + doc)) + +(defun help-highlight-arguments (usage doc &rest args) + (when usage + (with-temp-buffer + (insert usage) + (goto-char (point-min)) + (let ((case-fold-search nil) + (next (not (or args (looking-at "\\[")))) + (opt nil)) + ;; Make a list of all arguments + (skip-chars-forward "^ ") + (while next + (or opt (not (looking-at " &")) (setq opt t)) + (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &)\.]+\\)" nil t)) + (setq next nil) + (setq args (cons (match-string 2) args)) + (when (and opt (string= (match-string 1) "(")) + ;; A pesky CL-style optional argument with default value, + ;; so let's skip over it + (search-backward "(") + (goto-char (scan-sexps (point) 1))))) + ;; Highlight aguments in the USAGE string + (setq usage (help-do-arg-highlight (buffer-string) args)) + ;; Highlight arguments in the DOC string + (setq doc (and doc (help-do-arg-highlight doc args)))))) + ;; Return value is like the one from help-split-fundoc, but highlighted + (cons usage doc)) + ;;;###autoload (defun describe-function-1 (function) (let* ((def (if (symbolp function) @@ -229,8 +345,7 @@ Return (USAGE . DOC) or nil if there's no usage info." (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) + ((keymapp def) (let ((is-full nil) (elts (cdr-safe def))) (while elts @@ -249,7 +364,7 @@ Return (USAGE . DOC) or nil if there's no usage info." (if (re-search-backward "alias for `\\([^`']+\\)'" nil t) (help-xref-button 1 'help-function def))))) (or file-name - (setq file-name (symbol-file function))) + (setq file-name (symbol-file function 'defun))) (when (equal file-name "loaddefs.el") ;; Find the real def site of the preloaded function. ;; This is necessary only for defaliases. @@ -263,81 +378,124 @@ Return (USAGE . DOC) or nil if there's no usage info." (when (re-search-backward "^;;; Generated autoloads from \\(.*\\)" nil t) (setq file-name (match-string 1))))))) - (cond - (file-name + (when (and (null file-name) (subrp def)) + ;; Find the C source file name. + (setq file-name (if (get-buffer " *DOC*") + (help-C-file-name def 'subr) + 'C-source))) + (when file-name (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 (if (eq file-name 'C-source) "C source code" file-name)) (princ "'") ;; Make a hyperlink to the library. (with-current-buffer standard-output - (save-excursion + (save-excursion (re-search-backward "`\\([^`']+\\)'" nil t) - (help-xref-button 1 'help-function-def function file-name))))) + (help-xref-button 1 'help-function-def function file-name)))) (princ ".") (terpri) (when (commandp function) - (let* ((remapped (remap-command function)) + (let* ((remapped (command-remapping function)) (keys (where-is-internal - (or remapped function) overriding-local-map nil nil))) + (or remapped function) overriding-local-map nil nil)) + non-modified-keys) + ;; Which non-control non-meta keys run this command? + (dolist (key keys) + (if (member (event-modifiers (aref key 0)) '(nil (shift))) + (push key non-modified-keys))) (when remapped (princ "It is remapped to `") (princ (symbol-name remapped)) (princ "'")) + (when keys (princ (if remapped " which is bound to " "It is bound to ")) ;; FIXME: This list can be very long (f.ex. for self-insert-command). - (princ (mapconcat 'key-description keys ", "))) - (when (or remapped keys) + ;; If there are many, remove them from KEYS. + (if (< (length non-modified-keys) 10) + (princ (mapconcat 'key-description keys ", ")) + (dolist (key non-modified-keys) + (setq keys (delq key keys))) + (if keys + (progn + (princ (mapconcat 'key-description keys ", ")) + (princ ", and many ordinary text characters")) + (princ "many ordinary text characters")))) + (when (or remapped keys non-modified-keys) (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 (help-function-arglist def)) (doc (documentation function)) - usage) - (princ (cond - ((listp arglist) (help-make-usage function arglist)) - ((stringp arglist) arglist) - ((and doc (subrp def) (setq usage (help-split-fundoc doc def))) - (setq doc (cdr usage)) (car usage)) - (t "[Missing arglist. Please make a bug report.]"))) - (terpri) - (let ((obsolete (get function 'byte-obsolete-info))) - (when obsolete - (terpri) - (princ "This function is obsolete") - (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete)))) - (princ ";") (terpri) - (princ (if (stringp (car obsolete)) (car obsolete) - (format "use `%s' instead." (car obsolete)))) - (terpri))) - (terpri) - (princ (or doc "Not documented."))))) + (usage (help-split-fundoc doc function))) + (with-current-buffer standard-output + ;; If definition is a keymap, skip arglist note. + (unless (keymapp def) + (let* ((use (cond + (usage (setq doc (cdr usage)) (car usage)) + ((listp arglist) + (format "%S" (help-make-usage function arglist))) + ((stringp arglist) arglist) + ;; Maybe the arglist is in the docstring of the alias. + ((let ((fun function)) + (while (and (symbolp fun) + (setq fun (symbol-function fun)) + (not (setq usage (help-split-fundoc + (documentation fun) + function))))) + usage) + (car usage)) + ((or (stringp def) + (vectorp def)) + (format "\nMacro: %s" (format-kbd-macro def))) + (t "[Missing arglist. Please make a bug report.]"))) + (high (help-highlight-arguments use doc))) + (insert (car high) "\n") + (setq doc (cdr high)))) + (let ((obsolete (and + ;; function might be a lambda construct. + (symbolp function) + (get function 'byte-obsolete-info)))) + (when obsolete + (princ "\nThis function is obsolete") + (when (nth 2 obsolete) + (insert (format " since %s" (nth 2 obsolete)))) + (insert ";\n" + (if (stringp (car obsolete)) (car obsolete) + (format "use `%s' instead." (car obsolete))) + "\n")) + (insert "\n" + (or doc "Not documented."))))))) ;; Variables ;;;###autoload -(defun variable-at-point () +(defun variable-at-point (&optional any-symbol) "Return the bound variable symbol found around point. -Return 0 if there is no such symbol." - (condition-case () - (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))) +Return 0 if there is no such symbol. +If ANY-SYMBOL is non-nil, don't insist the symbol be bound." + (or (condition-case () + (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)))) + (and (symbolp obj) (boundp obj) obj)))) + (error nil)) + (let* ((str (find-tag-default)) + (sym (if str (intern-soft str)))) + (if (and sym (or any-symbol (boundp sym))) + sym + (save-match-data + (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str)) + (setq sym (intern-soft (match-string 1 str))) + (and (or any-symbol (boundp sym)) sym))))) + 0)) ;;;###autoload (defun describe-variable (variable &optional buffer) @@ -361,30 +519,33 @@ it is displayed along with the global value." (if (not (symbolp variable)) (message "You did not specify a variable") (save-excursion - (let (valvoid) + (let* ((valvoid (not (with-current-buffer buffer (boundp variable)))) + ;; Extract the value before setting up the output buffer, + ;; in case `buffer' *is* the output buffer. + (val (unless valvoid (buffer-local-value variable buffer)))) (help-setup-xref (list #'describe-variable variable buffer) (interactive-p)) (with-output-to-temp-buffer (help-buffer) (with-current-buffer buffer (prin1 variable) - (if (not (boundp variable)) - (progn - (princ " is void") - (setq valvoid t)) - (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)) - (if (< (point) (+ from 20)) - (save-excursion - (goto-char from) - (delete-char -1))))))) + (if valvoid + (princ " is void") + (with-current-buffer standard-output + (princ "'s value is ") + (terpri) + (let ((from (point))) + (pp val) + ;; Hyperlinks in variable's value are quite frequently + ;; inappropriate e.g C-h v features + ;; (help-xref-on-pp from (point)) + (if (< (point) (+ from 20)) + (delete-region (1- from) from))))) (terpri) (when (local-variable-p variable) - (princ (format "Local in buffer %s; " (buffer-name))) + (princ (format "%socal in buffer %s; " + (if (get variable 'permanent-local) + "Permanently l" "L") + (buffer-name))) (if (not (default-boundp variable)) (princ "globally void") (let ((val (default-value variable))) @@ -397,7 +558,8 @@ it is displayed along with the global value." ;; sensible size before prettyprinting. -- fx (let ((from (point))) (pp val) - (help-xref-on-pp from (point)) + ;; See previous comment for this function. + ;; (help-xref-on-pp from (point)) (if (< (point) (+ from 20)) (delete-region (1- from) from)))))) (terpri)) @@ -413,9 +575,16 @@ it is displayed along with the global value." (forward-line 1) (forward-sexp 1) (delete-region (point) (progn (end-of-line) (point))) - (insert " value is shown below.\n\n") (save-excursion - (insert "\n\nValue:")))) + (insert "\n\nValue:") + (set (make-local-variable 'help-button-cache) + (point-marker))) + (insert " value is shown ") + (insert-button "below" + 'action help-button-cache + 'follow-link t + 'help-echo "mouse-2, RET: show value") + (insert ".\n\n"))) ;; Add a note for variables that have been make-var-buffer-local. (when (and (local-variable-if-set-p variable) (or (not (local-variable-p variable)) @@ -445,12 +614,7 @@ it is displayed along with the global value." (terpri)) (princ (or doc "Not documented as a variable."))) ;; 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 + (if (custom-variable-p variable) (let ((customize-label "customize")) (terpri) (terpri) @@ -463,7 +627,7 @@ it is displayed along with the global value." ;; 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))) + (let ((file-name (symbol-file variable 'defvar))) (when (equal file-name "loaddefs.el") ;; Find the real def site of the preloaded variable. (let ((location @@ -476,9 +640,16 @@ it is displayed along with the global value." (when (re-search-backward "^;;; Generated autoloads from \\(.*\\)" nil t) (setq file-name (match-string 1))))))) + (when (and (null file-name) + (integerp (get variable 'variable-documentation))) + ;; It's a variable not defined in Elisp but in C. + (setq file-name + (if (get-buffer " *DOC*") + (help-C-file-name variable 'var) + 'C-source))) (when file-name (princ "\n\nDefined in `") - (princ file-name) + (princ (if (eq file-name 'C-source) "C source code" file-name)) (princ "'.") (with-current-buffer standard-output (save-excursion @@ -520,7 +691,9 @@ BUFFER defaults to the current buffer." ;;;###autoload (defun describe-categories (&optional buffer) "Describe the category specifications in the current category table. -The descriptions are inserted in a buffer, which is then displayed." +The descriptions are inserted in a buffer, which is then displayed. +If BUFFER is non-nil, then describe BUFFER's category table instead. +BUFFER should be a buffer or a buffer name." (interactive) (setq buffer (or buffer (current-buffer))) (help-setup-xref (list #'describe-categories buffer) (interactive-p)) @@ -542,4 +715,5 @@ The descriptions are inserted in a buffer, which is then displayed." (provide 'help-fns) +;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3 ;;; help-fns.el ends here