Ignore:
Timestamp:
04/08/10 19:44:14 (11 years ago)
Author:
astalla
Message:

JAVA-CLASS metaclass reimplemented in Lisp.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/java.lisp

    r12315 r12583  
    3333
    3434(require "CLOS")
     35(require "PRINT-OBJECT")
    3536
    3637(defun jregister-handler (object event handler &key data count)
     
    309310  (%jset-property-value obj prop value))
    310311
    311 (provide "JAVA-EXTENSIONS")
     312;;; print-object
     313
     314(defmethod print-object ((obj java:java-object) stream)
     315  (write-string (sys::%write-to-string obj) stream))
     316
     317(defmethod print-object ((e java:java-exception) stream)
     318  (if *print-escape*
     319      (print-unreadable-object (e stream :type t :identity t)
     320        (format stream "~A"
     321                (java:jcall (java:jmethod "java.lang.Object" "toString")
     322                            (java:java-exception-cause e))))
     323      (format stream "Java exception '~A'."
     324              (java:jcall (java:jmethod "java.lang.Object" "toString")
     325                          (java:java-exception-cause e)))))
     326
     327;;; JAVA-CLASS support
     328
     329(defclass java-class (standard-class)
     330  ((jclass :initarg :java-class
     331     :initform (error "class is required")
     332     :reader java-class-jclass)))
     333
     334(defun ensure-java-class (jclass)
     335  (let ((class (%find-java-class jclass)))
     336    (if class
     337  class
     338  (%register-java-class
     339   jclass (mop::ensure-class (make-symbol (jclass-name jclass))
     340           :metaclass (find-class 'java-class)
     341           :direct-superclasses (if (jclass-superclass-p jclass (jclass "java.lang.Object"))
     342                  (list (find-class 'java-object))
     343                  (mapcar #'ensure-java-class
     344                    (delete nil
     345                      (concatenate 'list (list (jclass-superclass jclass))
     346                       (jclass-interfaces jclass)))))
     347           :java-class jclass)))))
     348   
     349(defmethod make-instance ((class java-class) &rest initargs &key &allow-other-keys)
     350  (declare (ignore initargs))
     351  (error "make-instance not supported for ~S" class))
     352
     353(provide "JAVA")
Note: See TracChangeset for help on using the changeset viewer.