]> code.delx.au - gnu-emacs/blobdiff - lisp/help-fns.el
(command-line): On MS-Windows, probe "~", not "~USER", for warning about
[gnu-emacs] / lisp / help-fns.el
index 9231f959c644c674d548844224246ee30af42f42..2b75e7fd053dd723c108136ceb20bbd7eb0fcc6b 100644 (file)
@@ -1,7 +1,7 @@
 ;;; help-fns.el --- Complex help functions
 
-;; Copyright (C) 1985, 86, 93, 94, 98, 1999, 2000, 01, 02, 03, 2004
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001,
+;;   2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: help, internal
@@ -20,8 +20,8 @@
 
 ;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -65,8 +65,6 @@ With ARG, you are asked to choose which language."
       (insert-file-contents (expand-file-name filename data-directory))
       (hack-local-variables)
       (goto-char (point-min))
-      ;; The first line conventionally contains the title.
-      (delete-region (point) (progn (forward-line 1) (point)))
       (search-forward "\n<<")
       (beginning-of-line)
       ;; Convert the <<...>> line to the proper [...] line,
@@ -102,34 +100,6 @@ With ARG, you are asked to choose which language."
       (setq buffer-undo-list nil)
       (set-buffer-modified-p nil))))
 
-;;;###autoload
-(defun locate-library (library &optional nosuffix path interactive-call)
-  "Show the precise file name of Emacs library LIBRARY.
-This command searches the directories in `load-path' like `\\[load-library]'
-to find the file that `\\[load-library] RET LIBRARY RET' would load.
-Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes'
-to the specified name LIBRARY.
-
-If the optional third arg PATH is specified, that list of directories
-is used instead of `load-path'.
-
-When called from a program, the file name is normaly returned as a
-string.  When run interactively, the argument INTERACTIVE-CALL is t,
-and the file name is displayed in the echo area."
-  (interactive (list (completing-read "Locate library: "
-                                     'locate-file-completion
-                                     (cons load-path load-suffixes))
-                    nil nil
-                    t))
-  (let ((file (locate-file library
-                          (or path load-path)
-                          (append (unless nosuffix load-suffixes) '("")))))
-    (if interactive-call
-       (if file
-           (message "Library is file %s" (abbreviate-file-name file))
-         (message "No library %s in search path" library)))
-    file))
-
 \f
 ;; Functions
 
@@ -143,7 +113,8 @@ and the file name is displayed in the echo area."
      (setq val (completing-read (if fn
                                    (format "Describe function (default %s): " fn)
                                  "Describe function: ")
-                               obarray 'fboundp t nil nil (symbol-name fn)))
+                               obarray 'fboundp t nil nil
+                               (and fn (symbol-name fn))))
      (list (if (equal val "")
               fn (intern val)))))
   (if (null function)
@@ -219,14 +190,14 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
                        (intern (upcase name))))))
                arglist)))
 
