legacy-dotfiles/emacs.d/nxhtml/alts/find-recursive-orig.el

;; find-recursive.el -- Find files recursively into a directory
;;
;; Copyright (C) 2001 Ovidiu Predescu
;;
;; Author: Ovidiu Predescu <ovidiu@cup.hp.com>
;; Date: March 26, 2001
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;
;; Setup: put this file in your Lisp path and add the following line in
;; your .emacs:
;;
;; (require 'find-recursive)
;;

(require 'cl)

(defcustom find-recursive-exclude-files '(".*.class$" ".*~$" ".*.elc$")
  "List of regular expressions of files to be excluded when recursively searching for files."
  :type '(repeat (string :tag "File regexp")))

(defun find-file-recursively (file-regexp directory)
  (interactive "sFile name to search for recursively: \nDIn directory: ")
  (let ((directory (if (equal (substring directory -1) "/")
                       directory
                     (concat directory "/")))
        (matches
         (find-recursive-filter-out
          find-recursive-exclude-files
          (find-recursive-directory-relative-files directory "" file-regexp))))
    (cond ((eq (length matches) 0) (message "No file(s) found!"))
           ((eq (length matches) 1)
            (find-file (concat directory (car matches))))
           (t
            (run-with-timer 0.001 nil
                            (lambda ()
                              (dispatch-event
                               (make-event 'key-press '(key tab)))))
            (let ((file (completing-read "Choose file: "
                                           (mapcar 'list matches)
                                           nil t)))
                (if (or (eq file nil) (equal file ""))
                    (message "No file selected.")
                  (find-file (concat directory file))))))))

(defun find-recursive-directory-relative-files (directory
                                          relative-directory
                                          file-regexp)
  (let* ((full-dir (concat directory "/" relative-directory))
         (matches
          (mapcar
           (function (lambda (x)
                       (concat relative-directory x)))
           (find-recursive-filter-out '(nil)
                                (directory-files full-dir nil
                                                 file-regexp nil t))))
         (inner
          (mapcar
           (function
            (lambda (dir)
              (find-recursive-directory-relative-files directory
                                                 (concat relative-directory
                                                         dir "/")
                                                 file-regexp)))
           (find-recursive-filter-out '(nil "\\." "\\.\\.")
                                (directory-files full-dir nil ".*"
                                                 nil 'directories)))))
    (mapcar (function (lambda (dir) (setq matches (append matches dir))))
            inner)
    matches))

(defun find-recursive-filter-out (remove-list list)
  "Remove all the elements in *remove-list* from *list*"
  (if (eq list nil)
      nil
    (let ((elem (car list))
          (rest (cdr list)))
      (if (some
           (lambda (regexp)
             (if (or (eq elem nil) (eq regexp nil))
                 nil
               (not (eq (string-match regexp elem) nil))))
           remove-list)
          (find-recursive-filter-out remove-list rest)
        (cons elem (find-recursive-filter-out remove-list rest))))))

(defvar find-recursive-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))

(if find-recursive-running-xemacs
    nil
  (defadvice directory-files (after
                              directory-files-xemacs
                              (dirname &optional full match nosort files-only)
                              activate)
    "Add an additional argument, FILES-ONLY to the list of arguments
for GNU Emacs. If the symbol is t, then only the files in the
directory will be returned. If FILES-ONLY is nil, then both files and
directories are selected. If FILES-ONLY is not nil and not t, then
only sundirectories are returned."
    (setq ad-return-value
          (cond ((null files-only) ad-return-value)
                ((eq files-only t)
                 (find-recursive-remove-if (lambda (f)
                                             (file-directory-p
                                              (concat dirname "/" f)))
                                           ad-return-value))
                (t
                 (find-recursive-remove-if (lambda (f)
                                             (not (file-directory-p
                                                   (concat dirname "/" f))))
                                           ad-return-value)))))

  (defun find-recursive-remove-if (func list)
    "Removes all elements satisfying FUNC from LIST."
    (let ((result nil))
      (while list
        (if (not (funcall func (car list)))
            (setq result (cons (car list) result)))
        (setq list (cdr list)))
      (nreverse result))))

(global-set-key [(control x) (meta f)] 'find-file-recursively)

(provide 'find-recursive)