From: ueno Date: Thu, 16 Nov 2000 03:04:46 +0000 (+0000) Subject: Importing XEmacs to Java bridge. X-Git-Tag: xemacs-java-0_4 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=HEAD;p=elisp%2Fxemacs-java.git Importing XEmacs to Java bridge. --- 00644e30110339a88898f2a73fb19857f39132d1 diff --git a/.cvsignore b/.cvsignore new file mode 100644 index 0000000..0f59d90 --- /dev/null +++ b/.cvsignore @@ -0,0 +1,2 @@ +java_i.c +java.ell diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..228da16 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,97 @@ +2000-10-17 Daiki Ueno + + * jbrowse.el (jbrowse-type-string): Prepare cached entry. + (jbrowse-modifier-chars): Rename from `jbrowse-modifier-alist'. + (jbrowse-modifier-chars): Rename from `jbrowse-describe-modifiers'. + (jbrowse-describe-parameters): Abolish. + (jbrowse-describe-method): Abolish. + (jbrowse-make-method-info): New function. + (jbrowse-describe-method-info): New function. + (jbrowse-insert-type): Don't call "isPrimitive" or "isArray". + (jbrowse-make-class-info): New function. + (jbrowse-describe-class-1): New function. + (jbrowse-describe-class): Cache class information. + +2000-10-17 Daiki Ueno + + * jbrowse.el (jbrowse-class-obarray): New variable. + (jbrowse-insert-type): Update it. + (jbrowse-describe-class): Use `jbrowse-class-obarray' to do + completion. + +2000-10-17 Daiki Ueno + + * java.c (java_unify_parameters): Delete local reference to + the parameter array. + (java_find_method): Ditto. + (java_call_static_method): Remove last "\n" from error string. + (java_call_virtual_method): Ditto. + +2000-10-17 Daiki Ueno + + * java.c (jni_call_virtual_method): New function. + (jni_call_static_method): New function. + (java_build_return_value): Don't cast `null'. + +2000-10-17 Daiki Ueno + + * java.c (java_find_method): Accept 6th argument `filter'. + (mark_javaobject): New function. + +2000-10-16 Daiki Ueno + + * jbrowse.el (jbrowse-class-java-lang-package): New variable. + (jbrowse-modifier-alist): New variable. + (jbrowse-describe-modifiers): Rewrite with using it. + (jbrowse-insert-type): New function to deal with cross references. + (jbrowse-describe-parameters): Use it. + (jbrowse-describe-method): Use it. + (jbrowse-describe-methods): Abolish. + (jbrowse-describe-class): Do completion based on the current + package tree and already loaded classes. + +2000-10-16 Daiki Ueno + + * jbrowse.el (jbrowse-type-string): New function. + (jbrowse-describe-parameters): Use it. + (jbrowse-describe-methods): Use it. + (jbrowse-describe-class): Use it. + +2000-10-16 Daiki Ueno + + * java.c (Fjava_class_list): New function. + (add_java_class_to_list_mapper): New function. + (java_class_list_closure): New struct. + (java_modifier_filter): New type. + (Fjava_find_class): Store the given name of the class. + (mark_javaclass): New function. + (Fjava_class_name): New function. + +2000-10-16 Daiki Ueno + + * java.c (java_unify_object_array): Add comment. + (java_build_return_value_vector): Use `xstrdup' and `xfree' + instead of `alloca'. + (java_primitive_type_signature): Rename from `java_type_signature_1'. + (jni_class_get_name): New function. + (java_type_signature): Use it. + (jni_class_to_string): Abolish. + (jni_nonvirtual_method_caller): New type. + (jni_primitive_wrapper): Add `call_nonvirtual_method'. + (jni_initialize_primitive_call_table): Initialize + `call_nonvirtual_method'. + +2000-10-15 Daiki Ueno + + * java.c (java_unify_parameter): Handle 'C'. + (java_build_return_value): Ditto. + +2000-10-15 Daiki Ueno + + * java.c (java_build_return_value_vector): New function. + (java_build_return_value): Use it. + (java_call_static_method): Handle return type `['. + (java_call_virtual_method): Ditto. + (Fjava_make_object): New function. + (syms_of_java): Don't register `Fjava_initialize' and + `Fjava_finalize'; register `Fjava_make_object'. diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..08e6cb8 --- /dev/null +++ b/Makefile @@ -0,0 +1,38 @@ +1SHELL=/bin/sh +RM=rm -f +CC=ellcc +LD=$(CC) --mode=link +MKINIT=$(CC) --mode=init +JAVA_HOME=/usr/local/jdk1.3 +CFLAGS=-I. -I$(JAVA_HOME)/include -I$(JAVA_HOME)/include/linux +JAVA_ARCH_RUNTIME_LIBS=$(JAVA_HOME)/jre/lib/i386/native_threads +LIBS=-Wl,-rpath,$(JAVA_HOME)/jre/lib/i386:$(JAVA_ARCH_RUNTIME_LIBS):$(JAVA_HOME)/jre/lib/i386/classic \ + -L$(JAVA_HOME)/jre/lib/i386 -L$(JAVA_ARCH_RUNTIME_LIBS) \ + -ljava -lhpi + +SRCS=java.c +OBJS=$(SRCS:.c=.o) + +.c.o: + $(CC) $(CFLAGS) -c $< + +MODNAME=java +MODVER=0.4 +MODTITLE="Java Native Interface module" + +all: $(MODNAME).ell + +distclean: clean + +clean: + $(RM) $(MODNAME).ell $(OBJS) java_i.o java_i.c + +$(MODNAME).ell: $(OBJS) java_i.o + $(LD) --mod-output=$@ $(OBJS) java_i.o $(LIBS) + +java_i.o: java_i.c +java_i.c: $(SRCS) + $(MKINIT) --mod-output=$@ \ + --mod-name=$(MODNAME) --mod-version=$(MODVER) \ + --mod-title=$(MODTITLE) $(SRCS) + diff --git a/README b/README new file mode 100644 index 0000000..7741fd1 --- /dev/null +++ b/README @@ -0,0 +1,20 @@ +*** XEmacs Java bridge *** + +* What is it? + +This package uses JNI to create a JVM within the XEmacs process; +allow XEmacs Lisp to access Java VM. + +* Installation + +(0) You will need XEmacs 21.2 (beta37) and J2SE version 1.3 or later +to compile (check out http://java.sun.com/j2se/1.3/). + +(1) Edit Makefile and just type make. You will see the loadable +module `java.ell'. (locate it in site-module-directory if you want) + +(3) Start XEmacs and type M-x load-module java.ell. + +* Known bugs + +- No way to call back to Lisp functions. diff --git a/java.c b/java.c new file mode 100644 index 0000000..eac2054 --- /dev/null +++ b/java.c @@ -0,0 +1,1376 @@ +/* Emacs Lisp binding to Java Native Interface. + Copyright (C) 2000 Daiki Ueno. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include +#include +#include "java.h" + +#ifdef MULE +#define JAVA_OS_CODING Fget_coding_system(Vjava_coding_system) +#else +#define JAVA_OS_CODING Qnative +#endif + +Lisp_Object Vjava_coding_system; +Lisp_Object Vjava_class_path; +Lisp_Object Vjava_library_path; +static Lisp_Object Qjava; + +Lisp_Object Qjavaclassp; +Lisp_Object Qjavaobjectp; + +static JavaVM *java_jvm = NULL; +static JNIEnv *java_env = NULL; + +#define JAVAVM_LIVE_P() (java_jvm && java_env) +#define CHECK_LIVE_JAVAVM() do { \ + if (!JAVAVM_LIVE_P ()) \ + error ("Attempting to access uninitialized Java VM.\n"); \ +} while (0) + +static Extbyte *java_build_property_string (Lisp_Object, Lisp_Object); +static void java_dots_to_slashes (Extbyte *); +static int java_unify_parameter (JNIEnv *, const Extbyte *, Lisp_Object, + jvalue *); +static Lisp_Object java_build_return_value (JNIEnv *, const Extbyte *, jvalue); + +typedef jlong (JNICALL *jni_method_caller) + (JNIEnv *, jobject, jmethodID, jvalue *); + +typedef jlong (JNICALL *jni_static_method_caller) + (JNIEnv *, jclass, jmethodID, jvalue *); + +typedef jlong (JNICALL *jni_nonvirtual_method_caller) + (JNIEnv *, jobject, jclass, jmethodID, jvalue *); + +typedef jarray (JNICALL *jni_array_allocater) (JNIEnv *, jsize); + +typedef void (*jni_array_setter) (JNIEnv *, jarray, jsize, jvalue); +typedef jlong (*jni_array_referrer) (JNIEnv *, jarray, jsize); + +struct jni_primitive_wrapper { + jni_method_caller call_method; + jni_static_method_caller call_static_method; + jni_nonvirtual_method_caller call_nonvirtual_method; + jni_array_allocater new_array; + jni_array_setter set_array_element; + jni_array_referrer get_array_element; +}; + +typedef jboolean (*java_modifier_filter)(JNIEnv *, jint); + +struct java_class_list_closure +{ + Lisp_Object *java_class_list; +}; + +static struct jni_primitive_wrapper jni_primitive_call_table[8]; +static const Extbyte *jni_primitive_signature_table = "ZBCSIJFD"; + +inline static jvalue jni_primitive_call_method + (JNIEnv *, const Extbyte *, jobject, jmethodID, jvalue *); +inline static jvalue jni_primitive_call_static_method + (JNIEnv *, const Extbyte *, jclass, jmethodID, jvalue *); +inline static jarray jni_primitive_new_array + (JNIEnv *, const Extbyte *, jsize); +inline static void jni_primitive_set_array_element + (JNIEnv *, const Extbyte *, jarray, jsize, jvalue); +inline static jvalue jni_primitive_get_array_element + (JNIEnv *, const Extbyte *, jarray, jsize); + +static void jni_initialize_primitive_call_table (JNIEnv *); +static int jni_lookup_primitive_call_table (const char *); +static jobjectArray jni_class_get_methods (JNIEnv *, jclass); +static jobjectArray jni_class_get_constructors (JNIEnv *, jclass); +static jstring jni_class_get_name (JNIEnv *, jclass class); +static jboolean jni_class_is_primitive (JNIEnv *, jclass); +static jobjectArray jni_method_get_parameter_types (JNIEnv *, jobject); +static jstring jni_method_get_name (JNIEnv *, jobject); +static jint jni_method_get_modifiers (JNIEnv *, jobject); +static jclass jni_method_get_return_type (JNIEnv *, jobject); +static jboolean jni_modifier_is_static (JNIEnv *, jint); +static jboolean jni_modifier_is_non_static (JNIEnv *, jint); +static void jni_check_exception (JNIEnv *); +static jvalue jni_call_static_method (JNIEnv *, const Extbyte *, + jclass, jmethodID, jvalue *); +static jvalue jni_call_virtual_method (JNIEnv *, const Extbyte *, + jobject, jmethodID, jvalue *); + +static Lisp_Object Vjava_class_hash_table; + +static void +initialize_javavm (void) +{ + JavaVMInitArgs vm_args; + JavaVMOption options[2]; + jint noptions = 0, status; + + options[0].optionString = "abort"; + options[0].extraInfo = abort; + + if (!NILP (Vjava_class_path)) + { + CHECK_STRING (Vjava_class_path); + + options[noptions++].optionString = + java_build_property_string (build_string ("java.class.path"), + Vjava_class_path); + } + + vm_args.version = JNI_VERSION_1_2; + vm_args.options = options; + vm_args.nOptions = noptions; + vm_args.ignoreUnrecognized = JNI_TRUE; + + status = JNI_CreateJavaVM (&java_jvm, (void **)&java_env, &vm_args); + if (status < 0) + error ("Can't create Java VM. Error: %ld\n", status); + + jni_initialize_primitive_call_table (java_env); +} + +static void +finalize_javavm (void) +{ + (*java_jvm)->DestroyJavaVM (java_jvm); + java_jvm = NULL; + java_env = NULL; +} + +static Lisp_Object +make_javaclass (Lisp_JavaClass *javaclass) +{ + Lisp_Object lisp_javaclass; + XSETJAVACLASS (lisp_javaclass, javaclass); + return lisp_javaclass; +} + +static Lisp_Object +mark_javaclass (Lisp_Object obj) +{ + Lisp_JavaClass *javaclass = XJAVACLASS (obj); + return javaclass->name; +} + +static void +print_javaclass (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) +{ + Lisp_JavaClass *javaclass; + char buf[256]; + + javaclass = XJAVACLASS (obj); + + if (NILP (javaclass->name)) + strcpy (buf, "#"); + else + sprintf (buf, "#", XSTRING_DATA (javaclass->name)); + write_c_string (buf, printcharfun); +} + +static Lisp_JavaClass * +allocate_javaclass (void) +{ + Lisp_JavaClass *javaclass = alloc_lcrecord_type (Lisp_JavaClass, + &lrecord_javaclass); + + javaclass->class = (jclass)NULL; + javaclass->name = Qnil; + return javaclass; +} + +DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION ("javaclass", javaclass, + mark_javaclass, print_javaclass, NULL, + NULL, NULL, + 0, + Lisp_JavaClass); + +static Lisp_Object +make_javaobject (Lisp_JavaObject *javaobject) +{ + Lisp_Object lisp_javaobject; + XSETJAVAOBJECT (lisp_javaobject, javaobject); + return lisp_javaobject; +} + +static Lisp_Object +mark_javaobject (Lisp_Object obj) +{ + Lisp_JavaObject *javaobject = XJAVAOBJECT (obj); + return javaobject->signature; +} + +static void +print_javaobject (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) +{ + Lisp_JavaObject *javaobject; + char buf[256]; + + javaobject = XJAVAOBJECT (obj); + + if (NILP (javaobject->signature)) + strcpy (buf, "#"); + else + sprintf (buf, "#", + XSTRING_DATA (javaobject->signature)); + write_c_string (buf, printcharfun); +} + +static Lisp_JavaObject * +allocate_javaobject (void) +{ + Lisp_JavaObject *javaobject; + + javaobject = alloc_lcrecord_type (Lisp_JavaObject, &lrecord_javaobject); + javaobject->object = (jobject)NULL; + javaobject->signature = Qnil; + return javaobject; +} + +DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION ("javaobject", javaobject, + mark_javaobject, print_javaobject, + NULL, NULL, NULL, + 0, + Lisp_JavaObject); + +DEFUN ("java-initialize", Fjava_initialize, 0, 0, 0, /* +Initialize the Java Virtual Machine. +*/ + ()) +{ + if (JAVAVM_LIVE_P ()) + return Qnil; + + initialize_javavm (); + if (JAVAVM_LIVE_P ()) + return Qt; + + return Qnil; /* not reached */ +} + +DEFUN ("java-finalize", Fjava_finalize, 0, 0, 0, /* +Finalize the Java Virtual Machine. +*/ + ()) +{ + CHECK_LIVE_JAVAVM (); + finalize_javavm (); + + return Qnil; +} + +DEFUN ("java-find-class", Fjava_find_class, 1, 1, 0, /* +Find class by name. +*/ + (name)) +{ + char *c_name; + jclass clazz; + Lisp_JavaClass *javaclass; + Lisp_Object class; + + CHECK_LIVE_JAVAVM (); + CHECK_STRING (name); + + class = Fgethash (name, Vjava_class_hash_table, Qnil); + if (JAVACLASSP (class)) + return class; + + TO_EXTERNAL_FORMAT (LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative); + java_dots_to_slashes (c_name); + clazz = (*java_env)->FindClass (java_env, c_name); + if (!clazz) + error ("Can't locate the %s class", XSTRING_DATA (name)); + + javaclass = allocate_javaclass (); + javaclass->class = clazz; + javaclass->name = name; + + class = make_javaclass (javaclass); + Fputhash (javaclass->name, class, Vjava_class_hash_table); + return class; +} + +static Extbyte * +java_build_property_string (name, value) + Lisp_Object name, value; +{ + const Extbyte *c_name, *c_value; + Extbyte *c_property; + + TO_EXTERNAL_FORMAT (LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, c_value, Qnative); + + c_property = xmalloc (strlen (c_name) + strlen (c_value) + 4); + sprintf (c_property, "-D%s=%s", c_name, c_value); + + return c_property; +} + +static void +java_dots_to_slashes (c_class) + Extbyte *c_class; +{ + const Extbyte *end; + + for (end = c_class + strlen (c_class); c_class < end; c_class++) + if (*c_class == '.') + *c_class = '/'; +} + +inline static Extbyte * +java_primitive_type_signature (name) + const Extbyte *name; +{ + if (!strncmp (name, "boolean", 7)) + return "Z"; + else if (!strncmp (name, "byte", 4)) + return "B"; + else if (!strncmp (name, "char", 4)) + return "C"; + else if (!strncmp (name, "short", 5)) + return "S"; + else if (!strncmp (name, "int", 3)) + return "I"; + else if (!strncmp (name, "long", 4)) + return "J"; + else if (!strncmp (name, "float", 5)) + return "F"; + else if (!strncmp (name, "double", 6)) + return "D"; + else if (!strncmp (name, "void", 4)) + return "V"; +} + +static const Extbyte * +java_type_signature (env, class) + JNIEnv *env; + jclass class; +{ + jstring string = jni_class_get_name (env, class); + const Extbyte *utf_string, *signature; + Extbyte *buf; + jboolean is_copy; + + utf_string = (*env)->GetStringUTFChars (env, string, &is_copy); + + if (jni_class_is_primitive (env, class)) + signature = java_primitive_type_signature (utf_string); + else if (utf_string[0] == '[') + { + signature = buf = xstrdup (utf_string); + java_dots_to_slashes (buf); + } + else + { + signature = buf = xmalloc (strlen (utf_string) + 3); + sprintf (buf, "L%s;", utf_string); + java_dots_to_slashes (buf); + } + if (is_copy == JNI_TRUE) + (*env)->ReleaseStringUTFChars (env, string, utf_string); + + return signature; +} + +static jarray +java_unify_primitive_array (env, element_sig, obj) + JNIEnv *env; + const Extbyte *element_sig; + Lisp_Object obj; +{ + int i, index, len = XVECTOR_LENGTH (obj); + Lisp_Object *data = XVECTOR_DATA (obj); + jarray array; + + array = jni_primitive_new_array (env, element_sig, len); + + for (i = 0; iNewObjectArray (env, len, XJAVACLASS (class)->class, NULL); + xfree (name); + + name = alloca (element_sig_len + 1); + strncpy (name, element_sig, element_sig_len); + name[element_sig_len] = '\0'; + for (i = 0; iSetObjectArrayElement (env, array, i, param.l); + } + return array; +} + +/* Convert a Lisp object into a Java object according to PARAM_SIG. */ +static int +java_unify_parameter (env, param_sig, obj, param) + JNIEnv *env; + const Extbyte *param_sig; + Lisp_Object obj; + jvalue *param; +{ + switch (param_sig[0]) + { + case 'Z': + param->z = NILP (obj) ? JNI_FALSE : JNI_TRUE; + break; + case 'B': + if (!INTP (obj)) + return 0; + param->b = (jshort) XINT (obj); + break; + case 'C': + if (CHARP (obj)) + { + obj = Fchar_ucs (obj); + if (!INTP(obj)) + return 0; + param->c = (jchar) XINT (obj); + } + break; + case 'S': + if (!INTP (obj)) + return 0; + param->s = (jshort) XINT (obj); + break; + case 'I': + if (!INTP (obj)) + return 0; + param->i = (jint) XINT (obj); + break; + case 'J': + if (!INTP (obj)) + return 0; + param->j = (jlong) XINT (obj); + break; + case 'F': + if (!INT_OR_FLOATP (obj)) + return 0; + param->f = (jfloat) XFLOATINT (obj); + break; + case 'D': + if (!INT_OR_FLOATP (obj)) + return 0; + param->d = (jdouble) XFLOATINT (obj); + break; + case 'L': + if (!JAVAOBJECTP (obj) && !STRINGP (obj) + || strncmp (param_sig, "Ljava/lang/String;", 18)) + return 0; + if (JAVAOBJECTP (obj)) + param->l = XJAVAOBJECT (obj)->object; + else if (STRINGP (obj)) + { + const Extbyte *c_string; + TO_EXTERNAL_FORMAT (LISP_STRING, obj, C_STRING_ALLOCA, + c_string, Qnative); + param->l = (jobject) (*env)->NewStringUTF (env, c_string); + } + break; + case '[': + if (!VECTORP (obj) && !BIT_VECTORP (obj) + || !strncmp (param_sig, "[Z", 2)) + return 0; + if (BIT_VECTORP (obj)) + obj = vconcat2 (obj, Qnil); + if (param_sig[1] == 'L') + param->l = java_unify_object_array (env, param_sig+1, obj); + else + param->l = java_unify_primitive_array (env, param_sig+1, obj); + if (!param->l) + return 0; + break; + } + return 1; +} + +static const Extbyte * +java_unify_parameters (env, ptypes, nargs, args, params) + JNIEnv *env; + int nargs; + jobjectArray ptypes; + Lisp_Object *args; + jvalue *params; +{ + int i, bufsize = 128, nptypes = (*env)->GetArrayLength (env, ptypes); + char *p, *buf = xmalloc_and_zero (bufsize); + + for (p = buf, i = 0; i < nptypes; i++) + { + jclass element = (*env)->GetObjectArrayElement (env, ptypes, i); + const Extbyte *param_sig = java_type_signature (env, element); + int len = strlen (param_sig); + (*env)->DeleteLocalRef (env, element); + if (!java_unify_parameter (env, param_sig, args[i], ¶ms[i])) + { + xfree (buf); + return NULL; + } + + while ((buf - p) + len > bufsize) + { + bufsize *= 2; + buf = xrealloc (buf, bufsize); + } + + strncpy (buf, param_sig, len); + } + return buf; +} + +static Lisp_Object +java_build_return_value_vector (env, return_sig, array) + JNIEnv *env; + const Extbyte *return_sig; + jarray array; +{ + jint len = (*env)->GetArrayLength (env, array); + Lisp_Object v = make_vector (len, Qnil); + int i; + Extbyte *name = xstrdup (return_sig); + jvalue element; + + if (name[0] == 'L' || name[0] == '[') + for (i = 0; iGetObjectArrayElement (env, array, i); + Faset (v, make_int (i), java_build_return_value (env, name, element)); + } + else + for (i = 0; iGetStringUTFChars (env, value.l, &is_copy); + string = build_ext_string (utf_string, JAVA_OS_CODING); + if (is_copy == JNI_TRUE) + (*env)->ReleaseStringUTFChars (env, value.l, utf_string); + + return string; + } + else { + Lisp_JavaObject *javaobject; + + javaobject = allocate_javaobject (); + javaobject->object = value.l; + javaobject->signature = build_string (return_sig); + + return make_javaobject (javaobject); + } + break; + case '[': + return java_build_return_value_vector (env, return_sig+1, value.l); + } + + error ("Can't cast the return value."); + + return Qnil; +} + +static jobject +java_find_method (env, methods, c_method_to_invoke, + nargs, args, params, filter) + JNIEnv *env; + jobjectArray methods; + const Extbyte *c_method_to_invoke; + int nargs; + Lisp_Object *args; + jvalue *params; + java_modifier_filter filter; +{ + jobject method = NULL; + jint nmethods; + int i; + + nmethods = (*env)->GetArrayLength (env, methods); + for (i = 0; i < nmethods; i++) + { + jobject element = + (*env)->GetObjectArrayElement (env, methods, i); + jint modifiers = jni_method_get_modifiers (env, element); + jobjectArray ptypes; + int nptypes; + jstring name = jni_method_get_name (env, element); + const Extbyte *utf_name, *param_sig; + jboolean is_copy; + + utf_name = (*java_env)->GetStringUTFChars (env, name, &is_copy); + + if (c_method_to_invoke && strcmp (utf_name, c_method_to_invoke)) + goto retry; + if (filter && (*filter) (env, modifiers) != JNI_TRUE) + goto retry; + + ptypes = jni_method_get_parameter_types (env, element); + nptypes = (*env)->GetArrayLength (env, ptypes); + + if (nptypes != nargs) + goto retry; + + param_sig = java_unify_parameters (env, ptypes, nargs, args, params); + if (!param_sig) + goto retry; + + method = element; + break; + + retry: + if (is_copy == JNI_TRUE) + (*env)->ReleaseStringUTFChars (env, name, utf_name); + (*env)->DeleteLocalRef (env, element); + } + return method; +} + +static Lisp_Object +java_call_static_method (obj, name, nargs, args) + Lisp_Object obj, name, *args; + int nargs; +{ + jclass class, return_type; + jobjectArray methods; + jobject method; + jvalue *params, value; + jmethodID method_id; + Extbyte *c_name; + const Extbyte *return_sig; + java_modifier_filter filter; + + /* Prepare for the static method call. */ + class = XJAVACLASS (obj)->class; + filter = jni_modifier_is_static; + params = alloca (sizeof (jvalue) * nargs); + + /* Do unification in the ordinary way. + This part can be commonly used and should be split off. */ + methods = jni_class_get_methods (java_env, class); + TO_EXTERNAL_FORMAT(LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative); + method = java_find_method (java_env, methods, c_name, nargs, args, params, + filter); + if (!method) + error ("Bad method name: %s", XSTRING_DATA (name)); + + method_id = (*java_env)->FromReflectedMethod (java_env, method); + return_type = jni_method_get_return_type (java_env, method); + return_sig = java_type_signature (java_env, return_type); + (*java_env)->DeleteLocalRef (java_env, method); + + value = jni_call_static_method (java_env, return_sig, class, method_id, + params); + + /* Clean up returned value. + This part can be commonly used and should be split off. */ + jni_check_exception (java_env); + if (!value.l) /* possibly null or void */ + return Qnil; + return java_build_return_value (java_env, return_sig, value); +} + +static Lisp_Object +java_call_virtual_method (obj, name, nargs, args) + Lisp_Object obj, name, *args; + int nargs; +{ + jclass class, return_type; + jobjectArray methods; + jobject object, method; + jvalue *params, value; + jmethodID method_id; + Extbyte *c_name; + const Extbyte *return_sig; + java_modifier_filter filter; + + /* Prepare for the virtual method call. */ + object = XJAVAOBJECT (obj)->object; + class = (*java_env)->GetObjectClass (java_env, object); + filter = jni_modifier_is_non_static; + params = alloca (sizeof (jvalue) * nargs); + + /* Do unification. + This part can be commonly used and should be split off. */ + methods = jni_class_get_methods (java_env, class); + TO_EXTERNAL_FORMAT(LISP_STRING, name, C_STRING_ALLOCA, c_name, Qnative); + method = java_find_method (java_env, methods, c_name, nargs, args, params, + filter); + if (!method) + error ("Bad method name: %s", XSTRING_DATA (name)); + + method_id = (*java_env)->FromReflectedMethod (java_env, method); + return_type = jni_method_get_return_type (java_env, method); + return_sig = java_type_signature (java_env, return_type); + (*java_env)->DeleteLocalRef (java_env, method); + + value = jni_call_virtual_method (java_env, return_sig, object, method_id, + params); + + /* Clean up returned value. + This part can be commonly used and should be split off. */ + jni_check_exception (java_env); + if (!value.l) /* possibly null or void */ + return Qnil; + return java_build_return_value (java_env, return_sig, value); +} + +DEFUN ("java-call-static-method", Fjava_call_static_method, 2, MANY, 0, /* +Call static method. +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object class = args[0]; + Lisp_Object method = args[1]; + java_modifier_filter filter; + + CHECK_JAVACLASS (class); + CHECK_STRING (method); + CHECK_LIVE_JAVAVM (); + + return java_call_static_method (class, method, nargs - 2, args + 2); +} + +DEFUN ("java-call-virtual-method", Fjava_call_virtual_method, 2, MANY, 0, /* +Call static method. +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object object = args[0]; + Lisp_Object method = args[1]; + + CHECK_JAVAOBJECT (object); + CHECK_STRING (method); + CHECK_LIVE_JAVAVM (); + + return java_call_virtual_method (object, method, nargs - 2, args + 2); +} + +static Lisp_Object +java_make_object (class, nargs, args) + Lisp_Object class, *args; + int nargs; +{ + jclass clazz; + jobjectArray constructors; + jobject constructor, object; + jvalue *params; + jmethodID method_id; + int i, nconstructors; + const Extbyte *param_sig; + Lisp_JavaObject *javaobject; + + clazz = XJAVACLASS (class)->class; + constructors = jni_class_get_constructors (java_env, clazz); + nconstructors = (*java_env)->GetArrayLength (java_env, constructors); + params = alloca (sizeof (jvalue) * nargs); + + constructor = java_find_method (java_env, constructors, NULL, + nargs, args, params, NULL); + + if (!constructor) + error ("No such constructor: %s\n", + XSTRING_DATA (XJAVACLASS (class)->name)); + + method_id = (*java_env)->FromReflectedMethod (java_env, constructor); + object = (*java_env)->NewObjectA (java_env, clazz, method_id, params); + + if (!object) + return Qnil; + + javaobject = allocate_javaobject (); + javaobject->object = object; + javaobject->signature = XJAVACLASS (class)->name; + + return make_javaobject (javaobject); +} + +DEFUN ("java-make-object", Fjava_make_object, 1, MANY, 0, /* +Call static method. +*/ + (int nargs, Lisp_Object *args)) +{ + Lisp_Object class = args[0]; + + CHECK_JAVACLASS (class); + CHECK_LIVE_JAVAVM (); + + return java_make_object (class, nargs - 1, args + 1); +} + +static int +add_java_class_to_list_mapper (Lisp_Object key, Lisp_Object value, + void *java_class_list_closure) +{ + /* This function can GC */ + struct java_class_list_closure *cscl = + (struct java_class_list_closure *) java_class_list_closure; + Lisp_Object *java_class_list = cscl->java_class_list; + + *java_class_list = Fcons (value, *java_class_list); + return 0; +} + +DEFUN ("java-class-list", Fjava_class_list, 0, 0, 0, /* +Return a list of all loaded classes. +*/ + ()) +{ + Lisp_Object java_class_list = Qnil; + struct gcpro gcpro1; + struct java_class_list_closure java_class_list_closure; + + GCPRO1 (java_class_list); + java_class_list_closure.java_class_list = &java_class_list; + elisp_maphash (add_java_class_to_list_mapper, Vjava_class_hash_table, + &java_class_list_closure); + UNGCPRO; + + return java_class_list; +} + +DEFUN ("java-class-name", Fjava_class_name, 1, 1, 0, /* +Return the name of the given class. +*/ + (class)) +{ + CHECK_JAVACLASS (class); + return XJAVACLASS (class)->name; +} + +static int +jni_lookup_primitive_call_table (signature) + const char *signature; +{ + const char *p = strchr (jni_primitive_signature_table, signature[0]); + if (!p) + return -1; + return (p - jni_primitive_signature_table); +} + +inline static jvalue +jni_primitive_call_method (env, return_sig, object, method, params) + JNIEnv *env; + const Extbyte *return_sig; + jobject object; + jmethodID method; + jvalue *params; +{ + int index = jni_lookup_primitive_call_table (return_sig); + return (jvalue)(*jni_primitive_call_table[index].call_method) + (env, object, method, params); +} + +inline static jvalue +jni_primitive_call_static_method (env, return_sig, class, method, params) + JNIEnv *env; + const Extbyte *return_sig; + jclass class; + jmethodID method; + jvalue *params; +{ + int index = jni_lookup_primitive_call_table (return_sig); + return (jvalue)(*jni_primitive_call_table[index].call_static_method) + (env, class, method, params); +} + +inline static jarray +jni_primitive_new_array (env, element_sig, len) + JNIEnv *env; + const Extbyte *element_sig; + jsize len; +{ + int index = jni_lookup_primitive_call_table (element_sig); + return (*jni_primitive_call_table[index].new_array) + (env, len); +} + +inline static void +jni_primitive_set_array_element (env, element_sig, array, n, element) + JNIEnv *env; + const Extbyte *element_sig; + jarray array; + jsize n; + jvalue element; +{ + int index = jni_lookup_primitive_call_table (element_sig); + jni_primitive_call_table[index].set_array_element + (env, array, n, element); +} + +inline static jvalue +jni_primitive_get_array_element (env, element_sig, array, n) + JNIEnv *env; + const Extbyte *element_sig; + jarray array; + jsize n; +{ + int index = jni_lookup_primitive_call_table (element_sig); + return (jvalue)(*jni_primitive_call_table[index].get_array_element) + (env, array, n); +} + +#define DEFINE_JNI_ARRAY_SET(atype,jtype,type) \ +static void jni_set_##jtype##_array_element (JNIEnv *, jarray, \ + jsize, jvalue); \ +static void jni_set_##jtype##_array_element (JNIEnv *env, jarray array, \ + jsize n, jvalue element) { \ + jtype *elements; \ + jboolean is_copy; \ + elements = (*env)->Get##type##ArrayElements (env, (atype)array, \ + &is_copy); \ + elements[n] = *(jtype*)&element; \ + if (is_copy == JNI_TRUE) \ + (*env)->Release##type##ArrayElements \ + (env, (atype)array, elements, 0); \ +} + +DEFINE_JNI_ARRAY_SET(jbooleanArray, jboolean, Boolean) +DEFINE_JNI_ARRAY_SET(jbyteArray, jbyte, Byte) +DEFINE_JNI_ARRAY_SET(jcharArray, jchar, Char) +DEFINE_JNI_ARRAY_SET(jshortArray, jshort, Short) +DEFINE_JNI_ARRAY_SET(jintArray, jint, Int) +DEFINE_JNI_ARRAY_SET(jlongArray, jlong, Long) +DEFINE_JNI_ARRAY_SET(jfloatArray, jfloat, Float) +DEFINE_JNI_ARRAY_SET(jdoubleArray, jdouble, Double) + +#define DEFINE_JNI_ARRAY_GET(atype,jtype,type) \ +static jlong jni_get_##jtype##_array_element (JNIEnv *, jarray, jsize); \ +static jlong jni_get_##jtype##_array_element (JNIEnv *env, \ + jarray array, jsize n) { \ + jtype *elements; \ + jboolean is_copy; \ + elements = (*env)->Get##type##ArrayElements (env, (atype)array, \ + &is_copy); \ + return (jlong)elements[n]; \ +} + +DEFINE_JNI_ARRAY_GET(jbooleanArray, jboolean, Boolean) +DEFINE_JNI_ARRAY_GET(jbyteArray, jbyte, Byte) +DEFINE_JNI_ARRAY_GET(jcharArray, jchar, Char) +DEFINE_JNI_ARRAY_GET(jshortArray, jshort, Short) +DEFINE_JNI_ARRAY_GET(jintArray, jint, Int) +DEFINE_JNI_ARRAY_GET(jlongArray, jlong, Long) +DEFINE_JNI_ARRAY_GET(jfloatArray, jfloat, Float) +DEFINE_JNI_ARRAY_GET(jdoubleArray, jdouble, Double) + +static void +jni_initialize_primitive_call_table (env) + JNIEnv *env; +{ + jni_primitive_call_table[0].call_method = + (jni_method_caller)(*env)->CallBooleanMethodA; + jni_primitive_call_table[0].call_static_method = + (jni_static_method_caller)(*env)->CallStaticBooleanMethodA; + jni_primitive_call_table[0].call_nonvirtual_method = + (jni_nonvirtual_method_caller)(*env)->CallNonvirtualBooleanMethodA; + jni_primitive_call_table[0].new_array = + (jni_array_allocater)(*env)->NewBooleanArray; + jni_primitive_call_table[0].set_array_element = + jni_set_jboolean_array_element; + jni_primitive_call_table[0].get_array_element = + jni_get_jboolean_array_element; + + jni_primitive_call_table[1].call_method = + (jni_method_caller)(*env)->CallByteMethodA; + jni_primitive_call_table[1].call_static_method = + (jni_static_method_caller)(*env)->CallStaticByteMethodA; + jni_primitive_call_table[1].call_nonvirtual_method = + (jni_nonvirtual_method_caller)(*env)->CallNonvirtualByteMethodA; + jni_primitive_call_table[1].new_array = + (jni_array_allocater)(*env)->NewByteArray; + jni_primitive_call_table[1].set_array_element = + jni_set_jbyte_array_element; + jni_primitive_call_table[1].get_array_element = + jni_get_jbyte_array_element; + + jni_primitive_call_table[2].call_method = + (jni_method_caller)(*env)->CallCharMethodA; + jni_primitive_call_table[2].call_static_method = + (jni_static_method_caller)(*env)->CallStaticCharMethodA; + jni_primitive_call_table[2].call_nonvirtual_method = + (jni_nonvirtual_method_caller)(*env)->CallNonvirtualCharMethodA; + jni_primitive_call_table[2].new_array = + (jni_array_allocater)(*env)->NewCharArray; + jni_primitive_call_table[2].set_array_element = + jni_set_jchar_array_element; + jni_primitive_call_table[2].get_array_element = + jni_get_jchar_array_element; + + jni_primitive_call_table[3].call_method = + (jni_method_caller)(*env)->CallShortMethodA; + jni_primitive_call_table[3].call_static_method = + (jni_static_method_caller)(*env)->CallStaticShortMethodA; + jni_primitive_call_table[3].call_nonvirtual_method = + (jni_nonvirtual_method_caller)(*env)->CallNonvirtualShortMethodA; + jni_primitive_call_table[3].new_array = + (jni_array_allocater)(*env)->NewShortArray; + jni_primitive_call_table[3].set_array_element = + jni_set_jshort_array_element; + jni_primitive_call_table[3].get_array_element = + jni_get_jshort_array_element; + + jni_primitive_call_table[4].call_method = + (jni_method_caller)(*env)->CallIntMethodA; + jni_primitive_call_table[4].call_static_method = + (jni_static_method_caller)(*env)->CallStaticIntMethodA; + jni_primitive_call_table[4].call_nonvirtual_method = + (jni_nonvirtual_method_caller)(*env)->CallNonvirtualIntMethodA; + jni_primitive_call_table[4].new_array = + (jni_array_allocater)(*env)->NewIntArray; + jni_primitive_call_table[4].set_array_element = + jni_set_jint_array_element; + jni_primitive_call_table[4].get_array_element = + jni_get_jint_array_element; + + jni_primitive_call_table[5].call_method = + (jni_method_caller)(*env)->CallLongMethodA; + jni_primitive_call_table[5].call_static_method = + (jni_static_method_caller)(*env)->CallStaticLongMethodA; + jni_primitive_call_table[5].call_nonvirtual_method = + (jni_nonvirtual_method_caller)(*env)->CallNonvirtualLongMethodA; + jni_primitive_call_table[5].new_array = + (jni_array_allocater)(*env)->NewLongArray; + jni_primitive_call_table[5].set_array_element = + jni_set_jlong_array_element; + jni_primitive_call_table[5].get_array_element = + jni_get_jlong_array_element; + + jni_primitive_call_table[6].call_method = + (jni_method_caller)(*env)->CallFloatMethodA; + jni_primitive_call_table[6].call_static_method = + (jni_static_method_caller)(*env)->CallStaticFloatMethodA; + jni_primitive_call_table[6].call_nonvirtual_method = + (jni_nonvirtual_method_caller)(*env)->CallNonvirtualFloatMethodA; + jni_primitive_call_table[6].new_array = + (jni_array_allocater)(*env)->NewFloatArray; + jni_primitive_call_table[6].set_array_element = + jni_set_jfloat_array_element; + jni_primitive_call_table[6].get_array_element = + jni_get_jfloat_array_element; + + jni_primitive_call_table[7].call_method = + (jni_method_caller)(*env)->CallDoubleMethodA; + jni_primitive_call_table[7].call_static_method = + (jni_static_method_caller)(*env)->CallStaticDoubleMethodA; + jni_primitive_call_table[7].call_nonvirtual_method = + (jni_nonvirtual_method_caller)(*env)->CallNonvirtualDoubleMethodA; + jni_primitive_call_table[7].new_array = + (jni_array_allocater)(*env)->NewDoubleArray; + jni_primitive_call_table[7].set_array_element = + jni_set_jdouble_array_element; + jni_primitive_call_table[7].get_array_element = + jni_get_jdouble_array_element; +} + +static jobjectArray +jni_class_get_methods (env, class) + JNIEnv *env; + jclass class; +{ + jclass clazz = (*env)->GetObjectClass (env, class); + jmethodID method = (*env)->GetMethodID (env, clazz, "getMethods", + "()[Ljava/lang/reflect/Method;"); + return (jobjectArray) (*env)->CallObjectMethod (env, class, method, NULL); +} + +static jobjectArray +jni_class_get_constructors (env, class) + JNIEnv *env; + jclass class; +{ + jclass clazz = (*env)->GetObjectClass (env, class); + jmethodID method = (*env)->GetMethodID (env, clazz, "getConstructors", + "()[Ljava/lang/reflect/Constructor;"); + return (jobjectArray) (*env)->CallObjectMethod (env, class, method, NULL); +} + +static jstring +jni_class_get_name (env, class) + JNIEnv *env; + jclass class; +{ + jclass clazz = (*env)->GetObjectClass (env, class); + jmethodID method = (*env)->GetMethodID (env, clazz, "getName", + "()Ljava/lang/String;"); + return (jstring) (*env)->CallObjectMethod (env, class, method, NULL); +} + +static jboolean +jni_class_is_primitive (env, class) + JNIEnv *env; + jclass class; +{ + jclass clazz = (*env)->GetObjectClass (env, class); + jmethodID method = (*env)->GetMethodID (env, clazz, "isPrimitive", + "()Z"); + return (*env)->CallBooleanMethod (env, class, method, NULL); +} + +static jobjectArray +jni_method_get_parameter_types (env, method) + JNIEnv *env; + jobject method; +{ + jclass class = (*env)->GetObjectClass (env, method); + jmethodID get_parameter_types = + (*env)->GetMethodID (env, class, "getParameterTypes", + "()[Ljava/lang/Class;"); + return (jobjectArray) (*env)->CallObjectMethod + (env, method, get_parameter_types, NULL); +} + +static jstring +jni_method_get_name (env, method) + JNIEnv *env; + jobject method; +{ + jclass class = (*env)->GetObjectClass (env, method); + jmethodID get_name = + (*env)->GetMethodID (env, class, "getName", "()Ljava/lang/String;"); + return (jstring) (*env)->CallObjectMethod (env, method, get_name, NULL); +} + +static jint +jni_method_get_modifiers (env, method) + JNIEnv *env; + jobject method; +{ + jclass class = (*env)->GetObjectClass (env, method); + jmethodID get_modifiers = + (*env)->GetMethodID (env, class, "getModifiers", "()I"); + return (*env)->CallIntMethod (env, method, get_modifiers, NULL); +} + +static jclass +jni_method_get_return_type (env, method) + JNIEnv *env; + jobject method; +{ + jclass class = (*env)->GetObjectClass (env, method); + jmethodID get_return_type = + (*env)->GetMethodID (env, class, "getReturnType", "()Ljava/lang/Class;"); + return (jclass) (*env)->CallObjectMethod + (env, method, get_return_type, NULL); +} + +static jboolean +jni_modifier_is_static (env, modifiers) + JNIEnv *env; + jint modifiers; +{ + static jclass class = NULL; + jmethodID is_static; + + if (!class) + class = (*env)->FindClass (env, "java/lang/reflect/Modifier"); + is_static = (*env)->GetStaticMethodID (env, class, "isStatic", "(I)Z"); + return (*env)->CallStaticBooleanMethod (env, class, is_static, modifiers); +} + +static jboolean +jni_modifier_is_non_static (env, modifiers) + JNIEnv *env; + jint modifiers; +{ + if (jni_modifier_is_static (env, modifiers) == JNI_TRUE) + return JNI_FALSE; + return JNI_TRUE; +} + +static void +jni_check_exception (env) + JNIEnv *env; +{ + jthrowable throwable; + + throwable = (*env)->ExceptionOccurred (env); + if (!throwable) + return; + + (*env)->ExceptionClear (env); + error ("Exception occurred."); +} + +static jvalue +jni_call_static_method (env, return_sig, class, method, params) + JNIEnv *env; + const Extbyte *return_sig; + jclass class; + jmethodID method; + jvalue *params; +{ + jthrowable throwable; + jvalue value; + + switch (return_sig[0]) + { + case 'V': + (*env)->CallStaticVoidMethodA (env, class, method, params); + value.l = NULL; + case 'L': case '[': + value = (jvalue)(*env)->CallStaticObjectMethodA + (env, class, method, params); + break; + default: + value = jni_primitive_call_static_method (env, return_sig, class, + method, params); + break; + } + + return value; +} + +static jvalue +jni_call_virtual_method (env, return_sig, object, method, params) + JNIEnv *env; + const Extbyte *return_sig; + jobject object; + jmethodID method; + jvalue *params; +{ + jthrowable throwable; + jvalue value; + + switch (return_sig[0]) + { + case 'V': + (*env)->CallVoidMethodA (env, object, method, params); + value.l = NULL; + case 'L': case '[': + value = (jvalue)(*env)->CallObjectMethodA (env, object, method, params); + break; + default: + value = jni_primitive_call_method (env, return_sig, object, method, + params); + break; + } + + return value; +} + + +void +syms_of_java (void) +{ + INIT_EXTERNAL_LRECORD_IMPLEMENTATION (javaclass); + INIT_EXTERNAL_LRECORD_IMPLEMENTATION (javaobject); + defsymbol (&Qjava, "java"); + + defsymbol (&Qjavaclassp, "javaclassp"); + defsymbol (&Qjavaobjectp, "javaobjectp"); + + DEFSUBR (Fjava_find_class); + DEFSUBR (Fjava_call_virtual_method); + DEFSUBR (Fjava_call_static_method); + DEFSUBR (Fjava_make_object); + DEFSUBR (Fjava_class_list); + DEFSUBR (Fjava_class_name); +} + +void +vars_of_java (void) +{ + char *p; + + Fprovide (Qjava); + + DEFVAR_LISP ("java-coding-system", &Vjava_coding_system /* +Default Java Vartual Machine coding system. +*/); + Vjava_coding_system = Qnative; + + DEFVAR_LISP ("java-class-path", &Vjava_class_path /* +Default class path. +*/); + p = getenv ("CLASSPATH"); + if (!p) + Vjava_class_path = Qnil; + else + Vjava_class_path = build_ext_string (p, JAVA_OS_CODING); + + initialize_javavm (); + + staticpro (&Vjava_class_hash_table); + Vjava_class_hash_table = + make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); +} diff --git a/java.h b/java.h new file mode 100644 index 0000000..155c5f3 --- /dev/null +++ b/java.h @@ -0,0 +1,57 @@ +/* Definitions for Emacs Lisp binding to Java Native Interface. + Copyright (C) 2000 Daiki Ueno. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifndef INCLUDED_java_h_ +#define INCLUDED_java_h_ 1 + +#include + +struct Lisp_JavaClass +{ + struct lcrecord_header header; + jclass class; + Lisp_Object name; +}; +typedef struct Lisp_JavaClass Lisp_JavaClass; + +DECLARE_EXTERNAL_LRECORD (javaclass, Lisp_JavaClass); + +#define XJAVACLASS(x) XRECORD (x, javaclass, Lisp_JavaClass) +#define XSETJAVACLASS(x, p) XSETRECORD (x, p, javaclass) +#define JAVACLASSP(x) RECORDP (x, javaclass) +#define CHECK_JAVACLASS(x) CHECK_RECORD (x, javaclass) +#define CONCHECK_JAVACLASS(x) CONCHECK_RECORD (x, javaclass) + +struct Lisp_JavaObject +{ + struct lcrecord_header header; + jobject object; + Lisp_Object signature; +}; +typedef struct Lisp_JavaObject Lisp_JavaObject; + +DECLARE_EXTERNAL_LRECORD (javaobject, Lisp_JavaObject); +#define XJAVAOBJECT(x) XRECORD (x, javaobject, Lisp_JavaObject) +#define XSETJAVAOBJECT(x, p) XSETRECORD (x, p, javaobject) +#define JAVAOBJECTP(x) RECORDP (x, javaobject) +#define CHECK_JAVAOBJECT(x) CHECK_RECORD (x, javaobject) +#define CONCHECK_JAVAOBJECT(x) CONCHECK_RECORD (x, javaobject) + +#endif /* INCLUDED_java_h_ */ diff --git a/jbrowse.el b/jbrowse.el new file mode 100644 index 0000000..b00176e --- /dev/null +++ b/jbrowse.el @@ -0,0 +1,159 @@ +;;; jbrowse.el --- Simple class browser for Java Programming Language. + +;; Copyright (C) 2000 Daiki Ueno + +;; Author: Daiki Ueno +;; Keywords: Java + +;; This file is not part of any package. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(defvar jbrowse-class-java-lang-reflect-method + (java-find-class "java.lang.reflect.Method")) +(defvar jbrowse-class-java-lang-reflect-modifier + (java-find-class "java.lang.reflect.Modifier")) +(defvar jbrowse-class-java-lang-class + (java-find-class "java.lang.Class")) +(defvar jbrowse-class-java-lang-package + (java-find-class "java.lang.Package")) + +(defvar jbrowse-class-obarray (make-vector 31 0)) + +(defun jbrowse-type-string (type) + (let ((name (java-call-virtual-method type "getName"))) + (if (eq (string-to-char name) ?\[) + (concat + (jbrowse-type-string + (java-call-virtual-method type "getComponentType")) + "[]") + (or (java-call-virtual-method type "isPrimitive") + (set (intern name jbrowse-class-obarray) nil)) ;Prepare cache entry. + name))) + +(defvar jbrowse-modifier-chars + '((public ?+) (private ?-) (protected ?#))) + +(defun jbrowse-modifier-chars (modifiers) + (let ((alist jbrowse-modifier-chars) + chars) + (while alist + (if (java-call-static-method + jbrowse-class-java-lang-reflect-modifier + (concat "is" (capitalize (symbol-name (car (car alist))))) + modifiers) + (push (nth 1 (car alist)) chars)) + (setq alist (cdr alist))) + chars)) + +(defun jbrowse-make-method-info (method) + (nconc + (list + (java-call-virtual-method method "getName") + (jbrowse-type-string + (java-call-virtual-method method "getReturnType")) + (jbrowse-modifier-chars + (java-call-virtual-method method "getModifiers"))) + (mapcar + #'jbrowse-type-string + (java-call-virtual-method method "getParameterTypes")))) + +(defun jbrowse-describe-method-info (info) + (insert + (let ((modifier-chars (nth 2 info))) + (if modifier-chars + (apply #'string modifier-chars) + " ")) + (car info) + ": ") + (jbrowse-insert-type (nth 1 info)) + (let ((params (nthcdr 3 info))) + (when params + (insert "\n (") + (while params + (jbrowse-insert-type (pop params))) + (insert ")"))) + (insert "\n")) + +(defun jbrowse-insert-type (type) + (if (intern-soft type jbrowse-class-obarray) + (let ((point (point)) + extent) + (insert type) + (setq extent (make-extent point (point))) + (set-extent-properties + extent `(mouse-face highlight help-symbol ,type)) + (set-extent-property + extent 'activate-function + #'(lambda (event extent) + (help-symbol-run-function-1 + event extent 'jbrowse-describe-class)))) + (insert type))) + +(defun jbrowse-make-class-info (name) + (let* ((class + (java-call-static-method + jbrowse-class-java-lang-class "forName" name)) + (super + (java-call-virtual-method class "getSuperclass"))) + (cons + (and super (java-call-virtual-method super "getName")) + (mapcar + #'jbrowse-make-method-info + (java-call-virtual-method class "getDeclaredMethods"))))) + +(defun jbrowse-describe-class-1 (class info) + (with-displaying-help-buffer + (lambda () + (with-current-buffer standard-output + (if (null (car info)) + (insert (format "`%s' is\n\n" class)) + (insert (format "`%s' is derived from `" class)) + (jbrowse-insert-type (car info)) + (insert "'\n\n")) + (let ((methods (cdr info))) + (while methods + (jbrowse-describe-method-info (pop methods)))) + ;; Return the text we displayed. + (buffer-string nil nil standard-output))) + (format "class `%s'" class))) + +(defun jbrowse-describe-class (class) + (interactive + (let ((classes (mapcar #'java-class-name (java-class-list)))) + (list + (if current-prefix-arg + (let ((packages + (mapcar + (lambda (package) + (java-call-virtual-method package "getName")) + (java-call-static-method + jbrowse-class-java-lang-package "getPackages")))) + (completing-read "Describe class: " (mapcar #'list classes))) + (completing-read "Describe class: " jbrowse-class-obarray))))) + (let ((class-info (symbol-value (intern-soft class jbrowse-class-obarray)))) + (unless class-info + (setq class-info (jbrowse-make-class-info class)) + (set (intern class jbrowse-class-obarray) class-info)) + (jbrowse-describe-class-1 class class-info))) + +(provide 'jbrowse) + +;;; jbrowse.el ends here diff --git a/sha1-java.el b/sha1-java.el new file mode 100644 index 0000000..e76e4ab --- /dev/null +++ b/sha1-java.el @@ -0,0 +1,55 @@ +;;; sha1-java.el --- SHA1 Secure Hash Algorithm using Java. + +;; Copyright (C) 2000 Daiki Ueno + +;; Author: Daiki Ueno +;; Keywords: SHA1, FIPS 180-1 + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(defvar sha1-java-message-digest + (let ((class (java-find-class "java.security.MessageDigest"))) + (java-call-static-method class "getInstance" "SHA"))) + +(defun sha1-java-update (bytes) + "Update the current SHA1 state with BYTES (an string of uni-bytes)." + (let ((bytes (mapvector #'char-to-int bytes))) + (java-call-virtual-method sha1-java-message-digest "update" bytes))) + +(defun sha1-java-encode (message &optional binary) + "Encodes MESSAGE using the SHA1 message digest algorithm. +MESSAGE must be a unibyte-string. +By default, return a string which formed hex-decimal charcters +from message digest. +If optional argument BINARY is non-nil, then return binary formed +string of message digest." + (sha1-java-update message) + (mapconcat + (lambda (byte) + (if binary + (char-to-string (logand byte #xff)) + (format "%02x" (logand byte #xff)))) + (java-call-virtual-method sha1-java-message-digest "digest") "")) + +(provide 'sha1-java) + +;;; sha1-java.el ends here