GNU   davin.50webs.com/research
Bringing to you notes for the ages

       Main Menu          Research Projects         Photo Album            Curriculum Vitae      The Greatest Artists
    Email Address       Computer Games          Web Design          Java Training Wheels      The Fly (A Story)   
  Political Activism   Bob Dylan Quotes+       My Life Story          Smoking Cessation          Other Links      
Debugging Macros     String Class I     Linked List System I Java for C Programmers Naming Convention
    String Class II         How I use m4              Strings III                 Symmetrical I/O             Linked Lists II     
Run-Time Type Info   Virtual Methods      An Array System        Science & Religion            Submodes       
  Nested Packages      Memory Leaks    Garbage Collection      Internet & Poverty      What is Knowledge?
Limits of Evolution   Emacs Additions      Function Plotter           Romantic Love        The Next Big Thing
    Science Fiction     Faster Compilation Theory of Morality         Elisp Scoping               Elisp Advice      
  S.O.G.M. Pattern       Safe Properties         School Bullying          Charisma Control          Life and Death    
     Splitting Java          Multiple Ctors       Religious Beliefs         Conversation 1           Conversation 2    
   J.T.W. Language    Emacs Additions II      Build Counter             Relation Plotter          Lisp++ Language  
  Memory Leaks II   Super Constructors CRUD Implementation Order a Website Form There Is An Afterlife
More Occam's Razor C to Java Translator Theory of Morality II


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)
Back
| Main Menu | Research Projects | Photo Album | Curriculum Vitae | The Greatest Artists |
| Email Address | Computer Games | Web Design | Java Training Wheels | The Fly (A Story) |
| Political Activism | Bob Dylan Quotes+ | My Life Story | Smoking Cessation | Other Links |
| Debugging Macros | String Class I | Linked List System I | Java for C Programmers | Naming Convention |
| String Class II | How I use m4 | Strings III | Symmetrical I/O | Linked Lists II |
| Run-Time Type Info | Virtual Methods | An Array System | Science & Religion | Submodes |
| Nested Packages | Memory Leaks | Garbage Collection | Internet & Poverty | What is Knowledge? |
| Limits of Evolution | Emacs Additions | Function Plotter | Romantic Love | The Next Big Thing |
| Science Fiction | Faster Compilation | Theory of Morality | Elisp Scoping | Elisp Advice |
| S.O.G.M. Pattern | Safe Properties | School Bullying | Charisma Control | Life and Death |
| Splitting Java | Multiple Ctors | Religious Beliefs | Conversation 1 | Conversation 2 |
| J.T.W. Language | Emacs Additions II | Build Counter | Relation Plotter | Lisp++ Language |
| Memory Leaks II | Super Constructors | CRUD Implementation | Order a Website Form | There Is An Afterlife |
| More Occam's Razor | C to Java Translator | Theory of Morality II
Last modified: Sat Apr 29 18:38:24 NZST 2017
Best viewed at 800x600 or above resolution.
© Copyright 1999-2017 Davin Pearson.
Please report any broken links to