7 #define TCLTKLIB_RELEASE_DATE "2010-08-25" 12 #ifdef HAVE_RUBY_ENCODING_H 16 #define RUBY_VERSION "(unknown version)" 18 #ifndef RUBY_RELEASE_DATE 19 #define RUBY_RELEASE_DATE "unknown release-date" 23 static VALUE rb_thread_critical;
30 #if !defined(RSTRING_PTR) 31 #define RSTRING_PTR(s) (RSTRING(s)->ptr) 32 #define RSTRING_LEN(s) (RSTRING(s)->len) 34 #if !defined(RARRAY_PTR) 35 #define RARRAY_PTR(s) (RARRAY(s)->ptr) 36 #define RARRAY_LEN(s) (RARRAY(s)->len) 40 #define RbTk_OBJ_UNTRUST(x) do {OBJ_TAINT(x); OBJ_UNTRUST(x);} while (0) 42 #define RbTk_OBJ_UNTRUST(x) OBJ_TAINT(x) 45 #if defined(HAVE_RB_PROC_NEW) && !defined(RUBY_VM) 52 #ifdef HAVE_STDARG_PROTOTYPES 54 #define va_init_list(a,b) va_start(a,b) 57 #define va_init_list(a,b) va_start(a) 61 #if !defined HAVE_VSNPRINTF && !defined vsnprintf 64 # define vsnprintf _vsnprintf 66 # ifdef HAVE_RUBY_RUBY_H 77 #ifndef HAVE_RUBY_NATIVE_THREAD_P 78 #define ruby_native_thread_p() is_ruby_native_thread() 79 #undef RUBY_USE_NATIVE_THREAD 81 #define RUBY_USE_NATIVE_THREAD 1 84 #ifndef HAVE_RB_ERRINFO 85 #define rb_errinfo() (ruby_errinfo+0) 89 #ifndef HAVE_RB_SAFE_LEVEL 90 #define rb_safe_level() (ruby_safe_level+0) 92 #ifndef HAVE_RB_SOURCEFILE 93 #define rb_sourcefile() (ruby_sourcefile+0) 98 #ifndef TCL_ALPHA_RELEASE 99 #define TCL_ALPHA_RELEASE 0 100 #define TCL_BETA_RELEASE 1 101 #define TCL_FINAL_RELEASE 2 122 #if TCL_MAJOR_VERSION >= 8 124 # if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 4 128 # define CONST84 CONST 136 # define CONST84 CONST 144 # if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 5 147 # define CONST86 CONST84 152 #define TAG_RETURN 0x1 153 #define TAG_BREAK 0x2 155 #define TAG_RETRY 0x4 157 #define TAG_RAISE 0x6 158 #define TAG_THROW 0x7 159 #define TAG_FATAL 0x8 162 #define DUMP1(ARG1) if (ruby_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1); fflush(stderr); } 163 #define DUMP2(ARG1, ARG2) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\ 164 fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); fflush(stderr); } 165 #define DUMP3(ARG1, ARG2, ARG3) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\ 166 fprintf(stderr, ARG1, ARG2, ARG3); fprintf(stderr, "\n"); fflush(stderr); } 183 #ifdef HAVE_RUBY_ENCODING_H 184 static VALUE cRubyEncoding;
187 static int ENCODING_INDEX_UTF8;
188 static int ENCODING_INDEX_BINARY;
249 #if TCL_MAJOR_VERSION >= 8 250 static const char Tcl_ObjTypeName_ByteArray[] =
"bytearray";
251 static CONST86 Tcl_ObjType *Tcl_ObjType_ByteArray;
253 static const char Tcl_ObjTypeName_String[] =
"string";
254 static CONST86 Tcl_ObjType *Tcl_ObjType_String;
256 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) 257 #define IS_TCL_BYTEARRAY(obj) ((obj)->typePtr == Tcl_ObjType_ByteArray) 258 #define IS_TCL_STRING(obj) ((obj)->typePtr == Tcl_ObjType_String) 259 #define IS_TCL_VALID_STRING(obj) ((obj)->bytes != (char*)NULL) 263 #ifndef HAVE_RB_HASH_LOOKUP 264 #define rb_hash_lookup rb_hash_aref 269 #ifdef HAVE_PROTOTYPES 270 tcl_eval(Tcl_Interp *interp,
const char *cmd)
280 Tcl_AllowExceptions(interp);
287 #define Tcl_Eval tcl_eval 290 #ifdef HAVE_PROTOTYPES 301 Tcl_AllowExceptions(interp);
307 #undef Tcl_GlobalEval 308 #define Tcl_GlobalEval tcl_global_eval 311 #if TCL_MAJOR_VERSION < 8 312 #define Tcl_IncrRefCount(obj) (1) 313 #define Tcl_DecrRefCount(obj) (1) 317 #if TCL_MAJOR_VERSION < 8 318 #define Tcl_GetStringResult(interp) ((interp)->result) 322 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 324 Tcl_GetVar2Ex(interp, name1, name2, flags)
330 Tcl_Obj *nameObj1, *nameObj2 =
NULL, *retObj;
332 nameObj1 = Tcl_NewStringObj((
char*)name1, -1);
336 nameObj2 = Tcl_NewStringObj((
char*)name2, -1);
340 retObj = Tcl_ObjGetVar2(interp, nameObj1, nameObj2, flags);
352 Tcl_SetVar2Ex(interp, name1, name2, newValObj, flags)
359 Tcl_Obj *nameObj1, *nameObj2 =
NULL, *retObj;
361 nameObj1 = Tcl_NewStringObj((
char*)name1, -1);
365 nameObj2 = Tcl_NewStringObj((
char*)name2, -1);
369 retObj = Tcl_ObjSetVar2(interp, nameObj1, nameObj2, newValObj, flags);
383 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4) 384 # if !defined __MINGW32__ && !defined __BORLANDC__ 400 #if TCL_MAJOR_VERSION >= 8 468 #ifdef RUBY_USE_NATIVE_THREAD 469 Tcl_ThreadId tk_eventloop_thread_id;
484 #ifdef RUBY_USE_NATIVE_THREAD 485 #define CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 1 486 #define USE_TOGGLE_WINDOW_MODE_FOR_IDLE 0 487 #define DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 1 489 #define CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 1 490 #define USE_TOGGLE_WINDOW_MODE_FOR_IDLE 0 491 #define DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 0 494 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 505 #ifdef RUBY_USE_NATIVE_THREAD 506 #define DEFAULT_EVENT_LOOP_MAX 800 507 #define DEFAULT_NO_EVENT_TICK 10 508 #define DEFAULT_NO_EVENT_WAIT 5 509 #define WATCHDOG_INTERVAL 10 510 #define DEFAULT_TIMER_TICK 0 511 #define NO_THREAD_INTERRUPT_TIME 100 513 #define DEFAULT_EVENT_LOOP_MAX 800 514 #define DEFAULT_NO_EVENT_TICK 10 515 #define DEFAULT_NO_EVENT_WAIT 20 516 #define WATCHDOG_INTERVAL 10 517 #define DEFAULT_TIMER_TICK 0 518 #define NO_THREAD_INTERRUPT_TIME 100 521 #define EVENT_HANDLER_TIMEOUT 100 538 #if TCL_MAJOR_VERSION >= 8 542 static int ip_ruby_eval _((ClientData, Tcl_Interp *,
int,
char **));
543 static int ip_ruby_cmd _((ClientData, Tcl_Interp *,
int,
char **));
555 #ifndef TCL_NAMESPACE_DEBUG 556 #define TCL_NAMESPACE_DEBUG 0 559 #if TCL_NAMESPACE_DEBUG 561 #if TCL_MAJOR_VERSION >= 8 562 EXTERN struct TclIntStubs *tclIntStubsPtr;
566 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5 569 # ifndef Tcl_GetCurrentNamespace 570 EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace
_((Tcl_Interp *));
572 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) 573 # ifndef Tcl_GetCurrentNamespace 574 # ifndef FunctionNum_of_GetCurrentNamespace 575 #define FunctionNum_of_GetCurrentNamespace 124 577 struct DummyTclIntStubs_for_GetCurrentNamespace {
579 struct TclIntStubHooks *hooks;
580 void (*
func[FunctionNum_of_GetCurrentNamespace])();
581 Tcl_Namespace * (*tcl_GetCurrentNamespace)
_((Tcl_Interp *));
584 #define Tcl_GetCurrentNamespace \ 585 (((struct DummyTclIntStubs_for_GetCurrentNamespace *)tclIntStubsPtr)->tcl_GetCurrentNamespace) 592 #if TCL_MAJOR_VERSION < 8 593 #define ip_null_namespace(interp) (0) 595 #define ip_null_namespace(interp) \ 596 (Tcl_GetCurrentNamespace(interp) == (Tcl_Namespace *)NULL) 600 #if TCL_MAJOR_VERSION < 8 601 #define rbtk_invalid_namespace(ptr) (0) 603 #define rbtk_invalid_namespace(ptr) \ 604 ((ptr)->default_ns == (Tcl_Namespace*)NULL || Tcl_GetCurrentNamespace((ptr)->ip) != (ptr)->default_ns) 608 #if TCL_MAJOR_VERSION >= 8 610 typedef struct CallFrame {
611 Tcl_Namespace *nsPtr;
615 struct CallFrame *callerPtr;
616 struct CallFrame *callerVarPtr;
625 # if !defined(TclGetFrame) && !defined(TclGetFrame_TCL_DECLARED) 626 EXTERN int TclGetFrame
_((Tcl_Interp *,
CONST char *, CallFrame **));
628 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) 630 # ifndef FunctionNum_of_GetFrame 631 #define FunctionNum_of_GetFrame 32 633 struct DummyTclIntStubs_for_GetFrame {
635 struct TclIntStubHooks *hooks;
636 void (*
func[FunctionNum_of_GetFrame])();
637 int (*tclGetFrame)
_((Tcl_Interp *,
CONST char *, CallFrame **));
639 #define TclGetFrame \ 640 (((struct DummyTclIntStubs_for_GetFrame *)tclIntStubsPtr)->tclGetFrame) 644 # if !defined(Tcl_PopCallFrame) && !defined(Tcl_PopCallFrame_TCL_DECLARED) 645 EXTERN void Tcl_PopCallFrame
_((Tcl_Interp *));
646 EXTERN int Tcl_PushCallFrame
_((Tcl_Interp *, Tcl_CallFrame *, Tcl_Namespace *,
int));
648 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) 649 # ifndef Tcl_PopCallFrame 650 # ifndef FunctionNum_of_PopCallFrame 651 #define FunctionNum_of_PopCallFrame 128 653 struct DummyTclIntStubs_for_PopCallFrame {
655 struct TclIntStubHooks *hooks;
656 void (*
func[FunctionNum_of_PopCallFrame])();
657 void (*tcl_PopCallFrame)
_((Tcl_Interp *));
658 int (*tcl_PushCallFrame)
_((Tcl_Interp *, Tcl_CallFrame *, Tcl_Namespace *,
int));
661 #define Tcl_PopCallFrame \ 662 (((struct DummyTclIntStubs_for_PopCallFrame *)tclIntStubsPtr)->tcl_PopCallFrame) 663 #define Tcl_PushCallFrame \ 664 (((struct DummyTclIntStubs_for_PopCallFrame *)tclIntStubsPtr)->tcl_PushCallFrame) 670 typedef struct CallFrame {
671 Tcl_HashTable varTable;
675 struct CallFrame *callerPtr;
676 struct CallFrame *callerVarPtr;
679 # ifndef Tcl_CallFrame 680 #define Tcl_CallFrame CallFrame 683 # if !defined(TclGetFrame) && !defined(TclGetFrame_TCL_DECLARED) 684 EXTERN int TclGetFrame
_((Tcl_Interp *,
CONST char *, CallFrame **));
687 # if !defined(Tcl_PopCallFrame) && !defined(Tcl_PopCallFrame_TCL_DECLARED) 688 typedef struct DummyInterp {
692 Tcl_HashTable dummy4;
693 Tcl_HashTable dummy5;
694 Tcl_HashTable dummy6;
698 CallFrame *varFramePtr;
702 Tcl_PopCallFrame(interp)
705 DummyInterp *iPtr = (DummyInterp*)interp;
706 CallFrame *frame = iPtr->varFramePtr;
709 iPtr->framePtr = frame.callerPtr;
710 iPtr->varFramePtr = frame.callerVarPtr;
716 #define Tcl_Namespace char 719 Tcl_PushCallFrame(interp, framePtr, nsPtr, isProcCallFrame)
721 Tcl_CallFrame *framePtr;
722 Tcl_Namespace *nsPtr;
725 DummyInterp *iPtr = (DummyInterp*)interp;
726 CallFrame *frame = (CallFrame *)framePtr;
729 Tcl_InitHashTable(&frame.varTable, TCL_STRING_KEYS);
730 if (iPtr->varFramePtr !=
NULL) {
731 frame.level = iPtr->varFramePtr->level + 1;
735 frame.callerPtr = iPtr->framePtr;
736 frame.callerVarPtr = iPtr->varFramePtr;
737 iPtr->framePtr = &frame;
738 iPtr->varFramePtr = &frame;
752 #if TCL_NAMESPACE_DEBUG 753 Tcl_Namespace *default_ns;
755 #ifdef RUBY_USE_NATIVE_THREAD 756 Tcl_ThreadId tk_thread_id;
776 if (ptr->
ip == (Tcl_Interp*)
NULL) {
787 if (!ptr || !ptr->
ip || Tcl_InterpDeleted(ptr->
ip)
789 || rbtk_invalid_namespace(ptr)
792 DUMP1(
"ip is deleted");
804 if (ptr->
ip == (Tcl_Interp*)
NULL) {
808 Tcl_Preserve((ClientData)ptr->
ip);
820 }
else if (ptr->
ip == (Tcl_Interp*)
NULL) {
824 Tcl_Release((ClientData)ptr->
ip);
831 #ifdef HAVE_STDARG_PROTOTYPES 852 Tcl_ResetResult(ptr->
ip);
860 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT 864 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 84 865 #error Ruby/Tk-Kit requires Tcl/Tk8.4 or later. 885 #if defined USE_TCL_STUBS || defined USE_TK_STUBS 886 # error Not support Tcl/Tk stubs with Ruby/Tk-Kit or Rubykit. 889 #ifndef KIT_INCLUDES_ZLIB 890 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86 891 #define KIT_INCLUDES_ZLIB 1 893 #define KIT_INCLUDES_ZLIB 0 898 #define WIN32_LEAN_AND_MEAN 900 #undef WIN32_LEAN_AND_MEAN 903 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86 904 EXTERN Tcl_Obj* TclGetStartupScriptPath();
905 EXTERN void TclSetStartupScriptPath
_((Tcl_Obj*));
906 #define Tcl_GetStartupScript(encPtr) TclGetStartupScriptPath() 907 #define Tcl_SetStartupScript(path,enc) TclSetStartupScriptPath(path) 909 #if !defined(TclSetPreInitScript) && !defined(TclSetPreInitScript_TCL_DECLARED) 910 EXTERN char* TclSetPreInitScript
_((
char *));
913 #ifndef KIT_INCLUDES_TK 914 # define KIT_INCLUDES_TK 1 919 Tcl_AppInitProc Vfs_Init, Rechan_Init;
920 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85 921 Tcl_AppInitProc Pwb_Init;
925 Tcl_AppInitProc Vlerq_Init, Vlerq_SafeInit;
927 Tcl_AppInitProc Mk4tcl_Init;
930 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD 931 Tcl_AppInitProc Thread_Init;
934 #if KIT_INCLUDES_ZLIB 935 Tcl_AppInitProc Zlib_Init;
938 #ifdef KIT_INCLUDES_ITCL 939 Tcl_AppInitProc Itcl_Init;
943 Tcl_AppInitProc Dde_Init, Dde_SafeInit, Registry_Init;
948 #define RUBYTK_KITPATH_CONST_NAME "RUBYTK_KITPATH" 950 static char *rubytk_kitpath =
NULL;
952 static char rubytkkit_preInitCmd[] =
953 "proc tclKitPreInit {} {\n" 954 "rename tclKitPreInit {}\n" 955 "load {} rubytk_kitpath\n" 956 #if KIT_INCLUDES_ZLIB 957 "catch {load {} zlib}\n" 961 "namespace eval ::vlerq {}\n" 962 "if {[catch { vlerq open $::tcl::kitpath } ::vlerq::starkit_root]} {\n" 965 "set files [vlerq get $::vlerq::starkit_root 0 dirs 0 files]\n" 966 "set n [lsearch [vlerq get $files * name] boot.tcl]\n" 969 "array set a [vlerq get $files $n]\n" 972 #if defined KIT_VFS_WRITABLE && !defined CREATE_RUBYKIT 974 "mk::file open exe $::tcl::kitpath\n" 976 "mk::file open exe $::tcl::kitpath -readonly\n" 978 "set n [mk::select exe.dirs!0.files name boot.tcl]\n" 979 "if {[llength $n] == 1} {\n" 980 "array set a [mk::get exe.dirs!0.files!$n]\n" 982 "if {![info exists a(contents)]} { error {no boot.tcl file} }\n" 983 "if {$a(size) != [string length $a(contents)]} {\n" 984 "set a(contents) [zlib decompress $a(contents)]\n" 986 "if {$a(contents) eq \"\"} { error {empty boot.tcl} }\n" 987 "uplevel #0 $a(contents)\n" 989 "} elseif {[lindex $::argv 0] eq \"-init-\"} {\n" 990 "uplevel #0 { source [lindex $::argv 1] }\n" 995 "set vfsdir \"[file rootname $::tcl::kitpath].vfs\"\n" 996 "if {[file isdirectory $vfsdir]} {\n" 997 "set ::tcl_library [file join $vfsdir lib tcl$::tcl_version]\n" 998 "set ::tcl_libPath [list $::tcl_library [file join $vfsdir lib]]\n" 999 "catch {uplevel #0 [list source [file join $vfsdir config.tcl]]}\n" 1000 "uplevel #0 [list source [file join $::tcl_library init.tcl]]\n" 1001 "set ::auto_path $::tcl_libPath\n" 1003 "error \"\n $::tcl::kitpath has no VFS data to start up\"\n" 1013 static const char initScript[] =
1014 "if {[file isfile [file join $::tcl::kitpath main.tcl]]} {\n" 1015 "if {[info commands console] != {}} { console hide }\n" 1016 "set tcl_interactive 0\n" 1018 "set argv [linsert $argv 0 $argv0]\n" 1019 "set argv0 [file join $::tcl::kitpath main.tcl]\n" 1027 set_rubytk_kitpath(
const char *kitpath)
1031 if (rubytk_kitpath) {
1032 ckfree(rubytk_kitpath);
1035 rubytk_kitpath = (
char *)ckalloc(
len + 1);
1036 memcpy(rubytk_kitpath, kitpath,
len);
1037 rubytk_kitpath[
len] =
'\0';
1039 return rubytk_kitpath;
1045 #define DEV_NULL "NUL" 1047 #define DEV_NULL "/dev/null" 1051 check_tclkit_std_channels()
1060 chan = Tcl_GetStdChannel(TCL_STDIN);
1062 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"r", 0);
1064 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1066 Tcl_SetStdChannel(chan, TCL_STDIN);
1068 chan = Tcl_GetStdChannel(TCL_STDOUT);
1070 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"w", 0);
1072 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1074 Tcl_SetStdChannel(chan, TCL_STDOUT);
1076 chan = Tcl_GetStdChannel(TCL_STDERR);
1078 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"w", 0);
1080 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1082 Tcl_SetStdChannel(chan, TCL_STDERR);
1089 rubytk_kitpathObjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *
const objv[])
1093 set_rubytk_kitpath(Tcl_GetString(objv[1]));
1094 }
else if (objc > 2) {
1095 Tcl_WrongNumArgs(interp, 1, objv,
"?path?");
1097 str = rubytk_kitpath ? rubytk_kitpath : Tcl_GetNameOfExecutable();
1098 Tcl_SetObjResult(interp, Tcl_NewStringObj(str, -1));
1107 rubytk_kitpath_init(Tcl_Interp *interp)
1109 Tcl_CreateObjCommand(interp,
"::tcl::kitpath", rubytk_kitpathObjCmd, 0, 0);
1110 if (Tcl_LinkVar(interp,
"::tcl::kitpath", (
char *) &rubytk_kitpath,
1111 TCL_LINK_STRING | TCL_LINK_READ_ONLY) != TCL_OK) {
1112 Tcl_ResetResult(interp);
1115 Tcl_CreateObjCommand(interp,
"::tcl::rubytk_kitpath", rubytk_kitpathObjCmd, 0, 0);
1116 if (Tcl_LinkVar(interp,
"::tcl::rubytk_kitpath", (
char *) &rubytk_kitpath,
1117 TCL_LINK_STRING | TCL_LINK_READ_ONLY) != TCL_OK) {
1118 Tcl_ResetResult(interp);
1121 if (rubytk_kitpath ==
NULL) {
1126 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1129 return Tcl_PkgProvide(interp,
"rubytk_kitpath",
"1.0");
1135 init_static_tcltk_packages()
1140 check_tclkit_std_channels();
1142 #ifdef KIT_INCLUDES_ITCL 1143 Tcl_StaticPackage(0,
"Itcl", Itcl_Init,
NULL);
1146 Tcl_StaticPackage(0,
"Vlerq", Vlerq_Init, Vlerq_SafeInit);
1148 Tcl_StaticPackage(0,
"Mk4tcl", Mk4tcl_Init,
NULL);
1150 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85 1151 Tcl_StaticPackage(0,
"pwb", Pwb_Init,
NULL);
1153 Tcl_StaticPackage(0,
"rubytk_kitpath", rubytk_kitpath_init,
NULL);
1154 Tcl_StaticPackage(0,
"rechan", Rechan_Init,
NULL);
1155 Tcl_StaticPackage(0,
"vfs", Vfs_Init,
NULL);
1156 #if KIT_INCLUDES_ZLIB 1157 Tcl_StaticPackage(0,
"zlib", Zlib_Init,
NULL);
1159 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD 1160 Tcl_StaticPackage(0,
"Thread", Thread_Init, Thread_SafeInit);
1163 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84 1164 Tcl_StaticPackage(0,
"dde", Dde_Init, Dde_SafeInit);
1166 Tcl_StaticPackage(0,
"dde", Dde_Init,
NULL);
1168 Tcl_StaticPackage(0,
"registry", Registry_Init,
NULL);
1170 #ifdef KIT_INCLUDES_TK 1171 Tcl_StaticPackage(0,
"Tk", Tk_Init, Tk_SafeInit);
1178 call_tclkit_init_script(Tcl_Interp *interp)
1184 if (Tcl_EvalEx(interp, initScript, -1, TCL_EVAL_GLOBAL) == TCL_OK) {
1185 const char *encoding =
NULL;
1186 Tcl_Obj* path = Tcl_GetStartupScript(&encoding);
1187 Tcl_SetStartupScript(Tcl_GetObjResult(interp), encoding);
1189 Tcl_Eval(interp,
"incr argc -1; set argv [lrange $argv 1 end]");
1203 EXTERN void TkWinSetHINSTANCE(HINSTANCE hInstance);
1204 void rbtk_win32_SetHINSTANCE(
const char *module_name)
1211 hInst = GetModuleHandle(module_name);
1212 TkWinSetHINSTANCE(hInst);
1224 init_static_tcltk_packages();
1228 const_id =
rb_intern(RUBYTK_KITPATH_CONST_NAME);
1231 volatile VALUE pathobj;
1235 #ifdef HAVE_RUBY_ENCODING_H 1243 #ifdef CREATE_RUBYTK_KIT 1244 if (rubytk_kitpath ==
NULL) {
1248 volatile VALUE basename;
1258 if (rubytk_kitpath ==
NULL) {
1259 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1262 TclSetPreInitScript(rubytkkit_preInitCmd);
1307 #if TCL_MAJOR_VERSION >= 8 1310 if (Tcl_IsSafe(ptr->
ip)) {
1311 DUMP1(
"Tk_SafeInit");
1318 "tcltklib: can't find Tk_SafeInit()");
1321 "tcltklib: fail to Tk_SafeInit(). %s",
1325 "tcltklib: fail to Tk_InitStubs(). %s",
1329 "tcltklib: unknown error(%d) on ruby_tk_stubs_safeinit", st);
1339 "tcltklib: can't find Tk_Init()");
1342 "tcltklib: fail to Tk_Init(). %s",
1346 "tcltklib: fail to Tk_InitStubs(). %s",
1350 "tcltklib: unknown error(%d) on ruby_tk_stubs_init", st);
1361 #ifdef RUBY_USE_NATIVE_THREAD 1362 ptr->tk_thread_id = Tcl_GetCurrentThread();
1381 DUMP1(
"find a pending exception");
1390 DUMP1(
"pending_exception_check0: call rb_jump_tag(retry)");
1393 DUMP1(
"pending_exception_check0: call rb_jump_tag(redo)");
1396 DUMP1(
"pending_exception_check0: call rb_jump_tag(throw)");
1415 DUMP1(
"find a pending exception");
1429 rb_thread_critical = thr_crit_bup;
1432 DUMP1(
"pending_exception_check1: call rb_jump_tag(retry)");
1435 DUMP1(
"pending_exception_check1: call rb_jump_tag(redo)");
1438 DUMP1(
"pending_exception_check1: call rb_jump_tag(throw)");
1457 #if TCL_MAJOR_VERSION >= 8 1461 DUMP1(
"original_exit is called");
1465 thr_crit_bup = rb_thread_critical;
1466 rb_thread_critical =
Qtrue;
1468 Tcl_ResetResult(ptr->
ip);
1473 #if TCL_MAJOR_VERSION >= 8 1474 state_obj = Tcl_NewIntObj(
state);
1477 if (info->isNativeObjectProc) {
1479 #define USE_RUBY_ALLOC 0 1483 argv = (Tcl_Obj **)ckalloc(
sizeof(Tcl_Obj *) * 3);
1485 Tcl_Preserve((ClientData)
argv);
1488 cmd_obj = Tcl_NewStringObj(
"exit", 4);
1492 argv[1] = state_obj;
1496 = (*(info->objProc))(info->objClientData, ptr->
ip, 2,
argv);
1504 Tcl_EventuallyFree((ClientData)
argv, TCL_DYNAMIC);
1507 Tcl_Release((ClientData)
argv);
1510 ckfree((
char*)
argv);
1514 #undef USE_RUBY_ALLOC 1519 #define USE_RUBY_ALLOC 0 1523 argv = (
CONST84 char **)ckalloc(
sizeof(
char *) * 3);
1525 Tcl_Preserve((ClientData)
argv);
1528 argv[0] = (
char *)
"exit";
1530 argv[1] = Tcl_GetStringFromObj(state_obj, (
int*)
NULL);
1539 Tcl_EventuallyFree((ClientData)
argv, TCL_DYNAMIC);
1542 Tcl_Release((ClientData)
argv);
1545 ckfree((
char*)
argv);
1549 #undef USE_RUBY_ALLOC 1558 #define USE_RUBY_ALLOC 0 1562 argv = (
char **)ckalloc(
sizeof(
char *) * 3);
1564 Tcl_Preserve((ClientData)
argv);
1578 Tcl_EventuallyFree((ClientData)
argv, TCL_DYNAMIC);
1581 Tcl_Release((ClientData)
argv);
1588 #undef USE_RUBY_ALLOC 1591 DUMP1(
"complete original_exit");
1593 rb_thread_critical = thr_crit_bup;
1603 ClientData clientData;
1610 DUMP1(
"call _timer_for_tcl");
1612 thr_crit_bup = rb_thread_critical;
1613 rb_thread_critical =
Qtrue;
1626 rb_thread_critical = thr_crit_bup;
1632 #ifdef RUBY_USE_NATIVE_THREAD 1633 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE 1635 toggle_eventloop_window_mode_for_idle()
1691 "timer-tick parameter must be 0 or positive number");
1694 thr_crit_bup = rb_thread_critical;
1695 rb_thread_critical =
Qtrue;
1709 rb_thread_critical = thr_crit_bup;
1733 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1758 "no_event_wait parameter must be positive number");
1785 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1805 int lpmax =
NUM2INT(loop_max);
1806 int no_ev =
NUM2INT(no_event);
1810 if (lpmax <= 0 || no_ev <= 0) {
1840 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1859 struct Tcl_Time tcl_time;
1862 switch(
TYPE(time)) {
1885 Tcl_SetMaxBlockTime(&tcl_time);
1930 }
else if (
NIL_P(val)) {
1951 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1965 return INT2FIX(Tk_GetNumMainWindows());
1975 #ifdef RUBY_USE_NATIVE_THREAD 1988 Tcl_SetMaxBlockTime(&tcl_time);
1998 #ifdef RUBY_USE_NATIVE_THREAD 2000 #ifdef HAVE_PROTOTYPES 2001 call_DoOneEvent_core(
VALUE flag_val)
2003 call_DoOneEvent_core(flag_val)
2010 if (Tcl_DoOneEvent(flag)) {
2018 #ifdef HAVE_PROTOTYPES 2030 #ifdef HAVE_PROTOTYPES 2040 if (Tcl_DoOneEvent(flag)) {
2050 #ifdef HAVE_PROTOTYPES 2066 #ifdef HAVE_NATIVETHREAD 2067 #ifndef RUBY_USE_NATIVE_THREAD 2069 rb_bug(
"cross-thread violation on eventloop_sleep()");
2078 #ifdef HAVE_NATIVETHREAD 2079 #ifndef RUBY_USE_NATIVE_THREAD 2081 rb_bug(
"cross-thread violation on eventloop_sleep()");
2089 #define USE_EVLOOP_THREAD_ALONE_CHECK_FLAG 0 2091 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG 2093 get_thread_alone_check_flag()
2095 #ifdef RUBY_USE_NATIVE_THREAD 2127 #define TRAP_CHECK() do { \ 2128 if (trap_check(check_var) == 0) return 0; \ 2134 DUMP1(
"trap check");
2138 if (check_var != (
int*)
NULL) {
2147 if (rb_trap_pending) {
2149 if (rb_prohibit_interrupt || check_var != (
int*)
NULL) {
2164 DUMP1(
"check eventloop_interp");
2182 int found_event = 1;
2188 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG 2189 int thread_alone_check_flag = 1;
2192 if (update_flag)
DUMP1(
"update loop start!!");
2200 thr_crit_bup = rb_thread_critical;
2201 rb_thread_critical =
Qtrue;
2204 rb_thread_critical = thr_crit_bup;
2209 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG 2211 thread_alone_check_flag = get_thread_alone_check_flag();
2217 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG 2222 DUMP1(
"no other thread");
2226 event_flag = update_flag;
2229 event_flag = TCL_ALL_EVENTS;
2240 if (check_var != (
int *)
NULL) {
2241 if (*check_var || !found_event) {
2244 if (interp != (Tcl_Interp*)
NULL 2245 && Tcl_InterpDeleted(interp)) {
2253 INT2FIX(event_flag), &status));
2285 DUMP2(
"DoOneEvent(1) abnormal exit!! %d",
2290 DUMP1(
"exception on wait");
2299 if (update_flag != 0) {
2301 DUMP1(
"next update loop");
2304 DUMP1(
"update complete");
2312 DUMP1(
"check Root Widget");
2327 DUMP1(
"there are other threads");
2333 event_flag = update_flag;
2336 event_flag = TCL_ALL_EVENTS;
2343 if (check_var != (
int *)
NULL) {
2344 if (*check_var || !found_event) {
2347 if (interp != (Tcl_Interp*)
NULL 2348 && Tcl_InterpDeleted(interp)) {
2358 #ifdef RUBY_USE_NATIVE_THREAD 2361 INT2FIX(event_flag), &status));
2366 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE 2368 if (toggle_eventloop_window_mode_for_idle()) {
2381 INT2FIX(event_flag), &status));
2384 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 2397 "unknown exception");
2423 DUMP2(
"DoOneEvent(2) abnormal exit!! %d",
2430 if (check_var != (
int*)
NULL 2432 DUMP1(
"exception on wait");
2444 if (update_flag != 0) {
2445 DUMP1(
"update complete");
2461 "unknown exception");
2490 DUMP2(
"sleep eventloop %lx", current);
2503 DUMP1(
"check Root Widget");
2524 DUMP1(
"thread scheduling");
2528 DUMP1(
"check interrupts");
2529 #if defined(RUBY_USE_NATIVE_THREAD) || defined(RUBY_VM) 2612 DUMP2(
"eventloop_ensure: current-thread : %lx", current_evloop);
2615 DUMP2(
"finish eventloop %lx (NOT current eventloop)", current_evloop);
2626 DUMP2(
"eventloop-ensure: new eventloop-thread -> %lx",
2631 DUMP2(
"eventloop %lx : back from recursive call", current_evloop);
2654 #ifdef RUBY_USE_NATIVE_THREAD 2656 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2665 DUMP2(
"finish current eventloop %lx", current_evloop);
2683 #ifdef RUBY_USE_NATIVE_THREAD 2684 tk_eventloop_thread_id = Tcl_GetCurrentThread();
2688 DUMP2(
"eventloop: recursive call on %lx", parent_evloop);
2693 DUMP2(
"wait for stop of parent_evloop %lx", parent_evloop);
2695 DUMP2(
"parent_evloop %lx doesn't stop", parent_evloop);
2698 DUMP1(
"succeed to stop parent");
2703 DUMP3(
"tcltklib: eventloop-thread : %lx -> %lx\n",
2710 args->thr_crit_bup = rb_thread_critical;
2712 rb_thread_critical =
Qfalse;
2729 VALUE check_rootwidget;
2732 check_rootwidget =
Qtrue;
2733 }
else if (
RTEST(check_rootwidget)) {
2734 check_rootwidget =
Qtrue;
2736 check_rootwidget =
Qfalse;
2757 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2771 VALUE check_rootwidget;
2777 #define EVLOOP_WAKEUP_CHANCE 3 2781 VALUE check_rootwidget;
2786 int check =
RTEST(check_rootwidget);
2809 DUMP2(
"eventloop thread %lx is sleeping or dead",
2812 (
void*)&check_rootwidget);
2813 DUMP2(
"create new eventloop thread %lx", evloop);
2841 #ifdef RUBY_USE_NATIVE_THREAD 2842 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2853 VALUE check_rootwidget;
2857 "eventloop_watchdog is not implemented on Ruby VM.");
2861 check_rootwidget =
Qtrue;
2862 }
else if (
RTEST(check_rootwidget)) {
2863 check_rootwidget =
Qtrue;
2865 check_rootwidget =
Qfalse;
2885 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2933 #ifdef HAVE_PROTOTYPES 2951 int status, foundEvent;
2971 q->done, (Tcl_Interp*)
NULL));
3013 volatile VALUE vflags;
3024 flags = TCL_ALL_EVENTS | TCL_DONT_WAIT;
3031 flags |= TCL_DONT_WAIT;
3043 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
3045 flags |= TCL_DONT_WAIT;
3050 found_event = Tcl_DoOneEvent(flags);
3092 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) 3094 Tcl_Encoding encoding;
3097 thr_crit_bup = rb_thread_critical;
3098 rb_thread_critical =
Qtrue;
3103 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) 3109 encoding = (Tcl_Encoding)
NULL;
3128 Tcl_DStringInit(&dstr);
3129 Tcl_DStringFree(&dstr);
3132 Tcl_AppendResult(interp, Tcl_DStringValue(&dstr), (
char*)
NULL);
3133 DUMP2(
"error message:%s", Tcl_DStringValue(&dstr));
3134 Tcl_DStringFree(&dstr);
3142 rb_thread_critical = thr_crit_bup;
3175 #ifdef HAVE_PROTOTYPES 3186 int thr_crit_bup = rb_thread_critical;
3188 Tcl_ResetResult(interp);
3190 rb_thread_critical =
Qfalse;
3192 rb_thread_critical =
Qtrue;
3218 DUMP1(
"rb_protect: retry");
3227 DUMP1(
"rb_protect: redo");
3252 DUMP1(
"rb_protect: throw");
3262 sprintf(
buf,
"unknown loncaljmp status %d", status);
3274 rb_thread_critical = thr_crit_bup;
3276 Tcl_ResetResult(interp);
3281 volatile VALUE backtrace;
3285 thr_crit_bup = rb_thread_critical;
3286 rb_thread_critical =
Qtrue;
3288 DUMP1(
"set backtrace");
3294 rb_thread_critical = thr_crit_bup;
3305 return TCL_CONTINUE;
3328 return TCL_CONTINUE;
3338 thr_crit_bup = rb_thread_critical;
3339 rb_thread_critical =
Qtrue;
3342 DUMP1(
"Tcl_AppendResult");
3345 rb_thread_critical = thr_crit_bup;
3361 #ifdef HAVE_NATIVETHREAD 3362 #ifndef RUBY_USE_NATIVE_THREAD 3364 rb_bug(
"cross-thread violation on tcl_protect()");
3373 int old_trapflag = rb_trap_immediate;
3374 rb_trap_immediate = 0;
3376 rb_trap_immediate = old_trapflag;
3384 #if TCL_MAJOR_VERSION >= 8 3386 ClientData clientData;
3392 ClientData clientData;
3402 if (interp == (Tcl_Interp*)
NULL) {
3412 "wrong number of arguments (%d for 1)",
argc - 1);
3414 char buf[
sizeof(int)*8 + 1];
3415 Tcl_ResetResult(interp);
3417 Tcl_AppendResult(interp,
"wrong number of arguments (",
3418 buf,
" for 1)", (
char *)
NULL);
3426 #if TCL_MAJOR_VERSION >= 8 3431 thr_crit_bup = rb_thread_critical;
3432 rb_thread_critical =
Qtrue;
3434 str = Tcl_GetStringFromObj(
argv[1], &
len);
3437 memcpy(arg, str,
len);
3440 rb_thread_critical = thr_crit_bup;
3448 DUMP2(
"rb_eval_string(%s)", arg);
3452 #if TCL_MAJOR_VERSION >= 8 3469 DUMP1(
"call ip_ruby_cmd_core");
3470 thr_crit_bup = rb_thread_critical;
3471 rb_thread_critical =
Qfalse;
3473 DUMP2(
"rb_apply return:%lx", ret);
3474 rb_thread_critical = thr_crit_bup;
3475 DUMP1(
"finish ip_ruby_cmd_core");
3480 #define SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER 1 3492 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER 3514 if (*head ==
':') head += 2;
3539 #if !SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER 3543 if (str[0] ==
':' || (
'A' <= str[0] && str[0] <=
'Z')) {
3545 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER 3551 }
else if (str[0] ==
'$') {
3563 memcpy(
buf + 1, str,
len);
3575 #if TCL_MAJOR_VERSION >= 8 3577 ClientData clientData;
3583 ClientData clientData;
3600 if (interp == (Tcl_Interp*)
NULL) {
3610 Tcl_ResetResult(interp);
3611 Tcl_AppendResult(interp,
"too few arguments", (
char *)
NULL);
3619 thr_crit_bup = rb_thread_critical;
3620 rb_thread_critical =
Qtrue;
3624 #if TCL_MAJOR_VERSION >= 8 3625 str = Tcl_GetStringFromObj(
argv[1], &
len);
3629 DUMP2(
"receiver:%s",str);
3635 "unknown class/module/global-variable '%s'", str);
3637 Tcl_ResetResult(interp);
3638 Tcl_AppendResult(interp,
"unknown class/module/global-variable '",
3639 str,
"'", (
char *)
NULL);
3648 #if TCL_MAJOR_VERSION >= 8 3649 str = Tcl_GetStringFromObj(
argv[2], &
len);
3659 #if TCL_MAJOR_VERSION >= 8 3660 str = Tcl_GetStringFromObj(
argv[
i], &
len);
3666 DUMP2(
"arg:%s",str);
3667 #ifndef HAVE_STRUCT_RARRAY_LEN 3675 rb_thread_critical = thr_crit_bup;
3699 #if TCL_MAJOR_VERSION >= 8 3700 #ifdef HAVE_PROTOTYPES 3701 ip_InterpExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3704 ip_InterpExitObjCmd(clientData, interp,
argc,
argv)
3705 ClientData clientData;
3711 #ifdef HAVE_PROTOTYPES 3716 ClientData clientData;
3723 DUMP1(
"start ip_InterpExitCommand");
3724 if (interp != (Tcl_Interp*)
NULL 3725 && !Tcl_InterpDeleted(interp)
3727 && !ip_null_namespace(interp)
3730 Tcl_ResetResult(interp);
3733 if (!Tcl_InterpDeleted(interp)) {
3736 Tcl_DeleteInterp(interp);
3737 Tcl_Release(interp);
3744 #if TCL_MAJOR_VERSION >= 8 3745 #ifdef HAVE_PROTOTYPES 3746 ip_RubyExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3749 ip_RubyExitObjCmd(clientData, interp,
argc,
argv)
3750 ClientData clientData;
3756 #ifdef HAVE_PROTOTYPES 3761 ClientData clientData;
3770 #if TCL_MAJOR_VERSION < 8 3775 DUMP1(
"start ip_RubyExitCommand");
3777 #if TCL_MAJOR_VERSION >= 8 3779 cmd = Tcl_GetStringFromObj(
argv[0], (
int*)
NULL);
3782 if (argc < 1 || argc > 2) {
3784 Tcl_AppendResult(interp,
3785 "wrong number of arguments: should be \"",
3786 cmd,
" ?returnCode?\"", (
char *)
NULL);
3790 if (interp == (Tcl_Interp*)
NULL)
return TCL_OK;
3792 Tcl_ResetResult(interp);
3795 if (!Tcl_InterpDeleted(interp)) {
3798 Tcl_DeleteInterp(interp);
3799 Tcl_Release(interp);
3807 Tcl_AppendResult(interp,
3808 "fail to call \"", cmd,
"\"", (
char *)
NULL);
3817 #if TCL_MAJOR_VERSION >= 8 3818 if (Tcl_GetIntFromObj(interp,
argv[1], &
state) == TCL_ERROR) {
3822 param = Tcl_GetStringFromObj(
argv[1], (
int*)
NULL);
3826 Tcl_AppendResult(interp,
3827 "expected integer but got \"",
3835 Tcl_AppendResult(interp,
"fail to call \"", cmd,
" ",
3836 param,
"\"", (
char *)
NULL);
3846 Tcl_AppendResult(interp,
3847 "wrong number of arguments: should be \"",
3848 cmd,
" ?returnCode?\"", (
char *)
NULL);
3861 #if TCL_MAJOR_VERSION >= 8 3862 static int ip_rbUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
3863 Tcl_Obj *
CONST []));
3865 ip_rbUpdateObjCmd(clientData, interp, objc, objv)
3866 ClientData clientData;
3869 Tcl_Obj *
CONST objv[];
3874 ClientData clientData;
3883 static CONST char *updateOptions[] = {
"idletasks", (
char *)
NULL};
3884 enum updateOptions {REGEXP_IDLETASKS};
3886 DUMP1(
"Ruby's 'update' is called");
3887 if (interp == (Tcl_Interp*)
NULL) {
3892 #ifdef HAVE_NATIVETHREAD 3893 #ifndef RUBY_USE_NATIVE_THREAD 3895 rb_bug(
"cross-thread violation on ip_ruby_eval()");
3900 Tcl_ResetResult(interp);
3903 flags = TCL_DONT_WAIT;
3905 }
else if (objc == 2) {
3906 #if TCL_MAJOR_VERSION >= 8 3907 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
3908 "option", 0, &optionIndex) != TCL_OK) {
3911 switch ((
enum updateOptions) optionIndex) {
3912 case REGEXP_IDLETASKS: {
3913 flags = TCL_IDLE_EVENTS;
3917 rb_bug(
"ip_rbUpdateObjCmd: bad option index to UpdateOptions");
3921 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
3922 Tcl_AppendResult(interp,
"bad option \"", objv[1],
3923 "\": must be idletasks", (
char *)
NULL);
3926 flags = TCL_IDLE_EVENTS;
3929 #ifdef Tcl_WrongNumArgs 3930 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
3932 # if TCL_MAJOR_VERSION >= 8 3934 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
3935 Tcl_GetStringFromObj(objv[0], &dummy),
3939 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
3940 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
3946 Tcl_Preserve(interp);
3954 Tcl_Release(interp);
3971 if (rb_trap_pending) {
3973 Tcl_Release(interp);
3984 Tcl_ResetResult(interp);
3985 Tcl_Release(interp);
3987 DUMP1(
"finish Ruby's 'update'");
4003 ClientData clientData;
4007 DUMP1(
"threadUpdateProc is called");
4014 #if TCL_MAJOR_VERSION >= 8 4015 static int ip_rb_threadUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
4016 Tcl_Obj *
CONST []));
4018 ip_rb_threadUpdateObjCmd(clientData, interp, objc, objv)
4019 ClientData clientData;
4022 Tcl_Obj *
CONST objv[];
4028 ClientData clientData;
4037 static CONST char *updateOptions[] = {
"idletasks", (
char *)
NULL};
4038 enum updateOptions {REGEXP_IDLETASKS};
4042 DUMP1(
"Ruby's 'thread_update' is called");
4043 if (interp == (Tcl_Interp*)
NULL) {
4048 #ifdef HAVE_NATIVETHREAD 4049 #ifndef RUBY_USE_NATIVE_THREAD 4051 rb_bug(
"cross-thread violation on ip_rb_threadUpdateCommand()");
4058 #if TCL_MAJOR_VERSION >= 8 4059 DUMP1(
"call ip_rbUpdateObjCmd");
4060 return ip_rbUpdateObjCmd(clientData, interp, objc, objv);
4062 DUMP1(
"call ip_rbUpdateCommand");
4067 DUMP1(
"start Ruby's 'thread_update' body");
4069 Tcl_ResetResult(interp);
4072 flags = TCL_DONT_WAIT;
4074 }
else if (objc == 2) {
4075 #if TCL_MAJOR_VERSION >= 8 4076 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
4077 "option", 0, &optionIndex) != TCL_OK) {
4080 switch ((
enum updateOptions) optionIndex) {
4081 case REGEXP_IDLETASKS: {
4082 flags = TCL_IDLE_EVENTS;
4086 rb_bug(
"ip_rb_threadUpdateObjCmd: bad option index to UpdateOptions");
4090 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
4091 Tcl_AppendResult(interp,
"bad option \"", objv[1],
4092 "\": must be idletasks", (
char *)
NULL);
4095 flags = TCL_IDLE_EVENTS;
4098 #ifdef Tcl_WrongNumArgs 4099 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
4101 # if TCL_MAJOR_VERSION >= 8 4103 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4104 Tcl_GetStringFromObj(objv[0], &dummy),
4108 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4109 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
4115 DUMP1(
"pass argument check");
4120 Tcl_Preserve((ClientData)param);
4122 param->thread = current_thread;
4125 DUMP1(
"set idle proc");
4131 while(!param->done) {
4132 DUMP1(
"wait for complete idle proc");
4142 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
4145 Tcl_Release((ClientData)param);
4148 ckfree((
char *)param);
4152 DUMP1(
"finish Ruby's 'thread_update'");
4160 #if TCL_MAJOR_VERSION >= 8 4161 static int ip_rbVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4162 Tcl_Obj *
CONST []));
4163 static int ip_rb_threadVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4164 Tcl_Obj *
CONST []));
4165 static int ip_rbTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4166 Tcl_Obj *
CONST []));
4167 static int ip_rb_threadTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4168 Tcl_Obj *
CONST []));
4178 #if TCL_MAJOR_VERSION >= 8 4183 ClientData clientData;
4189 static char *
VwaitVarProc _((ClientData, Tcl_Interp *,
char *,
char *,
int));
4192 ClientData clientData;
4199 int *donePtr = (
int *) clientData;
4202 return (
char *)
NULL;
4205 #if TCL_MAJOR_VERSION >= 8 4207 ip_rbVwaitObjCmd(clientData, interp, objc, objv)
4208 ClientData clientData;
4211 Tcl_Obj *
CONST objv[];
4215 ClientData clientData;
4221 int ret,
done, foundEvent;
4226 DUMP1(
"Ruby's 'vwait' is called");
4227 if (interp == (Tcl_Interp*)
NULL) {
4237 #if TCL_MAJOR_VERSION >= 8 4238 DUMP1(
"call ip_rb_threadVwaitObjCmd");
4239 return ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv);
4241 DUMP1(
"call ip_rb_threadVwaitCommand");
4247 Tcl_Preserve(interp);
4248 #ifdef HAVE_NATIVETHREAD 4249 #ifndef RUBY_USE_NATIVE_THREAD 4251 rb_bug(
"cross-thread violation on ip_rbVwaitCommand()");
4256 Tcl_ResetResult(interp);
4259 #ifdef Tcl_WrongNumArgs 4260 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4262 thr_crit_bup = rb_thread_critical;
4263 rb_thread_critical =
Qtrue;
4265 #if TCL_MAJOR_VERSION >= 8 4267 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4269 nameString = objv[0];
4271 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4272 nameString,
" name\"", (
char *)
NULL);
4274 rb_thread_critical = thr_crit_bup;
4277 Tcl_Release(interp);
4281 thr_crit_bup = rb_thread_critical;
4282 rb_thread_critical =
Qtrue;
4284 #if TCL_MAJOR_VERSION >= 8 4287 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4289 nameString = objv[1];
4299 ret = Tcl_TraceVar(interp, nameString,
4300 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4303 rb_thread_critical = thr_crit_bup;
4305 if (ret != TCL_OK) {
4306 #if TCL_MAJOR_VERSION >= 8 4309 Tcl_Release(interp);
4318 thr_crit_bup = rb_thread_critical;
4319 rb_thread_critical =
Qtrue;
4321 Tcl_UntraceVar(interp, nameString,
4322 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4325 rb_thread_critical = thr_crit_bup;
4329 #if TCL_MAJOR_VERSION >= 8 4332 Tcl_Release(interp);
4349 if (rb_trap_pending) {
4351 #if TCL_MAJOR_VERSION >= 8 4354 Tcl_Release(interp);
4364 Tcl_ResetResult(interp);
4366 thr_crit_bup = rb_thread_critical;
4367 rb_thread_critical =
Qtrue;
4369 Tcl_AppendResult(interp,
"can't wait for variable \"", nameString,
4370 "\": would wait forever", (
char *)
NULL);
4372 rb_thread_critical = thr_crit_bup;
4374 #if TCL_MAJOR_VERSION >= 8 4377 Tcl_Release(interp);
4381 #if TCL_MAJOR_VERSION >= 8 4384 Tcl_Release(interp);
4392 #if TCL_MAJOR_VERSION >= 8 4397 ClientData clientData;
4404 char *,
char *,
int));
4407 ClientData clientData;
4414 int *donePtr = (
int *) clientData;
4417 return (
char *)
NULL;
4423 ClientData clientData;
4426 int *donePtr = (
int *) clientData;
4428 if (eventPtr->type == VisibilityNotify) {
4431 if (eventPtr->type == DestroyNotify) {
4439 ClientData clientData;
4442 int *donePtr = (
int *) clientData;
4444 if (eventPtr->type == DestroyNotify) {
4449 #if TCL_MAJOR_VERSION >= 8 4451 ip_rbTkWaitObjCmd(clientData, interp, objc, objv)
4452 ClientData clientData;
4455 Tcl_Obj *
CONST objv[];
4459 ClientData clientData;
4465 Tk_Window tkwin = (Tk_Window) clientData;
4468 static CONST char *optionStrings[] = {
"variable",
"visibility",
"window",
4470 enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW };
4475 DUMP1(
"Ruby's 'tkwait' is called");
4476 if (interp == (Tcl_Interp*)
NULL) {
4486 #if TCL_MAJOR_VERSION >= 8 4487 DUMP1(
"call ip_rb_threadTkWaitObjCmd");
4488 return ip_rb_threadTkWaitObjCmd((ClientData)tkwin, interp, objc, objv);
4490 DUMP1(
"call ip_rb_threadTkWaitCommand");
4491 return ip_rb_threadTkWwaitCommand((ClientData)tkwin, interp, objc, objv);
4496 Tcl_Preserve(interp);
4497 Tcl_ResetResult(interp);
4500 #ifdef Tcl_WrongNumArgs 4501 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
4503 thr_crit_bup = rb_thread_critical;
4504 rb_thread_critical =
Qtrue;
4506 #if TCL_MAJOR_VERSION >= 8 4507 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4508 Tcl_GetStringFromObj(objv[0], &dummy),
4509 " variable|visibility|window name\"",
4512 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4513 objv[0],
" variable|visibility|window name\"",
4517 rb_thread_critical = thr_crit_bup;
4520 Tcl_Release(interp);
4524 #if TCL_MAJOR_VERSION >= 8 4525 thr_crit_bup = rb_thread_critical;
4526 rb_thread_critical =
Qtrue;
4535 ret = Tcl_GetIndexFromObj(interp, objv[1],
4536 (
CONST84 char **)optionStrings,
4537 "option", 0, &index);
4539 rb_thread_critical = thr_crit_bup;
4541 if (ret != TCL_OK) {
4542 Tcl_Release(interp);
4548 size_t length =
strlen(objv[1]);
4550 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
4552 index = TKWAIT_VARIABLE;
4553 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
4555 index = TKWAIT_VISIBILITY;
4556 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
4557 index = TKWAIT_WINDOW;
4559 Tcl_AppendResult(interp,
"bad option \"", objv[1],
4560 "\": must be variable, visibility, or window",
4562 Tcl_Release(interp);
4568 thr_crit_bup = rb_thread_critical;
4569 rb_thread_critical =
Qtrue;
4571 #if TCL_MAJOR_VERSION >= 8 4574 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
4576 nameString = objv[2];
4579 rb_thread_critical = thr_crit_bup;
4581 switch ((
enum options) index) {
4582 case TKWAIT_VARIABLE:
4583 thr_crit_bup = rb_thread_critical;
4584 rb_thread_critical =
Qtrue;
4592 ret = Tcl_TraceVar(interp, nameString,
4593 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4596 rb_thread_critical = thr_crit_bup;
4598 if (ret != TCL_OK) {
4599 #if TCL_MAJOR_VERSION >= 8 4602 Tcl_Release(interp);
4610 thr_crit_bup = rb_thread_critical;
4611 rb_thread_critical =
Qtrue;
4613 Tcl_UntraceVar(interp, nameString,
4614 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4617 #if TCL_MAJOR_VERSION >= 8 4621 rb_thread_critical = thr_crit_bup;
4625 Tcl_Release(interp);
4642 if (rb_trap_pending) {
4644 Tcl_Release(interp);
4651 case TKWAIT_VISIBILITY:
4652 thr_crit_bup = rb_thread_critical;
4653 rb_thread_critical =
Qtrue;
4659 window = Tk_NameToWindow(interp, nameString, tkwin);
4662 if (window ==
NULL) {
4663 Tcl_AppendResult(interp,
": tkwait: ",
4664 "no main-window (not Tk application?)",
4666 rb_thread_critical = thr_crit_bup;
4667 #if TCL_MAJOR_VERSION >= 8 4670 Tcl_Release(interp);
4674 Tk_CreateEventHandler(window,
4675 VisibilityChangeMask|StructureNotifyMask,
4678 rb_thread_critical = thr_crit_bup;
4686 #if TCL_MAJOR_VERSION >= 8 4689 Tcl_Release(interp);
4706 if (rb_trap_pending) {
4708 #if TCL_MAJOR_VERSION >= 8 4711 Tcl_Release(interp);
4721 thr_crit_bup = rb_thread_critical;
4722 rb_thread_critical =
Qtrue;
4724 Tcl_ResetResult(interp);
4725 Tcl_AppendResult(interp,
"window \"", nameString,
4726 "\" was deleted before its visibility changed",
4729 rb_thread_critical = thr_crit_bup;
4731 #if TCL_MAJOR_VERSION >= 8 4734 Tcl_Release(interp);
4738 thr_crit_bup = rb_thread_critical;
4739 rb_thread_critical =
Qtrue;
4741 #if TCL_MAJOR_VERSION >= 8 4745 Tk_DeleteEventHandler(window,
4746 VisibilityChangeMask|StructureNotifyMask,
4749 rb_thread_critical = thr_crit_bup;
4754 thr_crit_bup = rb_thread_critical;
4755 rb_thread_critical =
Qtrue;
4761 window = Tk_NameToWindow(interp, nameString, tkwin);
4764 #if TCL_MAJOR_VERSION >= 8 4768 if (window ==
NULL) {
4769 Tcl_AppendResult(interp,
": tkwait: ",
4770 "no main-window (not Tk application?)",
4772 rb_thread_critical = thr_crit_bup;
4773 Tcl_Release(interp);
4777 Tk_CreateEventHandler(window, StructureNotifyMask,
4780 rb_thread_critical = thr_crit_bup;
4788 Tcl_Release(interp);
4805 if (rb_trap_pending) {
4807 Tcl_Release(interp);
4824 Tcl_ResetResult(interp);
4825 Tcl_Release(interp);
4837 #if TCL_MAJOR_VERSION >= 8 4842 ClientData clientData;
4849 char *,
char *,
int));
4852 ClientData clientData;
4861 if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
4868 return (
char *)
NULL;
4871 #define TKWAIT_MODE_VISIBILITY 1 4872 #define TKWAIT_MODE_DESTROY 2 4877 ClientData clientData;
4882 if (eventPtr->type == VisibilityNotify) {
4885 if (eventPtr->type == DestroyNotify) {
4894 ClientData clientData;
4899 if (eventPtr->type == DestroyNotify) {
4905 #if TCL_MAJOR_VERSION >= 8 4907 ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv)
4908 ClientData clientData;
4911 Tcl_Obj *
CONST objv[];
4915 ClientData clientData;
4928 DUMP1(
"Ruby's 'thread_vwait' is called");
4929 if (interp == (Tcl_Interp*)
NULL) {
4936 #if TCL_MAJOR_VERSION >= 8 4937 DUMP1(
"call ip_rbVwaitObjCmd");
4938 return ip_rbVwaitObjCmd(clientData, interp, objc, objv);
4940 DUMP1(
"call ip_rbVwaitCommand");
4945 Tcl_Preserve(interp);
4946 Tcl_ResetResult(interp);
4949 #ifdef Tcl_WrongNumArgs 4950 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4952 thr_crit_bup = rb_thread_critical;
4953 rb_thread_critical =
Qtrue;
4955 #if TCL_MAJOR_VERSION >= 8 4957 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4959 nameString = objv[0];
4961 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4962 nameString,
" name\"", (
char *)
NULL);
4964 rb_thread_critical = thr_crit_bup;
4967 Tcl_Release(interp);
4971 #if TCL_MAJOR_VERSION >= 8 4974 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4976 nameString = objv[1];
4978 thr_crit_bup = rb_thread_critical;
4979 rb_thread_critical =
Qtrue;
4984 Tcl_Preserve((ClientData)param);
4986 param->thread = current_thread;
4996 ret = Tcl_TraceVar(interp, nameString,
4997 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5000 rb_thread_critical = thr_crit_bup;
5002 if (ret != TCL_OK) {
5004 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5007 Tcl_Release((ClientData)param);
5010 ckfree((
char *)param);
5014 #if TCL_MAJOR_VERSION >= 8 5017 Tcl_Release(interp);
5024 while(!param->done) {
5033 thr_crit_bup = rb_thread_critical;
5034 rb_thread_critical =
Qtrue;
5036 if (param->done > 0) {
5037 Tcl_UntraceVar(interp, nameString,
5038 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5043 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5046 Tcl_Release((ClientData)param);
5049 ckfree((
char *)param);
5053 rb_thread_critical = thr_crit_bup;
5055 #if TCL_MAJOR_VERSION >= 8 5058 Tcl_Release(interp);
5062 #if TCL_MAJOR_VERSION >= 8 5064 ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv)
5065 ClientData clientData;
5068 Tcl_Obj *
CONST objv[];
5072 ClientData clientData;
5079 Tk_Window tkwin = (Tk_Window) clientData;
5082 static CONST char *optionStrings[] = {
"variable",
"visibility",
"window",
5084 enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW };
5091 DUMP1(
"Ruby's 'thread_tkwait' is called");
5092 if (interp == (Tcl_Interp*)
NULL) {
5099 #if TCL_MAJOR_VERSION >= 8 5100 DUMP1(
"call ip_rbTkWaitObjCmd");
5102 DUMP2(
"current_thread %lx", current_thread);
5103 return ip_rbTkWaitObjCmd(clientData, interp, objc, objv);
5105 DUMP1(
"call rb_VwaitCommand");
5110 Tcl_Preserve(interp);
5111 Tcl_Preserve(tkwin);
5113 Tcl_ResetResult(interp);
5116 #ifdef Tcl_WrongNumArgs 5117 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
5119 thr_crit_bup = rb_thread_critical;
5120 rb_thread_critical =
Qtrue;
5122 #if TCL_MAJOR_VERSION >= 8 5123 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
5124 Tcl_GetStringFromObj(objv[0], &dummy),
5125 " variable|visibility|window name\"",
5128 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
5129 objv[0],
" variable|visibility|window name\"",
5133 rb_thread_critical = thr_crit_bup;
5137 Tcl_Release(interp);
5141 #if TCL_MAJOR_VERSION >= 8 5142 thr_crit_bup = rb_thread_critical;
5143 rb_thread_critical =
Qtrue;
5151 ret = Tcl_GetIndexFromObj(interp, objv[1],
5152 (
CONST84 char **)optionStrings,
5153 "option", 0, &index);
5155 rb_thread_critical = thr_crit_bup;
5157 if (ret != TCL_OK) {
5159 Tcl_Release(interp);
5165 size_t length =
strlen(objv[1]);
5167 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
5169 index = TKWAIT_VARIABLE;
5170 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
5172 index = TKWAIT_VISIBILITY;
5173 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
5174 index = TKWAIT_WINDOW;
5176 Tcl_AppendResult(interp,
"bad option \"", objv[1],
5177 "\": must be variable, visibility, or window",
5180 Tcl_Release(interp);
5186 thr_crit_bup = rb_thread_critical;
5187 rb_thread_critical =
Qtrue;
5189 #if TCL_MAJOR_VERSION >= 8 5192 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
5194 nameString = objv[2];
5200 Tcl_Preserve((ClientData)param);
5202 param->thread = current_thread;
5205 rb_thread_critical = thr_crit_bup;
5207 switch ((
enum options) index) {
5208 case TKWAIT_VARIABLE:
5209 thr_crit_bup = rb_thread_critical;
5210 rb_thread_critical =
Qtrue;
5218 ret = Tcl_TraceVar(interp, nameString,
5219 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5222 rb_thread_critical = thr_crit_bup;
5224 if (ret != TCL_OK) {
5226 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5232 ckfree((
char *)param);
5236 #if TCL_MAJOR_VERSION >= 8 5241 Tcl_Release(interp);
5248 while(!param->done) {
5257 thr_crit_bup = rb_thread_critical;
5258 rb_thread_critical =
Qtrue;
5260 if (param->done > 0) {
5261 Tcl_UntraceVar(interp, nameString,
5262 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5266 #if TCL_MAJOR_VERSION >= 8 5270 rb_thread_critical = thr_crit_bup;
5274 case TKWAIT_VISIBILITY:
5275 thr_crit_bup = rb_thread_critical;
5276 rb_thread_critical =
Qtrue;
5282 window = Tk_NameToWindow(interp, nameString, tkwin);
5290 if (Tcl_GetCommandInfo(interp,
".", &info)) {
5291 window = Tk_NameToWindow(interp, nameString, tkwin);
5298 if (window ==
NULL) {
5299 Tcl_AppendResult(interp,
": thread_tkwait: ",
5300 "no main-window (not Tk application?)",
5303 rb_thread_critical = thr_crit_bup;
5306 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5312 ckfree((
char *)param);
5316 #if TCL_MAJOR_VERSION >= 8 5320 Tcl_Release(interp);
5323 Tcl_Preserve(window);
5325 Tk_CreateEventHandler(window,
5326 VisibilityChangeMask|StructureNotifyMask,
5329 rb_thread_critical = thr_crit_bup;
5344 thr_crit_bup = rb_thread_critical;
5345 rb_thread_critical =
Qtrue;
5349 Tk_DeleteEventHandler(window,
5350 VisibilityChangeMask|StructureNotifyMask,
5352 (ClientData) param);
5355 if (param->done != 1) {
5356 Tcl_ResetResult(interp);
5357 Tcl_AppendResult(interp,
"window \"", nameString,
5358 "\" was deleted before its visibility changed",
5361 rb_thread_critical = thr_crit_bup;
5363 Tcl_Release(window);
5366 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5372 ckfree((
char *)param);
5376 #if TCL_MAJOR_VERSION >= 8 5381 Tcl_Release(interp);
5385 Tcl_Release(window);
5387 #if TCL_MAJOR_VERSION >= 8 5391 rb_thread_critical = thr_crit_bup;
5396 thr_crit_bup = rb_thread_critical;
5397 rb_thread_critical =
Qtrue;
5403 window = Tk_NameToWindow(interp, nameString, tkwin);
5411 if (Tcl_GetCommandInfo(interp,
".", &info)) {
5412 window = Tk_NameToWindow(interp, nameString, tkwin);
5419 #if TCL_MAJOR_VERSION >= 8 5423 if (window ==
NULL) {
5424 Tcl_AppendResult(interp,
": thread_tkwait: ",
5425 "no main-window (not Tk application?)",
5428 rb_thread_critical = thr_crit_bup;
5431 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5437 ckfree((
char *)param);
5442 Tcl_Release(interp);
5446 Tcl_Preserve(window);
5448 Tk_CreateEventHandler(window, StructureNotifyMask,
5451 rb_thread_critical = thr_crit_bup;
5465 Tcl_Release(window);
5481 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5484 Tcl_Release((ClientData)param);
5487 ckfree((
char *)param);
5496 Tcl_ResetResult(interp);
5499 Tcl_Release(interp);
5535 #if TCL_MAJOR_VERSION >= 8 5542 Tcl_Obj *slave_list, *elem;
5546 DUMP1(
"delete slaves");
5547 thr_crit_bup = rb_thread_critical;
5548 rb_thread_critical =
Qtrue;
5550 if (!Tcl_InterpDeleted(ip) &&
Tcl_Eval(ip,
"interp slaves") == TCL_OK) {
5551 slave_list = Tcl_GetObjResult(ip);
5554 if (Tcl_ListObjLength((Tcl_Interp*)
NULL, slave_list, &
len) == TCL_OK) {
5555 for(
i = 0;
i <
len;
i++) {
5556 Tcl_ListObjIndex((Tcl_Interp*)
NULL, slave_list,
i, &elem);
5558 if (elem == (Tcl_Obj*)
NULL)
continue;
5564 slave_name = Tcl_GetStringFromObj(elem, (
int*)
NULL);
5565 DUMP2(
"delete slave:'%s'", slave_name);
5569 slave = Tcl_GetSlave(ip, slave_name);
5570 if (slave == (Tcl_Interp*)
NULL)
continue;
5572 if (!Tcl_InterpDeleted(slave)) {
5576 Tcl_DeleteInterp(slave);
5585 rb_thread_critical = thr_crit_bup;
5600 DUMP1(
"delete slaves");
5601 thr_crit_bup = rb_thread_critical;
5602 rb_thread_critical =
Qtrue;
5604 if (!Tcl_InterpDeleted(ip) &&
Tcl_Eval(ip,
"interp slaves") == TCL_OK) {
5605 slave_list = ip->result;
5606 if (Tcl_SplitList((Tcl_Interp*)
NULL,
5607 slave_list, &
argc, &
argv) == TCL_OK) {
5609 slave_name =
argv[
i];
5611 DUMP2(
"delete slave:'%s'", slave_name);
5613 slave = Tcl_GetSlave(ip, slave_name);
5614 if (slave == (Tcl_Interp*)
NULL)
continue;
5616 if (!Tcl_InterpDeleted(slave)) {
5620 Tcl_DeleteInterp(slave);
5626 rb_thread_critical = thr_crit_bup;
5633 #ifdef HAVE_PROTOTYPES 5644 #if TCL_MAJOR_VERSION >= 8 5645 #ifdef HAVE_PROTOTYPES 5646 ip_null_proc(ClientData clientData, Tcl_Interp *interp,
5650 ClientData clientData;
5656 #ifdef HAVE_PROTOTYPES 5660 ClientData clientData;
5667 Tcl_ResetResult(interp);
5678 VALUE rb_debug_bup, rb_verbose_bup;
5686 DUMP1(
"start ip_finalize");
5688 if (ip == (Tcl_Interp*)
NULL) {
5689 DUMP1(
"ip is NULL");
5693 if (Tcl_InterpDeleted(ip)) {
5694 DUMP2(
"ip(%p) is already deleted", ip);
5698 #if TCL_NAMESPACE_DEBUG 5699 if (ip_null_namespace(ip)) {
5700 DUMP2(
"ip(%p) has null namespace", ip);
5705 thr_crit_bup = rb_thread_critical;
5706 rb_thread_critical =
Qtrue;
5722 #if TCL_MAJOR_VERSION >= 8 5724 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
5726 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
5728 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
5731 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
5733 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
5735 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
5747 DUMP1(
"check `destroy'");
5748 if (Tcl_GetCommandInfo(ip,
"destroy", &info)) {
5749 DUMP1(
"call `destroy .'");
5754 DUMP1(
"destroy root widget");
5768 Tk_Window win = Tk_MainWindow(ip);
5770 DUMP1(
"call Tk_DestroyWindow");
5773 if (! (((Tk_FakeWin*)win)->flags & TK_ALREADY_DEAD)) {
5774 Tk_DestroyWindow(win);
5782 DUMP1(
"check `finalize-hook-proc'");
5792 DUMP1(
"check `foreach' & `after'");
5793 if ( Tcl_GetCommandInfo(ip,
"foreach", &info)
5794 && Tcl_GetCommandInfo(ip,
"after", &info) ) {
5795 DUMP1(
"cancel after callbacks");
5798 Tcl_GlobalEval(ip,
"catch {foreach id [after info] {after cancel $id}}");
5805 DUMP1(
"finish ip_finalize");
5808 rb_thread_critical = thr_crit_bup;
5819 DUMP2(
"free Tcl Interp %lx", (
unsigned long)ptr->
ip);
5821 thr_crit_bup = rb_thread_critical;
5822 rb_thread_critical =
Qtrue;
5824 if ( ptr->
ip != (Tcl_Interp*)
NULL 5825 && !Tcl_InterpDeleted(ptr->
ip)
5826 && Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL 5827 && !Tcl_InterpDeleted(Tcl_GetMaster(ptr->
ip)) ) {
5828 DUMP2(
"parent IP(%lx) is not deleted",
5829 (
unsigned long)Tcl_GetMaster(ptr->
ip));
5830 DUMP2(
"slave IP(%lx) should not be deleted",
5831 (
unsigned long)ptr->
ip);
5834 rb_thread_critical = thr_crit_bup;
5838 if (ptr->
ip == (Tcl_Interp*)
NULL) {
5839 DUMP1(
"ip_free is called for deleted IP");
5842 rb_thread_critical = thr_crit_bup;
5846 if (!Tcl_InterpDeleted(ptr->
ip)) {
5849 Tcl_DeleteInterp(ptr->
ip);
5850 Tcl_Release(ptr->
ip);
5853 ptr->
ip = (Tcl_Interp*)
NULL;
5857 rb_thread_critical = thr_crit_bup;
5860 DUMP1(
"complete freeing Tcl Interp");
5879 #if TCL_MAJOR_VERSION >= 8 5880 DUMP1(
"Tcl_CreateObjCommand(\"vwait\")");
5881 Tcl_CreateObjCommand(interp,
"vwait", ip_rbVwaitObjCmd,
5882 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
5884 DUMP1(
"Tcl_CreateCommand(\"vwait\")");
5886 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
5890 #if TCL_MAJOR_VERSION >= 8 5891 DUMP1(
"Tcl_CreateObjCommand(\"tkwait\")");
5892 Tcl_CreateObjCommand(interp,
"tkwait", ip_rbTkWaitObjCmd,
5893 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
5895 DUMP1(
"Tcl_CreateCommand(\"tkwait\")");
5897 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
5901 #if TCL_MAJOR_VERSION >= 8 5902 DUMP1(
"Tcl_CreateObjCommand(\"thread_vwait\")");
5903 Tcl_CreateObjCommand(interp,
"thread_vwait", ip_rb_threadVwaitObjCmd,
5904 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
5906 DUMP1(
"Tcl_CreateCommand(\"thread_vwait\")");
5908 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
5912 #if TCL_MAJOR_VERSION >= 8 5913 DUMP1(
"Tcl_CreateObjCommand(\"thread_tkwait\")");
5914 Tcl_CreateObjCommand(interp,
"thread_tkwait", ip_rb_threadTkWaitObjCmd,
5915 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
5917 DUMP1(
"Tcl_CreateCommand(\"thread_tkwait\")");
5919 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
5923 #if TCL_MAJOR_VERSION >= 8 5924 DUMP1(
"Tcl_CreateObjCommand(\"update\")");
5925 Tcl_CreateObjCommand(interp,
"update", ip_rbUpdateObjCmd,
5926 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
5928 DUMP1(
"Tcl_CreateCommand(\"update\")");
5930 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
5934 #if TCL_MAJOR_VERSION >= 8 5935 DUMP1(
"Tcl_CreateObjCommand(\"thread_update\")");
5936 Tcl_CreateObjCommand(interp,
"thread_update", ip_rb_threadUpdateObjCmd,
5937 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
5939 DUMP1(
"Tcl_CreateCommand(\"thread_update\")");
5941 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
5946 #if TCL_MAJOR_VERSION >= 8 5948 ip_rb_replaceSlaveTkCmdsObjCmd(clientData, interp, objc, objv)
5949 ClientData clientData;
5952 Tcl_Obj *
CONST objv[];
5956 ClientData clientData;
5967 #ifdef Tcl_WrongNumArgs 5968 Tcl_WrongNumArgs(interp, 1, objv,
"slave_name");
5971 #if TCL_MAJOR_VERSION >= 8 5972 nameString = Tcl_GetStringFromObj(objv[0], (
int*)
NULL);
5974 nameString = objv[0];
5976 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
5977 nameString,
" slave_name\"", (
char *)
NULL);
5981 #if TCL_MAJOR_VERSION >= 8 5982 slave_name = Tcl_GetStringFromObj(objv[1], (
int*)
NULL);
5984 slave_name = objv[1];
5987 slave = Tcl_GetSlave(interp, slave_name);
5988 if (slave ==
NULL) {
5989 Tcl_AppendResult(interp,
"cannot find slave \"",
5990 slave_name,
"\"", (
char *)
NULL);
5993 mainWin = Tk_MainWindow(slave);
5996 #if TCL_MAJOR_VERSION >= 8 5997 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
5998 Tcl_CreateObjCommand(slave,
"exit", ip_InterpExitObjCmd,
5999 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6001 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6003 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6013 #if TCL_MAJOR_VERSION >= 8 6014 static int ip_rbNamespaceObjCmd
_((ClientData, Tcl_Interp *,
int,
6015 Tcl_Obj *
CONST []));
6017 ip_rbNamespaceObjCmd(clientData, interp, objc, objv)
6018 ClientData clientData;
6021 Tcl_Obj *
CONST objv[];
6026 if (!Tcl_GetCommandInfo(interp,
"__orig_namespace_command__", &(info))) {
6027 Tcl_ResetResult(interp);
6028 Tcl_AppendResult(interp,
6029 "invalid command name \"namespace\"", (
char*)
NULL);
6036 if (info.isNativeObjectProc) {
6037 ret = (*(info.objProc))(info.objClientData, interp, objc, objv);
6044 argv = (
char **)ckalloc(
sizeof(
char *) * (objc + 1));
6046 Tcl_Preserve((ClientData)
argv);
6049 for(
i = 0;
i < objc;
i++) {
6051 argv[
i] = Tcl_GetStringFromObj(objv[
i], (
int*)
NULL);
6055 ret = (*(info.proc))(info.clientData, interp,
6059 Tcl_EventuallyFree((ClientData)
argv, TCL_DYNAMIC);
6062 Tcl_Release((ClientData)
argv);
6065 ckfree((
char*)
argv);
6081 #if TCL_MAJOR_VERSION >= 8 6082 Tcl_CmdInfo orig_info;
6084 if (!Tcl_GetCommandInfo(interp,
"namespace", &(orig_info))) {
6088 if (orig_info.isNativeObjectProc) {
6089 Tcl_CreateObjCommand(interp,
"__orig_namespace_command__",
6090 orig_info.objProc, orig_info.objClientData,
6091 orig_info.deleteProc);
6093 Tcl_CreateCommand(interp,
"__orig_namespace_command__",
6094 orig_info.proc, orig_info.clientData,
6095 orig_info.deleteProc);
6098 Tcl_CreateObjCommand(interp,
"namespace", ip_rbNamespaceObjCmd,
6099 (ClientData) 0, (Tcl_CmdDeleteProc *)
NULL);
6106 #ifdef HAVE_PROTOTYPES 6110 ClientData clientData;
6117 DUMP1(
"start ip_CallWhenDeleted");
6118 thr_crit_bup = rb_thread_critical;
6119 rb_thread_critical =
Qtrue;
6123 DUMP1(
"finish ip_CallWhenDeleted");
6124 rb_thread_critical = thr_crit_bup;
6141 Tk_Window mainWin = (Tk_Window)
NULL;
6146 "Cannot create a TclTkIp object at level %d",
6155 #ifdef RUBY_USE_NATIVE_THREAD 6156 ptr->tk_thread_id = 0;
6163 DUMP1(
"Tcl_CreateInterp");
6186 #if TCL_MAJOR_VERSION >= 8 6187 #if TCL_NAMESPACE_DEBUG 6188 DUMP1(
"get current namespace");
6189 if ((ptr->default_ns = Tcl_GetCurrentNamespace(ptr->
ip))
6190 == (Tcl_Namespace*)
NULL) {
6203 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT 6206 # if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84 6208 Tcl_DString encodingName;
6209 Tcl_GetEncodingNameFromEnvironment(&encodingName);
6210 if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(
NULL))) {
6212 Tcl_SetSystemEncoding(
NULL, Tcl_DStringValue(&encodingName));
6214 Tcl_SetVar(
current_interp,
"tclkit_system_encoding", Tcl_DStringValue(&encodingName), 0);
6215 Tcl_DStringFree(&encodingName);
6221 Tcl_Eval(ptr->
ip,
"set argc 0; set argv {}; set argv0 tcltklib.so");
6233 Tcl_Eval(ptr->
ip,
"set argc [llength $argv]");
6237 if (!
NIL_P(argv0)) {
6240 Tcl_SetVar(ptr->
ip,
"argv0",
"ruby", TCL_GLOBAL_ONLY);
6254 #if (defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT) && (!defined KIT_LITE) && (10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION == 85) 6261 Tcl_Eval(ptr->
ip,
"catch {rename ::chan ::_tmp_chan}");
6262 if (Tcl_Init(ptr->
ip) == TCL_ERROR) {
6265 Tcl_Eval(ptr->
ip,
"catch {rename ::_tmp_chan ::chan}");
6267 if (Tcl_Init(ptr->
ip) == TCL_ERROR) {
6292 DUMP1(
"Tcl_StaticPackage(\"Tk\")");
6293 #if TCL_MAJOR_VERSION >= 8 6294 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init, Tk_SafeInit);
6296 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init,
6297 (Tcl_PackageInitProc *)
NULL);
6300 #ifdef RUBY_USE_NATIVE_THREAD 6302 ptr->tk_thread_id = Tcl_GetCurrentThread();
6305 mainWin = Tk_MainWindow(ptr->
ip);
6306 Tk_Preserve((ClientData)mainWin);
6310 #if TCL_MAJOR_VERSION >= 8 6311 DUMP1(
"Tcl_CreateObjCommand(\"ruby\")");
6313 (Tcl_CmdDeleteProc *)
NULL);
6314 DUMP1(
"Tcl_CreateObjCommand(\"ruby_eval\")");
6316 (Tcl_CmdDeleteProc *)
NULL);
6317 DUMP1(
"Tcl_CreateObjCommand(\"ruby_cmd\")");
6319 (Tcl_CmdDeleteProc *)
NULL);
6321 DUMP1(
"Tcl_CreateCommand(\"ruby\")");
6323 (Tcl_CmdDeleteProc *)
NULL);
6324 DUMP1(
"Tcl_CreateCommand(\"ruby_eval\")");
6326 (Tcl_CmdDeleteProc *)
NULL);
6327 DUMP1(
"Tcl_CreateCommand(\"ruby_cmd\")");
6329 (Tcl_CmdDeleteProc *)
NULL);
6333 #if TCL_MAJOR_VERSION >= 8 6334 DUMP1(
"Tcl_CreateObjCommand(\"interp_exit\")");
6335 Tcl_CreateObjCommand(ptr->
ip,
"interp_exit", ip_InterpExitObjCmd,
6336 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6337 DUMP1(
"Tcl_CreateObjCommand(\"ruby_exit\")");
6338 Tcl_CreateObjCommand(ptr->
ip,
"ruby_exit", ip_RubyExitObjCmd,
6339 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6340 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6341 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6342 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6344 DUMP1(
"Tcl_CreateCommand(\"interp_exit\")");
6346 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6347 DUMP1(
"Tcl_CreateCommand(\"ruby_exit\")");
6349 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6350 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6352 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6362 #if TCL_MAJOR_VERSION >= 8 6363 Tcl_CreateObjCommand(ptr->
ip,
"__replace_slave_tk_commands__",
6364 ip_rb_replaceSlaveTkCmdsObjCmd,
6365 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
6367 Tcl_CreateCommand(ptr->
ip,
"__replace_slave_tk_commands__",
6369 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
6375 if (mainWin != (Tk_Window)
NULL) {
6376 Tk_Release((ClientData)mainWin);
6400 "deleted master cannot create a new slave");
6406 if (Tcl_IsSafe(master->
ip) == 1) {
6408 }
else if (safemode ==
Qfalse ||
NIL_P(safemode)) {
6415 thr_crit_bup = rb_thread_critical;
6416 rb_thread_critical =
Qtrue;
6420 if (
RTEST(with_tk)) {
6425 rb_thread_critical = thr_crit_bup;
6433 #ifdef RUBY_USE_NATIVE_THREAD 6435 slave->tk_thread_id = master->tk_thread_id;
6443 rb_thread_critical = thr_crit_bup;
6445 "fail to create the new slave interpreter");
6447 #if TCL_MAJOR_VERSION >= 8 6448 #if TCL_NAMESPACE_DEBUG 6449 slave->default_ns = Tcl_GetCurrentNamespace(slave->
ip);
6459 #if TCL_MAJOR_VERSION >= 8 6460 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6461 Tcl_CreateObjCommand(slave->
ip,
"exit", ip_InterpExitObjCmd,
6462 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6464 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6466 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6476 #if TCL_MAJOR_VERSION >= 8 6477 Tcl_CreateObjCommand(slave->
ip,
"__replace_slave_tk_commands__",
6478 ip_rb_replaceSlaveTkCmdsObjCmd,
6479 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
6481 Tcl_CreateCommand(slave->
ip,
"__replace_slave_tk_commands__",
6483 (ClientData)
NULL, (Tcl_CmdDeleteProc *)
NULL);
6489 rb_thread_critical = thr_crit_bup;
6508 "deleted master cannot create a new slave interpreter");
6515 if (Tcl_IsSafe(master->
ip) != 1
6522 callargv[1] = safemode;
6546 #if defined(MAC_TCL) || defined(__WIN32__) 6547 #if TCL_MAJOR_VERSION < 8 \ 6548 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) \ 6549 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \ 6550 && (TCL_RELEASE_LEVEL == TCL_ALPHA_RELEASE \ 6551 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \ 6552 && TCL_RELEASE_SERIAL < 2) ) ) 6553 EXTERN void TkConsoleCreate
_((
void));
6555 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \ 6556 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \ 6557 && TCL_RELEASE_SERIAL == 0) \ 6558 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \ 6559 && TCL_RELEASE_SERIAL >= 2) ) 6560 EXTERN void TkConsoleCreate_
_((
void));
6575 if (Tcl_GetVar(ptr->
ip,
"tcl_interactive",TCL_GLOBAL_ONLY) == (
char*)
NULL) {
6576 Tcl_SetVar(ptr->
ip,
"tcl_interactive",
"0", TCL_GLOBAL_ONLY);
6579 #if TCL_MAJOR_VERSION > 8 \ 6580 || (TCL_MAJOR_VERSION == 8 \ 6581 && (TCL_MINOR_VERSION > 1 \ 6582 || (TCL_MINOR_VERSION == 1 \ 6583 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \ 6584 && TCL_RELEASE_SERIAL >= 1) ) ) 6585 Tk_InitConsoleChannels(ptr->
ip);
6587 if (Tk_CreateConsoleWindow(ptr->
ip) != TCL_OK) {
6591 #if defined(MAC_TCL) || defined(__WIN32__) 6592 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \ 6593 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE && TCL_RELEASE_SERIAL == 0) \ 6594 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE && TCL_RELEASE_SERIAL >= 2) ) 6600 if (TkConsoleInit(ptr->
ip) != TCL_OK) {
6640 if (Tcl_MakeSafe(ptr->
ip) == TCL_ERROR) {
6651 #if TCL_MAJOR_VERSION >= 8 6652 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6653 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6654 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6656 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6658 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6690 if (Tcl_IsSafe(ptr->
ip)) {
6731 if (Tcl_IsSafe(ptr->
ip)) {
6733 "insecure operation on a safe interpreter");
6746 #if TCL_MAJOR_VERSION >= 8 6747 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6748 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6749 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6751 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6753 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6759 #if TCL_MAJOR_VERSION >= 8 6760 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6761 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6762 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6764 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6766 (ClientData)mainWin, (Tcl_CmdDeleteProc *)
NULL);
6782 DUMP1(
"delete deleted IP");
6786 thr_crit_bup = rb_thread_critical;
6787 rb_thread_critical =
Qtrue;
6789 DUMP1(
"delete interp");
6790 if (!Tcl_InterpDeleted(ptr->
ip)) {
6791 DUMP1(
"call ip_finalize");
6794 Tcl_DeleteInterp(ptr->
ip);
6795 Tcl_Release(ptr->
ip);
6798 rb_thread_critical = thr_crit_bup;
6816 #if TCL_NAMESPACE_DEBUG 6817 if (rbtk_invalid_namespace(ptr)) {
6850 }
else if (Tk_MainWindow(ptr->
ip) == (Tk_Window)
NULL) {
6866 #if TCL_MAJOR_VERSION >= 8 6868 get_str_from_obj(obj)
6871 int len, binary = 0;
6875 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 6876 s = Tcl_GetStringFromObj(obj, &
len);
6878 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 3 6880 if (Tcl_GetCharLength(obj) != Tcl_UniCharLen(Tcl_GetUnicode(obj))) {
6882 s = (
char *)Tcl_GetByteArrayFromObj(obj, &
len);
6886 s = Tcl_GetStringFromObj(obj, &
len);
6889 if (IS_TCL_BYTEARRAY(obj)) {
6890 s = (
char *)Tcl_GetByteArrayFromObj(obj, &
len);
6893 s = Tcl_GetStringFromObj(obj, &
len);
6900 #ifdef HAVE_RUBY_ENCODING_H 6904 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) 6906 #ifdef HAVE_RUBY_ENCODING_H 6916 get_obj_from_str(str)
6921 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 6922 return Tcl_NewStringObj((
char*)s,
RSTRING_LEN(str));
6930 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LEN(str));
6935 #ifdef HAVE_RUBY_ENCODING_H 6938 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LEN(str));
6942 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LEN(str));
6955 #if TCL_MAJOR_VERSION >= 8 6957 volatile VALUE strval;
6959 retObj = Tcl_GetObjResult(interp);
6961 strval = get_str_from_obj(retObj);
6963 Tcl_ResetResult(interp);
6993 volatile VALUE q_dat;
6997 DUMP2(
"do_call_queue_handler : evPtr = %p", evPtr);
6999 DUMP2(
"added by thread : %lx", thread);
7002 DUMP1(
"processed by another event-loop");
7005 DUMP1(
"process it on current event-loop");
7015 DUMP1(
"caller is not yet ready to receive the result -> pending");
7041 DUMP2(
"call function (for caller thread:%lx)", thread);
7068 DUMP2(
"back to caller (caller thread:%lx)", thread);
7070 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 7076 DUMP1(
"finish back to caller");
7077 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 7081 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7100 int is_tk_evloop_thread;
7102 volatile VALUE ip_obj = obj;
7114 #ifdef RUBY_USE_NATIVE_THREAD 7117 is_tk_evloop_thread = (ptr->tk_thread_id == (Tcl_ThreadId) 0
7118 || ptr->tk_thread_id == Tcl_GetCurrentThread());
7121 is_tk_evloop_thread = (tk_eventloop_thread_id == (Tcl_ThreadId) 0
7122 || tk_eventloop_thread_id == Tcl_GetCurrentThread());
7125 is_tk_evloop_thread = 1;
7128 if (is_tk_evloop_thread
7132 DUMP2(
"tk_funcall from thread:%lx but no eventloop", current);
7134 DUMP2(
"tk_funcall from current eventloop %lx", current);
7143 DUMP2(
"tk_funcall from thread %lx (NOT current eventloop)", current);
7145 thr_crit_bup = rb_thread_critical;
7146 rb_thread_critical =
Qtrue;
7153 Tcl_Preserve((ClientData)temp);
7161 alloc_done = (
int*)ckalloc(
sizeof(
int));
7163 Tcl_Preserve((ClientData)alloc_done);
7171 Tcl_Preserve(callq);
7178 callq->
done = alloc_done;
7189 DUMP1(
"add handler");
7190 #ifdef RUBY_USE_NATIVE_THREAD 7191 if (ptr && ptr->tk_thread_id) {
7194 Tcl_ThreadQueueEvent(ptr->tk_thread_id,
7195 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7196 Tcl_ThreadAlert(ptr->tk_thread_id);
7197 }
else if (tk_eventloop_thread_id) {
7200 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
7201 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7202 Tcl_ThreadAlert(tk_eventloop_thread_id);
7205 Tcl_QueueEvent((Tcl_Event*)callq, TCL_QUEUE_HEAD);
7209 Tcl_QueueEvent((Tcl_Event*)callq, TCL_QUEUE_HEAD);
7212 rb_thread_critical = thr_crit_bup;
7218 DUMP2(
"callq wait for handler (current thread:%lx)", current);
7219 while(*alloc_done >= 0) {
7220 DUMP2(
"*** callq wait for handler (current thread:%lx)", current);
7224 DUMP2(
"*** callq wakeup (current thread:%lx)", current);
7227 DUMP1(
"*** callq lost eventloop thread");
7231 DUMP2(
"back from handler (current thread:%lx)", current);
7236 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7239 Tcl_Release((ClientData)alloc_done);
7242 ckfree((
char*)alloc_done);
7252 Tcl_EventuallyFree((ClientData)
argv, TCL_DYNAMIC);
7255 Tcl_Release((ClientData)
argv);
7257 ckfree((
char*)
argv);
7266 ckfree((
char*)callq);
7272 DUMP1(
"raise exception");
7278 DUMP1(
"exit tk_funcall");
7284 #if TCL_MAJOR_VERSION >= 8 7285 struct call_eval_info {
7291 #ifdef HAVE_PROTOTYPES 7292 call_tcl_eval(
VALUE arg)
7298 struct call_eval_info *
inf = (
struct call_eval_info *)arg;
7300 Tcl_AllowExceptions(
inf->ptr->ip);
7301 inf->ptr->return_value = Tcl_EvalObj(
inf->ptr->ip,
inf->cmd);
7317 #if TCL_MAJOR_VERSION >= 8 7322 thr_crit_bup = rb_thread_critical;
7323 rb_thread_critical =
Qtrue;
7325 cmd = Tcl_NewStringObj(cmd_str, cmd_len);
7331 rb_thread_critical = thr_crit_bup;
7336 struct call_eval_info
inf;
7352 "unknown exception");
7385 "ip_eval_real receives TCL_RETURN");
7388 "ip_eval_real receives TCL_BREAK");
7391 "ip_eval_real receives TCL_CONTINUE");
7398 rb_thread_critical = thr_crit_bup;
7406 Tcl_ResetResult(ptr->
ip);
7408 rb_thread_critical = thr_crit_bup;
7416 rb_thread_critical = thr_crit_bup;
7420 DUMP2(
"Tcl_Eval(%s)", cmd_str);
7445 "ip_eval_real receives TCL_RETURN");
7448 "ip_eval_real receives TCL_BREAK");
7451 "ip_eval_real receives TCL_CONTINUE");
7489 volatile VALUE q_dat;
7493 DUMP2(
"do_eval_queue_handler : evPtr = %p", evPtr);
7495 DUMP2(
"added by thread : %lx", thread);
7498 DUMP1(
"processed by another event-loop");
7501 DUMP1(
"process it on current event-loop");
7511 DUMP1(
"caller is not yet ready to receive the result -> pending");
7530 #ifdef HAVE_NATIVETHREAD 7531 #ifndef RUBY_USE_NATIVE_THREAD 7533 rb_bug(
"cross-thread violation on eval_queue_handler()");
7568 DUMP2(
"back to caller (caller thread:%lx)", thread);
7570 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 7576 DUMP1(
"finish back to caller");
7577 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 7581 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7595 #ifdef RUBY_USE_NATIVE_THREAD 7602 volatile VALUE ip_obj =
self;
7605 Tcl_QueuePosition position;
7608 thr_crit_bup = rb_thread_critical;
7609 rb_thread_critical =
Qtrue;
7611 rb_thread_critical = thr_crit_bup;
7613 #ifdef RUBY_USE_NATIVE_THREAD 7615 DUMP2(
"eval status: ptr->tk_thread_id %p", ptr->tk_thread_id);
7616 DUMP2(
"eval status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7618 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7623 #ifdef RUBY_USE_NATIVE_THREAD
7624 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
7630 DUMP2(
"eval from thread:%lx but no eventloop", current);
7632 DUMP2(
"eval from current eventloop %lx", current);
7641 DUMP2(
"eval from thread %lx (NOT current eventloop)", current);
7643 thr_crit_bup = rb_thread_critical;
7644 rb_thread_critical =
Qtrue;
7648 alloc_done = (
int*)ckalloc(
sizeof(
int));
7650 Tcl_Preserve((ClientData)alloc_done);
7655 eval_str = ckalloc(
sizeof(
char) * (
RSTRING_LEN(str) + 1));
7657 Tcl_Preserve((ClientData)eval_str);
7673 evq->
done = alloc_done;
7674 evq->
str = eval_str;
7682 position = TCL_QUEUE_TAIL;
7685 DUMP1(
"add handler");
7686 #ifdef RUBY_USE_NATIVE_THREAD 7687 if (ptr->tk_thread_id) {
7689 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)evq, position);
7690 Tcl_ThreadAlert(ptr->tk_thread_id);
7691 }
else if (tk_eventloop_thread_id) {
7692 Tcl_ThreadQueueEvent(tk_eventloop_thread_id, (Tcl_Event*)evq, position);
7695 Tcl_ThreadAlert(tk_eventloop_thread_id);
7698 Tcl_QueueEvent((Tcl_Event*)evq, position);
7702 Tcl_QueueEvent((Tcl_Event*)evq, position);
7705 rb_thread_critical = thr_crit_bup;
7711 DUMP2(
"evq wait for handler (current thread:%lx)", current);
7712 while(*alloc_done >= 0) {
7713 DUMP2(
"*** evq wait for handler (current thread:%lx)", current);
7717 DUMP2(
"*** evq wakeup (current thread:%lx)", current);
7720 DUMP1(
"*** evq lost eventloop thread");
7724 DUMP2(
"back from handler (current thread:%lx)", current);
7730 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7733 Tcl_Release((ClientData)alloc_done);
7736 ckfree((
char*)alloc_done);
7740 Tcl_EventuallyFree((ClientData)eval_str, TCL_DYNAMIC);
7743 Tcl_Release((ClientData)eval_str);
7758 DUMP1(
"raise exception");
7774 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6) 7776 "cancel_eval is supported Tcl/Tk8.6 or later.");
7787 return Tcl_CancelEval(
interp, msg_obj, 0, flag);
7809 #ifndef TCL_CANCEL_UNWIND 7810 #define TCL_CANCEL_UNWIND 0x100000 7853 thr_crit_bup = rb_thread_critical;
7854 rb_thread_critical =
Qtrue;
7863 Tcl_ResetResult(ptr->
ip);
7865 #if TCL_MAJOR_VERSION >= 8 7870 Tcl_ResetResult(ptr->
ip);
7877 Tcl_ResetResult(ptr->
ip);
7882 rb_thread_critical = thr_crit_bup;
7890 rb_thread_critical = thr_crit_bup;
7930 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
7943 volatile VALUE str = src;
7947 Tcl_Encoding encoding;
7962 if (
NIL_P(ip_obj)) {
7963 interp = (Tcl_Interp *)
NULL;
7969 interp = (Tcl_Interp *)
NULL;
7975 thr_crit_bup = rb_thread_critical;
7976 rb_thread_critical =
Qtrue;
7978 if (
NIL_P(encodename)) {
7982 #ifdef HAVE_RUBY_ENCODING_H 7988 if (
NIL_P(ip_obj)) {
7989 encoding = (Tcl_Encoding)
NULL;
7993 encoding = (Tcl_Encoding)
NULL;
7999 encoding = (Tcl_Encoding)
NULL;
8001 encoding = Tcl_GetEncoding((Tcl_Interp*)
NULL,
8003 if (encoding == (Tcl_Encoding)
NULL) {
8012 #ifdef HAVE_RUBY_ENCODING_H 8016 rb_thread_critical = thr_crit_bup;
8020 encoding = Tcl_GetEncoding((Tcl_Interp*)
NULL,
8022 if (encoding == (Tcl_Encoding)
NULL) {
8027 encoding = (Tcl_Encoding)
NULL;
8031 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8032 #ifdef HAVE_RUBY_ENCODING_H 8036 rb_thread_critical = thr_crit_bup;
8040 encoding = Tcl_GetEncoding((Tcl_Interp*)
NULL,
RSTRING_PTR(encodename));
8041 if (encoding == (Tcl_Encoding)
NULL) {
8053 rb_thread_critical = thr_crit_bup;
8061 Tcl_DStringInit(&dstr);
8062 Tcl_DStringFree(&dstr);
8064 Tcl_ExternalToUtfDString(encoding,
buf,
RSTRING_LEN(str), &dstr);
8068 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8069 #ifdef HAVE_RUBY_ENCODING_H 8080 Tcl_DStringFree(&dstr);
8085 rb_thread_critical = thr_crit_bup;
8097 VALUE str, encodename;
8111 VALUE str, encodename;
8125 volatile VALUE str = src;
8129 Tcl_Encoding encoding;
8143 if (
NIL_P(ip_obj)) {
8144 interp = (Tcl_Interp *)
NULL;
8146 interp = (Tcl_Interp *)
NULL;
8151 thr_crit_bup = rb_thread_critical;
8152 rb_thread_critical =
Qtrue;
8154 if (
NIL_P(encodename)) {
8162 #ifdef HAVE_RUBY_ENCODING_H 8166 rb_thread_critical = thr_crit_bup;
8169 #ifdef HAVE_RUBY_ENCODING_H 8173 rb_thread_critical = thr_crit_bup;
8179 if (
NIL_P(ip_obj)) {
8180 encoding = (Tcl_Encoding)
NULL;
8184 encoding = (Tcl_Encoding)
NULL;
8190 encoding = (Tcl_Encoding)
NULL;
8192 encoding = Tcl_GetEncoding((Tcl_Interp*)
NULL,
8194 if (encoding == (Tcl_Encoding)
NULL) {
8206 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8214 s = (
char*)Tcl_GetByteArrayFromObj(tclstr, &
len);
8218 #ifdef HAVE_RUBY_ENCODING_H 8223 rb_thread_critical = thr_crit_bup;
8228 encoding = Tcl_GetEncoding((Tcl_Interp*)
NULL,
RSTRING_PTR(encodename));
8229 if (encoding == (Tcl_Encoding)
NULL) {
8243 rb_thread_critical = thr_crit_bup;
8252 Tcl_DStringInit(&dstr);
8253 Tcl_DStringFree(&dstr);
8259 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8260 #ifdef HAVE_RUBY_ENCODING_H 8282 Tcl_DStringFree(&dstr);
8287 rb_thread_critical = thr_crit_bup;
8299 VALUE str, encodename;
8313 VALUE str, encodename;
8328 char *src_buf, *dst_buf, *ptr;
8329 int read_len = 0, dst_len = 0;
8340 thr_crit_bup = rb_thread_critical;
8341 rb_thread_critical =
Qtrue;
8344 src_buf = ckalloc(
sizeof(
char) * (
RSTRING_LEN(str)+1));
8346 Tcl_Preserve((ClientData)src_buf);
8352 dst_buf = ckalloc(
sizeof(
char) * (
RSTRING_LEN(str)+1));
8354 Tcl_Preserve((ClientData)dst_buf);
8359 if (*ptr ==
'\\' && (all_bs || *(ptr + 1) ==
'u')) {
8360 dst_len += Tcl_UtfBackslash(ptr, &read_len, (dst_buf + dst_len));
8363 *(dst_buf + (dst_len++)) = *(ptr++);
8369 #ifdef HAVE_RUBY_ENCODING_H 8375 Tcl_EventuallyFree((ClientData)src_buf, TCL_DYNAMIC);
8378 Tcl_Release((ClientData)src_buf);
8385 Tcl_EventuallyFree((ClientData)dst_buf, TCL_DYNAMIC);
8388 Tcl_Release((ClientData)dst_buf);
8395 rb_thread_critical = thr_crit_bup;
8421 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) 8434 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0) 8438 Tcl_SetSystemEncoding((Tcl_Interp *)
NULL, (
CONST char *)
NULL);
8443 if (Tcl_SetSystemEncoding((Tcl_Interp *)
NULL,
8460 #if TCL_MAJOR_VERSION >= 8 8470 #ifdef HAVE_PROTOTYPES 8479 #if TCL_MAJOR_VERSION >= 8 8485 #if TCL_MAJOR_VERSION >= 8 8486 if (!
inf->cmdinfo.isNativeObjectProc) {
8489 argv = (
char **)ckalloc(
sizeof(
char *)*(
argc+1));
8491 Tcl_Preserve((ClientData)
argv);
8500 Tcl_ResetResult(
inf->ptr->ip);
8503 #if TCL_MAJOR_VERSION >= 8 8504 if (
inf->cmdinfo.isNativeObjectProc) {
8505 inf->ptr->return_value
8506 = (*(
inf->cmdinfo.objProc))(
inf->cmdinfo.objClientData,
8512 #if TCL_MAJOR_VERSION >= 8 8513 inf->ptr->return_value
8514 = (*(
inf->cmdinfo.proc))(
inf->cmdinfo.clientData,
inf->ptr->ip,
8518 Tcl_EventuallyFree((ClientData)
argv, TCL_DYNAMIC);
8521 Tcl_Release((ClientData)
argv);
8524 ckfree((
char*)
argv);
8529 inf->ptr->return_value
8530 = (*(
inf->cmdinfo.proc))(
inf->cmdinfo.clientData,
inf->ptr->ip,
8539 #if TCL_MAJOR_VERSION >= 8 8558 int unknown_flag = 0;
8565 #if TCL_MAJOR_VERSION >= 8 8576 #if TCL_MAJOR_VERSION >= 8 8577 cmd = Tcl_GetStringFromObj(objv[0], &
len);
8594 DUMP2(
"call Tcl_GetCommandInfo, %s", cmd);
8595 if (!Tcl_GetCommandInfo(
ptr->
ip, cmd, &info)) {
8596 DUMP1(
"error Tcl_GetCommandInfo");
8597 DUMP1(
"try auto_load (call 'unknown' command)");
8598 if (!Tcl_GetCommandInfo(
ptr->
ip,
8599 #
if TCL_MAJOR_VERSION >= 8
8605 DUMP1(
"fail to get 'unknown' command");
8612 "invalid command name `%s'", cmd);
8615 rb_warning(
"invalid command name `%s' (ignore)", cmd);
8617 rb_warn(
"invalid command name `%s' (ignore)", cmd);
8619 Tcl_ResetResult(
ptr->
ip);
8625 #if TCL_MAJOR_VERSION >= 8 8626 Tcl_Obj **unknown_objv;
8628 char **unknown_argv;
8630 DUMP1(
"find 'unknown' command -> set arguemnts");
8633 #if TCL_MAJOR_VERSION >= 8 8635 unknown_objv = (Tcl_Obj **)ckalloc(
sizeof(Tcl_Obj *) * (objc+2));
8637 Tcl_Preserve((ClientData)unknown_objv);
8639 unknown_objv[0] = Tcl_NewStringObj(
"::unknown", 9);
8641 memcpy(unknown_objv + 1, objv,
sizeof(Tcl_Obj *)*objc);
8642 unknown_objv[++objc] = (Tcl_Obj*)
NULL;
8643 objv = unknown_objv;
8646 unknown_argv = (
char **)ckalloc(
sizeof(
char *) * (
argc+2));
8648 Tcl_Preserve((ClientData)unknown_argv);
8650 unknown_argv[0] =
strdup(
"unknown");
8651 memcpy(unknown_argv + 1,
argv,
sizeof(
char *)*
argc);
8652 unknown_argv[++
argc] = (
char *)
NULL;
8653 argv = unknown_argv;
8657 DUMP1(
"end Tcl_GetCommandInfo");
8659 thr_crit_bup = rb_thread_critical;
8660 rb_thread_critical =
Qtrue;
8666 #if TCL_MAJOR_VERSION >= 8 8680 "unknown exception");
8697 #if TCL_MAJOR_VERSION >= 8 8698 if (!info.isNativeObjectProc) {
8703 argv = (
char **)ckalloc(
sizeof(
char *) * (
argc+1));
8705 Tcl_Preserve((ClientData)
argv);
8708 argv[
i] = Tcl_GetStringFromObj(objv[
i], &
len);
8714 Tcl_ResetResult(
ptr->
ip);
8717 #if TCL_MAJOR_VERSION >= 8 8718 if (info.isNativeObjectProc) {
8723 resultPtr = Tcl_GetObjResult(
ptr->
ip);
8724 Tcl_SetResult(
ptr->
ip, Tcl_GetStringFromObj(resultPtr, &
len),
8731 #if TCL_MAJOR_VERSION >= 8 8736 Tcl_EventuallyFree((ClientData)
argv, TCL_DYNAMIC);
8739 Tcl_Release((ClientData)
argv);
8742 ckfree((
char*)
argv);
8755 #if TCL_MAJOR_VERSION >= 8 8758 Tcl_EventuallyFree((ClientData)objv, TCL_DYNAMIC);
8761 Tcl_Release((ClientData)objv);
8764 ckfree((
char*)objv);
8771 Tcl_EventuallyFree((ClientData)
argv, TCL_DYNAMIC);
8774 Tcl_Release((ClientData)
argv);
8777 ckfree((
char*)
argv);
8788 rb_thread_critical = thr_crit_bup;
8796 "ip_invoke_core receives TCL_RETURN");
8799 "ip_invoke_core receives TCL_BREAK");
8802 "ip_invoke_core receives TCL_CONTINUE");
8814 Tcl_ResetResult(
ptr->
ip);
8824 #if TCL_MAJOR_VERSION >= 8 8836 #if TCL_MAJOR_VERSION >= 8 8842 thr_crit_bup = rb_thread_critical;
8843 rb_thread_critical =
Qtrue;
8846 #if TCL_MAJOR_VERSION >= 8 8848 av = (Tcl_Obj**)ckalloc(
sizeof(Tcl_Obj *)*(
argc+1));
8850 Tcl_Preserve((ClientData)av);
8853 av[
i] = get_obj_from_str(
argv[
i]);
8861 av = (
char**)ckalloc(
sizeof(
char *) * (
argc+1));
8863 Tcl_Preserve((ClientData)av);
8871 rb_thread_critical = thr_crit_bup;
8879 #if TCL_MAJOR_VERSION >= 8 8888 #if TCL_MAJOR_VERSION >= 8 8890 av[
i] = (Tcl_Obj*)
NULL;
8893 av[
i] = (
char*)
NULL;
8896 #if TCL_MAJOR_VERSION >= 8 8898 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8901 Tcl_Release((ClientData)av);
8908 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8911 Tcl_Release((ClientData)av);
8929 #if TCL_MAJOR_VERSION >= 8 8930 Tcl_Obj **av = (Tcl_Obj **)
NULL;
8932 char **av = (
char **)
NULL;
8949 Tcl_ResetResult(ptr->
ip);
8979 volatile VALUE q_dat;
8983 DUMP2(
"do_invoke_queue_handler : evPtr = %p", evPtr);
8985 DUMP2(
"added by thread : %lx", thread);
8988 DUMP1(
"processed by another event-loop");
8991 DUMP1(
"process it on current event-loop");
9001 DUMP1(
"caller is not yet ready to receive the result -> pending");
9027 DUMP2(
"call invoke_real (for caller thread:%lx)", thread);
9053 DUMP2(
"back to caller (caller thread:%lx)", thread);
9055 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 9061 DUMP1(
"finish back to caller");
9062 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 9066 DUMP2(
"caller is dead (caller thread:%lx)", thread);
9079 Tcl_QueuePosition position;
9082 #ifdef RUBY_USE_NATIVE_THREAD 9088 volatile VALUE ip_obj = obj;
9093 #if TCL_MAJOR_VERSION >= 8 9094 Tcl_Obj **av = (Tcl_Obj **)
NULL;
9096 char **av = (
char **)
NULL;
9103 #ifdef RUBY_USE_NATIVE_THREAD 9105 DUMP2(
"invoke status: ptr->tk_thread_id %p", ptr->tk_thread_id);
9106 DUMP2(
"invoke status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9108 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9113 #ifdef RUBY_USE_NATIVE_THREAD
9114 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
9120 DUMP2(
"invoke from thread:%lx but no eventloop", current);
9122 DUMP2(
"invoke from current eventloop %lx", current);
9131 DUMP2(
"invoke from thread %lx (NOT current eventloop)", current);
9133 thr_crit_bup = rb_thread_critical;
9134 rb_thread_critical =
Qtrue;
9141 alloc_done = (
int*)ckalloc(
sizeof(
int));
9143 Tcl_Preserve((ClientData)alloc_done);
9151 Tcl_Preserve((ClientData)ivq);
9158 ivq->done = alloc_done;
9161 ivq->interp = ip_obj;
9163 ivq->thread = current;
9168 DUMP1(
"add handler");
9169 #ifdef RUBY_USE_NATIVE_THREAD 9170 if (ptr->tk_thread_id) {
9172 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)ivq, position);
9173 Tcl_ThreadAlert(ptr->tk_thread_id);
9174 }
else if (tk_eventloop_thread_id) {
9177 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
9178 (Tcl_Event*)ivq, position);
9179 Tcl_ThreadAlert(tk_eventloop_thread_id);
9182 Tcl_QueueEvent((Tcl_Event*)ivq, position);
9186 Tcl_QueueEvent((Tcl_Event*)ivq, position);
9189 rb_thread_critical = thr_crit_bup;
9195 DUMP2(
"ivq wait for handler (current thread:%lx)", current);
9196 while(*alloc_done >= 0) {
9200 DUMP2(
"*** ivq wakeup (current thread:%lx)", current);
9203 DUMP1(
"*** ivq lost eventloop thread");
9207 DUMP2(
"back from handler (current thread:%lx)", current);
9212 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
9215 Tcl_Release((ClientData)alloc_done);
9218 ckfree((
char*)alloc_done);
9224 Tcl_EventuallyFree((ClientData)ivq, TCL_DYNAMIC);
9239 DUMP1(
"raise exception");
9245 DUMP1(
"exit ip_invoke");
9298 volatile VALUE varname, index, flag;
9309 #if TCL_MAJOR_VERSION >= 8 9312 volatile VALUE strval;
9314 thr_crit_bup = rb_thread_critical;
9315 rb_thread_critical =
Qtrue;
9319 rb_thread_critical = thr_crit_bup;
9329 if (ret == (Tcl_Obj*)
NULL) {
9337 rb_thread_critical = thr_crit_bup;
9342 strval = get_str_from_obj(ret);
9348 rb_thread_critical = thr_crit_bup;
9354 volatile VALUE strval;
9367 if (ret == (
char*)
NULL) {
9372 rb_thread_critical = thr_crit_bup;
9379 rb_thread_critical = thr_crit_bup;
9405 if (
NIL_P(retval)) {
9429 volatile VALUE varname, index, value, flag;
9442 #if TCL_MAJOR_VERSION >= 8 9444 Tcl_Obj *valobj, *ret;
9445 volatile VALUE strval;
9447 thr_crit_bup = rb_thread_critical;
9448 rb_thread_critical =
Qtrue;
9450 valobj = get_obj_from_str(value);
9456 rb_thread_critical = thr_crit_bup;
9468 if (ret == (Tcl_Obj*)
NULL) {
9476 rb_thread_critical = thr_crit_bup;
9481 strval = get_str_from_obj(ret);
9487 rb_thread_critical = thr_crit_bup;
9494 volatile VALUE strval;
9507 if (ret == (
char*)
NULL) {
9515 rb_thread_critical = thr_crit_bup;
9544 if (
NIL_P(retval)) {
9568 volatile VALUE varname, index, flag;
9589 if (
FIX2INT(flag) & TCL_LEAVE_ERR_MSG) {
9619 if (
NIL_P(retval)) {
9641 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9651 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9661 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9672 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9681 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9691 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9702 volatile VALUE ary, elem;
9705 #ifdef HAVE_RUBY_ENCODING_H 9707 volatile VALUE list_ivar_enc;
9714 if (
NIL_P(ip_obj)) {
9715 interp = (Tcl_Interp *)
NULL;
9717 interp = (Tcl_Interp *)
NULL;
9723 #ifdef HAVE_RUBY_ENCODING_H 9729 #if TCL_MAJOR_VERSION >= 8 9736 listobj = get_obj_from_str(list_str);
9740 result = Tcl_ListObjGetElements(interp, listobj, &objc, &objv);
9742 if (
result == TCL_ERROR) {
9744 if (interp == (Tcl_Interp*)
NULL) {
9751 for(idx = 0; idx < objc; idx++) {
9755 thr_crit_bup = rb_thread_critical;
9756 rb_thread_critical =
Qtrue;
9763 for(idx = 0; idx < objc; idx++) {
9764 elem = get_str_from_obj(objv[idx]);
9767 #ifdef HAVE_RUBY_ENCODING_H 9784 rb_thread_critical = thr_crit_bup;
9786 for(idx = 0; idx < objc; idx++) {
9799 if (interp == (Tcl_Interp*)
NULL) {
9811 for(idx = 0; idx <
argc; idx++) {
9865 thr_crit_bup = rb_thread_critical;
9866 rb_thread_critical =
Qtrue;
9871 flagPtr = (
int *)ckalloc(
sizeof(
int) *
argc);
9873 Tcl_Preserve((ClientData)flagPtr);
9878 for(num = 0; num <
argc; num++) {
9881 #if TCL_MAJOR_VERSION >= 8 9885 len += Tcl_ScanElement(dst, &flagPtr[num]) + 1;
9893 Tcl_Preserve((ClientData)
result);
9896 for(num = 0; num <
argc; num++) {
9897 #if TCL_MAJOR_VERSION >= 8 9915 Tcl_EventuallyFree((ClientData)flagPtr, TCL_DYNAMIC);
9918 Tcl_Release((ClientData)flagPtr);
9921 ckfree((
char*)flagPtr);
9929 Tcl_EventuallyFree((ClientData)
result, TCL_DYNAMIC);
9932 Tcl_Release((ClientData)
result);
9940 rb_thread_critical = thr_crit_bup;
9957 thr_crit_bup = rb_thread_critical;
9958 rb_thread_critical =
Qtrue;
9962 #if TCL_MAJOR_VERSION >= 8 9977 rb_thread_critical = thr_crit_bup;
10016 volatile VALUE ret;
10019 =
"tcltklib %s :: Ruby%s (%s) %s pthread :: Tcl%s(%s)/Tk%s(%s) %s";
10027 +
strlen(TCL_PATCH_LEVEL)
10028 +
strlen(
"without stub")
10029 +
strlen(TK_PATCH_LEVEL)
10030 +
strlen(
"without stub")
10031 +
strlen(
"unknown tcl_threads");
10036 sprintf(info, form,
10045 #ifdef USE_TCL_STUBS
10051 #ifdef USE_TK_STUBS
10056 #ifdef WITH_TCL_ENABLE_THREAD
10057 #
if WITH_TCL_ENABLE_THREAD
10060 "without tcl_threads" 10063 "unknown tcl_threads" 10090 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) 10092 if (
RTEST(error_mode)) {
10101 #ifdef HAVE_RUBY_ENCODING_H 10106 if (
RTEST(error_mode)) {
10126 #ifdef HAVE_RUBY_ENCODING_H 10128 update_encoding_table(table, interp, error_mode)
10142 if (
NIL_P(interp))
return 0;
10148 Tcl_GetEncodingNames(ptr->
ip);
10152 if (Tcl_ListObjGetElements(ptr->
ip,
enc_list,
10153 &objc, &objv) != TCL_OK) {
10160 for(
i = 0;
i < objc;
i++) {
10198 if (!
NIL_P(interp)) {
10207 if (ptr &&
NIL_P(enc)) {
10239 if (update_encoding_table(table, interp, error_mode)) {
10272 if (update_encoding_table(table, interp, error_mode)) {
10285 if (
RTEST(error_mode)) {
10309 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) 10311 update_encoding_table(table, interp, error_mode)
10324 if (
NIL_P(interp))
return 0;
10330 Tcl_GetEncodingNames(ptr->
ip);
10334 if (Tcl_ListObjGetElements(ptr->
ip,
enc_list, &objc, &objv) != TCL_OK) {
10341 for(
i = 0;
i < objc;
i++) {
10384 if (
RTEST(error_mode)) {
10433 #ifdef HAVE_RUBY_ENCODING_H 10447 #ifdef HAVE_RB_SET_SAFE_LEVEL_FORCE 10463 Tcl_GetEncodingNames(ptr->
ip);
10467 if (Tcl_ListObjGetElements(ptr->
ip,
enc_list, &objc, &objv) != TCL_OK) {
10473 for(
i = 0;
i < objc;
i++) {
10474 int name2obj, obj2name;
10476 name2obj = 1; obj2name = 1;
10481 if (strcmp(
RSTRING_PTR(encname),
"identity") == 0) {
10482 name2obj = 1; obj2name = 0;
10483 idx = ENCODING_INDEX_BINARY;
10485 }
else if (strcmp(
RSTRING_PTR(encname),
"shiftjis") == 0) {
10486 name2obj = 1; obj2name = 0;
10489 }
else if (strcmp(
RSTRING_PTR(encname),
"unicode") == 0) {
10490 name2obj = 1; obj2name = 0;
10491 idx = ENCODING_INDEX_UTF8;
10493 }
else if (strcmp(
RSTRING_PTR(encname),
"symbol") == 0) {
10494 name2obj = 1; obj2name = 0;
10499 name2obj = 1; obj2name = 1;
10529 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1) 10548 Tcl_GetEncodingNames(ptr->
ip);
10552 if (Tcl_ListObjGetElements(ptr->
ip,
enc_list, &objc, &objv) != TCL_OK) {
10558 for(
i = 0;
i < objc;
i++) {
10601 if (
NIL_P(table)) {
10618 #if TCL_MAJOR_VERSION >= 8 10620 #define MASTER_MENU 0 10621 #define TEAROFF_MENU 1 10624 struct dummy_TkMenuEntry {
10626 struct dummy_TkMenu *menuPtr;
10630 struct dummy_TkMenu {
10633 Tcl_Interp *interp;
10634 Tcl_Command widgetCmd;
10635 struct dummy_TkMenuEntry **entries;
10639 Tcl_Obj *menuTypePtr;
10643 struct dummy_TkMenuRef {
10644 struct dummy_TkMenu *menuPtr;
10651 EXTERN struct dummy_TkMenuRef *TkFindMenuReferences(Tcl_Interp*,
char*);
10653 #define MENU_HASH_KEY "tkMenus" 10664 #if TCL_MAJOR_VERSION >= 8 10665 volatile VALUE menu_path;
10667 struct dummy_TkMenuRef *menuRefPtr =
NULL;
10669 Tcl_HashTable *menuTablePtr;
10670 Tcl_HashEntry *hashEntryPtr;
10672 menu_path =
argv[0];
10676 menuRefPtr = TkFindMenuReferences(ptr->
ip,
RSTRING_PTR(menu_path));
10679 = (Tcl_HashTable *) Tcl_GetAssocData(ptr->
ip, MENU_HASH_KEY,
NULL))
10682 = Tcl_FindHashEntry(menuTablePtr,
RSTRING_PTR(menu_path)))
10684 menuRefPtr = (
struct dummy_TkMenuRef *) Tcl_GetHashValue(hashEntryPtr);
10689 if (menuRefPtr == (
struct dummy_TkMenuRef *)
NULL) {
10693 if (menuRefPtr->menuPtr == (
struct dummy_TkMenu *)
NULL) {
10695 "invalid menu widget (maybe already destroyed)");
10698 if ((menuRefPtr->menuPtr)->menuType != MENUBAR) {
10700 "target menu widget must be a MENUBAR type");
10703 (menuRefPtr->menuPtr)->menuType = TEAROFF_MENU;
10707 char *s =
"normal";
10709 (menuRefPtr->menuPtr)->menuTypePtr = Tcl_NewStringObj(s,
strlen(s));
10712 (menuRefPtr->menuPtr)->menuType = MASTER_MENU;
10717 TkEventuallyRecomputeMenu(menuRefPtr->menuPtr);
10718 TkEventuallyRedrawMenu(menuRefPtr->menuPtr,
10719 (
struct dummy_TkMenuEntry *)
NULL);
10721 memset((
void *) &event, 0,
sizeof(event));
10722 event.xany.type = ConfigureNotify;
10723 event.xany.serial = NextRequest(Tk_Display((menuRefPtr->menuPtr)->tkwin));
10724 event.xany.send_event = 0;
10725 event.xany.window = Tk_WindowId((menuRefPtr->menuPtr)->tkwin);
10726 event.xany.display = Tk_Display((menuRefPtr->menuPtr)->tkwin);
10727 event.xconfigure.window =
event.xany.window;
10728 Tk_HandleEvent(&event);
10745 argv[0] = menu_path;
10771 #ifdef HAVE_RUBY_ENCODING_H 10810 # define TK_WINDOWING_SYSTEM "win32" 10813 # define TK_WINDOWING_SYSTEM "classic" 10816 # define TK_WINDOWING_SYSTEM "aqua" 10818 # define TK_WINDOWING_SYSTEM "x11" 10839 #ifdef TCL_NAMESPACE_ONLY 10847 #ifdef TCL_PARSE_PART1 11038 #ifndef DEFAULT_EVENTLOOP_DEPTH 11039 #define DEFAULT_EVENTLOOP_DEPTH 7 11050 #ifdef HAVE_NATIVETHREAD 11076 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT 11085 Tcl_ObjType_ByteArray = Tcl_GetObjType(Tcl_ObjTypeName_ByteArray);
11086 Tcl_ObjType_String = Tcl_GetObjType(Tcl_ObjTypeName_String);
RUBY_EXTERN VALUE rb_cString
static VALUE tk_funcall(VALUE(*func)(), int argc, VALUE *argv, VALUE obj)
VALUE rb_apply(VALUE, ID, VALUE)
Calls a method.
static VALUE lib_fromUTF8(int argc, VALUE *argv, VALUE self)
static long NUM2LONG(VALUE x)
void invoke_queue_mark(struct invoke_queue *q)
void rb_thread_schedule(void)
int rb_enc_get_index(VALUE obj)
static VALUE encoding_table_get_name_core(VALUE table, VALUE enc, VALUE error_mode)
static VALUE eTkCallbackRetry
RUBY_EXTERN VALUE rb_cData
static VALUE lib_restart(VALUE self)
static void tcl_stubs_check()
Tcl_Interp * current_interp
static void lib_mark_at_exit(VALUE self)
static VALUE ip_has_invalid_namespace_p(VALUE self)
static void WaitVisibilityProc(ClientData clientData, XEvent *eventPtr)
VALUE rb_ary_pop(VALUE ary)
#define TCL_FINAL_RELEASE
#define TKWAIT_MODE_VISIBILITY
void rb_bug(const char *fmt,...)
int ruby_tcl_stubs_init()
static VALUE ip_set_global_var2(VALUE self, VALUE varname, VALUE index, VALUE value)
static VALUE ip_set_eventloop_tick(VALUE self, VALUE tick)
static VALUE eTkCallbackRedo
static VALUE ip_set_global_var(VALUE self, VALUE varname, VALUE value)
static VALUE lib_UTF_backslash_core(VALUE self, VALUE str, int all_bs)
size_t strlen(const char *)
static void ip_finalize(Tcl_Interp *ip)
static VALUE ip_fromUTF8(int argc, VALUE *argv, VALUE self)
static VALUE ip_get_variable(VALUE self, VALUE varname, VALUE flag)
#define FAIL_Tcl_InitStubs
#define TCL_ALPHA_RELEASE
static VALUE ip_mainloop(int argc, VALUE *argv, VALUE self)
static int tcl_protect_core(Tcl_Interp *interp, VALUE(*proc)(), VALUE data)
static VALUE ip_evloop_abort_on_exc(VALUE self)
static VALUE get_no_event_wait(VALUE self)
static VALUE lib_mainloop(int argc, VALUE *argv, VALUE self)
static int lib_eventloop_core(int check_root, int update_flag, int *check_var, Tcl_Interp *interp)
static VALUE set_no_event_wait(VALUE self, VALUE wait)
static VALUE lib_evloop_abort_on_exc(VALUE self)
static VALUE tcltkip_class
static char * WaitVariableProc(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)
#define Data_Get_Struct(obj, type, sval)
void rb_define_singleton_method(VALUE obj, const char *name, VALUE(*func)(ANYARGS), int argc)
Defines a singleton method for obj.
int rb_thread_check_trap_pending(void)
static void rb_threadWaitVisibilityProc(ClientData clientData, XEvent *eventPtr)
#define NO_THREAD_INTERRUPT_TIME
#define RUBY_RELEASE_DATE
#define TK_WINDOWING_SYSTEM
static VALUE ip_has_mainwindow_p_core(VALUE self, int argc, VALUE *argv)
#define DEFAULT_EVENTLOOP_DEPTH
static VALUE enc_list(VALUE klass)
static VALUE ip_ruby_cmd_receiver_get(char *str)
static VALUE watchdog_evloop_launcher(VALUE check_rootwidget)
void rbtk_EventCheckProc(ClientData clientData, int flag)
void call_queue_mark(struct call_queue *q)
static int enc_arg(volatile VALUE *arg, const char **name_p, rb_encoding **enc_p)
static VALUE ip_toUTF8(int argc, VALUE *argv, VALUE self)
static int tcl_eval(Tcl_Interp *interp, const char *cmd)
static void rb_threadUpdateProc(ClientData clientData)
static int rbtk_internal_eventloop_handler
static int call_queue_handler(Tcl_Event *evPtr, int flags)
#define FAIL_CreateInterp
static struct tcltkip * get_ip(VALUE self)
static void ip_replace_wait_commands(Tcl_Interp *interp, Tk_Window mainWin)
static Tcl_TimerToken timer_token
static int event_loop_max
VALUE rb_enc_from_encoding(rb_encoding *encoding)
static VALUE lib_thread_callback(int argc, VALUE *argv, VALUE self)
static VALUE ip_eval(VALUE self, VALUE str)
static void delete_slaves(Tcl_Interp *ip)
static VALUE set_max_block_time(VALUE self, VALUE time)
static ID ID_encoding_name
static void ip_CallWhenDeleted(ClientData clientData, Tcl_Interp *ip)
VALUE rb_ary_push(VALUE ary, VALUE item)
static VALUE eventloop_thread
static int rbtk_release_ip(struct tcltkip *ptr)
SSL_METHOD *(* func)(void)
static VALUE ip_get_variable2_core(VALUE interp, int argc, VALUE *argv)
static VALUE create_dummy_encoding_for_tk_core(VALUE interp, VALUE name, VALUE error_mode)
static void ip_wrap_namespace_command(Tcl_Interp *interp)
int rb_thread_alone(void)
static VALUE ip_create_slave(int argc, VALUE *argv, VALUE self)
static VALUE ip_unset_global_var(VALUE self, VALUE varname)
void eval_queue_mark(struct eval_queue *q)
VALUE rb_thread_wakeup(VALUE)
VALUE lib_eventloop_ensure(VALUE args)
static VALUE lib_num_of_mainwindows_core(VALUE self, int argc, VALUE *argv)
static VALUE INT2NUM(int v)
static int run_timer_flag
#define TKWAIT_MODE_DESTROY
VALUE rb_funcall(VALUE, ID, int,...)
Calls a method.
VALUE rb_protect(VALUE(*proc)(VALUE), VALUE data, int *state)
static int rbtk_eventloop_depth
static VALUE ip_create_slave_core(VALUE interp, int argc, VALUE *argv)
static struct @18 tcltk_version
void rb_raise(VALUE exc, const char *fmt,...)
static VALUE ip_cancel_eval_unwind(int argc, VALUE *argv, VALUE self)
VALUE rb_ivar_get(VALUE, ID)
static VALUE ip_thread_tkwait(VALUE self, VALUE mode, VALUE target)
static void WaitWindowProc(ClientData clientData, XEvent *eventPtr)
void rb_define_alloc_func(VALUE, rb_alloc_func_t)
VALUE rb_obj_is_kind_of(VALUE, VALUE)
int rb_const_defined(VALUE, ID)
VALUE rb_tainted_str_new2(const char *)
static VALUE ip_unset_global_var2(VALUE self, VALUE varname, VALUE index)
VALUE rb_ary_new3(long n,...)
static VALUE _thread_call_proc(VALUE arg)
static VALUE invoke_tcl_proc(VALUE arg)
VALUE rb_locale_charmap(VALUE klass)
static VALUE eLocalJumpError
static VALUE ip_ruby_cmd_receiver_const_get(char *name)
void rb_gc_mark(VALUE ptr)
static VALUE lib_fromUTF8_core(VALUE ip_obj, VALUE src, VALUE encodename)
static int check_rootwidget_flag
VALUE lib_watchdog_ensure(VALUE arg)
static VALUE ip_get_global_var2(VALUE self, VALUE varname, VALUE index)
static VALUE ip_invoke(int argc, VALUE *argv, VALUE obj)
static int ip_rb_threadTkWaitCommand(ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int deleted_ip(struct tcltkip *ptr)
static VALUE rb_thread_alive_p(VALUE thread)
VALUE rb_path2class(const char *)
static VALUE set_eventloop_tick(VALUE self, VALUE tick)
rb_encoding * rb_utf8_encoding(void)
static void set_tcltk_version()
static VALUE ip_make_menu_embeddable(VALUE interp, VALUE menu_path)
static VALUE ip_unset_variable(VALUE self, VALUE varname, VALUE flag)
static VALUE ip_allow_ruby_exit_set(VALUE self, VALUE val)
VALUE rb_fix2str(VALUE, int)
static VALUE lib_mainloop_watchdog(int argc, VALUE *argv, VALUE self)
static VALUE call_DoOneEvent(VALUE flag_val)
#define Tcl_GetStringResult(interp)
static char * rb_threadVwaitProc(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)
void rb_gc_force_recycle(VALUE p)
static VALUE ip_split_tklist(VALUE self, VALUE list_str)
static VALUE ip_is_deleted_p(VALUE self)
static VALUE ip_set_no_event_wait(VALUE self, VALUE wait)
static VALUE ip_invoke_core(VALUE interp, int argc, char **argv)
static VALUE lib_get_system_encoding(VALUE self)
#define Data_Wrap_Struct(klass, mark, free, sval)
static const char finalize_hook_name[]
static VALUE ip_delete(VALUE self)
void rb_global_variable(VALUE *var)
#define DEFAULT_NO_EVENT_TICK
void rb_exc_raise(VALUE mesg)
static VALUE ip_alloc(VALUE self)
static VALUE ip_is_slave_of_p(VALUE self, VALUE master)
static VALUE ip_make_menu_embeddable_core(VALUE interp, int argc, VALUE *argv)
VALUE ivq_safelevel_handler(VALUE arg, VALUE ivq)
static VALUE ip_has_mainwindow_p(VALUE self)
static VALUE ip_set_variable2_core(VALUE interp, int argc, VALUE *argv)
static VALUE create_encoding_table(VALUE interp)
#define WATCHDOG_INTERVAL
static int ip_rb_replaceSlaveTkCmdsCommand(ClientData clientData, Tcl_Interp *interp, int objc, objv)
static VALUE rbtk_pending_exception
static VALUE get_eventloop_window_mode(VALUE self)
#define RbTk_OBJ_UNTRUST(x)
VALUE rb_gv_get(const char *)
void rb_set_safe_level(int)
static VALUE ip_invoke_immediate(int argc, VALUE *argv, VALUE obj)
int rb_to_encoding_index(VALUE enc)
static VALUE encoding_table_get_name(VALUE table, VALUE enc)
static VALUE lib_evloop_abort_on_exc_set(VALUE self, VALUE val)
static VALUE encoding_table_get_obj(VALUE table, VALUE enc)
static int have_rb_thread_waiting_for_value
static VALUE ip_create_console_core(VALUE interp, int argc, VALUE *argv)
VALUE rb_hash_aset(VALUE hash, VALUE key, VALUE val)
static int ip_rbUpdateCommand(ClientData clientData, Tcl_Interp *interp, int objc, objv)
static VALUE ip_invoke_real(int argc, VALUE *argv, VALUE interp)
RUBY_EXTERN VALUE rb_cObject
#define HAVE_NATIVETHREAD
VALUE rb_eval_string_protect(const char *, int *)
VALUE rb_obj_as_string(VALUE)
static char * VwaitVarProc(ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)
static VALUE create_dummy_encoding_for_tk(VALUE interp, VALUE name)
VALUE rb_enc_default_external(void)
static VALUE eventloop_sleep(VALUE dummy)
VALUE rb_thread_current(void)
static VALUE enc_name(VALUE self)
VALUE rb_define_class(const char *name, VALUE super)
Defines a top-level class.
static VALUE ip_get_result_string_obj(Tcl_Interp *interp)
static VALUE eventloop_stack
void rb_define_const(VALUE, const char *, VALUE)
#define Tcl_IncrRefCount(obj)
static int ip_RubyExitCommand(ClientData clientData, Tcl_Interp *interp, int argc, argv)
static int ip_rb_threadVwaitCommand(ClientData clientData, Tcl_Interp *interp, int objc, objv)
static int ip_rb_threadUpdateCommand(ClientData clientData, Tcl_Interp *interp, int objc, objv)
VALUE rb_eval_string(const char *)
rb_atomic_t cnt[RUBY_NSIG]
static ID ID_encoding_table
static VALUE get_eventloop_tick(VALUE self)
static Tcl_Interp * eventloop_interp
static VALUE lib_eventloop_launcher(int check_root, int update_flag, int *check_var, Tcl_Interp *interp)
static VALUE ip_get_variable2(VALUE self, VALUE varname, VALUE index, VALUE flag)
static VALUE lib_do_one_event(int argc, VALUE *argv, VALUE self)
static int window_event_mode
static VALUE watchdog_thread
static void ip_finalize _((Tcl_Interp *))
static VALUE ip_get_eventloop_weight(VALUE self)
static VALUE evq_safelevel_handler(VALUE arg, VALUE evq)
static VALUE lib_UTF_backslash(VALUE self, VALUE str)
#define MEMCPY(p1, p2, type, n)
VALUE rb_enc_associate_index(VALUE obj, int idx)
static VALUE encoding_table_get_obj_core(VALUE table, VALUE enc, VALUE error_mode)
#define Tcl_DecrRefCount(obj)
VALUE rb_str_resize(VALUE, long)
static VALUE lib_toUTF8(int argc, VALUE *argv, VALUE self)
static const char tcltklib_release_date[]
static VALUE ip_unset_variable2(VALUE self, VALUE varname, VALUE index, VALUE flag)
VALUE rb_const_get(VALUE, ID)
static VALUE tcltklib_compile_info()
static int tcl_protect(Tcl_Interp *interp, VALUE(*proc)(), VALUE data)
void rb_define_module_function(VALUE module, const char *name, VALUE(*func)(ANYARGS), int argc)
Defines a module function for module.
static int pending_exception_check1(int thr_crit_bup, struct tcltkip *ptr)
#define DEFAULT_NO_EVENT_WAIT
static VALUE _thread_call_proc_ensure(VALUE arg)
static VALUE lib_Tcl_backslash(VALUE self, VALUE str)
static VALUE set_eventloop_weight(VALUE self, VALUE loop_max, VALUE no_event)
static VALUE TkStringValue(VALUE obj)
static VALUE lib_split_tklist_core(VALUE ip_obj, VALUE list_str)
VALUE rb_iv_set(VALUE, const char *, VALUE)
int rb_scan_args(int argc, const VALUE *argv, const char *fmt,...)
static VALUE ip_do_one_event(int argc, VALUE *argv, VALUE self)
static VALUE create_ip_exc(interp, VALUE interp:VALUE exc, const char *fmt, va_alist)
VALUE rb_ivar_set(VALUE, ID, VALUE)
unsigned char buf[MIME_BUF_SIZE]
static VALUE lib_split_tklist(VALUE self, VALUE list_str)
int ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip)
int ruby_tk_stubs_init(Tcl_Interp *tcl_ip)
VALUE rb_exc_new2(VALUE etype, const char *s)
int rb_define_dummy_encoding(const char *name)
static int options(unsigned char *cp)
Tcl_CmdInfo orig_exit_info
static VALUE lib_evloop_thread_p(VALUE self)
static VALUE eTkCallbackContinue
static int event_loop_abort_on_exc
static VALUE lib_getversion(VALUE self)
static VALUE ip_thread_vwait(VALUE self, VALUE var)
VALUE rb_obj_encoding(VALUE obj)
register unsigned int len
VALUE rb_gc_disable(void)
VALUE rb_ensure(VALUE(*b_proc)(ANYARGS), VALUE data1, VALUE(*e_proc)(ANYARGS), VALUE data2)
#define FAIL_Tk_InitStubs
#define DUMP2(ARG1, ARG2)
static int ip_null_proc(ClientData clientData, Tcl_Interp *interp, int argc, argv)
VALUE lib_eventloop_main(VALUE args)
#define TCL_NAMESPACE_DEBUG
static VALUE ip_make_safe(VALUE self)
VALUE lib_eventloop_main_core(VALUE args)
void rb_jump_tag(int tag)
static int trap_check(int *check_var)
static void ip_set_exc_message(Tcl_Interp *interp, VALUE exc)
static VALUE set_eventloop_window_mode(VALUE self, VALUE mode)
long strtol(const char *nptr, char **endptr, int base)
#define NO_FindExecutable
static void _timer_for_tcl(ClientData clientData)
void rb_set_end_proc(void(*func)(VALUE), VALUE data)
int rb_respond_to(VALUE, ID)
static void ip_free(struct tcltkip *ptr)
static int ip_ruby_eval(ClientData clientData, Tcl_Interp *interp, int argc, argv)
VALUE rb_define_module_under(VALUE outer, const char *name)
#define TCL_CANCEL_UNWIND
static VALUE get_eventloop_weight(VALUE self)
#define StringValueCStr(v)
void rb_set_safe_level_force(int)
static VALUE eTkLocalJumpError
#define va_init_list(a, b)
void rb_thread_wait_for(struct timeval)
static VALUE ENCODING_NAME_BINARY
static void call_original_exit(struct tcltkip *ptr, int state)
static VALUE lib_watchdog_core(VALUE check_rootwidget)
static VALUE ip_set_variable2(VALUE self, VALUE varname, VALUE index, VALUE value, VALUE flag)
static VALUE lib_restart_core(VALUE interp, int argc, VALUE *argv)
static VALUE lib_num_of_mainwindows(VALUE self)
static int pending_exception_check0()
static int ip_rbVwaitCommand(ClientData clientData, Tcl_Interp *interp, int objc, objv)
VALUE rb_exc_new3(VALUE etype, VALUE str)
Tcl_Interp * ruby_tcl_create_ip_and_stubs_init(int *st)
static VALUE eTkCallbackBreak
static VALUE ip_mainloop_watchdog(int argc, VALUE *argv, VALUE self)
VALUE rb_block_proc(void)
void rbtk_EventSetupProc(ClientData clientData, int flag)
static VALUE ip_allow_ruby_exit_p(VALUE self)
#define EVENT_HANDLER_TIMEOUT
static VALUE lib_conv_listelement(VALUE self, VALUE src)
static int ip_InterpExitCommand(ClientData clientData, Tcl_Interp *interp, int argc, argv)
#define DUMP3(ARG1, ARG2, ARG3)
static VALUE lib_do_one_event_core(int argc, VALUE *argv, VALUE self, int is_ip)
int invoke_queue_handler(Tcl_Event *evPtr, int flags)
static VALUE create_encoding_table_core(VALUE arg, VALUE interp)
static int req_timer_tick
static void free_invoke_arguments(int argc, char **av)
static VALUE ip_init(int argc, VALUE *argv, VALUE self)
static VALUE ip_get_no_event_wait(VALUE self)
static VALUE lib_set_system_encoding(VALUE self, VALUE enc_name)
static VALUE ip_restart(VALUE self)
VALUE rb_proc_new(VALUE(*)(ANYARGS), VALUE)
void rb_thread_check_ints(void)
static int event_loop_wait_event
VALUE rb_thread_run(VALUE)
static int tcl_global_eval(Tcl_Interp *interp, const char *cmd)
static VALUE lib_merge_tklist(int argc, VALUE *argv, VALUE obj)
static int ip_ruby_cmd(ClientData clientData, Tcl_Interp *interp, int argc, argv)
static VALUE ENCODING_NAME_UTF8
static VALUE lib_toUTF8_core(VALUE ip_obj, VALUE src, VALUE encodename)
VALUE rb_str_export_to_enc(VALUE, rb_encoding *)
static VALUE eTkCallbackReturn
static char ** alloc_invoke_arguments(int argc, VALUE *argv)
void rb_notimplement(void)
static VALUE ip_get_global_var(VALUE self, VALUE varname)
VALUE rb_ary_join(VALUE ary, VALUE sep)
VALUE rb_enc_default_internal(void)
VALUE rb_ary_new2(long capa)
static int ip_cancel_eval_core(Tcl_Interp *interp, VALUE msg, int flag)
static VALUE ip_set_eventloop_weight(VALUE self, VALUE loop_max, VALUE no_event)
#define DEFAULT_EVENT_LOOP_MAX
static VALUE tcltkip_init_tk(VALUE interp)
static VALUE ip_cancel_eval(int argc, VALUE *argv, VALUE self)
static VALUE callq_safelevel_handler(VALUE arg, VALUE callq)
static VALUE eTkCallbackThrow
static VALUE ip_evloop_abort_on_exc_set(VALUE self, VALUE val)
static int ip_rbTkWaitCommand(ClientData clientData, Tcl_Interp *interp, int objc, objv)
#define StringValuePtr(v)
#define ruby_native_thread_p()
#define rb_enc_to_index(enc)
int eval_queue_handler(Tcl_Event *evPtr, int flags)
static VALUE ip_create_console(VALUE self)
static VALUE _thread_call_proc_core(VALUE arg)
void rb_warning(const char *fmt,...)
#define TCLTKLIB_RELEASE_DATE
int rb_enc_find_index(const char *name)
int ruby_open_tcl_dll(char *appname)
static VALUE ip_make_safe_core(VALUE interp, int argc, VALUE *argv)
VALUE rb_obj_freeze(VALUE)
void _thread_call_proc_arg_mark(struct thread_call_proc_arg *q)
static int rbtk_preserve_ip(struct tcltkip *ptr)
static VALUE ip_get_eventloop_tick(VALUE self)
VALUE rb_tainted_str_new(const char *, long)
VALUE rb_define_module(const char *name)
static VALUE ip_retval(VALUE self)
static VALUE ip_unset_variable2_core(VALUE interp, int argc, VALUE *argv)
static VALUE ip_invoke_with_position(int argc, VALUE *argv, VALUE obj, Tcl_QueuePosition position)
static VALUE ip_set_variable(VALUE self, VALUE varname, VALUE value, VALUE flag)
static void rb_threadWaitWindowProc(ClientData clientData, XEvent *eventPtr)
VALUE rb_vsprintf(const char *, va_list)
static VALUE ip_get_encoding_table(VALUE interp)
static int check_eventloop_interp()
static VALUE ip_is_safe_p(VALUE self)
VALUE rb_thread_create(VALUE(*)(ANYARGS), void *)
void rb_define_method(VALUE klass, const char *name, VALUE(*func)(ANYARGS), int argc)
VALUE rb_str_append(VALUE, VALUE)
VALUE rb_str_new2(const char *)
void rb_warn(const char *fmt,...)
static VALUE lib_get_reltype_name(VALUE self)
#define EVLOOP_WAKEUP_CHANCE
VALUE rb_attr_get(VALUE, ID)
static VALUE _thread_call_proc_value(VALUE th)
#define DEFAULT_TIMER_TICK
static VALUE ip_ruby_cmd_core(struct cmd_body_arg *arg)
rb_encoding * rb_enc_from_index(int index)
static VALUE ip_eval_real(VALUE self, char *cmd_str, int cmd_len)
RUBY_EXTERN VALUE rb_argv0
void rb_thread_sleep_forever(void)
VALUE rb_str_new(const char *, long)
VALUE rb_obj_class(VALUE)