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