[armedbear-cvs] r13430 - in trunk/abcl/contrib: abcl-asdf jss
mevenson at common-lisp.net
mevenson at common-lisp.net
Mon Aug 1 21:34:27 UTC 2011
Author: mevenson
Date: Mon Aug 1 14:34:26 2011
New Revision: 13430
Log:
Refactor ASDF extensions from JSS into ABCL-ASDF.
The JAR-FILE, JAR-DIRECTORY, and CLASS-FILE-DIRECTORY ASDF extensions
are now part of the ABCL-ASDF contrib as we aim to centralize all such
things in one place. *ADDED-TO-CLASSPATH* is now part of the
ABCL-ASDF package as well.
There is currently a (mostly) recursive relationship between JSS and
ABCL-ASDF, as each (mostly) requires the other for operation.
JSS:ENSURE-COMPATIBILITY will ensure that JSS continues to understand
the refactored extensions.
Added:
trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp
- copied, changed from r13429, trunk/abcl/contrib/jss/asdf-jar.lisp
Deleted:
trunk/abcl/contrib/jss/asdf-jar.lisp
Modified:
trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd
trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp
trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp
trunk/abcl/contrib/jss/compat.lisp
trunk/abcl/contrib/jss/invoke.lisp
trunk/abcl/contrib/jss/jss.asd
trunk/abcl/contrib/jss/packages.lisp
Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd
==============================================================================
--- trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Sun Jul 31 06:01:43 2011 (r13429)
+++ trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Mon Aug 1 14:34:26 2011 (r13430)
@@ -3,9 +3,12 @@
(defsystem :abcl-asdf
:author "Mark Evenson"
- :version "0.2.0"
- :depends-on ("jss") ;;; XXX move the JSS ASDf defintions here? uggh.
+ :version "0.3.0"
+ :depends-on ("jss")
:components
((:module base :pathname "" :components
((:file "abcl-asdf")
- (:file "maven-embedder" :depends-on ("abcl-asdf"))))))
+ (:file "asdf-jar"
+ :depends-on ("abcl-asdf"))
+ (:file "maven-embedder"
+ :depends-on ("abcl-asdf" "asdf-jar"))))))
Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp
==============================================================================
--- trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp Sun Jul 31 06:01:43 2011 (r13429)
+++ trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp Mon Aug 1 14:34:26 2011 (r13430)
@@ -5,7 +5,13 @@
#:as-classpath
#:resolve-artifact
- #:resolve-dependencies))
+ #:resolve-dependencies
+
+ #:add-directory-jars-to-class-path
+ #:need-to-add-directory-jar?
+
+ #:*added-to-classpath*
+ #:*inhibit-add-to-classpath*))
(in-package :asdf)
(defclass iri (static-class)
Copied and modified: trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp (from r13429, trunk/abcl/contrib/jss/asdf-jar.lisp)
==============================================================================
--- trunk/abcl/contrib/jss/asdf-jar.lisp Sun Jul 31 06:01:43 2011 (r13429, copy source)
+++ trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp Mon Aug 1 14:34:26 2011 (r13430)
@@ -1,34 +1,65 @@
+(in-package :abcl-asdf)
+
+(defvar *added-to-classpath* nil)
+
+(defvar *inhibit-add-to-classpath* nil)
+
+(defun add-directory-jars-to-class-path (directory recursive-p)
+ (loop :for jar :in (if recursive-p
+ (all-jars-below directory)
+ (directory (merge-pathnames "*.jar" directory)))
+ :do (java:add-to-classpath jar)))
+
+(defun all-jars-below (directory)
+ (loop :with q = (system:list-directory directory)
+ :while q :for top = (pop q)
+ :if (null (pathname-name top))
+ :do (setq q (append q (all-jars-below top)))
+ :if (equal (pathname-type top) "jar")
+ :collect top))
+
+(defun need-to-add-directory-jar? (directory recursive-p)
+ (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))
+ (return-from need-to-add-directory-jar? t)))
+ nil)
+
(in-package :asdf)
(defclass jar-directory (static-file) ())
(defmethod perform ((operation compile-op) (c jar-directory))
- (unless jss:*inhibit-add-to-classpath*
- (jss:add-directory-jars-to-class-path (truename (component-pathname c)) t)))
+ (unless abcl-asdf:*inhibit-add-to-classpath*
+ (abcl-asdf:add-directory-jars-to-class-path (truename (component-pathname c)) t)))
(defmethod perform ((operation load-op) (c jar-directory))
- (unless jss:*inhibit-add-to-classpath*
- (jss:add-directory-jars-to-class-path (truename (component-pathname c)) t)))
+ (unless abcl-asdf:*inhibit-add-to-classpath*
+ (abcl-asdf:add-directory-jars-to-class-path (truename (component-pathname c)) t)))
(defmethod operation-done-p ((operation load-op) (c jar-directory))
- (or jss:*inhibit-add-to-classpath*
- (not (jss:need-to-add-directory-jar? (component-pathname c) t))))
+ (or abcl-asdf:*inhibit-add-to-classpath*
+ (not (abcl-asdf:need-to-add-directory-jar? (component-pathname c) t))))
(defmethod operation-done-p ((operation compile-op) (c jar-directory))
t)
(defclass jar-file (static-file) ())
+(defmethod source-file-type ((c jar-file) (s module)) "jar")
+
(defmethod perform ((operation compile-op) (c jar-file))
- (jss:add-to-classpath (component-pathname c)))
+ (java:add-to-classpath (component-pathname c)))
(defmethod perform ((operation load-op) (c jar-file))
- (or jss:*inhibit-add-to-classpath*
- (jss:add-to-classpath (component-pathname c))))
+ (or abcl-asdf:*inhibit-add-to-classpath*
+ (java:add-to-classpath (component-pathname c))))
(defmethod operation-done-p ((operation load-op) (c jar-file))
- (or jss:*inhibit-add-to-classpath*
- (member (namestring (truename (component-pathname c))) jss:*added-to-classpath* :test 'equal)))
+ (or abcl-asdf:*inhibit-add-to-classpath*
+ (member (namestring (truename (component-pathname c)))
+ abcl-asdf:*added-to-classpath* :test 'equal)))
(defmethod operation-done-p ((operation compile-op) (c jar-file))
t)
@@ -36,12 +67,11 @@
(defclass class-file-directory (static-file) ())
(defmethod perform ((operation compile-op) (c class-file-directory))
- (jss:add-to-classpath (component-pathname c)))
+ (java:add-to-classpath (component-pathname c)))
(defmethod perform ((operation load-op) (c class-file-directory))
- (jss:add-to-classpath (component-pathname c)))
+ (java:add-to-classpath (component-pathname c)))
-(defmethod source-file-type ((c jar-file) (s module)) "jar")
Modified: trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp
==============================================================================
--- trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp Sun Jul 31 06:01:43 2011 (r13429)
+++ trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp Mon Aug 1 14:34:26 2011 (r13430)
@@ -81,7 +81,7 @@
(error "You must download maven-3.0.3 from http://maven.apache.org/download.html, then set ABCL-ASDF:*MVN-DIRECTORY* appropiately."))
(unless (ensure-mvn-version)
(error "We need maven-3.0.3 or later."))
- (jss:add-directory-jars-to-class-path *mvn-libs-directory* nil)
+ (add-directory-jars-to-class-path *mvn-libs-directory* nil)
(setf *init* t))
(defun make-wagon-provider ()
Modified: trunk/abcl/contrib/jss/compat.lisp
==============================================================================
--- trunk/abcl/contrib/jss/compat.lisp Sun Jul 31 06:01:43 2011 (r13429)
+++ trunk/abcl/contrib/jss/compat.lisp Mon Aug 1 14:34:26 2011 (r13430)
@@ -4,13 +4,24 @@
"Whether backwards compatibility with JSS's use of CL-USER has been enabled.")
(defun ensure-compatibility ()
- (setf *cl-user-compatibility* t)
- (let ((dont-export '(add-to-classpath *cl-user-compatibility*)))
+ (require 'abcl-asdf)
+ (loop :for symbol :in '("add-directory-jars-to-class-path"
+ "need-to-add-directory-jar?")
+ :do
+ (unintern (intern symbol "CL-USER") :cl-user)
+ :do
+ (import (intern symbol "ABCL-ASDF") :cl-user))
+ (let ((dont-export '(*cl-user-compatibility* add-to-classpath)))
(loop :for symbol :being :each :external-symbol :in :jss
:when (not (find symbol dont-export))
- :do
- (unintern symbol :cl-user)
- :and :do
- (import symbol :cl-user))))
+ :do
+ (unintern symbol :cl-user)
+ :and :do
+ (import symbol :cl-user)))
+ (setf *cl-user-compatibility* t))
+
+;;; Because we're the last file in the ASDF system at the moment
+(provide 'jss)
+
Modified: trunk/abcl/contrib/jss/invoke.lisp
==============================================================================
--- trunk/abcl/contrib/jss/invoke.lisp Sun Jul 31 06:01:43 2011 (r13429)
+++ trunk/abcl/contrib/jss/invoke.lisp Mon Aug 1 14:34:26 2011 (r13430)
@@ -446,30 +446,6 @@
for i below (#"size" classesv)
collect (#"getName" (#"elementAt" classesv i))))))
-(defvar *added-to-classpath* nil)
-
-(defvar *inhibit-add-to-classpath* nil)
-
-(defun add-to-classpath (path &optional force)
- (unless *inhibit-add-to-classpath*
-;;; (ensure-dynamic-classpath)
-;;; (clear-invoke-imports)
- (let ((absolute (namestring (truename path))))
-;; (when (not (equal (pathname-type absolute) (pathname-type path)))
-;; (warn "HEY! ~a, ~a ~a, ~a" path (pathname-type path) absolute (pathname-type absolute))
-;; (setq @ (list path absolute)))
- ;; NOTE: for jar files, specified as a component, the ".jar" is part of the pathname-name :(
- (when (or force (not (member absolute *added-to-classpath* :test 'equalp)))
-;;; (#"addClassPath" *classpath-manager* (new 'java.net.url (#"replaceAll" (#"replaceAll" (concatenate 'string "file://" absolute) "\\\\" "/") "C:" "")))
-;;; (#"setClassLoader" '|jsint.Import| (#"getBaseLoader" *classpath-manager*))
-; (format t "path=~a type=~a~%" absolute (pathname-type absolute))
- (java:add-to-classpath path)
- (cond ((equal (pathname-type absolute) "jar")
- (jar-import absolute))
- ((file-directory-p absolute)
- (classfiles-import absolute)))
- (push absolute *added-to-classpath*)))))
-
(defun get-dynamic-class-path ()
(rest
(find-if (lambda (loader)
@@ -525,23 +501,6 @@
(pushnew full-class-name (gethash name *class-name-to-full-case-insensitive*)
:test 'equal)))
-(defun add-directory-jars-to-class-path (directory recursive-p)
- (if recursive-p
- (loop for jar in (all-jars-below directory) do (add-to-classpath jar))
- (loop for jar in (directory (merge-pathnames "*.jar" directory)) do (add-to-classpath jar))))
-
-(defun need-to-add-directory-jar? (directory recursive-p)
- (if recursive-p
- (loop for jar in (all-jars-below directory)
- do
- (if (not (member (namestring (truename jar)) *added-to-classpath* :test 'equal))
- (return-from need-to-add-directory-jar? t)))
- (loop for jar in (directory (merge-pathnames "*.jar" directory))
- do
- (if (not (member (namestring (truename jar)) *added-to-classpath* :test 'equal))
- (return-from need-to-add-directory-jar? t))))
- nil)
-
(defun set-to-list (set)
(declare (optimize (speed 3) (safety 0)))
(with-constant-signature ((iterator "iterator" t) (hasnext "hasNext") (next "next"))
Modified: trunk/abcl/contrib/jss/jss.asd
==============================================================================
--- trunk/abcl/contrib/jss/jss.asd Sun Jul 31 06:01:43 2011 (r13429)
+++ trunk/abcl/contrib/jss/jss.asd Mon Aug 1 14:34:26 2011 (r13430)
@@ -3,12 +3,13 @@
(defsystem :jss
:author "Alan Ruttenberg, Mark Evenson"
- :version "2.2.0"
+ :version "3.0.0"
:components
- ((:module base :pathname "" :serial t
+ ((:module base
+ :pathname "" :serial t
:components ((:file "packages")
(:file "invoke")
- (:file "asdf-jar")
+ (:file "classpath")
(:file "compat")))))
Modified: trunk/abcl/contrib/jss/packages.lisp
==============================================================================
--- trunk/abcl/contrib/jss/packages.lisp Sun Jul 31 06:01:43 2011 (r13429)
+++ trunk/abcl/contrib/jss/packages.lisp Mon Aug 1 14:34:26 2011 (r13430)
@@ -10,13 +10,13 @@
#:with-constant-signature
#:invoke-add-imports
- #:add-directory-jars-to-class-path
- #:add-to-classpath
#:find-java-class
- #:need-to-add-directory-jar?
#:jcmn
#:japropos
#:new
+
+ #:jar-import
+ #:classfiles-import
;;; Useful utilities to convert common Java items to Lisp counterparts
#:hashmap-to-hashtable
@@ -34,6 +34,6 @@
#:jclass-all-interfaces
;;; Enable compatibility with jss-1.0 by placing symbols in CL-USER
- #:ensure-compatibility #:*cl-user-compatibility*)
- (:shadow #:add-to-classpath))
+ #:ensure-compatibility #:*cl-user-compatibility*))
+
More information about the armedbear-cvs
mailing list