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"
30 #if !defined(RSTRING_PTR)
31 #define RSTRING_PTR(s) (RSTRING(s)->ptr)
32 #define RSTRING_LEN(s) (RSTRING(s)->len)
34 #if !defined(RSTRING_LENINT)
35 #define RSTRING_LENINT(s) ((int)RSTRING_LEN(s))
37 #if !defined(RARRAY_PTR)
38 #define RARRAY_PTR(s) (RARRAY(s)->ptr)
39 #define RARRAY_LEN(s) (RARRAY(s)->len)
43 #define RbTk_OBJ_UNTRUST(x) do {OBJ_TAINT(x); OBJ_UNTRUST(x);} while (0)
45 #define RbTk_OBJ_UNTRUST(x) OBJ_TAINT(x)
47 #define RbTk_ALLOC_N(type, n) (type *)ckalloc((int)(sizeof(type) * (n)))
49 #if defined(HAVE_RB_PROC_NEW) && !defined(RUBY_VM)
56 #ifdef HAVE_STDARG_PROTOTYPES
58 #define va_init_list(a,b) va_start(a,b)
61 #define va_init_list(a,b) va_start(a)
65 #if !defined HAVE_VSNPRINTF && !defined vsnprintf
68 # define vsnprintf _vsnprintf
70 # ifdef HAVE_RUBY_RUBY_H
81 #ifndef HAVE_RUBY_NATIVE_THREAD_P
82 #define ruby_native_thread_p() is_ruby_native_thread()
83 #undef RUBY_USE_NATIVE_THREAD
85 #define RUBY_USE_NATIVE_THREAD 1
88 #ifndef HAVE_RB_ERRINFO
89 #define rb_errinfo() (ruby_errinfo+0)
93 #ifndef HAVE_RB_SAFE_LEVEL
94 #define rb_safe_level() (ruby_safe_level+0)
96 #ifndef HAVE_RB_SOURCEFILE
97 #define rb_sourcefile() (ruby_sourcefile+0)
102 #ifndef TCL_ALPHA_RELEASE
103 #define TCL_ALPHA_RELEASE 0
104 #define TCL_BETA_RELEASE 1
105 #define TCL_FINAL_RELEASE 2
126 #if TCL_MAJOR_VERSION >= 8
128 # if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 4
132 # define CONST84 CONST
140 # define CONST84 CONST
148 # if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 5
151 # define CONST86 CONST84
156 #define TAG_RETURN 0x1
157 #define TAG_BREAK 0x2
159 #define TAG_RETRY 0x4
161 #define TAG_RAISE 0x6
162 #define TAG_THROW 0x7
163 #define TAG_FATAL 0x8
166 #define DUMP1(ARG1) if (ruby_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1); fflush(stderr); }
167 #define DUMP2(ARG1, ARG2) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\
168 fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); fflush(stderr); }
169 #define DUMP3(ARG1, ARG2, ARG3) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\
170 fprintf(stderr, ARG1, ARG2, ARG3); fprintf(stderr, "\n"); fflush(stderr); }
187 #ifdef HAVE_RUBY_ENCODING_H
253 #if TCL_MAJOR_VERSION >= 8
254 static const char Tcl_ObjTypeName_ByteArray[] =
"bytearray";
255 static CONST86 Tcl_ObjType *Tcl_ObjType_ByteArray;
257 static const char Tcl_ObjTypeName_String[] =
"string";
258 static CONST86 Tcl_ObjType *Tcl_ObjType_String;
260 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
261 #define IS_TCL_BYTEARRAY(obj) ((obj)->typePtr == Tcl_ObjType_ByteArray)
262 #define IS_TCL_STRING(obj) ((obj)->typePtr == Tcl_ObjType_String)
263 #define IS_TCL_VALID_STRING(obj) ((obj)->bytes != (char*)NULL)
267 #ifndef HAVE_RB_HASH_LOOKUP
268 #define rb_hash_lookup rb_hash_aref
273 #ifdef HAVE_PROTOTYPES
274 tcl_eval(Tcl_Interp *interp,
const char *cmd)
284 Tcl_AllowExceptions(interp);
291 #define Tcl_Eval tcl_eval
294 #ifdef HAVE_PROTOTYPES
305 Tcl_AllowExceptions(interp);
311 #undef Tcl_GlobalEval
312 #define Tcl_GlobalEval tcl_global_eval
315 #if TCL_MAJOR_VERSION < 8
316 #define Tcl_IncrRefCount(obj) (1)
317 #define Tcl_DecrRefCount(obj) (1)
321 #if TCL_MAJOR_VERSION < 8
322 #define Tcl_GetStringResult(interp) ((interp)->result)
326 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
328 Tcl_GetVar2Ex(interp, name1, name2, flags)
334 Tcl_Obj *nameObj1, *nameObj2 =
NULL, *retObj;
336 nameObj1 = Tcl_NewStringObj((
char*)name1, -1);
340 nameObj2 = Tcl_NewStringObj((
char*)name2, -1);
344 retObj = Tcl_ObjGetVar2(interp, nameObj1, nameObj2, flags);
356 Tcl_SetVar2Ex(interp, name1, name2, newValObj, flags)
363 Tcl_Obj *nameObj1, *nameObj2 =
NULL, *retObj;
365 nameObj1 = Tcl_NewStringObj((
char*)name1, -1);
369 nameObj2 = Tcl_NewStringObj((
char*)name2, -1);
373 retObj = Tcl_ObjSetVar2(interp, nameObj1, nameObj2, newValObj, flags);
387 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4)
388 # if !defined __MINGW32__ && !defined __BORLANDC__
404 #if TCL_MAJOR_VERSION >= 8
460 for(i = 0; i < q->
argc; i++) {
472 #ifdef RUBY_USE_NATIVE_THREAD
473 Tcl_ThreadId tk_eventloop_thread_id;
488 #ifdef RUBY_USE_NATIVE_THREAD
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 1
493 #define CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 1
494 #define USE_TOGGLE_WINDOW_MODE_FOR_IDLE 0
495 #define DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 0
498 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
509 #ifdef RUBY_USE_NATIVE_THREAD
510 #define DEFAULT_EVENT_LOOP_MAX 800
511 #define DEFAULT_NO_EVENT_TICK 10
512 #define DEFAULT_NO_EVENT_WAIT 5
513 #define WATCHDOG_INTERVAL 10
514 #define DEFAULT_TIMER_TICK 0
515 #define NO_THREAD_INTERRUPT_TIME 100
517 #define DEFAULT_EVENT_LOOP_MAX 800
518 #define DEFAULT_NO_EVENT_TICK 10
519 #define DEFAULT_NO_EVENT_WAIT 20
520 #define WATCHDOG_INTERVAL 10
521 #define DEFAULT_TIMER_TICK 0
522 #define NO_THREAD_INTERRUPT_TIME 100
525 #define EVENT_HANDLER_TIMEOUT 100
542 #if TCL_MAJOR_VERSION >= 8
546 static int ip_ruby_eval _((ClientData, Tcl_Interp *,
int,
char **));
547 static int ip_ruby_cmd _((ClientData, Tcl_Interp *,
int,
char **));
559 #ifndef TCL_NAMESPACE_DEBUG
560 #define TCL_NAMESPACE_DEBUG 0
563 #if TCL_NAMESPACE_DEBUG
565 #if TCL_MAJOR_VERSION >= 8
566 EXTERN struct TclIntStubs *tclIntStubsPtr;
570 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5
573 # ifndef Tcl_GetCurrentNamespace
574 EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace
_((Tcl_Interp *));
576 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
577 # ifndef Tcl_GetCurrentNamespace
578 # ifndef FunctionNum_of_GetCurrentNamespace
579 #define FunctionNum_of_GetCurrentNamespace 124
581 struct DummyTclIntStubs_for_GetCurrentNamespace {
583 struct TclIntStubHooks *hooks;
584 void (*
func[FunctionNum_of_GetCurrentNamespace])();
585 Tcl_Namespace * (*tcl_GetCurrentNamespace)
_((Tcl_Interp *));
588 #define Tcl_GetCurrentNamespace \
589 (((struct DummyTclIntStubs_for_GetCurrentNamespace *)tclIntStubsPtr)->tcl_GetCurrentNamespace)
596 #if TCL_MAJOR_VERSION < 8
597 #define ip_null_namespace(interp) (0)
599 #define ip_null_namespace(interp) \
600 (Tcl_GetCurrentNamespace(interp) == (Tcl_Namespace *)NULL)
604 #if TCL_MAJOR_VERSION < 8
605 #define rbtk_invalid_namespace(ptr) (0)
607 #define rbtk_invalid_namespace(ptr) \
608 ((ptr)->default_ns == (Tcl_Namespace*)NULL || Tcl_GetCurrentNamespace((ptr)->ip) != (ptr)->default_ns)
612 #if TCL_MAJOR_VERSION >= 8
614 typedef struct CallFrame {
615 Tcl_Namespace *nsPtr;
619 struct CallFrame *callerPtr;
620 struct CallFrame *callerVarPtr;
629 # if !defined(TclGetFrame) && !defined(TclGetFrame_TCL_DECLARED)
630 EXTERN int TclGetFrame
_((Tcl_Interp *,
CONST char *, CallFrame **));
632 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
634 # ifndef FunctionNum_of_GetFrame
635 #define FunctionNum_of_GetFrame 32
637 struct DummyTclIntStubs_for_GetFrame {
639 struct TclIntStubHooks *hooks;
640 void (*
func[FunctionNum_of_GetFrame])();
641 int (*tclGetFrame)
_((Tcl_Interp *,
CONST char *, CallFrame **));
643 #define TclGetFrame \
644 (((struct DummyTclIntStubs_for_GetFrame *)tclIntStubsPtr)->tclGetFrame)
648 # if !defined(Tcl_PopCallFrame) && !defined(Tcl_PopCallFrame_TCL_DECLARED)
649 EXTERN void Tcl_PopCallFrame
_((Tcl_Interp *));
650 EXTERN int Tcl_PushCallFrame
_((Tcl_Interp *, Tcl_CallFrame *, Tcl_Namespace *,
int));
652 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
653 # ifndef Tcl_PopCallFrame
654 # ifndef FunctionNum_of_PopCallFrame
655 #define FunctionNum_of_PopCallFrame 128
657 struct DummyTclIntStubs_for_PopCallFrame {
659 struct TclIntStubHooks *hooks;
660 void (*
func[FunctionNum_of_PopCallFrame])();
661 void (*tcl_PopCallFrame)
_((Tcl_Interp *));
662 int (*tcl_PushCallFrame)
_((Tcl_Interp *, Tcl_CallFrame *, Tcl_Namespace *,
int));
665 #define Tcl_PopCallFrame \
666 (((struct DummyTclIntStubs_for_PopCallFrame *)tclIntStubsPtr)->tcl_PopCallFrame)
667 #define Tcl_PushCallFrame \
668 (((struct DummyTclIntStubs_for_PopCallFrame *)tclIntStubsPtr)->tcl_PushCallFrame)
674 typedef struct CallFrame {
675 Tcl_HashTable varTable;
679 struct CallFrame *callerPtr;
680 struct CallFrame *callerVarPtr;
683 # ifndef Tcl_CallFrame
684 #define Tcl_CallFrame CallFrame
687 # if !defined(TclGetFrame) && !defined(TclGetFrame_TCL_DECLARED)
688 EXTERN int TclGetFrame
_((Tcl_Interp *,
CONST char *, CallFrame **));
691 # if !defined(Tcl_PopCallFrame) && !defined(Tcl_PopCallFrame_TCL_DECLARED)
692 typedef struct DummyInterp {
696 Tcl_HashTable dummy4;
697 Tcl_HashTable dummy5;
698 Tcl_HashTable dummy6;
702 CallFrame *varFramePtr;
706 Tcl_PopCallFrame(interp)
709 DummyInterp *iPtr = (DummyInterp*)interp;
710 CallFrame *frame = iPtr->varFramePtr;
713 iPtr->framePtr = frame.callerPtr;
714 iPtr->varFramePtr = frame.callerVarPtr;
720 #define Tcl_Namespace char
723 Tcl_PushCallFrame(interp, framePtr, nsPtr, isProcCallFrame)
725 Tcl_CallFrame *framePtr;
726 Tcl_Namespace *nsPtr;
729 DummyInterp *iPtr = (DummyInterp*)interp;
730 CallFrame *frame = (CallFrame *)framePtr;
733 Tcl_InitHashTable(&frame.varTable, TCL_STRING_KEYS);
734 if (iPtr->varFramePtr !=
NULL) {
735 frame.level = iPtr->varFramePtr->level + 1;
739 frame.callerPtr = iPtr->framePtr;
740 frame.callerVarPtr = iPtr->varFramePtr;
741 iPtr->framePtr = &frame;
742 iPtr->varFramePtr = &frame;
756 #if TCL_NAMESPACE_DEBUG
757 Tcl_Namespace *default_ns;
759 #ifdef RUBY_USE_NATIVE_THREAD
760 Tcl_ThreadId tk_thread_id;
780 if (ptr->
ip == (Tcl_Interp*)
NULL) {
791 if (!ptr || !ptr->ip || Tcl_InterpDeleted(ptr->ip)
793 || rbtk_invalid_namespace(ptr)
796 DUMP1(
"ip is deleted");
808 if (ptr->ip == (Tcl_Interp*)
NULL) {
812 Tcl_Preserve((ClientData)ptr->ip);
814 return(ptr->ref_count);
822 if (ptr->ref_count < 0) {
824 }
else if (ptr->ip == (Tcl_Interp*)
NULL) {
828 Tcl_Release((ClientData)ptr->ip);
830 return(ptr->ref_count);
835 #ifdef HAVE_STDARG_PROTOTYPES
852 buf[BUFSIZ - 1] =
'\0';
857 Tcl_ResetResult(ptr->
ip);
865 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
869 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 84
870 #error Ruby/Tk-Kit requires Tcl/Tk8.4 or later.
890 #if defined USE_TCL_STUBS || defined USE_TK_STUBS
891 # error Not support Tcl/Tk stubs with Ruby/Tk-Kit or Rubykit.
894 #ifndef KIT_INCLUDES_ZLIB
895 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
896 #define KIT_INCLUDES_ZLIB 1
898 #define KIT_INCLUDES_ZLIB 0
903 #define WIN32_LEAN_AND_MEAN
905 #undef WIN32_LEAN_AND_MEAN
908 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
909 EXTERN Tcl_Obj* TclGetStartupScriptPath();
910 EXTERN void TclSetStartupScriptPath
_((Tcl_Obj*));
911 #define Tcl_GetStartupScript(encPtr) TclGetStartupScriptPath()
912 #define Tcl_SetStartupScript(path,enc) TclSetStartupScriptPath(path)
914 #if !defined(TclSetPreInitScript) && !defined(TclSetPreInitScript_TCL_DECLARED)
915 EXTERN char* TclSetPreInitScript
_((
char *));
918 #ifndef KIT_INCLUDES_TK
919 # define KIT_INCLUDES_TK 1
924 Tcl_AppInitProc Vfs_Init, Rechan_Init;
925 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
926 Tcl_AppInitProc Pwb_Init;
930 Tcl_AppInitProc Vlerq_Init, Vlerq_SafeInit;
932 Tcl_AppInitProc Mk4tcl_Init;
935 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
936 Tcl_AppInitProc Thread_Init;
939 #if KIT_INCLUDES_ZLIB
940 Tcl_AppInitProc Zlib_Init;
943 #ifdef KIT_INCLUDES_ITCL
944 Tcl_AppInitProc Itcl_Init;
948 Tcl_AppInitProc Dde_Init, Dde_SafeInit, Registry_Init;
953 #define RUBYTK_KITPATH_CONST_NAME "RUBYTK_KITPATH"
955 static char *rubytk_kitpath =
NULL;
957 static char rubytkkit_preInitCmd[] =
958 "proc tclKitPreInit {} {\n"
959 "rename tclKitPreInit {}\n"
960 "load {} rubytk_kitpath\n"
961 #if KIT_INCLUDES_ZLIB
962 "catch {load {} zlib}\n"
966 "namespace eval ::vlerq {}\n"
967 "if {[catch { vlerq open $::tcl::kitpath } ::vlerq::starkit_root]} {\n"
970 "set files [vlerq get $::vlerq::starkit_root 0 dirs 0 files]\n"
971 "set n [lsearch [vlerq get $files * name] boot.tcl]\n"
974 "array set a [vlerq get $files $n]\n"
977 #if defined KIT_VFS_WRITABLE && !defined CREATE_RUBYKIT
979 "mk::file open exe $::tcl::kitpath\n"
981 "mk::file open exe $::tcl::kitpath -readonly\n"
983 "set n [mk::select exe.dirs!0.files name boot.tcl]\n"
984 "if {[llength $n] == 1} {\n"
985 "array set a [mk::get exe.dirs!0.files!$n]\n"
987 "if {![info exists a(contents)]} { error {no boot.tcl file} }\n"
988 "if {$a(size) != [string length $a(contents)]} {\n"
989 "set a(contents) [zlib decompress $a(contents)]\n"
991 "if {$a(contents) eq \"\"} { error {empty boot.tcl} }\n"
992 "uplevel #0 $a(contents)\n"
994 "} elseif {[lindex $::argv 0] eq \"-init-\"} {\n"
995 "uplevel #0 { source [lindex $::argv 1] }\n"
1000 "set vfsdir \"[file rootname $::tcl::kitpath].vfs\"\n"
1001 "if {[file isdirectory $vfsdir]} {\n"
1002 "set ::tcl_library [file join $vfsdir lib tcl$::tcl_version]\n"
1003 "set ::tcl_libPath [list $::tcl_library [file join $vfsdir lib]]\n"
1004 "catch {uplevel #0 [list source [file join $vfsdir config.tcl]]}\n"
1005 "uplevel #0 [list source [file join $::tcl_library init.tcl]]\n"
1006 "set ::auto_path $::tcl_libPath\n"
1008 "error \"\n $::tcl::kitpath has no VFS data to start up\"\n"
1018 static const char initScript[] =
1019 "if {[file isfile [file join $::tcl::kitpath main.tcl]]} {\n"
1020 "if {[info commands console] != {}} { console hide }\n"
1021 "set tcl_interactive 0\n"
1023 "set argv [linsert $argv 0 $argv0]\n"
1024 "set argv0 [file join $::tcl::kitpath main.tcl]\n"
1032 set_rubytk_kitpath(
const char *kitpath)
1035 int len = (int)
strlen(kitpath);
1036 if (rubytk_kitpath) {
1037 ckfree(rubytk_kitpath);
1040 rubytk_kitpath = (
char *)ckalloc(len + 1);
1041 memcpy(rubytk_kitpath, kitpath, len);
1042 rubytk_kitpath[len] =
'\0';
1044 return rubytk_kitpath;
1050 #define DEV_NULL "NUL"
1052 #define DEV_NULL "/dev/null"
1056 check_tclkit_std_channels()
1065 chan = Tcl_GetStdChannel(TCL_STDIN);
1067 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"r", 0);
1069 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1071 Tcl_SetStdChannel(chan, TCL_STDIN);
1073 chan = Tcl_GetStdChannel(TCL_STDOUT);
1075 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"w", 0);
1077 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1079 Tcl_SetStdChannel(chan, TCL_STDOUT);
1081 chan = Tcl_GetStdChannel(TCL_STDERR);
1083 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"w", 0);
1085 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1087 Tcl_SetStdChannel(chan, TCL_STDERR);
1094 rubytk_kitpathObjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *
const objv[])
1098 set_rubytk_kitpath(Tcl_GetString(objv[1]));
1099 }
else if (objc > 2) {
1100 Tcl_WrongNumArgs(interp, 1, objv,
"?path?");
1102 str = rubytk_kitpath ? rubytk_kitpath : Tcl_GetNameOfExecutable();
1103 Tcl_SetObjResult(interp, Tcl_NewStringObj(str, -1));
1112 rubytk_kitpath_init(Tcl_Interp *interp)
1114 Tcl_CreateObjCommand(interp,
"::tcl::kitpath", rubytk_kitpathObjCmd, 0, 0);
1115 if (Tcl_LinkVar(interp,
"::tcl::kitpath", (
char *) &rubytk_kitpath,
1116 TCL_LINK_STRING | TCL_LINK_READ_ONLY) != TCL_OK) {
1117 Tcl_ResetResult(interp);
1120 Tcl_CreateObjCommand(interp,
"::tcl::rubytk_kitpath", rubytk_kitpathObjCmd, 0, 0);
1121 if (Tcl_LinkVar(interp,
"::tcl::rubytk_kitpath", (
char *) &rubytk_kitpath,
1122 TCL_LINK_STRING | TCL_LINK_READ_ONLY) != TCL_OK) {
1123 Tcl_ResetResult(interp);
1126 if (rubytk_kitpath ==
NULL) {
1131 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1134 return Tcl_PkgProvide(interp,
"rubytk_kitpath",
"1.0");
1140 init_static_tcltk_packages()
1145 check_tclkit_std_channels();
1147 #ifdef KIT_INCLUDES_ITCL
1148 Tcl_StaticPackage(0,
"Itcl", Itcl_Init,
NULL);
1151 Tcl_StaticPackage(0,
"Vlerq", Vlerq_Init, Vlerq_SafeInit);
1153 Tcl_StaticPackage(0,
"Mk4tcl", Mk4tcl_Init,
NULL);
1155 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
1156 Tcl_StaticPackage(0,
"pwb", Pwb_Init,
NULL);
1158 Tcl_StaticPackage(0,
"rubytk_kitpath", rubytk_kitpath_init,
NULL);
1159 Tcl_StaticPackage(0,
"rechan", Rechan_Init,
NULL);
1160 Tcl_StaticPackage(0,
"vfs", Vfs_Init,
NULL);
1161 #if KIT_INCLUDES_ZLIB
1162 Tcl_StaticPackage(0,
"zlib", Zlib_Init,
NULL);
1164 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
1165 Tcl_StaticPackage(0,
"Thread", Thread_Init, Thread_SafeInit);
1168 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
1169 Tcl_StaticPackage(0,
"dde", Dde_Init, Dde_SafeInit);
1171 Tcl_StaticPackage(0,
"dde", Dde_Init,
NULL);
1173 Tcl_StaticPackage(0,
"registry", Registry_Init,
NULL);
1175 #ifdef KIT_INCLUDES_TK
1176 Tcl_StaticPackage(0,
"Tk", Tk_Init, Tk_SafeInit);
1183 call_tclkit_init_script(Tcl_Interp *interp)
1189 if (Tcl_EvalEx(interp, initScript, -1, TCL_EVAL_GLOBAL) == TCL_OK) {
1190 const char *encoding =
NULL;
1191 Tcl_Obj* path = Tcl_GetStartupScript(&encoding);
1192 Tcl_SetStartupScript(Tcl_GetObjResult(interp), encoding);
1194 Tcl_Eval(interp,
"incr argc -1; set argv [lrange $argv 1 end]");
1208 EXTERN void TkWinSetHINSTANCE(HINSTANCE hInstance);
1209 void rbtk_win32_SetHINSTANCE(
const char *module_name)
1216 hInst = GetModuleHandle(module_name);
1217 TkWinSetHINSTANCE(hInst);
1229 init_static_tcltk_packages();
1233 const_id =
rb_intern(RUBYTK_KITPATH_CONST_NAME);
1236 volatile VALUE pathobj;
1240 #ifdef HAVE_RUBY_ENCODING_H
1248 #ifdef CREATE_RUBYTK_KIT
1249 if (rubytk_kitpath ==
NULL) {
1253 volatile VALUE basename;
1263 if (rubytk_kitpath ==
NULL) {
1264 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1267 TclSetPreInitScript(rubytkkit_preInitCmd);
1312 #if TCL_MAJOR_VERSION >= 8
1315 if (Tcl_IsSafe(ptr->
ip)) {
1316 DUMP1(
"Tk_SafeInit");
1323 "tcltklib: can't find Tk_SafeInit()");
1326 "tcltklib: fail to Tk_SafeInit(). %s",
1330 "tcltklib: fail to Tk_InitStubs(). %s",
1334 "tcltklib: unknown error(%d) on ruby_tk_stubs_safeinit", st);
1344 "tcltklib: can't find Tk_Init()");
1347 "tcltklib: fail to Tk_Init(). %s",
1351 "tcltklib: fail to Tk_InitStubs(). %s",
1355 "tcltklib: unknown error(%d) on ruby_tk_stubs_init", st);
1366 #ifdef RUBY_USE_NATIVE_THREAD
1367 ptr->tk_thread_id = Tcl_GetCurrentThread();
1386 DUMP1(
"find a pending exception");
1387 if (rbtk_eventloop_depth > 0
1388 || rbtk_internal_eventloop_handler > 0
1392 rbtk_pending_exception =
Qnil;
1395 DUMP1(
"pending_exception_check0: call rb_jump_tag(retry)");
1398 DUMP1(
"pending_exception_check0: call rb_jump_tag(redo)");
1401 DUMP1(
"pending_exception_check0: call rb_jump_tag(throw)");
1422 DUMP1(
"find a pending exception");
1424 if (rbtk_eventloop_depth > 0
1425 || rbtk_internal_eventloop_handler > 0
1429 rbtk_pending_exception =
Qnil;
1439 DUMP1(
"pending_exception_check1: call rb_jump_tag(retry)");
1442 DUMP1(
"pending_exception_check1: call rb_jump_tag(redo)");
1445 DUMP1(
"pending_exception_check1: call rb_jump_tag(throw)");
1466 #if TCL_MAJOR_VERSION >= 8
1470 DUMP1(
"original_exit is called");
1472 if (!(ptr->has_orig_exit))
return;
1477 Tcl_ResetResult(ptr->ip);
1479 info = &(ptr->orig_exit_info);
1482 #if TCL_MAJOR_VERSION >= 8
1483 state_obj = Tcl_NewIntObj(state);
1486 if (info->isNativeObjectProc) {
1488 #define USE_RUBY_ALLOC 0
1490 argv = (Tcl_Obj **)
ALLOC_N(Tcl_Obj *, 3);
1494 Tcl_Preserve((ClientData)argv);
1497 cmd_obj = Tcl_NewStringObj(
"exit", 4);
1501 argv[1] = state_obj;
1502 argv[2] = (Tcl_Obj *)
NULL;
1505 = (*(info->objProc))(info->objClientData, ptr->ip, 2,
argv);
1513 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1516 Tcl_Release((ClientData)argv);
1519 ckfree((
char*)argv);
1523 #undef USE_RUBY_ALLOC
1528 #define USE_RUBY_ALLOC 0
1534 Tcl_Preserve((ClientData)argv);
1537 argv[0] = (
char *)
"exit";
1539 argv[1] = Tcl_GetStringFromObj(state_obj, (
int*)
NULL);
1540 argv[2] = (
char *)
NULL;
1542 ptr->return_value = (*(info->proc))(info->clientData, ptr->ip, 2,
argv);
1548 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1551 Tcl_Release((ClientData)argv);
1554 ckfree((
char*)argv);
1558 #undef USE_RUBY_ALLOC
1567 #define USE_RUBY_ALLOC 0
1569 argv = (
char **)
ALLOC_N(
char *, 3);
1573 Tcl_Preserve((ClientData)argv);
1578 argv[2] = (
char *)
NULL;
1580 ptr->return_value = (*(info->proc))(info->clientData, ptr->ip,
1587 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1590 Tcl_Release((ClientData)argv);
1597 #undef USE_RUBY_ALLOC
1600 DUMP1(
"complete original_exit");
1612 ClientData clientData;
1619 DUMP1(
"call _timer_for_tcl");
1624 Tcl_DeleteTimerHandler(timer_token);
1628 if (timer_tick > 0) {
1632 timer_token = (Tcl_TimerToken)
NULL;
1641 #ifdef RUBY_USE_NATIVE_THREAD
1642 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE
1644 toggle_eventloop_window_mode_for_idle()
1646 if (window_event_mode & TCL_IDLE_EVENTS) {
1648 window_event_mode |= TCL_WINDOW_EVENTS;
1649 window_event_mode &= ~TCL_IDLE_EVENTS;
1653 window_event_mode |= TCL_IDLE_EVENTS;
1654 window_event_mode &= ~TCL_WINDOW_EVENTS;
1669 window_event_mode = ~0;
1671 window_event_mode = ~TCL_WINDOW_EVENTS;
1681 if ( ~window_event_mode ) {
1700 "timer-tick parameter must be 0 or positive number");
1707 Tcl_DeleteTimerHandler(timer_token);
1709 timer_tick = req_timer_tick = ttick;
1710 if (timer_tick > 0) {
1715 timer_token = (Tcl_TimerToken)
NULL;
1742 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1767 "no_event_wait parameter must be positive number");
1770 no_event_wait = t_wait;
1779 return INT2NUM(no_event_wait);
1794 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1814 int lpmax =
NUM2INT(loop_max);
1815 int no_ev =
NUM2INT(no_event);
1819 if (lpmax <= 0 || no_ev <= 0) {
1823 event_loop_max = lpmax;
1824 no_event_tick = no_ev;
1849 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1868 struct Tcl_Time tcl_time;
1871 switch(
TYPE(time)) {
1894 Tcl_SetMaxBlockTime(&tcl_time);
1903 if (
NIL_P(eventloop_thread)) {
1916 if (event_loop_abort_on_exc > 0) {
1918 }
else if (event_loop_abort_on_exc == 0) {
1938 event_loop_abort_on_exc = 1;
1939 }
else if (
NIL_P(val)) {
1940 event_loop_abort_on_exc = -1;
1942 event_loop_abort_on_exc = 0;
1960 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1974 return INT2FIX(Tk_GetNumMainWindows());
1984 #ifdef RUBY_USE_NATIVE_THREAD
1996 tcl_time.usec = 1000L * (long)no_event_tick;
1997 Tcl_SetMaxBlockTime(&tcl_time);
2007 #ifdef RUBY_USE_NATIVE_THREAD
2009 #ifdef HAVE_PROTOTYPES
2010 call_DoOneEvent_core(
VALUE flag_val)
2012 call_DoOneEvent_core(flag_val)
2019 if (Tcl_DoOneEvent(flag)) {
2027 #ifdef HAVE_PROTOTYPES
2039 #ifdef HAVE_PROTOTYPES
2049 if (Tcl_DoOneEvent(flag)) {
2060 #ifdef HAVE_PROTOTYPES
2061 eventloop_sleep(
VALUE dummy)
2063 eventloop_sleep(dummy)
2069 if (no_event_wait <= 0) {
2074 t.tv_usec = (int)(no_event_wait*1000.0);
2076 #ifdef HAVE_NATIVETHREAD
2077 #ifndef RUBY_USE_NATIVE_THREAD
2079 rb_bug(
"cross-thread violation on eventloop_sleep()");
2088 #ifdef HAVE_NATIVETHREAD
2089 #ifndef RUBY_USE_NATIVE_THREAD
2091 rb_bug(
"cross-thread violation on eventloop_sleep()");
2100 #define USE_EVLOOP_THREAD_ALONE_CHECK_FLAG 0
2102 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2104 get_thread_alone_check_flag()
2106 #ifdef RUBY_USE_NATIVE_THREAD
2138 #define TRAP_CHECK() do { \
2139 if (trap_check(check_var) == 0) return 0; \
2145 DUMP1(
"trap check");
2149 if (check_var != (
int*)
NULL) {
2158 if (rb_trap_pending) {
2160 if (rb_prohibit_interrupt || check_var != (
int*)
NULL) {
2175 DUMP1(
"check eventloop_interp");
2176 if (eventloop_interp != (Tcl_Interp*)
NULL
2177 && Tcl_InterpDeleted(eventloop_interp)) {
2178 DUMP2(
"eventloop_interp(%p) was deleted", eventloop_interp);
2193 int found_event = 1;
2199 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2200 int thread_alone_check_flag = 1;
2203 if (update_flag)
DUMP1(
"update loop start!!");
2208 Tcl_DeleteTimerHandler(timer_token);
2210 if (timer_tick > 0) {
2217 timer_token = (Tcl_TimerToken)
NULL;
2220 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2222 thread_alone_check_flag = get_thread_alone_check_flag();
2228 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2233 DUMP1(
"no other thread");
2234 event_loop_wait_event = 0;
2237 event_flag = update_flag;
2240 event_flag = TCL_ALL_EVENTS;
2244 if (timer_tick == 0 && update_flag == 0) {
2246 timer_token = Tcl_CreateTimerHandler(timer_tick,
2251 if (check_var != (
int *)
NULL) {
2252 if (*check_var || !found_event) {
2255 if (interp != (Tcl_Interp*)
NULL
2256 && Tcl_InterpDeleted(interp)) {
2264 INT2FIX(event_flag), &status));
2269 rbtk_pending_exception
2274 if (!
NIL_P(rbtk_pending_exception)) {
2275 if (rbtk_eventloop_depth == 0) {
2277 rbtk_pending_exception =
Qnil;
2295 if (depth != rbtk_eventloop_depth) {
2296 DUMP2(
"DoOneEvent(1) abnormal exit!! %d",
2297 rbtk_eventloop_depth);
2300 if (check_var != (
int*)
NULL && !
NIL_P(rbtk_pending_exception)) {
2301 DUMP1(
"exception on wait");
2310 if (update_flag != 0) {
2312 DUMP1(
"next update loop");
2315 DUMP1(
"update complete");
2323 DUMP1(
"check Root Widget");
2330 if (loop_counter++ > 30000) {
2338 DUMP1(
"there are other threads");
2339 event_loop_wait_event = 1;
2344 event_flag = update_flag;
2347 event_flag = TCL_ALL_EVENTS;
2353 while(tick_counter < event_loop_max) {
2354 if (check_var != (
int *)
NULL) {
2355 if (*check_var || !found_event) {
2358 if (interp != (Tcl_Interp*)
NULL
2359 && Tcl_InterpDeleted(interp)) {
2365 if (
NIL_P(eventloop_thread) || current == eventloop_thread) {
2369 #ifdef RUBY_USE_NATIVE_THREAD
2372 INT2FIX(event_flag), &status));
2375 INT2FIX(event_flag & window_event_mode),
2377 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE
2379 if (toggle_eventloop_window_mode_for_idle()) {
2392 INT2FIX(event_flag), &status));
2395 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
2396 if (have_rb_thread_waiting_for_value) {
2397 have_rb_thread_waiting_for_value = 0;
2406 rbtk_pending_exception
2408 "unknown exception");
2412 if (!
NIL_P(rbtk_pending_exception)) {
2413 if (rbtk_eventloop_depth == 0) {
2415 rbtk_pending_exception =
Qnil;
2433 if (depth != rbtk_eventloop_depth) {
2434 DUMP2(
"DoOneEvent(2) abnormal exit!! %d",
2435 rbtk_eventloop_depth);
2441 if (check_var != (
int*)
NULL
2442 && !
NIL_P(rbtk_pending_exception)) {
2443 DUMP1(
"exception on wait");
2455 if (update_flag != 0) {
2456 DUMP1(
"update complete");
2470 rbtk_pending_exception
2472 "unknown exception");
2476 if (!
NIL_P(rbtk_pending_exception)) {
2477 if (rbtk_eventloop_depth == 0) {
2479 rbtk_pending_exception =
Qnil;
2501 DUMP2(
"sleep eventloop %lx", current);
2502 DUMP2(
"eventloop thread is %lx", eventloop_thread);
2507 if (!
NIL_P(watchdog_thread) && eventloop_thread != current) {
2514 DUMP1(
"check Root Widget");
2521 if (loop_counter++ > 30000) {
2526 if (run_timer_flag) {
2535 DUMP1(
"thread scheduling");
2539 DUMP1(
"check interrupts");
2540 #if defined(RUBY_USE_NATIVE_THREAD) || defined(RUBY_VM)
2594 rbtk_pending_exception
2623 DUMP2(
"eventloop_ensure: current-thread : %lx", current_evloop);
2624 DUMP2(
"eventloop_ensure: eventloop-thread : %lx", eventloop_thread);
2625 if (eventloop_thread != current_evloop) {
2626 DUMP2(
"finish eventloop %lx (NOT current eventloop)", current_evloop);
2636 while((eventloop_thread =
rb_ary_pop(eventloop_stack))) {
2637 DUMP2(
"eventloop-ensure: new eventloop-thread -> %lx",
2640 if (eventloop_thread == current_evloop) {
2641 rbtk_eventloop_depth--;
2642 DUMP2(
"eventloop %lx : back from recursive call", current_evloop);
2646 if (
NIL_P(eventloop_thread)) {
2647 Tcl_DeleteTimerHandler(timer_token);
2648 timer_token = (Tcl_TimerToken)
NULL;
2658 DUMP2(
"eventloop-enshure: wake up parent %lx", eventloop_thread);
2665 #ifdef RUBY_USE_NATIVE_THREAD
2666 if (
NIL_P(eventloop_thread)) {
2667 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2676 DUMP2(
"finish current eventloop %lx", current_evloop);
2694 #ifdef RUBY_USE_NATIVE_THREAD
2695 tk_eventloop_thread_id = Tcl_GetCurrentThread();
2698 if (parent_evloop == eventloop_thread) {
2699 DUMP2(
"eventloop: recursive call on %lx", parent_evloop);
2700 rbtk_eventloop_depth++;
2703 if (!
NIL_P(parent_evloop) && parent_evloop != eventloop_thread) {
2704 DUMP2(
"wait for stop of parent_evloop %lx", parent_evloop);
2706 DUMP2(
"parent_evloop %lx doesn't stop", parent_evloop);
2709 DUMP1(
"succeed to stop parent");
2714 DUMP3(
"tcltklib: eventloop-thread : %lx -> %lx\n",
2715 parent_evloop, eventloop_thread);
2740 VALUE check_rootwidget;
2742 if (
rb_scan_args(argc, argv,
"01", &check_rootwidget) == 0) {
2743 check_rootwidget =
Qtrue;
2744 }
else if (
RTEST(check_rootwidget)) {
2745 check_rootwidget =
Qtrue;
2747 check_rootwidget =
Qfalse;
2768 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2773 eventloop_interp = ptr->
ip;
2775 eventloop_interp = (Tcl_Interp*)
NULL;
2782 VALUE check_rootwidget;
2788 #define EVLOOP_WAKEUP_CHANCE 3
2792 VALUE check_rootwidget;
2797 int check =
RTEST(check_rootwidget);
2806 if (!
NIL_P(watchdog_thread)) {
2817 if (
NIL_P(eventloop_thread)
2820 DUMP2(
"eventloop thread %lx is sleeping or dead",
2823 (
void*)&check_rootwidget);
2824 DUMP2(
"create new eventloop thread %lx", evloop);
2835 if (event_loop_wait_event) {
2851 eventloop_thread =
Qnil;
2852 #ifdef RUBY_USE_NATIVE_THREAD
2853 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2864 VALUE check_rootwidget;
2868 "eventloop_watchdog is not implemented on Ruby VM.");
2871 if (
rb_scan_args(argc, argv,
"01", &check_rootwidget) == 0) {
2872 check_rootwidget =
Qtrue;
2873 }
else if (
RTEST(check_rootwidget)) {
2874 check_rootwidget =
Qtrue;
2876 check_rootwidget =
Qfalse;
2896 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2944 #ifdef HAVE_PROTOTYPES
2962 int status, foundEvent;
3000 if (
NIL_P(rbtk_pending_exception)) {
3007 rbtk_pending_exception =
Qnil;
3024 volatile VALUE vflags;
3028 if (!
NIL_P(eventloop_thread)) {
3035 flags = TCL_ALL_EVENTS | TCL_DONT_WAIT;
3042 flags |= TCL_DONT_WAIT;
3054 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
3056 flags |= TCL_DONT_WAIT;
3061 found_event = Tcl_DoOneEvent(flags);
3103 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
3105 Tcl_Encoding encoding;
3114 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
3120 encoding = (Tcl_Encoding)
NULL;
3139 Tcl_DStringInit(&dstr);
3140 Tcl_DStringFree(&dstr);
3141 Tcl_ExternalToUtfDString(encoding, buf,
RSTRING_LENINT(msg), &dstr);
3143 Tcl_AppendResult(interp, Tcl_DStringValue(&dstr), (
char*)
NULL);
3144 DUMP2(
"error message:%s", Tcl_DStringValue(&dstr));
3145 Tcl_DStringFree(&dstr);
3186 #ifdef HAVE_PROTOTYPES
3199 Tcl_ResetResult(interp);
3229 DUMP1(
"rb_protect: retry");
3230 exc =
rb_exc_new2(eTkCallbackRetry,
"retry jump error");
3238 DUMP1(
"rb_protect: redo");
3239 exc =
rb_exc_new2(eTkCallbackRedo,
"redo jump error");
3263 DUMP1(
"rb_protect: throw");
3264 exc =
rb_exc_new2(eTkCallbackThrow,
"throw jump error");
3273 sprintf(buf,
"unknown loncaljmp status %d", status);
3287 Tcl_ResetResult(interp);
3292 volatile VALUE backtrace;
3299 DUMP1(
"set backtrace");
3309 if (eclass == eTkCallbackReturn)
3312 if (eclass == eTkCallbackBreak)
3315 if (eclass == eTkCallbackContinue)
3316 return TCL_CONTINUE;
3319 rbtk_pending_exception = exc;
3324 rbtk_pending_exception = exc;
3332 if (
SYM2ID(reason) == ID_return)
3335 if (
SYM2ID(reason) == ID_break)
3338 if (
SYM2ID(reason) == ID_next)
3339 return TCL_CONTINUE;
3353 DUMP1(
"Tcl_AppendResult");
3372 #ifdef HAVE_NATIVETHREAD
3373 #ifndef RUBY_USE_NATIVE_THREAD
3375 rb_bug(
"cross-thread violation on tcl_protect()");
3384 int old_trapflag = rb_trap_immediate;
3385 rb_trap_immediate = 0;
3387 rb_trap_immediate = old_trapflag;
3395 #if TCL_MAJOR_VERSION >= 8
3397 ClientData clientData;
3400 Tcl_Obj *
CONST argv[];
3403 ClientData clientData;
3413 if (interp == (Tcl_Interp*)
NULL) {
3423 "wrong number of arguments (%d for 1)", argc - 1);
3425 char buf[
sizeof(int)*8 + 1];
3426 Tcl_ResetResult(interp);
3427 sprintf(
buf,
"%d", argc-1);
3428 Tcl_AppendResult(interp,
"wrong number of arguments (",
3429 buf,
" for 1)", (
char *)
NULL);
3437 #if TCL_MAJOR_VERSION >= 8
3445 str = Tcl_GetStringFromObj(argv[1], &len);
3448 memcpy(arg, str, len);
3459 DUMP2(
"rb_eval_string(%s)", arg);
3463 #if TCL_MAJOR_VERSION >= 8
3480 DUMP1(
"call ip_ruby_cmd_core");
3483 ret =
rb_apply(arg->receiver, arg->method, arg->args);
3484 DUMP2(
"rb_apply return:%lx", ret);
3486 DUMP1(
"finish ip_ruby_cmd_core");
3491 #define SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER 1
3503 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3522 head = name =
strdup(name);
3525 if (*head ==
':') head += 2;
3549 volatile VALUE receiver;
3550 #if !SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3554 if (str[0] ==
':' || (
'A' <= str[0] && str[0] <=
'Z')) {
3556 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3560 if (state)
return Qnil;
3562 }
else if (str[0] ==
'$') {
3574 memcpy(buf + 1, str, len);
3586 #if TCL_MAJOR_VERSION >= 8
3588 ClientData clientData;
3591 Tcl_Obj *
CONST argv[];
3594 ClientData clientData;
3600 volatile VALUE receiver;
3611 if (interp == (Tcl_Interp*)
NULL) {
3621 Tcl_ResetResult(interp);
3622 Tcl_AppendResult(interp,
"too few arguments", (
char *)
NULL);
3635 #if TCL_MAJOR_VERSION >= 8
3636 str = Tcl_GetStringFromObj(argv[1], &len);
3640 DUMP2(
"receiver:%s",str);
3643 if (
NIL_P(receiver)) {
3646 "unknown class/module/global-variable '%s'", str);
3648 Tcl_ResetResult(interp);
3649 Tcl_AppendResult(interp,
"unknown class/module/global-variable '",
3650 str,
"'", (
char *)
NULL);
3659 #if TCL_MAJOR_VERSION >= 8
3660 str = Tcl_GetStringFromObj(argv[2], &len);
3668 for(i = 3; i <
argc; i++) {
3670 #if TCL_MAJOR_VERSION >= 8
3671 str = Tcl_GetStringFromObj(argv[i], &len);
3677 DUMP2(
"arg:%s",str);
3678 #ifndef HAVE_STRUCT_RARRAY_LEN
3710 #if TCL_MAJOR_VERSION >= 8
3711 #ifdef HAVE_PROTOTYPES
3712 ip_InterpExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3713 int argc, Tcl_Obj *
CONST argv[])
3715 ip_InterpExitObjCmd(clientData, interp, argc, argv)
3716 ClientData clientData;
3719 Tcl_Obj *
CONST argv[];
3722 #ifdef HAVE_PROTOTYPES
3724 int argc,
char *argv[])
3727 ClientData clientData;
3734 DUMP1(
"start ip_InterpExitCommand");
3735 if (interp != (Tcl_Interp*)
NULL
3736 && !Tcl_InterpDeleted(interp)
3738 && !ip_null_namespace(interp)
3741 Tcl_ResetResult(interp);
3744 if (!Tcl_InterpDeleted(interp)) {
3747 Tcl_DeleteInterp(interp);
3748 Tcl_Release(interp);
3755 #if TCL_MAJOR_VERSION >= 8
3756 #ifdef HAVE_PROTOTYPES
3757 ip_RubyExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3758 int argc, Tcl_Obj *
CONST argv[])
3760 ip_RubyExitObjCmd(clientData, interp, argc, argv)
3761 ClientData clientData;
3764 Tcl_Obj *
CONST argv[];
3767 #ifdef HAVE_PROTOTYPES
3769 int argc,
char *argv[])
3772 ClientData clientData;
3781 #if TCL_MAJOR_VERSION < 8
3786 DUMP1(
"start ip_RubyExitCommand");
3788 #if TCL_MAJOR_VERSION >= 8
3790 cmd = Tcl_GetStringFromObj(argv[0], (
int*)
NULL);
3793 if (argc < 1 || argc > 2) {
3795 Tcl_AppendResult(interp,
3796 "wrong number of arguments: should be \"",
3797 cmd,
" ?returnCode?\"", (
char *)
NULL);
3801 if (interp == (Tcl_Interp*)
NULL)
return TCL_OK;
3803 Tcl_ResetResult(interp);
3806 if (!Tcl_InterpDeleted(interp)) {
3809 Tcl_DeleteInterp(interp);
3810 Tcl_Release(interp);
3818 Tcl_AppendResult(interp,
3819 "fail to call \"", cmd,
"\"", (
char *)
NULL);
3828 #if TCL_MAJOR_VERSION >= 8
3829 if (Tcl_GetIntFromObj(interp, argv[1], &state) == TCL_ERROR) {
3833 param = Tcl_GetStringFromObj(argv[1], (
int*)
NULL);
3835 state = (int)
strtol(argv[1], &endptr, 0);
3837 Tcl_AppendResult(interp,
3838 "expected integer but got \"",
3839 argv[1],
"\"", (
char *)
NULL);
3846 Tcl_AppendResult(interp,
"fail to call \"", cmd,
" ",
3847 param,
"\"", (
char *)
NULL);
3857 Tcl_AppendResult(interp,
3858 "wrong number of arguments: should be \"",
3859 cmd,
" ?returnCode?\"", (
char *)
NULL);
3872 #if TCL_MAJOR_VERSION >= 8
3873 static int ip_rbUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
3874 Tcl_Obj *
CONST []));
3876 ip_rbUpdateObjCmd(clientData, interp, objc, objv)
3877 ClientData clientData;
3880 Tcl_Obj *
CONST objv[];
3885 ClientData clientData;
3894 static CONST char *updateOptions[] = {
"idletasks", (
char *)
NULL};
3895 enum updateOptions {REGEXP_IDLETASKS};
3897 DUMP1(
"Ruby's 'update' is called");
3898 if (interp == (Tcl_Interp*)
NULL) {
3903 #ifdef HAVE_NATIVETHREAD
3904 #ifndef RUBY_USE_NATIVE_THREAD
3906 rb_bug(
"cross-thread violation on ip_ruby_eval()");
3911 Tcl_ResetResult(interp);
3914 flags = TCL_DONT_WAIT;
3916 }
else if (objc == 2) {
3917 #if TCL_MAJOR_VERSION >= 8
3918 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
3919 "option", 0, &optionIndex) != TCL_OK) {
3922 switch ((
enum updateOptions) optionIndex) {
3923 case REGEXP_IDLETASKS: {
3924 flags = TCL_IDLE_EVENTS;
3928 rb_bug(
"ip_rbUpdateObjCmd: bad option index to UpdateOptions");
3932 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
3933 Tcl_AppendResult(interp,
"bad option \"", objv[1],
3934 "\": must be idletasks", (
char *)
NULL);
3937 flags = TCL_IDLE_EVENTS;
3940 #ifdef Tcl_WrongNumArgs
3941 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
3943 # if TCL_MAJOR_VERSION >= 8
3945 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
3946 Tcl_GetStringFromObj(objv[0], &dummy),
3950 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
3951 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
3957 Tcl_Preserve(interp);
3964 if (!
NIL_P(rbtk_pending_exception)) {
3965 Tcl_Release(interp);
3982 if (rb_trap_pending) {
3984 Tcl_Release(interp);
3995 Tcl_ResetResult(interp);
3996 Tcl_Release(interp);
3998 DUMP1(
"finish Ruby's 'update'");
4014 ClientData clientData;
4018 DUMP1(
"threadUpdateProc is called");
4025 #if TCL_MAJOR_VERSION >= 8
4026 static int ip_rb_threadUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
4027 Tcl_Obj *
CONST []));
4029 ip_rb_threadUpdateObjCmd(clientData, interp, objc, objv)
4030 ClientData clientData;
4033 Tcl_Obj *
CONST objv[];
4039 ClientData clientData;
4048 static CONST char *updateOptions[] = {
"idletasks", (
char *)
NULL};
4049 enum updateOptions {REGEXP_IDLETASKS};
4053 DUMP1(
"Ruby's 'thread_update' is called");
4054 if (interp == (Tcl_Interp*)
NULL) {
4059 #ifdef HAVE_NATIVETHREAD
4060 #ifndef RUBY_USE_NATIVE_THREAD
4062 rb_bug(
"cross-thread violation on ip_rb_threadUpdateCommand()");
4068 ||
NIL_P(eventloop_thread) || eventloop_thread == current_thread) {
4069 #if TCL_MAJOR_VERSION >= 8
4070 DUMP1(
"call ip_rbUpdateObjCmd");
4071 return ip_rbUpdateObjCmd(clientData, interp, objc, objv);
4073 DUMP1(
"call ip_rbUpdateCommand");
4078 DUMP1(
"start Ruby's 'thread_update' body");
4080 Tcl_ResetResult(interp);
4083 flags = TCL_DONT_WAIT;
4085 }
else if (objc == 2) {
4086 #if TCL_MAJOR_VERSION >= 8
4087 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
4088 "option", 0, &optionIndex) != TCL_OK) {
4091 switch ((
enum updateOptions) optionIndex) {
4092 case REGEXP_IDLETASKS: {
4093 flags = TCL_IDLE_EVENTS;
4097 rb_bug(
"ip_rb_threadUpdateObjCmd: bad option index to UpdateOptions");
4101 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
4102 Tcl_AppendResult(interp,
"bad option \"", objv[1],
4103 "\": must be idletasks", (
char *)
NULL);
4106 flags = TCL_IDLE_EVENTS;
4109 #ifdef Tcl_WrongNumArgs
4110 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
4112 # if TCL_MAJOR_VERSION >= 8
4114 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4115 Tcl_GetStringFromObj(objv[0], &dummy),
4119 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4120 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
4126 DUMP1(
"pass argument check");
4131 Tcl_Preserve((ClientData)param);
4133 param->thread = current_thread;
4136 DUMP1(
"set idle proc");
4142 while(!param->done) {
4143 DUMP1(
"wait for complete idle proc");
4147 if (
NIL_P(eventloop_thread)) {
4153 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
4156 Tcl_Release((ClientData)param);
4159 ckfree((
char *)param);
4163 DUMP1(
"finish Ruby's 'thread_update'");
4171 #if TCL_MAJOR_VERSION >= 8
4172 static int ip_rbVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4173 Tcl_Obj *
CONST []));
4174 static int ip_rb_threadVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4175 Tcl_Obj *CONST []));
4176 static int ip_rbTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4177 Tcl_Obj *CONST []));
4178 static int ip_rb_threadTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4179 Tcl_Obj *CONST []));
4189 #if TCL_MAJOR_VERSION >= 8
4194 ClientData clientData;
4200 static char *
VwaitVarProc _((ClientData, Tcl_Interp *,
char *,
char *,
int));
4203 ClientData clientData;
4210 int *donePtr = (
int *) clientData;
4213 return (
char *)
NULL;
4216 #if TCL_MAJOR_VERSION >= 8
4218 ip_rbVwaitObjCmd(clientData, interp, objc, objv)
4219 ClientData clientData;
4222 Tcl_Obj *CONST objv[];
4226 ClientData clientData;
4232 int ret, done, foundEvent;
4237 DUMP1(
"Ruby's 'vwait' is called");
4238 if (interp == (Tcl_Interp*)
NULL) {
4246 && eventloop_thread !=
Qnil
4248 #if TCL_MAJOR_VERSION >= 8
4249 DUMP1(
"call ip_rb_threadVwaitObjCmd");
4250 return ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv);
4252 DUMP1(
"call ip_rb_threadVwaitCommand");
4258 Tcl_Preserve(interp);
4259 #ifdef HAVE_NATIVETHREAD
4260 #ifndef RUBY_USE_NATIVE_THREAD
4262 rb_bug(
"cross-thread violation on ip_rbVwaitCommand()");
4267 Tcl_ResetResult(interp);
4270 #ifdef Tcl_WrongNumArgs
4271 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4276 #if TCL_MAJOR_VERSION >= 8
4278 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4280 nameString = objv[0];
4282 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4283 nameString,
" name\"", (
char *)
NULL);
4288 Tcl_Release(interp);
4295 #if TCL_MAJOR_VERSION >= 8
4298 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4300 nameString = objv[1];
4310 ret = Tcl_TraceVar(interp, nameString,
4311 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4316 if (ret != TCL_OK) {
4317 #if TCL_MAJOR_VERSION >= 8
4320 Tcl_Release(interp);
4332 Tcl_UntraceVar(interp, nameString,
4333 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4339 if (!
NIL_P(rbtk_pending_exception)) {
4340 #if TCL_MAJOR_VERSION >= 8
4343 Tcl_Release(interp);
4360 if (rb_trap_pending) {
4362 #if TCL_MAJOR_VERSION >= 8
4365 Tcl_Release(interp);
4375 Tcl_ResetResult(interp);
4380 Tcl_AppendResult(interp,
"can't wait for variable \"", nameString,
4381 "\": would wait forever", (
char *)
NULL);
4385 #if TCL_MAJOR_VERSION >= 8
4388 Tcl_Release(interp);
4392 #if TCL_MAJOR_VERSION >= 8
4395 Tcl_Release(interp);
4403 #if TCL_MAJOR_VERSION >= 8
4408 ClientData clientData;
4415 char *,
char *,
int));
4418 ClientData clientData;
4425 int *donePtr = (
int *) clientData;
4428 return (
char *)
NULL;
4434 ClientData clientData;
4437 int *donePtr = (
int *) clientData;
4439 if (eventPtr->type == VisibilityNotify) {
4442 if (eventPtr->type == DestroyNotify) {
4450 ClientData clientData;
4453 int *donePtr = (
int *) clientData;
4455 if (eventPtr->type == DestroyNotify) {
4460 #if TCL_MAJOR_VERSION >= 8
4462 ip_rbTkWaitObjCmd(clientData, interp, objc, objv)
4463 ClientData clientData;
4466 Tcl_Obj *CONST objv[];
4470 ClientData clientData;
4476 Tk_Window tkwin = (Tk_Window) clientData;
4479 static CONST
char *optionStrings[] = {
"variable",
"visibility",
"window",
4481 enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW };
4486 DUMP1(
"Ruby's 'tkwait' is called");
4487 if (interp == (Tcl_Interp*)
NULL) {
4495 && eventloop_thread !=
Qnil
4497 #if TCL_MAJOR_VERSION >= 8
4498 DUMP1(
"call ip_rb_threadTkWaitObjCmd");
4499 return ip_rb_threadTkWaitObjCmd((ClientData)tkwin, interp, objc, objv);
4501 DUMP1(
"call ip_rb_threadTkWaitCommand");
4502 return ip_rb_threadTkWwaitCommand((ClientData)tkwin, interp, objc, objv);
4507 Tcl_Preserve(interp);
4508 Tcl_ResetResult(interp);
4511 #ifdef Tcl_WrongNumArgs
4512 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
4517 #if TCL_MAJOR_VERSION >= 8
4518 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4519 Tcl_GetStringFromObj(objv[0], &dummy),
4520 " variable|visibility|window name\"",
4523 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4524 objv[0],
" variable|visibility|window name\"",
4531 Tcl_Release(interp);
4535 #if TCL_MAJOR_VERSION >= 8
4546 ret = Tcl_GetIndexFromObj(interp, objv[1],
4547 (
CONST84 char **)optionStrings,
4548 "option", 0, &index);
4552 if (ret != TCL_OK) {
4553 Tcl_Release(interp);
4559 size_t length =
strlen(objv[1]);
4561 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
4563 index = TKWAIT_VARIABLE;
4564 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
4566 index = TKWAIT_VISIBILITY;
4567 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
4568 index = TKWAIT_WINDOW;
4570 Tcl_AppendResult(interp,
"bad option \"", objv[1],
4571 "\": must be variable, visibility, or window",
4573 Tcl_Release(interp);
4582 #if TCL_MAJOR_VERSION >= 8
4585 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
4587 nameString = objv[2];
4592 switch ((
enum options) index) {
4593 case TKWAIT_VARIABLE:
4603 ret = Tcl_TraceVar(interp, nameString,
4604 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4609 if (ret != TCL_OK) {
4610 #if TCL_MAJOR_VERSION >= 8
4613 Tcl_Release(interp);
4624 Tcl_UntraceVar(interp, nameString,
4625 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4628 #if TCL_MAJOR_VERSION >= 8
4635 if (!
NIL_P(rbtk_pending_exception)) {
4636 Tcl_Release(interp);
4653 if (rb_trap_pending) {
4655 Tcl_Release(interp);
4662 case TKWAIT_VISIBILITY:
4670 window = Tk_NameToWindow(interp, nameString, tkwin);
4673 if (window == NULL) {
4674 Tcl_AppendResult(interp,
": tkwait: ",
4675 "no main-window (not Tk application?)",
4678 #if TCL_MAJOR_VERSION >= 8
4681 Tcl_Release(interp);
4685 Tk_CreateEventHandler(window,
4686 VisibilityChangeMask|StructureNotifyMask,
4696 if (!
NIL_P(rbtk_pending_exception)) {
4697 #if TCL_MAJOR_VERSION >= 8
4700 Tcl_Release(interp);
4717 if (rb_trap_pending) {
4719 #if TCL_MAJOR_VERSION >= 8
4722 Tcl_Release(interp);
4735 Tcl_ResetResult(interp);
4736 Tcl_AppendResult(interp,
"window \"", nameString,
4737 "\" was deleted before its visibility changed",
4742 #if TCL_MAJOR_VERSION >= 8
4745 Tcl_Release(interp);
4752 #if TCL_MAJOR_VERSION >= 8
4756 Tk_DeleteEventHandler(window,
4757 VisibilityChangeMask|StructureNotifyMask,
4772 window = Tk_NameToWindow(interp, nameString, tkwin);
4775 #if TCL_MAJOR_VERSION >= 8
4779 if (window == NULL) {
4780 Tcl_AppendResult(interp,
": tkwait: ",
4781 "no main-window (not Tk application?)",
4784 Tcl_Release(interp);
4788 Tk_CreateEventHandler(window, StructureNotifyMask,
4798 if (!
NIL_P(rbtk_pending_exception)) {
4799 Tcl_Release(interp);
4816 if (rb_trap_pending) {
4818 Tcl_Release(interp);
4835 Tcl_ResetResult(interp);
4836 Tcl_Release(interp);
4848 #if TCL_MAJOR_VERSION >= 8
4853 ClientData clientData;
4860 char *,
char *,
int));
4863 ClientData clientData;
4872 if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
4879 return (
char *)
NULL;
4882 #define TKWAIT_MODE_VISIBILITY 1
4883 #define TKWAIT_MODE_DESTROY 2
4888 ClientData clientData;
4893 if (eventPtr->type == VisibilityNotify) {
4896 if (eventPtr->type == DestroyNotify) {
4905 ClientData clientData;
4910 if (eventPtr->type == DestroyNotify) {
4916 #if TCL_MAJOR_VERSION >= 8
4918 ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv)
4919 ClientData clientData;
4922 Tcl_Obj *CONST objv[];
4926 ClientData clientData;
4939 DUMP1(
"Ruby's 'thread_vwait' is called");
4940 if (interp == (Tcl_Interp*)NULL) {
4947 #if TCL_MAJOR_VERSION >= 8
4948 DUMP1(
"call ip_rbVwaitObjCmd");
4949 return ip_rbVwaitObjCmd(clientData, interp, objc, objv);
4951 DUMP1(
"call ip_rbVwaitCommand");
4956 Tcl_Preserve(interp);
4957 Tcl_ResetResult(interp);
4960 #ifdef Tcl_WrongNumArgs
4961 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4966 #if TCL_MAJOR_VERSION >= 8
4968 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4970 nameString = objv[0];
4972 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4973 nameString,
" name\"", (
char *) NULL);
4978 Tcl_Release(interp);
4982 #if TCL_MAJOR_VERSION >= 8
4985 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4987 nameString = objv[1];
4995 Tcl_Preserve((ClientData)param);
4997 param->thread = current_thread;
5007 ret = Tcl_TraceVar(interp, nameString,
5008 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5013 if (ret != TCL_OK) {
5015 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5018 Tcl_Release((ClientData)param);
5021 ckfree((
char *)param);
5025 #if TCL_MAJOR_VERSION >= 8
5028 Tcl_Release(interp);
5035 while(!param->done) {
5039 if (
NIL_P(eventloop_thread)) {
5047 if (param->done > 0) {
5048 Tcl_UntraceVar(interp, nameString,
5049 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5054 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5057 Tcl_Release((ClientData)param);
5060 ckfree((
char *)param);
5066 #if TCL_MAJOR_VERSION >= 8
5069 Tcl_Release(interp);
5073 #if TCL_MAJOR_VERSION >= 8
5075 ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv)
5076 ClientData clientData;
5079 Tcl_Obj *CONST objv[];
5083 ClientData clientData;
5090 Tk_Window tkwin = (Tk_Window) clientData;
5093 static CONST
char *optionStrings[] = {
"variable",
"visibility",
"window",
5095 enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW };
5102 DUMP1(
"Ruby's 'thread_tkwait' is called");
5103 if (interp == (Tcl_Interp*)NULL) {
5110 #if TCL_MAJOR_VERSION >= 8
5111 DUMP1(
"call ip_rbTkWaitObjCmd");
5112 DUMP2(
"eventloop_thread %lx", eventloop_thread);
5113 DUMP2(
"current_thread %lx", current_thread);
5114 return ip_rbTkWaitObjCmd(clientData, interp, objc, objv);
5116 DUMP1(
"call rb_VwaitCommand");
5121 Tcl_Preserve(interp);
5122 Tcl_Preserve(tkwin);
5124 Tcl_ResetResult(interp);
5127 #ifdef Tcl_WrongNumArgs
5128 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
5133 #if TCL_MAJOR_VERSION >= 8
5134 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
5135 Tcl_GetStringFromObj(objv[0], &dummy),
5136 " variable|visibility|window name\"",
5139 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
5140 objv[0],
" variable|visibility|window name\"",
5148 Tcl_Release(interp);
5152 #if TCL_MAJOR_VERSION >= 8
5162 ret = Tcl_GetIndexFromObj(interp, objv[1],
5163 (
CONST84 char **)optionStrings,
5164 "option", 0, &index);
5168 if (ret != TCL_OK) {
5170 Tcl_Release(interp);
5176 size_t length =
strlen(objv[1]);
5178 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
5180 index = TKWAIT_VARIABLE;
5181 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
5183 index = TKWAIT_VISIBILITY;
5184 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
5185 index = TKWAIT_WINDOW;
5187 Tcl_AppendResult(interp,
"bad option \"", objv[1],
5188 "\": must be variable, visibility, or window",
5191 Tcl_Release(interp);
5200 #if TCL_MAJOR_VERSION >= 8
5203 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
5205 nameString = objv[2];
5211 Tcl_Preserve((ClientData)param);
5213 param->thread = current_thread;
5218 switch ((
enum options) index) {
5219 case TKWAIT_VARIABLE:
5229 ret = Tcl_TraceVar(interp, nameString,
5230 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5235 if (ret != TCL_OK) {
5237 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5243 ckfree((
char *)param);
5247 #if TCL_MAJOR_VERSION >= 8
5252 Tcl_Release(interp);
5259 while(!param->done) {
5263 if (
NIL_P(eventloop_thread)) {
5271 if (param->done > 0) {
5272 Tcl_UntraceVar(interp, nameString,
5273 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5277 #if TCL_MAJOR_VERSION >= 8
5285 case TKWAIT_VISIBILITY:
5293 window = Tk_NameToWindow(interp, nameString, tkwin);
5301 if (Tcl_GetCommandInfo(interp,
".", &info)) {
5302 window = Tk_NameToWindow(interp, nameString, tkwin);
5309 if (window == NULL) {
5310 Tcl_AppendResult(interp,
": thread_tkwait: ",
5311 "no main-window (not Tk application?)",
5317 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5323 ckfree((
char *)param);
5327 #if TCL_MAJOR_VERSION >= 8
5331 Tcl_Release(interp);
5334 Tcl_Preserve(window);
5336 Tk_CreateEventHandler(window,
5337 VisibilityChangeMask|StructureNotifyMask,
5350 if (
NIL_P(eventloop_thread)) {
5360 Tk_DeleteEventHandler(window,
5361 VisibilityChangeMask|StructureNotifyMask,
5363 (ClientData) param);
5366 if (param->done != 1) {
5367 Tcl_ResetResult(interp);
5368 Tcl_AppendResult(interp,
"window \"", nameString,
5369 "\" was deleted before its visibility changed",
5374 Tcl_Release(window);
5377 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5383 ckfree((
char *)param);
5387 #if TCL_MAJOR_VERSION >= 8
5392 Tcl_Release(interp);
5396 Tcl_Release(window);
5398 #if TCL_MAJOR_VERSION >= 8
5414 window = Tk_NameToWindow(interp, nameString, tkwin);
5422 if (Tcl_GetCommandInfo(interp,
".", &info)) {
5423 window = Tk_NameToWindow(interp, nameString, tkwin);
5430 #if TCL_MAJOR_VERSION >= 8
5434 if (window == NULL) {
5435 Tcl_AppendResult(interp,
": thread_tkwait: ",
5436 "no main-window (not Tk application?)",
5442 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5448 ckfree((
char *)param);
5453 Tcl_Release(interp);
5457 Tcl_Preserve(window);
5459 Tk_CreateEventHandler(window, StructureNotifyMask,
5471 if (
NIL_P(eventloop_thread)) {
5476 Tcl_Release(window);
5492 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5495 Tcl_Release((ClientData)param);
5498 ckfree((
char *)param);
5507 Tcl_ResetResult(interp);
5510 Tcl_Release(interp);
5546 #if TCL_MAJOR_VERSION >= 8
5553 Tcl_Obj *slave_list, *elem;
5557 DUMP1(
"delete slaves");
5561 if (!Tcl_InterpDeleted(ip) &&
Tcl_Eval(ip,
"interp slaves") == TCL_OK) {
5562 slave_list = Tcl_GetObjResult(ip);
5565 if (Tcl_ListObjLength((Tcl_Interp*)NULL, slave_list, &len) == TCL_OK) {
5566 for(i = 0; i < len; i++) {
5567 Tcl_ListObjIndex((Tcl_Interp*)NULL, slave_list, i, &elem);
5569 if (elem == (Tcl_Obj*)NULL)
continue;
5575 slave_name = Tcl_GetStringFromObj(elem, (
int*)NULL);
5576 DUMP2(
"delete slave:'%s'", slave_name);
5580 slave = Tcl_GetSlave(ip, slave_name);
5581 if (slave == (Tcl_Interp*)NULL)
continue;
5583 if (!Tcl_InterpDeleted(slave)) {
5587 Tcl_DeleteInterp(slave);
5611 DUMP1(
"delete slaves");
5615 if (!Tcl_InterpDeleted(ip) &&
Tcl_Eval(ip,
"interp slaves") == TCL_OK) {
5616 slave_list = ip->result;
5617 if (Tcl_SplitList((Tcl_Interp*)NULL,
5618 slave_list, &argc, &argv) == TCL_OK) {
5619 for(i = 0; i <
argc; i++) {
5620 slave_name = argv[
i];
5622 DUMP2(
"delete slave:'%s'", slave_name);
5624 slave = Tcl_GetSlave(ip, slave_name);
5625 if (slave == (Tcl_Interp*)NULL)
continue;
5627 if (!Tcl_InterpDeleted(slave)) {
5631 Tcl_DeleteInterp(slave);
5644 #ifdef HAVE_PROTOTYPES
5655 #if TCL_MAJOR_VERSION >= 8
5656 #ifdef HAVE_PROTOTYPES
5657 ip_null_proc(ClientData clientData, Tcl_Interp *interp,
5658 int argc, Tcl_Obj *CONST argv[])
5661 ClientData clientData;
5664 Tcl_Obj *CONST argv[];
5667 #ifdef HAVE_PROTOTYPES
5668 ip_null_proc(ClientData clientData, Tcl_Interp *interp,
int argc,
char *argv[])
5671 ClientData clientData;
5678 Tcl_ResetResult(interp);
5689 VALUE rb_debug_bup, rb_verbose_bup;
5697 DUMP1(
"start ip_finalize");
5699 if (ip == (Tcl_Interp*)NULL) {
5700 DUMP1(
"ip is NULL");
5704 if (Tcl_InterpDeleted(ip)) {
5705 DUMP2(
"ip(%p) is already deleted", ip);
5709 #if TCL_NAMESPACE_DEBUG
5710 if (ip_null_namespace(ip)) {
5711 DUMP2(
"ip(%p) has null namespace", ip);
5733 #if TCL_MAJOR_VERSION >= 8
5735 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5737 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5739 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5742 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5744 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5746 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5758 DUMP1(
"check `destroy'");
5759 if (Tcl_GetCommandInfo(ip,
"destroy", &info)) {
5760 DUMP1(
"call `destroy .'");
5765 DUMP1(
"destroy root widget");
5779 Tk_Window win = Tk_MainWindow(ip);
5781 DUMP1(
"call Tk_DestroyWindow");
5784 if (! (((Tk_FakeWin*)win)->flags & TK_ALREADY_DEAD)) {
5785 Tk_DestroyWindow(win);
5793 DUMP1(
"check `finalize-hook-proc'");
5794 if ( Tcl_GetCommandInfo(ip, finalize_hook_name, &info)) {
5795 DUMP2(
"call finalize hook proc '%s'", finalize_hook_name);
5803 DUMP1(
"check `foreach' & `after'");
5804 if ( Tcl_GetCommandInfo(ip,
"foreach", &info)
5805 && Tcl_GetCommandInfo(ip,
"after", &info) ) {
5806 DUMP1(
"cancel after callbacks");
5809 Tcl_GlobalEval(ip,
"catch {foreach id [after info] {after cancel $id}}");
5816 DUMP1(
"finish ip_finalize");
5830 DUMP2(
"free Tcl Interp %lx", (
unsigned long)ptr->ip);
5835 if ( ptr->ip != (Tcl_Interp*)NULL
5836 && !Tcl_InterpDeleted(ptr->ip)
5837 && Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL
5838 && !Tcl_InterpDeleted(Tcl_GetMaster(ptr->ip)) ) {
5839 DUMP2(
"parent IP(%lx) is not deleted",
5840 (
unsigned long)Tcl_GetMaster(ptr->ip));
5841 DUMP2(
"slave IP(%lx) should not be deleted",
5842 (
unsigned long)ptr->ip);
5849 if (ptr->ip == (Tcl_Interp*)NULL) {
5850 DUMP1(
"ip_free is called for deleted IP");
5857 if (!Tcl_InterpDeleted(ptr->ip)) {
5860 Tcl_DeleteInterp(ptr->ip);
5861 Tcl_Release(ptr->ip);
5864 ptr->ip = (Tcl_Interp*)NULL;
5871 DUMP1(
"complete freeing Tcl Interp");
5890 #if TCL_MAJOR_VERSION >= 8
5891 DUMP1(
"Tcl_CreateObjCommand(\"vwait\")");
5892 Tcl_CreateObjCommand(interp,
"vwait", ip_rbVwaitObjCmd,
5893 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5895 DUMP1(
"Tcl_CreateCommand(\"vwait\")");
5897 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5901 #if TCL_MAJOR_VERSION >= 8
5902 DUMP1(
"Tcl_CreateObjCommand(\"tkwait\")");
5903 Tcl_CreateObjCommand(interp,
"tkwait", ip_rbTkWaitObjCmd,
5904 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5906 DUMP1(
"Tcl_CreateCommand(\"tkwait\")");
5908 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5912 #if TCL_MAJOR_VERSION >= 8
5913 DUMP1(
"Tcl_CreateObjCommand(\"thread_vwait\")");
5914 Tcl_CreateObjCommand(interp,
"thread_vwait", ip_rb_threadVwaitObjCmd,
5915 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5917 DUMP1(
"Tcl_CreateCommand(\"thread_vwait\")");
5919 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5923 #if TCL_MAJOR_VERSION >= 8
5924 DUMP1(
"Tcl_CreateObjCommand(\"thread_tkwait\")");
5925 Tcl_CreateObjCommand(interp,
"thread_tkwait", ip_rb_threadTkWaitObjCmd,
5926 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5928 DUMP1(
"Tcl_CreateCommand(\"thread_tkwait\")");
5930 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5934 #if TCL_MAJOR_VERSION >= 8
5935 DUMP1(
"Tcl_CreateObjCommand(\"update\")");
5936 Tcl_CreateObjCommand(interp,
"update", ip_rbUpdateObjCmd,
5937 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5939 DUMP1(
"Tcl_CreateCommand(\"update\")");
5941 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5945 #if TCL_MAJOR_VERSION >= 8
5946 DUMP1(
"Tcl_CreateObjCommand(\"thread_update\")");
5947 Tcl_CreateObjCommand(interp,
"thread_update", ip_rb_threadUpdateObjCmd,
5948 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5950 DUMP1(
"Tcl_CreateCommand(\"thread_update\")");
5952 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5957 #if TCL_MAJOR_VERSION >= 8
5959 ip_rb_replaceSlaveTkCmdsObjCmd(clientData, interp, objc, objv)
5960 ClientData clientData;
5963 Tcl_Obj *CONST objv[];
5967 ClientData clientData;
5978 #ifdef Tcl_WrongNumArgs
5979 Tcl_WrongNumArgs(interp, 1, objv,
"slave_name");
5982 #if TCL_MAJOR_VERSION >= 8
5983 nameString = Tcl_GetStringFromObj(objv[0], (
int*)NULL);
5985 nameString = objv[0];
5987 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
5988 nameString,
" slave_name\"", (
char *) NULL);
5992 #if TCL_MAJOR_VERSION >= 8
5993 slave_name = Tcl_GetStringFromObj(objv[1], (
int*)NULL);
5995 slave_name = objv[1];
5998 slave = Tcl_GetSlave(interp, slave_name);
5999 if (slave == NULL) {
6000 Tcl_AppendResult(interp,
"cannot find slave \"",
6001 slave_name,
"\"", (
char *)NULL);
6004 mainWin = Tk_MainWindow(slave);
6007 #if TCL_MAJOR_VERSION >= 8
6008 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6009 Tcl_CreateObjCommand(slave,
"exit", ip_InterpExitObjCmd,
6010 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6012 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6014 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6024 #if TCL_MAJOR_VERSION >= 8
6025 static int ip_rbNamespaceObjCmd
_((ClientData, Tcl_Interp *,
int,
6026 Tcl_Obj *CONST []));
6028 ip_rbNamespaceObjCmd(clientData, interp, objc, objv)
6029 ClientData clientData;
6032 Tcl_Obj *CONST objv[];
6037 if (!Tcl_GetCommandInfo(interp,
"__orig_namespace_command__", &(info))) {
6038 Tcl_ResetResult(interp);
6039 Tcl_AppendResult(interp,
6040 "invalid command name \"namespace\"", (
char*)NULL);
6044 rbtk_eventloop_depth++;
6047 if (info.isNativeObjectProc) {
6048 ret = (*(info.objProc))(info.objClientData, interp, objc, objv);
6057 Tcl_Preserve((ClientData)argv);
6060 for(i = 0; i < objc; i++) {
6062 argv[
i] = Tcl_GetStringFromObj(objv[i], (
int*)NULL);
6064 argv[objc] = (
char *)NULL;
6066 ret = (*(info.proc))(info.clientData, interp,
6070 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
6073 Tcl_Release((ClientData)argv);
6076 ckfree((
char*)argv);
6082 rbtk_eventloop_depth--;
6092 #if TCL_MAJOR_VERSION >= 8
6093 Tcl_CmdInfo orig_info;
6095 if (!Tcl_GetCommandInfo(interp,
"namespace", &(orig_info))) {
6099 if (orig_info.isNativeObjectProc) {
6100 Tcl_CreateObjCommand(interp,
"__orig_namespace_command__",
6101 orig_info.objProc, orig_info.objClientData,
6102 orig_info.deleteProc);
6104 Tcl_CreateCommand(interp,
"__orig_namespace_command__",
6105 orig_info.proc, orig_info.clientData,
6106 orig_info.deleteProc);
6109 Tcl_CreateObjCommand(interp,
"namespace", ip_rbNamespaceObjCmd,
6110 (ClientData) 0, (Tcl_CmdDeleteProc *)NULL);
6117 #ifdef HAVE_PROTOTYPES
6121 ClientData clientData;
6128 DUMP1(
"start ip_CallWhenDeleted");
6134 DUMP1(
"finish ip_CallWhenDeleted");
6152 Tk_Window mainWin = (Tk_Window)NULL;
6157 "Cannot create a TclTkIp object at level %d",
6166 #ifdef RUBY_USE_NATIVE_THREAD
6167 ptr->tk_thread_id = 0;
6174 DUMP1(
"Tcl_CreateInterp");
6176 if (ptr->
ip == NULL) {
6197 #if TCL_MAJOR_VERSION >= 8
6198 #if TCL_NAMESPACE_DEBUG
6199 DUMP1(
"get current namespace");
6200 if ((ptr->default_ns = Tcl_GetCurrentNamespace(ptr->
ip))
6201 == (Tcl_Namespace*)NULL) {
6209 current_interp = ptr->
ip;
6214 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
6215 call_tclkit_init_script(current_interp);
6217 # if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
6219 Tcl_DString encodingName;
6220 Tcl_GetEncodingNameFromEnvironment(&encodingName);
6221 if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(NULL))) {
6223 Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName));
6225 Tcl_SetVar(current_interp,
"tclkit_system_encoding", Tcl_DStringValue(&encodingName), 0);
6226 Tcl_DStringFree(&encodingName);
6232 Tcl_Eval(ptr->
ip,
"set argc 0; set argv {}; set argv0 tcltklib.so");
6244 Tcl_Eval(ptr->
ip,
"set argc [llength $argv]");
6248 if (!
NIL_P(argv0)) {
6251 Tcl_SetVar(ptr->
ip,
"argv0",
"ruby", TCL_GLOBAL_ONLY);
6265 #if (defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT) && (!defined KIT_LITE) && (10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION == 85)
6272 Tcl_Eval(ptr->
ip,
"catch {rename ::chan ::_tmp_chan}");
6273 if (Tcl_Init(ptr->
ip) == TCL_ERROR) {
6276 Tcl_Eval(ptr->
ip,
"catch {rename ::_tmp_chan ::chan}");
6278 if (Tcl_Init(ptr->
ip) == TCL_ERROR) {
6303 DUMP1(
"Tcl_StaticPackage(\"Tk\")");
6304 #if TCL_MAJOR_VERSION >= 8
6305 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init, Tk_SafeInit);
6307 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init,
6308 (Tcl_PackageInitProc *) NULL);
6311 #ifdef RUBY_USE_NATIVE_THREAD
6313 ptr->tk_thread_id = Tcl_GetCurrentThread();
6316 mainWin = Tk_MainWindow(ptr->
ip);
6317 Tk_Preserve((ClientData)mainWin);
6321 #if TCL_MAJOR_VERSION >= 8
6322 DUMP1(
"Tcl_CreateObjCommand(\"ruby\")");
6323 Tcl_CreateObjCommand(ptr->
ip,
"ruby",
ip_ruby_eval, (ClientData)NULL,
6324 (Tcl_CmdDeleteProc *)NULL);
6325 DUMP1(
"Tcl_CreateObjCommand(\"ruby_eval\")");
6326 Tcl_CreateObjCommand(ptr->
ip,
"ruby_eval",
ip_ruby_eval, (ClientData)NULL,
6327 (Tcl_CmdDeleteProc *)NULL);
6328 DUMP1(
"Tcl_CreateObjCommand(\"ruby_cmd\")");
6329 Tcl_CreateObjCommand(ptr->
ip,
"ruby_cmd",
ip_ruby_cmd, (ClientData)NULL,
6330 (Tcl_CmdDeleteProc *)NULL);
6332 DUMP1(
"Tcl_CreateCommand(\"ruby\")");
6333 Tcl_CreateCommand(ptr->
ip,
"ruby",
ip_ruby_eval, (ClientData)NULL,
6334 (Tcl_CmdDeleteProc *)NULL);
6335 DUMP1(
"Tcl_CreateCommand(\"ruby_eval\")");
6336 Tcl_CreateCommand(ptr->
ip,
"ruby_eval",
ip_ruby_eval, (ClientData)NULL,
6337 (Tcl_CmdDeleteProc *)NULL);
6338 DUMP1(
"Tcl_CreateCommand(\"ruby_cmd\")");
6339 Tcl_CreateCommand(ptr->
ip,
"ruby_cmd",
ip_ruby_cmd, (ClientData)NULL,
6340 (Tcl_CmdDeleteProc *)NULL);
6344 #if TCL_MAJOR_VERSION >= 8
6345 DUMP1(
"Tcl_CreateObjCommand(\"interp_exit\")");
6346 Tcl_CreateObjCommand(ptr->
ip,
"interp_exit", ip_InterpExitObjCmd,
6347 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6348 DUMP1(
"Tcl_CreateObjCommand(\"ruby_exit\")");
6349 Tcl_CreateObjCommand(ptr->
ip,
"ruby_exit", ip_RubyExitObjCmd,
6350 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6351 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6352 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6353 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6355 DUMP1(
"Tcl_CreateCommand(\"interp_exit\")");
6357 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6358 DUMP1(
"Tcl_CreateCommand(\"ruby_exit\")");
6360 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6361 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6363 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6373 #if TCL_MAJOR_VERSION >= 8
6374 Tcl_CreateObjCommand(ptr->
ip,
"__replace_slave_tk_commands__",
6375 ip_rb_replaceSlaveTkCmdsObjCmd,
6376 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6378 Tcl_CreateCommand(ptr->
ip,
"__replace_slave_tk_commands__",
6380 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6386 if (mainWin != (Tk_Window)NULL) {
6387 Tk_Release((ClientData)mainWin);
6411 "deleted master cannot create a new slave");
6417 if (Tcl_IsSafe(master->
ip) == 1) {
6419 }
else if (safemode ==
Qfalse ||
NIL_P(safemode)) {
6431 if (
RTEST(with_tk)) {
6444 #ifdef RUBY_USE_NATIVE_THREAD
6446 slave->tk_thread_id = master->tk_thread_id;
6453 if (slave->
ip == NULL) {
6456 "fail to create the new slave interpreter");
6458 #if TCL_MAJOR_VERSION >= 8
6459 #if TCL_NAMESPACE_DEBUG
6460 slave->default_ns = Tcl_GetCurrentNamespace(slave->
ip);
6470 #if TCL_MAJOR_VERSION >= 8
6471 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6472 Tcl_CreateObjCommand(slave->
ip,
"exit", ip_InterpExitObjCmd,
6473 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6475 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6477 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6487 #if TCL_MAJOR_VERSION >= 8
6488 Tcl_CreateObjCommand(slave->
ip,
"__replace_slave_tk_commands__",
6489 ip_rb_replaceSlaveTkCmdsObjCmd,
6490 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6492 Tcl_CreateCommand(slave->
ip,
"__replace_slave_tk_commands__",
6494 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6519 "deleted master cannot create a new slave interpreter");
6523 if (
rb_scan_args(argc, argv,
"11", &name, &safemode) == 1) {
6526 if (Tcl_IsSafe(master->
ip) != 1
6533 callargv[1] = safemode;
6548 if (Tcl_GetMaster(
get_ip(
self)->ip) ==
get_ip(master)->ip) {
6557 #if defined(MAC_TCL) || defined(__WIN32__)
6558 #if TCL_MAJOR_VERSION < 8 \
6559 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) \
6560 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6561 && (TCL_RELEASE_LEVEL == TCL_ALPHA_RELEASE \
6562 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \
6563 && TCL_RELEASE_SERIAL < 2) ) )
6564 EXTERN void TkConsoleCreate
_((
void));
6566 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6567 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \
6568 && TCL_RELEASE_SERIAL == 0) \
6569 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \
6570 && TCL_RELEASE_SERIAL >= 2) )
6571 EXTERN void TkConsoleCreate_
_((
void));
6586 if (Tcl_GetVar(ptr->
ip,
"tcl_interactive",TCL_GLOBAL_ONLY) == (
char*)NULL) {
6587 Tcl_SetVar(ptr->
ip,
"tcl_interactive",
"0", TCL_GLOBAL_ONLY);
6590 #if TCL_MAJOR_VERSION > 8 \
6591 || (TCL_MAJOR_VERSION == 8 \
6592 && (TCL_MINOR_VERSION > 1 \
6593 || (TCL_MINOR_VERSION == 1 \
6594 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \
6595 && TCL_RELEASE_SERIAL >= 1) ) )
6596 Tk_InitConsoleChannels(ptr->
ip);
6598 if (Tk_CreateConsoleWindow(ptr->
ip) != TCL_OK) {
6602 #if defined(MAC_TCL) || defined(__WIN32__)
6603 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6604 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE && TCL_RELEASE_SERIAL == 0) \
6605 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE && TCL_RELEASE_SERIAL >= 2) )
6611 if (TkConsoleInit(ptr->
ip) != TCL_OK) {
6651 if (Tcl_MakeSafe(ptr->
ip) == TCL_ERROR) {
6662 #if TCL_MAJOR_VERSION >= 8
6663 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6664 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6665 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6667 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6669 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6701 if (Tcl_IsSafe(ptr->
ip)) {
6742 if (Tcl_IsSafe(ptr->
ip)) {
6744 "insecure operation on a safe interpreter");
6757 #if TCL_MAJOR_VERSION >= 8
6758 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6759 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6760 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6762 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6764 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6770 #if TCL_MAJOR_VERSION >= 8
6771 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6772 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6773 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6775 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6777 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6793 DUMP1(
"delete deleted IP");
6800 DUMP1(
"delete interp");
6801 if (!Tcl_InterpDeleted(ptr->
ip)) {
6802 DUMP1(
"call ip_finalize");
6805 Tcl_DeleteInterp(ptr->
ip);
6806 Tcl_Release(ptr->
ip);
6822 if (ptr == (
struct tcltkip *)NULL || ptr->
ip == (Tcl_Interp *)NULL) {
6827 #if TCL_NAMESPACE_DEBUG
6828 if (rbtk_invalid_namespace(ptr)) {
6861 }
else if (Tk_MainWindow(ptr->
ip) == (Tk_Window)NULL) {
6877 #if TCL_MAJOR_VERSION >= 8
6879 get_str_from_obj(obj)
6882 int len, binary = 0;
6886 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
6887 s = Tcl_GetStringFromObj(obj, &len);
6889 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 3
6891 if (Tcl_GetCharLength(obj) != Tcl_UniCharLen(Tcl_GetUnicode(obj))) {
6893 s = (
char *)Tcl_GetByteArrayFromObj(obj, &len);
6897 s = Tcl_GetStringFromObj(obj, &len);
6900 if (IS_TCL_BYTEARRAY(obj)) {
6901 s = (
char *)Tcl_GetByteArrayFromObj(obj, &len);
6904 s = Tcl_GetStringFromObj(obj, &len);
6911 #ifdef HAVE_RUBY_ENCODING_H
6914 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
6915 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
6917 #ifdef HAVE_RUBY_ENCODING_H
6927 get_obj_from_str(str)
6932 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
6933 return Tcl_NewStringObj((
char*)s,
RSTRING_LEN(str));
6941 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6946 #ifdef HAVE_RUBY_ENCODING_H
6949 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6953 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6966 #if TCL_MAJOR_VERSION >= 8
6968 volatile VALUE strval;
6970 retObj = Tcl_GetObjResult(interp);
6972 strval = get_str_from_obj(retObj);
6974 Tcl_ResetResult(interp);
7004 volatile VALUE q_dat;
7008 DUMP2(
"do_call_queue_handler : evPtr = %p", evPtr);
7010 DUMP2(
"added by thread : %lx", thread);
7013 DUMP1(
"processed by another event-loop");
7016 DUMP1(
"process it on current event-loop");
7026 DUMP1(
"caller is not yet ready to receive the result -> pending");
7041 rbtk_internal_eventloop_handler++;
7050 q_dat = (
VALUE)NULL;
7052 DUMP2(
"call function (for caller thread:%lx)", thread);
7062 rbtk_internal_eventloop_handler--;
7079 DUMP2(
"back to caller (caller thread:%lx)", thread);
7081 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
7082 have_rb_thread_waiting_for_value = 1;
7087 DUMP1(
"finish back to caller");
7088 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
7092 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7111 int is_tk_evloop_thread;
7113 volatile VALUE ip_obj = obj;
7125 #ifdef RUBY_USE_NATIVE_THREAD
7128 is_tk_evloop_thread = (ptr->tk_thread_id == (Tcl_ThreadId) 0
7129 || ptr->tk_thread_id == Tcl_GetCurrentThread());
7132 is_tk_evloop_thread = (tk_eventloop_thread_id == (Tcl_ThreadId) 0
7133 || tk_eventloop_thread_id == Tcl_GetCurrentThread());
7136 is_tk_evloop_thread = 1;
7139 if (is_tk_evloop_thread
7142 if (
NIL_P(eventloop_thread)) {
7143 DUMP2(
"tk_funcall from thread:%lx but no eventloop", current);
7145 DUMP2(
"tk_funcall from current eventloop %lx", current);
7147 result = (
func)(ip_obj, argc, argv);
7154 DUMP2(
"tk_funcall from thread %lx (NOT current eventloop)", current);
7164 Tcl_Preserve((ClientData)temp);
7174 Tcl_Preserve((ClientData)alloc_done);
7182 Tcl_Preserve(callq);
7189 callq->
done = alloc_done;
7200 DUMP1(
"add handler");
7201 #ifdef RUBY_USE_NATIVE_THREAD
7202 if (ptr && ptr->tk_thread_id) {
7205 Tcl_ThreadQueueEvent(ptr->tk_thread_id,
7206 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7207 Tcl_ThreadAlert(ptr->tk_thread_id);
7208 }
else if (tk_eventloop_thread_id) {
7211 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
7212 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7213 Tcl_ThreadAlert(tk_eventloop_thread_id);
7216 Tcl_QueueEvent((Tcl_Event*)callq, TCL_QUEUE_HEAD);
7220 Tcl_QueueEvent((Tcl_Event*)callq, TCL_QUEUE_HEAD);
7229 DUMP2(
"callq wait for handler (current thread:%lx)", current);
7230 while(*alloc_done >= 0) {
7231 DUMP2(
"*** callq wait for handler (current thread:%lx)", current);
7235 DUMP2(
"*** callq wakeup (current thread:%lx)", current);
7236 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
7237 if (
NIL_P(eventloop_thread)) {
7238 DUMP1(
"*** callq lost eventloop thread");
7242 DUMP2(
"back from handler (current thread:%lx)", current);
7247 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7250 Tcl_Release((ClientData)alloc_done);
7253 ckfree((
char*)alloc_done);
7260 for(i = 0; i <
argc; i++) { argv[
i] = (
VALUE)NULL; }
7263 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
7266 Tcl_Release((ClientData)argv);
7268 ckfree((
char*)argv);
7277 ckfree((
char*)callq);
7283 DUMP1(
"raise exception");
7289 DUMP1(
"exit tk_funcall");
7295 #if TCL_MAJOR_VERSION >= 8
7296 struct call_eval_info {
7302 #ifdef HAVE_PROTOTYPES
7303 call_tcl_eval(
VALUE arg)
7309 struct call_eval_info *
inf = (
struct call_eval_info *)arg;
7311 Tcl_AllowExceptions(inf->ptr->ip);
7312 inf->ptr->return_value = Tcl_EvalObj(inf->ptr->ip, inf->cmd);
7328 #if TCL_MAJOR_VERSION >= 8
7336 cmd = Tcl_NewStringObj(cmd_str, cmd_len);
7347 struct call_eval_info inf;
7363 "unknown exception");
7390 if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->
ip)) {
7396 "ip_eval_real receives TCL_RETURN");
7399 "ip_eval_real receives TCL_BREAK");
7402 "ip_eval_real receives TCL_CONTINUE");
7412 if (event_loop_abort_on_exc < 0) {
7417 Tcl_ResetResult(ptr->
ip);
7431 DUMP2(
"Tcl_Eval(%s)", cmd_str);
7456 "ip_eval_real receives TCL_RETURN");
7459 "ip_eval_real receives TCL_BREAK");
7462 "ip_eval_real receives TCL_CONTINUE");
7500 volatile VALUE q_dat;
7504 DUMP2(
"do_eval_queue_handler : evPtr = %p", evPtr);
7506 DUMP2(
"added by thread : %lx", thread);
7509 DUMP1(
"processed by another event-loop");
7512 DUMP1(
"process it on current event-loop");
7522 DUMP1(
"caller is not yet ready to receive the result -> pending");
7537 rbtk_internal_eventloop_handler++;
7541 #ifdef HAVE_NATIVETHREAD
7542 #ifndef RUBY_USE_NATIVE_THREAD
7544 rb_bug(
"cross-thread violation on eval_queue_handler()");
7553 q_dat = (
VALUE)NULL;
7563 rbtk_internal_eventloop_handler--;
7579 DUMP2(
"back to caller (caller thread:%lx)", thread);
7581 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
7582 have_rb_thread_waiting_for_value = 1;
7587 DUMP1(
"finish back to caller");
7588 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
7592 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7606 #ifdef RUBY_USE_NATIVE_THREAD
7613 volatile VALUE ip_obj =
self;
7616 Tcl_QueuePosition position;
7624 #ifdef RUBY_USE_NATIVE_THREAD
7626 DUMP2(
"eval status: ptr->tk_thread_id %p", ptr->tk_thread_id);
7627 DUMP2(
"eval status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7629 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7631 DUMP2(
"status: eventloopt_thread %lx", eventloop_thread);
7634 #ifdef RUBY_USE_NATIVE_THREAD
7635 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
7638 (
NIL_P(eventloop_thread) || current == eventloop_thread)
7640 if (
NIL_P(eventloop_thread)) {
7641 DUMP2(
"eval from thread:%lx but no eventloop", current);
7643 DUMP2(
"eval from current eventloop %lx", current);
7652 DUMP2(
"eval from thread %lx (NOT current eventloop)", current);
7661 Tcl_Preserve((ClientData)alloc_done);
7668 Tcl_Preserve((ClientData)eval_str);
7684 evq->
done = alloc_done;
7685 evq->
str = eval_str;
7693 position = TCL_QUEUE_TAIL;
7696 DUMP1(
"add handler");
7697 #ifdef RUBY_USE_NATIVE_THREAD
7698 if (ptr->tk_thread_id) {
7700 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)evq, position);
7701 Tcl_ThreadAlert(ptr->tk_thread_id);
7702 }
else if (tk_eventloop_thread_id) {
7703 Tcl_ThreadQueueEvent(tk_eventloop_thread_id, (Tcl_Event*)evq, position);
7706 Tcl_ThreadAlert(tk_eventloop_thread_id);
7709 Tcl_QueueEvent((Tcl_Event*)evq, position);
7713 Tcl_QueueEvent((Tcl_Event*)evq, position);
7722 DUMP2(
"evq wait for handler (current thread:%lx)", current);
7723 while(*alloc_done >= 0) {
7724 DUMP2(
"*** evq wait for handler (current thread:%lx)", current);
7728 DUMP2(
"*** evq wakeup (current thread:%lx)", current);
7729 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
7730 if (
NIL_P(eventloop_thread)) {
7731 DUMP1(
"*** evq lost eventloop thread");
7735 DUMP2(
"back from handler (current thread:%lx)", current);
7741 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7744 Tcl_Release((ClientData)alloc_done);
7747 ckfree((
char*)alloc_done);
7751 Tcl_EventuallyFree((ClientData)eval_str, TCL_DYNAMIC);
7754 Tcl_Release((ClientData)eval_str);
7769 DUMP1(
"raise exception");
7785 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6)
7787 "cancel_eval is supported Tcl/Tk8.6 or later.");
7800 return Tcl_CancelEval(interp, msg_obj, 0, flag);
7822 #ifndef TCL_CANCEL_UNWIND
7823 #define TCL_CANCEL_UNWIND 0x100000
7876 Tcl_ResetResult(ptr->
ip);
7878 #if TCL_MAJOR_VERSION >= 8
7883 Tcl_ResetResult(ptr->
ip);
7890 Tcl_ResetResult(ptr->
ip);
7943 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)NULL) {
7956 volatile VALUE str = src;
7960 Tcl_Encoding encoding;
7975 if (
NIL_P(ip_obj)) {
7976 interp = (Tcl_Interp *)NULL;
7982 interp = (Tcl_Interp *)NULL;
7991 if (
NIL_P(encodename)) {
7995 #ifdef HAVE_RUBY_ENCODING_H
8001 if (
NIL_P(ip_obj)) {
8002 encoding = (Tcl_Encoding)NULL;
8006 encoding = (Tcl_Encoding)NULL;
8012 encoding = (Tcl_Encoding)NULL;
8014 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8016 if (encoding == (Tcl_Encoding)NULL) {
8025 #ifdef HAVE_RUBY_ENCODING_H
8028 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8033 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8035 if (encoding == (Tcl_Encoding)NULL) {
8040 encoding = (Tcl_Encoding)NULL;
8044 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8045 #ifdef HAVE_RUBY_ENCODING_H
8048 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8053 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(encodename));
8054 if (encoding == (Tcl_Encoding)NULL) {
8074 Tcl_DStringInit(&dstr);
8075 Tcl_DStringFree(&dstr);
8077 Tcl_ExternalToUtfDString(encoding, buf,
RSTRING_LENINT(str), &dstr);
8081 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8082 #ifdef HAVE_RUBY_ENCODING_H
8093 Tcl_DStringFree(&dstr);
8110 VALUE str, encodename;
8112 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8124 VALUE str, encodename;
8126 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8138 volatile VALUE str = src;
8142 Tcl_Encoding encoding;
8156 if (
NIL_P(ip_obj)) {
8157 interp = (Tcl_Interp *)NULL;
8159 interp = (Tcl_Interp *)NULL;
8167 if (
NIL_P(encodename)) {
8175 #ifdef HAVE_RUBY_ENCODING_H
8178 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8182 #ifdef HAVE_RUBY_ENCODING_H
8185 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8192 if (
NIL_P(ip_obj)) {
8193 encoding = (Tcl_Encoding)NULL;
8197 encoding = (Tcl_Encoding)NULL;
8203 encoding = (Tcl_Encoding)NULL;
8205 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8207 if (encoding == (Tcl_Encoding)NULL) {
8219 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8227 s = (
char*)Tcl_GetByteArrayFromObj(tclstr, &len);
8231 #ifdef HAVE_RUBY_ENCODING_H
8234 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8241 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(encodename));
8242 if (encoding == (Tcl_Encoding)NULL) {
8265 Tcl_DStringInit(&dstr);
8266 Tcl_DStringFree(&dstr);
8268 Tcl_UtfToExternalDString(encoding,buf,
RSTRING_LENINT(str),&dstr);
8272 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8273 #ifdef HAVE_RUBY_ENCODING_H
8295 Tcl_DStringFree(&dstr);
8312 VALUE str, encodename;
8314 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8326 VALUE str, encodename;
8328 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8341 char *src_buf, *dst_buf, *ptr;
8342 int read_len = 0, dst_len = 0;
8359 Tcl_Preserve((ClientData)src_buf);
8367 Tcl_Preserve((ClientData)dst_buf);
8372 if (*ptr ==
'\\' && (all_bs || *(ptr + 1) ==
'u')) {
8373 dst_len += Tcl_UtfBackslash(ptr, &read_len, (dst_buf + dst_len));
8376 *(dst_buf + (dst_len++)) = *(ptr++);
8382 #ifdef HAVE_RUBY_ENCODING_H
8388 Tcl_EventuallyFree((ClientData)src_buf, TCL_DYNAMIC);
8391 Tcl_Release((ClientData)src_buf);
8398 Tcl_EventuallyFree((ClientData)dst_buf, TCL_DYNAMIC);
8401 Tcl_Release((ClientData)dst_buf);
8434 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
8436 return rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL));
8447 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
8450 if (
NIL_P(enc_name)) {
8451 Tcl_SetSystemEncoding((Tcl_Interp *)NULL, (CONST
char *)NULL);
8455 enc_name =
rb_funcall(enc_name, ID_to_s, 0, 0);
8456 if (Tcl_SetSystemEncoding((Tcl_Interp *)NULL,
8473 #if TCL_MAJOR_VERSION >= 8
8483 #ifdef HAVE_PROTOTYPES
8492 #if TCL_MAJOR_VERSION >= 8
8493 int argc = inf->objc;
8494 char **argv = (
char **)NULL;
8498 #if TCL_MAJOR_VERSION >= 8
8499 if (!inf->
cmdinfo.isNativeObjectProc) {
8504 Tcl_Preserve((ClientData)argv);
8506 for (i = 0; i <
argc; ++
i) {
8507 argv[
i] = Tcl_GetStringFromObj(inf->objv[i], &len);
8509 argv[
argc] = (
char *)NULL;
8513 Tcl_ResetResult(inf->
ptr->
ip);
8516 #if TCL_MAJOR_VERSION >= 8
8517 if (inf->
cmdinfo.isNativeObjectProc) {
8520 inf->
ptr->
ip, inf->objc, inf->objv);
8525 #if TCL_MAJOR_VERSION >= 8
8531 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8534 Tcl_Release((ClientData)argv);
8537 ckfree((
char*)argv);
8552 #if TCL_MAJOR_VERSION >= 8
8571 int unknown_flag = 0;
8578 #if TCL_MAJOR_VERSION >= 8
8580 char **argv = (
char **)NULL;
8589 #if TCL_MAJOR_VERSION >= 8
8590 cmd = Tcl_GetStringFromObj(objv[0], &len);
8607 DUMP2(
"call Tcl_GetCommandInfo, %s", cmd);
8608 if (!Tcl_GetCommandInfo(ptr->
ip, cmd, &info)) {
8609 DUMP1(
"error Tcl_GetCommandInfo");
8610 DUMP1(
"try auto_load (call 'unknown' command)");
8611 if (!Tcl_GetCommandInfo(ptr->
ip,
8612 #
if TCL_MAJOR_VERSION >= 8
8618 DUMP1(
"fail to get 'unknown' command");
8620 if (event_loop_abort_on_exc > 0) {
8625 "invalid command name `%s'", cmd);
8627 if (event_loop_abort_on_exc < 0) {
8628 rb_warning(
"invalid command name `%s' (ignore)", cmd);
8630 rb_warn(
"invalid command name `%s' (ignore)", cmd);
8632 Tcl_ResetResult(ptr->
ip);
8638 #if TCL_MAJOR_VERSION >= 8
8639 Tcl_Obj **unknown_objv;
8641 char **unknown_argv;
8643 DUMP1(
"find 'unknown' command -> set arguemnts");
8646 #if TCL_MAJOR_VERSION >= 8
8650 Tcl_Preserve((ClientData)unknown_objv);
8652 unknown_objv[0] = Tcl_NewStringObj(
"::unknown", 9);
8654 memcpy(unknown_objv + 1, objv,
sizeof(Tcl_Obj *)*objc);
8655 unknown_objv[++objc] = (Tcl_Obj*)NULL;
8656 objv = unknown_objv;
8661 Tcl_Preserve((ClientData)unknown_argv);
8663 unknown_argv[0] =
strdup(
"unknown");
8664 memcpy(unknown_argv + 1, argv,
sizeof(
char *)*argc);
8665 unknown_argv[++
argc] = (
char *)NULL;
8666 argv = unknown_argv;
8670 DUMP1(
"end Tcl_GetCommandInfo");
8679 #if TCL_MAJOR_VERSION >= 8
8693 "unknown exception");
8710 #if TCL_MAJOR_VERSION >= 8
8711 if (!info.isNativeObjectProc) {
8718 Tcl_Preserve((ClientData)argv);
8720 for (i = 0; i <
argc; ++
i) {
8721 argv[
i] = Tcl_GetStringFromObj(objv[i], &len);
8723 argv[
argc] = (
char *)NULL;
8727 Tcl_ResetResult(ptr->
ip);
8730 #if TCL_MAJOR_VERSION >= 8
8731 if (info.isNativeObjectProc) {
8736 resultPtr = Tcl_GetObjResult(ptr->
ip);
8737 Tcl_SetResult(ptr->
ip, Tcl_GetStringFromObj(resultPtr, &len),
8744 #if TCL_MAJOR_VERSION >= 8
8749 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8752 Tcl_Release((ClientData)argv);
8755 ckfree((
char*)argv);
8768 #if TCL_MAJOR_VERSION >= 8
8771 Tcl_EventuallyFree((ClientData)objv, TCL_DYNAMIC);
8774 Tcl_Release((ClientData)objv);
8777 ckfree((
char*)objv);
8784 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8787 Tcl_Release((ClientData)argv);
8790 ckfree((
char*)argv);
8805 if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->
ip)) {
8809 "ip_invoke_core receives TCL_RETURN");
8812 "ip_invoke_core receives TCL_BREAK");
8815 "ip_invoke_core receives TCL_CONTINUE");
8822 if (event_loop_abort_on_exc < 0) {
8827 Tcl_ResetResult(ptr->
ip);
8837 #if TCL_MAJOR_VERSION >= 8
8849 #if TCL_MAJOR_VERSION >= 8
8859 #if TCL_MAJOR_VERSION >= 8
8863 Tcl_Preserve((ClientData)av);
8865 for (i = 0; i <
argc; ++
i) {
8866 av[
i] = get_obj_from_str(argv[i]);
8876 Tcl_Preserve((ClientData)av);
8878 for (i = 0; i <
argc; ++
i) {
8892 #if TCL_MAJOR_VERSION >= 8
8900 for (i = 0; i <
argc; ++
i) {
8901 #if TCL_MAJOR_VERSION >= 8
8903 av[
i] = (Tcl_Obj*)NULL;
8906 av[
i] = (
char*)NULL;
8909 #if TCL_MAJOR_VERSION >= 8
8911 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8914 Tcl_Release((ClientData)av);
8921 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8924 Tcl_Release((ClientData)av);
8942 #if TCL_MAJOR_VERSION >= 8
8943 Tcl_Obj **av = (Tcl_Obj **)NULL;
8945 char **av = (
char **)NULL;
8962 Tcl_ResetResult(ptr->
ip);
8992 volatile VALUE q_dat;
8996 DUMP2(
"do_invoke_queue_handler : evPtr = %p", evPtr);
8998 DUMP2(
"added by thread : %lx", thread);
9001 DUMP1(
"processed by another event-loop");
9004 DUMP1(
"process it on current event-loop");
9014 DUMP1(
"caller is not yet ready to receive the result -> pending");
9029 rbtk_internal_eventloop_handler++;
9038 q_dat = (
VALUE)NULL;
9040 DUMP2(
"call invoke_real (for caller thread:%lx)", thread);
9050 rbtk_internal_eventloop_handler--;
9066 DUMP2(
"back to caller (caller thread:%lx)", thread);
9068 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
9069 have_rb_thread_waiting_for_value = 1;
9074 DUMP1(
"finish back to caller");
9075 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
9079 DUMP2(
"caller is dead (caller thread:%lx)", thread);
9092 Tcl_QueuePosition position;
9095 #ifdef RUBY_USE_NATIVE_THREAD
9101 volatile VALUE ip_obj = obj;
9106 #if TCL_MAJOR_VERSION >= 8
9107 Tcl_Obj **av = (Tcl_Obj **)NULL;
9109 char **av = (
char **)NULL;
9116 #ifdef RUBY_USE_NATIVE_THREAD
9118 DUMP2(
"invoke status: ptr->tk_thread_id %p", ptr->tk_thread_id);
9119 DUMP2(
"invoke status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9121 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9123 DUMP2(
"status: eventloopt_thread %lx", eventloop_thread);
9126 #ifdef RUBY_USE_NATIVE_THREAD
9127 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
9130 (
NIL_P(eventloop_thread) || current == eventloop_thread)
9132 if (
NIL_P(eventloop_thread)) {
9133 DUMP2(
"invoke from thread:%lx but no eventloop", current);
9135 DUMP2(
"invoke from current eventloop %lx", current);
9144 DUMP2(
"invoke from thread %lx (NOT current eventloop)", current);
9156 Tcl_Preserve((ClientData)alloc_done);
9164 Tcl_Preserve((ClientData)ivq);
9171 ivq->done = alloc_done;
9174 ivq->interp = ip_obj;
9176 ivq->thread = current;
9181 DUMP1(
"add handler");
9182 #ifdef RUBY_USE_NATIVE_THREAD
9183 if (ptr->tk_thread_id) {
9185 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)ivq, position);
9186 Tcl_ThreadAlert(ptr->tk_thread_id);
9187 }
else if (tk_eventloop_thread_id) {
9190 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
9191 (Tcl_Event*)ivq, position);
9192 Tcl_ThreadAlert(tk_eventloop_thread_id);
9195 Tcl_QueueEvent((Tcl_Event*)ivq, position);
9199 Tcl_QueueEvent((Tcl_Event*)ivq, position);
9208 DUMP2(
"ivq wait for handler (current thread:%lx)", current);
9209 while(*alloc_done >= 0) {
9213 DUMP2(
"*** ivq wakeup (current thread:%lx)", current);
9214 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
9215 if (
NIL_P(eventloop_thread)) {
9216 DUMP1(
"*** ivq lost eventloop thread");
9220 DUMP2(
"back from handler (current thread:%lx)", current);
9225 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
9228 Tcl_Release((ClientData)alloc_done);
9231 ckfree((
char*)alloc_done);
9237 Tcl_EventuallyFree((ClientData)ivq, TCL_DYNAMIC);
9252 DUMP1(
"raise exception");
9258 DUMP1(
"exit ip_invoke");
9311 volatile VALUE varname, index, flag;
9322 #if TCL_MAJOR_VERSION >= 8
9325 volatile VALUE strval;
9342 if (ret == (Tcl_Obj*)NULL) {
9355 strval = get_str_from_obj(ret);
9367 volatile VALUE strval;
9380 if (ret == (
char*)NULL) {
9418 if (
NIL_P(retval)) {
9442 volatile VALUE varname, index, value, flag;
9455 #if TCL_MAJOR_VERSION >= 8
9457 Tcl_Obj *valobj, *ret;
9458 volatile VALUE strval;
9463 valobj = get_obj_from_str(value);
9481 if (ret == (Tcl_Obj*)NULL) {
9494 strval = get_str_from_obj(ret);
9507 volatile VALUE strval;
9520 if (ret == (
char*)NULL) {
9557 if (
NIL_P(retval)) {
9581 volatile VALUE varname, index, flag;
9602 if (
FIX2INT(flag) & TCL_LEAVE_ERR_MSG) {
9632 if (
NIL_P(retval)) {
9654 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9664 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9674 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9685 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9694 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9704 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9715 volatile VALUE ary, elem;
9718 #ifdef HAVE_RUBY_ENCODING_H
9720 volatile VALUE list_ivar_enc;
9727 if (
NIL_P(ip_obj)) {
9728 interp = (Tcl_Interp *)NULL;
9730 interp = (Tcl_Interp *)NULL;
9736 #ifdef HAVE_RUBY_ENCODING_H
9742 #if TCL_MAJOR_VERSION >= 8
9749 listobj = get_obj_from_str(list_str);
9753 result = Tcl_ListObjGetElements(interp, listobj, &objc, &objv);
9755 if (result == TCL_ERROR) {
9757 if (interp == (Tcl_Interp*)NULL) {
9764 for(idx = 0; idx < objc; idx++) {
9776 for(idx = 0; idx < objc; idx++) {
9777 elem = get_str_from_obj(objv[idx]);
9780 #ifdef HAVE_RUBY_ENCODING_H
9783 rb_ivar_set(elem, ID_at_enc, ENCODING_NAME_BINARY);
9799 for(idx = 0; idx < objc; idx++) {
9811 &argc, &argv) == TCL_ERROR) {
9812 if (interp == (Tcl_Interp*)NULL) {
9824 for(idx = 0; idx <
argc; idx++) {
9886 Tcl_Preserve((ClientData)flagPtr);
9891 for(num = 0; num <
argc; num++) {
9894 #if TCL_MAJOR_VERSION >= 8
9898 len += Tcl_ScanElement(dst, &flagPtr[num]) + 1;
9904 result = (
char *)ckalloc(len);
9906 Tcl_Preserve((ClientData)result);
9909 for(num = 0; num <
argc; num++) {
9910 #if TCL_MAJOR_VERSION >= 8
9911 len = Tcl_ConvertCountedElement(
RSTRING_PTR(argv[num]),
9915 len = Tcl_ConvertElement(
RSTRING_PTR(argv[num]), dst, flagPtr[num]);
9921 if (dst == result) {
9928 Tcl_EventuallyFree((ClientData)flagPtr, TCL_DYNAMIC);
9931 Tcl_Release((ClientData)flagPtr);
9934 ckfree((
char*)flagPtr);
9942 Tcl_EventuallyFree((ClientData)result, TCL_DYNAMIC);
9945 Tcl_Release((ClientData)result);
9975 #if TCL_MAJOR_VERSION >= 8
9982 len = Tcl_ScanElement(
RSTRING_PTR(src), &scan_flag);
10031 volatile VALUE ret;
10033 static CONST
char form[]
10034 =
"tcltklib %s :: Ruby%s (%s) %s pthread :: Tcl%s(%s)/Tk%s(%s) %s";
10042 +
strlen(TCL_PATCH_LEVEL)
10043 +
strlen(
"without stub")
10044 +
strlen(TK_PATCH_LEVEL)
10045 +
strlen(
"without stub")
10046 +
strlen(
"unknown tcl_threads");
10051 sprintf(info, form,
10060 #ifdef USE_TCL_STUBS
10066 #ifdef USE_TK_STUBS
10071 #ifdef WITH_TCL_ENABLE_THREAD
10072 #
if WITH_TCL_ENABLE_THREAD
10075 "without tcl_threads"
10078 "unknown tcl_threads"
10105 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10106 if (Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(name)) == (Tcl_Encoding)NULL) {
10107 if (
RTEST(error_mode)) {
10116 #ifdef HAVE_RUBY_ENCODING_H
10121 if (
RTEST(error_mode)) {
10143 #ifdef HAVE_RUBY_ENCODING_H
10159 if (
NIL_P(interp))
return 0;
10161 if (ptr == (
struct tcltkip *) NULL)
return 0;
10165 Tcl_GetEncodingNames(ptr->
ip);
10166 enc_list = Tcl_GetObjResult(ptr->
ip);
10169 if (Tcl_ListObjGetElements(ptr->
ip, enc_list,
10170 &objc, &objv) != TCL_OK) {
10177 for(i = 0; i < objc; i++) {
10215 if (!
NIL_P(interp)) {
10218 ptr = (
struct tcltkip *) NULL;
10224 if (ptr &&
NIL_P(enc)) {
10226 enc =
rb_funcall(interp, ID_encoding_name, 0, 0);
10235 enc =
rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL));
10249 if (!
NIL_P(name)) {
10260 if (!
NIL_P(name)) {
10302 if (
RTEST(error_mode)) {
10326 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10341 if (
NIL_P(interp))
return 0;
10343 if (ptr == (
struct tcltkip *) NULL)
return 0;
10347 Tcl_GetEncodingNames(ptr->
ip);
10348 enc_list = Tcl_GetObjResult(ptr->
ip);
10351 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) != TCL_OK) {
10358 for(i = 0; i < objc; i++) {
10384 if (!
NIL_P(name)) {
10395 if (!
NIL_P(name)) {
10401 if (
RTEST(error_mode)) {
10450 #ifdef HAVE_RUBY_ENCODING_H
10464 #ifdef HAVE_RB_SET_SAFE_LEVEL_FORCE
10480 Tcl_GetEncodingNames(ptr->
ip);
10481 enc_list = Tcl_GetObjResult(ptr->
ip);
10484 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) != TCL_OK) {
10490 for(i = 0; i < objc; i++) {
10491 int name2obj, obj2name;
10493 name2obj = 1; obj2name = 1;
10498 if (strcmp(
RSTRING_PTR(encname),
"identity") == 0) {
10499 name2obj = 1; obj2name = 0;
10502 }
else if (strcmp(
RSTRING_PTR(encname),
"shiftjis") == 0) {
10503 name2obj = 1; obj2name = 0;
10506 }
else if (strcmp(
RSTRING_PTR(encname),
"unicode") == 0) {
10507 name2obj = 1; obj2name = 0;
10510 }
else if (strcmp(
RSTRING_PTR(encname),
"symbol") == 0) {
10511 name2obj = 1; obj2name = 0;
10516 name2obj = 1; obj2name = 1;
10546 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10562 rb_hash_aset(table, ENCODING_NAME_BINARY, ENCODING_NAME_BINARY);
10565 Tcl_GetEncodingNames(ptr->
ip);
10566 enc_list = Tcl_GetObjResult(ptr->
ip);
10569 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) != TCL_OK) {
10575 for(i = 0; i < objc; i++) {
10618 if (
NIL_P(table)) {
10635 #if TCL_MAJOR_VERSION >= 8
10637 #define MASTER_MENU 0
10638 #define TEAROFF_MENU 1
10641 struct dummy_TkMenuEntry {
10643 struct dummy_TkMenu *menuPtr;
10647 struct dummy_TkMenu {
10650 Tcl_Interp *interp;
10651 Tcl_Command widgetCmd;
10652 struct dummy_TkMenuEntry **entries;
10656 Tcl_Obj *menuTypePtr;
10660 struct dummy_TkMenuRef {
10661 struct dummy_TkMenu *menuPtr;
10668 EXTERN struct dummy_TkMenuRef *TkFindMenuReferences(Tcl_Interp*,
char*);
10670 #define MENU_HASH_KEY "tkMenus"
10681 #if TCL_MAJOR_VERSION >= 8
10682 volatile VALUE menu_path;
10684 struct dummy_TkMenuRef *menuRefPtr =
NULL;
10686 Tcl_HashTable *menuTablePtr;
10687 Tcl_HashEntry *hashEntryPtr;
10689 menu_path = argv[0];
10693 menuRefPtr = TkFindMenuReferences(ptr->
ip,
RSTRING_PTR(menu_path));
10696 = (Tcl_HashTable *) Tcl_GetAssocData(ptr->
ip, MENU_HASH_KEY, NULL))
10699 = Tcl_FindHashEntry(menuTablePtr,
RSTRING_PTR(menu_path)))
10701 menuRefPtr = (
struct dummy_TkMenuRef *) Tcl_GetHashValue(hashEntryPtr);
10706 if (menuRefPtr == (
struct dummy_TkMenuRef *)
NULL) {
10710 if (menuRefPtr->menuPtr == (
struct dummy_TkMenu *) NULL) {
10712 "invalid menu widget (maybe already destroyed)");
10715 if ((menuRefPtr->menuPtr)->menuType != MENUBAR) {
10717 "target menu widget must be a MENUBAR type");
10720 (menuRefPtr->menuPtr)->menuType = TEAROFF_MENU;
10724 char *s =
"normal";
10726 (menuRefPtr->menuPtr)->menuTypePtr = Tcl_NewStringObj(s,
strlen(s));
10729 (menuRefPtr->menuPtr)->menuType = MASTER_MENU;
10734 TkEventuallyRecomputeMenu(menuRefPtr->menuPtr);
10735 TkEventuallyRedrawMenu(menuRefPtr->menuPtr,
10736 (
struct dummy_TkMenuEntry *)NULL);
10738 memset((
void *) &event, 0,
sizeof(event));
10739 event.xany.type = ConfigureNotify;
10740 event.xany.serial = NextRequest(Tk_Display((menuRefPtr->menuPtr)->tkwin));
10741 event.xany.send_event = 0;
10742 event.xany.window = Tk_WindowId((menuRefPtr->menuPtr)->tkwin);
10743 event.xany.display = Tk_Display((menuRefPtr->menuPtr)->tkwin);
10744 event.xconfigure.window =
event.xany.window;
10745 Tk_HandleEvent(&event);
10762 argv[0] = menu_path;
10784 tcltkip_class = ip;
10788 #ifdef HAVE_RUBY_ENCODING_H
10827 # define TK_WINDOWING_SYSTEM "win32"
10830 # define TK_WINDOWING_SYSTEM "classic"
10833 # define TK_WINDOWING_SYSTEM "aqua"
10835 # define TK_WINDOWING_SYSTEM "x11"
10856 #ifdef TCL_NAMESPACE_ONLY
10864 #ifdef TCL_PARSE_PART1
10891 eTkLocalJumpError =
rb_define_class(
"TkLocalJumpError", eLocalJumpError);
10893 eTkCallbackRetry =
rb_define_class(
"TkCallbackRetry", eTkLocalJumpError);
10894 eTkCallbackRedo =
rb_define_class(
"TkCallbackRedo", eTkLocalJumpError);
10895 eTkCallbackThrow =
rb_define_class(
"TkCallbackThrow", eTkLocalJumpError);
10901 ID_encoding_name =
rb_intern(
"encoding_name");
10902 ID_encoding_table =
rb_intern(
"encoding_table");
11052 eventloop_thread =
Qnil;
11053 eventloop_interp = (Tcl_Interp*)NULL;
11055 #ifndef DEFAULT_EVENTLOOP_DEPTH
11056 #define DEFAULT_EVENTLOOP_DEPTH 7
11061 watchdog_thread =
Qnil;
11063 rbtk_pending_exception =
Qnil;
11067 #ifdef HAVE_NATIVETHREAD
11093 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
11102 Tcl_ObjType_ByteArray = Tcl_GetObjType(Tcl_ObjTypeName_ByteArray);
11103 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)
void invoke_queue_mark(struct invoke_queue *q)
void rb_thread_schedule(void)
int rb_enc_get_index(VALUE obj)
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)
int rb_thread_check_trap_pending()
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.
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)
static int update_encoding_table(VALUE table, VALUE interp, VALUE error_mode)
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 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 VALUE cRubyEncoding
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 int ENCODING_INDEX_BINARY
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)
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 *)
Evaluates the given string in an isolated binding.
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)
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 *)
Evaluates the given string in an isolated binding.
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)
static int rb_thread_critical
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
#define RbTk_ALLOC_N(type, n)
static VALUE lib_getversion(VALUE self)
static VALUE ip_thread_vwait(VALUE self, VALUE var)
VALUE rb_obj_encoding(VALUE obj)
VALUE rb_gc_disable(void)
static VALUE encoding_table_get_name_core(VALUE table, VALUE enc_arg, VALUE error_mode)
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)
static struct @62 tcltk_version
#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)
#define RSTRING_LENINT(str)
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)
static VALUE ip_get_encoding_table(VALUE interp)
VALUE rb_hash_aset(VALUE, VALUE, VALUE)
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
static int ENCODING_INDEX_UTF8
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)