-;;; Could be this, if we make symbol-file do the work below.
-;;; (defun help-C-file-name (subr-or-var kind)
-;;;   "Return the name of the C file where SUBR-OR-VAR is defined.
-;;; KIND should be `var' for a variable or `subr' for a subroutine."
-;;;   (symbol-file (if (symbolp subr-or-var) subr-or-var
-;;;             (subr-name subr-or-var))
-;;;           (if (eq kind 'var) 'defvar 'defun)))
-
+;; Could be this, if we make symbol-file do the work below.
+;; (defun help-C-file-name (subr-or-var kind)
+;;   "Return the name of the C file where SUBR-OR-VAR is defined.
+;; KIND should be `var' for a variable or `subr' for a subroutine."
+;;   (symbol-file (if (symbolp subr-or-var) subr-or-var
+;;              (subr-name subr-or-var))
+;;            (if (eq kind 'var) 'defvar 'defun)))
+;;;###autoload
 (defun help-C-file-name (subr-or-var kind)
   "Return the name of the C file where SUBR-OR-VAR is defined.
 KIND should be `var' for a variable or `subr' for a subroutine."
@@ -253,7 +224,6 @@ KIND should be `var' for a variable or `subr' for a subroutine."
            (concat "src/" file)
          file)))))
 
-;;;###autoload
 (defface help-argument-name '((((supports :slant italic)) :inherit italic))
   "Face to highlight argument names in *Help* buffers."
   :group 'help)
@@ -271,22 +241,21 @@ face (according to `face-differs-from-default-p')."
 (defun help-do-arg-highlight (doc args)
   (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
     (modify-syntax-entry ?\- "w")
-    (while args
-      (let ((arg (prog1 (car args) (setq args (cdr args)))))
-        (setq doc (replace-regexp-in-string
-                   ;; This is heuristic, but covers all common cases
-                   ;; except ARG1-ARG2
-                   (concat "\\<"                   ; beginning of word
-                           "\\(?:[a-z-]+-\\)?"     ; for xxx-ARG
-                           "\\("
-                           arg
-                           "\\)"
-                           "\\(?:es\\|s\\|th\\)?"  ; for ARGth, ARGs
-                           "\\(?:-[a-z-]+\\)?"     ; for ARG-xxx
-                           "\\>")                  ; end of word
-                   (help-default-arg-highlight arg)
-                   doc t t 1))))
-    doc))
+    (dolist (arg args doc)
+      (setq doc (replace-regexp-in-string
+                 ;; This is heuristic, but covers all common cases
+                 ;; except ARG1-ARG2
+                 (concat "\\<"                   ; beginning of word
+                         "\\(?:[a-z-]*-\\)?"     ; for xxx-ARG
+                         "\\("
+                         (regexp-quote arg)
+                         "\\)"
+                         "\\(?:es\\|s\\|th\\)?"  ; for ARGth, ARGs
+                         "\\(?:-[a-z0-9-]+\\)?"  ; for ARG-xxx, ARG-n
+                         "\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x'
+                         "\\>")                  ; end of word
+                 (help-default-arg-highlight arg)
+                 doc t t 1)))))
 
 (defun help-highlight-arguments (usage doc &rest args)
   (when usage
@@ -315,6 +284,20 @@ face (according to `face-differs-from-default-p')."
   ;; Return value is like the one from help-split-fundoc, but highlighted
   (cons usage doc))
 
+;;;###autoload
+(defun describe-simplify-lib-file-name (file)
+  "Simplify a library name FILE to a relative name, and make it a source file."
+  (if file
+      ;; Try converting the absolute file name to a library name.
+      (let ((libname (file-name-nondirectory file)))
+       ;; Now convert that back to a file name and see if we get
+       ;; the original one.  If so, they are equivalent.
+       (if (equal file (locate-file libname load-path '("")))
+           (if (string-match "[.]elc\\'" libname)
+               (substring libname 0 -1)
+             libname)
+         file))))
+
 ;;;###autoload
 (defun describe-function-1 (function)
   (let* ((def (if (symbolp function)
@@ -367,6 +350,7 @@ face (according to `face-differs-from-default-p')."
              (help-xref-button 1 'help-function def)))))
     (or file-name
        (setq file-name (symbol-file function 'defun)))
+    (setq file-name (describe-simplify-lib-file-name file-name))
     (when (equal file-name "loaddefs.el")
       ;; Find the real def site of the preloaded function.
       ;; This is necessary only for defaliases.
@@ -453,7 +437,9 @@ face (according to `face-differs-from-default-p')."
                          (format "\nMacro: %s" (format-kbd-macro def)))
                         (t "[Missing arglist.  Please make a bug report.]")))
                  (high (help-highlight-arguments use doc)))
-            (insert (car high) "\n")
+            (let ((fill-begin (point)))
+             (insert (car high) "\n")
+             (fill-region fill-begin (point)))
             (setq doc (cdr high))))
         (let ((obsolete (and
                          ;; function might be a lambda construct.
@@ -513,7 +499,11 @@ it is displayed along with the global value."
                                    (format
                                     "Describe variable (default %s): " v)
                                  "Describe variable: ")
-                               obarray 'boundp t nil nil
+                               obarray
+                               '(lambda (vv)
+                                  (or (boundp vv)
+                                      (get vv 'variable-documentation)))
+                               t nil nil
                                (if (symbolp v) (symbol-name v))))
      (list (if (equal val "")
               v (intern val)))))
@@ -524,23 +514,68 @@ it is displayed along with the global value."
       (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 (unless valvoid (buffer-local-value variable buffer)))
+            val-start-pos)
        (help-setup-xref (list #'describe-variable variable buffer)
                         (interactive-p))
        (with-output-to-temp-buffer (help-buffer)
          (with-current-buffer buffer
            (prin1 variable)
+           ;; Make a hyperlink to the library if appropriate.  (Don't
+           ;; change the format of the buffer's initial line in case
+           ;; anything expects the current format.)
+           (let ((file-name (symbol-file variable 'defvar)))
+             (setq file-name (describe-simplify-lib-file-name file-name))
+             (when (equal file-name "loaddefs.el")
+               ;; Find the real def site of the preloaded variable.
+               (let ((location
+                      (condition-case nil
+                          (find-variable-noselect variable file-name)
+                        (error nil))))
+                 (when location
+                   (with-current-buffer (car location)
+                     (goto-char (cdr location))
+                     (when (re-search-backward
+                            "^;;; Generated autoloads from \\(.*\\)" nil t)
+                       (setq file-name (match-string 1)))))))
+             (when (and (null file-name)
+                        (integerp (get variable 'variable-documentation)))
+               ;; It's a variable not defined in Elisp but in C.
+               (setq file-name
+                     (if (get-buffer " *DOC*")
+                         (help-C-file-name variable 'var)
+                       'C-source)))
+             (if file-name
+                 (progn
+                   (princ " is a variable defined in `")
+                   (princ (if (eq file-name 'C-source) "C source code" file-name))
+                   (princ "'.\n")
+                   (with-current-buffer standard-output
+                     (save-excursion
+                       (re-search-backward "`\\([^`']+\\)'" nil t)
+                       (help-xref-button 1 'help-variable-def
+                                         variable file-name)))
+                   (if valvoid
+                       (princ "It is void as a variable.")
+                     (princ "Its ")))
+               (if valvoid
+                   (princ " is void as a variable.")
+                 (princ "'s "))))
            (if valvoid
-               (princ " is void")
+               nil
              (with-current-buffer standard-output
-               (princ "'s value is ")
+               (setq val-start-pos (point))
+               (princ "value is ")
                (terpri)
                (let ((from (point)))
                  (pp val)
-                 (help-xref-on-pp from (point))
+                 ;; Hyperlinks in variable's value are quite frequently
+                 ;; inappropriate e.g C-h v <RET> features <RET>
+                 ;; (help-xref-on-pp from (point))
                  (if (< (point) (+ from 20))
                      (delete-region (1- from) from)))))
            (terpri)
+
            (when (local-variable-p variable)
              (princ (format "%socal in buffer %s; "
                             (if (get variable 'permanent-local)
@@ -558,59 +593,61 @@ it is displayed along with the global value."
                    ;; sensible size before prettyprinting.  -- fx
                    (let ((from (point)))
                      (pp val)
-                     (help-xref-on-pp from (point))
+                     ;; See previous comment for this function.
+                     ;; (help-xref-on-pp from (point))
                      (if (< (point) (+ from 20))
-                       (delete-region (1- from) from))))))
-             (terpri))
+                         (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)
+
+           ;; If the value is large, move it to the end.
            (with-current-buffer standard-output
              (when (> (count-lines (point-min) (point-max)) 10)
                ;; Note that setting the syntax table like below
                ;; makes forward-sexp move over a `'s' at the end
                ;; of a symbol.
                (set-syntax-table emacs-lisp-mode-syntax-table)
-               (goto-char (point-min))
-               (if valvoid
-                   (forward-line 1)
-                 (forward-sexp 1)
-                 (delete-region (point) (progn (end-of-line) (point)))
-                 (save-excursion
-                   (insert "\n\nValue:")
-                   (set (make-local-variable 'help-button-cache)
-                        (point-marker)))
-                 (insert " value is shown ")
-                 (insert-button "below"
-                                'action help-button-cache
-                                'follow-link t
-                                'help-echo "mouse-2, RET: show value")
-                 (insert ".\n\n")))
-             ;; 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))))
+               (goto-char val-start-pos)
+               (delete-region (point) (progn (end-of-line) (point)))
                (save-excursion
-                 (forward-line -1)
-                 (insert "Automatically becomes buffer-local when set in any fashion.\n"))))
+                 (insert "\n\nValue:")
+                 (set (make-local-variable 'help-button-cache)
+                      (point-marker)))
+               (insert "value is shown ")
+               (insert-button "below"
+                              'action help-button-cache
+                              'follow-link t
+                              'help-echo "mouse-2, RET: show value")
+               (insert ".\n\n")))
+
            ;; 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))))
               (unless (eq alias variable)
-                (princ (format "This variable is an alias for `%s'." alias))
-                (terpri)
-                (terpri))
+                (princ (format "\nThis variable is an alias for `%s'.\n" alias)))
               (when obsolete
-                (princ "This variable is obsolete")
+                (princ "\nThis 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))))
-                (terpri)
                 (terpri))
+             (when safe-var 
+               (princ "This variable is safe to use as a file local variable")
+               (princ (format " only if its value\nsatisfies the predicate `%s'.\n"
+                              safe-var))
+               (terpri))
+             (princ "Documentation:\n")
               (princ (or doc "Not documented as a variable.")))
            ;; Make a link to customize if this variable can be customized.
            (if (custom-variable-p variable)
@@ -623,39 +660,6 @@ it is displayed along with the global value."
                      (re-search-backward
                       (concat "\\(" customize-label "\\)") nil t)
                      (help-xref-button 1 'help-customize-variable variable)))))
-           ;; Make a hyperlink to the library if appropriate.  (Don't
-           ;; change the format of the buffer's initial line in case
-           ;; anything expects the current format.)
-           (let ((file-name (symbol-file variable 'defvar)))
-             (when (equal file-name "loaddefs.el")
-               ;; Find the real def site of the preloaded variable.
-               (let ((location
-                      (condition-case nil
-                          (find-variable-noselect variable file-name)
-                        (error nil))))
-                 (when location
-                   (with-current-buffer (car location)
-                     (goto-char (cdr location))
-                     (when (re-search-backward
-                            "^;;; Generated autoloads from \\(.*\\)" nil t)
-                       (setq file-name (match-string 1)))))))
-             (when (and (null file-name)
-                        (integerp (get variable 'variable-documentation)))
-               ;; It's a variable not defined in Elisp but in C.
-               (setq file-name
-                     (if (get-buffer " *DOC*")
-                         (help-C-file-name variable 'var)
-                       'C-source)))
-             (when file-name
-               (princ "\n\nDefined in `")
-               (princ (if (eq file-name 'C-source) "C source code" file-name))
-               (princ "'.")
-               (with-current-buffer standard-output
-                 (save-excursion
-                   (re-search-backward "`\\([^`']+\\)'" nil t)
-                   (help-xref-button 1 'help-variable-def
-                                     variable file-name)))))
-
            (print-help-return-message)
            (save-excursion
              (set-buffer standard-output)
@@ -707,12 +711,12 @@ BUFFER should be a buffer or a buffer name."
            (dotimes (i 95)
              (let ((elt (aref docs i)))
                (when elt
-                 (insert (+ i ?\ ) ": " elt "\n"))))
+                 (insert (+ i ?\s) ": " elt "\n"))))
            (while (setq table (char-table-parent table))
              (insert "\nThe parent category table is:")
              (describe-vector table 'help-describe-category-set))))))))
 
 (provide 'help-fns)
 
-;;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3
+;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3
 ;;; help-fns.el ends here