Changeset 11304

Timestamp:

09/02/08 20:56:12 (15 years ago)

Author:

ehuelsmann

Message:

Fix behaviour with :WILD directories.

Patch by: Ville Voutilianen (ville.voutilianen at gmail.com)
Tweaked by: me

File:

• trunk/j/src/org/armedbear/lisp/directory.lisp (modified) (3 diffs)

trunk/j/src/org/armedbear/lisp/directory.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2004-2007 Peter Graves
+;;; Copyright (C) 2008 Ville Voutilainen
 ;;; $Id$
 ;;;
@@ -29 +30 @@
                    :version nil)))
 
+(defun list-directories-with-wildcards (pathname)
+  (let* ((directory (pathname-directory pathname))
+   (first-wild (position-if #'wild-p directory))
+   (wild (and first-wild (nthcdr first-wild directory)))
+   (non-wild (or (and first-wild
+          (nbutlast directory
+              (- (length directory) first-wild))
+          directory)))
+   (newpath (make-pathname :directory non-wild
+         :name nil :type nil :defaults pathname))
+   (entries (list-directory newpath)))
+    (if (not wild)
+  entries (mapcan (lambda (entry)
+                          (let* ((pathname (pathname entry))
+                                 (directory (pathname-directory pathname))
+                                 (rest-wild (cdr wild)))
+                            (unless (file-namestring pathname)
+                              (when rest-wild
+                                (setf directory (nconc directory rest-wild)))
+                              (list-directories-with-wildcards
+                               (make-pathname :directory directory
+                                              :defaults newpath)))))
+                        entries))))
+
+
 (defun directory (pathspec &key)
   (let ((pathname (merge-pathnames pathspec)))
@@ -40 +66 @@
               (when device
                 (setq namestring (concatenate 'string device ":" namestring))))
-            (let ((entries (list-directory namestring))
+            (let ((entries (list-directories-with-wildcards namestring))
                   (matching-entries ()))
               (dolist (entry entries)