[armedbear-devel] JAR file support patches

Alan Ruttenberg alanruttenberg at gmail.com
Tue Jan 26 19:43:11 UTC 2010


On Tue, Jan 26, 2010 at 6:54 AM, Mark Evenson <evenson at panix.com> wrote:
>  Right now, wildcards (and DIRECTORY) don't work
> inside JARs which would be the first step to autodiscovery.

Recall that I had a patch for that that could probably be easily adapted.

(advise directory
	(let* ((translated (translate-logical-pathname (car arglist)))
	       (device (pathname-device translated)))
	  (if (and device (eql 0 (search "jar:file:" (namestring device))))
	      (directory-in-jar translated)
	      (:do-it)))
	:when :around :name  jar-file)

(defun directory-in-jar (pathname)
  (let* ((jarfile (subseq (namestring (pathname-device pathname)) 9))
	 (rest-pathname (namestring (make-pathname :directory
(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 (#"hasMoreElements" els)
	       for name = (jcall "getName" (#"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 `(:absolute ,@(cdr (pathname-directory name)))))))
	(let ((truename (probe-file-in-jar pathname)))
	  (if truename
              (list truename)
              nil)))))

-Alan




More information about the armedbear-devel mailing list