(lm-with-file): Use mode and syntax table for Emacs Lisp, not Lisp.
[bpt/emacs.git] / lisp / help-fns.el
index befd83c..ed6a6a8 100644 (file)
@@ -1,7 +1,7 @@
 ;;; 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
       (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))))))
@@ -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)
@@ -419,7 +431,8 @@ face (according to `face-differs-from-default-p')."
               (insert (format " since %s" (nth 2 obsolete))))
             (insert ";\n"
                     (if (stringp (car obsolete)) (car obsolete)
-                      (format "use `%s' instead." (car obsolete)))
+                      (if (null (car obsolete)) ""
+                        (format "use `%s' instead." (car obsolete))))
                     "\n"))
           (insert "\n"
                   (or doc "Not documented.")))))))
@@ -453,6 +466,28 @@ 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 frame)
   "Display the full documentation of VARIABLE (a symbol).
@@ -492,7 +527,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,8 +637,8 @@ 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))
                   (safe-var (get variable 'safe-local-variable))
                    (doc (or (documentation-property variable 'variable-documentation)
@@ -628,7 +663,8 @@ it is displayed along with the global value."
                 (if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
                 (princ ";\n  ")
                 (princ (if (stringp (car obsolete)) (car obsolete)
-                         (format "use `%s' instead." (car obsolete))))
+                         (if (null (car obsolete)) ""
+                           (format "use `%s' instead." (car obsolete)))))
                 (terpri))
              (when safe-var
                 (setq extra-line t)
@@ -642,18 +678,46 @@ 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"))
+
+            (let ((customize-label "customize")
+                  (initialization-file "initialization file"))
+              ;; All variables can be set; some can be customized
+              (when (and (symbolp variable) (not (custom-variable-p variable)))
+               (terpri)
+               (terpri)
+               (princ (concat "You can set this variable in your "
+                               initialization-file "."))
+               (with-current-buffer standard-output
+                 (save-excursion
+                    (re-search-backward
+                    (concat "\\(" initialization-file "\\)") nil t)
+                    (help-xref-button 1 'help-info-variable variable
+                                      "(emacs)Init File"))))
+              ;; Make a link to customize if this variable can be customized.
+              (when (custom-variable-p variable)
+               (terpri)
+               (terpri)
+               (princ (concat "You can " customize-label " this variable"))
+               (princ (concat " or set it in your " initialization-file "."))
+               (with-current-buffer standard-output
+                 (save-excursion
+                   (re-search-backward
+                    (concat "\\(" customize-label "\\)") nil t)
+                   (help-xref-button 1 'help-customize-variable variable))
+                 (save-excursion
+                    (re-search-backward
+                    (concat "\\(" initialization-file "\\)") nil t)
+                    (help-xref-button 1 'help-info-variable variable
+                                      "(emacs)Init File")
+                    )
+                  ))
+             ;; 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 +732,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 +757,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)