Merge from mainline.

[gnu-emacs] / lisp / apropos.el

diff --git a/lisp/apropos.el b/lisp/apropos.el
index 91e763185b6c1a47a713258c03d43fbadfb5f7de..35a3ac3c09ad434b860b7c4d57589c22e6a9d298 100644 (file)
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1,11 +1,11 @@
 ;;; apropos.el --- apropos commands for users and programmers
 
-;; Copyright (C) 1989, 1994, 1995, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1994-1995, 2001-2011  Free Software Foundation, Inc.
 
 ;; Author: Joe Wells <jbw@bigbird.bu.edu>
-;; Rewritten: Daniel Pfeiffer <occitan@esperanto.org>
+;;     Daniel Pfeiffer <occitan@esperanto.org> (rewrite)
 ;; Keywords: help
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
@@ -121,15 +121,12 @@ If value is `verbose', the computed score is shown for each match."
                 (const :tag "show scores" verbose)))
 
 (defvar apropos-mode-map
-  (let ((map (make-sparse-keymap)))
-    (set-keymap-parent map button-buffer-map)
+  (let ((map (copy-keymap button-buffer-map)))
+    (set-keymap-parent map special-mode-map)
     ;; Use `apropos-follow' instead of just using the button
     ;; definition of RET, so that users can use it anywhere in an
     ;; apropos item, not just on top of a button.
     (define-key map "\C-m" 'apropos-follow)
-    (define-key map " "    'scroll-up)
-    (define-key map "\177" 'scroll-down)
-    (define-key map "q"    'quit-window)
     map)
   "Keymap used in Apropos mode.")
 
@@ -374,8 +371,8 @@ Value is a list of offsets of the words into the string."
   "Return apropos score for documentation string DOC."
   (let ((l (length doc)))
     (if (> l 0)
-       (let ((score 0) i)
-         (when (setq i (string-match apropos-pattern-quoted doc))
+       (let ((score 0))
+         (when (string-match apropos-pattern-quoted doc)
            (setq score 10000))
          (dolist (s (apropos-calc-scores doc apropos-all-words) score)
            (setq score (+ score 50 (/ (* (- l s) 50) l)))))
@@ -410,7 +407,7 @@ This requires that at least 2 keywords (unless only one was given)."
   "Return t if DOC is really matched by the current keywords."
   (apropos-true-hit doc apropos-all-words))
 
-(define-derived-mode apropos-mode fundamental-mode "Apropos"
+(define-derived-mode apropos-mode special-mode "Apropos"
   "Major mode for following hyperlinks in output of apropos commands.
 
 \\{apropos-mode-map}")
@@ -466,7 +463,7 @@ while a list of strings is used as a word list."
   (apropos-parse-pattern pattern)
   (let ((message
         (let ((standard-output (get-buffer-create "*Apropos*")))
-          (print-help-return-message 'identity))))
+          (help-print-return-message 'identity))))
     (or do-all (setq do-all apropos-do-all))
     (setq apropos-accumulator
          (apropos-internal apropos-regexp
@@ -593,7 +590,7 @@ thus be found in `load-history'."
             (re (concat "\\(?:\\`\\|[\\/]\\)" (regexp-quote file)
                         "\\(\\.\\|\\'\\)")))
         (while (and lh (null lh-entry))
-          (if (string-match re (caar lh))
+          (if (and (caar lh) (string-match re (caar lh)))
               (setq lh-entry (car lh))
             (setq lh (cdr lh)))))
       (unless lh-entry (error "Unknown library `%s'" file)))
@@ -649,8 +646,19 @@ thus be found in `load-history'."
                   (apropos-documentation-property
                    symbol 'widget-documentation t))
               (when (facep symbol)
-                (apropos-documentation-property
-                 symbol 'face-documentation t))
+                (let ((alias (get symbol 'face-alias)))
+                  (if alias
+                      (if (facep alias)
+                          (format "%slias for the face `%s'."
+                                  (if (get symbol 'obsolete-face)
+                                      "Obsolete a"
+                                    "A")
+                                  alias)
+                        ;; Never happens in practice because fails
+                        ;; (facep symbol) test.
+                        "(alias for undefined face)")
+                    (apropos-documentation-property
+                     symbol 'face-documentation t))))
               (when (get symbol 'custom-group)
                   (apropos-documentation-property
                    symbol 'group-documentation t)))))
@@ -725,8 +733,7 @@ Returns list of symbols and documentation found."
        (apropos-sort-by-scores apropos-documentation-sort-by-scores)
        f v sf sv)
     (unwind-protect
-       (save-excursion
-         (set-buffer standard-input)
+       (with-current-buffer standard-input
          (apropos-documentation-check-doc-file)
          (if do-all
              (mapatoms
@@ -810,7 +817,7 @@ Returns list of symbols and documentation found."
 ;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name.
 
 (defun apropos-documentation-check-doc-file ()
-  (let (type symbol (sepa 2) sepb)
+  (let (type symbol (sepa 2) sepb doc)
     (insert ?\^_)
     (backward-char)
     (insert-file-contents (concat doc-directory internal-doc-file-name))
@@ -829,7 +836,14 @@ Returns list of symbols and documentation found."
                         3)             ; variable documentation
                  symbol (read)
                  doc (buffer-substring (1+ (point)) (1- sepb)))
-           (when (apropos-true-hit-doc doc)
+           (when (and (apropos-true-hit-doc doc)
+                       ;; The DOC file lists all built-in funcs and vars.
+                       ;; If any are not currently bound, they can
+                       ;; only be platform-specific stuff (eg NS) not
+                       ;; in use on the current platform.
+                       ;; So we exclude them.
+                       (cond ((= 3 type) (boundp symbol))
+                             ((= 2 type) (fboundp symbol))))
              (or (and (setq apropos-item (assq symbol apropos-accumulator))
                       (setcar (cdr apropos-item)
                               (apropos-score-doc doc)))
@@ -958,6 +972,7 @@ If non-nil TEXT is a string that will be printed as a heading."
     (with-output-to-temp-buffer "*Apropos*"
       (let ((p apropos-accumulator)
            (old-buffer (current-buffer))
+           (inhibit-read-only t)
            symbol item)
        (set-buffer standard-output)
        (apropos-mode)
@@ -965,8 +980,7 @@ If non-nil TEXT is a string that will be printed as a heading."
            (insert
             "If moving the mouse over text changes the text's color, "
             "you can click\n"
-            "mouse-2 (second button from right) on that text to "
-            "get more information.\n"))
+            "or press return on that text to get more information.\n"))
        (insert "In this buffer, go to the name of the command, or function,"
                " or variable,\n"
                (substitute-command-keys
@@ -1052,8 +1066,7 @@ If non-nil TEXT is a string that will be printed as a heading."
          (apropos-print-doc 5 'apropos-widget t)
          (apropos-print-doc 4 'apropos-plist nil))
         (set (make-local-variable 'truncate-partial-width-windows) t)
-        (set (make-local-variable 'truncate-lines) t)
-       (setq buffer-read-only t))))
+        (set (make-local-variable 'truncate-lines) t))))
   (prog1 apropos-accumulator
     (setq apropos-accumulator ())))    ; permit gc
 
@@ -1104,7 +1117,8 @@ If non-nil TEXT is a string that will be printed as a heading."
 
 (defun apropos-describe-plist (symbol)
   "Display a pretty listing of SYMBOL's plist."
-  (help-setup-xref (list 'apropos-describe-plist symbol) (interactive-p))
+  (help-setup-xref (list 'apropos-describe-plist symbol)
+                  (called-interactively-p 'interactive))
   (with-help-window (help-buffer)
     (set-buffer standard-output)
     (princ "Symbol ")
@@ -1119,5 +1133,4 @@ If non-nil TEXT is a string that will be printed as a heading."
 
 (provide 'apropos)
 
-;; arch-tag: d56fa2ac-e56b-4ce3-84ff-852f9c0dc66e
 ;;; apropos.el ends here