;;; 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) _______________________________________________ gnu-emacs-sources mailing list [email protected] http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
