annotate lisp/apropos.el @ 383:4f7094a6b826

*** empty log message ***
author Jim Blandy <jimb@redhat.com>
date Mon, 12 Aug 1991 12:12:28 +0000
parents 6c230193acf9
children 4cec2e6d4f9e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
367
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1 ;; Faster apropos commands.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2 ;; Copyright (C) 1989 Free Software Foundation, Inc.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4 ;; This file is part of GNU Emacs.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6 ;; GNU Emacs is free software; you can redistribute it and/or modify
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; it under the terms of the GNU General Public License as published by
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8 ;; the Free Software Foundation; either version 1, or (at your option)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; any later version.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; GNU Emacs is distributed in the hope that it will be useful,
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; GNU General Public License for more details.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; You should have received a copy of the GNU General Public License
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; along with GNU Emacs; see the file COPYING. If not, write to
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20 ;; Author: Joe Wells
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; Last changed: Fri May 5 18:08:16 1989 by jbw (Joseph Wells) on bucsf
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22 ;; jbw%bucsf.bu.edu@bu-it.bu.edu (school year)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23 ;; joew@uswest.com (summer)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ;; The ideas for this package were derived from the C code in
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 ;; src/keymap.c and elsewhere. The functions in this file should
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27 ;; always be byte-compiled for speed. Someone should rewrite this in
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;; C (as part of src/keymap.c) for speed.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 ;; The idea for super-apropos is based on the original implementation
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 ;; by Lynn Slater <lrs@esl.com>.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 ;; History:
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 ;; Fixed bug, current-local-map can return nil.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 ;; Change, doesn't calculate key-bindings unless needed.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36 ;; Added super-apropos capability, changed print functions.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 ;; Made fast-apropos and super-apropos share code.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38 ;; Sped up fast-apropos again.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 ;; Added apropos-do-all option.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 ;; Added fast-command-apropos.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 ;; Changed doc strings to comments for helping functions.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 ;; Made doc file buffer read-only, buried it.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 ;; Only call substitute-command-keys if do-all set.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 (defvar apropos-do-all nil
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 "*Whether `apropos' and `super-apropos' should do everything that they can.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 Makes them run 2 or 3 times slower. Set this non-nil if you have a fast
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 machine.")
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50 ;; If there isn't already a lisp variable named internal-doc-file-name, create
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 ;; it and document it. This is so the code will work right after RMS adds
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 ;; internal-doc-file-name.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 ;(or (boundp 'internal-doc-file-name)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 ; (setq internal-doc-file-name (concat exec-directory "DOC")))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 ;(or (documentation-property 'internal-doc-file-name 'variable-documentation)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 ; (put 'internal-doc-file-name 'variable-documentation
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 ; "The complete pathname of the documentation file that contains all
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 ;documentation for functions and variables defined before Emacs is dumped."))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 ;;;###autoload
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 (defun apropos (regexp &optional do-all pred)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 "Show all symbols whose names contain matches for REGEXP.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 If optional argument DO-ALL is non-nil, does more (time-consuming) work such as
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 showing key bindings. Optional argument PRED is called with each symbol, and
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 if it returns nil, the symbol is not shown.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 Returns list of symbols and documentation found."
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 (interactive "sApropos (regexp): \nP")
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 (setq do-all (or apropos-do-all do-all))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 (let ((apropos-accumulate (apropos-internal regexp pred)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 (if (null apropos-accumulate)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 (message "No apropos matches for `%s'" regexp)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 (apropos-get-doc apropos-accumulate)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 (with-output-to-temp-buffer "*Help*"
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 (apropos-print-matches apropos-accumulate regexp nil do-all)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 apropos-accumulate))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 ;; If "C-h a" still has its original binding of command-apropos, change it to
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 ;; use fast-command-apropos. I don't use substitute-key-definition because
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 ;; it's slow.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 ;(if (eq 'command-apropos (lookup-key help-map "a"))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 ; (define-key help-map "a" 'fast-command-apropos))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 ;; Takes LIST of symbols and adds documentation. Modifies LIST in place.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 ;; Resulting alist is of form ((symbol fn-doc var-doc) ...). Should only be
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 ;; called by apropos. Returns LIST.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 (defun apropos-get-doc (list)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 (let ((p list)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 fn-doc var-doc symbol)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 (while (consp p)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92 (setq symbol (car p)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 fn-doc (and (fboundp symbol)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 (documentation symbol))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 var-doc (documentation-property symbol 'variable-documentation)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 fn-doc (and fn-doc
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 (substring fn-doc 0 (string-match "\n" fn-doc)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 var-doc (and var-doc
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 (substring var-doc 0 (string-match "\n" var-doc))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 (setcar p (list symbol fn-doc var-doc))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101 (setq p (cdr p)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 list))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 ;;;###autoload
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 (defun super-apropos (regexp &optional do-all)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 "Show symbols whose names/documentation contain matches for REGEXP.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 If optional argument DO-ALL is non-nil, does more (time-consuming) work such as
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 showing key bindings and documentation that is not stored in the documentation
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 file.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 Returns list of symbols and documentation found."
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 (interactive "sSuper Apropos: \nP")
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 (setq do-all (or apropos-do-all do-all))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 (let (apropos-accumulate fn-doc var-doc item)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115 (setq apropos-accumulate (super-apropos-check-doc-file regexp))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116 (if (null apropos-accumulate)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117 (message "No apropos matches for `%s'" regexp)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 (if do-all (mapatoms 'super-apropos-accumulate))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 (with-output-to-temp-buffer "*Help*"
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 (apropos-print-matches apropos-accumulate nil t do-all)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 apropos-accumulate))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123 ;; Finds all documentation related to REGEXP in internal-doc-file-name.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 ;; Returns an alist of form ((symbol fn-doc var-doc) ...).
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126 (defun super-apropos-check-doc-file (regexp)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 (let ((doc-buffer (find-file-noselect internal-doc-file-name t))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 ;; (doc-buffer (or (get-file-buffer internal-doc-file-name)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129 ;; (find-file-noselect internal-doc-file-name)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 type symbol doc sym-list)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 (save-excursion
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132 (set-buffer doc-buffer)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 ;; a user said he might accidentally edit the doc file
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 (setq buffer-read-only t)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 (bury-buffer doc-buffer)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 (goto-char (point-min))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 (while (re-search-forward regexp nil t)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138 (search-backward "\C-_")
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 (setq type (if (eq ?F (char-after (1+ (point))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140 1 ;function documentation
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 2) ;variable documentation
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142 symbol (progn
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 (forward-char 2)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 (read doc-buffer))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145 doc (buffer-substring
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146 (point)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 (progn
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 (if (search-forward "\C-_" nil 'move)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149 (1- (point))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 (point))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 item (assq symbol sym-list))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 (or item
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153 (setq item (list symbol nil nil)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154 sym-list (cons item sym-list)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
155 (setcar (nthcdr type item) doc)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 sym-list))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158 ;; This is passed as the argument to map-atoms, so it is called once for every
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 ;; symbol in obarray. Takes one argument SYMBOL, and finds any memory-resident
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160 ;; documentation on that symbol if it matches a variable regexp. WARNING: this
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161 ;; function depends on the symbols fn-doc var-doc regexp and item being bound
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
162 ;; correctly when it is called!"
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
163
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164 (defun super-apropos-accumulate (symbol)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 (cond ((string-match regexp (symbol-name symbol))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 (setq item (apropos-get-accum-item symbol))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167 (setcar (cdr item) (or (safe-documentation symbol)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168 (nth 1 item)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169 (setcar (nthcdr 2 item) (or (safe-documentation-property symbol)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170 (nth 2 item))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 (t
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 (and (setq fn-doc (safe-documentation symbol))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 (string-match regexp fn-doc)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174 (setcar (cdr (apropos-get-accum-item symbol)) fn-doc))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 (and (setq var-doc (safe-documentation-property symbol))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 (string-match regexp var-doc)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177 (setcar (nthcdr 2 (apropos-get-accum-item symbol)) var-doc))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178 nil)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180 ;; Prints the symbols and documentation in alist MATCHES of form ((symbol
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 ;; fn-doc var-doc) ...). Uses optional argument REGEXP to speed up searching
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 ;; for keybindings. The names of all symbols in MATCHES must match REGEXP.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 ;; Displays in the buffer pointed to by standard-output. Optional argument
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184 ;; SPACING means put blank lines in between each symbol's documentation.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 ;; Optional argument DO-ALL means do more time-consuming work, specifically,
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186 ;; consulting key bindings. Should only be called within a
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187 ;; with-output-to-temp-buffer.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189 (defun apropos-print-matches (matches &optional regexp spacing do-all)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 (setq matches (sort matches (function
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191 (lambda (a b)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 (string-lessp (car a) (car b))))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193 (let ((p matches)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194 (old-buffer (current-buffer))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 item keys-done symbol)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196 (save-excursion
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197 (set-buffer standard-output)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 (or matches (princ "No matches found."))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199 (while (consp p)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200 (setq item (car p)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201 symbol (car item)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 p (cdr p))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203 (or (not spacing) (bobp) (terpri))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 (princ symbol) ;print symbol name
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205 ;; don't calculate key-bindings unless needed
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 (cond ((and do-all (commandp symbol) (not keys-done))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 (save-excursion
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208 (set-buffer old-buffer)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 (apropos-match-keys matches regexp))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210 (setq keys-done t)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 (cond ((and do-all
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
212 (or (setq tem (nthcdr 3 item))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 (commandp symbol)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
214 (indent-to 30 1)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
215 (if tem
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
216 (princ (mapconcat 'key-description tem ", "))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
217 (princ "(not bound to any keys)"))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
218 (terpri)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
219 (cond ((setq tem (nth 1 item))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220 (princ " Function: ")
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
221 (princ (if do-all (substitute-command-keys tem) tem))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
222 (or (bolp) (terpri))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223 (cond ((setq tem (nth 2 item))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224 (princ " Variable: ")
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225 (princ (if do-all (substitute-command-keys tem) tem))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 (or (bolp) (terpri)))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 t)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
228
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229 ;; Find key bindings for symbols that are cars in ALIST. Optionally, first
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230 ;; match the symbol name against REGEXP. Modifies ALIST in place. Each key
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 ;; binding is added as a string to the end of the list in ALIST whose car is
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 ;; the corresponding symbol. The pointer to ALIST is returned.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 (defun apropos-match-keys (alist &optional regexp)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235 (let* ((current-local-map (current-local-map))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (maps (append (and current-local-map
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 (accessible-keymaps current-local-map))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 (accessible-keymaps (current-global-map))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239 map ;map we are now inspecting
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 sequence ;key sequence to reach map
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241 i ;index into vector map
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 command ;what is bound to current keys
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243 key ;last key to reach command
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
244 local ;local binding for sequence + key
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
245 item) ;symbol data item in alist
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246 ;; examine all reachable keymaps
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 (while (consp maps)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248 (setq map (cdr (car maps))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249 sequence (car (car maps)) ;keys to reach this map
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250 maps (cdr maps))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
251 (setq i 0)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
252 ;; In an alist keymap, skip the leading `keymap', doc string, etc.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 (while (and (consp map) (not (consp (car map))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254 (setq map (cdr map)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255 (while (and map (< i 128)) ;vector keymaps have 128 entries
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
256 (cond ((consp map)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 (setq command (cdr (car map))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
258 key (car (car map))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
259 map (cdr map))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
260 ;; Skip any atoms in the keymap.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
261 (while (and (consp map) (not (consp (car map))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
262 (setq map (cdr map))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
263 ((vectorp map)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
264 (setq command (aref map i)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265 key i
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266 i (1+ i))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
267 ;; Skip any menu prompt in this key binding.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
268 (and (consp command) (symbolp (cdr command))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
269 (setq command (cdr command)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
270 ;; if is a symbol, and matches optional regexp, and is a car
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
271 ;; in alist, and is not shadowed by a different local binding,
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
272 ;; record it
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
273 (and (symbolp command)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
274 (if regexp (string-match regexp (symbol-name command)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275 (setq item (assq command alist))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
276 (setq key (concat sequence (char-to-string key)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
277 ;; checking if shadowed by local binding.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
278 ;; either no local map, no local binding, or runs off the
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
279 ;; binding tree (number), or is the same binding
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
280 (or (not current-local-map)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
281 (not (setq local (lookup-key current-local-map key)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
282 (numberp local)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
283 (eq command local))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
284 ;; add this key binding to the item in alist
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
285 (nconc item (cons key nil))))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
286 alist)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
287
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
288 ;; Get an alist item in alist apropos-accumulate whose car is SYMBOL. Creates
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
289 ;; the item if not already present. Modifies apropos-accumulate in place.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
290
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
291 (defun apropos-get-accum-item (symbol)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
292 (or (assq symbol apropos-accumulate)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
293 (progn
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
294 (setq apropos-accumulate
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
295 (cons (list symbol nil nil) apropos-accumulate))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 (assq symbol apropos-accumulate))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
298 (defun safe-documentation (function)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 "Like documentation, except it avoids calling `get_doc_string'.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
300 Will return nil instead."
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301 (while (symbolp function)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
302 (setq function (if (fboundp function)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
303 (symbol-function function)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
304 0)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
305 (if (not (consp function))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
306 nil
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
307 (if (eq (car function) 'macro)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 (setq function (cdr function)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309 (if (not (memq (car function) '(lambda autoload)))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310 nil
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 (setq function (nth 2 function))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
312 (if (stringp function)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
313 function
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
314 nil))))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
315
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
316 (defun safe-documentation-property (symbol)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
317 "Like documentation-property, except it avoids calling `get_doc_string'.
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
318 Will return nil instead."
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
319 (setq symbol (get symbol 'variable-documentation))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
320 (if (numberp symbol)
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
321 nil
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
322 symbol))
6c230193acf9 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
323