]> code.delx.au - gnu-emacs/blobdiff - lisp/apropos.el
(easy-menu-define-key): Fixed bug with BEFORE
[gnu-emacs] / lisp / apropos.el
index aadf72d910afd869d610f8314f34c993f778ce46..89ea5e46144e293a13b5ffb73825da72c3884755 100644 (file)
 
 ;;; Code:
 
+(defgroup apropos nil
+  "Apropos commands for users and programmers"
+  :group 'Help
+  :prefix "apropos")
+
 ;; I see a degradation of maybe 10-20% only.
-(defvar apropos-do-all nil
+(defcustom apropos-do-all nil
   "*Whether the apropos commands should do more.
-Slows them down more or less.  Set this non-nil if you have a fast machine.")
+
+Slows them down more or less.  Set this non-nil if you have a fast machine."
+  :group 'apropos
+  :type 'boolean)
 
 
-(defvar apropos-symbol-face (if window-system 'bold)
-  "*Face for symbol name in apropos output or `nil'.  
-This looks good, but slows down the commands several times.")
+(defcustom apropos-symbol-face (if window-system 'bold)
+  "*Face for symbol name in apropos output or `nil'.
+This looks good, but slows down the commands several times."
+  :group 'apropos
+  :type 'face)
 
-(defvar apropos-keybinding-face (if window-system 'underline)
+(defcustom apropos-keybinding-face (if window-system 'underline)
   "*Face for keybinding display in apropos output or `nil'.  
-This looks good, but slows down the commands several times.")
+This looks good, but slows down the commands several times."
+  :group 'apropos
+  :type 'face)
 
-(defvar apropos-label-face (if window-system 'italic)
+(defcustom apropos-label-face (if window-system 'italic)
   "*Face for label (Command, Variable ...) in apropos output or `nil'.
 If this is `nil' no mouse highlighting occurs.
 This looks good, but slows down the commands several times.
 When this is a face name, as it is initially, it gets transformed to a
-text-property list for efficiency.")
+text-property list for efficiency."
+  :group 'apropos
+  :type 'face)
 
-(defvar apropos-property-face (if window-system 'bold-italic)
+(defcustom apropos-property-face (if window-system 'bold-italic)
   "*Face for property name in apropos output or `nil'.  
-This looks good, but slows down the commands several times.")
+This looks good, but slows down the commands several times."
+  :group 'apropos
+  :type 'face)
 
-(defvar apropos-match-face (if window-system 'secondary-selection)
+(defcustom apropos-match-face (if window-system 'secondary-selection)
   "*Face for matching part in apropos-documentation/value output or `nil'.  
-This looks good, but slows down the commands several times.")
+This looks good, but slows down the commands several times."
+  :group 'apropos
+  :type 'face)
 
 
 (defvar apropos-mode-map
@@ -120,20 +138,25 @@ This looks good, but slows down the commands several times.")
   (setq major-mode 'apropos-mode
        mode-name "Apropos"))
 
+;;;###autoload
+(defun apropos-variable (regexp)
+  (interactive (list (read-string "Apropos variable (regexp): ")))
+  (apropos-command regexp nil t))
 
 ;; For auld lang syne:
 ;;;###autoload
 (fset 'command-apropos 'apropos-command)
 ;;;###autoload
-(defun apropos-command (apropos-regexp &optional do-all)
-  "Shows commands (interactively callable functions) that match REGEXP.
-With optional prefix ARG or if `apropos-do-all' is non-nil, also show
-variables."
-  (interactive (list (read-string (concat "Apropos command "
-                                         (if (or current-prefix-arg
-                                                 apropos-do-all)
-                                             "or variable ")
-                                         "(regexp): "))
+(defun apropos-command (apropos-regexp &optional do-all just-vars)
+  "Show commands (interactively callable functions) that match REGEXP.
+With optional prefix ARG, or if `apropos-do-all' is non-nil, also show
+variables.  If JUST-VARS is non-nil, show only variables."
+  (interactive (list (read-string (concat
+                                  "Apropos command "
+                                  (if (or current-prefix-arg
+                                          apropos-do-all)
+                                      "or variable ")
+                                  "(regexp): "))
                     current-prefix-arg))
   (let ((message
         (let ((standard-output (get-buffer-create "*Apropos*")))
@@ -144,7 +167,13 @@ variables."
                            (if do-all
                                (lambda (symbol) (or (commandp symbol)
                                                     (user-variable-p symbol)))
-                             'commandp)))
+                             (if just-vars 'user-variable-p
+                               'commandp))))
+    (let ((tem apropos-accumulator))
+      (while tem
+       (if (get (car tem) 'apropos-inhibit)
+           (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
+       (setq tem (cdr tem))))
     (if (apropos-print
         t
         (lambda (p)
@@ -152,10 +181,11 @@ variables."
             (while p
               (setcar p (list
                          (setq symbol (car p))
-                         (if (commandp symbol)
-                             (if (setq doc (documentation symbol t))
-                                 (substring doc 0 (string-match "\n" doc))
-                               "(not documented)"))
+                         (if (or do-all (not just-vars))
+                             (if (commandp symbol)
+                                 (if (setq doc (documentation symbol t))
+                                     (substring doc 0 (string-match "\n" doc))
+                                   "(not documented)")))
                          (and do-all
                               (user-variable-p symbol)
                               (if (setq doc (documentation-property
@@ -183,6 +213,11 @@ Returns list of symbols and documentation found."
                                     (boundp symbol)
                                     (facep symbol)
                                     (symbol-plist symbol))))))
+  (let ((tem apropos-accumulator))
+    (while tem
+      (if (get (car tem) 'apropos-inhibit)
+         (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
+      (setq tem (cdr tem))))
   (apropos-print
    (or do-all apropos-do-all)
    (lambda (p)
@@ -215,6 +250,12 @@ Returns list of symbols and documentation found."
                                     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))
@@ -529,14 +570,15 @@ found."
                               (if (apropos-macrop symbol)
                                   "Macro"
                                 "Function"))
-                            do-keys)
+                            t)
          (if (get symbol 'custom-type)
              (apropos-print-doc 'customize-variable-other-window 2
-                                "User Option" do-keys)
+                                "User Option" t)
            (apropos-print-doc 'describe-variable 2
-                              "Variable" do-keys))
-         (apropos-print-doc 'customize-face-other-window 5 "Face" do-keys)
-         (apropos-print-doc 'widget-browse-other-window 4 "Widget" do-keys)
+                              "Variable" t))
+         (apropos-print-doc 'customize-group-other-window 6 "Group" t)
+         (apropos-print-doc 'customize-face-other-window 5 "Face" t)
+         (apropos-print-doc 'widget-browse-other-window 4 "Widget" t)
          (apropos-print-doc 'apropos-describe-plist 3
                             "Plist" nil)))))
   (prog1 apropos-accumulator
@@ -618,4 +660,6 @@ found."
     (princ ")")
     (print-help-return-message)))
 
+(provide 'apropos)
+
 ;;; apropos.el ends here