;;; help-fns.el --- Complex help functions
;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001,
-;; 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help, internal
;; 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)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
(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))))))
libname)
file))))
+(defun find-source-lisp-file (file-name)
+ (let* ((elc-file (locate-file (concat file-name
+ (if (string-match "\\.el" file-name)
+ "c"
+ ".elc"))
+ load-path))
+ (str (if (and elc-file (file-readable-p elc-file))
+ (with-temp-buffer
+ (insert-file-contents-literally elc-file nil 0 256)
+ (buffer-string))))
+ (src-file (and str
+ (string-match ";;; from file \\(.*\\.el\\)" str)
+ (match-string 1 str))))
+ (if (and src-file (file-readable-p src-file))
+ 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 ")))
;; but that's completely wrong when the user used load-file.
(princ (if (eq file-name 'C-source) "C source code" file-name))
(princ "'")
+ ;; See if lisp files are present where they where installed from.
+ (if (not (eq file-name 'C-source))
+ (setq file-name (find-source-lisp-file file-name)))
+
;; Make a hyperlink to the library.
(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)
(when (commandp function)
((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
(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 frame)
"Display the full documentation of VARIABLE (a symbol).
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
;; 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
;; of a symbol.
(set-syntax-table emacs-lisp-mode-syntax-table)
(goto-char val-start-pos)
- (delete-region (point) (progn (end-of-line) (point)))
+ ;; The line below previously read as
+ ;; (delete-region (point) (progn (end-of-line) (point)))
+ ;; which suppressed display of the buffer local value for
+ ;; large values.
+ (when (looking-at "value is") (replace-match ""))
(save-excursion
(insert "\n\nValue:")
(set (make-local-variable 'help-button-cache)
'action help-button-cache
'follow-link t
'help-echo "mouse-2, RET: show value")
- (insert ".\n\n")))
+ (insert ".\n")))
+ (terpri)
- ;; Mention if it's an alias
(let* ((alias (condition-case nil
(indirect-variable variable)
(error variable)))
(obsolete (get variable 'byte-obsolete-variable))
(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 ";\n ")
(princ (if (stringp (car obsolete)) (car obsolete)
(format "use `%s' instead." (car obsolete))))
(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.
(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)
(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)