Convert consecutive FSF copyright years to ranges.

[bpt/emacs.git] / lisp / apropos.el

diff --git a/lisp/apropos.el b/lisp/apropos.el
index 31eada9..459d128 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 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.
 
@@ -112,7 +112,7 @@ If value is `verbose', the computed score is shown for each match."
                 (const :tag "show scores" verbose)))
 
 (defcustom apropos-documentation-sort-by-scores t
-  "*Non-nil means sort matches by scores; best match is shown first.
+  "Non-nil means sort matches by scores; best match is shown first.
 This applies to `apropos-documentation' only.
 If value is `verbose', the computed score is shown for each match."
   :group 'apropos
@@ -466,7 +466,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
@@ -569,17 +569,18 @@ Returns list of symbols and documentation found."
 FILE should be one of the libraries currently loaded and should
 thus be found in `load-history'."
   (interactive
-   (let ((libs
-          (nconc (delq nil
-                       (mapcar
-                        (lambda (l)
-                          (setq l (file-name-nondirectory l))
-                          (while
-                              (not (equal (setq l (file-name-sans-extension l))
-                                          l)))
-                          l)
-                        (mapcar 'car load-history)))
-                 (mapcar 'car load-history))))
+   (let* ((libs (delq nil (mapcar 'car load-history)))
+          (libs
+           (nconc (delq nil
+                        (mapcar
+                         (lambda (l)
+                           (setq l (file-name-nondirectory l))
+                           (while
+                               (not (equal (setq l (file-name-sans-extension l))
+                                           l)))
+                           l)
+                         libs))
+                  libs)))
      (list (completing-read "Describe library: " libs nil t))))
   (let ((symbols nil)
        ;; (autoloads nil)
@@ -592,7 +593,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)))
@@ -648,8 +649,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)))))
@@ -724,8 +736,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
@@ -809,7 +820,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))
@@ -828,7 +839,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)))
@@ -964,8 +982,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
@@ -1082,8 +1099,8 @@ If non-nil TEXT is a string that will be printed as a heading."
         'face 'default 'apropos-symbol (car apropos-item))
       (insert-text-button
        (if apropos-compact-layout
-           (button-type-get type 'apropos-label)
-         (format "<%s>" (button-type-get type 'apropos-short-label)))
+           (format "<%s>" (button-type-get type 'apropos-short-label))
+         (button-type-get type 'apropos-label))
        'type type
        ;; Can't use the default button face, since user may have changed the
        ;; variable!  Just say `no' to variables containing faces!
@@ -1103,7 +1120,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 ")
@@ -1118,5 +1136,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