X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b2529d56b5126319a1659dc1530d6fc102cc21d6..a971635315e259c076de020b3676c04d1dcc415e:/lisp/help-fns.el diff --git a/lisp/help-fns.el b/lisp/help-fns.el index bf8d5f9a20..d251ab0e34 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 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 @@ -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)))))) @@ -152,9 +149,11 @@ KIND should be `var' for a variable or `subr' for a subroutine." (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))))) @@ -239,7 +238,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,20 +248,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* ((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)) @@ -343,8 +349,12 @@ face (according to `face-differs-from-default-p')." (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) @@ -364,7 +374,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) @@ -378,13 +388,15 @@ 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) @@ -409,18 +421,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."))))))) @@ -432,8 +445,8 @@ face (according to `face-differs-from-default-p')." "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) @@ -441,17 +454,41 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound." (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) @@ -492,7 +529,7 @@ it is displayed along with the global value." 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 @@ -602,9 +639,10 @@ it is displayed along with the global value." (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))) @@ -626,9 +664,9 @@ it is displayed along with the global value." (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) @@ -642,18 +680,25 @@ it is displayed along with the global value." (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. @@ -668,7 +713,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) @@ -693,7 +738,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)