Mercurial > emacs
annotate lisp/apropos.el @ 10289:9dd21ecf6b0f
(Flength): Handle compiled function as pseudovector.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 30 Dec 1994 01:46:04 +0000 |
parents | 1d1c5ea9eb86 |
children | 509f78000a59 |
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 | |
9213
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
54 (defun apropos (regexp &optional do-all pred no-header) |
367 | 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 | |
9213
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
61 Optional argument NO-HEADER means don't print `Function:' or `Variable:' |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
62 in the output. |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
63 |
367 | 64 Returns list of symbols and documentation found." |
65 (interactive "sApropos (regexp): \nP") | |
66 (setq do-all (or apropos-do-all do-all)) | |
67 (let ((apropos-accumulate (apropos-internal regexp pred))) | |
68 (if (null apropos-accumulate) | |
69 (message "No apropos matches for `%s'" regexp) | |
70 (apropos-get-doc apropos-accumulate) | |
71 (with-output-to-temp-buffer "*Help*" | |
9213
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
72 (apropos-print-matches apropos-accumulate regexp nil |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
73 do-all no-header))) |
367 | 74 apropos-accumulate)) |
75 | |
76 ;; Takes LIST of symbols and adds documentation. Modifies LIST in place. | |
77 ;; Resulting alist is of form ((symbol fn-doc var-doc) ...). Should only be | |
78 ;; called by apropos. Returns LIST. | |
79 | |
80 (defun apropos-get-doc (list) | |
81 (let ((p list) | |
82 fn-doc var-doc symbol) | |
83 (while (consp p) | |
84 (setq symbol (car p) | |
85 fn-doc (and (fboundp symbol) | |
86 (documentation symbol)) | |
87 var-doc (documentation-property symbol 'variable-documentation) | |
88 fn-doc (and fn-doc | |
89 (substring fn-doc 0 (string-match "\n" fn-doc))) | |
90 var-doc (and var-doc | |
91 (substring var-doc 0 (string-match "\n" var-doc)))) | |
92 (setcar p (list symbol fn-doc var-doc)) | |
93 (setq p (cdr p))) | |
94 list)) | |
95 | |
10282
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
96 ;; Variables bound by super-apropos and used by its subroutines. |
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
97 ;; It would be good to say what each one is for, but I don't know -- rms. |
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
98 (defvar apropos-item) |
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
99 (defvar apropos-var-doc) |
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
100 (defvar apropos-fn-doc) |
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
101 (defvar apropos-accumulate) |
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
102 (defvar apropos-regexp |
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
103 "Within `super-apropos', this holds the REGEXP argument.") |
10283
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
104 (defvar apropos-files-scanned) |
10282
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
105 |
367 | 106 ;;;###autoload |
107 (defun super-apropos (regexp &optional do-all) | |
108 "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
|
109 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
|
110 or if `apropos-do-all' is non-nil, does more (time-consuming) work such as |
367 | 111 showing key bindings and documentation that is not stored in the documentation |
112 file. | |
113 | |
114 Returns list of symbols and documentation found." | |
115 (interactive "sSuper Apropos: \nP") | |
116 (setq do-all (or apropos-do-all do-all)) | |
10282
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
117 (let ((apropos-regexp regexp) |
10283
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
118 apropos-accumulate apropos-fn-doc apropos-var-doc apropos-item |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
119 apropos-files-scanned) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
120 (setq apropos-accumulate |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
121 (super-apropos-check-doc-file apropos-regexp)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
122 (if do-all (mapatoms 'super-apropos-accumulate)) |
367 | 123 (if (null apropos-accumulate) |
10282
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
124 (message "No apropos matches for `%s'" apropos-regexp) |
367 | 125 (with-output-to-temp-buffer "*Help*" |
10283
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
126 (setq apropos-accumulate |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
127 (apropos-print-matches apropos-accumulate nil t do-all)))) |
367 | 128 apropos-accumulate)) |
129 | |
130 ;; Finds all documentation related to REGEXP in internal-doc-file-name. | |
131 ;; Returns an alist of form ((symbol fn-doc var-doc) ...). | |
132 | |
133 (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
|
134 (let* ((doc-file (concat doc-directory internal-doc-file-name)) |
10283
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
135 (doc-buffer (get-buffer-create " apropos-temp")) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
136 type symbol doc sym-list) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
137 (unwind-protect |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
138 (save-excursion |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
139 (set-buffer doc-buffer) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
140 (buffer-disable-undo) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
141 (erase-buffer) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
142 (insert-file-contents doc-file) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
143 (while (re-search-forward regexp nil t) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
144 (search-backward "\C-_") |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
145 (setq type (if (eq ?F (char-after (1+ (point)))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
146 1 ;function documentation |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
147 2) ;variable documentation |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
148 symbol (progn |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
149 (forward-char 2) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
150 (read doc-buffer)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
151 doc (buffer-substring |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
152 (point) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
153 (progn |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
154 (if (search-forward "\C-_" nil 'move) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
155 (1- (point)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
156 (point)))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
157 apropos-item (assq symbol sym-list)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
158 (and (if (= type 1) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
159 (and (fboundp symbol) (documentation symbol)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
160 (documentation-property symbol 'variable-documentation)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
161 (or apropos-item |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
162 (setq apropos-item (list symbol nil nil) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
163 sym-list (cons apropos-item sym-list))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
164 (setcar (nthcdr type apropos-item) doc)))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
165 (kill-buffer doc-buffer)) |
367 | 166 sym-list)) |
167 | |
10283
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
168 (defun super-apropos-check-elc-file (regexp file) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
169 (let* ((doc-buffer (get-buffer-create " apropos-temp")) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
170 symbol doc length beg end this-is-a-variable) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
171 (unwind-protect |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
172 (save-excursion |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
173 (set-buffer doc-buffer) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
174 (buffer-disable-undo) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
175 (erase-buffer) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
176 (insert-file-contents file) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
177 (while (search-forward "\n#@" nil t) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
178 ;; Read the comment length, and advance over it. |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
179 (setq length (read (current-buffer))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
180 (setq beg (point)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
181 (setq end (+ (point) length 1)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
182 (if (re-search-forward regexp end t) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
183 (progn |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
184 (setq this-is-a-variable (save-excursion |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
185 (goto-char end) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
186 (looking-at "(defvar\\|(defconst")) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
187 symbol (save-excursion |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
188 (goto-char end) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
189 (skip-chars-forward "(a-z") |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
190 (forward-char 1) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
191 (read doc-buffer)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
192 symbol (if (consp symbol) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
193 (nth 1 symbol) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
194 symbol) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
195 doc (buffer-substring (1+ beg) (- end 2)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
196 apropos-item (assq symbol apropos-accumulate)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
197 (and (if this-is-a-variable |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
198 (documentation-property symbol 'variable-documentation) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
199 (and (fboundp symbol) (documentation symbol))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
200 (or apropos-item |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
201 (setq apropos-item (list symbol nil nil) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
202 apropos-accumulate (cons apropos-item |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
203 apropos-accumulate))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
204 (setcar (nthcdr (if this-is-a-variable 2 1) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
205 apropos-item) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
206 doc)))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
207 (goto-char end))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
208 (kill-buffer doc-buffer)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
209 apropos-accumulate)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
210 |
367 | 211 ;; This is passed as the argument to map-atoms, so it is called once for every |
212 ;; symbol in obarray. Takes one argument SYMBOL, and finds any memory-resident | |
10282
84c786359b07
(super-apropos, super-apropos-check-doc-file)
Richard M. Stallman <rms@gnu.org>
parents:
10162
diff
changeset
|
213 ;; documentation on that symbol if it matches a variable regexp. |
367 | 214 |
215 (defun super-apropos-accumulate (symbol) | |
10283
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
216 (let (doc) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
217 (cond ((string-match apropos-regexp (symbol-name symbol)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
218 (setq apropos-item (apropos-get-accum-item symbol)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
219 (setcar (cdr apropos-item) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
220 (or (safe-documentation symbol) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
221 (nth 1 apropos-item))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
222 (setcar (nthcdr 2 apropos-item) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
223 (or (safe-documentation-property symbol) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
224 (nth 2 apropos-item)))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
225 ((or (consp (setq doc (safe-documentation symbol))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
226 (consp (setq doc (safe-documentation-property symbol)))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
227 ;; This symbol's doc is stored in a file. |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
228 ;; Scan the file if we have not scanned it before. |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
229 (let ((file (car doc))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
230 (or (member file apropos-files-scanned) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
231 (progn |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
232 (setq apropos-files-scanned |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
233 (cons file apropos-files-scanned)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
234 (super-apropos-check-elc-file apropos-regexp file))))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
235 (t |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
236 (and (stringp (setq doc (safe-documentation symbol))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
237 (setq apropos-fn-doc doc) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
238 (string-match apropos-regexp apropos-fn-doc) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
239 (setcar (cdr (apropos-get-accum-item symbol)) apropos-fn-doc)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
240 (and (stringp (setq doc (safe-documentation-property symbol))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
241 (setq apropos-var-doc doc) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
242 (string-match apropos-regexp apropos-var-doc) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
243 (setcar (nthcdr 2 (apropos-get-accum-item symbol)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
244 apropos-var-doc))))) |
367 | 245 nil) |
246 | |
247 ;; Prints the symbols and documentation in alist MATCHES of form ((symbol | |
248 ;; fn-doc var-doc) ...). Uses optional argument REGEXP to speed up searching | |
249 ;; for keybindings. The names of all symbols in MATCHES must match REGEXP. | |
250 ;; Displays in the buffer pointed to by standard-output. Optional argument | |
251 ;; SPACING means put blank lines in between each symbol's documentation. | |
252 ;; Optional argument DO-ALL means do more time-consuming work, specifically, | |
253 ;; consulting key bindings. Should only be called within a | |
254 ;; with-output-to-temp-buffer. | |
255 | |
9213
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
256 (defun apropos-print-matches (matches &optional regexp |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
257 spacing do-all no-header) |
367 | 258 (setq matches (sort matches (function |
259 (lambda (a b) | |
260 (string-lessp (car a) (car b)))))) | |
261 (let ((p matches) | |
262 (old-buffer (current-buffer)) | |
2946
1f24ead69a2f
(apropos-print-matches): Bind tem.
Richard M. Stallman <rms@gnu.org>
parents:
2937
diff
changeset
|
263 item keys-done symbol tem) |
367 | 264 (save-excursion |
265 (set-buffer standard-output) | |
266 (or matches (princ "No matches found.")) | |
267 (while (consp p) | |
268 (setq item (car p) | |
269 symbol (car item) | |
270 p (cdr p)) | |
271 (or (not spacing) (bobp) (terpri)) | |
272 (princ symbol) ;print symbol name | |
273 ;; don't calculate key-bindings unless needed | |
274 (cond ((and do-all (commandp symbol) (not keys-done)) | |
275 (save-excursion | |
276 (set-buffer old-buffer) | |
277 (apropos-match-keys matches regexp)) | |
278 (setq keys-done t))) | |
279 (cond ((and do-all | |
280 (or (setq tem (nthcdr 3 item)) | |
281 (commandp symbol))) | |
282 (indent-to 30 1) | |
283 (if tem | |
284 (princ (mapconcat 'key-description tem ", ")) | |
285 (princ "(not bound to any keys)")))) | |
286 (terpri) | |
287 (cond ((setq tem (nth 1 item)) | |
9213
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
288 (let ((substed (if do-all (substitute-command-keys tem) tem))) |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
289 (if no-header |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
290 (princ " ") |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
291 (princ " Function: ") |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
292 (if (> (length substed) 67) |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
293 (princ "\n "))) |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
294 (princ substed)))) |
367 | 295 (or (bolp) (terpri)) |
296 (cond ((setq tem (nth 2 item)) | |
9213
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
297 (let ((substed (if do-all (substitute-command-keys tem) tem))) |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
298 (if no-header |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
299 (princ " ") |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
300 (princ " Variable: ") |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
301 (if (> (length substed) 67) |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
302 (princ "\n "))) |
177bb6670a97
(apropos-print-matches): Add newline after
Richard M. Stallman <rms@gnu.org>
parents:
7300
diff
changeset
|
303 (princ substed)))) |
9860
49a20a98c276
(apropos-print-matches): Set help-mode in *Help* buffer.
Karl Heuer <kwzh@gnu.org>
parents:
9213
diff
changeset
|
304 (or (bolp) (terpri))) |
49a20a98c276
(apropos-print-matches): Set help-mode in *Help* buffer.
Karl Heuer <kwzh@gnu.org>
parents:
9213
diff
changeset
|
305 (help-mode))) |
10283
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
306 matches) |
367 | 307 |
308 ;; Find key bindings for symbols that are cars in ALIST. Optionally, first | |
309 ;; match the symbol name against REGEXP. Modifies ALIST in place. Each key | |
310 ;; binding is added as a string to the end of the list in ALIST whose car is | |
311 ;; the corresponding symbol. The pointer to ALIST is returned. | |
312 | |
313 (defun apropos-match-keys (alist &optional regexp) | |
314 (let* ((current-local-map (current-local-map)) | |
10162
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
315 ;; Get a list of the top-level maps now active. |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
316 (top-maps |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
317 (if overriding-local-map |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
318 (list overriding-local-map (current-global-map)) |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
319 (append (current-minor-mode-maps) |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
320 (if current-local-map |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
321 (list current-local-map (current-global-map)) |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
322 (list (current-global-map)))))) |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
323 ;; Turn that into a list of all the maps including submaps. |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
324 (maps (apply 'append (mapcar 'accessible-keymaps top-maps))) |
367 | 325 map ;map we are now inspecting |
326 sequence ;key sequence to reach map | |
327 i ;index into vector map | |
328 command ;what is bound to current keys | |
329 key ;last key to reach command | |
330 local ;local binding for sequence + key | |
331 item) ;symbol data item in alist | |
332 ;; examine all reachable keymaps | |
333 (while (consp maps) | |
334 (setq map (cdr (car maps)) | |
335 sequence (car (car maps)) ;keys to reach this map | |
336 maps (cdr maps)) | |
2937
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
337 ;; 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
|
338 (if (eq (car map) 'keymap) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
339 (setq map (cdr map))) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
340 (while (stringp (car-safe map)) |
367 | 341 (setq map (cdr map))) |
10162
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
342 |
2937
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
343 (while (consp map) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
344 (cond ((consp (car map)) |
367 | 345 (setq command (cdr (car map)) |
2937
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
346 key (car (car map))) |
10162
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
347 ;; Skip any menu prompt and help string in this key binding. |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
348 (while (and (consp command) (stringp (car command))) |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
349 (setq command (cdr command))) |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
350 ;; Skip any cached equivalent key. |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
351 (and (consp command) |
58037e770f67
(apropos-match-keys): Handle menu bindings with cached equivalent keys.
Richard M. Stallman <rms@gnu.org>
parents:
9860
diff
changeset
|
352 (consp (car command)) |
2937
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
353 (setq command (cdr command))) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
354 ;; 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
|
355 ;; 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
|
356 ;; record it |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
357 (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
|
358 (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
|
359 (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
|
360 t) |
2937
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
361 (setq item (assq command alist)) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
362 (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
|
363 (setq key (vconcat sequence (vector key))) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
364 (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
|
365 ;; checking if shadowed by local binding. |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
366 ;; 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
|
367 ;; 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
|
368 (or (not current-local-map) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
369 (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
|
370 (numberp local) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
371 (eq command local)) |
6525
7e1e1ccc238c
(apropos-match-keys): Skip duplicate keybindings.
Karl Heuer <kwzh@gnu.org>
parents:
6329
diff
changeset
|
372 ;; check if this binding is already recorded |
7e1e1ccc238c
(apropos-match-keys): Skip duplicate keybindings.
Karl Heuer <kwzh@gnu.org>
parents:
6329
diff
changeset
|
373 ;; (this can happen due to inherited keymaps) |
7e1e1ccc238c
(apropos-match-keys): Skip duplicate keybindings.
Karl Heuer <kwzh@gnu.org>
parents:
6329
diff
changeset
|
374 (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
|
375 ;; 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
|
376 (nconc item (cons key nil)))) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
377 ((vectorp (car map)) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
378 (let ((i 0) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
379 (vec (car map)) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
380 (len (length (car map)))) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
381 (while (< i len) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
382 (setq command (aref vec i)) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
383 (setq key i) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
384 ;; 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
|
385 (and (consp command) (symbolp (cdr command)) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
386 (setq command (cdr command))) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
387 ;; 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
|
388 (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
|
389 (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
|
390 (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
|
391 t) |
2937
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
392 (setq item (assq command alist)) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
393 (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
|
394 (setq key (vconcat sequence (vector key))) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
395 (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
|
396 ;; checking if shadowed by local binding. |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
397 ;; 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
|
398 ;; 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
|
399 (or (not current-local-map) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
400 (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
|
401 (numberp local) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
402 (eq command local)) |
6525
7e1e1ccc238c
(apropos-match-keys): Skip duplicate keybindings.
Karl Heuer <kwzh@gnu.org>
parents:
6329
diff
changeset
|
403 ;; check if this binding is already recorded |
7e1e1ccc238c
(apropos-match-keys): Skip duplicate keybindings.
Karl Heuer <kwzh@gnu.org>
parents:
6329
diff
changeset
|
404 ;; (this can happen due to inherited keymaps) |
7e1e1ccc238c
(apropos-match-keys): Skip duplicate keybindings.
Karl Heuer <kwzh@gnu.org>
parents:
6329
diff
changeset
|
405 (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
|
406 ;; 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
|
407 (nconc item (cons key nil))) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
408 (setq i (1+ i)))))) |
e38ff71093b5
(apropos-match-keys): Handle modern keymap structure.
Richard M. Stallman <rms@gnu.org>
parents:
2247
diff
changeset
|
409 (setq map (cdr map))))) |
367 | 410 alist) |
411 | |
412 ;; Get an alist item in alist apropos-accumulate whose car is SYMBOL. Creates | |
413 ;; the item if not already present. Modifies apropos-accumulate in place. | |
414 | |
415 (defun apropos-get-accum-item (symbol) | |
416 (or (assq symbol apropos-accumulate) | |
417 (progn | |
418 (setq apropos-accumulate | |
419 (cons (list symbol nil nil) apropos-accumulate)) | |
420 (assq symbol apropos-accumulate)))) | |
421 | |
422 (defun safe-documentation (function) | |
423 "Like documentation, except it avoids calling `get_doc_string'. | |
424 Will return nil instead." | |
425 (while (symbolp function) | |
426 (setq function (if (fboundp function) | |
427 (symbol-function function) | |
428 0))) | |
3563
804e4f30b7ce
(safe-documentation): Don't crash on byte-compiled macro.
Richard M. Stallman <rms@gnu.org>
parents:
2946
diff
changeset
|
429 (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
|
430 (setq function (cdr function))) |
10283
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
431 (if (byte-code-function-p function) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
432 (if (> (length function) 4) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
433 (aref function 4)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
434 (if (not (consp function)) |
367 | 435 nil |
10283
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
436 (if (not (memq (car function) '(lambda autoload))) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
437 nil |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
438 (setq function (nth 2 function)) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
439 (if (stringp function) |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
440 function |
1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10282
diff
changeset
|
441 nil))))) |
367 | 442 |
443 (defun safe-documentation-property (symbol) | |
444 "Like documentation-property, except it avoids calling `get_doc_string'. | |
445 Will return nil instead." | |
446 (setq symbol (get symbol 'variable-documentation)) | |
447 (if (numberp symbol) | |
448 nil | |
449 symbol)) | |
450 | |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
444
diff
changeset
|
451 ;;; apropos.el ends here |