Changeset 11304


Ignore:
Timestamp:
09/02/08 20:56:12 (14 years ago)
Author:
ehuelsmann
Message:

Fix behaviour with :WILD directories.

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/directory.lisp

    r11297 r11304  
    22;;;
    33;;; Copyright (C) 2004-2007 Peter Graves
     4;;; Copyright (C) 2008 Ville Voutilainen
    45;;; $Id$
    56;;;
     
    2930                   :version nil)))
    3031
     32(defun list-directories-with-wildcards (pathname)
     33  (let* ((directory (pathname-directory pathname))
     34   (first-wild (position-if #'wild-p directory))
     35   (wild (and first-wild (nthcdr first-wild directory)))
     36   (non-wild (or (and first-wild
     37          (nbutlast directory
     38              (- (length directory) first-wild))
     39          directory)))
     40   (newpath (make-pathname :directory non-wild
     41         :name nil :type nil :defaults pathname))
     42   (entries (list-directory newpath)))
     43    (if (not wild)
     44  entries (mapcan (lambda (entry)
     45                          (let* ((pathname (pathname entry))
     46                                 (directory (pathname-directory pathname))
     47                                 (rest-wild (cdr wild)))
     48                            (unless (file-namestring pathname)
     49                              (when rest-wild
     50                                (setf directory (nconc directory rest-wild)))
     51                              (list-directories-with-wildcards
     52                               (make-pathname :directory directory
     53                                              :defaults newpath)))))
     54                        entries))))
     55
     56
    3157(defun directory (pathspec &key)
    3258  (let ((pathname (merge-pathnames pathspec)))
     
    4066              (when device
    4167                (setq namestring (concatenate 'string device ":" namestring))))
    42             (let ((entries (list-directory namestring))
     68            (let ((entries (list-directories-with-wildcards namestring))
    4369                  (matching-entries ()))
    4470              (dolist (entry entries)
Note: See TracChangeset for help on using the changeset viewer.