Changeset 13937


Ignore:
Timestamp:
05/16/12 12:10:06 (2 years ago)
Author:
mevenson
Message:

jss: fix ticket #205 JSS:WITH-CONSTANT-SIGNATURE.

Add more docstrings to JSS.

JAVA-CLASS-METHOD-NAMES is now a synonym for JSS.

Location:
trunk/abcl
Files:
5 edited

Legend:

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

    r13430 r13937  
    55
    66(defun ensure-compatibility ()
     7  "Ensure backwards compatibility with JSS's use of CL-USER."
    78  (require 'abcl-asdf)
    89  (loop :for symbol :in '("add-directory-jars-to-class-path"
  • trunk/abcl/contrib/jss/invoke.lisp

    r13910 r13937  
    22;;
    33;; Copyright (C) 2005 Alan Ruttenberg
    4 ;; Copyright (C) 2011 Mark Evenson
     4;; Copyright (C) 2011-2 Mark Evenson
    55;;
    66;; Since most of this code is derivative of the Jscheme System, it is
     
    123123
    124124(eval-when (:compile-toplevel :load-toplevel :execute)
    125   (defvar *do-auto-imports* t))
     125  (defvar *do-auto-imports* t
     126    "Whether to automatically introspect all Java classes on the classpath when JSS is loaded."))
    126127
    127128(defvar *imports-resolved-classes* (make-hash-table :test 'equal))
    128129
    129130(defun find-java-class (name)
     131  "Returns the java.lang.Class representation of NAME.
     132
     133NAME can either string or a symbol according to the usual JSS conventions."
    130134  (jclass (maybe-resolve-class-against-imports name)))
    131135
     
    177181                (apply #'jcall method object args))))))
    178182
    179 ;;; Method name as String --> String  | Symbol --> jmethod
    180 (defvar *methods-cache* (make-hash-table :test #'equal))
    181 
    182 (defun get-jmethod (method object)
    183   (when (gethash method *methods-cache*)
    184     (gethash
    185      (if (symbolp object) (lookup-class-name object) (jobject-class object))
    186      (gethash method *methods-cache*))))
    187 
    188 (defun set-jmethod (method object jmethod)
    189   (unless (gethash method *methods-cache*)
    190     (setf (gethash method *methods-cache*) (make-hash-table :test #'equal)))
    191   (setf
    192    (gethash
    193     (if (symbolp object) (lookup-class-name object) (jobject-class object))
    194     (gethash method *methods-cache*))
    195    jmethod))
    196 
    197183(defconstant +set-accessible+
    198184  (jmethod "java.lang.reflect.AccessibleObject" "setAccessible" "boolean"))
    199185
    200 ;;; TODO optimize me!
    201186(defun invoke-find-method (method object args)
    202   (let ((jmethod (get-jmethod method object)))
    203     (unless jmethod
    204       (setf jmethod
    205             (if (symbolp object)
     187  (let ((result
     188         (if (symbolp object)
    206189                ;;; static method
    207                 (apply #'jmethod (lookup-class-name object)
    208                        method (mapcar #'jobject-class args))
     190             (apply #'jmethod (lookup-class-name object)
     191                    method (mapcar #'jobject-class args))
    209192                  ;;; instance method
    210                 (apply #'jresolve-method
    211                        method object args)))
    212       (jcall +set-accessible+ jmethod +true+)
    213       (set-jmethod method object jmethod))
    214     jmethod))
     193             (apply #'jresolve-method
     194                    method object args))))
     195    (jcall +set-accessible+ result +true+)
     196    result))
    215197
    216198;; This is the reader macro for java methods. it translates the method
     
    233215
    234216(defmacro with-constant-signature (fname-jname-pairs &body body)
     217  "Expand all references to FNAME-JNAME-PAIRS in BODY into static function calls promising that the same function bound in the FNAME-JNAME-PAIRS will be invoked with the same argument signature.
     218
     219FNAME-JNAME-PAIRS is a list of (symbol function &optional raw)
     220elements where symbol will be the symbol bound to the method named by
     221the string function.  If the optional parameter raw is non-nil, the
     222result will be the raw JVM object, uncoerced by the usual conventions.
     223
     224Use this macro if you are making a lot of calls and
     225want to avoid the overhead of the dynamic dispatch."
     226
    235227  (if (null fname-jname-pairs)
    236228      `(progn ,@body)
     
    260252                  (jclass "java.util.regex.Pattern")
    261253                  ".*?([^.]*)$")))
    262 
    263254   (last-name
    264255    (let ((matcher (#0"matcher" last-name-pattern name)))
     
    309300
    310301(defun jar-import (file)
     302  "Import all the Java classes contained in the pathname FILE into the JSS dynamic lookup cache."
    311303  (when (probe-file file)
    312304    (loop for (name . full-class-name) in (get-all-jar-classnames file)
     
    316308
    317309(defun new (class-name &rest args)
     310  "Invoke the Java constructor for CLASS-NAME with ARGS.
     311
     312CLASS-NAME may either be a symbol or a string according to the usual JSS conventions."
    318313  (invoke-restargs 'new class-name args))
    319314
     
    405400
    406401(defun japropos (string)
     402"Output the names of all Java class names loaded in the current process which match STRING.."
    407403  (setq string (string string))
    408404  (let ((matches nil))
     
    426422   (ignore-errors (remove-duplicates (map 'list (if full #"toString" 'jmethod-name) (#"getConstructors" (find-java-class class))) :test 'equal))))
    427423
    428 (defun jcmn (class &optional full)
    429   (if full
     424(defun java-class-method-names (class &optional stream)
     425  "Return a list of the public methods encapsulated by the JVM CLASS.
     426
     427If STREAM non-nil, output a verbose description to the named output stream.
     428
     429CLASS may either be a string naming a fully qualified JVM class in dot
     430notation, or a symbol resolved against all class entries in the
     431current classpath."
     432  (if stream
    430433      (dolist (method (jclass-method-names class t))
    431   (format t "~a~%" method))
     434  (format stream "~a~%" method))
    432435      (jclass-method-names class)))
     436
     437(setf (symbol-function 'jcmn) 'java-class-method-names)
    433438
    434439(defun path-to-class (classname)
     
    504509
    505510(defun classfiles-import (directory)
     511  "Load all Java classes recursively contained under DIRECTORY in the current process."
    506512  (setq directory (truename directory))
    507513  (loop for full-class-name in (all-classes-below-directory directory)
     
    526532
    527533(defun jarray-to-list (jarray)
     534  "Convert the Java array named by JARRARY into a Lisp list."
    528535  (declare (optimize (speed 3) (safety 0)))
    529536  (jlist-to-list
     
    546553
    547554(defun iterable-to-list (iterable)
     555  "Return the items contained the java.lang.Iterable ITERABLE as a list."
    548556 (declare (optimize (speed 3) (safety 0)))
    549557 (let ((it (#"iterator" iterable)))
  • trunk/abcl/contrib/jss/jss.asd

    r13909 r13937  
    44(defsystem :jss
    55  :author "Alan Ruttenberg, Mark Evenson"
    6   :version "3.0.2"
     6  :version "3.0.3"
    77  :components
    88  ((:module base
  • trunk/abcl/contrib/jss/packages.lisp

    r13909 r13937  
    1212   #:invoke-add-imports
    1313   #:find-java-class
    14    #:jcmn
     14   #:jcmn #:java-class-method-names
    1515   #:japropos
    1616   #:new
  • trunk/abcl/test/lisp/abcl/bugs.lisp

    r13936 r13937  
    111111      (require :jss)
    112112      (jss:with-constant-signature ((substring "substring"))
    113         (substring "some string" 2)))
    114   t)
     113        (substring "01234" 2)))
     114  "234")
    115115
    116116
Note: See TracChangeset for help on using the changeset viewer.