]> code.delx.au - gnu-emacs/blobdiff - lisp/apropos.el
(display-time-string-forms): Test display-time-day-and-date
[gnu-emacs] / lisp / apropos.el
index 70855f469ccaba8cde06955e3f97747fb93ccda6..6729e4a4c6a9a8081e9a98f09bd10d284a0d4312 100644 (file)
@@ -90,6 +90,8 @@ This looks good, but slows down the commands several times.")
 (defvar apropos-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "\C-m" 'apropos-follow)
+    (define-key map " "      'scroll-up)
+    (define-key map "\177"   'scroll-down)
     (define-key map [mouse-2] 'apropos-mouse-follow)
     (define-key map [down-mouse-2] nil)
     map)
@@ -179,28 +181,47 @@ Returns list of symbols and documentation found."
                               (lambda (symbol)
                                 (or (fboundp symbol)
                                     (boundp symbol)
+                                    (facep symbol)
                                     (symbol-plist symbol))))))
   (apropos-print
    (or do-all apropos-do-all)
    (lambda (p)
-     (let (symbol doc)
+     (let (symbol doc properties)
        (while p
         (setcar p (list
                    (setq symbol (car p))
-                   (if (fboundp symbol)
-                       (if (setq doc (documentation symbol t))
-                           (substring doc 0 (string-match "\n" doc))
-                         "(not documented)"))
-                   (if (boundp symbol)
-                       (if (setq doc (documentation-property
-                                      symbol 'variable-documentation t))
-                           (substring doc 0
-                                      (string-match "\n" doc))
-                         "(not documented)"))
-                   (if (setq doc (symbol-plist symbol))
-                       (if (eq (/ (length doc) 2) 1)
-                           (format "1 property (%s)" (car doc))
-                         (concat (/ (length doc) 2) " properties")))))
+                   (when (fboundp symbol)
+                     (if (setq doc (documentation symbol t))
+                         (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)"))
+                   (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)"))
+                   (when (facep symbol)
+                     (if (setq doc (documentation-property
+                                    symbol 'face-documentation t))
+                         (substring doc 0
+                                    (string-match "\n" doc))
+                       "(not documented)"))
+                   (when (get symbol 'custom-group)
+                     (if (setq doc (documentation-property
+                                    symbol 'group-documentation t))
+                         (substring doc 0
+                                    (string-match "\n" doc))
+                       "(not documented)"))))
         (setq p (cdr p)))))
    nil))
 
@@ -458,25 +479,48 @@ found."
                point1 (point))
          (princ symbol)                        ; print symbol name
          (setq point2 (point))
-         ;; don't calculate key-bindings unless needed
+         ;; Calculate key-bindings if we want them.
          (and do-keys
               (commandp symbol)
               (indent-to 30 1)
-              (insert
-               (if (setq item (save-excursion
-                                (set-buffer old-buffer)
-                                (where-is-internal symbol)))
+              (if (let ((keys
+                         (save-excursion
+                           (set-buffer old-buffer)
+                           (where-is-internal symbol)))
+                        filtered)
+                    ;; Copy over the list of key sequences,
+                    ;; omitting any that contain a buffer or a frame.
+                    (while keys
+                      (let ((key (car keys))
+                            (i 0)
+                            loser)
+                        (while (< i (length key))
+                          (if (or (framep (aref key i))
+                                  (bufferp (aref key i)))
+                              (setq loser t))
+                          (setq i (1+ i)))
+                        (or loser
+                            (setq filtered (cons key filtered))))
+                      (setq keys (cdr keys)))
+                    (setq item filtered))
+                  ;; Convert the remaining keys to a string and insert.
+                  (insert
                    (mapconcat
-                    (if apropos-keybinding-face
-                        (lambda (key)
-                          (setq key (key-description key))
+                    (lambda (key)
+                      (setq key (key-description key))
+                      (if apropos-keybinding-face
                           (put-text-property 0 (length key)
                                              'face apropos-keybinding-face
-                                             key)
-                          key)
-                      'key-description)
-                    item ", ")
-                 "(not bound to any keys)")))
+                                             key))
+                      key)
+                    item ", "))
+                (insert "M-x")
+                (put-text-property (- (point) 3) (point)
+                                   'face apropos-keybinding-face)
+                (insert " " (symbol-name symbol) " ")
+                (insert "RET")
+                (put-text-property (- (point) 3) (point)
+                                   'face apropos-keybinding-face)))
          (terpri)
          ;; only now so we don't propagate text attributes all over
          (put-text-property point1 point2 'item
@@ -492,8 +536,14 @@ found."
                                   "Macro"
                                 "Function"))
                             do-keys)
-         (apropos-print-doc 'describe-variable 2
-                            "Variable" do-keys)
+         (if (get symbol 'custom-type)
+             (apropos-print-doc 'customize-variable-other-window 2
+                                "User Option" do-keys)
+           (apropos-print-doc 'describe-variable 2
+                              "Variable" do-keys))
+         (apropos-print-doc 'customize-other-window 6 "Group" do-keys)
+         (apropos-print-doc 'customize-face-other-window 5 "Face" do-keys)
+         (apropos-print-doc 'widget-browse-other-window 4 "Widget" do-keys)
          (apropos-print-doc 'apropos-describe-plist 3
                             "Plist" nil)))))
   (prog1 apropos-accumulator