[armedbear-devel] more directory and jars

[Alan Ruttenberg]

CL-USER> (DIRECTORY
"jar:file:/Users/alanr/Desktop/jar2go.jar!/abcl-module-*.lisp")
 Calling (DIRECTORY
"jar:file:/Users/alanr/Desktop/jar2go.jar!/abcl-module-*.lisp")
 DIRECTORY returned #<FILE-ERROR {E2C42F}>
#<FILE-ERROR {E2C42F}>
CL-USER> (describe *)
#<FILE-ERROR {E2C42F}> is an instance of #<STANDARD-CLASS FILE-ERROR {8917A2}>.
The following slots have :INSTANCE allocation:
  FORMAT-CONTROL     "Not a wild pathname."
  FORMAT-ARGUMENTS   NIL
  PATHNAME
#P"jar:file:/Users/alanr/Desktop/jar2go.jar!/abcl-module-*.lisp"
; No value


Below is the function I use for directory in jars. Please consider
including it until there is a correct implementation in java.

(defun directory-in-jar (pathname)
  (let* ((device (pathname-device pathname))
	 (jarfile (namestring (car device)))
	 (rest-pathname (namestring (make-pathname :directory `(:absolute
,@(cdr (pathname-directory pathname)))
						   :name (pathname-name pathname)
						   :type (pathname-type pathname)))))
    (if (or (position #\* (namestring rest-pathname))
	    (wild-pathname-p rest-pathname))
	(let ((jar (jnew  "java.util.zip.ZipFile" jarfile)))
	  (let ((els (jcall "entries" jar)))
	    (loop while (jcall "hasMoreElements" els)
	       for name = (jcall "getName" (jcall "nextElement" els))
	       when (pathname-match-p (concatenate 'string "/" name) rest-pathname)
	       collect (make-pathname :device (pathname-device pathname)
				      :name (pathname-name name)
				      :type (pathname-type name)
				      :directory `(:relative ,@(cdr (pathname-directory name)))))))
	(let ((truename (probe-file pathname)))
	  (if truename
              (list truename)
              nil)))))