site-lisp/find-recursive.el

   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)