Changeset 12491


Ignore:
Timestamp:
02/20/10 23:52:28 (12 years ago)
Author:
Mark Evenson
Message:

DIRECTORY works for (some) jar:file cases.

Doesn't handle JAR in JAR or JAR not file:.

File:
1 edited

Legend:

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

    r11616 r12491  
    7272    (when (logical-pathname-p pathname)
    7373      (setq pathname (translate-logical-pathname pathname)))
    74     (if (or (position #\* (namestring pathname))
    75       (wild-pathname-p pathname))
    76         (let ((namestring (directory-namestring pathname)))
    77           (when (and namestring (> (length namestring) 0))
    78             #+windows
    79             (let ((device (pathname-device pathname)))
    80               (when device
    81                 (setq namestring (concatenate 'string device ":" namestring))))
    82             (let ((entries (list-directories-with-wildcards namestring))
    83                   (matching-entries ()))
    84               (dolist (entry entries)
    85                 (cond ((file-directory-p entry)
    86                        (when (pathname-match-p (file-namestring (pathname-as-file entry)) (file-namestring pathname))
    87                          (push entry matching-entries)))
    88                       ((pathname-match-p (file-namestring entry) (file-namestring pathname))
    89                        (push entry matching-entries))))
    90               matching-entries)))
    91         ;; Not wild.
    92         (let ((truename (probe-file pathname)))
    93           (if truename
    94               (list (pathname truename))
     74    (if (pathname-jar-p pathname)
     75        (directory-jar pathspec)
     76        (if (or (position #\* (namestring pathname))
     77                (wild-pathname-p pathname))
     78            (let ((namestring (directory-namestring pathname)))
     79              (when (and namestring (> (length namestring) 0))
     80                #+windows
     81                (let ((device (pathname-device pathname)))
     82                  (when device
     83                    (setq namestring (concatenate 'string device ":" namestring))))
     84                (let ((entries (list-directories-with-wildcards namestring))
     85                      (matching-entries ()))
     86                  (dolist (entry entries)
     87                    (cond ((file-directory-p entry)
     88                           (when (pathname-match-p (file-namestring (pathname-as-file entry)) (file-namestring pathname))
     89                             (push entry matching-entries)))
     90                          ((pathname-match-p (file-namestring entry) (file-namestring pathname))
     91                           (push entry matching-entries))))
     92                  matching-entries)))
     93            ;; Not wild.
     94            (let ((truename (probe-file pathname)))
     95              (if truename
     96                  (list (pathname truename))
     97                  nil))))))
     98
     99;;; Thanks to Alan "Never touch Java unless you have to" Ruttenberg
     100;;; XXX need to handle JAR in JAR cases
     101;;; XXX doesn't handle non file: JAR entries
     102(defun directory-jar (pathname)
     103  (let* ((device (pathname-device pathname))
     104   (jarfile (namestring (car device)))
     105   (rest-pathname (namestring (make-pathname :directory `(:absolute ,@(cdr (pathname-directory pathname)))
     106               :name (pathname-name pathname)
     107               :type (pathname-type pathname)))))
     108    (if (or (position #\* (namestring rest-pathname))
     109      (wild-pathname-p rest-pathname))
     110  (let ((jar (java:jnew "java.util.zip.ZipFile" jarfile)))
     111    (let ((els (java:jcall "entries" jar)))
     112      (loop :while (java:jcall "hasMoreElements" els)
     113         :for name = (java:jcall "getName"
     114                                       (java:jcall "nextElement" els))
     115         :when (pathname-match-p (concatenate 'string "/" name) rest-pathname)
     116         :collect (make-pathname :device (pathname-device pathname)
     117                                       :name (pathname-name name)
     118                                       :type (pathname-type name)
     119                                       :directory `(:relative ,@(cdr (pathname-directory name)))))))
     120  (let ((truename (probe-file pathname)))
     121    (if truename
     122              (list truename)
    95123              nil)))))
Note: See TracChangeset for help on using the changeset viewer.