1(in-package :abcl-asdf) 2 3(defvar *added-to-classpath* nil) 4 5(defvar *inhibit-add-to-classpath* nil) 6 7(defun add-directory-jars-to-class-path (directory recursive-p) 8 (loop :for jar :in (if recursive-p 9 (all-jars-below directory) 10 (directory (merge-pathnames "*.jar" directory))) 11 :do (java:add-to-classpath jar))) 12 13(defun all-jars-below (directory) 14 (loop :with q = (system:list-directory directory) 15 :while q :for top = (pop q) 16 :if (null (pathname-name top)) 17 :do (setq q (append q (all-jars-below top))) 18 :if (equal (pathname-type top) "jar") 19 :collect top)) 20 21(defun need-to-add-directory-jar? (directory recursive-p) 22 (loop :for jar :in (if recursive-p 23 (all-jars-below directory) 24 (directory (merge-pathnames "*.jar" directory))) 25 :doing (if (not (member (namestring (truename jar)) 26 *added-to-classpath* :test 'equal)) 27 (return-from need-to-add-directory-jar? t))) 28 nil) 29 30(defmethod java:add-to-classpath :around ((uri-or-uris t) &optional classloader) 31 (declare (ignore classloader)) 32 (call-next-method) 33 (if (listp uri-or-uris) 34 (dolist (uri uri-or-uris) 35 (pushnew uri *added-to-classpath*)) 36 (pushnew uri-or-uris *added-to-classpath*))) 37 38(in-package :asdf) 39 40(defclass jar-directory (static-file) ()) 41 42(defmethod perform ((operation compile-op) (c jar-directory)) 43 (unless abcl-asdf:*inhibit-add-to-classpath* 44 (abcl-asdf:add-directory-jars-to-class-path (truename (component-pathname c)) t))) 45 46(defmethod perform ((operation load-op) (c jar-directory)) 47 (unless abcl-asdf:*inhibit-add-to-classpath* 48 (abcl-asdf:add-directory-jars-to-class-path (truename (component-pathname c)) t))) 49 50(defmethod operation-done-p ((operation load-op) (c jar-directory)) 51 (or abcl-asdf:*inhibit-add-to-classpath* 52 (not (abcl-asdf:need-to-add-directory-jar? (component-pathname c) t)))) 53 54(defmethod operation-done-p ((operation compile-op) (c jar-directory)) 55 t) 56 57(defclass jar-file (static-file) 58 ((type :initform "jar"))) 59 60(defmethod perform ((operation compile-op) (c jar-file)) 61 (java:add-to-classpath (component-pathname c))) 62 63(defmethod perform ((operation load-op) (c jar-file)) 64 (or abcl-asdf:*inhibit-add-to-classpath* 65 (java:add-to-classpath (component-pathname c)))) 66 67;;; The original JSS specified jar pathnames as having a NAME ending 68;;; in ".jar" without a TYPE. If we encounter such a definition, we 69;;; clean it up. 70(defmethod normalize-jar-name ((component jar-file)) 71 (when (#"endsWith" (slot-value component 'name) ".jar") 72 (with-slots (name absolute-pathname) component 73 (let* ((new-name 74 (subseq name 0 (- (length name) 4))) 75 (new-absolute-pathname 76 (make-pathname :defaults absolute-pathname :name new-name))) 77 (setf name new-name 78 absolute-pathname new-absolute-pathname))))) 79 80(defmethod perform :before ((operation compile-op) (c jar-file)) 81 (normalize-jar-name c)) 82 83(defmethod perform :before ((operation load-op) (c jar-file)) 84 (normalize-jar-name c)) 85 86(defmethod operation-done-p :before ((operation load-op) (c jar-file)) 87 (normalize-jar-name c)) 88 89(defmethod operation-done-p ((operation load-op) (c jar-file)) 90 (or abcl-asdf:*inhibit-add-to-classpath* 91 (member (namestring (truename (component-pathname c))) 92 abcl-asdf:*added-to-classpath* :test 'equal))) 93 94(defmethod operation-done-p ((operation compile-op) (c jar-file)) 95 t) 96 97(defclass class-file-directory (static-file) ()) 98 99(defmethod perform ((operation compile-op) (c class-file-directory)) 100 (java:add-to-classpath (component-pathname c))) 101 102(defmethod perform ((operation load-op) (c class-file-directory)) 103 (java:add-to-classpath (component-pathname c))) 104 105;; a jar file where the pathname and name are relative to JAVA_HOME 106(defclass jdk-jar (jar-file) ()) 107 108(defmethod normalize-jar-name :after ((c jdk-jar)) 109 (setf (slot-value c 'absolute-pathname) 110 (merge-pathnames 111 (merge-pathnames 112 (slot-value c 'name) 113 (make-pathname :directory `(:relative ,(slot-value (component-parent c) 'relative-pathname)))) 114 (java::jstatic "getProperty" "java.lang.System" "java.home")))) 115 116 117 118