Changeset 13281


Ignore:
Timestamp:
05/20/11 14:24:57 (10 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:
3 added
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/contrib/jss/invoke.lisp

    r13280 r13281  
    121121;; Tested on windows, linux.
    122122
    123 (in-package :cl-user)
     123(in-package :jss)
    124124
    125125;; invoke takes it's arguments in a java array. In order to not cons
     
    153153
    154154(defvar *imports-resolved-classes* (make-hash-table :test 'equal))
    155 (defvar *classpath-manager* nil)
    156155
    157156
     
    217216          argv))))
    218217      (if (eq method 'new)
    219     (progn
    220       (jstatic-raw ic invoke-class (or object-as-class-name object) argv))
     218          (apply #'jnew (or object-as-class-name object) args)
    221219    (if raw?
    222220        (if (symbolp object)
    223       (jstatic-raw is invoke-class object-as-class method argv)
    224       (jstatic-raw ii invoke-class object method argv true))
     221      (apply #'jstatic-raw method object-as-class  args)
     222      (apply #'jcall-raw method object  args))
    225223        (if (symbolp object)
    226       (jstatic is invoke-class object-as-class method argv)
    227       (jstatic ii invoke-class object method argv true)
    228       )))))))
     224      (apply #'jstatic method object-as-class args)
     225      (apply #'jcall method object args))))))))
    229226
    230227;; (defconstant no-args (load-time-value (jnew-array "java.lang.Object" 0)))
     
    411408      :test 'equal))))
    412409
    413 
    414410(defun new (class-name &rest args)
    415411  (invoke-restargs 'new class-name args))
     
    432428    (if (symbolp object)
    433429  (let ((class (find-java-class object)))
    434     (#"peekStatic" 'invoke class field))
    435       (#"peek" 'invoke object field))))
     430          (jfield class field)
     431        (jfield field object)))))
    436432
    437433;; use #"getSuperclass" and #"getInterfaces" to see whether there are fields in superclasses that we might set
     
    453449      (#"poke" 'invoke object field value))))
    454450
     451(defconstant +for-name+
     452  (jmethod "java.lang.Class" "forName" "java.lang.String" "boolean" "java.lang.ClassLoader"))
     453
     454(defconstant +true+
     455  (jstatic-raw "parseBoolean" "java.lang.Boolean" "true"))
     456
    455457(defun find-java-class (name)
    456   (if *classpath-manager*
    457       (or (#1"classForName" *classpath-manager* (maybe-resolve-class-against-imports name))
    458     (ignore-errors (jclass (maybe-resolve-class-against-imports name))))
    459     (jclass (maybe-resolve-class-against-imports name))))
     458  (or (jstatic +for-name+ "java.lang.Class"
     459               (maybe-resolve-class-against-imports name) +true+ java::*classloader*)
     460      (ignore-errors (jclass (maybe-resolve-class-against-imports name)))))
    460461
    461462(defmethod print-object ((obj (jclass "java.lang.Class")) stream)
     
    531532         :key #"getName" :test 'equal)))
    532533    (#"setAccessible" classes-field t)
    533     (loop for classloader in
    534    (list* (#"getClassLoader" (jclass "org.armedbear.lisp.Lisp"))
    535     (and *classpath-manager* (list (#"getBaseLoader" *classpath-manager*))))
     534    (loop for classloader in (mapcar #'first (dump-classpath))
    536535   append
    537536   (loop with classesv = (#"get" classes-field classloader)
     
    556555;; http://www.javaworld.com/javaworld/jw-10-1996/jw-10-indepth-p2.html
    557556
    558 (defvar *classpath-manager* nil)
    559 
    560557(defvar *added-to-classpath* nil)
    561 
    562 (defun maybe-install-bsh-classloader ()
    563   (unless *classpath-manager*
    564     (when (ignore-errors (jclass "bsh.classpath.ClassManagerImpl"))
    565       (let* ((urls (jnew-array "java.net.URL" 0))
    566        (manager (jnew "bsh.classpath.ClassManagerImpl"))
    567        (bshclassloader (jnew "bsh.classpath.BshClassLoader" manager urls)))
    568   (#"setClassLoader" '|jsint.Import| bshclassloader)
    569   (setq *classpath-manager* manager)))))
    570 
    571 (defun ensure-dynamic-classpath ()
    572   (assert *classpath-manager* () "Can't add to classpath unless bean shell jar is in your classpath"))
    573558
    574559(defvar *inhibit-add-to-classpath* nil)
     
    576561(defun add-to-classpath (path &optional force)
    577562  (unless *inhibit-add-to-classpath*
    578     (ensure-dynamic-classpath)
    579     (clear-invoke-imports)
     563;;;    (ensure-dynamic-classpath)
     564;;;    (clear-invoke-imports)
    580565    (let ((absolute (namestring (truename path))))
    581566;;       (when (not (equal (pathname-type absolute) (pathname-type path)))
     
    584569      ;; NOTE: for jar files, specified as a component, the ".jar" is part of the pathname-name :(
    585570      (when (or force (not (member absolute *added-to-classpath* :test 'equalp)))
    586   (#"addClassPath" *classpath-manager* (new 'java.net.url (#"replaceAll" (#"replaceAll" (concatenate 'string "file://" absolute) "\\\\" "/") "C:" "")))
    587   (#"setClassLoader" '|jsint.Import| (#"getBaseLoader" *classpath-manager*))
     571;;; (#"addClassPath" *classpath-manager* (new 'java.net.url (#"replaceAll" (#"replaceAll" (concatenate 'string "file://" absolute) "\\\\" "/") "C:" "")))
     572;;; (#"setClassLoader" '|jsint.Import| (#"getBaseLoader" *classpath-manager*))
    588573; (format t "path=~a type=~a~%"  absolute (pathname-type absolute))
     574        (java:add-to-classpath path)
    589575  (cond ((equal (pathname-type absolute) "jar")
    590576         (jar-import absolute))
     
    594580
    595581(defun get-dynamic-class-path ()
    596   (ensure-dynamic-classpath)
     582  (dump-classpath)
     583#+nil
    597584  (map 'list (lambda(el)
    598585         (let ((path (#"toString" el)))
     
    602589       (#"getPathComponents" (#"getClassPath" *classpath-manager*))))
    603590
     591#+nil
    604592(eval-when (:load-toplevel :execute)
    605593  (maybe-install-bsh-classloader))
     
    672660(defun add-directory-jars-to-class-path (directory recursive-p)
    673661  (if recursive-p
    674       (loop for jar in (all-jars-below directory) do (cl-user::add-to-classpath jar))
    675       (loop for jar in (directory (merge-pathnames "*.jar" directory)) do (cl-user::add-to-classpath jar))))
     662      (loop for jar in (all-jars-below directory) do (add-to-classpath jar))
     663      (loop for jar in (directory (merge-pathnames "*.jar" directory)) do (add-to-classpath jar))))
    676664
    677665(defun need-to-add-directory-jar? (directory recursive-p)
     
    774762      else
    775763      do (assert (or (symbolp m) (functionp m)) (m) "Methods must be function designators: ~s" m)))
    776         (null (make-immediate-object nil :ref)))
     764#+nil   (null (make-immediate-object nil :ref)))
    777765    (let ((safe-method-names-and-defs
    778766     (loop for (name function) on method-names-and-defs by #'cddr
    779         collect name collect (safely  function name))))
     767        collect name collect (safely function name))))
    780768      (loop for method across
    781769     (jclass-methods interface :declared nil :public t)
     
    785773     (let* ((def  `(lambda
    786774           (&rest args)
    787          (cl-user::invoke-restargs ,(jmethod-name method) ,dispatch-to args t)
     775         (invoke-restargs ,(jmethod-name method) ,dispatch-to args t)
    788776         )))
    789777       (push (coerce def 'function) safe-method-names-and-defs)
     
    804792      (#"replaceFirst" (princ-to-string condition) "(?s)\\\\s*at jsint.E.*" "")))
    805793
    806 (in-package :asdf)
    807 
    808 
    809 (defclass jar-directory (static-file) ())
    810 
    811 (defmethod perform ((operation compile-op) (c jar-directory))
    812   (unless cl-user::*inhibit-add-to-classpath*
    813     (cl-user::add-directory-jars-to-class-path (truename (component-pathname c)) t)))
    814 
    815 (defmethod perform ((operation load-op) (c jar-directory))
    816   (unless cl-user::*inhibit-add-to-classpath*
    817     (cl-user::add-directory-jars-to-class-path (truename (component-pathname c)) t)))
    818 
    819 (defmethod operation-done-p ((operation load-op) (c jar-directory))
    820   (or cl-user::*inhibit-add-to-classpath*
    821     (not (cl-user::need-to-add-directory-jar? (component-pathname c) t))))
    822 
    823 (defmethod operation-done-p ((operation compile-op) (c jar-directory))
    824   t)
    825 
    826 (defclass jar-file (static-file) ())
    827 
    828 (defmethod perform ((operation compile-op) (c jar-file))
    829   (cl-user::add-to-classpath (component-pathname c)))
    830 
    831 (defmethod perform ((operation load-op) (c jar-file))
    832   (or cl-user::*inhibit-add-to-classpath*
    833       (cl-user::add-to-classpath (component-pathname c))))
    834 
    835 (defmethod operation-done-p ((operation load-op) (c jar-file))
    836   (or cl-user::*inhibit-add-to-classpath*
    837       (member (namestring (truename (component-pathname c))) cl-user::*added-to-classpath* :test 'equal)))
    838 
    839 (defmethod operation-done-p ((operation compile-op) (c jar-file))
    840   t)
    841 
    842 (defclass class-file-directory (static-file) ())
    843 
    844 (defmethod perform ((operation compile-op) (c class-file-directory))
    845   (cl-user::add-to-classpath (component-pathname c)))
    846 
    847 (defmethod perform ((operation load-op) (c class-file-directory))
    848   (cl-user::add-to-classpath (component-pathname c)))
    849 
    850 ;; ****************************************************************
    851 
    852 
    853 
  • trunk/abcl/contrib/jss/jss.asd

    r13280 r13281  
    11;;;; -*- Mode: LISP -*-
     2
     3;;; XXX
     4;;(java:add-to-classpath "~/work/lsw2/lib/jscheme.jar")
    25
    36(in-package :asdf)
     
    58(defsystem :jss
    69  :author "Alan Ruttenberg"
    7   :version "1"
    8   :components
    9   ((:file "invoke"))
    10   :depends-on
    11   ())
     10  :version "2.0"
     11  :components
     12  ((:module base :pathname "" :serial t
     13            :components ((:file "packages")
     14                         (:file "invoke")
     15                         (:file "asdf-jar")
     16                         (:file "compat")))))
    1217
     18
     19
     20
     21   
     22
     23
Note: See TracChangeset for help on using the changeset viewer.