From: Adam Warner
Subject: Obtain list of subdirectories
Date: 
Message-ID: <pan.2002.11.13.14.02.59.839692@consulting.net.nz>
Hi all,

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

From: Chris Beggy
Subject: Re: Obtain list of subdirectories
Date: 
Message-ID: <87znsdsdxz.fsf@lackawana.kippona.com>
"Adam Warner" <······@consulting.net.nz> writes:

> 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.

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
From: Adam Warner
Subject: Re: Obtain list of subdirectories
Date: 
Message-ID: <pan.2002.11.13.22.13.18.43091@consulting.net.nz>
Hi Chris Beggy,

>> 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.
> 
> 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,

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
From: Chris Beggy
Subject: Re: Obtain list of subdirectories
Date: 
Message-ID: <87vg30sy8u.fsf@lackawana.kippona.com>
"Adam Warner" <······@consulting.net.nz> writes:

> 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...)

> * (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")
From: Adam Warner
Subject: Re: Obtain list of subdirectories (& new version of match-pathname)
Date: 
Message-ID: <pan.2002.11.15.10.00.58.799982@consulting.net.nz>
Hi all,

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)))))