[armedbear-cvs] r13431 - in trunk/abcl/contrib: abcl-asdf jss

[mevenson at common-lisp.net]

Author: mevenson
Date: Mon Aug  1 14:34:35 2011
New Revision: 13431

Log:
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.

Modified:
   trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd
   trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp
   trunk/abcl/contrib/jss/jss.asd

Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd
==============================================================================
--- trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd	Mon Aug  1 14:34:26 2011	(r13430)
+++ trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd	Mon Aug  1 14:34:35 2011	(r13431)
@@ -3,7 +3,7 @@
 
 (defsystem :abcl-asdf
   :author "Mark Evenson"
-  :version "0.3.0"
+  :version "0.3.1"
   :depends-on ("jss") 
   :components 
   ((:module base :pathname "" :components

Modified: trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp
==============================================================================
--- trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp	Mon Aug  1 14:34:26 2011	(r13430)
+++ trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp	Mon Aug  1 14:34:35 2011	(r13431)
@@ -22,7 +22,8 @@
   (loop :for jar :in (if recursive-p 
                          (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)
 
@@ -56,6 +57,29 @@
   (or abcl-asdf:*inhibit-add-to-classpath*
       (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*
       (member (namestring (truename (component-pathname c)))

Modified: trunk/abcl/contrib/jss/jss.asd
==============================================================================
--- trunk/abcl/contrib/jss/jss.asd	Mon Aug  1 14:34:26 2011	(r13430)
+++ trunk/abcl/contrib/jss/jss.asd	Mon Aug  1 14:34:35 2011	(r13431)
@@ -3,7 +3,7 @@
 
 (defsystem :jss
   :author "Alan Ruttenberg, Mark Evenson"
-  :version "3.0.0" 
+  :version "3.0.1" 
   :components 
   ((:module base 
             :pathname "" :serial t