Mercurial > emacs
comparison lisp/apropos.el @ 10283:1d1c5ea9eb86
(super-apropos-check-elc-file): New function.
specifies which file to search.
(apropos-files-scanned): New variable.
(super-apropos): Bind apropos-files-scanned.
Update apropos-accumulate from apropos-print-matches.
Call super-apropos-accumulate before checking for no matches.
(super-apropos-check-doc-file): Don't visit the file, just insert it.
(super-apropos-accumulate): When doc string is in a file, scan that file.
(apropos-print-matches): Return the sorted list.
(safe-documentation): Handle compiled files.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 29 Dec 1994 04:17:00 +0000 |
parents | 84c786359b07 |
children | 509f78000a59 |
comparison
equal
deleted
inserted
replaced
10282:84c786359b07 | 10283:1d1c5ea9eb86 |
---|---|
99 (defvar apropos-var-doc) | 99 (defvar apropos-var-doc) |
100 (defvar apropos-fn-doc) | 100 (defvar apropos-fn-doc) |
101 (defvar apropos-accumulate) | 101 (defvar apropos-accumulate) |
102 (defvar apropos-regexp | 102 (defvar apropos-regexp |
103 "Within `super-apropos', this holds the REGEXP argument.") | 103 "Within `super-apropos', this holds the REGEXP argument.") |
104 (defvar apropos-files-scanned) | |
104 | 105 |
105 ;;;###autoload | 106 ;;;###autoload |
106 (defun super-apropos (regexp &optional do-all) | 107 (defun super-apropos (regexp &optional do-all) |
107 "Show symbols whose names/documentation contain matches for REGEXP. | 108 "Show symbols whose names/documentation contain matches for REGEXP. |
108 If optional argument DO-ALL is non-nil (prefix argument if interactive), | 109 If optional argument DO-ALL is non-nil (prefix argument if interactive), |
112 | 113 |
113 Returns list of symbols and documentation found." | 114 Returns list of symbols and documentation found." |
114 (interactive "sSuper Apropos: \nP") | 115 (interactive "sSuper Apropos: \nP") |
115 (setq do-all (or apropos-do-all do-all)) | 116 (setq do-all (or apropos-do-all do-all)) |
116 (let ((apropos-regexp regexp) | 117 (let ((apropos-regexp regexp) |
117 apropos-accumulate apropos-fn-doc apropos-var-doc apropos-item) | 118 apropos-accumulate apropos-fn-doc apropos-var-doc apropos-item |
118 (setq apropos-accumulate (super-apropos-check-doc-file apropos-regexp)) | 119 apropos-files-scanned) |
120 (setq apropos-accumulate | |
121 (super-apropos-check-doc-file apropos-regexp)) | |
122 (if do-all (mapatoms 'super-apropos-accumulate)) | |
119 (if (null apropos-accumulate) | 123 (if (null apropos-accumulate) |
120 (message "No apropos matches for `%s'" apropos-regexp) | 124 (message "No apropos matches for `%s'" apropos-regexp) |
121 (if do-all (mapatoms 'super-apropos-accumulate)) | |
122 (with-output-to-temp-buffer "*Help*" | 125 (with-output-to-temp-buffer "*Help*" |
123 (apropos-print-matches apropos-accumulate nil t do-all))) | 126 (setq apropos-accumulate |
127 (apropos-print-matches apropos-accumulate nil t do-all)))) | |
124 apropos-accumulate)) | 128 apropos-accumulate)) |
125 | 129 |
126 ;; Finds all documentation related to REGEXP in internal-doc-file-name. | 130 ;; Finds all documentation related to REGEXP in internal-doc-file-name. |
127 ;; Returns an alist of form ((symbol fn-doc var-doc) ...). | 131 ;; Returns an alist of form ((symbol fn-doc var-doc) ...). |
128 | 132 |
129 (defun super-apropos-check-doc-file (regexp) | 133 (defun super-apropos-check-doc-file (regexp) |
130 (let* ((doc-file (concat doc-directory internal-doc-file-name)) | 134 (let* ((doc-file (concat doc-directory internal-doc-file-name)) |
131 (doc-buffer | 135 (doc-buffer (get-buffer-create " apropos-temp")) |
132 ;; Force fundamental mode for the DOC file. | 136 type symbol doc sym-list) |
133 (let (auto-mode-alist) | 137 (unwind-protect |
134 (find-file-noselect doc-file t))) | 138 (save-excursion |
135 type symbol doc sym-list) | 139 (set-buffer doc-buffer) |
136 (save-excursion | 140 (buffer-disable-undo) |
137 (set-buffer doc-buffer) | 141 (erase-buffer) |
138 ;; a user said he might accidentally edit the doc file | 142 (insert-file-contents doc-file) |
139 (setq buffer-read-only t) | 143 (while (re-search-forward regexp nil t) |
140 (bury-buffer doc-buffer) | 144 (search-backward "\C-_") |
141 (goto-char (point-min)) | 145 (setq type (if (eq ?F (char-after (1+ (point)))) |
142 (while (re-search-forward regexp nil t) | 146 1 ;function documentation |
143 (search-backward "\C-_") | 147 2) ;variable documentation |
144 (setq type (if (eq ?F (char-after (1+ (point)))) | 148 symbol (progn |
145 1 ;function documentation | 149 (forward-char 2) |
146 2) ;variable documentation | 150 (read doc-buffer)) |
147 symbol (progn | 151 doc (buffer-substring |
148 (forward-char 2) | 152 (point) |
149 (read doc-buffer)) | 153 (progn |
150 doc (buffer-substring | 154 (if (search-forward "\C-_" nil 'move) |
151 (point) | 155 (1- (point)) |
152 (progn | 156 (point)))) |
153 (if (search-forward "\C-_" nil 'move) | 157 apropos-item (assq symbol sym-list)) |
154 (1- (point)) | 158 (and (if (= type 1) |
155 (point)))) | 159 (and (fboundp symbol) (documentation symbol)) |
156 apropos-item (assq symbol sym-list)) | 160 (documentation-property symbol 'variable-documentation)) |
157 (and (if (= type 1) | 161 (or apropos-item |
158 (and (fboundp symbol) (documentation symbol)) | 162 (setq apropos-item (list symbol nil nil) |
159 (documentation-property symbol 'variable-documentation)) | 163 sym-list (cons apropos-item sym-list))) |
160 (or apropos-item | 164 (setcar (nthcdr type apropos-item) doc)))) |
161 (setq apropos-item (list symbol nil nil) | 165 (kill-buffer doc-buffer)) |
162 sym-list (cons apropos-item sym-list))) | |
163 (setcar (nthcdr type apropos-item) doc)))) | |
164 sym-list)) | 166 sym-list)) |
167 | |
168 (defun super-apropos-check-elc-file (regexp file) | |
169 (let* ((doc-buffer (get-buffer-create " apropos-temp")) | |
170 symbol doc length beg end this-is-a-variable) | |
171 (unwind-protect | |
172 (save-excursion | |
173 (set-buffer doc-buffer) | |
174 (buffer-disable-undo) | |
175 (erase-buffer) | |
176 (insert-file-contents file) | |
177 (while (search-forward "\n#@" nil t) | |
178 ;; Read the comment length, and advance over it. | |
179 (setq length (read (current-buffer))) | |
180 (setq beg (point)) | |
181 (setq end (+ (point) length 1)) | |
182 (if (re-search-forward regexp end t) | |
183 (progn | |
184 (setq this-is-a-variable (save-excursion | |
185 (goto-char end) | |
186 (looking-at "(defvar\\|(defconst")) | |
187 symbol (save-excursion | |
188 (goto-char end) | |
189 (skip-chars-forward "(a-z") | |
190 (forward-char 1) | |
191 (read doc-buffer)) | |
192 symbol (if (consp symbol) | |
193 (nth 1 symbol) | |
194 symbol) | |
195 doc (buffer-substring (1+ beg) (- end 2)) | |
196 apropos-item (assq symbol apropos-accumulate)) | |
197 (and (if this-is-a-variable | |
198 (documentation-property symbol 'variable-documentation) | |
199 (and (fboundp symbol) (documentation symbol))) | |
200 (or apropos-item | |
201 (setq apropos-item (list symbol nil nil) | |
202 apropos-accumulate (cons apropos-item | |
203 apropos-accumulate))) | |
204 (setcar (nthcdr (if this-is-a-variable 2 1) | |
205 apropos-item) | |
206 doc)))) | |
207 (goto-char end))) | |
208 (kill-buffer doc-buffer)) | |
209 apropos-accumulate)) | |
165 | 210 |
166 ;; This is passed as the argument to map-atoms, so it is called once for every | 211 ;; This is passed as the argument to map-atoms, so it is called once for every |
167 ;; symbol in obarray. Takes one argument SYMBOL, and finds any memory-resident | 212 ;; symbol in obarray. Takes one argument SYMBOL, and finds any memory-resident |
168 ;; documentation on that symbol if it matches a variable regexp. | 213 ;; documentation on that symbol if it matches a variable regexp. |
169 | 214 |
170 (defun super-apropos-accumulate (symbol) | 215 (defun super-apropos-accumulate (symbol) |
171 (cond ((string-match apropos-regexp (symbol-name symbol)) | 216 (let (doc) |
172 (setq apropos-item (apropos-get-accum-item symbol)) | 217 (cond ((string-match apropos-regexp (symbol-name symbol)) |
173 (setcar (cdr apropos-item) (or (safe-documentation symbol) | 218 (setq apropos-item (apropos-get-accum-item symbol)) |
174 (nth 1 apropos-item))) | 219 (setcar (cdr apropos-item) |
175 (setcar (nthcdr 2 apropos-item) (or (safe-documentation-property symbol) | 220 (or (safe-documentation symbol) |
176 (nth 2 apropos-item)))) | 221 (nth 1 apropos-item))) |
177 (t | 222 (setcar (nthcdr 2 apropos-item) |
178 (and (setq apropos-fn-doc (safe-documentation symbol)) | 223 (or (safe-documentation-property symbol) |
179 (string-match apropos-regexp apropos-fn-doc) | 224 (nth 2 apropos-item)))) |
180 (setcar (cdr (apropos-get-accum-item symbol)) apropos-fn-doc)) | 225 ((or (consp (setq doc (safe-documentation symbol))) |
181 (and (setq apropos-var-doc (safe-documentation-property symbol)) | 226 (consp (setq doc (safe-documentation-property symbol)))) |
182 (string-match apropos-regexp apropos-var-doc) | 227 ;; This symbol's doc is stored in a file. |
183 (setcar (nthcdr 2 (apropos-get-accum-item symbol)) | 228 ;; Scan the file if we have not scanned it before. |
184 apropos-var-doc)))) | 229 (let ((file (car doc))) |
230 (or (member file apropos-files-scanned) | |
231 (progn | |
232 (setq apropos-files-scanned | |
233 (cons file apropos-files-scanned)) | |
234 (super-apropos-check-elc-file apropos-regexp file))))) | |
235 (t | |
236 (and (stringp (setq doc (safe-documentation symbol))) | |
237 (setq apropos-fn-doc doc) | |
238 (string-match apropos-regexp apropos-fn-doc) | |
239 (setcar (cdr (apropos-get-accum-item symbol)) apropos-fn-doc)) | |
240 (and (stringp (setq doc (safe-documentation-property symbol))) | |
241 (setq apropos-var-doc doc) | |
242 (string-match apropos-regexp apropos-var-doc) | |
243 (setcar (nthcdr 2 (apropos-get-accum-item symbol)) | |
244 apropos-var-doc))))) | |
185 nil) | 245 nil) |
186 | 246 |
187 ;; Prints the symbols and documentation in alist MATCHES of form ((symbol | 247 ;; Prints the symbols and documentation in alist MATCHES of form ((symbol |
188 ;; fn-doc var-doc) ...). Uses optional argument REGEXP to speed up searching | 248 ;; fn-doc var-doc) ...). Uses optional argument REGEXP to speed up searching |
189 ;; for keybindings. The names of all symbols in MATCHES must match REGEXP. | 249 ;; for keybindings. The names of all symbols in MATCHES must match REGEXP. |
241 (if (> (length substed) 67) | 301 (if (> (length substed) 67) |
242 (princ "\n "))) | 302 (princ "\n "))) |
243 (princ substed)))) | 303 (princ substed)))) |
244 (or (bolp) (terpri))) | 304 (or (bolp) (terpri))) |
245 (help-mode))) | 305 (help-mode))) |
246 t) | 306 matches) |
247 | 307 |
248 ;; Find key bindings for symbols that are cars in ALIST. Optionally, first | 308 ;; Find key bindings for symbols that are cars in ALIST. Optionally, first |
249 ;; match the symbol name against REGEXP. Modifies ALIST in place. Each key | 309 ;; match the symbol name against REGEXP. Modifies ALIST in place. Each key |
250 ;; binding is added as a string to the end of the list in ALIST whose car is | 310 ;; binding is added as a string to the end of the list in ALIST whose car is |
251 ;; the corresponding symbol. The pointer to ALIST is returned. | 311 ;; the corresponding symbol. The pointer to ALIST is returned. |
366 (setq function (if (fboundp function) | 426 (setq function (if (fboundp function) |
367 (symbol-function function) | 427 (symbol-function function) |
368 0))) | 428 0))) |
369 (if (eq (car-safe function) 'macro) | 429 (if (eq (car-safe function) 'macro) |
370 (setq function (cdr function))) | 430 (setq function (cdr function))) |
371 (if (not (consp function)) | 431 (if (byte-code-function-p function) |
372 nil | 432 (if (> (length function) 4) |
373 (if (not (memq (car function) '(lambda autoload))) | 433 (aref function 4)) |
434 (if (not (consp function)) | |
374 nil | 435 nil |
375 (setq function (nth 2 function)) | 436 (if (not (memq (car function) '(lambda autoload))) |
376 (if (stringp function) | 437 nil |
377 function | 438 (setq function (nth 2 function)) |
378 nil)))) | 439 (if (stringp function) |
440 function | |
441 nil))))) | |
379 | 442 |
380 (defun safe-documentation-property (symbol) | 443 (defun safe-documentation-property (symbol) |
381 "Like documentation-property, except it avoids calling `get_doc_string'. | 444 "Like documentation-property, except it avoids calling `get_doc_string'. |
382 Will return nil instead." | 445 Will return nil instead." |
383 (setq symbol (get symbol 'variable-documentation)) | 446 (setq symbol (get symbol 'variable-documentation)) |