apropos.el 43.4 KB
Newer Older
1
;;; apropos.el --- apropos commands for users and programmers
Eric S. Raymond's avatar
Eric S. Raymond committed
2

3
;; Copyright (C) 1989, 1994-1995, 2001-2014 Free Software Foundation,
4
;; Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
5

Eric S. Raymond's avatar
Eric S. Raymond committed
6
;; Author: Joe Wells <jbw@bigbird.bu.edu>
Glenn Morris's avatar
Glenn Morris committed
7
;;	Daniel Pfeiffer <occitan@esperanto.org> (rewrite)
Eric S. Raymond's avatar
Eric S. Raymond committed
8
;; Keywords: help
9
;; Package: emacs
Eric S. Raymond's avatar
Eric S. Raymond committed
10

Richard M. Stallman's avatar
Richard M. Stallman committed
11 12
;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
17 18 19 20 21 22 23

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
25

Eric S. Raymond's avatar
Eric S. Raymond committed
26
;;; Commentary:
Richard M. Stallman's avatar
Richard M. Stallman committed
27 28 29 30 31 32 33 34 35 36 37 38 39

;; The ideas for this package were derived from the C code in
;; src/keymap.c and elsewhere.  The functions in this file should
;; always be byte-compiled for speed.  Someone should rewrite this in
;; C (as part of src/keymap.c) for speed.

;; The idea for super-apropos is based on the original implementation
;; by Lynn Slater <lrs@esl.com>.

;; History:
;; Fixed bug, current-local-map can return nil.
;; Change, doesn't calculate key-bindings unless needed.
;; Added super-apropos capability, changed print functions.
Stefan Monnier's avatar
Stefan Monnier committed
40 41
;; Made fast-apropos and super-apropos share code.
;; Sped up fast-apropos again.
Richard M. Stallman's avatar
Richard M. Stallman committed
42
;; Added apropos-do-all option.
Stefan Monnier's avatar
Stefan Monnier committed
43
;; Added fast-command-apropos.
Richard M. Stallman's avatar
Richard M. Stallman committed
44
;; Changed doc strings to comments for helping functions.
Stefan Monnier's avatar
Stefan Monnier committed
45
;; Made doc file buffer read-only, buried it.
Richard M. Stallman's avatar
Richard M. Stallman committed
46 47
;; Only call substitute-command-keys if do-all set.

48 49
;; Optionally use configurable faces to make the output more legible.
;; Differentiate between command, function and macro.
50 51 52 53 54 55 56 57
;; Apropos-command (ex command-apropos) does cmd and optionally user var.
;; Apropos shows all 3 aspects of symbols (fn, var and plist)
;; Apropos-documentation (ex super-apropos) now finds all it should.
;; New apropos-value snoops through all values and optionally plists.
;; Reading DOC file doesn't load nroff.
;; Added hypertext following of documentation, mouse-2 on variable gives value
;;   from buffer in active window.

Eric S. Raymond's avatar
Eric S. Raymond committed
58 59
;;; Code:

