Some useful idrectory functions

[Davin Pearson]

;;; directory-files-deep.el --- Some useful directory functions

;; Copyright (C) 2006-2011 Davin Pearson

;; Author/Maintainer: Davin Pearson http://www.davinpearson.com
;; Keywords: Recursive directory functions
;; Version: 1.0

;;; Limitation of Warranty

;; This file 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, or (at your option)
;; any later version.

;; This file 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
Floor,
;; Boston, MA 02110-1301, USA.

;;; Install Instructions:

;; See the following URL for the latest info and a tarball:

;; http://davin.50webs.com/research/2006/mopa2e.html#cfm

;; Extract the file in the above-mentioned tarball and put it
;; somewhere in load-path and load it by putting the following
;; command in your .emacs file:
;;
;; (require 'cfm)

;;; Known Bugs:

;; none so far!

;; (directory-files-no-dotdotdot "c:/bak-unix/" )
(defun directory-files-no-dotdotdot (directory &optional full match
nosort)
  "Author: Davin Pearson http://www.davinpearson.com";
  (let* ((case-fold-search t)
         (list (directory-files directory full match nosort))
         (ptr list))
    (while ptr
      (if (string-match "/\\.$" (car ptr))
          (setcar ptr "."))
      (if (string-match "/\\..$" (car ptr))
          (setcar ptr ".."))
      (setq ptr (cdr ptr)))
    (setq list (delete "." list))
    (setq list (delete ".." list))
    list))

;;(setq directory "~/cosc/")
;;(setq full t)
;;(setq match "\\.java$")
;;(setq nosort nil)
;;(directory-files-subdirs "~/3-libd/")
;;
(defun directory-files-subdirs (directory &optional full match nosort)
  "Author: Davin Pearson http://www.davinpearson.com
   NOTE: no .. and ."
  (let* ((case-fold-search t)
         (list (directory-files-no-dotdotdot directory full match
nosort))
         (ptr  list)
         (dir  nil))

    (setq directory (expand-file-name directory))

    ;; REMOVE TRAILING SLASH:
    (if (string-match "\\(.*\\)/$" directory)
        (setq directory (substring directory (match-beginning 1)
(match-end 1))))

    (while ptr

      (setq dir (if full (car ptr) (concat directory "/" (car ptr))))

      (if (or (not (file-directory-p dir))
              (file-symlink-p dir))
          (setcar ptr nil))

      (setq ptr (cdr ptr)))

    (setq list (delete nil list))))

;; (setq directory "~/")
;; (setq full      nil)
;; (setq match     nil)
;; (setq nosort    nil)
;; (setq list      (directory-files-no-dotdotdot directory full match
nosort))
;; (setq ptr       list)
(defun directory-files-no-subdirs (directory &optional full match
nosort)
  "Author: Davin Pearson http://www.davinpearson.com
   NOTE: no .. and ."
  (let* ((case-fold-search t)
         (list (directory-files-no-dotdotdot directory full match
nosort))
         (ptr  list))

    ;; REMOVE TRAILING SLASH:
    (if (string-match "\\(.*\\)/$" directory)
        (setq directory (substring directory (match-beginning 1)
(match-end 1))))

    (while ptr
      (if (file-directory-p (if full (car ptr) (concat directory
"/" (car ptr))))
          (setcar ptr nil))
      (setq ptr (cdr ptr)))

    (setq list (delete nil list))
    list)
  )

(quote defun directory-files-deep-inner--string-lessp (string-1
string-2)

  "Author: Davin Pearson http://www.davinpearson.com";

  (let ((dir-1 nil)
        (dir-2 nil))

    ;;
    ;; WARNING: accesses global variables: full and directory
    ;;

    (if (not (boundp 'full))
        (error "Variable full not bound"))

    (if (not (boundp 'directory))
        (error "Variable directory not bound"))

    ;; SET DIR VARS ONE:
    ;;
    (if (file-directory-p (if full string-1 (concat directory "/"
string-1)))
        (progn
          (setq dir-1 string-1)
          (setq string-1 ""))
      (progn
        (setq dir-1    (file-name-directory string-1))
        (setq string-1 (file-name-nondirectory string-1))))

    (if (not dir-1) (setq dir-1 ""))
    (if (not string-1) (setq string-1 ""))

    ;;
-------------------------------------------------------------------

    ;; SET DIR VARS TWO:
    ;;
    (if (file-directory-p (if full string-2 (concat directory "/"
string-2)))
        (progn
          (setq dir-2 string-2)
          (setq string-2 ""))
      (progn
        (setq dir-2    (file-name-directory string-2))
        (setq string-2 (file-name-nondirectory string-2))))

    (if (not dir-2) (setq dir-2 ""))
    (if (not string-2) (setq string-2 ""))

    ;;
-------------------------------------------------------------------

    ;;(setq g-string-1 string-1)
    ;;(setq g-string-2 string-2)

    ;; (directory-files-deep-inner--string-lessp "lab9" "lab9.tar")
    ;; g-string-1 dir-1
    ;; g-string-2 dir-2

    (cond

     ((string= dir-1 dir-2)
      (string-lessp string-1 string-2))

     ;;   ((and (string= "" dir-1)
     ;;         (not (string= "" dir-2)))
     ;;    t)
     ;;
     ;;   ((and (not (string= "" dir-1))
     ;;         (string= "" dir-2))
     ;;    nil)
     ;;
     (t
      (string-lessp dir-1 dir-2)))
    )
  )

(defun directory-files-deep-inner (directory &optional full match
nosort)
  "Author: Davin Pearson http://www.davinpearson.com
  NOTE: no .. and ."

  ;; REMOVE MULTIPLE SLASHES:
  (setq directory (expand-file-name directory))

  ;; REMOVE TRAILING SLASH:
  (if (string-match "\\(.*\\)/$" directory)
      (setq directory (substring directory (match-beginning 1) (match-
end 1))))

  (message "Fn directory-files-deep scanning directory %s " directory)

  (let*
      ;; (directory-files-deep "~/old-sources/" nil "djgpp")
      ((list-files-that-match (directory-files-no-dotdotdot directory
full match nosort))
       (list-all-subdirs      (directory-files-subdirs directory full
nil nosort))
       (return-list           list-files-that-match)
       (ptr                   nil)
       (sub-files-list        nil))

;;    ;; ADD SLASH TO DIR FILES:
;;    (setq ptr list-files-that-match)
;;    (while ptr
;;      (if (file-directory-p (if full (car ptr) (concat directory
"/" (car ptr))))
;;          (setcar ptr (concat (car ptr) "/")))
;;      (setq ptr (cdr ptr)))
;;
    ;; DESCEND RECURSIVELY INTO DIRS:
    (setq ptr list-all-subdirs)
    (while ptr

      (setq sub-files-list (directory-files-deep-inner (if full (car
ptr)
                                                         (concat
directory "/" (car ptr)))
                                                       full match
nosort))

      ;;(setq sub-files-list (list (concat "directory-files-
deep" (concat directory "/" (car ptr)))))

      ;;(message "sub-files-list = %s" sub-files-list)

      (if (not full)

          (setq sub-files-list (mapcar '(lambda (filename)
                                          (concat (car ptr) "/"
filename)
                                          ;;"egg"
                                          ) sub-files-list)))

      ;;(message "sub-files-list after procesing = %s" sub-files-list)

      (setq return-list (append sub-files-list return-list))

      (setq ptr (cdr ptr)))

    (setq return-list (delete-duplicates return-list :test 'string=))

    ;; SORT THE LIST:
    (if (not nosort)
        (setq return-list (sort* return-list
                                 'string<;;'directory-files-deep-
inner--string-lessp
                                 :key 'downcase)))

    return-list))

;;; (setq list (directory-files-deep "d:/home/hairy-lemon/web/
java_tutorials/"))
(defun directory-files-deep (directory &optional full match nosort)
  "Author: Davin Pearson http://www.davinpearson.com NOTE: no ..
and ."
  ;;  (interactive "D")
  (let ((case-fold-search t)
        (result (directory-files-deep-inner directory full match
nosort)))
    ;;(d-beep)
    result))

(provide 'directory-files-deep)