Changeset 13281

Timestamp:

05/20/11 14:24:57 (12 years ago)

Author:

Mark Evenson

Message:

Provisionally working version of JSS without bsh-2.0b4.jar.

This still needs 'jscheme.jar' to be loaded via the top-level
declaration at the beginning of packages.lisp. Adjust the filepath to
a local version of jscheme.jar which may be downloaded from
​http://code.google.com/p/lsw2/source/browse/trunk/lib/jscheme.jar.

Rigourously untested, but still a worthwhile checkpoint for public
consumption, especially since we need to fix on an API.

Re-packaged in JSS package. Use ENSURE-COMPATIBILITY to be compatible
with existing JSS installations.

Location:

trunk/abcl/contrib/jss

Files:

• asdf-jar.lisp (added)
• compat.lisp (added)
• invoke.lisp (modified) (16 diffs)
• jss.asd (modified) (2 diffs)
• packages.lisp (added)

trunk/abcl/contrib/jss/invoke.lisp

@@ -121 +121 @@
 ;; Tested on windows, linux.
 
-(in-package :cl-user)
+(in-package :jss)
 
 ;; invoke takes it's arguments in a java array. In order to not cons
@@ -153 +153 @@
 
 (defvar *imports-resolved-classes* (make-hash-table :test 'equal))
-(defvar *classpath-manager* nil)
 
 
@@ -217 +216 @@
           argv))))
       (if (eq method 'new)
-    (progn
-      (jstatic-raw ic invoke-class (or object-as-class-name object) argv))
+          (apply #'jnew (or object-as-class-name object) args)
     (if raw?
         (if (symbolp object)
-      (jstatic-raw is invoke-class object-as-class method argv)
-      (jstatic-raw ii invoke-class object method argv true))
+      (apply #'jstatic-raw method object-as-class  args)
+      (apply #'jcall-raw method object  args))
         (if (symbolp object)
-      (jstatic is invoke-class object-as-class method argv)
-      (jstatic ii invoke-class object method argv true)
-      )))))))
+      (apply #'jstatic method object-as-class args)
+      (apply #'jcall method object args))))))))
 
 ;; (defconstant no-args (load-time-value (jnew-array "java.lang.Object" 0)))
@@ -411 +408 @@
       :test 'equal))))
 
-
 (defun new (class-name &rest args)
   (invoke-restargs 'new class-name args))
@@ -432 +428 @@
     (if (symbolp object)
   (let ((class (find-java-class object)))
-    (#"peekStatic" 'invoke class field))
-      (#"peek" 'invoke object field))))
+          (jfield class field)
+        (jfield field object)))))
 
 ;; use #"getSuperclass" and #"getInterfaces" to see whether there are fields in superclasses that we might set
@@ -453 +449 @@
       (#"poke" 'invoke object field value))))
 
+(defconstant +for-name+ 
+  (jmethod "java.lang.Class" "forName" "java.lang.String" "boolean" "java.lang.ClassLoader"))
+
+(defconstant +true+
+  (jstatic-raw "parseBoolean" "java.lang.Boolean" "true"))
+
 (defun find-java-class (name)
-  (if *classpath-manager*
-      (or (#1"classForName" *classpath-manager* (maybe-resolve-class-against-imports name))
-    (ignore-errors (jclass (maybe-resolve-class-against-imports name))))
-    (jclass (maybe-resolve-class-against-imports name))))
+  (or (jstatic +for-name+ "java.lang.Class" 
+               (maybe-resolve-class-against-imports name) +true+ java::*classloader*)
+      (ignore-errors (jclass (maybe-resolve-class-against-imports name)))))
 
 (defmethod print-object ((obj (jclass "java.lang.Class")) stream) 
@@ -531 +532 @@
          :key #"getName" :test 'equal)))
     (#"setAccessible" classes-field t)
-    (loop for classloader in 
-   (list* (#"getClassLoader" (jclass "org.armedbear.lisp.Lisp"))
-    (and *classpath-manager* (list (#"getBaseLoader" *classpath-manager*))))
+    (loop for classloader in (mapcar #'first (dump-classpath))
    append
    (loop with classesv = (#"get" classes-field classloader)
@@ -556 +555 @@
 ;; http://www.javaworld.com/javaworld/jw-10-1996/jw-10-indepth-p2.html
 
-(defvar *classpath-manager* nil)
-
 (defvar *added-to-classpath* nil)
-
-(defun maybe-install-bsh-classloader ()
-  (unless *classpath-manager*
-    (when (ignore-errors (jclass "bsh.classpath.ClassManagerImpl"))
-      (let* ((urls (jnew-array "java.net.URL" 0))
-       (manager (jnew "bsh.classpath.ClassManagerImpl"))
-       (bshclassloader (jnew "bsh.classpath.BshClassLoader" manager urls)))
-  (#"setClassLoader" '|jsint.Import| bshclassloader)
-  (setq *classpath-manager* manager)))))
-
-(defun ensure-dynamic-classpath ()
-  (assert *classpath-manager* () "Can't add to classpath unless bean shell jar is in your classpath"))
 
 (defvar *inhibit-add-to-classpath* nil)
@@ -576 +561 @@
 (defun add-to-classpath (path &optional force)
   (unless *inhibit-add-to-classpath*
-    (ensure-dynamic-classpath)
-    (clear-invoke-imports)
+;;;    (ensure-dynamic-classpath)
+;;;    (clear-invoke-imports)
     (let ((absolute (namestring (truename path))))
 ;;       (when (not (equal (pathname-type absolute) (pathname-type path)))
@@ -584 +569 @@
       ;; 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*))
+;;; (#"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))
@@ -594 +580 @@
 
 (defun get-dynamic-class-path ()
-  (ensure-dynamic-classpath)
+  (dump-classpath)
+#+nil
   (map 'list (lambda(el) 
          (let ((path (#"toString" el)))
@@ -602 +589 @@
        (#"getPathComponents" (#"getClassPath" *classpath-manager*))))
 
+#+nil
 (eval-when (:load-toplevel :execute)
   (maybe-install-bsh-classloader))
@@ -672 +660 @@
 (defun add-directory-jars-to-class-path (directory recursive-p)
   (if recursive-p
-      (loop for jar in (all-jars-below directory) do (cl-user::add-to-classpath jar))
-      (loop for jar in (directory (merge-pathnames "*.jar" directory)) do (cl-user::add-to-classpath jar))))
+      (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)
@@ -774 +762 @@
       else
       do (assert (or (symbolp m) (functionp m)) (m) "Methods must be function designators: ~s" m))) 
-        (null (make-immediate-object nil :ref)))
+#+nil   (null (make-immediate-object nil :ref)))
     (let ((safe-method-names-and-defs 
      (loop for (name function) on method-names-and-defs by #'cddr
-        collect name collect (safely  function name))))
+        collect name collect (safely function name))))
       (loop for method across
      (jclass-methods interface :declared nil :public t)
@@ -785 +773 @@
      (let* ((def  `(lambda
            (&rest args)
-         (cl-user::invoke-restargs ,(jmethod-name method) ,dispatch-to args t)
+         (invoke-restargs ,(jmethod-name method) ,dispatch-to args t)
          )))
        (push (coerce def 'function) safe-method-names-and-defs)
@@ -804 +792 @@
       (#"replaceFirst" (princ-to-string condition) "(?s)\\\\s*at jsint.E.*" "")))
 
-(in-package :asdf)
-
-
-(defclass jar-directory (static-file) ())
-
-(defmethod perform ((operation compile-op) (c jar-directory))
-  (unless cl-user::*inhibit-add-to-classpath*
-    (cl-user::add-directory-jars-to-class-path (truename (component-pathname c)) t)))
-
-(defmethod perform ((operation load-op) (c jar-directory))
-  (unless cl-user::*inhibit-add-to-classpath*
-    (cl-user::add-directory-jars-to-class-path (truename (component-pathname c)) t)))
-
-(defmethod operation-done-p ((operation load-op) (c jar-directory))
-  (or cl-user::*inhibit-add-to-classpath*
-    (not (cl-user::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 perform ((operation compile-op) (c jar-file))
-  (cl-user::add-to-classpath (component-pathname c)))
-
-(defmethod perform ((operation load-op) (c jar-file))
-  (or cl-user::*inhibit-add-to-classpath*
-      (cl-user::add-to-classpath (component-pathname c))))
-
-(defmethod operation-done-p ((operation load-op) (c jar-file))
-  (or cl-user::*inhibit-add-to-classpath*
-      (member (namestring (truename (component-pathname c))) cl-user::*added-to-classpath* :test 'equal)))
-
-(defmethod operation-done-p ((operation compile-op) (c jar-file))
-  t)
-
-(defclass class-file-directory (static-file) ())
-
-(defmethod perform ((operation compile-op) (c class-file-directory))
-  (cl-user::add-to-classpath (component-pathname c)))
-
-(defmethod perform ((operation load-op) (c class-file-directory))
-  (cl-user::add-to-classpath (component-pathname c)))
-
-;; ****************************************************************
-
-
-

trunk/abcl/contrib/jss/jss.asd

@@ -1 +1 @@
 ;;;; -*- Mode: LISP -*-
+
+;;; XXX 
+;;(java:add-to-classpath "~/work/lsw2/lib/jscheme.jar")
 
 (in-package :asdf)
@@ -5 +8 @@
 (defsystem :jss
   :author "Alan Ruttenberg"
-  :version "1"
-  :components
-  ((:file "invoke"))
-  :depends-on
-  ())
+  :version "2.0" 
+  :components 
+  ((:module base :pathname "" :serial t 
+            :components ((:file "packages")
+                         (:file "invoke")
+                         (:file "asdf-jar")
+                         (:file "compat")))))
 
+
+
+
+   
+
+