Changeset 12985
- Timestamp:
- 10/30/10 17:53:45 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/directory.lisp
r12503 r12985 42 42 :version nil))) 43 43 44 (defun list-directories-with-wildcards (pathname) 44 (defun wild-inferiors-p (component) 45 (eq component :wild-inferiors)) 46 47 (defun list-directories-with-wildcards (pathname 48 &optional (wild-inferiors-found nil)) 45 49 (let* ((directory (pathname-directory pathname)) 50 (first-wild-inferior (and (not wild-inferiors-found) 51 (position-if #'wild-inferiors-p directory))) 46 52 (first-wild (position-if #'wild-p directory)) 47 (wild (when first-wild (nthcdr first-wild directory))) 48 (non-wild (if first-wild 53 (wild (when (or first-wild-inferior first-wild) 54 (nthcdr (or first-wild-inferior first-wild) directory))) 55 (non-wild (if (or first-wild-inferior first-wild) 49 56 (nbutlast directory 50 (- (length directory) first-wild)) 51 directory)) 57 (- (length directory) 58 (or first-wild-inferior first-wild))) 59 directory)) 52 60 (newpath (make-pathname :directory non-wild 53 61 :name nil :type nil :defaults pathname)) 54 62 (entries (list-directory newpath))) 55 (if (not wild) 56 entries 57 (mapcan (lambda (entry) 58 (let* ((pathname (pathname entry)) 59 (directory (pathname-directory pathname)) 60 (rest-wild (cdr wild))) 61 (unless (pathname-name pathname) 62 (when (pathname-match-p (first (last directory)) 63 (if (eql (car wild) :wild) "*" (car wild))) 64 (when rest-wild 65 (setf directory (nconc directory rest-wild))) 66 (list-directories-with-wildcards 67 (make-pathname :directory directory 68 :defaults newpath)))))) 69 entries)))) 63 (if (not (or wild wild-inferiors-found)) 64 entries 65 (let ((inferior-entries (when (or wild-inferiors-found first-wild-inferior) entries))) 66 (nconc 67 (mapcan (lambda (entry) 68 (when (pathname-match-p (pathname entry) pathname) 69 (list entry))) 70 inferior-entries) 71 (mapcan (lambda (entry) 72 (let* ((pathname (pathname entry)) 73 (directory (pathname-directory pathname)) 74 (rest-wild (cdr wild))) 75 (unless (pathname-name pathname) 76 (when (pathname-match-p (first (last directory)) 77 (cond ((eql (car wild) :wild) 78 "*") 79 ((eql (car wild) :wild-inferiors) 80 "*") 81 (wild 82 (car wild)) 83 (t ""))) 84 (when rest-wild 85 (setf directory (nconc directory rest-wild))) 86 (list-directories-with-wildcards 87 (make-pathname :directory directory 88 :defaults newpath) 89 (or first-wild-inferior wild-inferiors-found)))))) 90 entries)))))) 70 91 71 92
Note: See TracChangeset
for help on using the changeset viewer.