Miles Bader's avatar
Miles Bader committed
60 61
(require 'button)

Richard M. Stallman's avatar
Richard M. Stallman committed
62
(defgroup apropos nil
63
  "Apropos commands for users and programmers."
64
  :group 'help
Richard M. Stallman's avatar
Richard M. Stallman committed
65 66
  :prefix "apropos")

67
;; I see a degradation of maybe 10-20% only.
Richard M. Stallman's avatar
Richard M. Stallman committed
68
(defcustom apropos-do-all nil
Glenn Morris's avatar
Glenn Morris committed
69 70 71
  "Non nil means apropos commands will search more extensively.
This may be slower.  This option affects the following commands:

72
`apropos-user-option' will search all variables, not just user options.
Glenn Morris's avatar
Glenn Morris committed
73 74 75 76 77 78 79 80 81 82 83 84
`apropos-command' will also search non-interactive functions.
`apropos' will search all symbols, not just functions, variables, faces,
and those with property lists.
`apropos-value' will also search in property lists and functions.
`apropos-documentation' will search all documentation strings, not just
those in the etc/DOC documentation file.

This option only controls the default behavior.  Each of the above
commands also has an optional argument to request a more extensive search.

Additionally, this option makes the function `apropos-library'
include key-binding information in its output."
Richard M. Stallman's avatar
Richard M. Stallman committed
85 86
  :group 'apropos
  :type 'boolean)
87

Chong Yidong's avatar
Chong Yidong committed
88 89 90 91
(defface apropos-symbol
  '((t (:inherit bold)))
  "Face for the symbol name in Apropos output."
  :group 'apropos
92
  :version "24.3")
93

Chong Yidong's avatar
Chong Yidong committed
94 95 96
(defface apropos-keybinding
  '((t (:inherit underline)))
  "Face for lists of keybinding in Apropos output."
Richard M. Stallman's avatar
Richard M. Stallman committed
97
  :group 'apropos
98
  :version "24.3")
99

Chong Yidong's avatar
Chong Yidong committed
100 101
(defface apropos-property
  '((t (:inherit font-lock-builtin-face)))
Juanma Barranquero's avatar
Juanma Barranquero committed
102
  "Face for property name in Apropos output, or nil for none."
Richard M. Stallman's avatar
Richard M. Stallman committed
103
  :group 'apropos
104
  :version "24.3")
105

Chong Yidong's avatar
Chong Yidong committed
106 107 108
(defface apropos-function-button
  '((t (:inherit (font-lock-function-name-face button))))
  "Button face indicating a function, macro, or command in Apropos."
Richard M. Stallman's avatar
Richard M. Stallman committed
109
  :group 'apropos
110
  :version "24.3")
111

Chong Yidong's avatar
Chong Yidong committed
112 113 114
(defface apropos-variable-button
  '((t (:inherit (font-lock-variable-name-face button))))
  "Button face indicating a variable in Apropos."
Richard M. Stallman's avatar
Richard M. Stallman committed
115
  :group 'apropos
116
  :version "24.3")
Chong Yidong's avatar
Chong Yidong committed
117

118 119 120 121 122 123
(defface apropos-user-option-button
  '((t (:inherit (font-lock-variable-name-face button))))
  "Button face indicating a user option in Apropos."
  :group 'apropos
  :version "24.4")

Chong Yidong's avatar
Chong Yidong committed
124 125 126 127
(defface apropos-misc-button
  '((t (:inherit (font-lock-constant-face button))))
  "Button face indicating a miscellaneous object type in Apropos."
  :group 'apropos
128
  :version "24.3")
129

130
(defcustom apropos-match-face 'match
131
  "Face for matching text in Apropos documentation/value, or nil for none.
132
This applies when you look for matches in the documentation or variable value
Kim F. Storm's avatar
Kim F. Storm committed
133
for the pattern; the part that matches gets displayed in this font."
134
  :type '(choice (const nil) face)
Richard M. Stallman's avatar
Richard M. Stallman committed
135
  :group 'apropos
136
  :version "24.3")
137

138
(defcustom apropos-sort-by-scores nil
139
  "Non-nil means sort matches by scores; best match is shown first.
Kim F. Storm's avatar
Kim F. Storm committed
140 141
This applies to all `apropos' commands except `apropos-documentation'.
If value is `verbose', the computed score is shown for each match."
142
  :group 'apropos
Kim F. Storm's avatar
Kim F. Storm committed
143 144 145 146 147
  :type '(choice (const :tag "off" nil)
		 (const :tag "on" t)
		 (const :tag "show scores" verbose)))

(defcustom apropos-documentation-sort-by-scores t
Lute Kamstra's avatar
Lute Kamstra committed
148
  "Non-nil means sort matches by scores; best match is shown first.
Kim F. Storm's avatar
Kim F. Storm committed
149 150 151 152 153 154
This applies to `apropos-documentation' only.
If value is `verbose', the computed score is shown for each match."
  :group 'apropos
  :type '(choice (const :tag "off" nil)
		 (const :tag "on" t)
		 (const :tag "show scores" verbose)))
Richard M. Stallman's avatar
Richard M. Stallman committed
155

156
(defvar apropos-mode-map
157 158
  (let ((map (copy-keymap button-buffer-map)))
    (set-keymap-parent map special-mode-map)
159 160 161
    ;; Use `apropos-follow' instead of just using the button
    ;; definition of RET, so that users can use it anywhere in an
    ;; apropos item, not just on top of a button.
162 163
    (define-key map "\C-m" 'apropos-follow)
    map)
164
  "Keymap used in Apropos mode.")
165

Gerd Moellmann's avatar
Gerd Moellmann committed
166
(defvar apropos-mode-hook nil
167
  "Hook run when mode is turned on.")
168

169
(defvar apropos-pattern nil
Kim F. Storm's avatar
Kim F. Storm committed
170 171 172
  "Apropos pattern as entered by user.")

(defvar apropos-pattern-quoted nil
173
  "Apropos pattern passed through `regexp-quote'.")
Kim F. Storm's avatar
Kim F. Storm committed
174 175 176

(defvar apropos-words ()
  "Current list of apropos words extracted from `apropos-pattern'.")
177

Kim F. Storm's avatar
Kim F. Storm committed
178 179
(defvar apropos-all-words ()
  "Current list of words and synonyms.")
180

Kim F. Storm's avatar
Kim F. Storm committed
181 182 183 184
(defvar apropos-regexp nil
  "Regexp used in current apropos run.")

(defvar apropos-all-words-regexp nil
Juanma Barranquero's avatar
Juanma Barranquero committed
185
  "Regexp matching `apropos-all-words'.")
186

187
(defvar apropos-files-scanned ()
Karl Heuer's avatar
Karl Heuer committed
188
  "List of elc files already scanned in current run of `apropos-documentation'.")
189 190

(defvar apropos-accumulator ()
191 192 193 194 195 196 197 198 199 200 201
  "Alist of symbols already found in current apropos run.
Each element has the form

  (SYMBOL SCORE FUN-DOC VAR-DOC PLIST WIDGET-DOC FACE-DOC CUS-GROUP-DOC)

where SYMBOL is the symbol name, SCORE is its relevance score (a
number), FUN-DOC is the function docstring, VAR-DOC is the
variable docstring, PLIST is the list of the symbols names in the
property list, WIDGET-DOC is the widget docstring, FACE-DOC is
the face docstring, and CUS-GROUP-DOC is the custom group
docstring.  Each docstring is either nil or a string.")
202

203
(defvar apropos-item ()
Dave Love's avatar
Dave Love committed
204
  "Current item in or for `apropos-accumulator'.")
205

206 207 208
(defvar apropos-synonyms '(
  ("find" "open" "edit")
  ("kill" "cut")
209 210
  ("yank" "paste")
  ("region" "selection"))
211
  "List of synonyms known by apropos.
212
Each element is a list of words where the first word is the standard Emacs
213 214
term, and the rest of the words are alternative terms.")

215 216 217 218

;;; Button types used by apropos

(define-button-type 'apropos-symbol
Chong Yidong's avatar
Chong Yidong committed
219
  'face 'apropos-symbol
220
  'help-echo "mouse-2, RET: Display more help on this symbol"
221
  'follow-link t
222
  'action #'apropos-symbol-button-display-help)
223 224 225 226 227 228 229

(defun apropos-symbol-button-display-help (button)
  "Display further help for the `apropos-symbol' button BUTTON."
  (button-activate
   (or (apropos-next-label-button (button-start button))
       (error "There is nothing to follow for `%s'" (button-label button)))))

230 231
(define-button-type 'apropos-function
  'apropos-label "Function"
232
  'apropos-short-label "f"
Chong Yidong's avatar
Chong Yidong committed
233
  'face 'apropos-function-button
234 235
  'help-echo "mouse-2, RET: Display more help on this function"
  'follow-link t
236
  'action (lambda (button)
237 238
	    (describe-function (button-get button 'apropos-symbol))))

239 240
(define-button-type 'apropos-macro
  'apropos-label "Macro"
241
  'apropos-short-label "m"
Chong Yidong's avatar
Chong Yidong committed
242
  'face 'apropos-function-button
243 244
  'help-echo "mouse-2, RET: Display more help on this macro"
  'follow-link t
245
  'action (lambda (button)
246 247
	    (describe-function (button-get button 'apropos-symbol))))

248 249
(define-button-type 'apropos-command
  'apropos-label "Command"
250
  'apropos-short-label "c"
Chong Yidong's avatar
Chong Yidong committed
251
  'face 'apropos-function-button
252 253
  'help-echo "mouse-2, RET: Display more help on this command"
  'follow-link t
254
  'action (lambda (button)
255
	    (describe-function (button-get button 'apropos-symbol))))
Pavel Janík's avatar
Pavel Janík committed
256

257 258 259 260 261 262 263
;; We used to use `customize-variable-other-window' instead for a
;; customizable variable, but that is slow.  It is better to show an
;; ordinary help buffer and let the user click on the customization
;; button in that buffer, if he wants to.
;; Likewise for `customize-face-other-window'.
(define-button-type 'apropos-variable
  'apropos-label "Variable"
264
  'apropos-short-label "v"
Chong Yidong's avatar
Chong Yidong committed
265
  'face 'apropos-variable-button
266
  'help-echo "mouse-2, RET: Display more help on this variable"
267
  'follow-link t
268 269 270
  'action (lambda (button)
	    (describe-variable (button-get button 'apropos-symbol))))

271 272 273 274 275 276 277 278 279
(define-button-type 'apropos-user-option
  'apropos-label "User option"
  'apropos-short-label "o"
  'face 'apropos-user-option-button
  'help-echo "mouse-2, RET: Display more help on this user option"
  'follow-link t
  'action (lambda (button)
	    (describe-variable (button-get button 'apropos-symbol))))

280 281
(define-button-type 'apropos-face
  'apropos-label "Face"
282
  'apropos-short-label "F"
283
  'face '(font-lock-variable-name-face button)
284
  'help-echo "mouse-2, RET: Display more help on this face"
285
  'follow-link t
286 287 288 289 290
  'action (lambda (button)
	    (describe-face (button-get button 'apropos-symbol))))

(define-button-type 'apropos-group
  'apropos-label "Group"
291
  'apropos-short-label "g"
Chong Yidong's avatar
Chong Yidong committed
292
  'face 'apropos-misc-button
293
  'help-echo "mouse-2, RET: Display more help on this group"
294
  'follow-link t
295
  'action (lambda (button)
296
	    (customize-group-other-window
297 298 299 300
	     (button-get button 'apropos-symbol))))

(define-button-type 'apropos-widget
  'apropos-label "Widget"
301
  'apropos-short-label "w"
Chong Yidong's avatar
Chong Yidong committed
302
  'face 'apropos-misc-button
303
  'help-echo "mouse-2, RET: Display more help on this widget"
304
  'follow-link t
305 306 307 308
  'action (lambda (button)
	    (widget-browse-other-window (button-get button 'apropos-symbol))))

(define-button-type 'apropos-plist
309
  'apropos-label "Properties"
310
  'apropos-short-label "p"
Chong Yidong's avatar
Chong Yidong committed
311
  'face 'apropos-misc-button
312
  'help-echo "mouse-2, RET: Display more help on this plist"
313
  'follow-link t
314 315
  'action (lambda (button)
	    (apropos-describe-plist (button-get button 'apropos-symbol))))
316

317 318 319 320 321 322
(define-button-type 'apropos-library
  'help-echo "mouse-2, RET: Display more help on this library"
  'follow-link t
  'action (lambda (button)
	    (apropos-library (button-get button 'apropos-symbol))))

323
(defun apropos-next-label-button (pos)
324
  "Return the next apropos label button after POS, or nil if there's none.
325 326
Will also return nil if more than one `apropos-symbol' button is encountered
before finding a label."
327
  (let* ((button (next-button pos t))
328
	 (already-hit-symbol nil)
329 330
	 (label (and button (button-get button 'apropos-label)))
	 (type (and button (button-get button 'type))))
331
    (while (and button
332 333
		(not label)
		(or (not (eq type 'apropos-symbol))
334
		    (not already-hit-symbol)))
335
      (when (eq type 'apropos-symbol)
336 337 338
	(setq already-hit-symbol t))
      (setq button (next-button (button-start button)))
      (when button
339 340 341
	(setq label (button-get button 'apropos-label))
	(setq type (button-get button 'type))))
    (and label button)))
342

343

344
(defun apropos-words-to-regexp (words wild)
345 346 347 348 349 350 351 352 353 354 355 356 357 358 359
  "Make regexp matching any two of the words in WORDS.
WILD should be a subexpression matching wildcards between matches."
  (setq words (delete-dups (copy-sequence words)))
  (if (null (cdr words))
      (car words)
    (mapconcat
     (lambda (w)
       (concat "\\(?:" w "\\)" ;; parens for synonyms
               wild "\\(?:"
               (mapconcat 'identity
			  (delq w (copy-sequence words))
			  "\\|")
               "\\)"))
     words
     "\\|")))
360

Kim F. Storm's avatar
Kim F. Storm committed
361 362 363 364 365 366 367 368 369
;;;###autoload
(defun apropos-read-pattern (subject)
  "Read an apropos pattern, either a word list or a regexp.
Returns the user pattern, either a list of words which are matched
literally, or a string which is used as a regexp to search for.

SUBJECT is a string that is included in the prompt to identify what
kind of objects to search."
  (let ((pattern
370
	 (read-string (concat "Search for " subject " (word list or regexp): "))))
Kim F. Storm's avatar
Kim F. Storm committed
371 372
    (if (string-equal (regexp-quote pattern) pattern)
	;; Split into words
373 374
	(or (split-string pattern "[ \t]+" t)
	    (user-error "No word list given"))
Kim F. Storm's avatar
Kim F. Storm committed
375 376 377 378
      pattern)))

(defun apropos-parse-pattern (pattern)
  "Rewrite a list of words to a regexp matching all permutations.
379 380 381
If PATTERN is a string, that means it is already a regexp.
This updates variables `apropos-pattern', `apropos-pattern-quoted',
`apropos-regexp', `apropos-words', and `apropos-all-words-regexp'."
Kim F. Storm's avatar
Kim F. Storm committed
382 383 384
  (setq apropos-words nil
	apropos-all-words nil)
  (if (consp pattern)
385 386 387 388 389
      ;; We don't actually make a regexp matching all permutations.
      ;; Instead, for e.g. "a b c", we make a regexp matching
      ;; any combination of two or more words like this:
      ;; (a|b|c).*(a|b|c) which may give some false matches,
      ;; but as long as it also gives the right ones, that's ok.
Kim F. Storm's avatar
Kim F. Storm committed
390 391 392
      (let ((words pattern))
	(setq apropos-pattern (mapconcat 'identity pattern " ")
	      apropos-pattern-quoted (regexp-quote apropos-pattern))
393 394 395 396 397 398 399 400 401 402 403 404
	(dolist (word words)
	  (let ((syn apropos-synonyms) (s word) (a word))
	    (while syn
	      (if (member word (car syn))
		  (progn
		    (setq a (mapconcat 'identity (car syn) "\\|"))
		    (if (member word (cdr (car syn)))
			(setq s a))
		    (setq syn nil))
		(setq syn (cdr syn))))
	    (setq apropos-words (cons s apropos-words)
		  apropos-all-words (cons a apropos-all-words))))
405 406 407 408
	(setq apropos-all-words-regexp
	      (apropos-words-to-regexp apropos-all-words ".+"))
	(setq apropos-regexp
	      (apropos-words-to-regexp apropos-words ".*?")))
Kim F. Storm's avatar
Kim F. Storm committed
409 410
    (setq apropos-pattern-quoted (regexp-quote pattern)
	  apropos-all-words-regexp pattern
411 412
	  apropos-pattern pattern
	  apropos-regexp pattern)))
Kim F. Storm's avatar
Kim F. Storm committed
413

414 415 416
(defun apropos-calc-scores (str words)
  "Return apropos scores for string STR matching WORDS.
Value is a list of offsets of the words into the string."
Kim F. Storm's avatar
Kim F. Storm committed
417
  (let (scores i)
418 419 420 421 422
    (if words
	(dolist (word words scores)
	  (if (setq i (string-match word str))
	      (setq scores (cons i scores))))
      ;; Return list of start and end position of regexp
423
      (and (string-match apropos-pattern str)
Kim F. Storm's avatar
Kim F. Storm committed
424
	   (list (match-beginning 0) (match-end 0))))))
425 426 427 428

(defun apropos-score-str (str)
  "Return apropos score for string STR."
  (if str
Kim F. Storm's avatar
Kim F. Storm committed
429 430
      (let* ((l (length str))
	     (score (- (/ l 10))))
431
	(dolist (s (apropos-calc-scores str apropos-all-words) score)
432
	  (setq score (+ score 1000 (/ (* (- l s) 1000) l)))))
433 434 435 436
      0))

(defun apropos-score-doc (doc)
  "Return apropos score for documentation string DOC."
437 438
  (let ((l (length doc)))
    (if (> l 0)
439 440
	(let ((score 0))
	  (when (string-match apropos-pattern-quoted doc)
Kim F. Storm's avatar
Kim F. Storm committed
441
	    (setq score 10000))
442 443 444
	  (dolist (s (apropos-calc-scores doc apropos-all-words) score)
	    (setq score (+ score 50 (/ (* (- l s) 50) l)))))
      0)))
445

446 447 448 449
(defun apropos-score-symbol (symbol &optional weight)
  "Return apropos score for SYMBOL."
  (setq symbol (symbol-name symbol))
  (let ((score 0)
Kim F. Storm's avatar
Kim F. Storm committed
450
	(l (length symbol)))
451 452 453
    (dolist (s (apropos-calc-scores symbol apropos-words) (* score (or weight 3)))
      (setq score (+ score (- 60 l) (/ (* (- l s) 60) l))))))

454 455 456
(defun apropos-true-hit (str words)
  "Return t if STR is a genuine hit.
This may fail if only one of the keywords is matched more than once.
Juanma Barranquero's avatar
Juanma Barranquero committed
457
This requires at least two keywords (unless only one was given)."
458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474
  (or (not str)
      (not words)
      (not (cdr words))
      (> (length (apropos-calc-scores str words)) 1)))

(defun apropos-false-hit-symbol (symbol)
  "Return t if SYMBOL is not really matched by the current keywords."
  (not (apropos-true-hit (symbol-name symbol) apropos-words)))

(defun apropos-false-hit-str (str)
  "Return t if STR is not really matched by the current keywords."
  (not (apropos-true-hit str apropos-words)))

(defun apropos-true-hit-doc (doc)
  "Return t if DOC is really matched by the current keywords."
  (apropos-true-hit doc apropos-all-words))

475
(define-derived-mode apropos-mode special-mode "Apropos"
476 477
  "Major mode for following hyperlinks in output of apropos commands.

478
\\{apropos-mode-map}")
479

480 481 482 483
(defvar apropos-multi-type t
  "If non-nil, this apropos query concerns multiple types.
This is used to decide whether to print the result's type or not.")

484
;;;###autoload
485 486
(defun apropos-user-option (pattern &optional do-all)
  "Show user options that match PATTERN.
Kim F. Storm's avatar
Kim F. Storm committed
487 488 489 490 491 492
PATTERN can be a word, a list of words (separated by spaces),
or a regexp (using some regexp special characters).  If it is a word,
search for matches for that word as a substring.  If it is a list of words,
search for matches for any two (or more) of those words.

With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show
493
variables, not just user options."
Kim F. Storm's avatar
Kim F. Storm committed
494 495 496
  (interactive (list (apropos-read-pattern
		      (if (or current-prefix-arg apropos-do-all)
			  "variable" "user option"))
497
                     current-prefix-arg))
Kim F. Storm's avatar
Kim F. Storm committed
498
  (apropos-command pattern nil
499
		   (if (or do-all apropos-do-all)
500 501 502
		       #'(lambda (symbol)
			   (and (boundp symbol)
				(get symbol 'variable-documentation)))
503
		     'custom-variable-p)))
504

505 506 507
;;;###autoload
(defun apropos-variable (pattern &optional do-not-all)
  "Show variables that match PATTERN.
Juanma Barranquero's avatar
Juanma Barranquero committed
508
When DO-NOT-ALL is non-nil, show user options only, i.e. behave
509 510 511 512 513 514 515
like `apropos-user-option'."
  (interactive (list (apropos-read-pattern
		      (if current-prefix-arg "user option" "variable"))
                     current-prefix-arg))
  (let ((apropos-do-all (if do-not-all nil t)))
    (apropos-user-option pattern)))

516 517
;; For auld lang syne:
;;;###autoload
518
(defalias 'command-apropos 'apropos-command)
Richard M. Stallman's avatar
Richard M. Stallman committed
519
;;;###autoload
Kim F. Storm's avatar
Kim F. Storm committed
520 521 522
(defun apropos-command (pattern &optional do-all var-predicate)
  "Show commands (interactively callable functions) that match PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
523 524 525 526
or a regexp (using some regexp special characters).  If it is a word,
search for matches for that word as a substring.  If it is a list of words,
search for matches for any two (or more) of those words.

Kim F. Storm's avatar
Kim F. Storm committed
527
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show
528
noninteractive functions.
529

530
If VAR-PREDICATE is non-nil, show only variables, and only those that
Kim F. Storm's avatar
Kim F. Storm committed
531 532 533 534 535 536 537
satisfy the predicate VAR-PREDICATE.

When called from a Lisp program, a string PATTERN is used as a regexp,
while a list of strings is used as a word list."
  (interactive (list (apropos-read-pattern
		      (if (or current-prefix-arg apropos-do-all)
			  "command or function" "command"))
538
		     current-prefix-arg))
539
  (apropos-parse-pattern pattern)
540
  (let ((message
541
	 (let ((standard-output (get-buffer-create "*Apropos*")))
542
	   (help-print-return-message 'identity))))
543 544
    (or do-all (setq do-all apropos-do-all))
    (setq apropos-accumulator
Kim F. Storm's avatar
Kim F. Storm committed
545
	  (apropos-internal apropos-regexp
546
			    (or var-predicate
547 548 549 550
                                ;; We used to use `functionp' here, but this
                                ;; rules out macros.  `fboundp' rules in
                                ;; keymaps, but it seems harmless.
				(if do-all 'fboundp 'commandp))))
551 552
    (let ((tem apropos-accumulator))
      (while tem
553 554
	(if (or (get (car tem) 'apropos-inhibit)
		(apropos-false-hit-symbol (car tem)))
555 556
	    (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
	(setq tem (cdr tem))))
557
    (let ((p apropos-accumulator)
558
	  doc symbol score)
559 560 561
      (while p
	(setcar p (list
		   (setq symbol (car p))
562
		   (setq score (apropos-score-symbol symbol))
563
		   (unless var-predicate
564
		     (if (fboundp symbol)
565 566 567 568 569 570
			 (if (setq doc (condition-case nil
                                           (documentation symbol t)
                                         (error 'error)))
                             ;; Eg alias to undefined function.
                             (if (eq doc 'error)
                                 "(documentation error)"
571
			       (setq score (+ score (apropos-score-doc doc)))
572
			       (substring doc 0 (string-match "\n" doc)))
573 574 575 576 577
			   "(not documented)")))
		   (and var-predicate
			(funcall var-predicate symbol)
			(if (setq doc (documentation-property
				       symbol 'variable-documentation t))
578 579 580 581 582
			     (progn
			       (setq score (+ score (apropos-score-doc doc)))
			       (substring doc 0
					  (string-match "\n" doc)))))))
	(setcar (cdr (car p)) score)
583
	(setq p (cdr p))))
584 585
    (and (let ((apropos-multi-type do-all))
           (apropos-print t nil nil t))
586
	 message
Deepak Goel's avatar
Deepak Goel committed
587
	 (message "%s" message))))
588 589 590


;;;###autoload
591 592 593 594 595 596 597 598
(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)")))

599 600

;;;###autoload
Kim F. Storm's avatar
Kim F. Storm committed
601
(defun apropos (pattern &optional do-all)
602 603 604 605
  "Show all meaningful Lisp symbols whose names match PATTERN.
Symbols are shown if they are defined as functions, variables, or
faces, or if they have nonempty property lists.

Kim F. Storm's avatar
Kim F. Storm committed
606
PATTERN can be a word, a list of words (separated by spaces),
607 608 609 610
or a regexp (using some regexp special characters).  If it is a word,
search for matches for that word as a substring.  If it is a list of words,
search for matches for any two (or more) of those words.

Richard M. Stallman's avatar
Richard M. Stallman committed
611 612 613 614
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil,
consider all symbols (if they match PATTERN).

Returns list of symbols and documentation found."
Kim F. Storm's avatar
Kim F. Storm committed
615 616
  (interactive (list (apropos-read-pattern "symbol")
		     current-prefix-arg))
617
  (apropos-parse-pattern pattern)
618
  (apropos-symbols-internal
Kim F. Storm's avatar
Kim F. Storm committed
619
   (apropos-internal apropos-regexp
Richard M. Stallman's avatar
Richard M. Stallman committed
620 621 622 623 624 625 626
		     (and (not do-all)
			  (not apropos-do-all)
			  (lambda (symbol)
			    (or (fboundp symbol)
				(boundp symbol)
				(facep symbol)
				(symbol-plist symbol)))))
627 628
   (or do-all apropos-do-all)))

629 630 631 632 633 634
(defun apropos-library-button (sym)
  (if (null sym)
      "<nothing>"
    (let ((name (copy-sequence (symbol-name sym))))
      (make-text-button name nil
                        'type 'apropos-library
Chong Yidong's avatar
Chong Yidong committed
635
                        'face 'apropos-symbol
636 637 638 639 640 641 642
                        'apropos-symbol name)
      name)))

;;;###autoload
(defun apropos-library (file)
  "List the variables and functions defined by library FILE.
FILE should be one of the libraries currently loaded and should
Glenn Morris's avatar
Glenn Morris committed
643 644
thus be found in `load-history'.  If `apropos-do-all' is non-nil,
the output includes key-bindings of commands."
645
  (interactive
646 647 648 649 650 651 652 653 654 655 656 657
   (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)))
658 659 660 661 662 663 664 665 666 667 668 669
     (list (completing-read "Describe library: " libs nil t))))
  (let ((symbols nil)
	;; (autoloads nil)
	(provides nil)
	(requires nil)
        (lh-entry (assoc file load-history)))
    (unless lh-entry
      ;; `file' may be the "shortname".
      (let ((lh load-history)
            (re (concat "\\(?:\\`\\|[\\/]\\)" (regexp-quote file)
                        "\\(\\.\\|\\'\\)")))
        (while (and lh (null lh-entry))
670
          (if (and (caar lh) (string-match re (caar lh)))
671 672 673 674
              (setq lh-entry (car lh))
            (setq lh (cdr lh)))))
      (unless lh-entry (error "Unknown library `%s'" file)))
    (dolist (x (cdr lh-entry))
Stefan Monnier's avatar
Stefan Monnier committed
675
      (pcase (car-safe x)
676
	;; (autoload (push (cdr x) autoloads))
Stefan Monnier's avatar
Stefan Monnier committed
677 678 679
	(`require (push (cdr x) requires))
	(`provide (push (cdr x) provides))
	(_ (push (or (cdr-safe x) x) symbols))))
680 681 682 683 684 685 686 687 688 689 690
    (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal.
      (apropos-symbols-internal
       symbols apropos-do-all
       (concat
        (format "Library `%s' provides: %s\nand requires: %s"
                file
                (mapconcat 'apropos-library-button
                           (or provides '(nil)) " and ")
                (mapconcat 'apropos-library-button
                           (or requires '(nil)) " and ")))))))

691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715
(defun apropos-symbols-internal (symbols keys &optional text)
  ;; Filter out entries that are marked as apropos-inhibit.
  (let ((all nil))
    (dolist (symbol symbols)
      (unless (get symbol 'apropos-inhibit)
	(push symbol all)))
    (setq symbols all))
  (let ((apropos-accumulator
	 (mapcar
	  (lambda (symbol)
	    (let (doc properties)
	      (list
	       symbol
	       (apropos-score-symbol symbol)
	       (when (fboundp symbol)
		 (if (setq doc (condition-case nil
				   (documentation symbol t)
				 (void-function
				  "(alias for undefined function)")
				 (error
				  "(can't retrieve function documentation)")))
		     (substring doc 0 (string-match "\n" doc))
		   "(not documented)"))
	       (when (boundp symbol)
		 (apropos-documentation-property
716 717 718 719 720
		  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)))
721
		 (mapconcat (lambda (p) (format "%s" p)) (nreverse doc) " "))
722 723 724
	       (when (get symbol 'widget-type)
		 (apropos-documentation-property
		  symbol 'widget-documentation t))
725
	       (when (facep symbol)
726 727 728 729 730 731 732 733 734 735 736 737 738
		 (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))))
739
	       (when (get symbol 'custom-group)
740 741
		 (apropos-documentation-property
		  symbol 'group-documentation t)))))
742 743
	  symbols)))
    (apropos-print keys nil text)))
744 745


Richard M. Stallman's avatar
Richard M. Stallman committed
746
;;;###autoload
Kim F. Storm's avatar
Kim F. Storm committed
747
(defun apropos-value (pattern &optional do-all)
748
  "Show all symbols whose value's printed representation matches PATTERN.
Kim F. Storm's avatar
Kim F. Storm committed
749
PATTERN can be a word, a list of words (separated by spaces),
750 751 752 753
or a regexp (using some regexp special characters).  If it is a word,
search for matches for that word as a substring.  If it is a list of words,
search for matches for any two (or more) of those words.

Kim F. Storm's avatar
Kim F. Storm committed
754
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also looks
Glenn Morris's avatar
Glenn Morris committed
755 756 757
at function definitions (arguments, documentation and body) and at the
names and values of properties.

758
Returns list of symbols and values found."
Kim F. Storm's avatar
Kim F. Storm committed
759 760
  (interactive (list (apropos-read-pattern "value")
		     current-prefix-arg))
761
  (apropos-parse-pattern pattern)
762 763 764
  (or do-all (setq do-all apropos-do-all))
  (setq apropos-accumulator ())
   (let (f v p)
765 766 767
     (mapatoms
      (lambda (symbol)
	(setq f nil v nil p nil)
Kim F. Storm's avatar
Kim F. Storm committed
768 769
	(or (memq symbol '(apropos-regexp
			   apropos-pattern apropos-all-words-regexp
770 771 772
			   apropos-words apropos-all-words
			   do-all apropos-accumulator
			   symbol f v p))
773
	    (setq v (apropos-value-internal 'boundp symbol 'symbol-value)))
774
	(if do-all
775 776
	    (setq f (apropos-value-internal 'fboundp symbol 'symbol-function)
		  p (apropos-format-plist symbol "\n    " t)))
777 778 779 780 781 782
	(if (apropos-false-hit-str v)
	    (setq v nil))
	(if (apropos-false-hit-str f)
	    (setq f nil))
	(if (apropos-false-hit-str p)
	    (setq p nil))
783
	(if (or f v p)
784
	    (setq apropos-accumulator (cons (list symbol
785 786 787 788
						  (+ (apropos-score-str f)
						     (apropos-score-str v)
						     (apropos-score-str p))
						  f v p)
789
					    apropos-accumulator))))))
790 791
   (let ((apropos-multi-type do-all))
     (apropos-print nil "\n----------------\n")))
792 793


794
;;;###autoload
Kim F. Storm's avatar
Kim F. Storm committed
795
(defun apropos-documentation (pattern &optional do-all)
796
  "Show symbols whose documentation contains matches for PATTERN.
Kim F. Storm's avatar
Kim F. Storm committed
797
PATTERN can be a word, a list of words (separated by spaces),
798 799 800 801
or a regexp (using some regexp special characters).  If it is a word,
search for matches for that word as a substring.  If it is a list of words,
search for matches for any two (or more) of those words.

Glenn Morris's avatar
Glenn Morris committed
802 803 804 805 806
Note that by default this command only searches in the file specified by
`internal-doc-file-name'; i.e., the etc/DOC file.  With \\[universal-argument] prefix,
or if `apropos-do-all' is non-nil, it searches all currently defined
documentation strings.

807
Returns list of symbols and documentation found."
Glenn Morris's avatar
Glenn Morris committed
808 809
  ;; The doc used to say that DO-ALL includes key-bindings info in the
  ;; output, but I cannot see that that is true.
Kim F. Storm's avatar
Kim F. Storm committed
810 811
  (interactive (list (apropos-read-pattern "documentation")
		     current-prefix-arg))
812
  (apropos-parse-pattern pattern)
813 814 815
  (or do-all (setq do-all apropos-do-all))
  (setq apropos-accumulator () apropos-files-scanned ())
  (let ((standard-input (get-buffer-create " apropos-temp"))
Kim F. Storm's avatar
Kim F. Storm committed
816
	(apropos-sort-by-scores apropos-documentation-sort-by-scores)
817
	f v sf sv)
818
    (unwind-protect
819
	(with-current-buffer standard-input
820 821 822 823 824
	  (apropos-documentation-check-doc-file)
	  (if do-all
	      (mapatoms
	       (lambda (symbol)
		 (setq f (apropos-safe-documentation symbol)
825 826 827 828
		       v (get symbol 'variable-documentation))
		 (if (integerp v) (setq v))
		 (setq f (apropos-documentation-internal f)
		       v (apropos-documentation-internal v))
829 830
		 (setq sf (apropos-score-doc f)
		       sv (apropos-score-doc v))
831 832 833 834 835
		 (if (or f v)
		     (if (setq apropos-item
			       (cdr (assq symbol apropos-accumulator)))
			 (progn
			   (if f
836 837 838
			       (progn
				 (setcar (nthcdr 1 apropos-item) f)
				 (setcar apropos-item (+ (car apropos-item) sf))))
839
			   (if v
840 841 842
			       (progn
				 (setcar (nthcdr 2 apropos-item) v)
				 (setcar apropos-item (+ (car apropos-item) sv)))))
843
		       (setq apropos-accumulator
844
			     (cons (list symbol
845 846
					 (+ (apropos-score-symbol symbol 2) sf sv)
					 f v)
847
				   apropos-accumulator)))))))
Kim F. Storm's avatar
Kim F. Storm committed
848
	  (apropos-print nil "\n----------------\n" nil t))
849 850 851 852 853 854 855
      (kill-buffer standard-input))))


(defun apropos-value-internal (predicate symbol function)
  (if (funcall predicate symbol)
      (progn
	(setq symbol (prin1-to-string (funcall function symbol)))
Kim F. Storm's avatar
Kim F. Storm committed
856
	(if (string-match apropos-regexp symbol)
857 858 859 860 861 862 863 864 865 866
	    (progn
	      (if apropos-match-face
		  (put-text-property (match-beginning 0) (match-end 0)
				     'face apropos-match-face
				     symbol))
	      symbol)))))

(defun apropos-documentation-internal (doc)
  (if (consp doc)
      (apropos-documentation-check-elc-file (car doc))
Kim F. Storm's avatar
Kim F. Storm committed
867 868 869 870 871 872 873 874 875 876 877
    (if (and doc
	     (string-match apropos-all-words-regexp doc)
	     (apropos-true-hit-doc doc))
	(when apropos-match-face
	  (setq doc (substitute-command-keys (copy-sequence doc)))
	  (if (or (string-match apropos-pattern-quoted doc)
		  (string-match apropos-all-words-regexp doc))
	      (put-text-property (match-beginning 0)
				 (match-end 0)
				 'face apropos-match-face doc))
	  doc))))
878 879

(defun apropos-format-plist (pl sep &optional compare)
880 881 882 883
  (setq pl (symbol-plist pl))
  (let (p p-out)
    (while pl
      (setq p (format "%s %S" (car pl) (nth 1 pl)))
Kim F. Storm's avatar
Kim F. Storm committed
884
      (if (or (not compare) (string-match apropos-regexp p))
Chong Yidong's avatar
Chong Yidong committed
885 886
	  (put-text-property 0 (length (symbol-name (car pl)))
			     'face 'apropos-property p)
887
	(setq p nil))
888 889 890 891 892 893 894
      (if p
	  (progn
	    (and compare apropos-match-face
		 (put-text-property (match-beginning 0) (match-end 0)
				    'face apropos-match-face
				    p))
	    (setq p-out (concat p-out (if p-out sep) p))))
895 896 897
      (setq pl (nthcdr 2 pl)))
    p-out))

Richard M. Stallman's avatar
Richard M. Stallman committed
898

Kim F. Storm's avatar
Kim F. Storm committed
899
;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name.
900

901
(defun apropos-documentation-check-doc-file ()
902
  (let (type symbol (sepa 2) sepb doc)
903 904
    (insert ?\^_)
    (backward-char)
905
    (insert-file-contents (concat doc-directory internal-doc-file-name))
906 907