diff options
author | matz <matz@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 1999-08-13 05:37:52 +0000 |
---|---|---|
committer | matz <matz@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 1999-08-13 05:37:52 +0000 |
commit | 0a64817fb80016030c03518fb9459f63c11605ea (patch) | |
tree | 3ea2e607f9ea08c56830ef7b803cd259e3d67c7f /ext/tcltklib | |
parent | 210367ec889f5910e270d6ea2c7ddb8a8d939e61 (diff) | |
download | ruby-0a64817fb80016030c03518fb9459f63c11605ea.tar.gz |
remove marshal/gtk/kconv
git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@518 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'ext/tcltklib')
-rw-r--r-- | ext/tcltklib/depend | 2 | ||||
-rw-r--r-- | ext/tcltklib/extconf.rb | 96 | ||||
-rw-r--r-- | ext/tcltklib/tcltklib.c | 362 |
3 files changed, 251 insertions, 209 deletions
diff --git a/ext/tcltklib/depend b/ext/tcltklib/depend index 71d9f20537..e91f9dacbf 100644 --- a/ext/tcltklib/depend +++ b/ext/tcltklib/depend @@ -1 +1 @@ -tcltklib.o: tcltklib.c $(hdrdir)/ruby.h $(hdrdir)/config.h $(hdrdir)/defines.h +tcltklib.o: tcltklib.c $(hdrdir)/ruby.h $(topdir)/config.h $(hdrdir)/defines.h diff --git a/ext/tcltklib/extconf.rb b/ext/tcltklib/extconf.rb index e34e549ca0..e1086855ba 100644 --- a/ext/tcltklib/extconf.rb +++ b/ext/tcltklib/extconf.rb @@ -7,79 +7,41 @@ have_library("socket", "socket") have_library("dl", "dlopen") have_library("m", "log") -$includes = [] -def search_header(include, *path) - pwd = Dir.getwd - begin - for i in path.sort!.reverse! - dir = Dir[i] - for path in dir.sort!.reverse! - next unless File.directory? path - Dir.chdir path - files = Dir[include] - if files.size > 0 - unless $includes.include? path - $includes << path - end - return - end - end - end - ensure - Dir.chdir pwd - end -end +dir_config("tk") +dir_config("tcl") +dir_config("X11") -search_header("tcl.h", - "/usr/include/tcl{,8*,7*}", - "/usr/include", - "/usr/local/include/tcl{,8*,7*}", - "/usr/local/include") -search_header("tk.h", - "/usr/include/tk{,8*,4*}", - "/usr/include", - "/usr/local/include/tk{,8*,4*}", - "/usr/local/include") -search_header("X11/Xlib.h", - "/usr/include/X11*", - "/usr/include", - "/usr/openwin/include", - "/usr/X11*/include") +tklib = with_config("tklib") +tcllib = with_config("tcllib") -$CFLAGS = $includes.collect{|path| "-I" + path}.join(" ") +def find_tcl(tcllib) + paths = ["/usr/local/lib", "/usr/pkg"] + func = "Tcl_FindExecutable" + if tcllib + find_library(tcllib, func, *paths) + else + find_library("tcl", func, *paths) or + find_library("tcl8.0", func, *paths) or + find_library("tcl7.6", func, *paths) + end +end -$libraries = [] -def search_lib(file, func, *path) - for i in path.reverse! - dir = Dir[i] - for path in dir.sort!.reverse! - $LDFLAGS = $libraries.collect{|p| "-L" + p}.join(" ") + " -L" + path - files = Dir[path+"/"+file] - if files.size > 0 - for lib in files.sort!.reverse! - lib = File::basename(lib) - lib.sub!(/^lib/, '') - lib.sub!(/\.(a|so)$/, '') - if have_library(lib, func) - unless $libraries.include? path - $libraries << path - end - return true - end - end - end - end +def find_tk(tklib) + paths = ["/usr/local/lib", "/usr/pkg"] + func = "Tk_Init" + if tklib + find_library(tklib, func, *paths) + else + find_library("tk", func, *paths) or + find_library("tk8.0", func, *paths) or + find_library("tk4.2", func, *paths) end - return false; end if have_header("tcl.h") && have_header("tk.h") && - search_lib("libX11.{so,a}", "XOpenDisplay", - "/usr/lib", "/usr/openwin/lib", "/usr/X11*/lib") && - search_lib("libtcl{8*,7*,}.{so,a}", "Tcl_FindExecutable", - "/usr/lib", "/usr/local/lib") && - search_lib("libtk{8*,4*,}.{so,a}", "Tk_Init", - "/usr/lib", "/usr/local/lib") - $LDFLAGS = $libraries.collect{|path| "-L" + path}.join(" ") + (/mswin32/ =~ RUBY_PLATFORM || find_library("X11", "XOpenDisplay", + "/usr/X11/lib", "/usr/X11R6/lib", "/usr/openwin/lib")) && + find_tcl(tcllib) && + find_tk(tklib) create_makefile("tcltklib") end diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c index 625fe61ccc..314246869e 100644 --- a/ext/tcltklib/tcltklib.c +++ b/ext/tcltklib/tcltklib.c @@ -4,22 +4,22 @@ * Oct. 24, 1997 Y. Matsumoto */ -#include "ruby.h" -#include "rubysig.h" #include <stdio.h> #include <string.h> #include <tcl.h> #include <tk.h> +#include "ruby.h" +#include "rubysig.h" #ifdef __MACOS__ # include <tkMac.h> # include <Quickdraw.h> #endif -/* for rb_debug */ +/* for ruby_debug */ -#define DUMP1(ARG1) if (rb_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1);} -#define DUMP2(ARG1, ARG2) if (rb_debug) { fprintf(stderr, "tcltklib: ");\ +#define DUMP1(ARG1) if (ruby_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1);} +#define DUMP2(ARG1, ARG2) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\ fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); } /* #define DUMP1(ARG1) @@ -27,8 +27,10 @@ fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); } */ /* for callback break & continue */ -VALUE eTkCallbackBreak; -VALUE eTkCallbackContinue; +static VALUE eTkCallbackBreak; +static VALUE eTkCallbackContinue; + +static VALUE ip_invoke_real _((int, VALUE*, VALUE)); /* from tkAppInit.c */ @@ -42,51 +44,61 @@ int *tclDummyMathPtr = (int *) matherr; /*---- module TclTkLib ----*/ +struct invoke_queue { + int argc; + VALUE *argv; + VALUE obj; + int done; + VALUE result; + VALUE thread; + struct invoke_queue *next; +}; + +static struct invoke_queue *iqueue; +static VALUE main_thread; + /* Tk_ThreadTimer */ -typedef struct { - Tcl_TimerToken token; - int flag; -} Tk_TimerData; +static Tcl_TimerToken timer_token; /* timer callback */ -void _timer_for_tcl (ClientData clientData) +static void +_timer_for_tcl(clientData) + ClientData clientData; { - Tk_TimerData *timer = (Tk_TimerData*)clientData; + struct invoke_queue *q, *tmp; + VALUE thread; - timer->flag = 0; - CHECK_INTS; -#ifdef USE_THREAD - if (!rb_thread_critical) rb_thread_schedule(); -#endif + Tk_DeleteTimerHandler(timer_token); + timer_token = Tk_CreateTimerHandler(100, _timer_for_tcl, + (ClientData)0); - timer->token = Tk_CreateTimerHandler(200, _timer_for_tcl, - (ClientData)timer); - timer->flag = 1; + CHECK_INTS; + q = iqueue; + while (q) { + tmp = q; + q = q->next; + if (!tmp->done) { + tmp->done = 1; + tmp->result = ip_invoke_real(tmp->argc, tmp->argv, tmp->obj); + thread = tmp->thread; + tmp = tmp->next; + rb_thread_run(thread); + } + } + rb_thread_schedule(); } /* execute Tk_MainLoop */ static VALUE -lib_mainloop(VALUE self) +lib_mainloop(self) + VALUE self; { - Tk_TimerData *timer; - - timer = (Tk_TimerData *) ckalloc(sizeof(Tk_TimerData)); - timer->flag = 0; - timer->token = Tk_CreateTimerHandler(200, _timer_for_tcl, - (ClientData)timer); - timer->flag = 1; - + timer_token = Tk_CreateTimerHandler(100, _timer_for_tcl, + (ClientData)0); DUMP1("start Tk_Mainloop"); - while (Tk_GetNumMainWindows() > 0) { - Tcl_DoOneEvent(0); - } + Tk_MainLoop(); DUMP1("stop Tk_Mainloop"); - -#ifdef USE_THREAD - if (timer->flag) { - Tk_DeleteTimerHandler(timer->token); - } -#endif + Tk_DeleteTimerHandler(timer_token); return Qnil; } @@ -99,7 +111,9 @@ struct tcltkip { /* Tcl command `ruby' */ static VALUE -ip_eval_rescue(VALUE *failed, VALUE einfo) +ip_eval_rescue(failed, einfo) + VALUE *failed; + VALUE einfo; { *failed = einfo; return Qnil; @@ -107,10 +121,17 @@ ip_eval_rescue(VALUE *failed, VALUE einfo) static int #if TCL_MAJOR_VERSION >= 8 -ip_ruby(ClientData clientData, Tcl_Interp *interp, - int argc, Tcl_Obj *CONST argv[]) +ip_ruby(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + Tcl_Obj *CONST argv[]; #else -ip_ruby(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) +ip_ruby(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char *argv[]; #endif { VALUE res; @@ -143,11 +164,11 @@ ip_ruby(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) VALUE eclass = CLASS_OF(failed); Tcl_AppendResult(interp, STR2CSTR(failed), (char*)NULL); if (eclass == eTkCallbackBreak) { - return TCL_BREAK; + return TCL_BREAK; } else if (eclass == eTkCallbackContinue) { - return TCL_CONTINUE; + return TCL_CONTINUE; } else { - return TCL_ERROR; + return TCL_ERROR; } } @@ -167,7 +188,8 @@ ip_ruby(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) /* destroy interpreter */ static void -ip_free(struct tcltkip *ptr) +ip_free(ptr) + struct tcltkip *ptr; { DUMP1("Tcl_DeleteInterp"); Tcl_DeleteInterp(ptr->ip); @@ -176,7 +198,8 @@ ip_free(struct tcltkip *ptr) /* create and initialize interpreter */ static VALUE -ip_new(VALUE self) +ip_new(self) + VALUE self; { struct tcltkip *ptr; /* tcltkip data struct */ VALUE obj; /* newly created object */ @@ -192,11 +215,11 @@ ip_new(VALUE self) /* from Tcl_AppInit() */ DUMP1("Tcl_Init"); if (Tcl_Init(ptr->ip) == TCL_ERROR) { - rb_raise(rb_eRuntimeError, "Tcl_Init"); + rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); } DUMP1("Tk_Init"); if (Tk_Init(ptr->ip) == TCL_ERROR) { - rb_raise(rb_eRuntimeError, "Tk_Init"); + rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); } DUMP1("Tcl_StaticPackage(\"Tk\")"); Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, @@ -218,7 +241,9 @@ ip_new(VALUE self) /* eval string in tcl by Tcl_Eval() */ static VALUE -ip_eval(VALUE self, VALUE str) +ip_eval(self, str) + VALUE self; + VALUE str; { char *s; char *buf; /* Tcl_Eval requires re-writable string region */ @@ -234,7 +259,7 @@ ip_eval(VALUE self, VALUE str) DUMP2("Tcl_Eval(%s)", buf); ptr->return_value = Tcl_Eval(ptr->ip, buf); if (ptr->return_value == TCL_ERROR) { - rb_raise(rb_eRuntimeError, ptr->ip->result); + rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); } DUMP2("(TCL_Eval result) %d", ptr->return_value); @@ -244,76 +269,77 @@ ip_eval(VALUE self, VALUE str) static VALUE -ip_toUTF8(VALUE self, VALUE str, VALUE encodename) +ip_toUTF8(self, str, encodename) + VALUE self; + VALUE str; + VALUE encodename; { -#ifndef TCL_UTF_MAX - return str; -#else - Tcl_Interp *interp; - Tcl_Encoding encoding; - Tcl_DString dstr; - struct tcltkip *ptr; - char *buff1,*buff2; - - Data_Get_Struct(self,struct tcltkip, ptr); - interp = ptr->ip; - - encoding = Tcl_GetEncoding(interp,STR2CSTR(encodename)); - buff1 = ALLOCA_N(char,strlen(STR2CSTR(str))+1); - strcpy(buff1,STR2CSTR(str)); - - Tcl_DStringInit(&dstr); - Tcl_DStringFree(&dstr); - Tcl_ExternalToUtfDString(encoding,buff1,strlen(buff1),&dstr); - buff2 = ALLOCA_N(char,Tcl_DStringLength(&dstr)+1); - strcpy(buff2,Tcl_DStringValue(&dstr)); - - Tcl_FreeEncoding(encoding); - Tcl_DStringFree(&dstr); - - return rb_str_new2(buff2); +#ifdef TCL_UTF_MAX + Tcl_Interp *interp; + Tcl_Encoding encoding; + Tcl_DString dstr; + struct tcltkip *ptr; + char *buf; + + Data_Get_Struct(self,struct tcltkip, ptr); + interp = ptr->ip; + + encoding = Tcl_GetEncoding(interp,STR2CSTR(encodename)); + buf = ALLOCA_N(char,strlen(STR2CSTR(str))+1); + strcpy(buf,STR2CSTR(str)); + + Tcl_DStringInit(&dstr); + Tcl_DStringFree(&dstr); + Tcl_ExternalToUtfDString(encoding,buf,strlen(buf),&dstr); + str = rb_str_new2(Tcl_DStringValue(&dstr)); + + Tcl_FreeEncoding(encoding); + Tcl_DStringFree(&dstr); #endif + return str; } static VALUE -ip_fromUTF8(VALUE self, VALUE str, VALUE encodename) +ip_fromUTF8(self, str, encodename) + VALUE self; + VALUE str; + VALUE encodename; { -#ifndef TCL_UTF_MAX - return str; -#else - Tcl_Interp *interp; - Tcl_Encoding encoding; - Tcl_DString dstr; - struct tcltkip *ptr; - char *buff1,*buff2; +#ifdef TCL_UTF_MAX + Tcl_Interp *interp; + Tcl_Encoding encoding; + Tcl_DString dstr; + struct tcltkip *ptr; + char *buf; - Data_Get_Struct(self,struct tcltkip, ptr); - interp = ptr->ip; + Data_Get_Struct(self,struct tcltkip, ptr); + interp = ptr->ip; - encoding = Tcl_GetEncoding(interp,STR2CSTR(encodename)); - buff1 = ALLOCA_N(char,strlen(STR2CSTR(str))+1); - strcpy(buff1,STR2CSTR(str)); + encoding = Tcl_GetEncoding(interp,STR2CSTR(encodename)); + buf = ALLOCA_N(char,strlen(STR2CSTR(str))+1); + strcpy(buf,STR2CSTR(str)); - Tcl_DStringInit(&dstr); - Tcl_DStringFree(&dstr); - Tcl_UtfToExternalDString(encoding,buff1,strlen(buff1),&dstr); - buff2 = ALLOCA_N(char,Tcl_DStringLength(&dstr)+1); - strcpy(buff2,Tcl_DStringValue(&dstr)); + Tcl_DStringInit(&dstr); + Tcl_DStringFree(&dstr); + Tcl_UtfToExternalDString(encoding,buf,strlen(buf),&dstr); + str = rb_str_new2(Tcl_DStringValue(&dstr)); - Tcl_FreeEncoding(encoding); - Tcl_DStringFree(&dstr); + Tcl_FreeEncoding(encoding); + Tcl_DStringFree(&dstr); - return rb_str_new2(buff2); #endif + return str; } static VALUE -ip_invoke(int argc, VALUE *argv, VALUE obj) +ip_invoke_real(argc, argv, obj) + int argc; + VALUE *argv; + VALUE obj; { struct tcltkip *ptr; /* tcltkip data struct */ int i; - int object = 0; Tcl_CmdInfo info; char *cmd; char **av = (char **)NULL; @@ -332,63 +358,115 @@ ip_invoke(int argc, VALUE *argv, VALUE obj) if (!Tcl_GetCommandInfo(ptr->ip, cmd, &info)) { rb_raise(rb_eNameError, "invalid command name `%s'", cmd); } -#if TCL_MAJOR_VERSION >= 8 - object = info.isNativeObjectProc; -#endif /* memory allocation for arguments of this command */ - if (object) { #if TCL_MAJOR_VERSION >= 8 - /* object interface */ - ov = (Tcl_Obj **)ALLOCA_N(Tcl_Obj *, argc+1); - for (i = 0; i < argc; ++i) { - char *s = STR2CSTR(argv[i]); - ov[i] = Tcl_NewStringObj(s, strlen(s)); - } - ov[argc] = (Tcl_Obj *)NULL; + if (info.isNativeObjectProc) { + /* object interface */ + ov = (Tcl_Obj **)ALLOCA_N(Tcl_Obj *, argc+1); + for (i = 0; i < argc; ++i) { + char *s = STR2CSTR(argv[i]); + ov[i] = Tcl_NewStringObj(s, strlen(s)); + Tcl_IncrRefCount(ov[i]); + } + ov[argc] = (Tcl_Obj *)NULL; + } + else #endif - } else { + { /* string interface */ - av = (char **)ALLOCA_N(char *, argc+1); - for (i = 0; i < argc; ++i) { - char *s = STR2CSTR(argv[i]); - - av[i] = ALLOCA_N(char, strlen(s)+1); - strcpy(av[i], s); - } - av[argc] = (char *)NULL; + av = (char **)ALLOCA_N(char *, argc+1); + for (i = 0; i < argc; ++i) { + char *s = STR2CSTR(argv[i]); + + av[i] = ALLOCA_N(char, strlen(s)+1); + strcpy(av[i], s); + } + av[argc] = (char *)NULL; } Tcl_ResetResult(ptr->ip); /* Invoke the C procedure */ - if (object) { #if TCL_MAJOR_VERSION >= 8 - int dummy; - ptr->return_value = (*info.objProc)(info.objClientData, - ptr->ip, argc, ov); - - /* get the string value from the result object */ - resultPtr = Tcl_GetObjResult(ptr->ip); - Tcl_SetResult(ptr->ip, Tcl_GetStringFromObj(resultPtr, &dummy), - TCL_VOLATILE); + if (info.isNativeObjectProc) { + int dummy; + ptr->return_value = (*info.objProc)(info.objClientData, + ptr->ip, argc, ov); + + /* get the string value from the result object */ + resultPtr = Tcl_GetObjResult(ptr->ip); + Tcl_SetResult(ptr->ip, Tcl_GetStringFromObj(resultPtr, &dummy), + TCL_VOLATILE); + + for (i=0; i<argc; i++) { + Tcl_DecrRefCount(ov[i]); + } + } + else #endif - } else { - ptr->return_value = (*info.proc)(info.clientData, - ptr->ip, argc, av); + { + ptr->return_value = (*info.proc)(info.clientData, + ptr->ip, argc, av); } if (ptr->return_value == TCL_ERROR) { - rb_raise(rb_eRuntimeError, ptr->ip->result); + rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); } /* pass back the result (as string) */ - return(rb_str_new2(ptr->ip->result)); + return rb_str_new2(ptr->ip->result); +} + +static VALUE +ip_invoke(argc, argv, obj) + int argc; + VALUE *argv; + VALUE obj; +{ + struct invoke_queue *tmp, *p; + VALUE result = rb_thread_current(); + + if (result == main_thread) { + return ip_invoke_real(argc, argv, obj); + } + tmp = ALLOC(struct invoke_queue); + tmp->obj = obj; + tmp->argc = argc; + tmp->argv = ALLOC_N(VALUE, argc); + MEMCPY(tmp->argv, argv, VALUE, argc); + tmp->thread = result; + tmp->done = 0; + + tmp->next = iqueue; + iqueue = tmp; + + rb_thread_stop(); + result = tmp->result; + if (iqueue == tmp) { + iqueue = tmp->next; + free(tmp->argv); + free(tmp); + return result; + } + + p = iqueue; + while (p->next) { + if (p->next == tmp) { + p->next = tmp->next; + free(tmp->argv); + free(tmp); + break; + } + p = p->next; + } + return result; } /* get return code from Tcl_Eval() */ static VALUE -ip_retval(VALUE self) +ip_retval(self) + VALUE self; { struct tcltkip *ptr; /* tcltkip data struct */ @@ -402,13 +480,14 @@ ip_retval(VALUE self) static void _macinit() { - tcl_macQdPtr = &qd; /* setup QuickDraw globals */ - Tcl_MacSetEventProc(TkMacConvertEvent); /* setup event handler */ + tcl_macQdPtr = &qd; /* setup QuickDraw globals */ + Tcl_MacSetEventProc(TkMacConvertEvent); /* setup event handler */ } #endif /*---- initialization ----*/ -void Init_tcltklib() +void +Init_tcltklib() { extern VALUE rb_argv0; /* the argv[0] */ @@ -428,6 +507,7 @@ void Init_tcltklib() rb_define_method(ip, "_return_value", ip_retval, 0); rb_define_method(ip, "mainloop", lib_mainloop, 0); + main_thread = rb_thread_current(); #ifdef __MACOS__ _macinit(); #endif |