mirror of
https://github.com/ruby/ruby.git
synced 2022-11-09 12:17:21 -05:00
remove marshal/gtk/kconv
git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@518 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
This commit is contained in:
matz
parent
210367ec88
commit
0a64817fb8
124 changed files with 14604 additions and 10219 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
dir_config("tk")
|
||||
dir_config("tcl")
|
||||
dir_config("X11")
|
||||
|
||||
tklib = with_config("tklib")
|
||||
tcllib = with_config("tcllib")
|
||||
|
||||
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
|
||||
|
||||
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")
|
||||
|
||||
$CFLAGS = $includes.collect{|path| "-I" + path}.join(" ")
|
||||
|
||||
$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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
Tk_DeleteTimerHandler(timer_token);
|
||||
timer_token = Tk_CreateTimerHandler(100, _timer_for_tcl,
|
||||
(ClientData)0);
|
||||
|
||||
timer->flag = 0;
|
||||
CHECK_INTS;
|
||||
#ifdef USE_THREAD
|
||||
if (!rb_thread_critical) rb_thread_schedule();
|
||||
#endif
|
||||
|
||||
timer->token = Tk_CreateTimerHandler(200, _timer_for_tcl,
|
||||
(ClientData)timer);
|
||||
timer->flag = 1;
|
||||
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;
|
||||
#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_ExternalToUtfDString(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_ExternalToUtfDString(encoding,buf,strlen(buf),&dstr);
|
||||
str = rb_str_new2(Tcl_DStringValue(&dstr));
|
||||
|
||||
Tcl_FreeEncoding(encoding);
|
||||
Tcl_DStringFree(&dstr);
|
||||
|
||||
return rb_str_new2(buff2);
|
||||
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 = (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[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);
|
||||
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);
|
||||
/* 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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue