kotovalexarian-likes-github/ruby--ruby
1
0
Fork 0
mirror of https://github.com/ruby/ruby.git synced 2022-11-09 12:17:21 -05:00
Code Releases Activity

remove marshal/gtk/kconv

Browse source 
git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@518 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
This commit is contained in:
matz 1999-08-13 05:37:52 +00:00
parent 210367ec88
commit 0a64817fb8
124 changed files with 14604 additions and 10219 deletions
Download patch file Download diff file Expand all files Collapse all files

350
ext/tcltklib/tcltklib.c
View file

@ -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