7 #define TCLTKLIB_RELEASE_DATE "2010-08-25"
12 #ifdef HAVE_RUBY_ENCODING_H
16 #define RUBY_VERSION "(unknown version)"
18 #ifndef RUBY_RELEASE_DATE
19 #define RUBY_RELEASE_DATE "unknown release-date"
23 static VALUE rb_thread_critical;
30 #if !defined(RSTRING_PTR)
31 #define RSTRING_PTR(s) (RSTRING(s)->ptr)
32 #define RSTRING_LEN(s) (RSTRING(s)->len)
34 #if !defined(RARRAY_PTR)
35 #define RARRAY_PTR(s) (RARRAY(s)->ptr)
36 #define RARRAY_LEN(s) (RARRAY(s)->len)
40 #define RbTk_OBJ_UNTRUST(x) do {OBJ_TAINT(x); OBJ_UNTRUST(x);} while (0)
42 #define RbTk_OBJ_UNTRUST(x) OBJ_TAINT(x)
45 #if defined(HAVE_RB_PROC_NEW) && !defined(RUBY_VM)
52 #ifdef HAVE_STDARG_PROTOTYPES
54 #define va_init_list(a,b) va_start(a,b)
57 #define va_init_list(a,b) va_start(a)
61 #if !defined HAVE_VSNPRINTF && !defined vsnprintf
64 # define vsnprintf _vsnprintf
66 # ifdef HAVE_RUBY_RUBY_H
77 #ifndef HAVE_RUBY_NATIVE_THREAD_P
78 #define ruby_native_thread_p() is_ruby_native_thread()
79 #undef RUBY_USE_NATIVE_THREAD
81 #define RUBY_USE_NATIVE_THREAD 1
84 #ifndef HAVE_RB_ERRINFO
85 #define rb_errinfo() (ruby_errinfo+0)
89 #ifndef HAVE_RB_SAFE_LEVEL
90 #define rb_safe_level() (ruby_safe_level+0)
92 #ifndef HAVE_RB_SOURCEFILE
93 #define rb_sourcefile() (ruby_sourcefile+0)
98 #ifndef TCL_ALPHA_RELEASE
99 #define TCL_ALPHA_RELEASE 0
100 #define TCL_BETA_RELEASE 1
101 #define TCL_FINAL_RELEASE 2
122 #if TCL_MAJOR_VERSION >= 8
124 # if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 4
128 # define CONST84 CONST
136 # define CONST84 CONST
144 # if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 5
147 # define CONST86 CONST84
152 #define TAG_RETURN 0x1
153 #define TAG_BREAK 0x2
155 #define TAG_RETRY 0x4
157 #define TAG_RAISE 0x6
158 #define TAG_THROW 0x7
159 #define TAG_FATAL 0x8
162 #define DUMP1(ARG1) if (ruby_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1); fflush(stderr); }
163 #define DUMP2(ARG1, ARG2) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\
164 fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); fflush(stderr); }
165 #define DUMP3(ARG1, ARG2, ARG3) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\
166 fprintf(stderr, ARG1, ARG2, ARG3); fprintf(stderr, "\n"); fflush(stderr); }
183 #ifdef HAVE_RUBY_ENCODING_H
184 static VALUE cRubyEncoding;
187 static int ENCODING_INDEX_UTF8;
188 static int ENCODING_INDEX_BINARY;
249 #if TCL_MAJOR_VERSION >= 8
250 static const char Tcl_ObjTypeName_ByteArray[] =
"bytearray";
251 static CONST86 Tcl_ObjType *Tcl_ObjType_ByteArray;
253 static const char Tcl_ObjTypeName_String[] =
"string";
254 static CONST86 Tcl_ObjType *Tcl_ObjType_String;
256 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
257 #define IS_TCL_BYTEARRAY(obj) ((obj)->typePtr == Tcl_ObjType_ByteArray)
258 #define IS_TCL_STRING(obj) ((obj)->typePtr == Tcl_ObjType_String)
259 #define IS_TCL_VALID_STRING(obj) ((obj)->bytes != (char*)NULL)
263 #ifndef HAVE_RB_HASH_LOOKUP
264 #define rb_hash_lookup rb_hash_aref
269 #ifdef HAVE_PROTOTYPES
270 tcl_eval(Tcl_Interp *interp,
const char *cmd)
280 Tcl_AllowExceptions(interp);
287 #define Tcl_Eval tcl_eval
290 #ifdef HAVE_PROTOTYPES
301 Tcl_AllowExceptions(interp);
307 #undef Tcl_GlobalEval
308 #define Tcl_GlobalEval tcl_global_eval
311 #if TCL_MAJOR_VERSION < 8
312 #define Tcl_IncrRefCount(obj) (1)
313 #define Tcl_DecrRefCount(obj) (1)
317 #if TCL_MAJOR_VERSION < 8
318 #define Tcl_GetStringResult(interp) ((interp)->result)
322 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
324 Tcl_GetVar2Ex(interp, name1, name2, flags)
330 Tcl_Obj *nameObj1, *nameObj2 =
NULL, *retObj;
332 nameObj1 = Tcl_NewStringObj((
char*)name1, -1);
336 nameObj2 = Tcl_NewStringObj((
char*)name2, -1);
340 retObj = Tcl_ObjGetVar2(interp, nameObj1, nameObj2, flags);
352 Tcl_SetVar2Ex(interp, name1, name2, newValObj, flags)
359 Tcl_Obj *nameObj1, *nameObj2 =
NULL, *retObj;
361 nameObj1 = Tcl_NewStringObj((
char*)name1, -1);
365 nameObj2 = Tcl_NewStringObj((
char*)name2, -1);
369 retObj = Tcl_ObjSetVar2(interp, nameObj1, nameObj2, newValObj, flags);
383 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4)
384 # if !defined __MINGW32__ && !defined __BORLANDC__
400 #if TCL_MAJOR_VERSION >= 8
456 for(i = 0; i < q->
argc; i++) {
468 #ifdef RUBY_USE_NATIVE_THREAD
469 Tcl_ThreadId tk_eventloop_thread_id;
484 #ifdef RUBY_USE_NATIVE_THREAD
485 #define CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 1
486 #define USE_TOGGLE_WINDOW_MODE_FOR_IDLE 0
487 #define DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 1
489 #define CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 1
490 #define USE_TOGGLE_WINDOW_MODE_FOR_IDLE 0
491 #define DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 0
494 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
505 #ifdef RUBY_USE_NATIVE_THREAD
506 #define DEFAULT_EVENT_LOOP_MAX 800
507 #define DEFAULT_NO_EVENT_TICK 10
508 #define DEFAULT_NO_EVENT_WAIT 5
509 #define WATCHDOG_INTERVAL 10
510 #define DEFAULT_TIMER_TICK 0
511 #define NO_THREAD_INTERRUPT_TIME 100
513 #define DEFAULT_EVENT_LOOP_MAX 800
514 #define DEFAULT_NO_EVENT_TICK 10
515 #define DEFAULT_NO_EVENT_WAIT 20
516 #define WATCHDOG_INTERVAL 10
517 #define DEFAULT_TIMER_TICK 0
518 #define NO_THREAD_INTERRUPT_TIME 100
521 #define EVENT_HANDLER_TIMEOUT 100
538 #if TCL_MAJOR_VERSION >= 8
542 static int ip_ruby_eval _((ClientData, Tcl_Interp *,
int,
char **));
543 static int ip_ruby_cmd _((ClientData, Tcl_Interp *,
int,
char **));
555 #ifndef TCL_NAMESPACE_DEBUG
556 #define TCL_NAMESPACE_DEBUG 0
559 #if TCL_NAMESPACE_DEBUG
561 #if TCL_MAJOR_VERSION >= 8
562 EXTERN struct TclIntStubs *tclIntStubsPtr;
566 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5
569 # ifndef Tcl_GetCurrentNamespace
570 EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace
_((Tcl_Interp *));
572 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
573 # ifndef Tcl_GetCurrentNamespace
574 # ifndef FunctionNum_of_GetCurrentNamespace
575 #define FunctionNum_of_GetCurrentNamespace 124
577 struct DummyTclIntStubs_for_GetCurrentNamespace {
579 struct TclIntStubHooks *hooks;
580 void (*
func[FunctionNum_of_GetCurrentNamespace])();
581 Tcl_Namespace * (*tcl_GetCurrentNamespace)
_((Tcl_Interp *));
584 #define Tcl_GetCurrentNamespace \
585 (((struct DummyTclIntStubs_for_GetCurrentNamespace *)tclIntStubsPtr)->tcl_GetCurrentNamespace)
592 #if TCL_MAJOR_VERSION < 8
593 #define ip_null_namespace(interp) (0)
595 #define ip_null_namespace(interp) \
596 (Tcl_GetCurrentNamespace(interp) == (Tcl_Namespace *)NULL)
600 #if TCL_MAJOR_VERSION < 8
601 #define rbtk_invalid_namespace(ptr) (0)
603 #define rbtk_invalid_namespace(ptr) \
604 ((ptr)->default_ns == (Tcl_Namespace*)NULL || Tcl_GetCurrentNamespace((ptr)->ip) != (ptr)->default_ns)
608 #if TCL_MAJOR_VERSION >= 8
610 typedef struct CallFrame {
611 Tcl_Namespace *nsPtr;
615 struct CallFrame *callerPtr;
616 struct CallFrame *callerVarPtr;
625 # if !defined(TclGetFrame) && !defined(TclGetFrame_TCL_DECLARED)
626 EXTERN int TclGetFrame
_((Tcl_Interp *,
CONST char *, CallFrame **));
628 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
630 # ifndef FunctionNum_of_GetFrame
631 #define FunctionNum_of_GetFrame 32
633 struct DummyTclIntStubs_for_GetFrame {
635 struct TclIntStubHooks *hooks;
636 void (*
func[FunctionNum_of_GetFrame])();
637 int (*tclGetFrame)
_((Tcl_Interp *,
CONST char *, CallFrame **));
639 #define TclGetFrame \
640 (((struct DummyTclIntStubs_for_GetFrame *)tclIntStubsPtr)->tclGetFrame)
644 # if !defined(Tcl_PopCallFrame) && !defined(Tcl_PopCallFrame_TCL_DECLARED)
645 EXTERN void Tcl_PopCallFrame
_((Tcl_Interp *));
646 EXTERN int Tcl_PushCallFrame
_((Tcl_Interp *, Tcl_CallFrame *, Tcl_Namespace *,
int));
648 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
649 # ifndef Tcl_PopCallFrame
650 # ifndef FunctionNum_of_PopCallFrame
651 #define FunctionNum_of_PopCallFrame 128
653 struct DummyTclIntStubs_for_PopCallFrame {
655 struct TclIntStubHooks *hooks;
656 void (*
func[FunctionNum_of_PopCallFrame])();
657 void (*tcl_PopCallFrame)
_((Tcl_Interp *));
658 int (*tcl_PushCallFrame)
_((Tcl_Interp *, Tcl_CallFrame *, Tcl_Namespace *,
int));
661 #define Tcl_PopCallFrame \
662 (((struct DummyTclIntStubs_for_PopCallFrame *)tclIntStubsPtr)->tcl_PopCallFrame)
663 #define Tcl_PushCallFrame \
664 (((struct DummyTclIntStubs_for_PopCallFrame *)tclIntStubsPtr)->tcl_PushCallFrame)
670 typedef struct CallFrame {
671 Tcl_HashTable varTable;
675 struct CallFrame *callerPtr;
676 struct CallFrame *callerVarPtr;
679 # ifndef Tcl_CallFrame
680 #define Tcl_CallFrame CallFrame
683 # if !defined(TclGetFrame) && !defined(TclGetFrame_TCL_DECLARED)
684 EXTERN int TclGetFrame
_((Tcl_Interp *,
CONST char *, CallFrame **));
687 # if !defined(Tcl_PopCallFrame) && !defined(Tcl_PopCallFrame_TCL_DECLARED)
688 typedef struct DummyInterp {
692 Tcl_HashTable dummy4;
693 Tcl_HashTable dummy5;
694 Tcl_HashTable dummy6;
698 CallFrame *varFramePtr;
702 Tcl_PopCallFrame(interp)
705 DummyInterp *iPtr = (DummyInterp*)interp;
706 CallFrame *frame = iPtr->varFramePtr;
709 iPtr->framePtr = frame.callerPtr;
710 iPtr->varFramePtr = frame.callerVarPtr;
716 #define Tcl_Namespace char
719 Tcl_PushCallFrame(interp, framePtr, nsPtr, isProcCallFrame)
721 Tcl_CallFrame *framePtr;
722 Tcl_Namespace *nsPtr;
725 DummyInterp *iPtr = (DummyInterp*)interp;
726 CallFrame *frame = (CallFrame *)framePtr;
729 Tcl_InitHashTable(&frame.varTable, TCL_STRING_KEYS);
730 if (iPtr->varFramePtr != NULL) {
731 frame.level = iPtr->varFramePtr->level + 1;
735 frame.callerPtr = iPtr->framePtr;
736 frame.callerVarPtr = iPtr->varFramePtr;
737 iPtr->framePtr = &frame;
738 iPtr->varFramePtr = &frame;
752 #if TCL_NAMESPACE_DEBUG
753 Tcl_Namespace *default_ns;
755 #ifdef RUBY_USE_NATIVE_THREAD
756 Tcl_ThreadId tk_thread_id;
776 if (ptr->
ip == (Tcl_Interp*)
NULL) {
787 if (!ptr || !ptr->ip || Tcl_InterpDeleted(ptr->ip)
789 || rbtk_invalid_namespace(ptr)
792 DUMP1(
"ip is deleted");
804 if (ptr->ip == (Tcl_Interp*)
NULL) {
808 Tcl_Preserve((ClientData)ptr->ip);
810 return(ptr->ref_count);
818 if (ptr->ref_count < 0) {
820 }
else if (ptr->ip == (Tcl_Interp*)
NULL) {
824 Tcl_Release((ClientData)ptr->ip);
826 return(ptr->ref_count);
831 #ifdef HAVE_STDARG_PROTOTYPES
848 buf[BUFSIZ - 1] =
'\0';
853 Tcl_ResetResult(ptr->
ip);
861 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
865 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 84
866 #error Ruby/Tk-Kit requires Tcl/Tk8.4 or later.
886 #if defined USE_TCL_STUBS || defined USE_TK_STUBS
887 # error Not support Tcl/Tk stubs with Ruby/Tk-Kit or Rubykit.
890 #ifndef KIT_INCLUDES_ZLIB
891 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
892 #define KIT_INCLUDES_ZLIB 1
894 #define KIT_INCLUDES_ZLIB 0
899 #define WIN32_LEAN_AND_MEAN
901 #undef WIN32_LEAN_AND_MEAN
904 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
905 EXTERN Tcl_Obj* TclGetStartupScriptPath();
906 EXTERN void TclSetStartupScriptPath
_((Tcl_Obj*));
907 #define Tcl_GetStartupScript(encPtr) TclGetStartupScriptPath()
908 #define Tcl_SetStartupScript(path,enc) TclSetStartupScriptPath(path)
910 #if !defined(TclSetPreInitScript) && !defined(TclSetPreInitScript_TCL_DECLARED)
911 EXTERN char* TclSetPreInitScript
_((
char *));
914 #ifndef KIT_INCLUDES_TK
915 # define KIT_INCLUDES_TK 1
920 Tcl_AppInitProc Vfs_Init, Rechan_Init;
921 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
922 Tcl_AppInitProc Pwb_Init;
926 Tcl_AppInitProc Vlerq_Init, Vlerq_SafeInit;
928 Tcl_AppInitProc Mk4tcl_Init;
931 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
932 Tcl_AppInitProc Thread_Init;
935 #if KIT_INCLUDES_ZLIB
936 Tcl_AppInitProc Zlib_Init;
939 #ifdef KIT_INCLUDES_ITCL
940 Tcl_AppInitProc Itcl_Init;
944 Tcl_AppInitProc Dde_Init, Dde_SafeInit, Registry_Init;
949 #define RUBYTK_KITPATH_CONST_NAME "RUBYTK_KITPATH"
951 static char *rubytk_kitpath =
NULL;
953 static char rubytkkit_preInitCmd[] =
954 "proc tclKitPreInit {} {\n"
955 "rename tclKitPreInit {}\n"
956 "load {} rubytk_kitpath\n"
957 #if KIT_INCLUDES_ZLIB
958 "catch {load {} zlib}\n"
962 "namespace eval ::vlerq {}\n"
963 "if {[catch { vlerq open $::tcl::kitpath } ::vlerq::starkit_root]} {\n"
966 "set files [vlerq get $::vlerq::starkit_root 0 dirs 0 files]\n"
967 "set n [lsearch [vlerq get $files * name] boot.tcl]\n"
970 "array set a [vlerq get $files $n]\n"
973 #if defined KIT_VFS_WRITABLE && !defined CREATE_RUBYKIT
975 "mk::file open exe $::tcl::kitpath\n"
977 "mk::file open exe $::tcl::kitpath -readonly\n"
979 "set n [mk::select exe.dirs!0.files name boot.tcl]\n"
980 "if {[llength $n] == 1} {\n"
981 "array set a [mk::get exe.dirs!0.files!$n]\n"
983 "if {![info exists a(contents)]} { error {no boot.tcl file} }\n"
984 "if {$a(size) != [string length $a(contents)]} {\n"
985 "set a(contents) [zlib decompress $a(contents)]\n"
987 "if {$a(contents) eq \"\"} { error {empty boot.tcl} }\n"
988 "uplevel #0 $a(contents)\n"
990 "} elseif {[lindex $::argv 0] eq \"-init-\"} {\n"
991 "uplevel #0 { source [lindex $::argv 1] }\n"
996 "set vfsdir \"[file rootname $::tcl::kitpath].vfs\"\n"
997 "if {[file isdirectory $vfsdir]} {\n"
998 "set ::tcl_library [file join $vfsdir lib tcl$::tcl_version]\n"
999 "set ::tcl_libPath [list $::tcl_library [file join $vfsdir lib]]\n"
1000 "catch {uplevel #0 [list source [file join $vfsdir config.tcl]]}\n"
1001 "uplevel #0 [list source [file join $::tcl_library init.tcl]]\n"
1002 "set ::auto_path $::tcl_libPath\n"
1004 "error \"\n $::tcl::kitpath has no VFS data to start up\"\n"
1014 static const char initScript[] =
1015 "if {[file isfile [file join $::tcl::kitpath main.tcl]]} {\n"
1016 "if {[info commands console] != {}} { console hide }\n"
1017 "set tcl_interactive 0\n"
1019 "set argv [linsert $argv 0 $argv0]\n"
1020 "set argv0 [file join $::tcl::kitpath main.tcl]\n"
1028 set_rubytk_kitpath(
const char *kitpath)
1032 if (rubytk_kitpath) {
1033 ckfree(rubytk_kitpath);
1036 rubytk_kitpath = (
char *)ckalloc(len + 1);
1037 memcpy(rubytk_kitpath, kitpath, len);
1038 rubytk_kitpath[
len] =
'\0';
1040 return rubytk_kitpath;
1046 #define DEV_NULL "NUL"
1048 #define DEV_NULL "/dev/null"
1052 check_tclkit_std_channels()
1061 chan = Tcl_GetStdChannel(TCL_STDIN);
1063 chan = Tcl_OpenFileChannel(NULL, DEV_NULL,
"r", 0);
1065 Tcl_SetChannelOption(NULL, chan,
"-encoding",
"utf-8");
1067 Tcl_SetStdChannel(chan, TCL_STDIN);
1069 chan = Tcl_GetStdChannel(TCL_STDOUT);
1071 chan = Tcl_OpenFileChannel(NULL, DEV_NULL,
"w", 0);
1073 Tcl_SetChannelOption(NULL, chan,
"-encoding",
"utf-8");
1075 Tcl_SetStdChannel(chan, TCL_STDOUT);
1077 chan = Tcl_GetStdChannel(TCL_STDERR);
1079 chan = Tcl_OpenFileChannel(NULL, DEV_NULL,
"w", 0);
1081 Tcl_SetChannelOption(NULL, chan,
"-encoding",
"utf-8");
1083 Tcl_SetStdChannel(chan, TCL_STDERR);
1090 rubytk_kitpathObjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *
const objv[])
1094 set_rubytk_kitpath(Tcl_GetString(objv[1]));
1095 }
else if (objc > 2) {
1096 Tcl_WrongNumArgs(interp, 1, objv,
"?path?");
1098 str = rubytk_kitpath ? rubytk_kitpath : Tcl_GetNameOfExecutable();
1099 Tcl_SetObjResult(interp, Tcl_NewStringObj(str, -1));
1108 rubytk_kitpath_init(Tcl_Interp *interp)
1110 Tcl_CreateObjCommand(interp,
"::tcl::kitpath", rubytk_kitpathObjCmd, 0, 0);
1111 if (Tcl_LinkVar(interp,
"::tcl::kitpath", (
char *) &rubytk_kitpath,
1112 TCL_LINK_STRING | TCL_LINK_READ_ONLY) != TCL_OK) {
1113 Tcl_ResetResult(interp);
1116 Tcl_CreateObjCommand(interp,
"::tcl::rubytk_kitpath", rubytk_kitpathObjCmd, 0, 0);
1117 if (Tcl_LinkVar(interp,
"::tcl::rubytk_kitpath", (
char *) &rubytk_kitpath,
1118 TCL_LINK_STRING | TCL_LINK_READ_ONLY) != TCL_OK) {
1119 Tcl_ResetResult(interp);
1122 if (rubytk_kitpath == NULL) {
1127 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1130 return Tcl_PkgProvide(interp,
"rubytk_kitpath",
"1.0");
1136 init_static_tcltk_packages()
1141 check_tclkit_std_channels();
1143 #ifdef KIT_INCLUDES_ITCL
1144 Tcl_StaticPackage(0,
"Itcl", Itcl_Init, NULL);
1147 Tcl_StaticPackage(0,
"Vlerq", Vlerq_Init, Vlerq_SafeInit);
1149 Tcl_StaticPackage(0,
"Mk4tcl", Mk4tcl_Init, NULL);
1151 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
1152 Tcl_StaticPackage(0,
"pwb", Pwb_Init, NULL);
1154 Tcl_StaticPackage(0,
"rubytk_kitpath", rubytk_kitpath_init, NULL);
1155 Tcl_StaticPackage(0,
"rechan", Rechan_Init, NULL);
1156 Tcl_StaticPackage(0,
"vfs", Vfs_Init, NULL);
1157 #if KIT_INCLUDES_ZLIB
1158 Tcl_StaticPackage(0,
"zlib", Zlib_Init, NULL);
1160 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
1161 Tcl_StaticPackage(0,
"Thread", Thread_Init, Thread_SafeInit);
1164 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
1165 Tcl_StaticPackage(0,
"dde", Dde_Init, Dde_SafeInit);
1167 Tcl_StaticPackage(0,
"dde", Dde_Init, NULL);
1169 Tcl_StaticPackage(0,
"registry", Registry_Init, NULL);
1171 #ifdef KIT_INCLUDES_TK
1172 Tcl_StaticPackage(0,
"Tk", Tk_Init, Tk_SafeInit);
1179 call_tclkit_init_script(Tcl_Interp *interp)
1185 if (Tcl_EvalEx(interp, initScript, -1, TCL_EVAL_GLOBAL) == TCL_OK) {
1186 const char *encoding =
NULL;
1187 Tcl_Obj* path = Tcl_GetStartupScript(&encoding);
1188 Tcl_SetStartupScript(Tcl_GetObjResult(interp), encoding);
1190 Tcl_Eval(interp,
"incr argc -1; set argv [lrange $argv 1 end]");
1204 EXTERN void TkWinSetHINSTANCE(HINSTANCE hInstance);
1205 void rbtk_win32_SetHINSTANCE(
const char *module_name)
1212 hInst = GetModuleHandle(module_name);
1213 TkWinSetHINSTANCE(hInst);
1225 init_static_tcltk_packages();
1229 const_id =
rb_intern(RUBYTK_KITPATH_CONST_NAME);
1232 volatile VALUE pathobj;
1236 #ifdef HAVE_RUBY_ENCODING_H
1244 #ifdef CREATE_RUBYTK_KIT
1245 if (rubytk_kitpath == NULL) {
1249 volatile VALUE basename;
1259 if (rubytk_kitpath == NULL) {
1260 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1263 TclSetPreInitScript(rubytkkit_preInitCmd);
1308 #if TCL_MAJOR_VERSION >= 8
1311 if (Tcl_IsSafe(ptr->
ip)) {
1312 DUMP1(
"Tk_SafeInit");
1319 "tcltklib: can't find Tk_SafeInit()");
1322 "tcltklib: fail to Tk_SafeInit(). %s",
1326 "tcltklib: fail to Tk_InitStubs(). %s",
1330 "tcltklib: unknown error(%d) on ruby_tk_stubs_safeinit", st);
1340 "tcltklib: can't find Tk_Init()");
1343 "tcltklib: fail to Tk_Init(). %s",
1347 "tcltklib: fail to Tk_InitStubs(). %s",
1351 "tcltklib: unknown error(%d) on ruby_tk_stubs_init", st);
1362 #ifdef RUBY_USE_NATIVE_THREAD
1363 ptr->tk_thread_id = Tcl_GetCurrentThread();
1382 DUMP1(
"find a pending exception");
1391 DUMP1(
"pending_exception_check0: call rb_jump_tag(retry)");
1394 DUMP1(
"pending_exception_check0: call rb_jump_tag(redo)");
1397 DUMP1(
"pending_exception_check0: call rb_jump_tag(throw)");
1416 DUMP1(
"find a pending exception");
1430 rb_thread_critical = thr_crit_bup;
1433 DUMP1(
"pending_exception_check1: call rb_jump_tag(retry)");
1436 DUMP1(
"pending_exception_check1: call rb_jump_tag(redo)");
1439 DUMP1(
"pending_exception_check1: call rb_jump_tag(throw)");
1458 #if TCL_MAJOR_VERSION >= 8
1462 DUMP1(
"original_exit is called");
1464 if (!(ptr->has_orig_exit))
return;
1466 thr_crit_bup = rb_thread_critical;
1467 rb_thread_critical =
Qtrue;
1469 Tcl_ResetResult(ptr->ip);
1471 info = &(ptr->orig_exit_info);
1474 #if TCL_MAJOR_VERSION >= 8
1475 state_obj = Tcl_NewIntObj(state);
1478 if (info->isNativeObjectProc) {
1480 #define USE_RUBY_ALLOC 0
1482 argv = (Tcl_Obj **)
ALLOC_N(Tcl_Obj *, 3);
1484 argv = (Tcl_Obj **)ckalloc(
sizeof(Tcl_Obj *) * 3);
1486 Tcl_Preserve((ClientData)argv);
1489 cmd_obj = Tcl_NewStringObj(
"exit", 4);
1493 argv[1] = state_obj;
1494 argv[2] = (Tcl_Obj *)
NULL;
1497 = (*(info->objProc))(info->objClientData, ptr->ip, 2,
argv);
1505 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1508 Tcl_Release((ClientData)argv);
1511 ckfree((
char*)argv);
1515 #undef USE_RUBY_ALLOC
1520 #define USE_RUBY_ALLOC 0
1524 argv = (
CONST84 char **)ckalloc(
sizeof(
char *) * 3);
1526 Tcl_Preserve((ClientData)argv);
1529 argv[0] = (
char *)
"exit";
1531 argv[1] = Tcl_GetStringFromObj(state_obj, (
int*)
NULL);
1532 argv[2] = (
char *)
NULL;
1534 ptr->return_value = (*(info->proc))(info->clientData, ptr->ip, 2,
argv);
1540 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1543 Tcl_Release((ClientData)argv);
1546 ckfree((
char*)argv);
1550 #undef USE_RUBY_ALLOC
1559 #define USE_RUBY_ALLOC 0
1561 argv = (
char **)
ALLOC_N(
char *, 3);
1563 argv = (
char **)ckalloc(
sizeof(
char *) * 3);
1565 Tcl_Preserve((ClientData)argv);
1570 argv[2] = (
char *)
NULL;
1572 ptr->return_value = (*(info->proc))(info->clientData, ptr->ip,
1579 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1582 Tcl_Release((ClientData)argv);
1589 #undef USE_RUBY_ALLOC
1592 DUMP1(
"complete original_exit");
1594 rb_thread_critical = thr_crit_bup;
1604 ClientData clientData;
1611 DUMP1(
"call _timer_for_tcl");
1613 thr_crit_bup = rb_thread_critical;
1614 rb_thread_critical =
Qtrue;
1620 if (timer_tick > 0) {
1627 rb_thread_critical = thr_crit_bup;
1633 #ifdef RUBY_USE_NATIVE_THREAD
1634 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE
1636 toggle_eventloop_window_mode_for_idle()
1638 if (window_event_mode & TCL_IDLE_EVENTS) {
1640 window_event_mode |= TCL_WINDOW_EVENTS;
1641 window_event_mode &= ~TCL_IDLE_EVENTS;
1645 window_event_mode |= TCL_IDLE_EVENTS;
1646 window_event_mode &= ~TCL_WINDOW_EVENTS;
1661 window_event_mode = ~0;
1663 window_event_mode = ~TCL_WINDOW_EVENTS;
1673 if ( ~window_event_mode ) {
1692 "timer-tick parameter must be 0 or positive number");
1695 thr_crit_bup = rb_thread_critical;
1696 rb_thread_critical =
Qtrue;
1701 timer_tick = req_timer_tick = ttick;
1702 if (timer_tick > 0) {
1710 rb_thread_critical = thr_crit_bup;
1734 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1759 "no_event_wait parameter must be positive number");
1762 no_event_wait = t_wait;
1771 return INT2NUM(no_event_wait);
1786 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1806 int lpmax =
NUM2INT(loop_max);
1807 int no_ev =
NUM2INT(no_event);
1811 if (lpmax <= 0 || no_ev <= 0) {
1815 event_loop_max = lpmax;
1816 no_event_tick = no_ev;
1841 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1860 struct Tcl_Time tcl_time;
1863 switch(
TYPE(time)) {
1886 Tcl_SetMaxBlockTime(&tcl_time);
1895 if (
NIL_P(eventloop_thread)) {
1908 if (event_loop_abort_on_exc > 0) {
1910 }
else if (event_loop_abort_on_exc == 0) {
1930 event_loop_abort_on_exc = 1;
1931 }
else if (
NIL_P(val)) {
1932 event_loop_abort_on_exc = -1;
1934 event_loop_abort_on_exc = 0;
1952 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1966 return INT2FIX(Tk_GetNumMainWindows());
1976 #ifdef RUBY_USE_NATIVE_THREAD
1988 tcl_time.usec = 1000L * (
long)no_event_tick;
1989 Tcl_SetMaxBlockTime(&tcl_time);
1999 #ifdef RUBY_USE_NATIVE_THREAD
2001 #ifdef HAVE_PROTOTYPES
2002 call_DoOneEvent_core(
VALUE flag_val)
2004 call_DoOneEvent_core(flag_val)
2011 if (Tcl_DoOneEvent(flag)) {
2019 #ifdef HAVE_PROTOTYPES
2031 #ifdef HAVE_PROTOTYPES
2041 if (Tcl_DoOneEvent(flag)) {
2051 #ifdef HAVE_PROTOTYPES
2060 if (no_event_wait <= 0) {
2067 #ifdef HAVE_NATIVETHREAD
2068 #ifndef RUBY_USE_NATIVE_THREAD
2070 rb_bug(
"cross-thread violation on eventloop_sleep()");
2079 #ifdef HAVE_NATIVETHREAD
2080 #ifndef RUBY_USE_NATIVE_THREAD
2082 rb_bug(
"cross-thread violation on eventloop_sleep()");
2090 #define USE_EVLOOP_THREAD_ALONE_CHECK_FLAG 0
2092 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2094 get_thread_alone_check_flag()
2096 #ifdef RUBY_USE_NATIVE_THREAD
2128 #define TRAP_CHECK() do { \
2129 if (trap_check(check_var) == 0) return 0; \
2135 DUMP1(
"trap check");
2139 if (check_var != (
int*)
NULL) {
2148 if (rb_trap_pending) {
2150 if (rb_prohibit_interrupt || check_var != (
int*)
NULL) {
2165 DUMP1(
"check eventloop_interp");
2166 if (eventloop_interp != (Tcl_Interp*)
NULL
2167 && Tcl_InterpDeleted(eventloop_interp)) {
2168 DUMP2(
"eventloop_interp(%p) was deleted", eventloop_interp);
2183 int found_event = 1;
2189 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2190 int thread_alone_check_flag = 1;
2193 if (update_flag)
DUMP1(
"update loop start!!");
2200 if (timer_tick > 0) {
2201 thr_crit_bup = rb_thread_critical;
2202 rb_thread_critical =
Qtrue;
2205 rb_thread_critical = thr_crit_bup;
2210 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2212 thread_alone_check_flag = get_thread_alone_check_flag();
2218 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2223 DUMP1(
"no other thread");
2224 event_loop_wait_event = 0;
2227 event_flag = update_flag;
2230 event_flag = TCL_ALL_EVENTS;
2234 if (timer_tick == 0 && update_flag == 0) {
2241 if (check_var != (
int *)
NULL) {
2242 if (*check_var || !found_event) {
2245 if (interp != (Tcl_Interp*)
NULL
2246 && Tcl_InterpDeleted(interp)) {
2254 INT2FIX(event_flag), &status));
2286 DUMP2(
"DoOneEvent(1) abnormal exit!! %d",
2291 DUMP1(
"exception on wait");
2300 if (update_flag != 0) {
2302 DUMP1(
"next update loop");
2305 DUMP1(
"update complete");
2313 DUMP1(
"check Root Widget");
2320 if (loop_counter++ > 30000) {
2328 DUMP1(
"there are other threads");
2329 event_loop_wait_event = 1;
2334 event_flag = update_flag;
2337 event_flag = TCL_ALL_EVENTS;
2343 while(tick_counter < event_loop_max) {
2344 if (check_var != (
int *)
NULL) {
2345 if (*check_var || !found_event) {
2348 if (interp != (Tcl_Interp*)
NULL
2349 && Tcl_InterpDeleted(interp)) {
2355 if (
NIL_P(eventloop_thread) || current == eventloop_thread) {
2359 #ifdef RUBY_USE_NATIVE_THREAD
2362 INT2FIX(event_flag), &status));
2365 INT2FIX(event_flag & window_event_mode),
2367 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE
2369 if (toggle_eventloop_window_mode_for_idle()) {
2382 INT2FIX(event_flag), &status));
2385 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
2386 if (have_rb_thread_waiting_for_value) {
2387 have_rb_thread_waiting_for_value = 0;
2398 "unknown exception");
2424 DUMP2(
"DoOneEvent(2) abnormal exit!! %d",
2431 if (check_var != (
int*)
NULL
2433 DUMP1(
"exception on wait");
2445 if (update_flag != 0) {
2446 DUMP1(
"update complete");
2462 "unknown exception");
2491 DUMP2(
"sleep eventloop %lx", current);
2492 DUMP2(
"eventloop thread is %lx", eventloop_thread);
2497 if (!
NIL_P(watchdog_thread) && eventloop_thread != current) {
2504 DUMP1(
"check Root Widget");
2511 if (loop_counter++ > 30000) {
2516 if (run_timer_flag) {
2525 DUMP1(
"thread scheduling");
2529 DUMP1(
"check interrupts");
2530 #if defined(RUBY_USE_NATIVE_THREAD) || defined(RUBY_VM)
2613 DUMP2(
"eventloop_ensure: current-thread : %lx", current_evloop);
2614 DUMP2(
"eventloop_ensure: eventloop-thread : %lx", eventloop_thread);
2615 if (eventloop_thread != current_evloop) {
2616 DUMP2(
"finish eventloop %lx (NOT current eventloop)", current_evloop);
2626 while((eventloop_thread =
rb_ary_pop(eventloop_stack))) {
2627 DUMP2(
"eventloop-ensure: new eventloop-thread -> %lx",
2630 if (eventloop_thread == current_evloop) {
2632 DUMP2(
"eventloop %lx : back from recursive call", current_evloop);
2636 if (
NIL_P(eventloop_thread)) {
2648 DUMP2(
"eventloop-enshure: wake up parent %lx", eventloop_thread);
2655 #ifdef RUBY_USE_NATIVE_THREAD
2656 if (
NIL_P(eventloop_thread)) {
2657 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2666 DUMP2(
"finish current eventloop %lx", current_evloop);
2684 #ifdef RUBY_USE_NATIVE_THREAD
2685 tk_eventloop_thread_id = Tcl_GetCurrentThread();
2688 if (parent_evloop == eventloop_thread) {
2689 DUMP2(
"eventloop: recursive call on %lx", parent_evloop);
2693 if (!
NIL_P(parent_evloop) && parent_evloop != eventloop_thread) {
2694 DUMP2(
"wait for stop of parent_evloop %lx", parent_evloop);
2696 DUMP2(
"parent_evloop %lx doesn't stop", parent_evloop);
2699 DUMP1(
"succeed to stop parent");
2704 DUMP3(
"tcltklib: eventloop-thread : %lx -> %lx\n",
2705 parent_evloop, eventloop_thread);
2713 rb_thread_critical =
Qfalse;
2730 VALUE check_rootwidget;
2732 if (
rb_scan_args(argc, argv,
"01", &check_rootwidget) == 0) {
2733 check_rootwidget =
Qtrue;
2734 }
else if (
RTEST(check_rootwidget)) {
2735 check_rootwidget =
Qtrue;
2737 check_rootwidget =
Qfalse;
2758 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2763 eventloop_interp = ptr->
ip;
2765 eventloop_interp = (Tcl_Interp*)
NULL;
2772 VALUE check_rootwidget;
2778 #define EVLOOP_WAKEUP_CHANCE 3
2782 VALUE check_rootwidget;
2787 int check =
RTEST(check_rootwidget);
2796 if (!
NIL_P(watchdog_thread)) {
2807 if (
NIL_P(eventloop_thread)
2810 DUMP2(
"eventloop thread %lx is sleeping or dead",
2813 (
void*)&check_rootwidget);
2814 DUMP2(
"create new eventloop thread %lx", evloop);
2825 if (event_loop_wait_event) {
2841 eventloop_thread =
Qnil;
2842 #ifdef RUBY_USE_NATIVE_THREAD
2843 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2854 VALUE check_rootwidget;
2858 "eventloop_watchdog is not implemented on Ruby VM.");
2861 if (
rb_scan_args(argc, argv,
"01", &check_rootwidget) == 0) {
2862 check_rootwidget =
Qtrue;
2863 }
else if (
RTEST(check_rootwidget)) {
2864 check_rootwidget =
Qtrue;
2866 check_rootwidget =
Qfalse;
2886 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2934 #ifdef HAVE_PROTOTYPES
2952 int status, foundEvent;
3014 volatile VALUE vflags;
3018 if (!
NIL_P(eventloop_thread)) {
3025 flags = TCL_ALL_EVENTS | TCL_DONT_WAIT;
3032 flags |= TCL_DONT_WAIT;
3044 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
3046 flags |= TCL_DONT_WAIT;
3051 found_event = Tcl_DoOneEvent(flags);
3093 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
3095 Tcl_Encoding encoding;
3098 thr_crit_bup = rb_thread_critical;
3099 rb_thread_critical =
Qtrue;
3104 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
3110 encoding = (Tcl_Encoding)
NULL;
3129 Tcl_DStringInit(&dstr);
3130 Tcl_DStringFree(&dstr);
3131 Tcl_ExternalToUtfDString(encoding, buf,
RSTRING_LEN(msg), &dstr);
3133 Tcl_AppendResult(interp, Tcl_DStringValue(&dstr), (
char*)
NULL);
3134 DUMP2(
"error message:%s", Tcl_DStringValue(&dstr));
3135 Tcl_DStringFree(&dstr);
3143 rb_thread_critical = thr_crit_bup;
3176 #ifdef HAVE_PROTOTYPES
3187 int thr_crit_bup = rb_thread_critical;
3189 Tcl_ResetResult(interp);
3191 rb_thread_critical =
Qfalse;
3193 rb_thread_critical =
Qtrue;
3219 DUMP1(
"rb_protect: retry");
3220 exc =
rb_exc_new2(eTkCallbackRetry,
"retry jump error");
3228 DUMP1(
"rb_protect: redo");
3229 exc =
rb_exc_new2(eTkCallbackRedo,
"redo jump error");
3253 DUMP1(
"rb_protect: throw");
3254 exc =
rb_exc_new2(eTkCallbackThrow,
"throw jump error");
3263 sprintf(buf,
"unknown loncaljmp status %d", status);
3275 rb_thread_critical = thr_crit_bup;
3277 Tcl_ResetResult(interp);
3282 volatile VALUE backtrace;
3286 thr_crit_bup = rb_thread_critical;
3287 rb_thread_critical =
Qtrue;
3289 DUMP1(
"set backtrace");
3295 rb_thread_critical = thr_crit_bup;
3299 if (eclass == eTkCallbackReturn)
3302 if (eclass == eTkCallbackBreak)
3305 if (eclass == eTkCallbackContinue)
3306 return TCL_CONTINUE;
3322 if (
SYM2ID(reason) == ID_return)
3325 if (
SYM2ID(reason) == ID_break)
3328 if (
SYM2ID(reason) == ID_next)
3329 return TCL_CONTINUE;
3339 thr_crit_bup = rb_thread_critical;
3340 rb_thread_critical =
Qtrue;
3343 DUMP1(
"Tcl_AppendResult");
3346 rb_thread_critical = thr_crit_bup;
3362 #ifdef HAVE_NATIVETHREAD
3363 #ifndef RUBY_USE_NATIVE_THREAD
3365 rb_bug(
"cross-thread violation on tcl_protect()");
3374 int old_trapflag = rb_trap_immediate;
3375 rb_trap_immediate = 0;
3377 rb_trap_immediate = old_trapflag;
3385 #if TCL_MAJOR_VERSION >= 8
3387 ClientData clientData;
3390 Tcl_Obj *
CONST argv[];
3393 ClientData clientData;
3403 if (interp == (Tcl_Interp*)
NULL) {
3413 "wrong number of arguments (%d for 1)", argc - 1);
3415 char buf[
sizeof(int)*8 + 1];
3416 Tcl_ResetResult(interp);
3417 sprintf(
buf,
"%d", argc-1);
3418 Tcl_AppendResult(interp,
"wrong number of arguments (",
3419 buf,
" for 1)", (
char *)
NULL);
3427 #if TCL_MAJOR_VERSION >= 8
3432 thr_crit_bup = rb_thread_critical;
3433 rb_thread_critical =
Qtrue;
3435 str = Tcl_GetStringFromObj(argv[1], &len);
3438 memcpy(arg, str, len);
3441 rb_thread_critical = thr_crit_bup;
3449 DUMP2(
"rb_eval_string(%s)", arg);
3453 #if TCL_MAJOR_VERSION >= 8
3470 DUMP1(
"call ip_ruby_cmd_core");
3471 thr_crit_bup = rb_thread_critical;
3472 rb_thread_critical =
Qfalse;
3473 ret =
rb_apply(arg->receiver, arg->method, arg->args);
3474 DUMP2(
"rb_apply return:%lx", ret);
3475 rb_thread_critical = thr_crit_bup;
3476 DUMP1(
"finish ip_ruby_cmd_core");
3481 #define SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER 1
3493 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3512 head = name =
strdup(name);
3515 if (*head ==
':') head += 2;
3539 volatile VALUE receiver;
3540 #if !SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3544 if (str[0] ==
':' || (
'A' <= str[0] && str[0] <=
'Z')) {
3546 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3550 if (state)
return Qnil;
3552 }
else if (str[0] ==
'$') {
3564 memcpy(buf + 1, str, len);
3576 #if TCL_MAJOR_VERSION >= 8
3578 ClientData clientData;
3581 Tcl_Obj *
CONST argv[];
3584 ClientData clientData;
3590 volatile VALUE receiver;
3601 if (interp == (Tcl_Interp*)
NULL) {
3611 Tcl_ResetResult(interp);
3612 Tcl_AppendResult(interp,
"too few arguments", (
char *)
NULL);
3620 thr_crit_bup = rb_thread_critical;
3621 rb_thread_critical =
Qtrue;
3625 #if TCL_MAJOR_VERSION >= 8
3626 str = Tcl_GetStringFromObj(argv[1], &len);
3630 DUMP2(
"receiver:%s",str);
3633 if (
NIL_P(receiver)) {
3636 "unknown class/module/global-variable '%s'", str);
3638 Tcl_ResetResult(interp);
3639 Tcl_AppendResult(interp,
"unknown class/module/global-variable '",
3640 str,
"'", (
char *)
NULL);
3649 #if TCL_MAJOR_VERSION >= 8
3650 str = Tcl_GetStringFromObj(argv[2], &len);
3658 for(i = 3; i <
argc; i++) {
3660 #if TCL_MAJOR_VERSION >= 8
3661 str = Tcl_GetStringFromObj(argv[i], &len);
3667 DUMP2(
"arg:%s",str);
3668 #ifndef HAVE_STRUCT_RARRAY_LEN
3676 rb_thread_critical = thr_crit_bup;
3700 #if TCL_MAJOR_VERSION >= 8
3701 #ifdef HAVE_PROTOTYPES
3702 ip_InterpExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3703 int argc, Tcl_Obj *
CONST argv[])
3705 ip_InterpExitObjCmd(clientData, interp, argc, argv)
3706 ClientData clientData;
3709 Tcl_Obj *
CONST argv[];
3712 #ifdef HAVE_PROTOTYPES
3714 int argc,
char *argv[])
3717 ClientData clientData;
3724 DUMP1(
"start ip_InterpExitCommand");
3725 if (interp != (Tcl_Interp*)
NULL
3726 && !Tcl_InterpDeleted(interp)
3728 && !ip_null_namespace(interp)
3731 Tcl_ResetResult(interp);
3734 if (!Tcl_InterpDeleted(interp)) {
3737 Tcl_DeleteInterp(interp);
3738 Tcl_Release(interp);
3745 #if TCL_MAJOR_VERSION >= 8
3746 #ifdef HAVE_PROTOTYPES
3747 ip_RubyExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3748 int argc, Tcl_Obj *
CONST argv[])
3750 ip_RubyExitObjCmd(clientData, interp, argc, argv)
3751 ClientData clientData;
3754 Tcl_Obj *
CONST argv[];
3757 #ifdef HAVE_PROTOTYPES
3759 int argc,
char *argv[])
3762 ClientData clientData;
3771 #if TCL_MAJOR_VERSION < 8
3776 DUMP1(
"start ip_RubyExitCommand");
3778 #if TCL_MAJOR_VERSION >= 8
3780 cmd = Tcl_GetStringFromObj(argv[0], (
int*)
NULL);
3783 if (argc < 1 || argc > 2) {
3785 Tcl_AppendResult(interp,
3786 "wrong number of arguments: should be \"",
3787 cmd,
" ?returnCode?\"", (
char *)
NULL);
3791 if (interp == (Tcl_Interp*)
NULL)
return TCL_OK;
3793 Tcl_ResetResult(interp);
3796 if (!Tcl_InterpDeleted(interp)) {
3799 Tcl_DeleteInterp(interp);
3800 Tcl_Release(interp);
3808 Tcl_AppendResult(interp,
3809 "fail to call \"", cmd,
"\"", (
char *)
NULL);
3818 #if TCL_MAJOR_VERSION >= 8
3819 if (Tcl_GetIntFromObj(interp, argv[1], &state) == TCL_ERROR) {
3823 param = Tcl_GetStringFromObj(argv[1], (
int*)
NULL);
3825 state = (int)
strtol(argv[1], &endptr, 0);
3827 Tcl_AppendResult(interp,
3828 "expected integer but got \"",
3829 argv[1],
"\"", (
char *)
NULL);
3836 Tcl_AppendResult(interp,
"fail to call \"", cmd,
" ",
3837 param,
"\"", (
char *)
NULL);
3847 Tcl_AppendResult(interp,
3848 "wrong number of arguments: should be \"",
3849 cmd,
" ?returnCode?\"", (
char *)
NULL);
3862 #if TCL_MAJOR_VERSION >= 8
3863 static int ip_rbUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
3864 Tcl_Obj *
CONST []));
3866 ip_rbUpdateObjCmd(clientData, interp, objc, objv)
3867 ClientData clientData;
3870 Tcl_Obj *
CONST objv[];
3875 ClientData clientData;
3884 static CONST char *updateOptions[] = {
"idletasks", (
char *)
NULL};
3885 enum updateOptions {REGEXP_IDLETASKS};
3887 DUMP1(
"Ruby's 'update' is called");
3888 if (interp == (Tcl_Interp*)
NULL) {
3893 #ifdef HAVE_NATIVETHREAD
3894 #ifndef RUBY_USE_NATIVE_THREAD
3896 rb_bug(
"cross-thread violation on ip_ruby_eval()");
3901 Tcl_ResetResult(interp);
3904 flags = TCL_DONT_WAIT;
3906 }
else if (objc == 2) {
3907 #if TCL_MAJOR_VERSION >= 8
3908 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
3909 "option", 0, &optionIndex) != TCL_OK) {
3912 switch ((
enum updateOptions) optionIndex) {
3913 case REGEXP_IDLETASKS: {
3914 flags = TCL_IDLE_EVENTS;
3918 rb_bug(
"ip_rbUpdateObjCmd: bad option index to UpdateOptions");
3922 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
3923 Tcl_AppendResult(interp,
"bad option \"", objv[1],
3924 "\": must be idletasks", (
char *)
NULL);
3927 flags = TCL_IDLE_EVENTS;
3930 #ifdef Tcl_WrongNumArgs
3931 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
3933 # if TCL_MAJOR_VERSION >= 8
3935 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
3936 Tcl_GetStringFromObj(objv[0], &dummy),
3940 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
3941 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
3947 Tcl_Preserve(interp);
3955 Tcl_Release(interp);
3972 if (rb_trap_pending) {
3974 Tcl_Release(interp);
3985 Tcl_ResetResult(interp);
3986 Tcl_Release(interp);
3988 DUMP1(
"finish Ruby's 'update'");
4004 ClientData clientData;
4008 DUMP1(
"threadUpdateProc is called");
4015 #if TCL_MAJOR_VERSION >= 8
4016 static int ip_rb_threadUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
4017 Tcl_Obj *
CONST []));
4019 ip_rb_threadUpdateObjCmd(clientData, interp, objc, objv)
4020 ClientData clientData;
4023 Tcl_Obj *
CONST objv[];
4029 ClientData clientData;
4038 static CONST char *updateOptions[] = {
"idletasks", (
char *)
NULL};
4039 enum updateOptions {REGEXP_IDLETASKS};
4043 DUMP1(
"Ruby's 'thread_update' is called");
4044 if (interp == (Tcl_Interp*)
NULL) {
4049 #ifdef HAVE_NATIVETHREAD
4050 #ifndef RUBY_USE_NATIVE_THREAD
4052 rb_bug(
"cross-thread violation on ip_rb_threadUpdateCommand()");
4058 ||
NIL_P(eventloop_thread) || eventloop_thread == current_thread) {
4059 #if TCL_MAJOR_VERSION >= 8
4060 DUMP1(
"call ip_rbUpdateObjCmd");
4061 return ip_rbUpdateObjCmd(clientData, interp, objc, objv);
4063 DUMP1(
"call ip_rbUpdateCommand");
4068 DUMP1(
"start Ruby's 'thread_update' body");
4070 Tcl_ResetResult(interp);
4073 flags = TCL_DONT_WAIT;
4075 }
else if (objc == 2) {
4076 #if TCL_MAJOR_VERSION >= 8
4077 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
4078 "option", 0, &optionIndex) != TCL_OK) {
4081 switch ((
enum updateOptions) optionIndex) {
4082 case REGEXP_IDLETASKS: {
4083 flags = TCL_IDLE_EVENTS;
4087 rb_bug(
"ip_rb_threadUpdateObjCmd: bad option index to UpdateOptions");
4091 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
4092 Tcl_AppendResult(interp,
"bad option \"", objv[1],
4093 "\": must be idletasks", (
char *)
NULL);
4096 flags = TCL_IDLE_EVENTS;
4099 #ifdef Tcl_WrongNumArgs
4100 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
4102 # if TCL_MAJOR_VERSION >= 8
4104 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4105 Tcl_GetStringFromObj(objv[0], &dummy),
4109 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4110 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
4116 DUMP1(
"pass argument check");
4121 Tcl_Preserve((ClientData)param);
4123 param->thread = current_thread;
4126 DUMP1(
"set idle proc");
4132 while(!param->done) {
4133 DUMP1(
"wait for complete idle proc");
4137 if (
NIL_P(eventloop_thread)) {
4143 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
4146 Tcl_Release((ClientData)param);
4149 ckfree((
char *)param);
4153 DUMP1(
"finish Ruby's 'thread_update'");
4161 #if TCL_MAJOR_VERSION >= 8
4162 static int ip_rbVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4163 Tcl_Obj *
CONST []));
4164 static int ip_rb_threadVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4165 Tcl_Obj *CONST []));
4166 static int ip_rbTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4167 Tcl_Obj *CONST []));
4168 static int ip_rb_threadTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4169 Tcl_Obj *CONST []));
4179 #if TCL_MAJOR_VERSION >= 8
4184 ClientData clientData;
4190 static char *
VwaitVarProc _((ClientData, Tcl_Interp *,
char *,
char *,
int));
4193 ClientData clientData;
4200 int *donePtr = (
int *) clientData;
4203 return (
char *)
NULL;
4206 #if TCL_MAJOR_VERSION >= 8
4208 ip_rbVwaitObjCmd(clientData, interp, objc, objv)
4209 ClientData clientData;
4212 Tcl_Obj *CONST objv[];
4216 ClientData clientData;
4222 int ret,
done, foundEvent;
4227 DUMP1(
"Ruby's 'vwait' is called");
4228 if (interp == (Tcl_Interp*)
NULL) {
4236 && eventloop_thread !=
Qnil
4238 #if TCL_MAJOR_VERSION >= 8
4239 DUMP1(
"call ip_rb_threadVwaitObjCmd");
4240 return ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv);
4242 DUMP1(
"call ip_rb_threadVwaitCommand");
4248 Tcl_Preserve(interp);
4249 #ifdef HAVE_NATIVETHREAD
4250 #ifndef RUBY_USE_NATIVE_THREAD
4252 rb_bug(
"cross-thread violation on ip_rbVwaitCommand()");
4257 Tcl_ResetResult(interp);
4260 #ifdef Tcl_WrongNumArgs
4261 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4263 thr_crit_bup = rb_thread_critical;
4264 rb_thread_critical =
Qtrue;
4266 #if TCL_MAJOR_VERSION >= 8
4268 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4270 nameString = objv[0];
4272 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4273 nameString,
" name\"", (
char *)
NULL);
4275 rb_thread_critical = thr_crit_bup;
4278 Tcl_Release(interp);
4282 thr_crit_bup = rb_thread_critical;
4283 rb_thread_critical =
Qtrue;
4285 #if TCL_MAJOR_VERSION >= 8
4288 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4290 nameString = objv[1];
4300 ret = Tcl_TraceVar(interp, nameString,
4301 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4304 rb_thread_critical = thr_crit_bup;
4306 if (ret != TCL_OK) {
4307 #if TCL_MAJOR_VERSION >= 8
4310 Tcl_Release(interp);
4319 thr_crit_bup = rb_thread_critical;
4320 rb_thread_critical =
Qtrue;
4322 Tcl_UntraceVar(interp, nameString,
4323 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4326 rb_thread_critical = thr_crit_bup;
4330 #if TCL_MAJOR_VERSION >= 8
4333 Tcl_Release(interp);
4350 if (rb_trap_pending) {
4352 #if TCL_MAJOR_VERSION >= 8
4355 Tcl_Release(interp);
4365 Tcl_ResetResult(interp);
4367 thr_crit_bup = rb_thread_critical;
4368 rb_thread_critical =
Qtrue;
4370 Tcl_AppendResult(interp,
"can't wait for variable \"", nameString,
4371 "\": would wait forever", (
char *)
NULL);
4373 rb_thread_critical = thr_crit_bup;
4375 #if TCL_MAJOR_VERSION >= 8
4378 Tcl_Release(interp);
4382 #if TCL_MAJOR_VERSION >= 8
4385 Tcl_Release(interp);
4393 #if TCL_MAJOR_VERSION >= 8
4398 ClientData clientData;
4405 char *,
char *,
int));
4408 ClientData clientData;
4415 int *donePtr = (
int *) clientData;
4418 return (
char *)
NULL;
4424 ClientData clientData;
4427 int *donePtr = (
int *) clientData;
4429 if (eventPtr->type == VisibilityNotify) {
4432 if (eventPtr->type == DestroyNotify) {
4440 ClientData clientData;
4443 int *donePtr = (
int *) clientData;
4445 if (eventPtr->type == DestroyNotify) {
4450 #if TCL_MAJOR_VERSION >= 8
4452 ip_rbTkWaitObjCmd(clientData, interp, objc, objv)
4453 ClientData clientData;
4456 Tcl_Obj *CONST objv[];
4460 ClientData clientData;
4466 Tk_Window tkwin = (Tk_Window) clientData;
4469 static CONST
char *optionStrings[] = {
"variable",
"visibility",
"window",
4471 enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW };
4476 DUMP1(
"Ruby's 'tkwait' is called");
4477 if (interp == (Tcl_Interp*)
NULL) {
4485 && eventloop_thread !=
Qnil
4487 #if TCL_MAJOR_VERSION >= 8
4488 DUMP1(
"call ip_rb_threadTkWaitObjCmd");
4489 return ip_rb_threadTkWaitObjCmd((ClientData)tkwin, interp, objc, objv);
4491 DUMP1(
"call ip_rb_threadTkWaitCommand");
4492 return ip_rb_threadTkWwaitCommand((ClientData)tkwin, interp, objc, objv);
4497 Tcl_Preserve(interp);
4498 Tcl_ResetResult(interp);
4501 #ifdef Tcl_WrongNumArgs
4502 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
4504 thr_crit_bup = rb_thread_critical;
4505 rb_thread_critical =
Qtrue;
4507 #if TCL_MAJOR_VERSION >= 8
4508 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4509 Tcl_GetStringFromObj(objv[0], &dummy),
4510 " variable|visibility|window name\"",
4513 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4514 objv[0],
" variable|visibility|window name\"",
4518 rb_thread_critical = thr_crit_bup;
4521 Tcl_Release(interp);
4525 #if TCL_MAJOR_VERSION >= 8
4526 thr_crit_bup = rb_thread_critical;
4527 rb_thread_critical =
Qtrue;
4536 ret = Tcl_GetIndexFromObj(interp, objv[1],
4537 (
CONST84 char **)optionStrings,
4538 "option", 0, &index);
4540 rb_thread_critical = thr_crit_bup;
4542 if (ret != TCL_OK) {
4543 Tcl_Release(interp);
4549 size_t length =
strlen(objv[1]);
4551 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
4553 index = TKWAIT_VARIABLE;
4554 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
4556 index = TKWAIT_VISIBILITY;
4557 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
4558 index = TKWAIT_WINDOW;
4560 Tcl_AppendResult(interp,
"bad option \"", objv[1],
4561 "\": must be variable, visibility, or window",
4563 Tcl_Release(interp);
4569 thr_crit_bup = rb_thread_critical;
4570 rb_thread_critical =
Qtrue;
4572 #if TCL_MAJOR_VERSION >= 8
4575 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
4577 nameString = objv[2];
4580 rb_thread_critical = thr_crit_bup;
4582 switch ((
enum options) index) {
4583 case TKWAIT_VARIABLE:
4584 thr_crit_bup = rb_thread_critical;
4585 rb_thread_critical =
Qtrue;
4593 ret = Tcl_TraceVar(interp, nameString,
4594 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4597 rb_thread_critical = thr_crit_bup;
4599 if (ret != TCL_OK) {
4600 #if TCL_MAJOR_VERSION >= 8
4603 Tcl_Release(interp);
4611 thr_crit_bup = rb_thread_critical;
4612 rb_thread_critical =
Qtrue;
4614 Tcl_UntraceVar(interp, nameString,
4615 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4618 #if TCL_MAJOR_VERSION >= 8
4622 rb_thread_critical = thr_crit_bup;
4626 Tcl_Release(interp);
4643 if (rb_trap_pending) {
4645 Tcl_Release(interp);
4652 case TKWAIT_VISIBILITY:
4653 thr_crit_bup = rb_thread_critical;
4654 rb_thread_critical =
Qtrue;
4660 window = Tk_NameToWindow(interp, nameString, tkwin);
4663 if (window == NULL) {
4664 Tcl_AppendResult(interp,
": tkwait: ",
4665 "no main-window (not Tk application?)",
4667 rb_thread_critical = thr_crit_bup;
4668 #if TCL_MAJOR_VERSION >= 8
4671 Tcl_Release(interp);
4675 Tk_CreateEventHandler(window,
4676 VisibilityChangeMask|StructureNotifyMask,
4679 rb_thread_critical = thr_crit_bup;
4687 #if TCL_MAJOR_VERSION >= 8
4690 Tcl_Release(interp);
4707 if (rb_trap_pending) {
4709 #if TCL_MAJOR_VERSION >= 8
4712 Tcl_Release(interp);
4722 thr_crit_bup = rb_thread_critical;
4723 rb_thread_critical =
Qtrue;
4725 Tcl_ResetResult(interp);
4726 Tcl_AppendResult(interp,
"window \"", nameString,
4727 "\" was deleted before its visibility changed",
4730 rb_thread_critical = thr_crit_bup;
4732 #if TCL_MAJOR_VERSION >= 8
4735 Tcl_Release(interp);
4739 thr_crit_bup = rb_thread_critical;
4740 rb_thread_critical =
Qtrue;
4742 #if TCL_MAJOR_VERSION >= 8
4746 Tk_DeleteEventHandler(window,
4747 VisibilityChangeMask|StructureNotifyMask,
4750 rb_thread_critical = thr_crit_bup;
4755 thr_crit_bup = rb_thread_critical;
4756 rb_thread_critical =
Qtrue;
4762 window = Tk_NameToWindow(interp, nameString, tkwin);
4765 #if TCL_MAJOR_VERSION >= 8
4769 if (window == NULL) {
4770 Tcl_AppendResult(interp,
": tkwait: ",
4771 "no main-window (not Tk application?)",
4773 rb_thread_critical = thr_crit_bup;
4774 Tcl_Release(interp);
4778 Tk_CreateEventHandler(window, StructureNotifyMask,
4781 rb_thread_critical = thr_crit_bup;
4789 Tcl_Release(interp);
4806 if (rb_trap_pending) {
4808 Tcl_Release(interp);
4825 Tcl_ResetResult(interp);
4826 Tcl_Release(interp);
4838 #if TCL_MAJOR_VERSION >= 8
4843 ClientData clientData;
4850 char *,
char *,
int));
4853 ClientData clientData;
4862 if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
4869 return (
char *)NULL;
4872 #define TKWAIT_MODE_VISIBILITY 1
4873 #define TKWAIT_MODE_DESTROY 2
4878 ClientData clientData;
4883 if (eventPtr->type == VisibilityNotify) {
4886 if (eventPtr->type == DestroyNotify) {
4895 ClientData clientData;
4900 if (eventPtr->type == DestroyNotify) {
4906 #if TCL_MAJOR_VERSION >= 8
4908 ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv)
4909 ClientData clientData;
4912 Tcl_Obj *CONST objv[];
4916 ClientData clientData;
4929 DUMP1(
"Ruby's 'thread_vwait' is called");
4930 if (interp == (Tcl_Interp*)NULL) {
4937 #if TCL_MAJOR_VERSION >= 8
4938 DUMP1(
"call ip_rbVwaitObjCmd");
4939 return ip_rbVwaitObjCmd(clientData, interp, objc, objv);
4941 DUMP1(
"call ip_rbVwaitCommand");
4946 Tcl_Preserve(interp);
4947 Tcl_ResetResult(interp);
4950 #ifdef Tcl_WrongNumArgs
4951 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4953 thr_crit_bup = rb_thread_critical;
4954 rb_thread_critical =
Qtrue;
4956 #if TCL_MAJOR_VERSION >= 8
4958 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4960 nameString = objv[0];
4962 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
4963 nameString,
" name\"", (
char *) NULL);
4965 rb_thread_critical = thr_crit_bup;
4968 Tcl_Release(interp);
4972 #if TCL_MAJOR_VERSION >= 8
4975 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4977 nameString = objv[1];
4979 thr_crit_bup = rb_thread_critical;
4980 rb_thread_critical =
Qtrue;
4985 Tcl_Preserve((ClientData)param);
4987 param->thread = current_thread;
4997 ret = Tcl_TraceVar(interp, nameString,
4998 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5001 rb_thread_critical = thr_crit_bup;
5003 if (ret != TCL_OK) {
5005 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5008 Tcl_Release((ClientData)param);
5011 ckfree((
char *)param);
5015 #if TCL_MAJOR_VERSION >= 8
5018 Tcl_Release(interp);
5025 while(!param->done) {
5029 if (
NIL_P(eventloop_thread)) {
5034 thr_crit_bup = rb_thread_critical;
5035 rb_thread_critical =
Qtrue;
5037 if (param->done > 0) {
5038 Tcl_UntraceVar(interp, nameString,
5039 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5044 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5047 Tcl_Release((ClientData)param);
5050 ckfree((
char *)param);
5054 rb_thread_critical = thr_crit_bup;
5056 #if TCL_MAJOR_VERSION >= 8
5059 Tcl_Release(interp);
5063 #if TCL_MAJOR_VERSION >= 8
5065 ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv)
5066 ClientData clientData;
5069 Tcl_Obj *CONST objv[];
5073 ClientData clientData;
5080 Tk_Window tkwin = (Tk_Window) clientData;
5083 static CONST
char *optionStrings[] = {
"variable",
"visibility",
"window",
5085 enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW };
5092 DUMP1(
"Ruby's 'thread_tkwait' is called");
5093 if (interp == (Tcl_Interp*)NULL) {
5100 #if TCL_MAJOR_VERSION >= 8
5101 DUMP1(
"call ip_rbTkWaitObjCmd");
5102 DUMP2(
"eventloop_thread %lx", eventloop_thread);
5103 DUMP2(
"current_thread %lx", current_thread);
5104 return ip_rbTkWaitObjCmd(clientData, interp, objc, objv);
5106 DUMP1(
"call rb_VwaitCommand");
5111 Tcl_Preserve(interp);
5112 Tcl_Preserve(tkwin);
5114 Tcl_ResetResult(interp);
5117 #ifdef Tcl_WrongNumArgs
5118 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
5120 thr_crit_bup = rb_thread_critical;
5121 rb_thread_critical =
Qtrue;
5123 #if TCL_MAJOR_VERSION >= 8
5124 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
5125 Tcl_GetStringFromObj(objv[0], &dummy),
5126 " variable|visibility|window name\"",
5129 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
5130 objv[0],
" variable|visibility|window name\"",
5134 rb_thread_critical = thr_crit_bup;
5138 Tcl_Release(interp);
5142 #if TCL_MAJOR_VERSION >= 8
5143 thr_crit_bup = rb_thread_critical;
5144 rb_thread_critical =
Qtrue;
5152 ret = Tcl_GetIndexFromObj(interp, objv[1],
5153 (
CONST84 char **)optionStrings,
5154 "option", 0, &index);
5156 rb_thread_critical = thr_crit_bup;
5158 if (ret != TCL_OK) {
5160 Tcl_Release(interp);
5166 size_t length =
strlen(objv[1]);
5168 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
5170 index = TKWAIT_VARIABLE;
5171 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
5173 index = TKWAIT_VISIBILITY;
5174 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
5175 index = TKWAIT_WINDOW;
5177 Tcl_AppendResult(interp,
"bad option \"", objv[1],
5178 "\": must be variable, visibility, or window",
5181 Tcl_Release(interp);
5187 thr_crit_bup = rb_thread_critical;
5188 rb_thread_critical =
Qtrue;
5190 #if TCL_MAJOR_VERSION >= 8
5193 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
5195 nameString = objv[2];
5201 Tcl_Preserve((ClientData)param);
5203 param->thread = current_thread;
5206 rb_thread_critical = thr_crit_bup;
5208 switch ((
enum options) index) {
5209 case TKWAIT_VARIABLE:
5210 thr_crit_bup = rb_thread_critical;
5211 rb_thread_critical =
Qtrue;
5219 ret = Tcl_TraceVar(interp, nameString,
5220 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5223 rb_thread_critical = thr_crit_bup;
5225 if (ret != TCL_OK) {
5227 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5233 ckfree((
char *)param);
5237 #if TCL_MAJOR_VERSION >= 8
5242 Tcl_Release(interp);
5249 while(!param->done) {
5253 if (
NIL_P(eventloop_thread)) {
5258 thr_crit_bup = rb_thread_critical;
5259 rb_thread_critical =
Qtrue;
5261 if (param->done > 0) {
5262 Tcl_UntraceVar(interp, nameString,
5263 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5267 #if TCL_MAJOR_VERSION >= 8
5271 rb_thread_critical = thr_crit_bup;
5275 case TKWAIT_VISIBILITY:
5276 thr_crit_bup = rb_thread_critical;
5277 rb_thread_critical =
Qtrue;
5283 window = Tk_NameToWindow(interp, nameString, tkwin);
5291 if (Tcl_GetCommandInfo(interp,
".", &info)) {
5292 window = Tk_NameToWindow(interp, nameString, tkwin);
5299 if (window == NULL) {
5300 Tcl_AppendResult(interp,
": thread_tkwait: ",
5301 "no main-window (not Tk application?)",
5304 rb_thread_critical = thr_crit_bup;
5307 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5313 ckfree((
char *)param);
5317 #if TCL_MAJOR_VERSION >= 8
5321 Tcl_Release(interp);
5324 Tcl_Preserve(window);
5326 Tk_CreateEventHandler(window,
5327 VisibilityChangeMask|StructureNotifyMask,
5330 rb_thread_critical = thr_crit_bup;
5340 if (
NIL_P(eventloop_thread)) {
5345 thr_crit_bup = rb_thread_critical;
5346 rb_thread_critical =
Qtrue;
5350 Tk_DeleteEventHandler(window,
5351 VisibilityChangeMask|StructureNotifyMask,
5353 (ClientData) param);
5356 if (param->done != 1) {
5357 Tcl_ResetResult(interp);
5358 Tcl_AppendResult(interp,
"window \"", nameString,
5359 "\" was deleted before its visibility changed",
5362 rb_thread_critical = thr_crit_bup;
5364 Tcl_Release(window);
5367 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5373 ckfree((
char *)param);
5377 #if TCL_MAJOR_VERSION >= 8
5382 Tcl_Release(interp);
5386 Tcl_Release(window);
5388 #if TCL_MAJOR_VERSION >= 8
5392 rb_thread_critical = thr_crit_bup;
5397 thr_crit_bup = rb_thread_critical;
5398 rb_thread_critical =
Qtrue;
5404 window = Tk_NameToWindow(interp, nameString, tkwin);
5412 if (Tcl_GetCommandInfo(interp,
".", &info)) {
5413 window = Tk_NameToWindow(interp, nameString, tkwin);
5420 #if TCL_MAJOR_VERSION >= 8
5424 if (window == NULL) {
5425 Tcl_AppendResult(interp,
": thread_tkwait: ",
5426 "no main-window (not Tk application?)",
5429 rb_thread_critical = thr_crit_bup;
5432 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5438 ckfree((
char *)param);
5443 Tcl_Release(interp);
5447 Tcl_Preserve(window);
5449 Tk_CreateEventHandler(window, StructureNotifyMask,
5452 rb_thread_critical = thr_crit_bup;
5461 if (
NIL_P(eventloop_thread)) {
5466 Tcl_Release(window);
5482 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5485 Tcl_Release((ClientData)param);
5488 ckfree((
char *)param);
5497 Tcl_ResetResult(interp);
5500 Tcl_Release(interp);
5536 #if TCL_MAJOR_VERSION >= 8
5543 Tcl_Obj *slave_list, *elem;
5547 DUMP1(
"delete slaves");
5548 thr_crit_bup = rb_thread_critical;
5549 rb_thread_critical =
Qtrue;
5551 if (!Tcl_InterpDeleted(ip) &&
Tcl_Eval(ip,
"interp slaves") == TCL_OK) {
5552 slave_list = Tcl_GetObjResult(ip);
5555 if (Tcl_ListObjLength((Tcl_Interp*)NULL, slave_list, &len) == TCL_OK) {
5556 for(i = 0; i <
len; i++) {
5557 Tcl_ListObjIndex((Tcl_Interp*)NULL, slave_list, i, &elem);
5559 if (elem == (Tcl_Obj*)NULL)
continue;
5565 slave_name = Tcl_GetStringFromObj(elem, (
int*)NULL);
5566 DUMP2(
"delete slave:'%s'", slave_name);
5570 slave = Tcl_GetSlave(ip, slave_name);
5571 if (slave == (Tcl_Interp*)NULL)
continue;
5573 if (!Tcl_InterpDeleted(slave)) {
5577 Tcl_DeleteInterp(slave);
5586 rb_thread_critical = thr_crit_bup;
5601 DUMP1(
"delete slaves");
5602 thr_crit_bup = rb_thread_critical;
5603 rb_thread_critical =
Qtrue;
5605 if (!Tcl_InterpDeleted(ip) &&
Tcl_Eval(ip,
"interp slaves") == TCL_OK) {
5606 slave_list = ip->result;
5607 if (Tcl_SplitList((Tcl_Interp*)NULL,
5608 slave_list, &argc, &argv) == TCL_OK) {
5609 for(i = 0; i <
argc; i++) {
5610 slave_name = argv[
i];
5612 DUMP2(
"delete slave:'%s'", slave_name);
5614 slave = Tcl_GetSlave(ip, slave_name);
5615 if (slave == (Tcl_Interp*)NULL)
continue;
5617 if (!Tcl_InterpDeleted(slave)) {
5621 Tcl_DeleteInterp(slave);
5627 rb_thread_critical = thr_crit_bup;
5634 #ifdef HAVE_PROTOTYPES
5645 #if TCL_MAJOR_VERSION >= 8
5646 #ifdef HAVE_PROTOTYPES
5647 ip_null_proc(ClientData clientData, Tcl_Interp *interp,
5648 int argc, Tcl_Obj *CONST argv[])
5651 ClientData clientData;
5654 Tcl_Obj *CONST argv[];
5657 #ifdef HAVE_PROTOTYPES
5658 ip_null_proc(ClientData clientData, Tcl_Interp *interp,
int argc,
char *argv[])
5661 ClientData clientData;
5668 Tcl_ResetResult(interp);
5679 VALUE rb_debug_bup, rb_verbose_bup;
5687 DUMP1(
"start ip_finalize");
5689 if (ip == (Tcl_Interp*)NULL) {
5690 DUMP1(
"ip is NULL");
5694 if (Tcl_InterpDeleted(ip)) {
5695 DUMP2(
"ip(%p) is already deleted", ip);
5699 #if TCL_NAMESPACE_DEBUG
5700 if (ip_null_namespace(ip)) {
5701 DUMP2(
"ip(%p) has null namespace", ip);
5706 thr_crit_bup = rb_thread_critical;
5707 rb_thread_critical =
Qtrue;
5723 #if TCL_MAJOR_VERSION >= 8
5725 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5727 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5729 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5732 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5734 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5736 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5748 DUMP1(
"check `destroy'");
5749 if (Tcl_GetCommandInfo(ip,
"destroy", &info)) {
5750 DUMP1(
"call `destroy .'");
5755 DUMP1(
"destroy root widget");
5769 Tk_Window win = Tk_MainWindow(ip);
5771 DUMP1(
"call Tk_DestroyWindow");
5774 if (! (((Tk_FakeWin*)win)->flags & TK_ALREADY_DEAD)) {
5775 Tk_DestroyWindow(win);
5783 DUMP1(
"check `finalize-hook-proc'");
5784 if ( Tcl_GetCommandInfo(ip, finalize_hook_name, &info)) {
5785 DUMP2(
"call finalize hook proc '%s'", finalize_hook_name);
5793 DUMP1(
"check `foreach' & `after'");
5794 if ( Tcl_GetCommandInfo(ip,
"foreach", &info)
5795 && Tcl_GetCommandInfo(ip,
"after", &info) ) {
5796 DUMP1(
"cancel after callbacks");
5799 Tcl_GlobalEval(ip,
"catch {foreach id [after info] {after cancel $id}}");
5806 DUMP1(
"finish ip_finalize");
5809 rb_thread_critical = thr_crit_bup;
5820 DUMP2(
"free Tcl Interp %lx", (
unsigned long)ptr->ip);
5822 thr_crit_bup = rb_thread_critical;
5823 rb_thread_critical =
Qtrue;
5825 if ( ptr->ip != (Tcl_Interp*)NULL
5826 && !Tcl_InterpDeleted(ptr->ip)
5827 && Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL
5828 && !Tcl_InterpDeleted(Tcl_GetMaster(ptr->ip)) ) {
5829 DUMP2(
"parent IP(%lx) is not deleted",
5830 (
unsigned long)Tcl_GetMaster(ptr->ip));
5831 DUMP2(
"slave IP(%lx) should not be deleted",
5832 (
unsigned long)ptr->ip);
5835 rb_thread_critical = thr_crit_bup;
5839 if (ptr->ip == (Tcl_Interp*)NULL) {
5840 DUMP1(
"ip_free is called for deleted IP");
5843 rb_thread_critical = thr_crit_bup;
5847 if (!Tcl_InterpDeleted(ptr->ip)) {
5850 Tcl_DeleteInterp(ptr->ip);
5851 Tcl_Release(ptr->ip);
5854 ptr->ip = (Tcl_Interp*)NULL;
5858 rb_thread_critical = thr_crit_bup;
5861 DUMP1(
"complete freeing Tcl Interp");
5880 #if TCL_MAJOR_VERSION >= 8
5881 DUMP1(
"Tcl_CreateObjCommand(\"vwait\")");
5882 Tcl_CreateObjCommand(interp,
"vwait", ip_rbVwaitObjCmd,
5883 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5885 DUMP1(
"Tcl_CreateCommand(\"vwait\")");
5887 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5891 #if TCL_MAJOR_VERSION >= 8
5892 DUMP1(
"Tcl_CreateObjCommand(\"tkwait\")");
5893 Tcl_CreateObjCommand(interp,
"tkwait", ip_rbTkWaitObjCmd,
5894 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5896 DUMP1(
"Tcl_CreateCommand(\"tkwait\")");
5898 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5902 #if TCL_MAJOR_VERSION >= 8
5903 DUMP1(
"Tcl_CreateObjCommand(\"thread_vwait\")");
5904 Tcl_CreateObjCommand(interp,
"thread_vwait", ip_rb_threadVwaitObjCmd,
5905 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5907 DUMP1(
"Tcl_CreateCommand(\"thread_vwait\")");
5909 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5913 #if TCL_MAJOR_VERSION >= 8
5914 DUMP1(
"Tcl_CreateObjCommand(\"thread_tkwait\")");
5915 Tcl_CreateObjCommand(interp,
"thread_tkwait", ip_rb_threadTkWaitObjCmd,
5916 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5918 DUMP1(
"Tcl_CreateCommand(\"thread_tkwait\")");
5920 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5924 #if TCL_MAJOR_VERSION >= 8
5925 DUMP1(
"Tcl_CreateObjCommand(\"update\")");
5926 Tcl_CreateObjCommand(interp,
"update", ip_rbUpdateObjCmd,
5927 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5929 DUMP1(
"Tcl_CreateCommand(\"update\")");
5931 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5935 #if TCL_MAJOR_VERSION >= 8
5936 DUMP1(
"Tcl_CreateObjCommand(\"thread_update\")");
5937 Tcl_CreateObjCommand(interp,
"thread_update", ip_rb_threadUpdateObjCmd,
5938 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5940 DUMP1(
"Tcl_CreateCommand(\"thread_update\")");
5942 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5947 #if TCL_MAJOR_VERSION >= 8
5949 ip_rb_replaceSlaveTkCmdsObjCmd(clientData, interp, objc, objv)
5950 ClientData clientData;
5953 Tcl_Obj *CONST objv[];
5957 ClientData clientData;
5968 #ifdef Tcl_WrongNumArgs
5969 Tcl_WrongNumArgs(interp, 1, objv,
"slave_name");
5972 #if TCL_MAJOR_VERSION >= 8
5973 nameString = Tcl_GetStringFromObj(objv[0], (
int*)NULL);
5975 nameString = objv[0];
5977 Tcl_AppendResult(interp,
"wrong number of arguments: should be \"",
5978 nameString,
" slave_name\"", (
char *) NULL);
5982 #if TCL_MAJOR_VERSION >= 8
5983 slave_name = Tcl_GetStringFromObj(objv[1], (
int*)NULL);
5985 slave_name = objv[1];
5988 slave = Tcl_GetSlave(interp, slave_name);
5989 if (slave == NULL) {
5990 Tcl_AppendResult(interp,
"cannot find slave \"",
5991 slave_name,
"\"", (
char *)NULL);
5994 mainWin = Tk_MainWindow(slave);
5997 #if TCL_MAJOR_VERSION >= 8
5998 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
5999 Tcl_CreateObjCommand(slave,
"exit", ip_InterpExitObjCmd,
6000 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6002 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6004 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6014 #if TCL_MAJOR_VERSION >= 8
6015 static int ip_rbNamespaceObjCmd
_((ClientData, Tcl_Interp *,
int,
6016 Tcl_Obj *CONST []));
6018 ip_rbNamespaceObjCmd(clientData, interp, objc, objv)
6019 ClientData clientData;
6022 Tcl_Obj *CONST objv[];
6027 if (!Tcl_GetCommandInfo(interp,
"__orig_namespace_command__", &(info))) {
6028 Tcl_ResetResult(interp);
6029 Tcl_AppendResult(interp,
6030 "invalid command name \"namespace\"", (
char*)NULL);
6037 if (info.isNativeObjectProc) {
6038 ret = (*(info.objProc))(info.objClientData, interp, objc, objv);
6045 argv = (
char **)ckalloc(
sizeof(
char *) * (objc + 1));
6047 Tcl_Preserve((ClientData)argv);
6050 for(i = 0; i < objc; i++) {
6052 argv[
i] = Tcl_GetStringFromObj(objv[i], (
int*)NULL);
6054 argv[objc] = (
char *)NULL;
6056 ret = (*(info.proc))(info.clientData, interp,
6060 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
6063 Tcl_Release((ClientData)argv);
6066 ckfree((
char*)argv);
6082 #if TCL_MAJOR_VERSION >= 8
6083 Tcl_CmdInfo orig_info;
6085 if (!Tcl_GetCommandInfo(interp,
"namespace", &(orig_info))) {
6089 if (orig_info.isNativeObjectProc) {
6090 Tcl_CreateObjCommand(interp,
"__orig_namespace_command__",
6091 orig_info.objProc, orig_info.objClientData,
6092 orig_info.deleteProc);
6094 Tcl_CreateCommand(interp,
"__orig_namespace_command__",
6095 orig_info.proc, orig_info.clientData,
6096 orig_info.deleteProc);
6099 Tcl_CreateObjCommand(interp,
"namespace", ip_rbNamespaceObjCmd,
6100 (ClientData) 0, (Tcl_CmdDeleteProc *)NULL);
6107 #ifdef HAVE_PROTOTYPES
6111 ClientData clientData;
6118 DUMP1(
"start ip_CallWhenDeleted");
6119 thr_crit_bup = rb_thread_critical;
6120 rb_thread_critical =
Qtrue;
6124 DUMP1(
"finish ip_CallWhenDeleted");
6125 rb_thread_critical = thr_crit_bup;
6142 Tk_Window mainWin = (Tk_Window)NULL;
6147 "Cannot create a TclTkIp object at level %d",
6156 #ifdef RUBY_USE_NATIVE_THREAD
6157 ptr->tk_thread_id = 0;
6164 DUMP1(
"Tcl_CreateInterp");
6166 if (ptr->
ip == NULL) {
6187 #if TCL_MAJOR_VERSION >= 8
6188 #if TCL_NAMESPACE_DEBUG
6189 DUMP1(
"get current namespace");
6190 if ((ptr->default_ns = Tcl_GetCurrentNamespace(ptr->
ip))
6191 == (Tcl_Namespace*)NULL) {
6199 current_interp = ptr->
ip;
6204 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
6205 call_tclkit_init_script(current_interp);
6207 # if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
6209 Tcl_DString encodingName;
6210 Tcl_GetEncodingNameFromEnvironment(&encodingName);
6211 if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(NULL))) {
6213 Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName));
6215 Tcl_SetVar(current_interp,
"tclkit_system_encoding", Tcl_DStringValue(&encodingName), 0);
6216 Tcl_DStringFree(&encodingName);
6222 Tcl_Eval(ptr->
ip,
"set argc 0; set argv {}; set argv0 tcltklib.so");
6234 Tcl_Eval(ptr->
ip,
"set argc [llength $argv]");
6238 if (!
NIL_P(argv0)) {
6241 Tcl_SetVar(ptr->
ip,
"argv0",
"ruby", TCL_GLOBAL_ONLY);
6255 #if (defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT) && (!defined KIT_LITE) && (10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION == 85)
6262 Tcl_Eval(ptr->
ip,
"catch {rename ::chan ::_tmp_chan}");
6263 if (Tcl_Init(ptr->
ip) == TCL_ERROR) {
6266 Tcl_Eval(ptr->
ip,
"catch {rename ::_tmp_chan ::chan}");
6268 if (Tcl_Init(ptr->
ip) == TCL_ERROR) {
6293 DUMP1(
"Tcl_StaticPackage(\"Tk\")");
6294 #if TCL_MAJOR_VERSION >= 8
6295 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init, Tk_SafeInit);
6297 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init,
6298 (Tcl_PackageInitProc *) NULL);
6301 #ifdef RUBY_USE_NATIVE_THREAD
6303 ptr->tk_thread_id = Tcl_GetCurrentThread();
6306 mainWin = Tk_MainWindow(ptr->
ip);
6307 Tk_Preserve((ClientData)mainWin);
6311 #if TCL_MAJOR_VERSION >= 8
6312 DUMP1(
"Tcl_CreateObjCommand(\"ruby\")");
6313 Tcl_CreateObjCommand(ptr->
ip,
"ruby",
ip_ruby_eval, (ClientData)NULL,
6314 (Tcl_CmdDeleteProc *)NULL);
6315 DUMP1(
"Tcl_CreateObjCommand(\"ruby_eval\")");
6316 Tcl_CreateObjCommand(ptr->
ip,
"ruby_eval",
ip_ruby_eval, (ClientData)NULL,
6317 (Tcl_CmdDeleteProc *)NULL);
6318 DUMP1(
"Tcl_CreateObjCommand(\"ruby_cmd\")");
6319 Tcl_CreateObjCommand(ptr->
ip,
"ruby_cmd",
ip_ruby_cmd, (ClientData)NULL,
6320 (Tcl_CmdDeleteProc *)NULL);
6322 DUMP1(
"Tcl_CreateCommand(\"ruby\")");
6323 Tcl_CreateCommand(ptr->
ip,
"ruby",
ip_ruby_eval, (ClientData)NULL,
6324 (Tcl_CmdDeleteProc *)NULL);
6325 DUMP1(
"Tcl_CreateCommand(\"ruby_eval\")");
6326 Tcl_CreateCommand(ptr->
ip,
"ruby_eval",
ip_ruby_eval, (ClientData)NULL,
6327 (Tcl_CmdDeleteProc *)NULL);
6328 DUMP1(
"Tcl_CreateCommand(\"ruby_cmd\")");
6329 Tcl_CreateCommand(ptr->
ip,
"ruby_cmd",
ip_ruby_cmd, (ClientData)NULL,
6330 (Tcl_CmdDeleteProc *)NULL);
6334 #if TCL_MAJOR_VERSION >= 8
6335 DUMP1(
"Tcl_CreateObjCommand(\"interp_exit\")");
6336 Tcl_CreateObjCommand(ptr->
ip,
"interp_exit", ip_InterpExitObjCmd,
6337 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6338 DUMP1(
"Tcl_CreateObjCommand(\"ruby_exit\")");
6339 Tcl_CreateObjCommand(ptr->
ip,
"ruby_exit", ip_RubyExitObjCmd,
6340 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6341 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6342 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6343 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6345 DUMP1(
"Tcl_CreateCommand(\"interp_exit\")");
6347 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6348 DUMP1(
"Tcl_CreateCommand(\"ruby_exit\")");
6350 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6351 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6353 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6363 #if TCL_MAJOR_VERSION >= 8
6364 Tcl_CreateObjCommand(ptr->
ip,
"__replace_slave_tk_commands__",
6365 ip_rb_replaceSlaveTkCmdsObjCmd,
6366 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6368 Tcl_CreateCommand(ptr->
ip,
"__replace_slave_tk_commands__",
6370 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6376 if (mainWin != (Tk_Window)NULL) {
6377 Tk_Release((ClientData)mainWin);
6401 "deleted master cannot create a new slave");
6407 if (Tcl_IsSafe(master->
ip) == 1) {
6409 }
else if (safemode ==
Qfalse ||
NIL_P(safemode)) {
6416 thr_crit_bup = rb_thread_critical;
6417 rb_thread_critical =
Qtrue;
6421 if (
RTEST(with_tk)) {
6426 rb_thread_critical = thr_crit_bup;
6434 #ifdef RUBY_USE_NATIVE_THREAD
6436 slave->tk_thread_id = master->tk_thread_id;
6443 if (slave->
ip == NULL) {
6444 rb_thread_critical = thr_crit_bup;
6446 "fail to create the new slave interpreter");
6448 #if TCL_MAJOR_VERSION >= 8
6449 #if TCL_NAMESPACE_DEBUG
6450 slave->default_ns = Tcl_GetCurrentNamespace(slave->
ip);
6460 #if TCL_MAJOR_VERSION >= 8
6461 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6462 Tcl_CreateObjCommand(slave->
ip,
"exit", ip_InterpExitObjCmd,
6463 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6465 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6467 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6477 #if TCL_MAJOR_VERSION >= 8
6478 Tcl_CreateObjCommand(slave->
ip,
"__replace_slave_tk_commands__",
6479 ip_rb_replaceSlaveTkCmdsObjCmd,
6480 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6482 Tcl_CreateCommand(slave->
ip,
"__replace_slave_tk_commands__",
6484 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6490 rb_thread_critical = thr_crit_bup;
6509 "deleted master cannot create a new slave interpreter");
6513 if (
rb_scan_args(argc, argv,
"11", &name, &safemode) == 1) {
6516 if (Tcl_IsSafe(master->
ip) != 1
6523 callargv[1] = safemode;
6538 if (Tcl_GetMaster(
get_ip(
self)->ip) ==
get_ip(master)->ip) {
6547 #if defined(MAC_TCL) || defined(__WIN32__)
6548 #if TCL_MAJOR_VERSION < 8 \
6549 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) \
6550 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6551 && (TCL_RELEASE_LEVEL == TCL_ALPHA_RELEASE \
6552 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \
6553 && TCL_RELEASE_SERIAL < 2) ) )
6554 EXTERN void TkConsoleCreate
_((
void));
6556 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6557 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \
6558 && TCL_RELEASE_SERIAL == 0) \
6559 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \
6560 && TCL_RELEASE_SERIAL >= 2) )
6561 EXTERN void TkConsoleCreate_
_((
void));
6576 if (Tcl_GetVar(ptr->
ip,
"tcl_interactive",TCL_GLOBAL_ONLY) == (
char*)NULL) {
6577 Tcl_SetVar(ptr->
ip,
"tcl_interactive",
"0", TCL_GLOBAL_ONLY);
6580 #if TCL_MAJOR_VERSION > 8 \
6581 || (TCL_MAJOR_VERSION == 8 \
6582 && (TCL_MINOR_VERSION > 1 \
6583 || (TCL_MINOR_VERSION == 1 \
6584 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \
6585 && TCL_RELEASE_SERIAL >= 1) ) )
6586 Tk_InitConsoleChannels(ptr->
ip);
6588 if (Tk_CreateConsoleWindow(ptr->
ip) != TCL_OK) {
6592 #if defined(MAC_TCL) || defined(__WIN32__)
6593 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6594 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE && TCL_RELEASE_SERIAL == 0) \
6595 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE && TCL_RELEASE_SERIAL >= 2) )
6601 if (TkConsoleInit(ptr->
ip) != TCL_OK) {
6641 if (Tcl_MakeSafe(ptr->
ip) == TCL_ERROR) {
6652 #if TCL_MAJOR_VERSION >= 8
6653 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6654 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6655 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6657 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6659 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6691 if (Tcl_IsSafe(ptr->
ip)) {
6732 if (Tcl_IsSafe(ptr->
ip)) {
6734 "insecure operation on a safe interpreter");
6747 #if TCL_MAJOR_VERSION >= 8
6748 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6749 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6750 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6752 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6754 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6760 #if TCL_MAJOR_VERSION >= 8
6761 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6762 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6763 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6765 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6767 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6783 DUMP1(
"delete deleted IP");
6787 thr_crit_bup = rb_thread_critical;
6788 rb_thread_critical =
Qtrue;
6790 DUMP1(
"delete interp");
6791 if (!Tcl_InterpDeleted(ptr->
ip)) {
6792 DUMP1(
"call ip_finalize");
6795 Tcl_DeleteInterp(ptr->
ip);
6796 Tcl_Release(ptr->
ip);
6799 rb_thread_critical = thr_crit_bup;
6812 if (ptr == (
struct tcltkip *)NULL || ptr->
ip == (Tcl_Interp *)NULL) {
6817 #if TCL_NAMESPACE_DEBUG
6818 if (rbtk_invalid_namespace(ptr)) {
6851 }
else if (Tk_MainWindow(ptr->
ip) == (Tk_Window)NULL) {
6867 #if TCL_MAJOR_VERSION >= 8
6869 get_str_from_obj(obj)
6872 int len, binary = 0;
6876 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
6877 s = Tcl_GetStringFromObj(obj, &len);
6879 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 3
6881 if (Tcl_GetCharLength(obj) != Tcl_UniCharLen(Tcl_GetUnicode(obj))) {
6883 s = (
char *)Tcl_GetByteArrayFromObj(obj, &len);
6887 s = Tcl_GetStringFromObj(obj, &len);
6890 if (IS_TCL_BYTEARRAY(obj)) {
6891 s = (
char *)Tcl_GetByteArrayFromObj(obj, &len);
6894 s = Tcl_GetStringFromObj(obj, &len);
6901 #ifdef HAVE_RUBY_ENCODING_H
6904 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
6905 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
6907 #ifdef HAVE_RUBY_ENCODING_H
6917 get_obj_from_str(str)
6922 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
6923 return Tcl_NewStringObj((
char*)s,
RSTRING_LEN(str));
6931 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LEN(str));
6936 #ifdef HAVE_RUBY_ENCODING_H
6939 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LEN(str));
6943 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LEN(str));
6956 #if TCL_MAJOR_VERSION >= 8
6958 volatile VALUE strval;
6960 retObj = Tcl_GetObjResult(interp);
6962 strval = get_str_from_obj(retObj);
6964 Tcl_ResetResult(interp);
6994 volatile VALUE q_dat;
6998 DUMP2(
"do_call_queue_handler : evPtr = %p", evPtr);
7000 DUMP2(
"added by thread : %lx", thread);
7003 DUMP1(
"processed by another event-loop");
7006 DUMP1(
"process it on current event-loop");
7016 DUMP1(
"caller is not yet ready to receive the result -> pending");
7040 q_dat = (
VALUE)NULL;
7042 DUMP2(
"call function (for caller thread:%lx)", thread);
7069 DUMP2(
"back to caller (caller thread:%lx)", thread);
7071 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
7072 have_rb_thread_waiting_for_value = 1;
7077 DUMP1(
"finish back to caller");
7078 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
7082 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7101 int is_tk_evloop_thread;
7103 volatile VALUE ip_obj = obj;
7115 #ifdef RUBY_USE_NATIVE_THREAD
7118 is_tk_evloop_thread = (ptr->tk_thread_id == (Tcl_ThreadId) 0
7119 || ptr->tk_thread_id == Tcl_GetCurrentThread());
7122 is_tk_evloop_thread = (tk_eventloop_thread_id == (Tcl_ThreadId) 0
7123 || tk_eventloop_thread_id == Tcl_GetCurrentThread());
7126 is_tk_evloop_thread = 1;
7129 if (is_tk_evloop_thread
7132 if (
NIL_P(eventloop_thread)) {
7133 DUMP2(
"tk_funcall from thread:%lx but no eventloop", current);
7135 DUMP2(
"tk_funcall from current eventloop %lx", current);
7137 result = (
func)(ip_obj, argc, argv);
7144 DUMP2(
"tk_funcall from thread %lx (NOT current eventloop)", current);
7146 thr_crit_bup = rb_thread_critical;
7147 rb_thread_critical =
Qtrue;
7154 Tcl_Preserve((ClientData)temp);
7162 alloc_done = (
int*)ckalloc(
sizeof(
int));
7164 Tcl_Preserve((ClientData)alloc_done);
7172 Tcl_Preserve(callq);
7179 callq->
done = alloc_done;
7190 DUMP1(
"add handler");
7191 #ifdef RUBY_USE_NATIVE_THREAD
7192 if (ptr && ptr->tk_thread_id) {
7195 Tcl_ThreadQueueEvent(ptr->tk_thread_id,
7196 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7197 Tcl_ThreadAlert(ptr->tk_thread_id);
7198 }
else if (tk_eventloop_thread_id) {
7201 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
7202 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7203 Tcl_ThreadAlert(tk_eventloop_thread_id);
7206 Tcl_QueueEvent((Tcl_Event*)callq, TCL_QUEUE_HEAD);
7210 Tcl_QueueEvent((Tcl_Event*)callq, TCL_QUEUE_HEAD);
7213 rb_thread_critical = thr_crit_bup;
7219 DUMP2(
"callq wait for handler (current thread:%lx)", current);
7220 while(*alloc_done >= 0) {
7221 DUMP2(
"*** callq wait for handler (current thread:%lx)", current);
7225 DUMP2(
"*** callq wakeup (current thread:%lx)", current);
7226 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
7227 if (
NIL_P(eventloop_thread)) {
7228 DUMP1(
"*** callq lost eventloop thread");
7232 DUMP2(
"back from handler (current thread:%lx)", current);
7237 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7240 Tcl_Release((ClientData)alloc_done);
7243 ckfree((
char*)alloc_done);
7250 for(i = 0; i <
argc; i++) { argv[
i] = (
VALUE)NULL; }
7253 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
7256 Tcl_Release((ClientData)argv);
7258 ckfree((
char*)argv);
7267 ckfree((
char*)callq);
7273 DUMP1(
"raise exception");
7279 DUMP1(
"exit tk_funcall");
7285 #if TCL_MAJOR_VERSION >= 8
7286 struct call_eval_info {
7292 #ifdef HAVE_PROTOTYPES
7299 struct call_eval_info *
inf = (
struct call_eval_info *)arg;
7301 Tcl_AllowExceptions(inf->ptr->ip);
7302 inf->ptr->return_value = Tcl_EvalObj(inf->ptr->ip, inf->cmd);
7318 #if TCL_MAJOR_VERSION >= 8
7323 thr_crit_bup = rb_thread_critical;
7324 rb_thread_critical =
Qtrue;
7326 cmd = Tcl_NewStringObj(cmd_str, cmd_len);
7332 rb_thread_critical = thr_crit_bup;
7337 struct call_eval_info inf;
7353 "unknown exception");
7380 if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->
ip)) {
7386 "ip_eval_real receives TCL_RETURN");
7389 "ip_eval_real receives TCL_BREAK");
7392 "ip_eval_real receives TCL_CONTINUE");
7399 rb_thread_critical = thr_crit_bup;
7402 if (event_loop_abort_on_exc < 0) {
7407 Tcl_ResetResult(ptr->
ip);
7409 rb_thread_critical = thr_crit_bup;
7417 rb_thread_critical = thr_crit_bup;
7421 DUMP2(
"Tcl_Eval(%s)", cmd_str);
7446 "ip_eval_real receives TCL_RETURN");
7449 "ip_eval_real receives TCL_BREAK");
7452 "ip_eval_real receives TCL_CONTINUE");
7490 volatile VALUE q_dat;
7494 DUMP2(
"do_eval_queue_handler : evPtr = %p", evPtr);
7496 DUMP2(
"added by thread : %lx", thread);
7499 DUMP1(
"processed by another event-loop");
7502 DUMP1(
"process it on current event-loop");
7512 DUMP1(
"caller is not yet ready to receive the result -> pending");
7531 #ifdef HAVE_NATIVETHREAD
7532 #ifndef RUBY_USE_NATIVE_THREAD
7534 rb_bug(
"cross-thread violation on eval_queue_handler()");
7543 q_dat = (
VALUE)NULL;
7569 DUMP2(
"back to caller (caller thread:%lx)", thread);
7571 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
7572 have_rb_thread_waiting_for_value = 1;
7577 DUMP1(
"finish back to caller");
7578 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
7582 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7596 #ifdef RUBY_USE_NATIVE_THREAD
7603 volatile VALUE ip_obj =
self;
7606 Tcl_QueuePosition position;
7609 thr_crit_bup = rb_thread_critical;
7610 rb_thread_critical =
Qtrue;
7612 rb_thread_critical = thr_crit_bup;
7614 #ifdef RUBY_USE_NATIVE_THREAD
7616 DUMP2(
"eval status: ptr->tk_thread_id %p", ptr->tk_thread_id);
7617 DUMP2(
"eval status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7619 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7621 DUMP2(
"status: eventloopt_thread %lx", eventloop_thread);
7624 #ifdef RUBY_USE_NATIVE_THREAD
7625 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
7628 (
NIL_P(eventloop_thread) || current == eventloop_thread)
7630 if (
NIL_P(eventloop_thread)) {
7631 DUMP2(
"eval from thread:%lx but no eventloop", current);
7633 DUMP2(
"eval from current eventloop %lx", current);
7642 DUMP2(
"eval from thread %lx (NOT current eventloop)", current);
7644 thr_crit_bup = rb_thread_critical;
7645 rb_thread_critical =
Qtrue;
7649 alloc_done = (
int*)ckalloc(
sizeof(
int));
7651 Tcl_Preserve((ClientData)alloc_done);
7656 eval_str = ckalloc(
sizeof(
char) * (
RSTRING_LEN(str) + 1));
7658 Tcl_Preserve((ClientData)eval_str);
7674 evq->
done = alloc_done;
7675 evq->
str = eval_str;
7683 position = TCL_QUEUE_TAIL;
7686 DUMP1(
"add handler");
7687 #ifdef RUBY_USE_NATIVE_THREAD
7688 if (ptr->tk_thread_id) {
7690 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)evq, position);
7691 Tcl_ThreadAlert(ptr->tk_thread_id);
7692 }
else if (tk_eventloop_thread_id) {
7693 Tcl_ThreadQueueEvent(tk_eventloop_thread_id, (Tcl_Event*)evq, position);
7696 Tcl_ThreadAlert(tk_eventloop_thread_id);
7699 Tcl_QueueEvent((Tcl_Event*)evq, position);
7703 Tcl_QueueEvent((Tcl_Event*)evq, position);
7706 rb_thread_critical = thr_crit_bup;
7712 DUMP2(
"evq wait for handler (current thread:%lx)", current);
7713 while(*alloc_done >= 0) {
7714 DUMP2(
"*** evq wait for handler (current thread:%lx)", current);
7718 DUMP2(
"*** evq wakeup (current thread:%lx)", current);
7719 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
7720 if (
NIL_P(eventloop_thread)) {
7721 DUMP1(
"*** evq lost eventloop thread");
7725 DUMP2(
"back from handler (current thread:%lx)", current);
7731 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7734 Tcl_Release((ClientData)alloc_done);
7737 ckfree((
char*)alloc_done);
7741 Tcl_EventuallyFree((ClientData)eval_str, TCL_DYNAMIC);
7744 Tcl_Release((ClientData)eval_str);
7759 DUMP1(
"raise exception");
7775 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6)
7777 "cancel_eval is supported Tcl/Tk8.6 or later.");
7788 return Tcl_CancelEval(interp, msg_obj, 0, flag);
7810 #ifndef TCL_CANCEL_UNWIND
7811 #define TCL_CANCEL_UNWIND 0x100000
7854 thr_crit_bup = rb_thread_critical;
7855 rb_thread_critical =
Qtrue;
7864 Tcl_ResetResult(ptr->
ip);
7866 #if TCL_MAJOR_VERSION >= 8
7871 Tcl_ResetResult(ptr->
ip);
7878 Tcl_ResetResult(ptr->
ip);
7883 rb_thread_critical = thr_crit_bup;
7891 rb_thread_critical = thr_crit_bup;
7931 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)NULL) {
7944 volatile VALUE str = src;
7948 Tcl_Encoding encoding;
7963 if (
NIL_P(ip_obj)) {
7964 interp = (Tcl_Interp *)NULL;
7970 interp = (Tcl_Interp *)NULL;
7976 thr_crit_bup = rb_thread_critical;
7977 rb_thread_critical =
Qtrue;
7979 if (
NIL_P(encodename)) {
7983 #ifdef HAVE_RUBY_ENCODING_H
7989 if (
NIL_P(ip_obj)) {
7990 encoding = (Tcl_Encoding)NULL;
7994 encoding = (Tcl_Encoding)NULL;
8000 encoding = (Tcl_Encoding)NULL;
8002 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8004 if (encoding == (Tcl_Encoding)NULL) {
8013 #ifdef HAVE_RUBY_ENCODING_H
8016 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8017 rb_thread_critical = thr_crit_bup;
8021 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8023 if (encoding == (Tcl_Encoding)NULL) {
8028 encoding = (Tcl_Encoding)NULL;
8032 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8033 #ifdef HAVE_RUBY_ENCODING_H
8036 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8037 rb_thread_critical = thr_crit_bup;
8041 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(encodename));
8042 if (encoding == (Tcl_Encoding)NULL) {
8054 rb_thread_critical = thr_crit_bup;
8062 Tcl_DStringInit(&dstr);
8063 Tcl_DStringFree(&dstr);
8065 Tcl_ExternalToUtfDString(encoding, buf,
RSTRING_LEN(str), &dstr);
8069 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8070 #ifdef HAVE_RUBY_ENCODING_H
8081 Tcl_DStringFree(&dstr);
8086 rb_thread_critical = thr_crit_bup;
8098 VALUE str, encodename;
8100 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8112 VALUE str, encodename;
8114 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8126 volatile VALUE str = src;
8130 Tcl_Encoding encoding;
8144 if (
NIL_P(ip_obj)) {
8145 interp = (Tcl_Interp *)NULL;
8147 interp = (Tcl_Interp *)NULL;
8152 thr_crit_bup = rb_thread_critical;
8153 rb_thread_critical =
Qtrue;
8155 if (
NIL_P(encodename)) {
8163 #ifdef HAVE_RUBY_ENCODING_H
8166 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8167 rb_thread_critical = thr_crit_bup;
8170 #ifdef HAVE_RUBY_ENCODING_H
8173 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8174 rb_thread_critical = thr_crit_bup;
8180 if (
NIL_P(ip_obj)) {
8181 encoding = (Tcl_Encoding)NULL;
8185 encoding = (Tcl_Encoding)NULL;
8191 encoding = (Tcl_Encoding)NULL;
8193 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8195 if (encoding == (Tcl_Encoding)NULL) {
8207 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8215 s = (
char*)Tcl_GetByteArrayFromObj(tclstr, &len);
8219 #ifdef HAVE_RUBY_ENCODING_H
8222 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8224 rb_thread_critical = thr_crit_bup;
8229 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(encodename));
8230 if (encoding == (Tcl_Encoding)NULL) {
8244 rb_thread_critical = thr_crit_bup;
8253 Tcl_DStringInit(&dstr);
8254 Tcl_DStringFree(&dstr);
8256 Tcl_UtfToExternalDString(encoding,buf,
RSTRING_LEN(str),&dstr);
8260 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8261 #ifdef HAVE_RUBY_ENCODING_H
8283 Tcl_DStringFree(&dstr);
8288 rb_thread_critical = thr_crit_bup;
8300 VALUE str, encodename;
8302 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8314 VALUE str, encodename;
8316 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8329 char *src_buf, *dst_buf, *ptr;
8330 int read_len = 0, dst_len = 0;
8341 thr_crit_bup = rb_thread_critical;
8342 rb_thread_critical =
Qtrue;
8345 src_buf = ckalloc(
sizeof(
char) * (
RSTRING_LEN(str)+1));
8347 Tcl_Preserve((ClientData)src_buf);
8353 dst_buf = ckalloc(
sizeof(
char) * (
RSTRING_LEN(str)+1));
8355 Tcl_Preserve((ClientData)dst_buf);
8360 if (*ptr ==
'\\' && (all_bs || *(ptr + 1) ==
'u')) {
8361 dst_len += Tcl_UtfBackslash(ptr, &read_len, (dst_buf + dst_len));
8364 *(dst_buf + (dst_len++)) = *(ptr++);
8370 #ifdef HAVE_RUBY_ENCODING_H
8376 Tcl_EventuallyFree((ClientData)src_buf, TCL_DYNAMIC);
8379 Tcl_Release((ClientData)src_buf);
8386 Tcl_EventuallyFree((ClientData)dst_buf, TCL_DYNAMIC);
8389 Tcl_Release((ClientData)dst_buf);
8396 rb_thread_critical = thr_crit_bup;
8422 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
8424 return rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL));
8435 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
8438 if (
NIL_P(enc_name)) {
8439 Tcl_SetSystemEncoding((Tcl_Interp *)NULL, (CONST
char *)NULL);
8443 enc_name =
rb_funcall(enc_name, ID_to_s, 0, 0);
8444 if (Tcl_SetSystemEncoding((Tcl_Interp *)NULL,
8461 #if TCL_MAJOR_VERSION >= 8
8471 #ifdef HAVE_PROTOTYPES
8480 #if TCL_MAJOR_VERSION >= 8
8481 int argc = inf->objc;
8482 char **argv = (
char **)NULL;
8486 #if TCL_MAJOR_VERSION >= 8
8487 if (!inf->
cmdinfo.isNativeObjectProc) {
8490 argv = (
char **)ckalloc(
sizeof(
char *)*(argc+1));
8492 Tcl_Preserve((ClientData)argv);
8494 for (i = 0; i <
argc; ++
i) {
8495 argv[
i] = Tcl_GetStringFromObj(inf->objv[i], &len);
8497 argv[
argc] = (
char *)NULL;
8501 Tcl_ResetResult(inf->
ptr->
ip);
8504 #if TCL_MAJOR_VERSION >= 8
8505 if (inf->
cmdinfo.isNativeObjectProc) {
8508 inf->
ptr->
ip, inf->objc, inf->objv);
8513 #if TCL_MAJOR_VERSION >= 8
8519 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8522 Tcl_Release((ClientData)argv);
8525 ckfree((
char*)argv);
8540 #if TCL_MAJOR_VERSION >= 8
8559 int unknown_flag = 0;
8566 #if TCL_MAJOR_VERSION >= 8
8568 char **argv = (
char **)NULL;
8577 #if TCL_MAJOR_VERSION >= 8
8578 cmd = Tcl_GetStringFromObj(objv[0], &len);
8595 DUMP2(
"call Tcl_GetCommandInfo, %s", cmd);
8596 if (!Tcl_GetCommandInfo(ptr->
ip, cmd, &info)) {
8597 DUMP1(
"error Tcl_GetCommandInfo");
8598 DUMP1(
"try auto_load (call 'unknown' command)");
8599 if (!Tcl_GetCommandInfo(ptr->
ip,
8600 #
if TCL_MAJOR_VERSION >= 8
8606 DUMP1(
"fail to get 'unknown' command");
8608 if (event_loop_abort_on_exc > 0) {
8613 "invalid command name `%s'", cmd);
8615 if (event_loop_abort_on_exc < 0) {
8616 rb_warning(
"invalid command name `%s' (ignore)", cmd);
8618 rb_warn(
"invalid command name `%s' (ignore)", cmd);
8620 Tcl_ResetResult(ptr->
ip);
8626 #if TCL_MAJOR_VERSION >= 8
8627 Tcl_Obj **unknown_objv;
8629 char **unknown_argv;
8631 DUMP1(
"find 'unknown' command -> set arguemnts");
8634 #if TCL_MAJOR_VERSION >= 8
8636 unknown_objv = (Tcl_Obj **)ckalloc(
sizeof(Tcl_Obj *) * (objc+2));
8638 Tcl_Preserve((ClientData)unknown_objv);
8640 unknown_objv[0] = Tcl_NewStringObj(
"::unknown", 9);
8642 memcpy(unknown_objv + 1, objv,
sizeof(Tcl_Obj *)*objc);
8643 unknown_objv[++objc] = (Tcl_Obj*)NULL;
8644 objv = unknown_objv;
8647 unknown_argv = (
char **)ckalloc(
sizeof(
char *) * (argc+2));
8649 Tcl_Preserve((ClientData)unknown_argv);
8651 unknown_argv[0] =
strdup(
"unknown");
8652 memcpy(unknown_argv + 1, argv,
sizeof(
char *)*argc);
8653 unknown_argv[++
argc] = (
char *)NULL;
8654 argv = unknown_argv;
8658 DUMP1(
"end Tcl_GetCommandInfo");
8660 thr_crit_bup = rb_thread_critical;
8661 rb_thread_critical =
Qtrue;
8667 #if TCL_MAJOR_VERSION >= 8
8681 "unknown exception");
8698 #if TCL_MAJOR_VERSION >= 8
8699 if (!info.isNativeObjectProc) {
8704 argv = (
char **)ckalloc(
sizeof(
char *) * (argc+1));
8706 Tcl_Preserve((ClientData)argv);
8708 for (i = 0; i <
argc; ++
i) {
8709 argv[
i] = Tcl_GetStringFromObj(objv[i], &len);
8711 argv[
argc] = (
char *)NULL;
8715 Tcl_ResetResult(ptr->
ip);
8718 #if TCL_MAJOR_VERSION >= 8
8719 if (info.isNativeObjectProc) {
8724 resultPtr = Tcl_GetObjResult(ptr->
ip);
8725 Tcl_SetResult(ptr->
ip, Tcl_GetStringFromObj(resultPtr, &len),
8732 #if TCL_MAJOR_VERSION >= 8
8737 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8740 Tcl_Release((ClientData)argv);
8743 ckfree((
char*)argv);
8756 #if TCL_MAJOR_VERSION >= 8
8759 Tcl_EventuallyFree((ClientData)objv, TCL_DYNAMIC);
8762 Tcl_Release((ClientData)objv);
8765 ckfree((
char*)objv);
8772 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8775 Tcl_Release((ClientData)argv);
8778 ckfree((
char*)argv);
8789 rb_thread_critical = thr_crit_bup;
8793 if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->
ip)) {
8797 "ip_invoke_core receives TCL_RETURN");
8800 "ip_invoke_core receives TCL_BREAK");
8803 "ip_invoke_core receives TCL_CONTINUE");
8810 if (event_loop_abort_on_exc < 0) {
8815 Tcl_ResetResult(ptr->
ip);
8825 #if TCL_MAJOR_VERSION >= 8
8837 #if TCL_MAJOR_VERSION >= 8
8843 thr_crit_bup = rb_thread_critical;
8844 rb_thread_critical =
Qtrue;
8847 #if TCL_MAJOR_VERSION >= 8
8849 av = (Tcl_Obj**)ckalloc(
sizeof(Tcl_Obj *)*(argc+1));
8851 Tcl_Preserve((ClientData)av);
8853 for (i = 0; i <
argc; ++
i) {
8854 av[
i] = get_obj_from_str(argv[i]);
8862 av = (
char**)ckalloc(
sizeof(
char *) * (argc+1));
8864 Tcl_Preserve((ClientData)av);
8866 for (i = 0; i <
argc; ++
i) {
8872 rb_thread_critical = thr_crit_bup;
8880 #if TCL_MAJOR_VERSION >= 8
8888 for (i = 0; i <
argc; ++
i) {
8889 #if TCL_MAJOR_VERSION >= 8
8891 av[
i] = (Tcl_Obj*)NULL;
8894 av[
i] = (
char*)NULL;
8897 #if TCL_MAJOR_VERSION >= 8
8899 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8902 Tcl_Release((ClientData)av);
8909 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8912 Tcl_Release((ClientData)av);
8930 #if TCL_MAJOR_VERSION >= 8
8931 Tcl_Obj **av = (Tcl_Obj **)NULL;
8933 char **av = (
char **)NULL;
8950 Tcl_ResetResult(ptr->
ip);
8980 volatile VALUE q_dat;
8984 DUMP2(
"do_invoke_queue_handler : evPtr = %p", evPtr);
8986 DUMP2(
"added by thread : %lx", thread);
8989 DUMP1(
"processed by another event-loop");
8992 DUMP1(
"process it on current event-loop");
9002 DUMP1(
"caller is not yet ready to receive the result -> pending");
9026 q_dat = (
VALUE)NULL;
9028 DUMP2(
"call invoke_real (for caller thread:%lx)", thread);
9054 DUMP2(
"back to caller (caller thread:%lx)", thread);
9056 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
9057 have_rb_thread_waiting_for_value = 1;
9062 DUMP1(
"finish back to caller");
9063 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
9067 DUMP2(
"caller is dead (caller thread:%lx)", thread);
9080 Tcl_QueuePosition position;
9083 #ifdef RUBY_USE_NATIVE_THREAD
9089 volatile VALUE ip_obj = obj;
9094 #if TCL_MAJOR_VERSION >= 8
9095 Tcl_Obj **av = (Tcl_Obj **)NULL;
9097 char **av = (
char **)NULL;
9104 #ifdef RUBY_USE_NATIVE_THREAD
9106 DUMP2(
"invoke status: ptr->tk_thread_id %p", ptr->tk_thread_id);
9107 DUMP2(
"invoke status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9109 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9111 DUMP2(
"status: eventloopt_thread %lx", eventloop_thread);
9114 #ifdef RUBY_USE_NATIVE_THREAD
9115 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
9118 (
NIL_P(eventloop_thread) || current == eventloop_thread)
9120 if (
NIL_P(eventloop_thread)) {
9121 DUMP2(
"invoke from thread:%lx but no eventloop", current);
9123 DUMP2(
"invoke from current eventloop %lx", current);
9132 DUMP2(
"invoke from thread %lx (NOT current eventloop)", current);
9134 thr_crit_bup = rb_thread_critical;
9135 rb_thread_critical =
Qtrue;
9142 alloc_done = (
int*)ckalloc(
sizeof(
int));
9144 Tcl_Preserve((ClientData)alloc_done);
9152 Tcl_Preserve((ClientData)ivq);
9159 ivq->done = alloc_done;
9162 ivq->interp = ip_obj;
9164 ivq->thread = current;
9169 DUMP1(
"add handler");
9170 #ifdef RUBY_USE_NATIVE_THREAD
9171 if (ptr->tk_thread_id) {
9173 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)ivq, position);
9174 Tcl_ThreadAlert(ptr->tk_thread_id);
9175 }
else if (tk_eventloop_thread_id) {
9178 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
9179 (Tcl_Event*)ivq, position);
9180 Tcl_ThreadAlert(tk_eventloop_thread_id);
9183 Tcl_QueueEvent((Tcl_Event*)ivq, position);
9187 Tcl_QueueEvent((Tcl_Event*)ivq, position);
9190 rb_thread_critical = thr_crit_bup;
9196 DUMP2(
"ivq wait for handler (current thread:%lx)", current);
9197 while(*alloc_done >= 0) {
9201 DUMP2(
"*** ivq wakeup (current thread:%lx)", current);
9202 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
9203 if (
NIL_P(eventloop_thread)) {
9204 DUMP1(
"*** ivq lost eventloop thread");
9208 DUMP2(
"back from handler (current thread:%lx)", current);
9213 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
9216 Tcl_Release((ClientData)alloc_done);
9219 ckfree((
char*)alloc_done);
9225 Tcl_EventuallyFree((ClientData)ivq, TCL_DYNAMIC);
9240 DUMP1(
"raise exception");
9246 DUMP1(
"exit ip_invoke");
9299 volatile VALUE varname, index, flag;
9310 #if TCL_MAJOR_VERSION >= 8
9313 volatile VALUE strval;
9315 thr_crit_bup = rb_thread_critical;
9316 rb_thread_critical =
Qtrue;
9320 rb_thread_critical = thr_crit_bup;
9330 if (ret == (Tcl_Obj*)NULL) {
9338 rb_thread_critical = thr_crit_bup;
9343 strval = get_str_from_obj(ret);
9349 rb_thread_critical = thr_crit_bup;
9355 volatile VALUE strval;
9368 if (ret == (
char*)NULL) {
9373 rb_thread_critical = thr_crit_bup;
9380 rb_thread_critical = thr_crit_bup;
9406 if (
NIL_P(retval)) {
9430 volatile VALUE varname, index, value, flag;
9443 #if TCL_MAJOR_VERSION >= 8
9445 Tcl_Obj *valobj, *ret;
9446 volatile VALUE strval;
9448 thr_crit_bup = rb_thread_critical;
9449 rb_thread_critical =
Qtrue;
9451 valobj = get_obj_from_str(value);
9457 rb_thread_critical = thr_crit_bup;
9469 if (ret == (Tcl_Obj*)NULL) {
9477 rb_thread_critical = thr_crit_bup;
9482 strval = get_str_from_obj(ret);
9488 rb_thread_critical = thr_crit_bup;
9495 volatile VALUE strval;
9508 if (ret == (
char*)NULL) {
9516 rb_thread_critical = thr_crit_bup;
9545 if (
NIL_P(retval)) {
9569 volatile VALUE varname, index, flag;
9590 if (
FIX2INT(flag) & TCL_LEAVE_ERR_MSG) {
9620 if (
NIL_P(retval)) {
9642 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9652 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9662 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9673 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9682 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9692 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9703 volatile VALUE ary, elem;
9706 #ifdef HAVE_RUBY_ENCODING_H
9708 volatile VALUE list_ivar_enc;
9715 if (
NIL_P(ip_obj)) {
9716 interp = (Tcl_Interp *)NULL;
9718 interp = (Tcl_Interp *)NULL;
9724 #ifdef HAVE_RUBY_ENCODING_H
9730 #if TCL_MAJOR_VERSION >= 8
9737 listobj = get_obj_from_str(list_str);
9741 result = Tcl_ListObjGetElements(interp, listobj, &objc, &objv);
9743 if (result == TCL_ERROR) {
9745 if (interp == (Tcl_Interp*)NULL) {
9752 for(idx = 0; idx < objc; idx++) {
9756 thr_crit_bup = rb_thread_critical;
9757 rb_thread_critical =
Qtrue;
9764 for(idx = 0; idx < objc; idx++) {
9765 elem = get_str_from_obj(objv[idx]);
9768 #ifdef HAVE_RUBY_ENCODING_H
9771 rb_ivar_set(elem, ID_at_enc, ENCODING_NAME_BINARY);
9785 rb_thread_critical = thr_crit_bup;
9787 for(idx = 0; idx < objc; idx++) {
9799 &argc, &argv) == TCL_ERROR) {
9800 if (interp == (Tcl_Interp*)NULL) {
9812 for(idx = 0; idx <
argc; idx++) {
9866 thr_crit_bup = rb_thread_critical;
9867 rb_thread_critical =
Qtrue;
9872 flagPtr = (
int *)ckalloc(
sizeof(
int) *
argc);
9874 Tcl_Preserve((ClientData)flagPtr);
9879 for(num = 0; num <
argc; num++) {
9882 #if TCL_MAJOR_VERSION >= 8
9883 len += Tcl_ScanCountedElement(dst,
RSTRING_LEN(argv[num]),
9886 len += Tcl_ScanElement(dst, &flagPtr[num]) + 1;
9892 result = (
char *)ckalloc(len);
9894 Tcl_Preserve((ClientData)result);
9897 for(num = 0; num <
argc; num++) {
9898 #if TCL_MAJOR_VERSION >= 8
9899 len = Tcl_ConvertCountedElement(
RSTRING_PTR(argv[num]),
9903 len = Tcl_ConvertElement(
RSTRING_PTR(argv[num]), dst, flagPtr[num]);
9909 if (dst == result) {
9916 Tcl_EventuallyFree((ClientData)flagPtr, TCL_DYNAMIC);
9919 Tcl_Release((ClientData)flagPtr);
9922 ckfree((
char*)flagPtr);
9930 Tcl_EventuallyFree((ClientData)result, TCL_DYNAMIC);
9933 Tcl_Release((ClientData)result);
9941 rb_thread_critical = thr_crit_bup;
9958 thr_crit_bup = rb_thread_critical;
9959 rb_thread_critical =
Qtrue;
9963 #if TCL_MAJOR_VERSION >= 8
9970 len = Tcl_ScanElement(
RSTRING_PTR(src), &scan_flag);
9978 rb_thread_critical = thr_crit_bup;
10017 volatile VALUE ret;
10020 =
"tcltklib %s :: Ruby%s (%s) %s pthread :: Tcl%s(%s)/Tk%s(%s) %s";
10028 +
strlen(TCL_PATCH_LEVEL)
10029 +
strlen(
"without stub")
10030 +
strlen(TK_PATCH_LEVEL)
10031 +
strlen(
"without stub")
10032 +
strlen(
"unknown tcl_threads");
10037 sprintf(info, form,
10046 #ifdef USE_TCL_STUBS
10052 #ifdef USE_TK_STUBS
10057 #ifdef WITH_TCL_ENABLE_THREAD
10058 #
if WITH_TCL_ENABLE_THREAD
10061 "without tcl_threads"
10064 "unknown tcl_threads"
10091 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10092 if (Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(name)) == (Tcl_Encoding)NULL) {
10093 if (
RTEST(error_mode)) {
10102 #ifdef HAVE_RUBY_ENCODING_H
10107 if (
RTEST(error_mode)) {
10127 #ifdef HAVE_RUBY_ENCODING_H
10129 update_encoding_table(table, interp, error_mode)
10143 if (
NIL_P(interp))
return 0;
10145 if (ptr == (
struct tcltkip *) NULL)
return 0;
10149 Tcl_GetEncodingNames(ptr->
ip);
10150 enc_list = Tcl_GetObjResult(ptr->
ip);
10153 if (Tcl_ListObjGetElements(ptr->
ip, enc_list,
10154 &objc, &objv) != TCL_OK) {
10161 for(i = 0; i < objc; i++) {
10199 if (!
NIL_P(interp)) {
10202 ptr = (
struct tcltkip *) NULL;
10208 if (ptr &&
NIL_P(enc)) {
10210 enc =
rb_funcall(interp, ID_encoding_name, 0, 0);
10219 enc =
rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL));
10233 if (!
NIL_P(name)) {
10240 if (update_encoding_table(table, interp, error_mode)) {
10244 if (!
NIL_P(name)) {
10273 if (update_encoding_table(table, interp, error_mode)) {
10286 if (
RTEST(error_mode)) {
10310 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10312 update_encoding_table(table, interp, error_mode)
10325 if (
NIL_P(interp))
return 0;
10327 if (ptr == (
struct tcltkip *) NULL)
return 0;
10331 Tcl_GetEncodingNames(ptr->
ip);
10332 enc_list = Tcl_GetObjResult(ptr->
ip);
10335 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) != TCL_OK) {
10342 for(i = 0; i < objc; i++) {
10368 if (!
NIL_P(name)) {
10374 if (update_encoding_table(table,
rb_ivar_get(table, ID_at_interp),
10379 if (!
NIL_P(name)) {
10385 if (
RTEST(error_mode)) {
10434 #ifdef HAVE_RUBY_ENCODING_H
10448 #ifdef HAVE_RB_SET_SAFE_LEVEL_FORCE
10464 Tcl_GetEncodingNames(ptr->
ip);
10465 enc_list = Tcl_GetObjResult(ptr->
ip);
10468 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) != TCL_OK) {
10474 for(i = 0; i < objc; i++) {
10475 int name2obj, obj2name;
10477 name2obj = 1; obj2name = 1;
10482 if (strcmp(
RSTRING_PTR(encname),
"identity") == 0) {
10483 name2obj = 1; obj2name = 0;
10484 idx = ENCODING_INDEX_BINARY;
10486 }
else if (strcmp(
RSTRING_PTR(encname),
"shiftjis") == 0) {
10487 name2obj = 1; obj2name = 0;
10490 }
else if (strcmp(
RSTRING_PTR(encname),
"unicode") == 0) {
10491 name2obj = 1; obj2name = 0;
10492 idx = ENCODING_INDEX_UTF8;
10494 }
else if (strcmp(
RSTRING_PTR(encname),
"symbol") == 0) {
10495 name2obj = 1; obj2name = 0;
10500 name2obj = 1; obj2name = 1;
10530 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10546 rb_hash_aset(table, ENCODING_NAME_BINARY, ENCODING_NAME_BINARY);
10549 Tcl_GetEncodingNames(ptr->
ip);
10550 enc_list = Tcl_GetObjResult(ptr->
ip);
10553 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) != TCL_OK) {
10559 for(i = 0; i < objc; i++) {
10602 if (
NIL_P(table)) {
10619 #if TCL_MAJOR_VERSION >= 8
10621 #define MASTER_MENU 0
10622 #define TEAROFF_MENU 1
10625 struct dummy_TkMenuEntry {
10627 struct dummy_TkMenu *menuPtr;
10631 struct dummy_TkMenu {
10634 Tcl_Interp *interp;
10635 Tcl_Command widgetCmd;
10636 struct dummy_TkMenuEntry **entries;
10640 Tcl_Obj *menuTypePtr;
10644 struct dummy_TkMenuRef {
10645 struct dummy_TkMenu *menuPtr;
10652 EXTERN struct dummy_TkMenuRef *TkFindMenuReferences(Tcl_Interp*,
char*);
10654 #define MENU_HASH_KEY "tkMenus"
10665 #if TCL_MAJOR_VERSION >= 8
10666 volatile VALUE menu_path;
10668 struct dummy_TkMenuRef *menuRefPtr = NULL;
10670 Tcl_HashTable *menuTablePtr;
10671 Tcl_HashEntry *hashEntryPtr;
10673 menu_path = argv[0];
10677 menuRefPtr = TkFindMenuReferences(ptr->
ip,
RSTRING_PTR(menu_path));
10680 = (Tcl_HashTable *) Tcl_GetAssocData(ptr->
ip, MENU_HASH_KEY, NULL))
10683 = Tcl_FindHashEntry(menuTablePtr,
RSTRING_PTR(menu_path)))
10685 menuRefPtr = (
struct dummy_TkMenuRef *) Tcl_GetHashValue(hashEntryPtr);
10690 if (menuRefPtr == (
struct dummy_TkMenuRef *) NULL) {
10694 if (menuRefPtr->menuPtr == (
struct dummy_TkMenu *) NULL) {
10696 "invalid menu widget (maybe already destroyed)");
10699 if ((menuRefPtr->menuPtr)->menuType != MENUBAR) {
10701 "target menu widget must be a MENUBAR type");
10704 (menuRefPtr->menuPtr)->menuType = TEAROFF_MENU;
10708 char *s =
"normal";
10710 (menuRefPtr->menuPtr)->menuTypePtr = Tcl_NewStringObj(s,
strlen(s));
10713 (menuRefPtr->menuPtr)->menuType = MASTER_MENU;
10718 TkEventuallyRecomputeMenu(menuRefPtr->menuPtr);
10719 TkEventuallyRedrawMenu(menuRefPtr->menuPtr,
10720 (
struct dummy_TkMenuEntry *)NULL);
10722 memset((
void *) &event, 0,
sizeof(event));
10723 event.xany.type = ConfigureNotify;
10724 event.xany.serial = NextRequest(Tk_Display((menuRefPtr->menuPtr)->tkwin));
10725 event.xany.send_event = 0;
10726 event.xany.window = Tk_WindowId((menuRefPtr->menuPtr)->tkwin);
10727 event.xany.display = Tk_Display((menuRefPtr->menuPtr)->tkwin);
10728 event.xconfigure.window =
event.xany.window;
10729 Tk_HandleEvent(&event);
10746 argv[0] = menu_path;
10768 tcltkip_class = ip;
10772 #ifdef HAVE_RUBY_ENCODING_H
10811 # define TK_WINDOWING_SYSTEM "win32"
10814 # define TK_WINDOWING_SYSTEM "classic"
10817 # define TK_WINDOWING_SYSTEM "aqua"
10819 # define TK_WINDOWING_SYSTEM "x11"
10840 #ifdef TCL_NAMESPACE_ONLY
10848 #ifdef TCL_PARSE_PART1
10875 eTkLocalJumpError =
rb_define_class(
"TkLocalJumpError", eLocalJumpError);
10877 eTkCallbackRetry =
rb_define_class(
"TkCallbackRetry", eTkLocalJumpError);
10878 eTkCallbackRedo =
rb_define_class(
"TkCallbackRedo", eTkLocalJumpError);
10879 eTkCallbackThrow =
rb_define_class(
"TkCallbackThrow", eTkLocalJumpError);
10885 ID_encoding_name =
rb_intern(
"encoding_name");
10886 ID_encoding_table =
rb_intern(
"encoding_table");
11036 eventloop_thread =
Qnil;
11037 eventloop_interp = (Tcl_Interp*)NULL;
11039 #ifndef DEFAULT_EVENTLOOP_DEPTH
11040 #define DEFAULT_EVENTLOOP_DEPTH 7
11045 watchdog_thread =
Qnil;
11051 #ifdef HAVE_NATIVETHREAD
11077 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
11086 Tcl_ObjType_ByteArray = Tcl_GetObjType(Tcl_ObjTypeName_ByteArray);
11087 Tcl_ObjType_String = Tcl_GetObjType(Tcl_ObjTypeName_String);