Lines Matching defs:apropos
0 ;;; apropos.el --- apropos commands for users and programmers
34 ;; The idea for super-apropos is based on the original implementation
40 ;; Added super-apropos capability, changed print functions.
41 ;;; Made fast-apropos and super-apropos share code.
42 ;;; Sped up fast-apropos again.
43 ;; Added apropos-do-all option.
44 ;;; Added fast-command-apropos.
51 ;; Apropos-command (ex command-apropos) does cmd and optionally user var.
53 ;; Apropos-documentation (ex super-apropos) now finds all it should.
54 ;; New apropos-value snoops through all values and optionally plists.
64 (defgroup apropos nil
67 :prefix "apropos")
70 (defcustom apropos-do-all nil
71 "*Whether the apropos commands should do more.
74 :group 'apropos
78 (defcustom apropos-symbol-face 'bold
80 :group 'apropos
83 (defcustom apropos-keybinding-face 'underline
85 :group 'apropos
88 (defcustom apropos-label-face 'italic
92 :group 'apropos
95 (defcustom apropos-property-face 'bold-italic
96 "*Face for property name in apropos output, or nil for none."
97 :group 'apropos
100 (defcustom apropos-match-face 'match
104 :group 'apropos
107 (defcustom apropos-sort-by-scores nil
109 This applies to all `apropos' commands except `apropos-documentation'.
111 :group 'apropos
116 (defcustom apropos-documentation-sort-by-scores t
118 This applies to `apropos-documentation' only.
120 :group 'apropos
125 (defvar apropos-mode-map
128 ;; Use `apropos-follow' instead of just using the button
130 ;; apropos item, not just on top of a button.
131 (define-key map "\C-m" 'apropos-follow)
138 (defvar apropos-mode-hook nil
141 (defvar apropos-pattern nil
144 (defvar apropos-pattern-quoted nil
147 (defvar apropos-words ()
148 "Current list of apropos words extracted from `apropos-pattern'.")
150 (defvar apropos-all-words ()
153 (defvar apropos-regexp nil
154 "Regexp used in current apropos run.")
156 (defvar apropos-all-words-regexp nil
157 "Regexp matching apropos-all-words.")
159 (defvar apropos-files-scanned ()
160 "List of elc files already scanned in current run of `apropos-documentation'.")
162 (defvar apropos-accumulator ()
163 "Alist of symbols already found in current apropos run.")
165 (defvar apropos-item ()
166 "Current item in or for `apropos-accumulator'.")
168 (defvar apropos-synonyms '(
173 "List of synonyms known by apropos.
179 ;;; Button types used by apropos
181 (define-button-type 'apropos-symbol
182 'face apropos-symbol-face
185 'action #'apropos-symbol-button-display-help
188 (defun apropos-symbol-button-display-help (button)
189 "Display further help for the `apropos-symbol' button BUTTON."
191 (or (apropos-next-label-button (button-start button))
194 (define-button-type 'apropos-function
195 'apropos-label "Function"
199 (describe-function (button-get button 'apropos-symbol))))
201 (define-button-type 'apropos-macro
202 'apropos-label "Macro"
206 (describe-function (button-get button 'apropos-symbol))))
208 (define-button-type 'apropos-command
209 'apropos-label "Command"
213 (describe-function (button-get button 'apropos-symbol))))
220 (define-button-type 'apropos-variable
221 'apropos-label "Variable"
225 (describe-variable (button-get button 'apropos-symbol))))
227 (define-button-type 'apropos-face
228 'apropos-label "Face"
232 (describe-face (button-get button 'apropos-symbol))))
234 (define-button-type 'apropos-group
235 'apropos-label "Group"
240 (button-get button 'apropos-symbol))))
242 (define-button-type 'apropos-widget
243 'apropos-label "Widget"
247 (widget-browse-other-window (button-get button 'apropos-symbol))))
249 (define-button-type 'apropos-plist
250 'apropos-label "Plist"
254 (apropos-describe-plist (button-get button 'apropos-symbol))))
256 (defun apropos-next-label-button (pos)
257 "Return the next apropos label button after POS, or nil if there's none.
258 Will also return nil if more than one `apropos-symbol' button is encountered
262 (label (and button (button-get button 'apropos-label)))
266 (or (not (eq type 'apropos-symbol))
268 (when (eq type 'apropos-symbol)
272 (setq label (button-get button 'apropos-label))
278 (defun apropos-words-to-regexp (words wild)
291 (defun apropos-read-pattern (subject)
292 "Read an apropos pattern, either a word list or a regexp.
305 (defun apropos-parse-pattern (pattern)
308 This updates variables `apropos-pattern', `apropos-pattern-quoted',
309 `apropos-regexp', `apropos-words', and `apropos-all-words-regexp'."
310 (setq apropos-words nil
311 apropos-all-words nil)
319 (setq apropos-pattern (mapconcat 'identity pattern " ")
320 apropos-pattern-quoted (regexp-quote apropos-pattern))
322 (let ((syn apropos-synonyms) (s word) (a word))
331 (setq apropos-words (cons s apropos-words)
332 apropos-all-words (cons a apropos-all-words))))
333 (setq apropos-all-words-regexp
334 (apropos-words-to-regexp apropos-all-words ".+"))
335 (setq apropos-regexp
336 (apropos-words-to-regexp apropos-words ".*?")))
337 (setq apropos-pattern-quoted (regexp-quote pattern)
338 apropos-all-words-regexp pattern
339 apropos-pattern pattern
340 apropos-regexp pattern)))
343 (defun apropos-calc-scores (str words)
344 "Return apropos scores for string STR matching WORDS.
352 (and (string-match apropos-pattern str)
355 (defun apropos-score-str (str)
356 "Return apropos score for string STR."
360 (dolist (s (apropos-calc-scores str apropos-all-words) score)
364 (defun apropos-score-doc (doc)
365 "Return apropos score for documentation string DOC."
369 (when (setq i (string-match apropos-pattern-quoted doc))
371 (dolist (s (apropos-calc-scores doc apropos-all-words) score)
375 (defun apropos-score-symbol (symbol &optional weight)
376 "Return apropos score for SYMBOL."
380 (dolist (s (apropos-calc-scores symbol apropos-words) (* score (or weight 3)))
383 (defun apropos-true-hit (str words)
390 (> (length (apropos-calc-scores str words)) 1)))
392 (defun apropos-false-hit-symbol (symbol)
394 (not (apropos-true-hit (symbol-name symbol) apropos-words)))
396 (defun apropos-false-hit-str (str)
398 (not (apropos-true-hit str apropos-words)))
400 (defun apropos-true-hit-doc (doc)
402 (apropos-true-hit doc apropos-all-words))
404 (define-derived-mode apropos-mode fundamental-mode "Apropos"
405 "Major mode for following hyperlinks in output of apropos commands.
407 \\{apropos-mode-map}")
410 (defun apropos-variable (pattern &optional do-all)
417 With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show
419 (interactive (list (apropos-read-pattern
420 (if (or current-prefix-arg apropos-do-all)
423 (apropos-command pattern nil
424 (if (or do-all apropos-do-all)
432 (defalias 'command-apropos 'apropos-command)
434 (defun apropos-command (pattern &optional do-all var-predicate)
441 With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show
449 (interactive (list (apropos-read-pattern
450 (if (or current-prefix-arg apropos-do-all)
453 (apropos-parse-pattern pattern)
457 (or do-all (setq do-all apropos-do-all))
458 (setq apropos-accumulator
459 (apropos-internal apropos-regexp
462 (let ((tem apropos-accumulator))
464 (if (or (get (car tem) 'apropos-inhibit)
465 (apropos-false-hit-symbol (car tem)))
466 (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
468 (let ((p apropos-accumulator)
473 (setq score (apropos-score-symbol symbol))
478 (setq score (+ score (apropos-score-doc doc)))
486 (setq score (+ score (apropos-score-doc doc)))
491 (and (apropos-print t nil nil t)
497 (defun apropos-documentation-property (symbol property raw)
507 (defun apropos (pattern &optional do-all)
517 With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil,
521 (interactive (list (apropos-read-pattern "symbol")
523 (apropos-parse-pattern pattern)
524 (apropos-symbols-internal
525 (apropos-internal apropos-regexp
527 (not apropos-do-all)
533 (or do-all apropos-do-all)))
535 (defun apropos-symbols-internal (symbols keys &optional text)
536 ;; Filter out entries that are marked as apropos-inhibit.
539 (unless (get symbol 'apropos-inhibit)
542 (let ((apropos-accumulator
548 (apropos-score-symbol symbol)
559 (apropos-documentation-property
567 (apropos-documentation-property
570 (apropos-documentation-property
573 (apropos-documentation-property
576 (apropos-print keys nil text)))
580 (defun apropos-value (pattern &optional do-all)
587 With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also looks
590 (interactive (list (apropos-read-pattern "value")
592 (apropos-parse-pattern pattern)
593 (or do-all (setq do-all apropos-do-all))
594 (setq apropos-accumulator ())
599 (or (memq symbol '(apropos-regexp
600 apropos-pattern apropos-all-words-regexp
601 apropos-words apropos-all-words
602 do-all apropos-accumulator
604 (setq v (apropos-value-internal 'boundp symbol 'symbol-value)))
606 (setq f (apropos-value-internal 'fboundp symbol 'symbol-function)
607 p (apropos-format-plist symbol "\n " t)))
608 (if (apropos-false-hit-str v)
610 (if (apropos-false-hit-str f)
612 (if (apropos-false-hit-str p)
615 (setq apropos-accumulator (cons (list symbol
616 (+ (apropos-score-str f)
617 (apropos-score-str v)
618 (apropos-score-str p))
620 apropos-accumulator))))))
621 (apropos-print nil "\n----------------\n"))
625 (defun apropos-documentation (pattern &optional do-all)
632 With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also use
636 (interactive (list (apropos-read-pattern "documentation")
638 (apropos-parse-pattern pattern)
639 (or do-all (setq do-all apropos-do-all))
640 (setq apropos-accumulator () apropos-files-scanned ())
641 (let ((standard-input (get-buffer-create " apropos-temp"))
642 (apropos-sort-by-scores apropos-documentation-sort-by-scores)
647 (apropos-documentation-check-doc-file)
651 (setq f (apropos-safe-documentation symbol)
654 (setq f (apropos-documentation-internal f)
655 v (apropos-documentation-internal v))
656 (setq sf (apropos-score-doc f)
657 sv (apropos-score-doc v))
659 (if (setq apropos-item
660 (cdr (assq symbol apropos-accumulator)))
664 (setcar (nthcdr 1 apropos-item) f)
665 (setcar apropos-item (+ (car apropos-item) sf))))
668 (setcar (nthcdr 2 apropos-item) v)
669 (setcar apropos-item (+ (car apropos-item) sv)))))
670 (setq apropos-accumulator
672 (+ (apropos-score-symbol symbol 2) sf sv)
674 apropos-accumulator)))))))
675 (apropos-print nil "\n----------------\n" nil t))
680 (defun apropos-value-internal (predicate symbol function)
684 (if (string-match apropos-regexp symbol)
686 (if apropos-match-face
688 'face apropos-match-face
692 (defun apropos-documentation-internal (doc)
694 (apropos-documentation-check-elc-file (car doc))
696 (string-match apropos-all-words-regexp doc)
697 (apropos-true-hit-doc doc))
698 (when apropos-match-face
700 (if (or (string-match apropos-pattern-quoted doc)
701 (string-match apropos-all-words-regexp doc))
704 'face apropos-match-face doc))
707 (defun apropos-format-plist (pl sep &optional compare)
712 (if (or (not compare) (string-match apropos-regexp p))
713 (if apropos-property-face
715 'face apropos-property-face p))
719 (and compare apropos-match-face
721 'face apropos-match-face
730 (defun apropos-documentation-check-doc-file ()
742 (re-search-forward apropos-all-words-regexp nil t))
750 (when (apropos-true-hit-doc doc)
751 (or (and (setq apropos-item (assq symbol apropos-accumulator))
752 (setcar (cdr apropos-item)
753 (apropos-score-doc doc)))
754 (setq apropos-item (list symbol
755 (+ (apropos-score-symbol symbol 2)
756 (apropos-score-doc doc))
758 apropos-accumulator (cons apropos-item
759 apropos-accumulator)))
760 (when apropos-match-face
762 (if (or (string-match apropos-pattern-quoted doc)
763 (string-match apropos-all-words-regexp doc))
766 'face apropos-match-face doc)))
767 (setcar (nthcdr type apropos-item) doc))))
770 (defun apropos-documentation-check-elc-file (file)
771 (if (member file apropos-files-scanned)
774 (setq apropos-files-scanned (cons file apropos-files-scanned))
786 (re-search-forward apropos-all-words-regexp nil t))
792 (when (apropos-true-hit-doc doc)
803 (and (fboundp symbol) (apropos-safe-documentation symbol)))
805 (or (and (setq apropos-item (assq symbol apropos-accumulator))
806 (setcar (cdr apropos-item)
807 (+ (cadr apropos-item) (apropos-score-doc doc))))
808 (setq apropos-item (list symbol
809 (+ (apropos-score-symbol symbol 2)
810 (apropos-score-doc doc))
812 apropos-accumulator (cons apropos-item
813 apropos-accumulator)))
814 (when apropos-match-face
816 (if (or (string-match apropos-pattern-quoted doc)
817 (string-match apropos-all-words-regexp doc))
820 'face apropos-match-face doc)))
822 apropos-item)
827 (defun apropos-safe-documentation (function)
850 (defun apropos-print (do-keys spacing &optional text nosubst)
851 "Output result of apropos searching into buffer `*Apropos*'.
852 The value of `apropos-accumulator' is the list of items to output.
855 The return value is the list that was in `apropos-accumulator', sorted
857 `apropos-accumulator' to nil before returning.
861 (if (null apropos-accumulator)
862 (message "No apropos matches for `%s'" apropos-pattern)
863 (setq apropos-accumulator
864 (sort apropos-accumulator
868 (if apropos-sort-by-scores
874 (let ((p apropos-accumulator)
878 (apropos-mode)
888 "and type \\[apropos-follow] to get full documentation.\n\n"))
893 (setq apropos-item (car p)
894 symbol (car apropos-item)
897 ;; apropos-item format.
898 (if (not (numberp (cadr apropos-item)))
899 (setq apropos-item
900 (cons (car apropos-item)
901 (cons nil (cdr apropos-item)))))
903 'type 'apropos-symbol
907 'face apropos-symbol-face)
908 (if (and (eq apropos-sort-by-scores 'verbose)
909 (cadr apropos-item))
910 (insert " (" (number-to-string (cadr apropos-item)) ") "))
943 (if apropos-keybinding-face
945 'face apropos-keybinding-face
950 (when apropos-keybinding-face
952 'face apropos-keybinding-face)
954 'face apropos-keybinding-face))))
956 (apropos-print-doc 2
958 'apropos-command
959 (if (apropos-macrop symbol)
960 'apropos-macro
961 'apropos-function))
963 (apropos-print-doc 3 'apropos-variable (not nosubst))
964 (apropos-print-doc 7 'apropos-group t)
965 (apropos-print-doc 6 'apropos-face t)
966 (apropos-print-doc 5 'apropos-widget t)
967 (apropos-print-doc 4 'apropos-plist nil))
969 (prog1 apropos-accumulator
970 (setq apropos-accumulator ()))) ; permit gc
973 (defun apropos-macrop (symbol)
984 (defun apropos-print-doc (i type do-keys)
985 (if (stringp (setq i (nth i apropos-item)))
988 (insert-text-button (button-type-get type 'apropos-label)
993 'face apropos-label-face
994 'apropos-symbol (car apropos-item))
1000 (defun apropos-follow ()
1004 (or (apropos-next-label-button (line-beginning-position))
1008 (defun apropos-describe-plist (symbol)
1010 (help-setup-xref (list 'apropos-describe-plist symbol) (interactive-p))
1016 (if apropos-symbol-face
1018 'face apropos-symbol-face))
1019 (insert (apropos-format-plist symbol "\n "))
1024 (provide 'apropos)
1027 ;;; apropos.el ends here