X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2536fb611876d5526fe40b9bee2a16e2836d4ff3..d9a3d80e56e26f65ca3b35b242436a2b16dbf535:/lisp/help-fns.el diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 92354624d8..f3b166a33c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1,17 +1,17 @@ ;;; help-fns.el --- Complex help functions ;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +19,7 @@ ;; 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, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -55,13 +53,12 @@ (message "You didn't specify a function") (help-setup-xref (list #'describe-function function) (interactive-p)) (save-excursion - (with-output-to-temp-buffer (help-buffer) + (with-help-window (help-buffer) (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) - (print-help-return-message) (with-current-buffer standard-output ;; Return the text we displayed. (buffer-string)))))) @@ -239,7 +236,7 @@ face (according to `face-differs-from-default-p')." ".elc")) load-path)) (str (if (and elc-file (file-readable-p elc-file)) - (with-temp-buffer + (with-temp-buffer (insert-file-contents-literally elc-file nil 0 256) (buffer-string)))) (src-file (and str @@ -249,13 +246,27 @@ face (according to `face-differs-from-default-p')." src-file file-name))) +(declare-function ad-get-advice-info "advice" (function)) + ;;;###autoload (defun describe-function-1 (function) - (let* ((def (if (symbolp function) - (symbol-function function) + (let* ((advised (and (symbolp function) (featurep 'advice) + (ad-get-advice-info function))) + ;; If the function is advised, use the symbol that has the + ;; real definition, if that symbol is already set up. + (real-function + (or (and advised + (cdr (assq 'origname advised)) + (fboundp (cdr (assq 'origname advised))) + (cdr (assq 'origname advised))) + function)) + ;; Get the real definition. + (def (if (symbolp real-function) + (symbol-function real-function) function)) file-name string - (beg (if (commandp def) "an interactive " "a "))) + (beg (if (commandp def) "an interactive " "a ")) + (pt1 (with-current-buffer (help-buffer) (point)))) (setq string (cond ((or (stringp def) (vectorp def)) @@ -334,10 +345,14 @@ face (according to `face-differs-from-default-p')." (with-current-buffer standard-output (save-excursion (re-search-backward "`\\([^`']+\\)'" nil t) - (help-xref-button 1 'help-function-def function file-name)))) + (help-xref-button 1 'help-function-def real-function file-name)))) (princ ".") - (terpri) + (with-current-buffer (help-buffer) + (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) + (point))) + (terpri)(terpri) (when (commandp function) + (let ((pt2 (with-current-buffer (help-buffer) (point)))) (if (and (eq function 'self-insert-command) (eq (key-binding "a") 'self-insert-command) (eq (key-binding "b") 'self-insert-command) @@ -357,7 +372,7 @@ face (according to `face-differs-from-default-p')." (princ "'")) (when keys - (princ (if remapped " which is bound to " "It is bound to ")) + (princ (if remapped ", which is bound to " "It is bound to ")) ;; If lots of ordinary text characters run this command, ;; don't mention them one by one. (if (< (length non-modified-keys) 10) @@ -371,20 +386,23 @@ face (according to `face-differs-from-default-p')." (princ "many ordinary text characters")))) (when (or remapped keys non-modified-keys) (princ ".") - (terpri))))) + (terpri)))) + (with-current-buffer (help-buffer) (fill-region-as-paragraph pt2 (point))) + (terpri))) (let* ((arglist (help-function-arglist def)) (doc (documentation function)) (usage (help-split-fundoc doc function))) (with-current-buffer standard-output ;; If definition is a keymap, skip arglist note. - (unless (keymapp def) + (unless (keymapp function) (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)) + ;; Maybe the arglist is in the docstring of a symbol + ;; this one is aliased to. + ((let ((fun real-function)) (while (and (symbolp fun) (setq fun (symbol-function fun)) (not (setq usage (help-split-fundoc @@ -401,18 +419,19 @@ face (according to `face-differs-from-default-p')." (insert (car high) "\n") (fill-region fill-begin (point))) (setq doc (cdr high)))) - (let ((obsolete (and - ;; function might be a lambda construct. - (symbolp function) - (get function 'byte-obsolete-info)))) + (let* ((obsolete (and + ;; function might be a lambda construct. + (symbolp function) + (get function 'byte-obsolete-info))) + (use (car obsolete))) (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 (cond ((stringp use) (concat ";\n" use)) + (use (format ";\nuse `%s' instead." use)) + (t ".")) + "\n")) (insert "\n" (or doc "Not documented."))))))) @@ -445,11 +464,34 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound." (and (or any-symbol (boundp sym)) sym))))) 0)) +(defun describe-variable-custom-version-info (variable) + (let ((custom-version (get variable 'custom-version)) + (cpv (get variable 'custom-package-version)) + (output nil)) + (if custom-version + (setq output + (format "This variable was introduced, or its default value was changed, in\nversion %s of Emacs.\n" + custom-version)) + (when cpv + (let* ((package (car-safe cpv)) + (version (car (cdr-safe cpv))) + (pkg-versions (assq package customize-package-emacs-version-alist)) + (emacsv (cdr (assoc version pkg-versions)))) + (if (and package version) + (setq output + (format (concat "This variable was introduced, or its default value was changed, in\nversion %s of the %s package" + (if emacsv + (format " that is part of Emacs %s" emacsv)) + ".\n") + version package)))))) + output)) + ;;;###autoload -(defun describe-variable (variable &optional buffer) +(defun describe-variable (variable &optional buffer frame) "Display the full documentation of VARIABLE (a symbol). Returns the documentation as a string, also. -If VARIABLE has a buffer-local value in BUFFER (default to the current buffer), +If VARIABLE has a buffer-local value in BUFFER or FRAME +\(default to the current buffer and current frame), it is displayed along with the global value." (interactive (let ((v (variable-at-point)) @@ -468,17 +510,22 @@ it is displayed along with the global value." (list (if (equal val "") v (intern val))))) (unless (buffer-live-p buffer) (setq buffer (current-buffer))) + (unless (frame-live-p frame) (setq frame (selected-frame))) (if (not (symbolp variable)) (message "You did not specify a variable") (save-excursion - (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))) - val-start-pos) + (let ((valvoid (not (with-current-buffer buffer (boundp variable)))) + val val-start-pos locus) + ;; Extract the value before setting up the output buffer, + ;; in case `buffer' *is* the output buffer. + (unless valvoid + (with-selected-frame frame + (with-current-buffer buffer + (setq val (symbol-value variable) + locus (variable-binding-locus variable))))) (help-setup-xref (list #'describe-variable variable buffer) (interactive-p)) - (with-output-to-temp-buffer (help-buffer) + (with-help-window (help-buffer) (with-current-buffer buffer (prin1 variable) ;; Make a hyperlink to the library if appropriate. (Don't @@ -537,11 +584,13 @@ it is displayed along with the global value." (delete-region (1- from) from))))) (terpri) - (when (local-variable-p variable) - (princ (format "%socal in buffer %s; " - (if (get variable 'permanent-local) - "Permanently l" "L") - (buffer-name))) + (when locus + (if (bufferp locus) + (princ (format "%socal in buffer %s; " + (if (get variable 'permanent-local) + "Permanently l" "L") + (buffer-name))) + (princ (format "It is a frame-local variable; "))) (if (not (default-boundp variable)) (princ "globally void") (let ((val (default-value variable))) @@ -557,14 +606,8 @@ it is displayed along with the global value." ;; See previous comment for this function. ;; (help-xref-on-pp from (point)) (if (< (point) (+ from 20)) - (delete-region (1- from) from))))))) - ;; 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)) - (with-temp-buffer - (local-variable-if-set-p variable)))) - (princ "\nAutomatically becomes buffer-local when set in any fashion.\n")) - (terpri) + (delete-region (1- from) from)))))) + (terpri)) ;; If the value is large, move it to the end. (with-current-buffer standard-output @@ -589,47 +632,69 @@ it is displayed along with the global value." 'follow-link t 'help-echo "mouse-2, RET: show value") (insert ".\n"))) + (terpri) - ;; Mention if it's an alias (let* ((alias (condition-case nil - (indirect-variable variable) - (error variable))) + (indirect-variable variable) + (error variable))) (obsolete (get variable 'byte-obsolete-variable)) + (use (car obsolete)) (safe-var (get variable 'safe-local-variable)) (doc (or (documentation-property variable 'variable-documentation) - (documentation-property alias 'variable-documentation)))) + (documentation-property alias 'variable-documentation))) + (extra-line nil)) + ;; 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)) + (with-temp-buffer + (local-variable-if-set-p variable)))) + (setq extra-line t) + (princ " Automatically becomes buffer-local when set in any fashion.\n")) + + ;; Mention if it's an alias (unless (eq alias variable) - (princ (format "\nThis variable is an alias for `%s'.\n" alias))) - (if (or obsolete safe-var) - (terpri)) + (setq extra-line t) + (princ (format " This variable is an alias for `%s'.\n" alias))) (when obsolete - (princ "This variable is obsolete") + (setq extra-line t) + (princ " This variable is obsolete") (if (cdr obsolete) (princ (format " since %s" (cdr obsolete)))) - (princ ";") (terpri) - (princ (if (stringp (car obsolete)) (car obsolete) - (format "use `%s' instead." (car obsolete)))) + (princ (cond ((stringp use) (concat ";\n " use)) + (use (format ";\n use `%s' instead." (car obsolete))) + (t "."))) (terpri)) (when safe-var - (princ "This variable is safe as a file local variable ") - (princ "if its value\nsatisfies the predicate ") + (setq extra-line t) + (princ " This variable is safe as a file local variable ") + (princ "if its value\n satisfies the predicate ") (princ (if (byte-code-function-p safe-var) "which is byte-compiled expression.\n" (format "`%s'.\n" safe-var)))) - (princ "\nDocumentation:\n") - (princ (or doc "Not documented as a variable."))) + + (if extra-line (terpri)) + (princ "Documentation:\n") + (with-current-buffer standard-output + (insert (or doc "Not documented as a variable.")))) + ;; Make a link to customize if this variable can be customized. - (if (custom-variable-p variable) - (let ((customize-label "customize")) + (when (custom-variable-p variable) + (let ((customize-label "customize")) + (terpri) + (terpri) + (princ (concat "You can " customize-label " this variable.")) + (with-current-buffer standard-output + (save-excursion + (re-search-backward + (concat "\\(" customize-label "\\)") nil t) + (help-xref-button 1 'help-customize-variable variable)))) + ;; Note variable's version or package version + (let ((output (describe-variable-custom-version-info variable))) + (when output (terpri) (terpri) - (princ (concat "You can " customize-label " this variable.")) - (with-current-buffer standard-output - (save-excursion - (re-search-backward - (concat "\\(" customize-label "\\)") nil t) - (help-xref-button 1 'help-customize-variable variable))))) - (print-help-return-message) + (princ output)))) + (save-excursion (set-buffer standard-output) ;; Return the text we displayed. @@ -644,7 +709,7 @@ BUFFER defaults to the current buffer." (interactive) (setq buffer (or buffer (current-buffer))) (help-setup-xref (list #'describe-syntax buffer) (interactive-p)) - (with-output-to-temp-buffer (help-buffer) + (with-help-window (help-buffer) (let ((table (with-current-buffer buffer (syntax-table)))) (with-current-buffer standard-output (describe-vector table 'internal-describe-syntax-value) @@ -669,7 +734,7 @@ 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)) - (with-output-to-temp-buffer (help-buffer) + (with-help-window (help-buffer) (let ((table (with-current-buffer buffer (category-table)))) (with-current-buffer standard-output (describe-vector table 'help-describe-category-set)