Mercurial > hg > xemacs-beta

comparison lisp/apropos.el @ 444:576fb035e263 r21-2-37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 7039e6323819
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
375 375
376 376
377 ;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name. 377 ;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name.
378 378
379 (defun apropos-documentation-check-doc-file () 379 (defun apropos-documentation-check-doc-file ()
380 (let (type symbol (sepa 2) sepb beg end doc) 380 (let (type symbol (sepa 2) sepb start end doc)
381 (insert ?\^_) 381 (insert ?\^_)
382 (backward-char) 382 (backward-char)
383 (insert-file-contents (concat doc-directory internal-doc-file-name)) 383 (insert-file-contents (concat doc-directory internal-doc-file-name))
384 (forward-char) 384 (forward-char)
385 (while (save-excursion 385 (while (save-excursion
388 (beginning-of-line 2) 388 (beginning-of-line 2)
389 (if (save-restriction 389 (if (save-restriction
390 (narrow-to-region (point) (1- sepb)) 390 (narrow-to-region (point) (1- sepb))
391 (re-search-forward apropos-regexp nil t)) 391 (re-search-forward apropos-regexp nil t))
392 (progn 392 (progn
393 (setq beg (match-beginning 0) 393 (setq start (match-beginning 0)
394 end (point)) 394 end (point))
395 (goto-char (1+ sepa)) 395 (goto-char (1+ sepa))
396 (or (setq type (if (eq ?F (preceding-char)) 396 (or (setq type (if (eq ?F (preceding-char))
397 1 ; function documentation 397 1 ; function documentation
398 2) ; variable documentation 398 2) ; variable documentation
399 symbol (read) 399 symbol (read)
400 beg (- beg (point) 1) 400 start (- start (point) 1)
401 end (- end (point) 1) 401 end (- end (point) 1)
402 doc (buffer-substring (1+ (point)) (1- sepb)) 402 doc (buffer-substring (1+ (point)) (1- sepb))
403 apropos-item (assq symbol apropos-accumulator)) 403 apropos-item (assq symbol apropos-accumulator))
404 (setq apropos-item (list symbol nil nil) 404 (setq apropos-item (list symbol nil nil)
405 apropos-accumulator (cons apropos-item 405 apropos-accumulator (cons apropos-item
406 apropos-accumulator))) 406 apropos-accumulator)))
407 (if apropos-match-face 407 (if apropos-match-face
408 (put-text-property beg end 'face apropos-match-face doc)) 408 (put-text-property start end 'face apropos-match-face doc))
409 (setcar (nthcdr type apropos-item) doc))) 409 (setcar (nthcdr type apropos-item) doc)))
410 (setq sepa (goto-char sepb))))) 410 (setq sepa (goto-char sepb)))))
411 411
412 (defun apropos-documentation-check-elc-file (file) 412 (defun apropos-documentation-check-elc-file (file)
413 (if (member file apropos-files-scanned) 413 (if (member file apropos-files-scanned)
414 nil 414 nil
415 (let (symbol doc beg end this-is-a-variable) 415 (let (symbol doc start end this-is-a-variable)
416 (setq apropos-files-scanned (cons file apropos-files-scanned)) 416 (setq apropos-files-scanned (cons file apropos-files-scanned))
417 (erase-buffer) 417 (erase-buffer)
418 (insert-file-contents file) 418 (insert-file-contents file)
419 (while (search-forward "\n#@" nil t) 419 (while (search-forward "\n#@" nil t)
420 ;; Read the comment length, and advance over it. 420 ;; Read the comment length, and advance over it.
421 (setq end (read) 421 (setq end (read)
422 beg (1+ (point)) 422 start (1+ (point))
423 end (+ (point) end -1)) 423 end (+ (point) end -1))
424 (forward-char) 424 (forward-char)
425 (if (save-restriction 425 (if (save-restriction
426 ;; match ^ and $ relative to doc string 426 ;; match ^ and $ relative to doc string
427 (narrow-to-region beg end) 427 (narrow-to-region start end)
428 (re-search-forward apropos-regexp nil t)) 428 (re-search-forward apropos-regexp nil t))
429 (progn 429 (progn
430 (goto-char (+ end 2)) 430 (goto-char (+ end 2))
431 (setq doc (buffer-substring beg end) 431 (setq doc (buffer-substring start end)
432 end (- (match-end 0) beg) 432 end (- (match-end 0) start)
433 beg (- (match-beginning 0) beg) 433 start (- (match-beginning 0) start)
434 this-is-a-variable (looking-at "(def\\(var\\|const\\) ") 434 this-is-a-variable (looking-at "(def\\(var\\|const\\) ")
435 symbol (progn 435 symbol (progn
436 (skip-chars-forward "(a-z") 436 (skip-chars-forward "(a-z")
437 (forward-char) 437 (forward-char)
438 (read)) 438 (read))
446 (or (setq apropos-item (assq symbol apropos-accumulator)) 446 (or (setq apropos-item (assq symbol apropos-accumulator))
447 (setq apropos-item (list symbol nil nil) 447 (setq apropos-item (list symbol nil nil)
448 apropos-accumulator (cons apropos-item 448 apropos-accumulator (cons apropos-item
449 apropos-accumulator))) 449 apropos-accumulator)))
450 (if apropos-match-face 450 (if apropos-match-face
451 (put-text-property beg end 'face apropos-match-face 451 (put-text-property start end 'face apropos-match-face
452 doc)) 452 doc))
453 (setcar (nthcdr (if this-is-a-variable 2 1) 453 (setcar (nthcdr (if this-is-a-variable 2 1)
454 apropos-item) 454 apropos-item)
455 doc))))))))) 455 doc)))))))))
456 456