;;; 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 3, 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
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
(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))))))
(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)
+ (if (string-match "^ns.*\\(\\.o\\|obj\\)\\'" file)
+ (setq file (replace-match ".m" t t file 1))
+ (if (string-match "\\.\\(o\\|obj\\)\\'" file)
+ (setq file (replace-match ".c" t t file))))
+ (if (string-match "\\.\\(c\\|m\\)\\'" file)
(concat "src/" file)
file)))))
".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
src-file
file-name)))
+(declare-function ad-get-advice-info "advice" (function))
+
;;;###autoload
(defun describe-function-1 (function)
- (let* ((advised (and (featurep 'advice) (ad-get-advice-info function)))
- ;; If the function is advised, get the symbol that has the
- ;; real definition.
+ (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
- (if advised (cdr (assq 'origname advised))
- 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))
(re-search-backward "`\\([^`']+\\)'" nil t)
(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)
(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)
(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)
(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.")))))))
"Return the bound variable symbol found at or before point.
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
+ (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)
(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))
+ (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)))
+
+(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 (if (listp (cdr-safe cpv))
+ (car (cdr-safe cpv))
+ (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)
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
(terpri)
(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)))
(setq extra-line t)
(princ " This variable is obsolete")
(if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
- (princ ";\n ")
- (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
(setq extra-line t)
(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)