1  ;; find-recursive.el -- Find files recursively into a directory
  2  ;;
  3  ;; Copyright (C) 2001 Ovidiu Predescu 
  4  ;; 
  5  ;; Author: Ovidiu Predescu <ovidiu@cup.hp.com>
  6  ;; Date: March 26, 2001
  7  ;;
  8  ;; This program is free software; you can redistribute it and/or 
  9  ;; modify it under the terms of the GNU General Public License 
 10  ;; as published by the Free Software Foundation; either version 2 
 11  ;; of the License, or (at your option) any later version. 
 12  ;;  
 13  ;; This program is distributed in the hope that it will be useful, 
 14  ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 
 15  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 16  ;; GNU General Public License for more details. 
 17  ;;  
 18  ;; You should have received a copy of the GNU General Public License 
 19  ;; along with this program; if not, write to the Free Software 
 20  ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 
 21   
 22  ;; 
 23  ;; Setup: put this file in your Lisp path and add the following line in 
 24  ;; your .emacs: 
 25  ;; 
 26  ;; (require 'find-recursive) 
 27  ;; 
 28  
 29  (require 'cl)
 30  
 31  (defcustom find-recursive-exclude-files '(".*.class$" ".*~$" ".*.elc$")
 32    "List of regular expressions of files to be excluded when recursively searching for files."
 33    :type '(repeat (string :tag "File regexp")))
 34  
 35  (defun find-file-recursively (file-regexp directory)
 36    (interactive "sFile name to search for recursively: \nDIn directory: ")
 37    (let ((directory (if (equal (substring directory -1) "/")
 38  		       directory
 39  		     (concat directory "/")))
 40  	(matches
 41  	 (find-recursive-filter-out
 42  	  find-recursive-exclude-files
 43  	  (find-recursive-directory-relative-files directory "" file-regexp))))
 44      (cond ((eq (length matches) 0) (message "No file(s) found!"))
 45  	   ((eq (length matches) 1)
 46  	    (find-file (concat directory (car matches))))
 47  	   (t
 48  	    (run-with-timer 0.001 nil
 49  			    (lambda ()
 50  			      (dispatch-event
 51  			       (make-event 'key-press '(key tab)))))
 52  	    (let ((file (completing-read "Choose file: "
 53  					   (mapcar 'list matches)
 54  					   nil t)))
 55  		(if (or (eq file nil) (equal file ""))
 56  		    (message "No file selected.")
 57  		  (find-file (concat directory file))))))))
 58  
 59  (defun find-recursive-directory-relative-files (directory
 60  					  relative-directory
 61  					  file-regexp)
 62    (let* ((full-dir (concat directory "/" relative-directory))
 63  	 (matches
 64  	  (mapcar
 65  	   (function (lambda (x)
 66  		       (concat relative-directory x)))
 67  	   (find-recursive-filter-out '(nil)
 68  				(directory-files full-dir nil
 69  						 file-regexp nil t))))
 70  	 (inner
 71  	  (mapcar
 72  	   (function
 73  	    (lambda (dir)
 74  	      (find-recursive-directory-relative-files directory
 75  						 (concat relative-directory
 76  							 dir "/")
 77  						 file-regexp)))
 78  	   (find-recursive-filter-out '(nil "\\." "\\.\\.")
 79  				(directory-files full-dir nil ".*"
 80  						 nil 'directories)))))
 81      (mapcar (function (lambda (dir) (setq matches (append matches dir))))
 82  	    inner)
 83      matches))
 84  
 85  (defun find-recursive-filter-out (remove-list list)
 86    "Remove all the elements in *remove-list* from *list*"
 87    (if (eq list nil)
 88        nil
 89      (let ((elem (car list))
 90  	  (rest (cdr list)))
 91        (if (some
 92  	   (lambda (regexp)
 93  	     (if (or (eq elem nil) (eq regexp nil))
 94  		 nil
 95  	       (not (eq (string-match regexp elem) nil))))
 96  	   remove-list)
 97  	  (find-recursive-filter-out remove-list rest)
 98  	(cons elem (find-recursive-filter-out remove-list rest))))))
 99  
100  (defvar find-recursive-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
101  
102  (if find-recursive-running-xemacs
103      nil
104    (defadvice directory-files (after
105  			      directory-files-xemacs
106  			      (dirname &optional full match nosort files-only)
107  			      activate)
108      "Add an additional argument, FILES-ONLY to the list of arguments
109  for GNU Emacs. If the symbol is t, then only the files in the
110  directory will be returned. If FILES-ONLY is nil, then both files and
111  directories are selected. If FILES-ONLY is not nil and not t, then
112  only sundirectories are returned."
113      (setq ad-return-value
114  	  (cond ((null files-only) ad-return-value)
115  		((eq files-only t)
116  		 (find-recursive-remove-if (lambda (f)
117  					     (file-directory-p
118  					      (concat dirname "/" f)))
119  					   ad-return-value))
120  		(t
121  		 (find-recursive-remove-if (lambda (f)
122  					     (not (file-directory-p
123  						   (concat dirname "/" f))))
124  					   ad-return-value)))))
125  
126    (defun find-recursive-remove-if (func list)
127      "Removes all elements satisfying FUNC from LIST."
128      (let ((result nil))
129        (while list
130  	(if (not (funcall func (car list)))
131  	    (setq result (cons (car list) result)))
132  	(setq list (cdr list)))
133        (nreverse result))))
134  
135  (global-set-key [(control x) (meta f)] 'find-file-recursively)
136  
137  (provide 'find-recursive)