Mercurial > emacs

comparison lisp/apropos.el @ 22532:5a83f0f3b29d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(apropos-print): Delete arg DOC-FN. Callers changed to do that work before calling apropos-print. Make *Apropos* buffer read only.
author Karl Heuer <kwzh@gnu.org>
date Sat, 20 Jun 1998 22:27:06 +0000
parents 500bc7f67524
children ac8f85b1733c
comparison
equal deleted inserted replaced
22531:ab25969db484 22532:5a83f0f3b29d
187 (let ((tem apropos-accumulator)) 187 (let ((tem apropos-accumulator))
188 (while tem 188 (while tem
189 (if (get (car tem) 'apropos-inhibit) 189 (if (get (car tem) 'apropos-inhibit)
190 (setq apropos-accumulator (delq (car tem) apropos-accumulator))) 190 (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
191 (setq tem (cdr tem)))) 191 (setq tem (cdr tem))))
192 (if (apropos-print 192 (let ((p apropos-accumulator)
193 t 193 doc symbol)
194 (lambda (p) 194 (while p
195 (let (doc symbol) 195 (setcar p (list
196 (while p 196 (setq symbol (car p))
197 (setcar p (list 197 (unless var-predicate
198 (setq symbol (car p)) 198 (if (functionp symbol)
199 (unless var-predicate 199 (if (setq doc (documentation symbol t))
200 (if (functionp symbol) 200 (substring doc 0 (string-match "\n" doc))
201 (if (setq doc (documentation symbol t)) 201 "(not documented)")))
202 (substring doc 0 (string-match "\n" doc)) 202 (and var-predicate
203 "(not documented)"))) 203 (funcall var-predicate symbol)
204 (and var-predicate 204 (if (setq doc (documentation-property
205 (funcall var-predicate symbol) 205 symbol 'variable-documentation t))
206 (if (setq doc (documentation-property 206 (substring doc 0
207 symbol 'variable-documentation t)) 207 (string-match "\n" doc))))))
208 (substring doc 0 208 (setq p (cdr p))))
209 (string-match "\n" doc)))))) 209 (and (apropos-print t nil)
210 (setq p (cdr p))))) 210 message
211 nil) 211 (message message))))
212 (and message (message message)))))
213 212
214 213
215 ;;;###autoload 214 ;;;###autoload
216 (defun apropos (apropos-regexp &optional do-all) 215 (defun apropos (apropos-regexp &optional do-all)
217 "Show all bound symbols whose names match REGEXP. 216 "Show all bound symbols whose names match REGEXP.
231 (let ((tem apropos-accumulator)) 230 (let ((tem apropos-accumulator))
232 (while tem 231 (while tem
233 (if (get (car tem) 'apropos-inhibit) 232 (if (get (car tem) 'apropos-inhibit)
234 (setq apropos-accumulator (delq (car tem) apropos-accumulator))) 233 (setq apropos-accumulator (delq (car tem) apropos-accumulator)))
235 (setq tem (cdr tem)))) 234 (setq tem (cdr tem))))
235 (let ((p apropos-accumulator)
236 symbol doc properties)
237 (while p
238 (setcar p (list
239 (setq symbol (car p))
240 (when (fboundp symbol)
241 (if (setq doc (condition-case nil
242 (documentation symbol t)
243 (void-function
244 "(alias for undefined function)")))
245 (substring doc 0 (string-match "\n" doc))
246 "(not documented)"))
247 (when (boundp symbol)
248 (if (setq doc (documentation-property
249 symbol 'variable-documentation t))
250 (substring doc 0 (string-match "\n" doc))
251 "(not documented)"))
252 (when (setq properties (symbol-plist symbol))
253 (setq doc (list (car properties)))
254 (while (setq properties (cdr (cdr properties)))
255 (setq doc (cons (car properties) doc)))
256 (mapconcat #'symbol-name (nreverse doc) " "))
257 (when (get symbol 'widget-type)
258 (if (setq doc (documentation-property
259 symbol 'widget-documentation t))
260 (substring doc 0
261 (string-match "\n" doc))
262 "(not documented)"))
263 (when (facep symbol)
264 (if (setq doc (documentation-property
265 symbol 'face-documentation t))
266 (substring doc 0
267 (string-match "\n" doc))
268 "(not documented)"))
269 (when (get symbol 'custom-group)
270 (if (setq doc (documentation-property
271 symbol 'group-documentation t))
272 (substring doc 0
273 (string-match "\n" doc))
274 "(not documented)"))))
275 (setq p (cdr p))))
236 (apropos-print 276 (apropos-print
237 (or do-all apropos-do-all) 277 (or do-all apropos-do-all)
238 (lambda (p)
239 (let (symbol doc properties)
240 (while p
241 (setcar p (list
242 (setq symbol (car p))
243 (when (fboundp symbol)
244 (if (setq doc (condition-case nil
245 (documentation symbol t)
246 (void-function
247 "(alias for undefined function)")))
248 (substring doc 0 (string-match "\n" doc))
249 "(not documented)"))
250 (when (boundp symbol)
251 (if (setq doc (documentation-property
252 symbol 'variable-documentation t))
253 (substring doc 0 (string-match "\n" doc))
254 "(not documented)"))
255 (when (setq properties (symbol-plist symbol))
256 (setq doc (list (car properties)))
257 (while (setq properties (cdr (cdr properties)))
258 (setq doc (cons (car properties) doc)))
259 (mapconcat #'symbol-name (nreverse doc) " "))
260 (when (get symbol 'widget-type)
261 (if (setq doc (documentation-property
262 symbol 'widget-documentation t))
263 (substring doc 0
264 (string-match "\n" doc))
265 "(not documented)"))
266 (when (facep symbol)
267 (if (setq doc (documentation-property
268 symbol 'face-documentation t))
269 (substring doc 0
270 (string-match "\n" doc))
271 "(not documented)"))
272 (when (get symbol 'custom-group)
273 (if (setq doc (documentation-property
274 symbol 'group-documentation t))
275 (substring doc 0
276 (string-match "\n" doc))
277 "(not documented)"))))
278 (setq p (cdr p)))))
279 nil)) 278 nil))
280 279
281 280
282 ;;;###autoload 281 ;;;###autoload
283 (defun apropos-value (apropos-regexp &optional do-all) 282 (defun apropos-value (apropos-regexp &optional do-all)
299 (setq f (apropos-value-internal 'fboundp symbol 'symbol-function) 298 (setq f (apropos-value-internal 'fboundp symbol 'symbol-function)
300 p (apropos-format-plist symbol "\n " t))) 299 p (apropos-format-plist symbol "\n " t)))
301 (if (or f v p) 300 (if (or f v p)
302 (setq apropos-accumulator (cons (list symbol f v p) 301 (setq apropos-accumulator (cons (list symbol f v p)
303 apropos-accumulator)))))) 302 apropos-accumulator))))))
304 (apropos-print nil nil t)) 303 (apropos-print nil t))
305 304
306 305
307 ;;;###autoload 306 ;;;###autoload
308 (defun apropos-documentation (apropos-regexp &optional do-all) 307 (defun apropos-documentation (apropos-regexp &optional do-all)
309 "Show symbols whose documentation contain matches for REGEXP. 308 "Show symbols whose documentation contain matches for REGEXP.
337 (if v 336 (if v
338 (setcar (cdr apropos-item) v))) 337 (setcar (cdr apropos-item) v)))
339 (setq apropos-accumulator 338 (setq apropos-accumulator
340 (cons (list symbol f v) 339 (cons (list symbol f v)
341 apropos-accumulator))))))) 340 apropos-accumulator)))))))
342 (apropos-print nil nil t)) 341 (apropos-print nil t))
343 (kill-buffer standard-input)))) 342 (kill-buffer standard-input))))
344 343
345 344
346 (defun apropos-value-internal (predicate symbol function) 345 (defun apropos-value-internal (predicate symbol function)
347 (if (funcall predicate symbol) 346 (if (funcall predicate symbol)
493 nil 492 nil
494 function)) 493 function))
495 494
496 495
497 496
498 (defun apropos-print (do-keys doc-fn spacing) 497 (defun apropos-print (do-keys spacing)
499 "Output result of various apropos commands with `apropos-regexp'. 498 "Output result of apropos searching into buffer `*Apropos*'.
500 APROPOS-ACCUMULATOR is a list. Optional DOC-FN is called for each element 499 The value of `apropos-accumulator' is the list of items to output.
501 of apropos-accumulator and may modify it resulting in (SYMBOL FN-DOC 500 Each element should have the format (SYMBOL FN-DOC VAR-DOC [PLIST-DOC]).
502 VAR-DOC [PLIST-DOC]). Returns sorted list of symbols and documentation 501 The return value is the list that was in `apropos-accumulator', sorted
503 found." 502 alphabetically by symbol name; but this function also sets
503 `apropos-accumulator' to nil before returning."
504 (if (null apropos-accumulator) 504 (if (null apropos-accumulator)
505 (message "No apropos matches for `%s'" apropos-regexp) 505 (message "No apropos matches for `%s'" apropos-regexp)
506 (if doc-fn
507 (funcall doc-fn apropos-accumulator))
508 (setq apropos-accumulator 506 (setq apropos-accumulator
509 (sort apropos-accumulator (lambda (a b) 507 (sort apropos-accumulator (lambda (a b)
510 (string-lessp (car a) (car b))))) 508 (string-lessp (car a) (car b)))))
511 (and apropos-label-face 509 (and apropos-label-face
512 (symbolp apropos-label-face) 510 (symbolp apropos-label-face)
597 (apropos-print-doc 'describe-variable 2 "Variable" t) 595 (apropos-print-doc 'describe-variable 2 "Variable" t)
598 (apropos-print-doc 'customize-group-other-window 6 "Group" t) 596 (apropos-print-doc 'customize-group-other-window 6 "Group" t)
599 (apropos-print-doc 'customize-face-other-window 5 "Face" t) 597 (apropos-print-doc 'customize-face-other-window 5 "Face" t)
600 (apropos-print-doc 'widget-browse-other-window 4 "Widget" t) 598 (apropos-print-doc 'widget-browse-other-window 4 "Widget" t)
601 (apropos-print-doc 'apropos-describe-plist 3 599 (apropos-print-doc 'apropos-describe-plist 3
602 "Plist" nil))))) 600 "Plist" nil))
601 (setq buffer-read-only t))))
603 (prog1 apropos-accumulator 602 (prog1 apropos-accumulator
604 (setq apropos-accumulator ()))) ; permit gc 603 (setq apropos-accumulator ()))) ; permit gc
605 604
606 605
607 (defun apropos-macrop (symbol) 606 (defun apropos-macrop (symbol)