directory-files-deep.el

    

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

;; Copyright (C) 2006-2011 Davin Pearson

;; Author/Maintainer: Davin Max Pearson <http://davin.50webs.com>
;; Keywords: Recursive directory functions
;; Package: dlisp (Davin's version of elisp)
;; Version: 1.2

;; This program is part of GNU Java Training Wheels

;;; Limitation of Warranty

;; 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 3 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 GNU Emacs, see the file COPYING.  If not, see:
;;
;; <http://www.gnu.org/licenses/gpl-3.0.txt>.


;;; Commentary:

;; This code provides some useful directory functions, including
;; directory-files-deep for listing the contents of directories
;; and all subfiles and subdirectories.

;;; Install Instructions:
;; See the following URL for the latest info and a tarball:
;;
;; <http://davin.50webs.com/research/2006/mopa2e.html#directory-files-deep>
;;
;; Then untar the tarball to a folder pointed to by the Emacs variable
;; load-path and add the following line to your ~/.emacs file.
;;
;; (require 'directory-files-deep)

;;; Known Bugs:

;; none so far!

;;; Code:

;; (directory-files-no-dotdotdot "c:/bak-unix/" )
(defun directory-files-no-dotdotdot (directory &optional full match nosort)
  "Author: Davin Pearson <http://davin.50webs.com>"
  (let* ((case-fold-search t)
         (list (directory-files directory full match nosort))
         (ptr list))
    (while ptr
      (if (string= (car ptr) "")
          (setcar ptr nil))
      (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))
    (setq list (delq nil list))
    list))

;;(setq directory "~/cosc/")
;;(setq full t)
;;(setq match "\\.java$")
;;(setq nosort nil)
;;(directory-files-subdirs "~/c++-projects/")
;; (directory-files-subdirs "c:/Downloads/ABBA Discography/")
;; (directory-files-subdirs (setq directory "c:/Downloads/1978 - Talking Heads - More Songs About Buildings And Food [US Vinyl 24-96 FLAC]") (setq full t) (setq match nil) (setq nosort nil))
;; (setq list (directory-files-subdirs directory full match nosort))
;; (setq list (directory-files-subdirs (setq directory "c:/Downloads/") full match nosort))
;; (directory-files-subdirs (setq directory "c:/Downloads"))
;; (setq list (directory-files-no-dotdotdot directory full match nosort))
;; (setq ptr list)
(defun directory-files-subdirs (directory &optional full match nosort)
  "Author: Davin Pearson <http://davin.50webs.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 0 (match-end 1))))
    (while ptr
      ;;(debug "Bic Runga: Sway")
      (when (and full (string= (concat directory "/") (car ptr)))
        ;;(debug "Tie-Fighters")
        (setf (car ptr) nil)
        )
      (when (and (not full) (string= (car ptr) ""))
        ;;(debug "Bic Runga: Swim")
        (setf (car ptr) nil)
        )
      ;;(debug "Life Begins When You're in Love")
      (when (car ptr)
        (setq dir (if full (car ptr) (concat directory "/" (car ptr))))
        (when (not (file-directory-p dir));; (file-symlink-p dir))
          ;;(debug "Billie Holiday: It's Like Reaching for the Moon")
          (setf (car ptr) nil)))
      (setq ptr (cdr ptr)))
    (setq list (delq nil list))
    list))

;; (setq directory "~/")
;; (setq full      nil)
;; (setq match     nil)
;; (setq nosort    nil)
;; (setq list      (directory-files-no-dotdotdot directory full match nosort))d
(defalias 'directory-files-nondirs 'directory-files-no-subdirs)

(defun directory-files-no-subdirs (directory &optional full match nosort)
  "Author: Davin Pearson <http://davin.50webs.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 (delq nil list))
    list)
  )

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

"Author: Davin Pearson <http://davin.50webs.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://davin.50webs.com>
  NOTE: no .. and ."

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

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

(message "directory-files-deep scanning %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))

    ;;(if debug-on-error (debug "Rocket Queen"))

;;    ;; NOTE 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)))
;;
    ;; NOTE 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 (function (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)))

(if os-type--mswindows-p
        (setq return-list (delete-duplicates return-list :test 'string=-ignore-case))
      (setq return-list (delete-duplicates return-list :test 'string=)))

    ;; SORT THE LIST:
    (if (not nosort)
        (setq return-list (sort* return-list
                                 'string<
                                 :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://davin.50webs.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)