Changeset 12492


Ignore:
Timestamp:
02/21/10 07:34:21 (12 years ago)
Author:
Mark Evenson
Message:

Revert r12490.

ABCL system Lisp should not break the abstraction barrier by utlizing
the Java FFI, but should *only* use primitives/special operators. If
we (developers) don't accept such patches, we shouldn't be checking
them in.

File:
1 edited

Legend:

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

    r12491 r12492  
    7272    (when (logical-pathname-p pathname)
    7373      (setq pathname (translate-logical-pathname pathname)))
    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)
     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))
    12395              nil)))))
Note: See TracChangeset for help on using the changeset viewer.