Changeset 13431 for trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp

Timestamp:

08/01/11 21:34:35 (12 years ago)

Author:

Mark Evenson

Message:

Allow ASDF definitions for JAR-FILE to include ".jar".

This increases compatibility with the original version of JSS.

The only possible situation where this doesn't make sense would be if
a jar where to end in something other than ".jar", like perhaps ".zip"
or ".war". In this case, additional ASDF classes should be defined
extending JAR-FILE.

File:

• trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp (modified) (2 diffs)

trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp

@@ -23 +23 @@
                          (all-jars-below directory)
                          (directory (merge-pathnames "*.jar" directory)))
-     :doing (if (not (member (namestring (truename jar)) *added-to-classpath* :test 'equal))
+     :doing (if (not (member (namestring (truename jar)) 
+                             *added-to-classpath* :test 'equal))
                 (return-from need-to-add-directory-jar? t)))
   nil)
@@ -57 +58 @@
       (java:add-to-classpath (component-pathname c))))
 
+;;; The original JSS specified jar pathnames as having a NAME ending
+;;; in ".jar" without a TYPE.  If we encounter such a definition, we
+;;; clean it up.
+(defmethod perform :before ((operation load-op) (c jar-file))
+  (when (#"endsWith" (slot-value c 'name) ".jar")
+    (with-slots (name absolute-pathname) c
+      (let* ((new-name 
+              (subseq name 0 (- (length name) 4)))
+             (new-absolute-pathname 
+              (make-pathname :defaults absolute-pathname :name new-name)))
+        (setf name new-name
+              absolute-pathname new-absolute-pathname)))))
+
+(defmethod operation-done-p :before ((operation load-op) (c jar-file))
+  (when (#"endsWith" (slot-value c 'name) ".jar")
+    (with-slots (name absolute-pathname) c
+      (let* ((new-name 
+              (subseq name 0 (- (length name) 4)))
+             (new-absolute-pathname 
+              (make-pathname :defaults absolute-pathname :name new-name)))
+        (setf name new-name
+              absolute-pathname new-absolute-pathname)))))
+
 (defmethod operation-done-p ((operation load-op) (c jar-file))
   (or abcl-asdf:*inhibit-add-to-classpath*