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.
parent b33fab36
......@@ -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"))))))
......@@ -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)
......
(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")
......
......@@ -81,7 +81,7 @@ Test:
(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 ()
......
......@@ -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)
......@@ -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"))
......
......@@ -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")))))
......
......@@ -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*))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment