(apropos-documentation-property): New function.

(apropos): Use apropos-documentation-property.

diff --git a/lisp/apropos.el b/lisp/apropos.el
index 9a5230eaabf8918156cb7f315f99f734dc9a0d1e..159ad669d3e6ea7ef5ded36d5640f805bfa26870 100644 (file)
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -432,6 +432,14 @@ satisfy the predicate VAR-PREDICATE."
 
 
 ;;;###autoload
+(defun apropos-documentation-property (symbol property raw)
+  "Like (documentation-property SYMBOL PROPERTY RAW) but handle errors."
+  (condition-case ()
+      (let ((doc (documentation-property symbol property raw)))
+       (if doc (substring doc 0 (string-match "\n" doc))
+         "(not documented)"))
+    (error "(error retrieving documentation)")))
+
 (defun apropos (apropos-regexp &optional do-all)
   "Show all bound symbols whose names match APROPOS-REGEXP.
 With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also
@@ -463,37 +471,28 @@ time-consuming.  Returns list of symbols and documentation found."
                   (if (setq doc (condition-case nil
                                     (documentation symbol t)
                                   (void-function
-                                   "(alias for undefined function)")))
+                                   "(alias for undefined function)")
+                                  (error
+                                   "(error retrieving function documentation")))
                       (substring doc 0 (string-match "\n" doc))
                     "(not documented)"))
                 (when (boundp symbol)
-                  (if (setq doc (documentation-property
-                                 symbol 'variable-documentation t))
-                      (substring doc 0 (string-match "\n" doc))
-                    "(not documented)"))
+                  (apropos-documentation-property
+                   symbol 'variable-documentation t))
                 (when (setq properties (symbol-plist symbol))
                   (setq doc (list (car properties)))
                   (while (setq properties (cdr (cdr properties)))
                     (setq doc (cons (car properties) doc)))
                   (mapconcat #'symbol-name (nreverse doc) " "))
                 (when (get symbol 'widget-type)
-                  (if (setq doc (documentation-property
-                                 symbol 'widget-documentation t))
-                      (substring doc 0
-                                 (string-match "\n" doc))
-                    "(not documented)"))
+                  (apropos-documentation-property
+                   symbol 'widget-documentation t))
                 (when (facep symbol)
-                  (if (setq doc (documentation-property
-                                 symbol 'face-documentation t))
-                      (substring doc 0
-                                 (string-match "\n" doc))
-                    "(not documented)"))
+                  (apropos-documentation-property
+                   symbol 'face-documentation t))
                 (when (get symbol 'custom-group)
-                  (if (setq doc (documentation-property
-                                 symbol 'group-documentation t))
-                      (substring doc 0
-                                 (string-match "\n" doc))
-                    "(not documented)"))))
+                  (apropos-documentation-property
+                   symbol 'group-documentation t))))
       (setq p (cdr p))))
   (apropos-print
    (or do-all apropos-do-all)