Obtain list of subdirectories
Adam Warner
In CLISP I can obtain a list of subdirectories by evaluating (directory
"*/"). How do you go about obtaining a list of subdirectories in CMUCL
using only ANSI CL constructs (no extensions)? Right now I can only think
of ways which are far less efficient (i.e. because (directory "*/")
returns all subdirectories and all files I have to sort through the entire
list to pick out the subdirectories).
I'd appreciate knowing whether (directory "*/") produces a list of
subdirectories or subdirectories and files in other implementations.
Thanks,
Adam
Chris Beggy
In cmucl, I took a look at (describe 'directory), then tried:
*
* (directory "/home/chrisb/programcode" :check-for-subdirs t )
(#p"/home/chrisb/programcode/CVS/" #p"/home/chrisb/programcode/bash/"
#p"/home/chrisb/programcode/cl/" #p"/home/chrisb/programcode/cron/"
#p"/home/chrisb/programcode/elisp/" #p"/home/chrisb/programcode/perl/"
#p"/home/chrisb/programcode/scheme/" #p"/home/chrisb/programcode/texinfo/"
#p"/home/chrisb/programcode/webmacro/")
* (directory "*/")
NIL
*
HTH,
Chris
Adam Warner
I do not see the same result Chris. Try the same command on /home/chrisb
to see what happens. Here's what happens on my system. And I've used
-noinit to disable loading of my custom .cmucl-init.lisp script:
* (directory "/home/adam" :check-for-subdirs t)
(#p"/home/adam/")
If I add a file named adam.test in /home/adam you can see that directory is
also looking for files named adam.* in /home:
* (directory "/home/adam" :check-for-subdirs t)
(#p"/home/adam/" #p"/home/adam.test")
You might want to consider adding a trailing slash to your directory
string to properly describe the directory. Compare:
* (directory-namestring "/home/chrisb/programcode")
"/home/chrisb/"
And:
* (directory-namestring "/home/chrisb/programcode/")
"/home/chrisb/programcode/"
Try and obtain the desired result of the subdirectories in test:
mkdir test
mkdir test/subdir
touch test/file
lisp -noinit
* (directory "/home/adam/test" :check-for-subdirs t)
(#p"/home/adam/test/")
* (directory "/home/adam/test/" :check-for-subdirs t)
(#p"/home/adam/test/file" #p"/home/adam/test/subdir/")
And consider this result:
* (directory "/home/adam/test/" :check-for-subdirs nil)
(#p"/home/adam/test/file" #p"/home/adam/test/subdir")
It just makes a subdirectory look like a file compared to the default
behaviour.
My CMUCL version is CMU Common Lisp release x86-linux 3.1.2 18d+ 24
September 2002 build 4293.
Regards,
Adam
Chris Beggy
> I do not see the same result Chris. Try the same command on /home/chrisb
> to see what happens. Here's what happens on my system. And I've used
> -noinit to disable loading of my custom .cmucl-init.lisp script:
You are absolutely right, and I get the same behavior as you
report here. I don't know what I was doing when I was cutting
and pasting from my ilisp session. The trailing "/" is important.
In addition, looking at (describe 'directory) again, the churlish
:check-for-subdirs key isn't explained or defined. I just
presumed it did something the way I thought it should!
I'm glad you've got cmucl now, so I won't be able to mislead you
any more.
Chris
(I think I've at least spelled my name right...)
Adam Warner
>> I do not see the same result Chris. Try the same command on
>> /home/chrisb to see what happens. Here's what happens on my system. And
>> I've used -noinit to disable loading of my custom .cmucl-init.lisp
>> script:
>
> You are absolutely right, and I get the same behavior as you report
> here. I don't know what I was doing when I was cutting and pasting from
> my ilisp session. The trailing "/" is important.
>
> In addition, looking at (describe 'directory) again, the churlish
> :check-for-subdirs key isn't explained or defined. I just
> presumed it did something the way I thought it should!
>
> I'm glad you've got cmucl now, so I won't be able to mislead you any
> more.
(grin) Chris, this is a very messy subject and I've just spent all this
time trying to produce consistent output between CLISP and CMUCL. I appear
to have almost fully succeeded. Full consistency requires a setting in
CLISP that is currently only in CVS. This setting has been commented out
and not tested.
I am placing the code in the public domain.
The function below is intended to produce a consistent wildcard matching
of files in the current directory and all subdirectories. I aim to avoid
following file and directory symlinks. The function returns a full
pathname for each match (this was another distinction between CLISP and
CMUCL that had to be made consistent). I applied brute force to eliminate
symbolic directory links outside a subdirectory.
Usage example:
(match-pathname-all-subdirs #p"*.*~")
This will match all Emacs (*.*~) backup files in the current directory and
subdirectories.
(match-pathname-all-subdirs #p"/explicit/directory/*.*~")
Will match all *.*~ backup files in the directory /explicit/directory/ and
all subdirectories.
You do not get consistent output between CLISP and CMUCL if you try and
shorten the wildcard match. CLISP and CMUCL interpret shortened wildcards
differently. A match of #p"*~" (i.e. the pathname-type is nil) still finds
the backup files in CLISP.
Regards,
Adam
;;Code to match wildcard files within the current directory and all subdirectories
;;Since the code will be used for tasks like deletion of files it is critical that symlinks
;;are not followed.
;; ***** REMEMBER TO UNCOMMENT :if-does-not-exist :keep WHEN THE NEXT VERSION OF CLISP IS RELEASED *****
;; I will have to test whether a broken symlink is treated as a file or a directory
;; (a feature extension allowing conditional version numbers would be nice)
(defun match-pathname-all-subdirs (pathname)
(unless (pathnamep pathname) (error "match-pathnames requires a pathname as input"))
(flet ((remove-if-non-subdir (full-dir dirs-symlinks)
(let ((length-full-dir (length full-dir)))
(loop for dir in dirs-symlinks
when (and (>= (length (directory-namestring dir)) length-full-dir)
(string= (subseq (directory-namestring dir) 0 length-full-dir) full-dir))
collect dir))))
;;we need to work on full pathname directories so recursion will work
;;without having to change the current directory.
(let* ((full-pathname-dir (truename (directory-namestring pathname)))
(full-dir (directory-namestring full-pathname-dir))
(full-pathname (make-pathname :directory (pathname-directory full-pathname-dir)
:name (pathname-name pathname)
:type (pathname-type pathname)))
;;refer CVS version of CLISP impnotes for discussion of :IF-DOES-NOT-EXIST functionality
;;http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/*checkout*/clisp/clisp/doc/impnotes.html?rev=1.24
(files #+clisp (mapcar #'first (directory full-pathname :full t)) ;;*** :if-does-not-exist :keep))
#+cmu (remove-if-not #'pathname-name (directory full-pathname :truenamep nil)))
;;the :full trick doesn't work here for CLISP and obtaining the full pathnames of directories
;;with CMUCL means that directory symlinks are followed. That's OK. We just have to remove
;;any references to non-subdirectory links below
(dirs-symlinks #+clisp (directory (concatenate 'string full-dir "*/"))
#+cmu (mapcar #'truename (remove-if #'pathname-name
(directory full-dir :truenamep nil))))
(dirs (remove-if-non-subdir full-dir dirs-symlinks)))
;;We now have a consistent set of pathnames that include no symlinks to outside directories.
;;A tiny bit of recursion and we're all done. We have to construct a new full pathname
(nconc files (loop for dir in dirs
nconc (match-pathname-all-subdirs (make-pathname :directory (pathname-directory dir)
:name (pathname-name pathname)
:type (pathname-type pathname))))))))
Adam Warner
It seems that even those using Lisp may be prone to implementing half of
Common Lisp before they realise everything that is provided in the
specification :-)
The new version of the public domain code below:
1. Provides correct type checking via check-type and a wider range of types.
2. Avoids creating a new subsequence of directory strings by using the
string= :end1 keyword instead of (subseq 0 ...)
3. Eliminates recursion within the function because conforming Common Lisp
implementations provide wild inferiors!
To obtain a non-wild absolute path I first obtain the pathname-directory.
If it is nil I return the path of the default directory. If it is non-nil
I check whether the path is :relative. If it is :relative I APPEND the
current absolute path to the rest of the relative path. Finally I remove
any :wild or :wild-inferiors from the list. The remaining list becomes the
new :directory component of make-pathname. I hope this procedure is sound.
The code has only been quickly tested. It could contain significant bugs.
I think its biggest advantage is that I can (hopefully) rely upon it to
always return absolute pathnames. Cf (directory "*" :truenamep nil) which
returns relative pathnames in CMUCL.
In this version I haven't nullified the difference between CLISP returning only
files or only directories and CMUCL returning files and directories.
Regards,
Adam
;;This code written by Adam Warner is released into the public domain.
;;match-pathname returns a list of ABSOLUTE pathnames matching a (potentially wild and wild-inferior) pathname.
;;Output is intended to be somewhat similar whether using CMUCL or CLISP.
;;If the first optional parameter is non-nil then symlinks are followed.
;;The second optional parameter is the base directory. Outside truenames will be removed.
;;This base directory defaults to (a) the directory in the pathname excluding :wild or :wild-inferiors components
;;or (b) the current directory if the pathname contains a pathname-directory of nil.
;;Thus BY DEFAULT no truename is ever returned outside the base directory of the pathname.
;;CLISP has an apparent bug where #p"*~" appears to match #p"*.*~" Don't leave out a :type component of a pathname
;;if you are aiming for consistent output between CMUCL and CLISP.
;;Note that the ANSI specification states: "``:allow-other-keys t'' may be used in conforming programs in
;;order to quietly ignore any additional keywords which are passed by the program but not supported by the
;;implementation." Both CLISP and CMUCL appear to be non-conforming. Try compiling a CLISP program containing this
;;keyword and it breaks with "directory: ignored duplicate keyword :allow-other-keys t". And CMUCL gives
;;the warning message "Warning: :allow-other-keys is not a known argument keyword." I'd rather use read-time
;;conditionals to avoid even a warning (a warning doesn't appear to comply with "quietly ignore").
;; Usage examples:
;;
;;1. Return list of files in the current directory matching "*.*~":
;; (match-pathname "*.*~")
;;
;;2. Return list of files in the current directory and subdirectories matching "*.*~":
;; (match-pathname "**/*.*~")
;;
;;3. As above but follow symlinks and only return those within or below the current directory:
;; (match-pathname "**/*.*~" t)
;;
;;4. As above but allow followed symlinks to be returned from anywhere within the filesystem:
;; (match-pathname "**/*.*~" t "/")
;;
;;5. Return list of files in the directory and subdirectories of "/absolute/path/" matching "*.*~",
;; following symlinks and constraining returned truenames to be within the directory "/absolute/":
;; (match-pathname "/absolute/path/**/*.*~" t "/absolute/")
(defun match-pathname (pathname &optional follow-symlinks base-directory)
(check-type pathname (or pathname base-string stream))
(check-type base-directory (or pathname base-string stream null))
(flet ((remove-if-not-in-base-dir (dirs base-dir-string)
(if (string= base-dir-string "/") dirs
(loop for dir in dirs
when (and (>= (length (directory-namestring dir)) (length base-dir-string))
(string= (directory-namestring dir) base-dir-string :end1 (length base-dir-string)))
collect dir)))
(absolute-pathname-dir-list (pathname-dir-list)
(cond ((eq pathname-dir-list nil) (pathname-directory (truename #p"")))
((eq (first pathname-dir-list) :relative)
(append (pathname-directory (truename #p"")) (rest pathname-dir-list)))
(t pathname-dir-list)))
(no-wild-pathname-dir-list (pathname-dir-list)
(remove-if #'(lambda (x) (or (eq x :wild) (eq x :wild-inferiors))) pathname-dir-list)))
(let ((base-dir-string (directory-namestring
(make-pathname
:directory (no-wild-pathname-dir-list
(absolute-pathname-dir-list
(if base-directory (pathname-directory base-directory)
(pathname-directory pathname)))))))
(absolute-pathname (make-pathname :directory (absolute-pathname-dir-list
(pathname-directory pathname))
:name (pathname-name pathname)
:type (pathname-type pathname))))
(if follow-symlinks (remove-if-not-in-base-dir
#+clisp (directory absolute-pathname) ;;CLISP 2.31+: :if-does-not-exist :error))
#+cmu (directory absolute-pathname) base-dir-string)
#+clisp (mapcar #'first (directory absolute-pathname :full t))
#+cmu (directory absolute-pathname :truenamep nil)))))