]> code.delx.au - gnu-emacs/blobdiff - lisp/help-fns.el
(compilation-directory-matcher): Improve previous doc fix.
[gnu-emacs] / lisp / help-fns.el
index b7820b778d2e9e754e27255940aaee27919a3e28..8df079433f1a703c6493093c3258a78ab305efab 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 Free Software Foundation, Inc.
+;;   2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: help, internal
 
 (require 'help-mode)
 
-
-;;;###autoload
-(defun help-with-tutorial (&optional arg)
-  "Select the Emacs learn-by-doing tutorial.
-If there is a tutorial version written in the language
-of the selected language environment, that version is used.
-If there's no tutorial in that language, `TUTORIAL' is selected.
-With ARG, you are asked to choose which language."
-  (interactive "P")
-  (let ((lang (if arg
-                  (let ((minibuffer-setup-hook minibuffer-setup-hook))
-                    (add-hook 'minibuffer-setup-hook
-                              'minibuffer-completion-help)
-                    (read-language-name 'tutorial "Language: " "English"))
-               (if (get-language-info current-language-environment 'tutorial)
-                   current-language-environment
-                 "English")))
-       file filename)
-    (setq filename (get-language-info lang 'tutorial))
-    (setq file (expand-file-name (concat "~/" filename)))
-    (delete-other-windows)
-    (if (get-file-buffer file)
-       (switch-to-buffer (get-file-buffer file))
-      (switch-to-buffer (create-file-buffer file))
-      (setq buffer-file-name file)
-      (setq default-directory (expand-file-name "~/"))
-      (setq buffer-auto-save-file-name nil)
-      (insert-file-contents (expand-file-name filename data-directory))
-      (hack-local-variables)
-      (goto-char (point-min))
-      (search-forward "\n<<")
-      (beginning-of-line)
-      ;; Convert the <<...>> line to the proper [...] line,
-      ;; or just delete the <<...>> line if a [...] line follows.
-      (cond ((save-excursion
-              (forward-line 1)
-              (looking-at "\\["))
-            (delete-region (point) (progn (forward-line 1) (point))))
-           ((looking-at "<<Blank lines inserted.*>>")
-            (replace-match "[Middle of page left blank for didactic purposes.   Text continues below]"))
-           (t
-            (looking-at "<<")
-            (replace-match "[")
-            (search-forward ">>")
-            (replace-match "]")))
-      (beginning-of-line)
-      (let ((n (- (window-height (selected-window))
-                 (count-lines (point-min) (point))
-                 6)))
-       (if (< n 8)
-           (progn
-             ;; For a short gap, we don't need the [...] line,
-             ;; so delete it.
-             (delete-region (point) (progn (end-of-line) (point)))
-             (newline n))
-         ;; Some people get confused by the large gap.
-         (newline (/ n 2))
-
-         ;; Skip the [...] line (don't delete it).
-         (forward-line 1)
-         (newline (- n (/ n 2)))))
-      (goto-char (point-min))
-      (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
 
 ;;;###autoload
@@ -141,7 +47,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)
@@ -251,7 +158,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)
@@ -280,6 +186,7 @@ face (according to `face-differs-from-default-p')."
                          "\\)"
                          "\\(?: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)))))
@@ -311,6 +218,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)
@@ -363,6 +284,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.
@@ -395,35 +317,40 @@ face (according to `face-differs-from-default-p')."
     (princ ".")
     (terpri)
     (when (commandp function)
-      (let* ((remapped (command-remapping function))
-            (keys (where-is-internal
-                   (or remapped function) overriding-local-map nil nil))
-            non-modified-keys)
-       ;; Which non-control non-meta keys run this command?
-       (dolist (key keys)
-         (if (member (event-modifiers (aref key 0)) '(nil (shift)))
-             (push key non-modified-keys)))
-       (when remapped
-         (princ "It is remapped to `")
-         (princ (symbol-name remapped))
-         (princ "'"))
-
-       (when keys
-         (princ (if remapped " which is bound to " "It is bound to "))
-         ;; FIXME: This list can be very long (f.ex. for self-insert-command).
-         ;; If there are many, remove them from KEYS.
-         (if (< (length non-modified-keys) 10)
-             (princ (mapconcat 'key-description keys ", "))
-           (dolist (key non-modified-keys)
-             (setq keys (delq key keys)))
-           (if keys
-               (progn
-                 (princ (mapconcat 'key-description keys ", "))
-                 (princ ", and many ordinary text characters"))
-             (princ "many ordinary text characters"))))
-       (when (or remapped keys non-modified-keys)
-         (princ ".")
-         (terpri))))
+      (if (and (eq function 'self-insert-command)
+              (eq (key-binding "a") 'self-insert-command)
+              (eq (key-binding "b") 'self-insert-command)
+              (eq (key-binding "c") 'self-insert-command))
+         (princ "It is bound to many ordinary text characters.\n")
+       (let* ((remapped (command-remapping function))
+              (keys (where-is-internal
+                     (or remapped function) overriding-local-map nil nil))
+              non-modified-keys)
+         ;; Which non-control non-meta keys run this command?
+         (dolist (key keys)
+           (if (member (event-modifiers (aref key 0)) '(nil (shift)))
+               (push key non-modified-keys)))
+         (when remapped
+           (princ "It is remapped to `")
+           (princ (symbol-name remapped))
+           (princ "'"))
+
+         (when keys
+           (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 (mapconcat 'key-description keys ", "))
+             (dolist (key non-modified-keys)
+               (setq keys (delq key keys)))
+             (if keys
+                 (progn
+                   (princ (mapconcat 'key-description keys ", "))
+                   (princ ", and many ordinary text characters"))
+               (princ "many ordinary text characters"))))
+         (when (or remapped keys non-modified-keys)
+           (princ ".")
+           (terpri)))))
     (let* ((arglist (help-function-arglist def))
           (doc (documentation function))
           (usage (help-split-fundoc doc function)))
@@ -449,7 +376,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.
@@ -509,7 +438,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)))))
@@ -531,6 +464,7 @@ it is displayed along with the global value."
            ;; 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
@@ -539,7 +473,8 @@ it is displayed along with the global value."
                         (error nil))))
                  (when location
                    (with-current-buffer (car location)
-                     (goto-char (cdr location))
+                     (when (cdr location)
+                       (goto-char (cdr location)))
                      (when (re-search-backward
                             "^;;; Generated autoloads from \\(.*\\)" nil t)
                        (setq file-name (match-string 1)))))))
@@ -561,10 +496,10 @@ it is displayed along with the global value."
                        (help-xref-button 1 'help-variable-def
                                          variable file-name)))
                    (if valvoid
-                       (princ "It is void as a variable.\n")
+                       (princ "It is void as a variable.")
                      (princ "Its ")))
                (if valvoid
-                   (princ " is void as a variable.\n")
+                   (princ " is void as a variable.")
                  (princ "'s "))))
            (if valvoid
                nil
@@ -635,6 +570,7 @@ it is displayed along with the global value."
                              (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)
@@ -646,6 +582,13 @@ it is displayed along with the global value."
                 (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 ")
+               (princ (if (byte-code-function-p safe-var)
+                          "which is byte-compiled expression.\n"
+                        (format "`%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.