home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / browser2.zip / br-loop.el < prev    next >
Lisp/Scheme  |  1995-02-17  |  8KB  |  227 lines
  1. ;;; CLASS BROWSER FOR C++
  2. ;;; $Id: br-loop.el,v 3.1 1995/02/17 18:19:36 mmann Exp $
  3. ;;;
  4. ;;; **********************************************************************
  5. ;;; Copyright (C) 1993, 1994 Gerd Moellmann. All rights reserved.
  6. ;;; Altenbergstr. 6, D-40235 Duesseldorf, Germany
  7. ;;; 100025.3303@COMPUSERVE.COM
  8. ;;; Suggestions, comments and requests for improvements are welcome.
  9. ;;; **********************************************************************
  10. ;;;
  11. ;;; This version works with both Emacs version 18 and 19, and I want
  12. ;;; to keep it that way. It requires the CL-19 Common Lisp compatibility
  13. ;;; package for Emacs 18 and 19.
  14. ;;;
  15. ;;; Search and replace over files in tree.
  16. ;;; 
  17.  
  18. ;; This file may be made part of the Emacs distribution at the option
  19. ;; of the FSF.
  20.  
  21. ;; This code is distributed in the hope that it will be useful,
  22. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  23. ;; accepts responsibility to anyone for the consequences of using it
  24. ;; or for whether it serves any particular purpose or works at all,
  25. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  26. ;; License for full details.
  27.  
  28. ;; Everyone is granted permission to copy, modify and redistribute
  29. ;; this code, but only under the conditions described in the
  30. ;; GNU Emacs General Public License.   A copy of this license is
  31. ;; supposed to have been given to you along with GNU Emacs so you
  32. ;; can know your rights and responsibilities.  It should be in a
  33. ;; file named COPYING.  Among other things, the copyright notice
  34. ;; and this notice must be preserved on all copies.
  35.  
  36. (require 'cl-19 "cl")
  37. (require 'backquote)
  38. (require 'br-macro)
  39. (require 'br-struc)
  40.  
  41. ;;;
  42. ;;; Increase MAX-LISP-EVAL-DEPTH for Emacs 18. This is necessary to
  43. ;;; be able to compile nested LOOPs here.
  44. ;;; 
  45.  
  46. (eval-when (compile)
  47.   (setq max-lisp-eval-depth (max 300 max-lisp-eval-depth)))
  48.  
  49. (defvar browse-loop-form ()
  50.   "Form for browse-loop-continue. Evaluated for each file in the
  51. tree. If it returns NIL, goes on with the next file.")
  52.  
  53. (defvar browse-next-file-list ()
  54.   "A list of files to be processed for searching, replacing etc.")
  55.  
  56. (defvar browse-next-file-path nil
  57.   "The path relative to which files have to be searched.")
  58.  
  59. (defvar browse-loop-last-file nil
  60.   "The last file visited via browse-loop.")
  61.  
  62. ;;;
  63. ;;; Return an obarray with all files that are mentioned in a tree.
  64. ;;; Only one entry for each file is in the list. If MARKED-ONLY is T, 
  65. ;;; include marked classes only.
  66. ;;; 
  67.  
  68. (defun* tree-files-obarray (&optional marked-only
  69.                       &aux (files (make-vector 1023 0))
  70.                       (i -1))
  71.   (dotrees (tree @tree-obarray)
  72.     (when (or (not marked-only)
  73.           (tree-mark tree))
  74.       (let* ((class (tree-class tree)))
  75.     
  76.     (when (zerop (% (incf i) 20))
  77.       (browse-indicate-progress "Preparing file list" (zerop i)))
  78.  
  79.     ;; Add files mentioned in class description
  80.     (let ((source-file (class-source-file class))
  81.           (file (class-file class)))
  82.       (when source-file (intern source-file files))
  83.       (when file (intern file files)))
  84.  
  85.     ;; For all member lists in this class
  86.     (loop for accessor in member-lists do
  87.           (loop for m in (funcall accessor tree)
  88.             for file = (member-file m)
  89.             for def-file = (member-definition-file m) do
  90.             (when file (intern file files))
  91.             (when def-file (intern def-file files)))))))
  92.   files)
  93.  
  94. ;;;
  95. ;;; Convert files obarray to list form.
  96. ;;; 
  97.   
  98. (defun tree-files (&optional marked-only)
  99.   (loop for x being the symbols of (tree-files-obarray marked-only)
  100.     collect (symbol-name x)))
  101.  
  102. ;;;
  103. ;;; Select next file among files in current tag table.
  104. ;;; Non-nil argument (prefix arg, if interactive) initializes to 
  105. ;;; the beginning of the list of files in the tag table.
  106. ;;; 
  107.  
  108. (defun browse-next-file (&optional initialize tree-buffer)
  109.   (interactive "P")
  110.  
  111.   ;; Call with INITIALIZE non-NIL initializes the files list.
  112.   ;; If more than one tree buffer is loaded, let the user choose
  113.   ;; on which tree (s)he wants to operate.
  114.  
  115.   (when initialize
  116.     (let ((buffer (or tree-buffer (tree-choose-buffer))))
  117.       (save-excursion
  118.     (set-buffer buffer)
  119.     (setq browse-next-file-list (tree-files (tree-marked-exist-p))
  120.           browse-loop-last-file nil
  121.           browse-next-file-path
  122.           (file-name-directory @tags-filename)))))
  123.  
  124.   ;; End of the loop if the stack of files is empty.
  125.  
  126.   (unless browse-next-file-list
  127.     (error "All files processed."))
  128.  
  129.   ;; BROWSE-LOOP-LAST-FILE is the last file that was visited due
  130.   ;; to a call to BROWSE-LOOP (see below). If that file is still
  131.   ;; in memory, and it wasn't modified, throw its buffer away to
  132.   ;; prevent cluttering up the buffer list.
  133.  
  134.   (when browse-loop-last-file
  135.     (let ((buffer (get-file-buffer browse-loop-last-file)))
  136.       (when (and buffer
  137.          (not (buffer-modified-p buffer)))
  138.     (kill-buffer buffer))))
  139.  
  140.   ;; Remember this buffer file name for later deletion, if it
  141.   ;; wasn't visited by other means.
  142.  
  143.   (let ((file (expand-file-name (car browse-next-file-list)
  144.                 browse-next-file-path)))
  145.     (setq browse-loop-last-file (if (get-file-buffer file) nil file))
  146.  
  147.     ;; Find the file and pop the file list. Pop has to be done
  148.     ;; before the file is loaded because FIND-FILE might encounter
  149.     ;; an error, and we want to be able to proceed with the next
  150.     ;; file in this case.
  151.  
  152.     (pop browse-next-file-list)
  153.     (find-file file)))
  154.  
  155. ;;;
  156. ;;; Repeat last operation.
  157. ;;; 
  158.  
  159. ;;;###autoload
  160. (defun browse-loop (&optional first-time tree-buffer)
  161.   "Repeat last operation on files in tree."
  162.   (interactive)
  163.   (when first-time
  164.     (browse-next-file first-time tree-buffer)
  165.     (goto-char (point-min)))
  166.   (while (not (eval browse-loop-form))
  167.     (browse-next-file)
  168.     (message "Scanning file %s..." buffer-file-name)
  169.     (goto-char (point-min))))
  170.  
  171. ;;;
  172. ;;; Search.
  173. ;;; 
  174.  
  175. ;;###autoload
  176. (defun browse-search (regexp)
  177.   "Search for REGEXP in all files in tree. If marked classes exist, process 
  178. marked classes, only. If regular expression is empty go on with last search."
  179.   (interactive "sTree search (regexp): ")
  180.   (if (and (string= regexp "")
  181.        (eq (car browse-loop-form) 're-search-forward))
  182.       (browse-loop)
  183.     (setq browse-loop-form (list 're-search-forward regexp nil t))
  184.     (browse-loop 'first-time)))
  185.  
  186. ;;;
  187. ;;; Query replace.
  188. ;;; 
  189.  
  190. ;;;###autoload
  191. (defun browse-query-replace (from to)
  192.   "Perform query replace over all files in tree. With prefix arg,
  193. process marked classes in the tree, only."
  194.   (interactive 
  195.    "sTree query replace (regexp): \nsTree query replace %s by: ")
  196.   (setq browse-loop-form
  197.     (list 'and (list 'save-excursion
  198.              (list 're-search-forward from nil t))
  199.           (list 'not (list 'perform-replace from to t t nil))))
  200.   (browse-loop 'first-time))
  201.  
  202. ;;;
  203. ;;; Search for some member with completion.
  204. ;;;
  205. ;;; ###autoload
  206.  
  207. (defun browse-search-member-usage (&optional fix-name)
  208.   "Read a member name from the minibuffer and search over files
  209. in tree for something that looks like a call of a function with
  210. that name."
  211.   (interactive)
  212.   (multiple-value-bind
  213.       (tree header tree-buffer)
  214.       (browse-find-tree)
  215.     (unless tree
  216.       (error "No class tree."))
  217.     (let ((name fix-name) class-name regexp)
  218.       (unless name
  219.     (multiple-value-setq (class-name name)
  220.       (browse-tags-read-name header "Find calls of: ")))
  221.       (setq regexp (concat "\\<" name "[ \t]*(")
  222.         browse-loop-form (list 're-search-forward regexp nil t))
  223.       (browse-loop 'first-time tree-buffer))))
  224.   
  225.  
  226. ;; end of `loop.el'.
  227.