7 #define TCLTKLIB_RELEASE_DATE "2010-08-25"
12 #ifdef HAVE_RUBY_ENCODING_H
16 #define RUBY_VERSION "(unknown version)"
18 #ifndef RUBY_RELEASE_DATE
19 #define RUBY_RELEASE_DATE "unknown release-date"
30 #if !defined(RSTRING_PTR)
31 #define RSTRING_PTR(s) (RSTRING(s)->ptr)
32 #define RSTRING_LEN(s) (RSTRING(s)->len)
34 #if !defined(RSTRING_LENINT)
35 #define RSTRING_LENINT(s) ((int)RSTRING_LEN(s))
37 #if !defined(RARRAY_PTR)
38 #define RARRAY_PTR(s) (RARRAY(s)->ptr)
39 #define RARRAY_LEN(s) (RARRAY(s)->len)
43 #define RbTk_OBJ_UNTRUST(x) do {OBJ_TAINT(x); OBJ_UNTRUST(x);} while (0)
45 #define RbTk_OBJ_UNTRUST(x) OBJ_TAINT(x)
47 #define RbTk_ALLOC_N(type, n) (type *)ckalloc((int)(sizeof(type) * (n)))
49 #if defined(HAVE_RB_PROC_NEW) && !defined(RUBY_VM)
56 #ifdef HAVE_STDARG_PROTOTYPES
58 #define va_init_list(a,b) va_start(a,b)
61 #define va_init_list(a,b) va_start(a)
65 #if !defined HAVE_VSNPRINTF && !defined vsnprintf
68 # define vsnprintf _vsnprintf
70 # ifdef HAVE_RUBY_RUBY_H
81 #ifndef HAVE_RUBY_NATIVE_THREAD_P
82 #define ruby_native_thread_p() is_ruby_native_thread()
83 #undef RUBY_USE_NATIVE_THREAD
85 #define RUBY_USE_NATIVE_THREAD 1
88 #ifndef HAVE_RB_ERRINFO
89 #define rb_errinfo() (ruby_errinfo+0)
93 #ifndef HAVE_RB_SAFE_LEVEL
94 #define rb_safe_level() (ruby_safe_level+0)
96 #ifndef HAVE_RB_SOURCEFILE
97 #define rb_sourcefile() (ruby_sourcefile+0)
102 #ifndef TCL_ALPHA_RELEASE
103 #define TCL_ALPHA_RELEASE 0
104 #define TCL_BETA_RELEASE 1
105 #define TCL_FINAL_RELEASE 2
126 #if TCL_MAJOR_VERSION >= 8
128 # if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 4
132 # define CONST84 CONST
140 # define CONST84 CONST
148 # if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 5
151 # define CONST86 CONST84
156 #define TAG_RETURN 0x1
157 #define TAG_BREAK 0x2
159 #define TAG_RETRY 0x4
161 #define TAG_RAISE 0x6
162 #define TAG_THROW 0x7
163 #define TAG_FATAL 0x8
166 #define DUMP1(ARG1) if (ruby_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1); fflush(stderr); }
167 #define DUMP2(ARG1, ARG2) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\
168 fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); fflush(stderr); }
169 #define DUMP3(ARG1, ARG2, ARG3) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\
170 fprintf(stderr, ARG1, ARG2, ARG3); fprintf(stderr, "\n"); fflush(stderr); }
187 #ifdef HAVE_RUBY_ENCODING_H
253 #if TCL_MAJOR_VERSION >= 8
254 static const char Tcl_ObjTypeName_ByteArray[] =
"bytearray";
255 static CONST86 Tcl_ObjType *Tcl_ObjType_ByteArray;
257 static const char Tcl_ObjTypeName_String[] =
"string";
258 static CONST86 Tcl_ObjType *Tcl_ObjType_String;
260 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
261 #define IS_TCL_BYTEARRAY(obj) ((obj)->typePtr == Tcl_ObjType_ByteArray)
262 #define IS_TCL_STRING(obj) ((obj)->typePtr == Tcl_ObjType_String)
263 #define IS_TCL_VALID_STRING(obj) ((obj)->bytes != (char*)NULL)
267 #ifndef HAVE_RB_HASH_LOOKUP
268 #define rb_hash_lookup rb_hash_aref
273 #ifdef HAVE_PROTOTYPES
274 tcl_eval(Tcl_Interp *
interp,
const char *
cmd)
276 tcl_eval(interp, cmd)
291 #define Tcl_Eval tcl_eval
294 #ifdef HAVE_PROTOTYPES
295 tcl_global_eval(Tcl_Interp *interp,
const char *cmd)
297 tcl_global_eval(interp, cmd)
311 #undef Tcl_GlobalEval
312 #define Tcl_GlobalEval tcl_global_eval
315 #if TCL_MAJOR_VERSION < 8
316 #define Tcl_IncrRefCount(obj) (1)
317 #define Tcl_DecrRefCount(obj) (1)
321 #if TCL_MAJOR_VERSION < 8
322 #define Tcl_GetStringResult(interp) ((interp)->result)
326 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
334 Tcl_Obj *nameObj1, *nameObj2 =
NULL, *retObj;
336 nameObj1 = Tcl_NewStringObj((
char*)name1, -1);
340 nameObj2 = Tcl_NewStringObj((
char*)name2, -1);
344 retObj = Tcl_ObjGetVar2(interp, nameObj1, nameObj2, flags);
363 Tcl_Obj *nameObj1, *nameObj2 =
NULL, *retObj;
365 nameObj1 = Tcl_NewStringObj((
char*)name1, -1);
369 nameObj2 = Tcl_NewStringObj((
char*)name2, -1);
373 retObj = Tcl_ObjSetVar2(interp, nameObj1, nameObj2, newValObj, flags);
387 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4)
388 # if !defined __MINGW32__ && !defined __BORLANDC__
404 #if TCL_MAJOR_VERSION >= 8
460 for(i = 0; i < q->
argc; i++) {
472 #ifdef RUBY_USE_NATIVE_THREAD
473 Tcl_ThreadId tk_eventloop_thread_id;
488 #ifdef RUBY_USE_NATIVE_THREAD
489 #define CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 1
490 #define USE_TOGGLE_WINDOW_MODE_FOR_IDLE 0
491 #define DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 1
493 #define CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 1
494 #define USE_TOGGLE_WINDOW_MODE_FOR_IDLE 0
495 #define DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 0
498 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
509 #ifdef RUBY_USE_NATIVE_THREAD
510 #define DEFAULT_EVENT_LOOP_MAX 800
511 #define DEFAULT_NO_EVENT_TICK 10
512 #define DEFAULT_NO_EVENT_WAIT 5
513 #define WATCHDOG_INTERVAL 10
514 #define DEFAULT_TIMER_TICK 0
515 #define NO_THREAD_INTERRUPT_TIME 100
517 #define DEFAULT_EVENT_LOOP_MAX 800
518 #define DEFAULT_NO_EVENT_TICK 10
519 #define DEFAULT_NO_EVENT_WAIT 20
520 #define WATCHDOG_INTERVAL 10
521 #define DEFAULT_TIMER_TICK 0
522 #define NO_THREAD_INTERRUPT_TIME 100
525 #define EVENT_HANDLER_TIMEOUT 100
542 #if TCL_MAJOR_VERSION >= 8
543 static int ip_ruby_eval
_((ClientData, Tcl_Interp *,
int, Tcl_Obj *
CONST*));
544 static int ip_ruby_cmd
_((ClientData, Tcl_Interp *,
int, Tcl_Obj *
CONST*));
546 static int ip_ruby_eval
_((ClientData, Tcl_Interp *,
int,
char **));
547 static int ip_ruby_cmd
_((ClientData, Tcl_Interp *,
int,
char **));
559 #ifndef TCL_NAMESPACE_DEBUG
560 #define TCL_NAMESPACE_DEBUG 0
563 #if TCL_NAMESPACE_DEBUG
565 #if TCL_MAJOR_VERSION >= 8
566 EXTERN struct TclIntStubs *tclIntStubsPtr;
570 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5
573 # ifndef Tcl_GetCurrentNamespace
574 EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace
_((Tcl_Interp *));
576 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
577 # ifndef Tcl_GetCurrentNamespace
578 # ifndef FunctionNum_of_GetCurrentNamespace
579 #define FunctionNum_of_GetCurrentNamespace 124
581 struct DummyTclIntStubs_for_GetCurrentNamespace {
583 struct TclIntStubHooks *hooks;
584 void (*
func[FunctionNum_of_GetCurrentNamespace])();
585 Tcl_Namespace * (*tcl_GetCurrentNamespace)
_((Tcl_Interp *));
588 #define Tcl_GetCurrentNamespace \
589 (((struct DummyTclIntStubs_for_GetCurrentNamespace *)tclIntStubsPtr)->tcl_GetCurrentNamespace)
596 #if TCL_MAJOR_VERSION < 8
597 #define ip_null_namespace(interp) (0)
599 #define ip_null_namespace(interp) \
600 (Tcl_GetCurrentNamespace(interp) == (Tcl_Namespace *)NULL)
604 #if TCL_MAJOR_VERSION < 8
605 #define rbtk_invalid_namespace(ptr) (0)
607 #define rbtk_invalid_namespace(ptr) \
608 ((ptr)->default_ns == (Tcl_Namespace*)NULL || Tcl_GetCurrentNamespace((ptr)->ip) != (ptr)->default_ns)
612 #if TCL_MAJOR_VERSION >= 8
614 typedef struct CallFrame {
615 Tcl_Namespace *nsPtr;
619 struct CallFrame *callerPtr;
620 struct CallFrame *callerVarPtr;
629 # if !defined(TclGetFrame) && !defined(TclGetFrame_TCL_DECLARED)
630 EXTERN int TclGetFrame
_((Tcl_Interp *,
CONST char *, CallFrame **));
632 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
634 # ifndef FunctionNum_of_GetFrame
635 #define FunctionNum_of_GetFrame 32
637 struct DummyTclIntStubs_for_GetFrame {
639 struct TclIntStubHooks *hooks;
640 void (*
func[FunctionNum_of_GetFrame])();
641 int (*tclGetFrame)
_((Tcl_Interp *,
CONST char *, CallFrame **));
643 #define TclGetFrame \
644 (((struct DummyTclIntStubs_for_GetFrame *)tclIntStubsPtr)->tclGetFrame)
648 # if !defined(Tcl_PopCallFrame) && !defined(Tcl_PopCallFrame_TCL_DECLARED)
649 EXTERN void Tcl_PopCallFrame
_((Tcl_Interp *));
650 EXTERN int Tcl_PushCallFrame
_((Tcl_Interp *, Tcl_CallFrame *, Tcl_Namespace *,
int));
652 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
653 # ifndef Tcl_PopCallFrame
654 # ifndef FunctionNum_of_PopCallFrame
655 #define FunctionNum_of_PopCallFrame 128
657 struct DummyTclIntStubs_for_PopCallFrame {
659 struct TclIntStubHooks *hooks;
660 void (*
func[FunctionNum_of_PopCallFrame])();
661 void (*tcl_PopCallFrame)
_((Tcl_Interp *));
662 int (*tcl_PushCallFrame)
_((Tcl_Interp *, Tcl_CallFrame *, Tcl_Namespace *,
int));
665 #define Tcl_PopCallFrame \
666 (((struct DummyTclIntStubs_for_PopCallFrame *)tclIntStubsPtr)->tcl_PopCallFrame)
667 #define Tcl_PushCallFrame \
668 (((struct DummyTclIntStubs_for_PopCallFrame *)tclIntStubsPtr)->tcl_PushCallFrame)
674 typedef struct CallFrame {
675 Tcl_HashTable varTable;
679 struct CallFrame *callerPtr;
680 struct CallFrame *callerVarPtr;
683 # ifndef Tcl_CallFrame
684 #define Tcl_CallFrame CallFrame
687 # if !defined(TclGetFrame) && !defined(TclGetFrame_TCL_DECLARED)
688 EXTERN int TclGetFrame
_((Tcl_Interp *,
CONST char *, CallFrame **));
691 # if !defined(Tcl_PopCallFrame) && !defined(Tcl_PopCallFrame_TCL_DECLARED)
692 typedef struct DummyInterp {
696 Tcl_HashTable dummy4;
697 Tcl_HashTable dummy5;
698 Tcl_HashTable dummy6;
702 CallFrame *varFramePtr;
706 Tcl_PopCallFrame(interp)
709 DummyInterp *iPtr = (DummyInterp*)interp;
710 CallFrame *frame = iPtr->varFramePtr;
713 iPtr->framePtr = frame.callerPtr;
714 iPtr->varFramePtr = frame.callerVarPtr;
720 #define Tcl_Namespace char
723 Tcl_PushCallFrame(interp, framePtr, nsPtr, isProcCallFrame)
725 Tcl_CallFrame *framePtr;
726 Tcl_Namespace *nsPtr;
729 DummyInterp *iPtr = (DummyInterp*)interp;
730 CallFrame *frame = (CallFrame *)framePtr;
733 Tcl_InitHashTable(&frame.varTable, TCL_STRING_KEYS);
734 if (iPtr->varFramePtr !=
NULL) {
735 frame.level = iPtr->varFramePtr->level + 1;
739 frame.callerPtr = iPtr->framePtr;
740 frame.callerVarPtr = iPtr->varFramePtr;
741 iPtr->framePtr = &frame;
742 iPtr->varFramePtr = &frame;
756 #if TCL_NAMESPACE_DEBUG
757 Tcl_Namespace *default_ns;
759 #ifdef RUBY_USE_NATIVE_THREAD
760 Tcl_ThreadId tk_thread_id;
791 if (!ptr || !ptr->ip || Tcl_InterpDeleted(ptr->ip)
793 || rbtk_invalid_namespace(ptr)
796 DUMP1(
"ip is deleted");
808 if (ptr->ip == (Tcl_Interp*)
NULL) {
814 return(ptr->ref_count);
822 if (ptr->ref_count < 0) {
824 }
else if (ptr->ip == (Tcl_Interp*)
NULL) {
830 return(ptr->ref_count);
835 #ifdef HAVE_STDARG_PROTOTYPES
838 create_ip_exc(interp, exc, fmt, va_alist)
848 struct tcltkip *ptr = get_ip(interp);
852 buf[BUFSIZ - 1] =
'\0';
865 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
869 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 84
870 #error Ruby/Tk-Kit requires Tcl/Tk8.4 or later.
890 #if defined USE_TCL_STUBS || defined USE_TK_STUBS
891 # error Not support Tcl/Tk stubs with Ruby/Tk-Kit or Rubykit.
894 #ifndef KIT_INCLUDES_ZLIB
895 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
896 #define KIT_INCLUDES_ZLIB 1
898 #define KIT_INCLUDES_ZLIB 0
903 #define WIN32_LEAN_AND_MEAN
905 #undef WIN32_LEAN_AND_MEAN
908 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
909 EXTERN Tcl_Obj* TclGetStartupScriptPath();
910 EXTERN void TclSetStartupScriptPath
_((Tcl_Obj*));
911 #define Tcl_GetStartupScript(encPtr) TclGetStartupScriptPath()
912 #define Tcl_SetStartupScript(path,enc) TclSetStartupScriptPath(path)
914 #if !defined(TclSetPreInitScript) && !defined(TclSetPreInitScript_TCL_DECLARED)
915 EXTERN char* TclSetPreInitScript
_((
char *));
918 #ifndef KIT_INCLUDES_TK
919 # define KIT_INCLUDES_TK 1
924 Tcl_AppInitProc Vfs_Init, Rechan_Init;
925 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
926 Tcl_AppInitProc Pwb_Init;
930 Tcl_AppInitProc Vlerq_Init, Vlerq_SafeInit;
932 Tcl_AppInitProc Mk4tcl_Init;
935 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
936 Tcl_AppInitProc Thread_Init;
939 #if KIT_INCLUDES_ZLIB
940 Tcl_AppInitProc Zlib_Init;
943 #ifdef KIT_INCLUDES_ITCL
944 Tcl_AppInitProc Itcl_Init;
948 Tcl_AppInitProc Dde_Init, Dde_SafeInit, Registry_Init;
953 #define RUBYTK_KITPATH_CONST_NAME "RUBYTK_KITPATH"
955 static char *rubytk_kitpath =
NULL;
957 static char rubytkkit_preInitCmd[] =
958 "proc tclKitPreInit {} {\n"
959 "rename tclKitPreInit {}\n"
960 "load {} rubytk_kitpath\n"
961 #if KIT_INCLUDES_ZLIB
962 "catch {load {} zlib}\n"
966 "namespace eval ::vlerq {}\n"
967 "if {[catch { vlerq open $::tcl::kitpath } ::vlerq::starkit_root]} {\n"
970 "set files [vlerq get $::vlerq::starkit_root 0 dirs 0 files]\n"
971 "set n [lsearch [vlerq get $files * name] boot.tcl]\n"
974 "array set a [vlerq get $files $n]\n"
977 #if defined KIT_VFS_WRITABLE && !defined CREATE_RUBYKIT
979 "mk::file open exe $::tcl::kitpath\n"
981 "mk::file open exe $::tcl::kitpath -readonly\n"
983 "set n [mk::select exe.dirs!0.files name boot.tcl]\n"
984 "if {[llength $n] == 1} {\n"
985 "array set a [mk::get exe.dirs!0.files!$n]\n"
987 "if {![info exists a(contents)]} { error {no boot.tcl file} }\n"
988 "if {$a(size) != [string length $a(contents)]} {\n"
989 "set a(contents) [zlib decompress $a(contents)]\n"
991 "if {$a(contents) eq \"\"} { error {empty boot.tcl} }\n"
992 "uplevel #0 $a(contents)\n"
994 "} elseif {[lindex $::argv 0] eq \"-init-\"} {\n"
995 "uplevel #0 { source [lindex $::argv 1] }\n"
1000 "set vfsdir \"[file rootname $::tcl::kitpath].vfs\"\n"
1001 "if {[file isdirectory $vfsdir]} {\n"
1002 "set ::tcl_library [file join $vfsdir lib tcl$::tcl_version]\n"
1003 "set ::tcl_libPath [list $::tcl_library [file join $vfsdir lib]]\n"
1004 "catch {uplevel #0 [list source [file join $vfsdir config.tcl]]}\n"
1005 "uplevel #0 [list source [file join $::tcl_library init.tcl]]\n"
1006 "set ::auto_path $::tcl_libPath\n"
1008 "error \"\n $::tcl::kitpath has no VFS data to start up\"\n"
1018 static const char initScript[] =
1019 "if {[file isfile [file join $::tcl::kitpath main.tcl]]} {\n"
1020 "if {[info commands console] != {}} { console hide }\n"
1021 "set tcl_interactive 0\n"
1023 "set argv [linsert $argv 0 $argv0]\n"
1024 "set argv0 [file join $::tcl::kitpath main.tcl]\n"
1032 set_rubytk_kitpath(
const char *kitpath)
1036 if (rubytk_kitpath) {
1040 rubytk_kitpath = (
char *)ckalloc(len + 1);
1041 memcpy(rubytk_kitpath, kitpath, len);
1042 rubytk_kitpath[
len] =
'\0';
1044 return rubytk_kitpath;
1050 #define DEV_NULL "NUL"
1052 #define DEV_NULL "/dev/null"
1056 check_tclkit_std_channels()
1065 chan = Tcl_GetStdChannel(TCL_STDIN);
1067 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"r", 0);
1069 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1071 Tcl_SetStdChannel(chan, TCL_STDIN);
1073 chan = Tcl_GetStdChannel(TCL_STDOUT);
1075 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"w", 0);
1077 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1079 Tcl_SetStdChannel(chan, TCL_STDOUT);
1081 chan = Tcl_GetStdChannel(TCL_STDERR);
1083 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"w", 0);
1085 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1087 Tcl_SetStdChannel(chan, TCL_STDERR);
1094 rubytk_kitpathObjCmd(ClientData
dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *
const objv[])
1098 set_rubytk_kitpath(Tcl_GetString(objv[1]));
1099 }
else if (objc > 2) {
1100 Tcl_WrongNumArgs(interp, 1, objv,
"?path?");
1102 str = rubytk_kitpath ? rubytk_kitpath : Tcl_GetNameOfExecutable();
1103 Tcl_SetObjResult(interp, Tcl_NewStringObj(str, -1));
1112 rubytk_kitpath_init(Tcl_Interp *interp)
1114 Tcl_CreateObjCommand(interp,
"::tcl::kitpath", rubytk_kitpathObjCmd, 0, 0);
1115 if (Tcl_LinkVar(interp,
"::tcl::kitpath", (
char *) &rubytk_kitpath,
1116 TCL_LINK_STRING | TCL_LINK_READ_ONLY) !=
TCL_OK) {
1120 Tcl_CreateObjCommand(interp,
"::tcl::rubytk_kitpath", rubytk_kitpathObjCmd, 0, 0);
1121 if (Tcl_LinkVar(interp,
"::tcl::rubytk_kitpath", (
char *) &rubytk_kitpath,
1122 TCL_LINK_STRING | TCL_LINK_READ_ONLY) !=
TCL_OK) {
1126 if (rubytk_kitpath ==
NULL) {
1131 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1134 return Tcl_PkgProvide(interp,
"rubytk_kitpath",
"1.0");
1140 init_static_tcltk_packages()
1145 check_tclkit_std_channels();
1147 #ifdef KIT_INCLUDES_ITCL
1148 Tcl_StaticPackage(0,
"Itcl", Itcl_Init,
NULL);
1151 Tcl_StaticPackage(0,
"Vlerq", Vlerq_Init, Vlerq_SafeInit);
1153 Tcl_StaticPackage(0,
"Mk4tcl", Mk4tcl_Init,
NULL);
1155 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
1156 Tcl_StaticPackage(0,
"pwb", Pwb_Init,
NULL);
1158 Tcl_StaticPackage(0,
"rubytk_kitpath", rubytk_kitpath_init,
NULL);
1159 Tcl_StaticPackage(0,
"rechan", Rechan_Init,
NULL);
1160 Tcl_StaticPackage(0,
"vfs", Vfs_Init,
NULL);
1161 #if KIT_INCLUDES_ZLIB
1162 Tcl_StaticPackage(0,
"zlib", Zlib_Init,
NULL);
1164 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
1165 Tcl_StaticPackage(0,
"Thread", Thread_Init, Thread_SafeInit);
1168 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
1169 Tcl_StaticPackage(0,
"dde", Dde_Init, Dde_SafeInit);
1171 Tcl_StaticPackage(0,
"dde", Dde_Init,
NULL);
1173 Tcl_StaticPackage(0,
"registry", Registry_Init,
NULL);
1175 #ifdef KIT_INCLUDES_TK
1176 Tcl_StaticPackage(0,
"Tk", Tk_Init, Tk_SafeInit);
1183 call_tclkit_init_script(Tcl_Interp *interp)
1189 if (Tcl_EvalEx(interp, initScript, -1, TCL_EVAL_GLOBAL) ==
TCL_OK) {
1190 const char *encoding =
NULL;
1191 Tcl_Obj*
path = Tcl_GetStartupScript(&encoding);
1192 Tcl_SetStartupScript(Tcl_GetObjResult(interp), encoding);
1194 Tcl_Eval(interp,
"incr argc -1; set argv [lrange $argv 1 end]");
1208 EXTERN void TkWinSetHINSTANCE(HINSTANCE hInstance);
1209 void rbtk_win32_SetHINSTANCE(
const char *module_name)
1216 hInst = GetModuleHandle(module_name);
1217 TkWinSetHINSTANCE(hInst);
1229 init_static_tcltk_packages();
1233 const_id =
rb_intern(RUBYTK_KITPATH_CONST_NAME);
1236 volatile VALUE pathobj;
1240 #ifdef HAVE_RUBY_ENCODING_H
1248 #ifdef CREATE_RUBYTK_KIT
1249 if (rubytk_kitpath ==
NULL) {
1253 volatile VALUE basename;
1263 if (rubytk_kitpath ==
NULL) {
1264 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1267 TclSetPreInitScript(rubytkkit_preInitCmd);
1307 tcltkip_init_tk(interp)
1310 struct tcltkip *ptr = get_ip(interp);
1312 #if TCL_MAJOR_VERSION >= 8
1315 if (Tcl_IsSafe(ptr->
ip)) {
1316 DUMP1(
"Tk_SafeInit");
1323 "tcltklib: can't find Tk_SafeInit()");
1326 "tcltklib: fail to Tk_SafeInit(). %s",
1330 "tcltklib: fail to Tk_InitStubs(). %s",
1334 "tcltklib: unknown error(%d) on ruby_tk_stubs_safeinit", st);
1344 "tcltklib: can't find Tk_Init()");
1347 "tcltklib: fail to Tk_Init(). %s",
1351 "tcltklib: fail to Tk_InitStubs(). %s",
1355 "tcltklib: unknown error(%d) on ruby_tk_stubs_init", st);
1366 #ifdef RUBY_USE_NATIVE_THREAD
1367 ptr->tk_thread_id = Tcl_GetCurrentThread();
1386 DUMP1(
"find a pending exception");
1395 DUMP1(
"pending_exception_check0: call rb_jump_tag(retry)");
1398 DUMP1(
"pending_exception_check0: call rb_jump_tag(redo)");
1401 DUMP1(
"pending_exception_check0: call rb_jump_tag(throw)");
1422 DUMP1(
"find a pending exception");
1439 DUMP1(
"pending_exception_check1: call rb_jump_tag(retry)");
1442 DUMP1(
"pending_exception_check1: call rb_jump_tag(redo)");
1445 DUMP1(
"pending_exception_check1: call rb_jump_tag(throw)");
1460 call_original_exit(ptr,
state)
1466 #if TCL_MAJOR_VERSION >= 8
1470 DUMP1(
"original_exit is called");
1472 if (!(ptr->has_orig_exit))
return;
1479 info = &(ptr->orig_exit_info);
1482 #if TCL_MAJOR_VERSION >= 8
1483 state_obj = Tcl_NewIntObj(state);
1486 if (info->isNativeObjectProc) {
1488 #define USE_RUBY_ALLOC 0
1490 argv = (Tcl_Obj **)
ALLOC_N(Tcl_Obj *, 3);
1497 cmd_obj = Tcl_NewStringObj(
"exit", 4);
1501 argv[1] = state_obj;
1502 argv[2] = (Tcl_Obj *)
NULL;
1505 = (*(info->objProc))(info->objClientData, ptr->ip, 2,
argv);
1513 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1523 #undef USE_RUBY_ALLOC
1528 #define USE_RUBY_ALLOC 0
1537 argv[0] = (
char *)
"exit";
1539 argv[1] = Tcl_GetStringFromObj(state_obj, (
int*)
NULL);
1540 argv[2] = (
char *)
NULL;
1542 ptr->return_value = (*(info->proc))(info->clientData, ptr->ip, 2,
argv);
1548 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1558 #undef USE_RUBY_ALLOC
1567 #define USE_RUBY_ALLOC 0
1569 argv = (
char **)
ALLOC_N(
char *, 3);
1578 argv[2] = (
char *)
NULL;
1580 ptr->return_value = (*(info->proc))(info->clientData, ptr->ip,
1587 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1597 #undef USE_RUBY_ALLOC
1600 DUMP1(
"complete original_exit");
1609 static void _timer_for_tcl
_((ClientData));
1619 DUMP1(
"call _timer_for_tcl");
1628 if (timer_tick > 0) {
1629 timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl,
1641 #ifdef RUBY_USE_NATIVE_THREAD
1642 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE
1644 toggle_eventloop_window_mode_for_idle()
1646 if (window_event_mode & TCL_IDLE_EVENTS) {
1648 window_event_mode |= TCL_WINDOW_EVENTS;
1649 window_event_mode &= ~TCL_IDLE_EVENTS;
1653 window_event_mode |= TCL_IDLE_EVENTS;
1654 window_event_mode &= ~TCL_WINDOW_EVENTS;
1662 set_eventloop_window_mode(
self,
mode)
1669 window_event_mode = ~0;
1671 window_event_mode = ~TCL_WINDOW_EVENTS;
1678 get_eventloop_window_mode(
self)
1681 if ( ~window_event_mode ) {
1700 "timer-tick parameter must be 0 or positive number");
1709 timer_tick = req_timer_tick = ttick;
1710 if (timer_tick > 0) {
1712 timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl,
1724 get_eventloop_tick(
self)
1731 ip_set_eventloop_tick(
self, tick)
1735 struct tcltkip *ptr = get_ip(
self);
1738 if (deleted_ip(ptr)) {
1739 return get_eventloop_tick(
self);
1742 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1744 return get_eventloop_tick(
self);
1750 ip_get_eventloop_tick(
self)
1753 return get_eventloop_tick(
self);
1767 "no_event_wait parameter must be positive number");
1770 no_event_wait = t_wait;
1776 get_no_event_wait(
self)
1779 return INT2NUM(no_event_wait);
1783 ip_set_no_event_wait(
self, wait)
1787 struct tcltkip *ptr = get_ip(
self);
1790 if (deleted_ip(ptr)) {
1791 return get_no_event_wait(
self);
1794 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1796 return get_no_event_wait(
self);
1802 ip_get_no_event_wait(
self)
1805 return get_no_event_wait(
self);
1814 int lpmax =
NUM2INT(loop_max);
1819 if (lpmax <= 0 || no_ev <= 0) {
1823 event_loop_max = lpmax;
1824 no_event_tick =
no_ev;
1830 get_eventloop_weight(
self)
1837 ip_set_eventloop_weight(
self, loop_max, no_event)
1842 struct tcltkip *ptr = get_ip(
self);
1845 if (deleted_ip(ptr)) {
1846 return get_eventloop_weight(
self);
1849 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1851 return get_eventloop_weight(
self);
1857 ip_get_eventloop_weight(
self)
1860 return get_eventloop_weight(
self);
1864 set_max_block_time(
self,
time)
1868 struct Tcl_Time tcl_time;
1894 Tcl_SetMaxBlockTime(&tcl_time);
1900 lib_evloop_thread_p(
self)
1903 if (
NIL_P(eventloop_thread)) {
1916 if (event_loop_abort_on_exc > 0) {
1918 }
else if (event_loop_abort_on_exc == 0) {
1926 ip_evloop_abort_on_exc(
self)
1938 event_loop_abort_on_exc = 1;
1940 event_loop_abort_on_exc = -1;
1942 event_loop_abort_on_exc = 0;
1948 ip_evloop_abort_on_exc_set(
self, val)
1951 struct tcltkip *ptr = get_ip(
self);
1956 if (deleted_ip(ptr)) {
1960 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1968 lib_num_of_mainwindows_core(
self,
argc, argv)
1974 return INT2FIX(Tk_GetNumMainWindows());
1981 lib_num_of_mainwindows(
self)
1984 #ifdef RUBY_USE_NATIVE_THREAD
1987 return lib_num_of_mainwindows_core(
self, 0, (
VALUE*)
NULL);
1996 tcl_time.usec = 1000L * (long)no_event_tick;
1997 Tcl_SetMaxBlockTime(&tcl_time);
2007 #ifdef RUBY_USE_NATIVE_THREAD
2009 #ifdef HAVE_PROTOTYPES
2012 call_DoOneEvent_core(flag_val)
2019 if (Tcl_DoOneEvent(flag)) {
2027 #ifdef HAVE_PROTOTYPES
2028 call_DoOneEvent(
VALUE flag_val)
2030 call_DoOneEvent(flag_val)
2039 #ifdef HAVE_PROTOTYPES
2040 call_DoOneEvent(
VALUE flag_val)
2042 call_DoOneEvent(flag_val)
2049 if (Tcl_DoOneEvent(flag)) {
2060 #ifdef HAVE_PROTOTYPES
2061 eventloop_sleep(
VALUE dummy)
2063 eventloop_sleep(dummy)
2069 if (no_event_wait <= 0) {
2074 t.tv_usec = (
int)(no_event_wait*1000.0);
2076 #ifdef HAVE_NATIVETHREAD
2077 #ifndef RUBY_USE_NATIVE_THREAD
2079 rb_bug(
"cross-thread violation on eventloop_sleep()");
2088 #ifdef HAVE_NATIVETHREAD
2089 #ifndef RUBY_USE_NATIVE_THREAD
2091 rb_bug(
"cross-thread violation on eventloop_sleep()");
2100 #define USE_EVLOOP_THREAD_ALONE_CHECK_FLAG 0
2102 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2104 get_thread_alone_check_flag()
2106 #ifdef RUBY_USE_NATIVE_THREAD
2138 #define TRAP_CHECK() do { \
2139 if (trap_check(check_var) == 0) return 0; \
2145 DUMP1(
"trap check");
2149 if (check_var != (
int*)
NULL) {
2158 if (rb_trap_pending) {
2160 if (rb_prohibit_interrupt || check_var != (
int*)
NULL) {
2175 DUMP1(
"check eventloop_interp");
2176 if (eventloop_interp != (Tcl_Interp*)
NULL
2177 && Tcl_InterpDeleted(eventloop_interp)) {
2178 DUMP2(
"eventloop_interp(%p) was deleted", eventloop_interp);
2199 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2200 int thread_alone_check_flag = 1;
2203 if (update_flag)
DUMP1(
"update loop start!!");
2210 if (timer_tick > 0) {
2213 timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl,
2220 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2222 thread_alone_check_flag = get_thread_alone_check_flag();
2228 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2233 DUMP1(
"no other thread");
2234 event_loop_wait_event = 0;
2240 event_flag = TCL_ALL_EVENTS;
2244 if (timer_tick == 0 && update_flag == 0) {
2251 if (check_var != (
int *)
NULL) {
2252 if (*check_var || !found_event) {
2255 if (interp != (Tcl_Interp*)
NULL
2256 && Tcl_InterpDeleted(interp)) {
2264 INT2FIX(event_flag), &status));
2296 DUMP2(
"DoOneEvent(1) abnormal exit!! %d",
2301 DUMP1(
"exception on wait");
2310 if (update_flag != 0) {
2312 DUMP1(
"next update loop");
2315 DUMP1(
"update complete");
2323 DUMP1(
"check Root Widget");
2330 if (loop_counter++ > 30000) {
2338 DUMP1(
"there are other threads");
2339 event_loop_wait_event = 1;
2347 event_flag = TCL_ALL_EVENTS;
2353 while(tick_counter < event_loop_max) {
2354 if (check_var != (
int *)
NULL) {
2355 if (*check_var || !found_event) {
2358 if (interp != (Tcl_Interp*)
NULL
2359 && Tcl_InterpDeleted(interp)) {
2365 if (
NIL_P(eventloop_thread) || current == eventloop_thread) {
2369 #ifdef RUBY_USE_NATIVE_THREAD
2372 INT2FIX(event_flag), &status));
2375 INT2FIX(event_flag & window_event_mode),
2377 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE
2379 if (toggle_eventloop_window_mode_for_idle()) {
2392 INT2FIX(event_flag), &status));
2395 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
2396 if (have_rb_thread_waiting_for_value) {
2397 have_rb_thread_waiting_for_value = 0;
2408 "unknown exception");
2434 DUMP2(
"DoOneEvent(2) abnormal exit!! %d",
2441 if (check_var != (
int*)
NULL
2443 DUMP1(
"exception on wait");
2455 if (update_flag != 0) {
2456 DUMP1(
"update complete");
2472 "unknown exception");
2501 DUMP2(
"sleep eventloop %lx", current);
2502 DUMP2(
"eventloop thread is %lx", eventloop_thread);
2507 if (!
NIL_P(watchdog_thread) && eventloop_thread != current) {
2514 DUMP1(
"check Root Widget");
2521 if (loop_counter++ > 30000) {
2526 if (run_timer_flag) {
2535 DUMP1(
"thread scheduling");
2539 DUMP1(
"check interrupts");
2540 #if defined(RUBY_USE_NATIVE_THREAD) || defined(RUBY_VM)
2560 lib_eventloop_main_core(args)
2580 lib_eventloop_main(args)
2583 return lib_eventloop_main_core(args);
2589 ret =
rb_protect(lib_eventloop_main_core, args, &status);
2615 lib_eventloop_ensure(args)
2623 DUMP2(
"eventloop_ensure: current-thread : %lx", current_evloop);
2624 DUMP2(
"eventloop_ensure: eventloop-thread : %lx", eventloop_thread);
2625 if (eventloop_thread != current_evloop) {
2626 DUMP2(
"finish eventloop %lx (NOT current eventloop)", current_evloop);
2637 DUMP2(
"eventloop-ensure: new eventloop-thread -> %lx",
2640 if (eventloop_thread == current_evloop) {
2642 DUMP2(
"eventloop %lx : back from recursive call", current_evloop);
2646 if (
NIL_P(eventloop_thread)) {
2658 DUMP2(
"eventloop-enshure: wake up parent %lx", eventloop_thread);
2665 #ifdef RUBY_USE_NATIVE_THREAD
2666 if (
NIL_P(eventloop_thread)) {
2667 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2676 DUMP2(
"finish current eventloop %lx", current_evloop);
2694 #ifdef RUBY_USE_NATIVE_THREAD
2695 tk_eventloop_thread_id = Tcl_GetCurrentThread();
2698 if (parent_evloop == eventloop_thread) {
2699 DUMP2(
"eventloop: recursive call on %lx", parent_evloop);
2703 if (!
NIL_P(parent_evloop) && parent_evloop != eventloop_thread) {
2704 DUMP2(
"wait for stop of parent_evloop %lx", parent_evloop);
2706 DUMP2(
"parent_evloop %lx doesn't stop", parent_evloop);
2709 DUMP1(
"succeed to stop parent");
2714 DUMP3(
"tcltklib: eventloop-thread : %lx -> %lx\n",
2715 parent_evloop, eventloop_thread);
2727 lib_eventloop_ensure, (
VALUE)args);
2730 lib_eventloop_ensure, (
VALUE)args);
2735 lib_mainloop(
argc, argv,
self)
2743 check_rootwidget =
Qtrue;
2745 check_rootwidget =
Qtrue;
2747 check_rootwidget =
Qfalse;
2755 ip_mainloop(argc, argv,
self)
2761 struct tcltkip *ptr = get_ip(
self);
2764 if (deleted_ip(ptr)) {
2768 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2773 eventloop_interp = ptr->
ip;
2774 ret = lib_mainloop(argc, argv,
self);
2775 eventloop_interp = (Tcl_Interp*)
NULL;
2781 watchdog_evloop_launcher(check_rootwidget)
2788 #define EVLOOP_WAKEUP_CHANCE 3
2791 lib_watchdog_core(check_rootwidget)
2792 VALUE check_rootwidget;
2817 if (
NIL_P(eventloop_thread)
2820 DUMP2(
"eventloop thread %lx is sleeping or dead",
2823 (
void*)&check_rootwidget);
2824 DUMP2(
"create new eventloop thread %lx", evloop);
2835 if (event_loop_wait_event) {
2848 lib_watchdog_ensure(
arg)
2851 eventloop_thread =
Qnil;
2852 #ifdef RUBY_USE_NATIVE_THREAD
2853 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2868 "eventloop_watchdog is not implemented on Ruby VM.");
2871 if (
rb_scan_args(argc, argv,
"01", &check_rootwidget) == 0) {
2872 check_rootwidget =
Qtrue;
2873 }
else if (
RTEST(check_rootwidget)) {
2874 check_rootwidget =
Qtrue;
2876 check_rootwidget =
Qfalse;
2879 return rb_ensure(lib_watchdog_core, check_rootwidget,
2880 lib_watchdog_ensure,
Qnil);
2884 ip_mainloop_watchdog(argc, argv,
self)
2889 struct tcltkip *ptr = get_ip(
self);
2892 if (deleted_ip(ptr)) {
2896 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2917 _thread_call_proc_core(
arg)
2925 _thread_call_proc_ensure(
arg)
2934 _thread_call_proc(
arg)
2940 _thread_call_proc_ensure, (
VALUE)q);
2944 #ifdef HAVE_PROTOTYPES
2945 _thread_call_proc_value(
VALUE th)
2947 _thread_call_proc_value(th)
2955 lib_thread_callback(argc, argv,
self)
2992 ret =
rb_protect(_thread_call_proc_value, th, &status);
3018 lib_do_one_event_core(argc, argv,
self,
is_ip)
3024 volatile VALUE vflags;
3035 flags = TCL_ALL_EVENTS | TCL_DONT_WAIT;
3042 flags |= TCL_DONT_WAIT;
3047 struct tcltkip *ptr = get_ip(
self);
3050 if (deleted_ip(ptr)) {
3054 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
3056 flags |= TCL_DONT_WAIT;
3061 found_event = Tcl_DoOneEvent(flags);
3075 lib_do_one_event(argc, argv,
self)
3080 return lib_do_one_event_core(argc, argv,
self, 0);
3084 ip_do_one_event(argc, argv,
self)
3089 return lib_do_one_event_core(argc, argv,
self, 0);
3094 ip_set_exc_message(interp, exc)
3103 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
3105 Tcl_Encoding encoding;
3114 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
3120 encoding = (Tcl_Encoding)
NULL;
3139 Tcl_DStringInit(&dstr);
3140 Tcl_DStringFree(&dstr);
3141 Tcl_ExternalToUtfDString(encoding, buf,
RSTRING_LENINT(msg), &dstr);
3144 DUMP2(
"error message:%s", Tcl_DStringValue(&dstr));
3145 Tcl_DStringFree(&dstr);
3186 #ifdef HAVE_PROTOTYPES
3229 DUMP1(
"rb_protect: retry");
3230 exc =
rb_exc_new2(eTkCallbackRetry,
"retry jump error");
3238 DUMP1(
"rb_protect: redo");
3239 exc =
rb_exc_new2(eTkCallbackRedo,
"redo jump error");
3263 DUMP1(
"rb_protect: throw");
3264 exc =
rb_exc_new2(eTkCallbackThrow,
"throw jump error");
3273 sprintf(buf,
"unknown loncaljmp status %d", status);
3292 volatile VALUE backtrace;
3299 DUMP1(
"set backtrace");
3307 ip_set_exc_message(interp, exc);
3309 if (eclass == eTkCallbackReturn)
3312 if (eclass == eTkCallbackBreak)
3315 if (eclass == eTkCallbackContinue)
3316 return TCL_CONTINUE;
3332 if (
SYM2ID(reason) == ID_return)
3335 if (
SYM2ID(reason) == ID_break)
3338 if (
SYM2ID(reason) == ID_next)
3339 return TCL_CONTINUE;
3352 ret = TkStringValue(ret);
3353 DUMP1(
"Tcl_AppendResult");
3365 tcl_protect(interp, proc, data)
3372 #ifdef HAVE_NATIVETHREAD
3373 #ifndef RUBY_USE_NATIVE_THREAD
3375 rb_bug(
"cross-thread violation on tcl_protect()");
3384 int old_trapflag = rb_trap_immediate;
3385 rb_trap_immediate = 0;
3387 rb_trap_immediate = old_trapflag;
3395 #if TCL_MAJOR_VERSION >= 8
3396 ip_ruby_eval(clientData, interp, argc, argv)
3397 ClientData clientData;
3400 Tcl_Obj *
CONST argv[];
3402 ip_ruby_eval(clientData, interp, argc, argv)
3403 ClientData clientData;
3423 "wrong number of arguments (%d for 1)", argc - 1);
3425 char buf[
sizeof(
int)*8 + 1];
3427 sprintf(buf,
"%d", argc-1);
3429 buf,
" for 1)", (
char *)
NULL);
3437 #if TCL_MAJOR_VERSION >= 8
3445 str = Tcl_GetStringFromObj(argv[1], &len);
3459 DUMP2(
"rb_eval_string(%s)", arg);
3463 #if TCL_MAJOR_VERSION >= 8
3474 ip_ruby_cmd_core(arg)
3480 DUMP1(
"call ip_ruby_cmd_core");
3483 ret =
rb_apply(arg->receiver, arg->method, arg->args);
3484 DUMP2(
"rb_apply return:%lx", ret);
3486 DUMP1(
"finish ip_ruby_cmd_core");
3491 #define SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER 1
3494 ip_ruby_cmd_receiver_const_get(
name)
3503 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3522 head = name =
strdup(name);
3525 if (*head ==
':') head += 2;
3546 ip_ruby_cmd_receiver_get(str)
3550 #if !SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3554 if (str[0] ==
':' || (
'A' <= str[0] && str[0] <=
'Z')) {
3556 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3557 receiver = ip_ruby_cmd_receiver_const_get(str);
3559 receiver =
rb_protect(ip_ruby_cmd_receiver_const_get, (
VALUE)str, &state);
3560 if (state)
return Qnil;
3562 }
else if (str[0] ==
'$') {
3574 memcpy(buf + 1, str, len);
3586 #if TCL_MAJOR_VERSION >= 8
3587 ip_ruby_cmd(clientData, interp, argc, argv)
3588 ClientData clientData;
3591 Tcl_Obj *
CONST argv[];
3593 ip_ruby_cmd(clientData, interp, argc, argv)
3594 ClientData clientData;
3611 if (interp == (Tcl_Interp*)
NULL) {
3635 #if TCL_MAJOR_VERSION >= 8
3636 str = Tcl_GetStringFromObj(argv[1], &len);
3640 DUMP2(
"receiver:%s",str);
3642 receiver = ip_ruby_cmd_receiver_get(str);
3646 "unknown class/module/global-variable '%s'", str);
3650 str,
"'", (
char *)
NULL);
3659 #if TCL_MAJOR_VERSION >= 8
3660 str = Tcl_GetStringFromObj(argv[2], &len);
3670 #if TCL_MAJOR_VERSION >= 8
3671 str = Tcl_GetStringFromObj(argv[i], &len);
3677 DUMP2(
"arg:%s",str);
3678 #ifndef HAVE_STRUCT_RARRAY_LEN
3697 code = tcl_protect(interp, ip_ruby_cmd_core, (
VALUE)arg);
3710 #if TCL_MAJOR_VERSION >= 8
3711 #ifdef HAVE_PROTOTYPES
3712 ip_InterpExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3713 int argc, Tcl_Obj *
CONST argv[])
3715 ip_InterpExitObjCmd(clientData, interp, argc, argv)
3716 ClientData clientData;
3719 Tcl_Obj *
CONST argv[];
3722 #ifdef HAVE_PROTOTYPES
3723 ip_InterpExitCommand(ClientData clientData, Tcl_Interp *interp,
3724 int argc,
char *argv[])
3726 ip_InterpExitCommand(clientData, interp, argc, argv)
3727 ClientData clientData;
3734 DUMP1(
"start ip_InterpExitCommand");
3735 if (interp != (Tcl_Interp*)
NULL
3736 && !Tcl_InterpDeleted(interp)
3738 && !ip_null_namespace(interp)
3744 if (!Tcl_InterpDeleted(interp)) {
3747 Tcl_DeleteInterp(interp);
3755 #if TCL_MAJOR_VERSION >= 8
3756 #ifdef HAVE_PROTOTYPES
3757 ip_RubyExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3758 int argc, Tcl_Obj *
CONST argv[])
3760 ip_RubyExitObjCmd(clientData, interp, argc, argv)
3761 ClientData clientData;
3764 Tcl_Obj *
CONST argv[];
3767 #ifdef HAVE_PROTOTYPES
3768 ip_RubyExitCommand(ClientData clientData, Tcl_Interp *interp,
3769 int argc,
char *argv[])
3771 ip_RubyExitCommand(clientData, interp, argc, argv)
3772 ClientData clientData;
3781 #if TCL_MAJOR_VERSION < 8
3786 DUMP1(
"start ip_RubyExitCommand");
3788 #if TCL_MAJOR_VERSION >= 8
3790 cmd = Tcl_GetStringFromObj(argv[0], (
int*)
NULL);
3793 if (argc < 1 || argc > 2) {
3796 "wrong number of arguments: should be \"",
3797 cmd,
" ?returnCode?\"", (
char *)
NULL);
3801 if (interp == (Tcl_Interp*)
NULL)
return TCL_OK;
3806 if (!Tcl_InterpDeleted(interp)) {
3809 Tcl_DeleteInterp(interp);
3819 "fail to call \"", cmd,
"\"", (
char *)
NULL);
3828 #if TCL_MAJOR_VERSION >= 8
3829 if (Tcl_GetIntFromObj(interp, argv[1], &state) ==
TCL_ERROR) {
3833 param = Tcl_GetStringFromObj(argv[1], (
int*)
NULL);
3835 state = (
int)
strtol(argv[1], &endptr, 0);
3838 "expected integer but got \"",
3839 argv[1],
"\"", (
char *)
NULL);
3847 param,
"\"", (
char *)
NULL);
3858 "wrong number of arguments: should be \"",
3859 cmd,
" ?returnCode?\"", (
char *)
NULL);
3872 #if TCL_MAJOR_VERSION >= 8
3873 static int ip_rbUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
3874 Tcl_Obj *
CONST []));
3876 ip_rbUpdateObjCmd(clientData, interp, objc, objv)
3877 ClientData clientData;
3880 Tcl_Obj *
CONST objv[];
3882 static int ip_rbUpdateCommand
_((ClientData, Tcl_Interp *,
int,
char *[]));
3884 ip_rbUpdateCommand(clientData, interp, objc, objv)
3885 ClientData clientData;
3897 DUMP1(
"Ruby's 'update' is called");
3898 if (interp == (Tcl_Interp*)
NULL) {
3903 #ifdef HAVE_NATIVETHREAD
3904 #ifndef RUBY_USE_NATIVE_THREAD
3906 rb_bug(
"cross-thread violation on ip_ruby_eval()");
3914 flags = TCL_DONT_WAIT;
3916 }
else if (objc == 2) {
3917 #if TCL_MAJOR_VERSION >= 8
3918 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
3919 "option", 0, &optionIndex) !=
TCL_OK) {
3922 switch ((
enum updateOptions) optionIndex) {
3924 flags = TCL_IDLE_EVENTS;
3928 rb_bug(
"ip_rbUpdateObjCmd: bad option index to UpdateOptions");
3932 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
3934 "\": must be idletasks", (
char *)
NULL);
3937 flags = TCL_IDLE_EVENTS;
3940 #ifdef Tcl_WrongNumArgs
3941 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
3943 # if TCL_MAJOR_VERSION >= 8
3946 Tcl_GetStringFromObj(objv[0], &dummy),
3951 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
3982 if (rb_trap_pending) {
3998 DUMP1(
"finish Ruby's 'update'");
4011 static void rb_threadUpdateProc
_((ClientData));
4013 rb_threadUpdateProc(clientData)
4014 ClientData clientData;
4018 DUMP1(
"threadUpdateProc is called");
4025 #if TCL_MAJOR_VERSION >= 8
4026 static int ip_rb_threadUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
4027 Tcl_Obj *
CONST []));
4029 ip_rb_threadUpdateObjCmd(clientData, interp, objc, objv)
4030 ClientData clientData;
4033 Tcl_Obj *
CONST objv[];
4035 static int ip_rb_threadUpdateCommand
_((ClientData, Tcl_Interp *,
int,
4038 ip_rb_threadUpdateCommand(clientData, interp, objc, objv)
4039 ClientData clientData;
4048 static CONST char *updateOptions[] = {
"idletasks", (
char *)
NULL};
4053 DUMP1(
"Ruby's 'thread_update' is called");
4054 if (interp == (Tcl_Interp*)
NULL) {
4059 #ifdef HAVE_NATIVETHREAD
4060 #ifndef RUBY_USE_NATIVE_THREAD
4062 rb_bug(
"cross-thread violation on ip_rb_threadUpdateCommand()");
4068 ||
NIL_P(eventloop_thread) || eventloop_thread == current_thread) {
4069 #if TCL_MAJOR_VERSION >= 8
4070 DUMP1(
"call ip_rbUpdateObjCmd");
4071 return ip_rbUpdateObjCmd(clientData, interp, objc, objv);
4073 DUMP1(
"call ip_rbUpdateCommand");
4074 return ip_rbUpdateCommand(clientData, interp, objc, objv);
4078 DUMP1(
"start Ruby's 'thread_update' body");
4083 flags = TCL_DONT_WAIT;
4085 }
else if (objc == 2) {
4086 #if TCL_MAJOR_VERSION >= 8
4087 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
4088 "option", 0, &optionIndex) !=
TCL_OK) {
4091 switch ((
enum updateOptions) optionIndex) {
4093 flags = TCL_IDLE_EVENTS;
4097 rb_bug(
"ip_rb_threadUpdateObjCmd: bad option index to UpdateOptions");
4101 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
4103 "\": must be idletasks", (
char *)
NULL);
4106 flags = TCL_IDLE_EVENTS;
4109 #ifdef Tcl_WrongNumArgs
4110 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
4112 # if TCL_MAJOR_VERSION >= 8
4115 Tcl_GetStringFromObj(objv[0], &dummy),
4120 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
4126 DUMP1(
"pass argument check");
4136 DUMP1(
"set idle proc");
4143 DUMP1(
"wait for complete idle proc");
4147 if (
NIL_P(eventloop_thread)) {
4153 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
4163 DUMP1(
"finish Ruby's 'thread_update'");
4171 #if TCL_MAJOR_VERSION >= 8
4172 static int ip_rbVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4173 Tcl_Obj *
CONST []));
4174 static int ip_rb_threadVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4175 Tcl_Obj *
CONST []));
4176 static int ip_rbTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4177 Tcl_Obj *
CONST []));
4178 static int ip_rb_threadTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4179 Tcl_Obj *
CONST []));
4181 static int ip_rbVwaitCommand
_((ClientData, Tcl_Interp *,
int,
char *[]));
4182 static int ip_rb_threadVwaitCommand
_((ClientData, Tcl_Interp *,
int,
4184 static int ip_rbTkWaitCommand
_((ClientData, Tcl_Interp *,
int,
char *[]));
4185 static int ip_rb_threadTkWaitCommand
_((ClientData, Tcl_Interp *,
int,
4189 #if TCL_MAJOR_VERSION >= 8
4190 static char *VwaitVarProc
_((ClientData, Tcl_Interp *,
4193 VwaitVarProc(clientData, interp, name1, name2, flags)
4194 ClientData clientData;
4200 static char *VwaitVarProc
_((ClientData, Tcl_Interp *,
char *,
char *,
int));
4202 VwaitVarProc(clientData, interp, name1, name2, flags)
4203 ClientData clientData;
4210 int *
donePtr = (
int *) clientData;
4216 #if TCL_MAJOR_VERSION >= 8
4218 ip_rbVwaitObjCmd(clientData, interp, objc, objv)
4219 ClientData clientData;
4222 Tcl_Obj *
CONST objv[];
4225 ip_rbVwaitCommand(clientData, interp, objc, objv)
4226 ClientData clientData;
4237 DUMP1(
"Ruby's 'vwait' is called");
4238 if (interp == (Tcl_Interp*)
NULL) {
4246 && eventloop_thread !=
Qnil
4248 #if TCL_MAJOR_VERSION >= 8
4249 DUMP1(
"call ip_rb_threadVwaitObjCmd");
4250 return ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv);
4252 DUMP1(
"call ip_rb_threadVwaitCommand");
4253 return ip_rb_threadVwaitCommand(clientData, interp, objc, objv);
4259 #ifdef HAVE_NATIVETHREAD
4260 #ifndef RUBY_USE_NATIVE_THREAD
4262 rb_bug(
"cross-thread violation on ip_rbVwaitCommand()");
4270 #ifdef Tcl_WrongNumArgs
4271 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4276 #if TCL_MAJOR_VERSION >= 8
4278 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4280 nameString = objv[0];
4283 nameString,
" name\"", (
char *)
NULL);
4295 #if TCL_MAJOR_VERSION >= 8
4298 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4300 nameString = objv[1];
4310 ret = Tcl_TraceVar(interp, nameString,
4311 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4312 VwaitVarProc, (ClientData) &done);
4317 #if TCL_MAJOR_VERSION >= 8
4332 Tcl_UntraceVar(interp, nameString,
4333 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4334 VwaitVarProc, (ClientData) &done);
4340 #if TCL_MAJOR_VERSION >= 8
4360 if (rb_trap_pending) {
4362 #if TCL_MAJOR_VERSION >= 8
4381 "\": would wait forever", (
char *)
NULL);
4385 #if TCL_MAJOR_VERSION >= 8
4392 #if TCL_MAJOR_VERSION >= 8
4403 #if TCL_MAJOR_VERSION >= 8
4404 static char *WaitVariableProc
_((ClientData, Tcl_Interp *,
4407 WaitVariableProc(clientData, interp, name1, name2, flags)
4408 ClientData clientData;
4414 static char *WaitVariableProc
_((ClientData, Tcl_Interp *,
4415 char *,
char *,
int));
4417 WaitVariableProc(clientData, interp, name1, name2, flags)
4418 ClientData clientData;
4425 int *donePtr = (
int *) clientData;
4428 return (
char *)
NULL;
4431 static void WaitVisibilityProc
_((ClientData, XEvent *));
4433 WaitVisibilityProc(clientData,
eventPtr)
4434 ClientData clientData;
4437 int *donePtr = (
int *) clientData;
4439 if (eventPtr->type == VisibilityNotify) {
4442 if (eventPtr->type == DestroyNotify) {
4447 static void WaitWindowProc
_((ClientData, XEvent *));
4449 WaitWindowProc(clientData, eventPtr)
4450 ClientData clientData;
4453 int *donePtr = (
int *) clientData;
4455 if (eventPtr->type == DestroyNotify) {
4460 #if TCL_MAJOR_VERSION >= 8
4462 ip_rbTkWaitObjCmd(clientData, interp, objc, objv)
4463 ClientData clientData;
4466 Tcl_Obj *
CONST objv[];
4469 ip_rbTkWaitCommand(clientData, interp, objc, objv)
4470 ClientData clientData;
4476 Tk_Window
tkwin = (Tk_Window) clientData;
4486 DUMP1(
"Ruby's 'tkwait' is called");
4487 if (interp == (Tcl_Interp*)
NULL) {
4495 && eventloop_thread !=
Qnil
4497 #if TCL_MAJOR_VERSION >= 8
4498 DUMP1(
"call ip_rb_threadTkWaitObjCmd");
4499 return ip_rb_threadTkWaitObjCmd((ClientData)tkwin, interp, objc, objv);
4501 DUMP1(
"call ip_rb_threadTkWaitCommand");
4502 return ip_rb_threadTkWwaitCommand((ClientData)tkwin, interp, objc, objv);
4511 #ifdef Tcl_WrongNumArgs
4512 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
4517 #if TCL_MAJOR_VERSION >= 8
4519 Tcl_GetStringFromObj(objv[0], &dummy),
4520 " variable|visibility|window name\"",
4524 objv[0],
" variable|visibility|window name\"",
4535 #if TCL_MAJOR_VERSION >= 8
4546 ret = Tcl_GetIndexFromObj(interp, objv[1],
4547 (
CONST84 char **)optionStrings,
4548 "option", 0, &index);
4561 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
4564 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
4567 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
4571 "\": must be variable, visibility, or window",
4582 #if TCL_MAJOR_VERSION >= 8
4585 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
4587 nameString = objv[2];
4603 ret = Tcl_TraceVar(interp, nameString,
4604 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4605 WaitVariableProc, (ClientData) &done);
4610 #if TCL_MAJOR_VERSION >= 8
4624 Tcl_UntraceVar(interp, nameString,
4625 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4626 WaitVariableProc, (ClientData) &done);
4628 #if TCL_MAJOR_VERSION >= 8
4653 if (rb_trap_pending) {
4670 window = Tk_NameToWindow(interp, nameString, tkwin);
4673 if (window == NULL) {
4675 "no main-window (not Tk application?)",
4678 #if TCL_MAJOR_VERSION >= 8
4685 Tk_CreateEventHandler(window,
4686 VisibilityChangeMask|StructureNotifyMask,
4687 WaitVisibilityProc, (ClientData) &done);
4697 #if TCL_MAJOR_VERSION >= 8
4717 if (rb_trap_pending) {
4719 #if TCL_MAJOR_VERSION >= 8
4737 "\" was deleted before its visibility changed",
4742 #if TCL_MAJOR_VERSION >= 8
4752 #if TCL_MAJOR_VERSION >= 8
4756 Tk_DeleteEventHandler(window,
4757 VisibilityChangeMask|StructureNotifyMask,
4758 WaitVisibilityProc, (ClientData) &done);
4772 window = Tk_NameToWindow(interp, nameString, tkwin);
4775 #if TCL_MAJOR_VERSION >= 8
4779 if (window == NULL) {
4781 "no main-window (not Tk application?)",
4788 Tk_CreateEventHandler(window, StructureNotifyMask,
4789 WaitWindowProc, (ClientData) &done);
4816 if (rb_trap_pending) {
4848 #if TCL_MAJOR_VERSION >= 8
4849 static char *rb_threadVwaitProc
_((ClientData, Tcl_Interp *,
4852 rb_threadVwaitProc(clientData, interp, name1, name2, flags)
4853 ClientData clientData;
4859 static char *rb_threadVwaitProc
_((ClientData, Tcl_Interp *,
4860 char *,
char *,
int));
4862 rb_threadVwaitProc(clientData, interp, name1, name2, flags)
4863 ClientData clientData;
4872 if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
4879 return (
char *)
NULL;
4882 #define TKWAIT_MODE_VISIBILITY 1
4883 #define TKWAIT_MODE_DESTROY 2
4885 static void rb_threadWaitVisibilityProc
_((ClientData, XEvent *));
4887 rb_threadWaitVisibilityProc(clientData, eventPtr)
4888 ClientData clientData;
4893 if (eventPtr->type == VisibilityNotify) {
4896 if (eventPtr->type == DestroyNotify) {
4902 static void rb_threadWaitWindowProc
_((ClientData, XEvent *));
4904 rb_threadWaitWindowProc(clientData, eventPtr)
4905 ClientData clientData;
4910 if (eventPtr->type == DestroyNotify) {
4916 #if TCL_MAJOR_VERSION >= 8
4918 ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv)
4919 ClientData clientData;
4922 Tcl_Obj *
CONST objv[];
4925 ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
4926 ClientData clientData;
4939 DUMP1(
"Ruby's 'thread_vwait' is called");
4940 if (interp == (Tcl_Interp*)NULL) {
4947 #if TCL_MAJOR_VERSION >= 8
4948 DUMP1(
"call ip_rbVwaitObjCmd");
4949 return ip_rbVwaitObjCmd(clientData, interp, objc, objv);
4951 DUMP1(
"call ip_rbVwaitCommand");
4952 return ip_rbVwaitCommand(clientData, interp, objc, objv);
4960 #ifdef Tcl_WrongNumArgs
4961 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4966 #if TCL_MAJOR_VERSION >= 8
4968 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4970 nameString = objv[0];
4973 nameString,
" name\"", (
char *) NULL);
4982 #if TCL_MAJOR_VERSION >= 8
4985 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4987 nameString = objv[1];
5007 ret = Tcl_TraceVar(interp, nameString,
5008 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5009 rb_threadVwaitProc, (ClientData) param);
5015 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5025 #if TCL_MAJOR_VERSION >= 8
5035 while(!param->
done) {
5039 if (
NIL_P(eventloop_thread)) {
5047 if (param->
done > 0) {
5048 Tcl_UntraceVar(interp, nameString,
5049 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5050 rb_threadVwaitProc, (ClientData) param);
5054 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5066 #if TCL_MAJOR_VERSION >= 8
5073 #if TCL_MAJOR_VERSION >= 8
5075 ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv)
5076 ClientData clientData;
5079 Tcl_Obj *
CONST objv[];
5082 ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
5083 ClientData clientData;
5090 Tk_Window tkwin = (Tk_Window) clientData;
5093 static CONST char *optionStrings[] = {
"variable",
"visibility",
"window",
5102 DUMP1(
"Ruby's 'thread_tkwait' is called");
5103 if (interp == (Tcl_Interp*)NULL) {
5110 #if TCL_MAJOR_VERSION >= 8
5111 DUMP1(
"call ip_rbTkWaitObjCmd");
5112 DUMP2(
"eventloop_thread %lx", eventloop_thread);
5113 DUMP2(
"current_thread %lx", current_thread);
5114 return ip_rbTkWaitObjCmd(clientData, interp, objc, objv);
5116 DUMP1(
"call rb_VwaitCommand");
5117 return ip_rbTkWaitCommand(clientData, interp, objc, objv);
5127 #ifdef Tcl_WrongNumArgs
5128 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
5133 #if TCL_MAJOR_VERSION >= 8
5135 Tcl_GetStringFromObj(objv[0], &dummy),
5136 " variable|visibility|window name\"",
5140 objv[0],
" variable|visibility|window name\"",
5152 #if TCL_MAJOR_VERSION >= 8
5162 ret = Tcl_GetIndexFromObj(interp, objv[1],
5163 (
CONST84 char **)optionStrings,
5164 "option", 0, &index);
5176 size_t length =
strlen(objv[1]);
5178 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
5181 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
5184 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
5188 "\": must be variable, visibility, or window",
5200 #if TCL_MAJOR_VERSION >= 8
5203 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
5205 nameString = objv[2];
5218 switch ((
enum options) index) {
5229 ret = Tcl_TraceVar(interp, nameString,
5230 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5231 rb_threadVwaitProc, (ClientData) param);
5237 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5247 #if TCL_MAJOR_VERSION >= 8
5259 while(!param->
done) {
5263 if (
NIL_P(eventloop_thread)) {
5271 if (param->
done > 0) {
5272 Tcl_UntraceVar(interp, nameString,
5273 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5274 rb_threadVwaitProc, (ClientData) param);
5277 #if TCL_MAJOR_VERSION >= 8
5293 window = Tk_NameToWindow(interp, nameString, tkwin);
5302 window = Tk_NameToWindow(interp, nameString, tkwin);
5309 if (window == NULL) {
5311 "no main-window (not Tk application?)",
5317 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5327 #if TCL_MAJOR_VERSION >= 8
5336 Tk_CreateEventHandler(window,
5337 VisibilityChangeMask|StructureNotifyMask,
5338 rb_threadWaitVisibilityProc, (ClientData) param);
5350 if (
NIL_P(eventloop_thread)) {
5360 Tk_DeleteEventHandler(window,
5361 VisibilityChangeMask|StructureNotifyMask,
5362 rb_threadWaitVisibilityProc,
5363 (ClientData) param);
5366 if (param->
done != 1) {
5369 "\" was deleted before its visibility changed",
5377 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5387 #if TCL_MAJOR_VERSION >= 8
5398 #if TCL_MAJOR_VERSION >= 8
5414 window = Tk_NameToWindow(interp, nameString, tkwin);
5423 window = Tk_NameToWindow(interp, nameString, tkwin);
5430 #if TCL_MAJOR_VERSION >= 8
5434 if (window == NULL) {
5436 "no main-window (not Tk application?)",
5442 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5459 Tk_CreateEventHandler(window, StructureNotifyMask,
5460 rb_threadWaitWindowProc, (ClientData) param);
5471 if (
NIL_P(eventloop_thread)) {
5492 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5515 ip_thread_vwait(
self,
var)
5529 ip_thread_tkwait(
self, mode,
target)
5546 #if TCL_MAJOR_VERSION >= 8
5557 DUMP1(
"delete slaves");
5561 if (!Tcl_InterpDeleted(ip) &&
Tcl_Eval(ip,
"interp slaves") ==
TCL_OK) {
5562 slave_list = Tcl_GetObjResult(ip);
5565 if (Tcl_ListObjLength((Tcl_Interp*)NULL, slave_list, &len) ==
TCL_OK) {
5566 for(i = 0; i <
len; i++) {
5567 Tcl_ListObjIndex((Tcl_Interp*)NULL, slave_list, i, &elem);
5569 if (elem == (Tcl_Obj*)NULL)
continue;
5575 slave_name = Tcl_GetStringFromObj(elem, (
int*)NULL);
5576 DUMP2(
"delete slave:'%s'", slave_name);
5580 slave = Tcl_GetSlave(ip, slave_name);
5581 if (slave == (Tcl_Interp*)NULL)
continue;
5583 if (!Tcl_InterpDeleted(slave)) {
5587 Tcl_DeleteInterp(slave);
5611 DUMP1(
"delete slaves");
5616 slave_list = ip->result;
5617 if (Tcl_SplitList((Tcl_Interp*)NULL,
5618 slave_list, &argc, &argv) ==
TCL_OK) {
5619 for(i = 0; i <
argc; i++) {
5620 slave_name = argv[
i];
5622 DUMP2(
"delete slave:'%s'", slave_name);
5624 slave = Tcl_GetSlave(ip, slave_name);
5625 if (slave == (Tcl_Interp*)NULL)
continue;
5627 if (!Tcl_InterpDeleted(slave)) {
5631 Tcl_DeleteInterp(slave);
5644 #ifdef HAVE_PROTOTYPES
5645 lib_mark_at_exit(
VALUE self)
5647 lib_mark_at_exit(
self)
5655 #if TCL_MAJOR_VERSION >= 8
5656 #ifdef HAVE_PROTOTYPES
5657 ip_null_proc(ClientData clientData, Tcl_Interp *interp,
5658 int argc, Tcl_Obj *
CONST argv[])
5660 ip_null_proc(clientData, interp, argc, argv)
5661 ClientData clientData;
5664 Tcl_Obj *
CONST argv[];
5667 #ifdef HAVE_PROTOTYPES
5668 ip_null_proc(ClientData clientData, Tcl_Interp *interp,
int argc,
char *argv[])
5670 ip_null_proc(clientData, interp, argc, argv)
5671 ClientData clientData;
5697 DUMP1(
"start ip_finalize");
5699 if (ip == (Tcl_Interp*)NULL) {
5700 DUMP1(
"ip is NULL");
5704 if (Tcl_InterpDeleted(ip)) {
5705 DUMP2(
"ip(%p) is already deleted", ip);
5709 #if TCL_NAMESPACE_DEBUG
5710 if (ip_null_namespace(ip)) {
5711 DUMP2(
"ip(%p) has null namespace", ip);
5733 #if TCL_MAJOR_VERSION >= 8
5734 Tcl_CreateObjCommand(ip,
"ruby", ip_null_proc,
5735 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5736 Tcl_CreateObjCommand(ip,
"ruby_eval", ip_null_proc,
5737 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5738 Tcl_CreateObjCommand(ip,
"ruby_cmd", ip_null_proc,
5739 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5742 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5744 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5746 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5758 DUMP1(
"check `destroy'");
5760 DUMP1(
"call `destroy .'");
5765 DUMP1(
"destroy root widget");
5779 Tk_Window win = Tk_MainWindow(ip);
5781 DUMP1(
"call Tk_DestroyWindow");
5784 if (! (((Tk_FakeWin*)win)->flags & TK_ALREADY_DEAD)) {
5785 Tk_DestroyWindow(win);
5793 DUMP1(
"check `finalize-hook-proc'");
5795 DUMP2(
"call finalize hook proc '%s'", finalize_hook_name);
5803 DUMP1(
"check `foreach' & `after'");
5806 DUMP1(
"cancel after callbacks");
5809 Tcl_GlobalEval(ip,
"catch {foreach id [after info] {after cancel $id}}");
5816 DUMP1(
"finish ip_finalize");
5830 DUMP2(
"free Tcl Interp %lx", (
unsigned long)ptr->ip);
5835 if ( ptr->ip != (Tcl_Interp*)NULL
5836 && !Tcl_InterpDeleted(ptr->ip)
5837 && Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL
5838 && !Tcl_InterpDeleted(Tcl_GetMaster(ptr->ip)) ) {
5839 DUMP2(
"parent IP(%lx) is not deleted",
5840 (
unsigned long)Tcl_GetMaster(ptr->ip));
5841 DUMP2(
"slave IP(%lx) should not be deleted",
5842 (
unsigned long)ptr->ip);
5849 if (ptr->ip == (Tcl_Interp*)NULL) {
5850 DUMP1(
"ip_free is called for deleted IP");
5857 if (!Tcl_InterpDeleted(ptr->ip)) {
5860 Tcl_DeleteInterp(ptr->ip);
5864 ptr->ip = (Tcl_Interp*)NULL;
5871 DUMP1(
"complete freeing Tcl Interp");
5890 #if TCL_MAJOR_VERSION >= 8
5891 DUMP1(
"Tcl_CreateObjCommand(\"vwait\")");
5892 Tcl_CreateObjCommand(interp,
"vwait", ip_rbVwaitObjCmd,
5893 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5895 DUMP1(
"Tcl_CreateCommand(\"vwait\")");
5897 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5901 #if TCL_MAJOR_VERSION >= 8
5902 DUMP1(
"Tcl_CreateObjCommand(\"tkwait\")");
5903 Tcl_CreateObjCommand(interp,
"tkwait", ip_rbTkWaitObjCmd,
5904 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5906 DUMP1(
"Tcl_CreateCommand(\"tkwait\")");
5908 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5912 #if TCL_MAJOR_VERSION >= 8
5913 DUMP1(
"Tcl_CreateObjCommand(\"thread_vwait\")");
5914 Tcl_CreateObjCommand(interp,
"thread_vwait", ip_rb_threadVwaitObjCmd,
5915 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5917 DUMP1(
"Tcl_CreateCommand(\"thread_vwait\")");
5919 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5923 #if TCL_MAJOR_VERSION >= 8
5924 DUMP1(
"Tcl_CreateObjCommand(\"thread_tkwait\")");
5925 Tcl_CreateObjCommand(interp,
"thread_tkwait", ip_rb_threadTkWaitObjCmd,
5926 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5928 DUMP1(
"Tcl_CreateCommand(\"thread_tkwait\")");
5930 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5934 #if TCL_MAJOR_VERSION >= 8
5935 DUMP1(
"Tcl_CreateObjCommand(\"update\")");
5936 Tcl_CreateObjCommand(interp,
"update", ip_rbUpdateObjCmd,
5937 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5939 DUMP1(
"Tcl_CreateCommand(\"update\")");
5941 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5945 #if TCL_MAJOR_VERSION >= 8
5946 DUMP1(
"Tcl_CreateObjCommand(\"thread_update\")");
5947 Tcl_CreateObjCommand(interp,
"thread_update", ip_rb_threadUpdateObjCmd,
5948 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5950 DUMP1(
"Tcl_CreateCommand(\"thread_update\")");
5952 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5957 #if TCL_MAJOR_VERSION >= 8
5959 ip_rb_replaceSlaveTkCmdsObjCmd(clientData, interp, objc, objv)
5960 ClientData clientData;
5963 Tcl_Obj *
CONST objv[];
5966 ip_rb_replaceSlaveTkCmdsCommand(clientData, interp, objc, objv)
5967 ClientData clientData;
5978 #ifdef Tcl_WrongNumArgs
5979 Tcl_WrongNumArgs(interp, 1, objv,
"slave_name");
5982 #if TCL_MAJOR_VERSION >= 8
5983 nameString = Tcl_GetStringFromObj(objv[0], (
int*)NULL);
5985 nameString = objv[0];
5988 nameString,
" slave_name\"", (
char *) NULL);
5992 #if TCL_MAJOR_VERSION >= 8
5993 slave_name = Tcl_GetStringFromObj(objv[1], (
int*)NULL);
5995 slave_name = objv[1];
5998 slave = Tcl_GetSlave(interp, slave_name);
5999 if (slave == NULL) {
6001 slave_name,
"\"", (
char *)NULL);
6004 mainWin = Tk_MainWindow(slave);
6007 #if TCL_MAJOR_VERSION >= 8
6008 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6009 Tcl_CreateObjCommand(slave,
"exit", ip_InterpExitObjCmd,
6010 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6012 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6014 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6024 #if TCL_MAJOR_VERSION >= 8
6025 static int ip_rbNamespaceObjCmd
_((ClientData, Tcl_Interp *,
int,
6026 Tcl_Obj *
CONST []));
6028 ip_rbNamespaceObjCmd(clientData, interp, objc, objv)
6029 ClientData clientData;
6032 Tcl_Obj *
CONST objv[];
6040 "invalid command name \"namespace\"", (
char*)NULL);
6047 if (info.isNativeObjectProc) {
6060 for(i = 0; i <
objc; i++) {
6062 argv[
i] = Tcl_GetStringFromObj(objv[i], (
int*)NULL);
6064 argv[
objc] = (
char *)NULL;
6066 ret = (*(info.proc))(info.clientData,
interp,
6070 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
6092 #if TCL_MAJOR_VERSION >= 8
6093 Tcl_CmdInfo orig_info;
6099 if (orig_info.isNativeObjectProc) {
6100 Tcl_CreateObjCommand(interp,
"__orig_namespace_command__",
6101 orig_info.objProc, orig_info.objClientData,
6102 orig_info.deleteProc);
6105 orig_info.proc, orig_info.clientData,
6106 orig_info.deleteProc);
6109 Tcl_CreateObjCommand(interp,
"namespace", ip_rbNamespaceObjCmd,
6110 (ClientData) 0, (Tcl_CmdDeleteProc *)NULL);
6117 #ifdef HAVE_PROTOTYPES
6118 ip_CallWhenDeleted(ClientData clientData, Tcl_Interp *ip)
6120 ip_CallWhenDeleted(clientData, ip)
6121 ClientData clientData;
6128 DUMP1(
"start ip_CallWhenDeleted");
6134 DUMP1(
"finish ip_CallWhenDeleted");
6142 ip_init(argc, argv,
self)
6152 Tk_Window mainWin = (Tk_Window)NULL;
6157 "Cannot create a TclTkIp object at level %d",
6166 #ifdef RUBY_USE_NATIVE_THREAD
6167 ptr->tk_thread_id = 0;
6174 DUMP1(
"Tcl_CreateInterp");
6176 if (ptr->
ip == NULL) {
6197 #if TCL_MAJOR_VERSION >= 8
6198 #if TCL_NAMESPACE_DEBUG
6199 DUMP1(
"get current namespace");
6200 if ((ptr->default_ns = Tcl_GetCurrentNamespace(ptr->
ip))
6201 == (Tcl_Namespace*)NULL) {
6209 current_interp = ptr->
ip;
6214 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
6215 call_tclkit_init_script(current_interp);
6217 # if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
6219 Tcl_DString encodingName;
6220 Tcl_GetEncodingNameFromEnvironment(&encodingName);
6221 if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(NULL))) {
6223 Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName));
6225 Tcl_SetVar(current_interp,
"tclkit_system_encoding", Tcl_DStringValue(&encodingName), 0);
6226 Tcl_DStringFree(&encodingName);
6232 Tcl_Eval(ptr->
ip,
"set argc 0; set argv {}; set argv0 tcltklib.so");
6244 Tcl_Eval(ptr->
ip,
"set argc [llength $argv]");
6248 if (!
NIL_P(argv0)) {
6251 Tcl_SetVar(ptr->
ip,
"argv0",
"ruby", TCL_GLOBAL_ONLY);
6265 #if (defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT) && (!defined KIT_LITE) && (10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION == 85)
6272 Tcl_Eval(ptr->
ip,
"catch {rename ::chan ::_tmp_chan}");
6276 Tcl_Eval(ptr->
ip,
"catch {rename ::_tmp_chan ::chan}");
6303 DUMP1(
"Tcl_StaticPackage(\"Tk\")");
6304 #if TCL_MAJOR_VERSION >= 8
6305 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init, Tk_SafeInit);
6307 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init,
6308 (Tcl_PackageInitProc *) NULL);
6311 #ifdef RUBY_USE_NATIVE_THREAD
6313 ptr->tk_thread_id = Tcl_GetCurrentThread();
6316 mainWin = Tk_MainWindow(ptr->
ip);
6317 Tk_Preserve((ClientData)mainWin);
6321 #if TCL_MAJOR_VERSION >= 8
6322 DUMP1(
"Tcl_CreateObjCommand(\"ruby\")");
6323 Tcl_CreateObjCommand(ptr->
ip,
"ruby", ip_ruby_eval, (ClientData)NULL,
6324 (Tcl_CmdDeleteProc *)NULL);
6325 DUMP1(
"Tcl_CreateObjCommand(\"ruby_eval\")");
6326 Tcl_CreateObjCommand(ptr->
ip,
"ruby_eval", ip_ruby_eval, (ClientData)NULL,
6327 (Tcl_CmdDeleteProc *)NULL);
6328 DUMP1(
"Tcl_CreateObjCommand(\"ruby_cmd\")");
6329 Tcl_CreateObjCommand(ptr->
ip,
"ruby_cmd", ip_ruby_cmd, (ClientData)NULL,
6330 (Tcl_CmdDeleteProc *)NULL);
6332 DUMP1(
"Tcl_CreateCommand(\"ruby\")");
6334 (Tcl_CmdDeleteProc *)NULL);
6335 DUMP1(
"Tcl_CreateCommand(\"ruby_eval\")");
6337 (Tcl_CmdDeleteProc *)NULL);
6338 DUMP1(
"Tcl_CreateCommand(\"ruby_cmd\")");
6340 (Tcl_CmdDeleteProc *)NULL);
6344 #if TCL_MAJOR_VERSION >= 8
6345 DUMP1(
"Tcl_CreateObjCommand(\"interp_exit\")");
6346 Tcl_CreateObjCommand(ptr->
ip,
"interp_exit", ip_InterpExitObjCmd,
6347 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6348 DUMP1(
"Tcl_CreateObjCommand(\"ruby_exit\")");
6349 Tcl_CreateObjCommand(ptr->
ip,
"ruby_exit", ip_RubyExitObjCmd,
6350 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6351 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6352 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6353 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6355 DUMP1(
"Tcl_CreateCommand(\"interp_exit\")");
6357 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6358 DUMP1(
"Tcl_CreateCommand(\"ruby_exit\")");
6360 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6361 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6363 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6373 #if TCL_MAJOR_VERSION >= 8
6374 Tcl_CreateObjCommand(ptr->
ip,
"__replace_slave_tk_commands__",
6375 ip_rb_replaceSlaveTkCmdsObjCmd,
6376 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6379 ip_rb_replaceSlaveTkCmdsCommand,
6380 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6386 if (mainWin != (Tk_Window)NULL) {
6387 Tk_Release((ClientData)mainWin);
6394 ip_create_slave_core(interp, argc, argv)
6409 if (deleted_ip(master)) {
6411 "deleted master cannot create a new slave");
6417 if (Tcl_IsSafe(master->
ip) == 1) {
6431 if (
RTEST(with_tk)) {
6434 exc = tcltkip_init_tk(interp);
6444 #ifdef RUBY_USE_NATIVE_THREAD
6446 slave->tk_thread_id = master->tk_thread_id;
6456 "fail to create the new slave interpreter");
6458 #if TCL_MAJOR_VERSION >= 8
6459 #if TCL_NAMESPACE_DEBUG
6460 slave->default_ns = Tcl_GetCurrentNamespace(slave->
ip);
6470 #if TCL_MAJOR_VERSION >= 8
6471 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6472 Tcl_CreateObjCommand(slave->
ip,
"exit", ip_InterpExitObjCmd,
6473 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6475 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6477 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6487 #if TCL_MAJOR_VERSION >= 8
6488 Tcl_CreateObjCommand(slave->
ip,
"__replace_slave_tk_commands__",
6489 ip_rb_replaceSlaveTkCmdsObjCmd,
6490 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6493 ip_rb_replaceSlaveTkCmdsCommand,
6494 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6506 ip_create_slave(argc, argv,
self)
6511 struct tcltkip *master = get_ip(
self);
6517 if (deleted_ip(master)) {
6519 "deleted master cannot create a new slave interpreter");
6526 if (Tcl_IsSafe(master->
ip) != 1
6535 return tk_funcall(ip_create_slave_core, 2, callargv,
self);
6541 ip_is_slave_of_p(
self, master)
6548 if (Tcl_GetMaster(get_ip(
self)->ip) == get_ip(master)->ip) {
6557 #if defined(MAC_TCL) || defined(__WIN32__)
6558 #if TCL_MAJOR_VERSION < 8 \
6559 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) \
6560 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6561 && (TCL_RELEASE_LEVEL == TCL_ALPHA_RELEASE \
6562 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \
6563 && TCL_RELEASE_SERIAL < 2) ) )
6564 EXTERN void TkConsoleCreate
_((
void));
6566 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6567 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \
6568 && TCL_RELEASE_SERIAL == 0) \
6569 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \
6570 && TCL_RELEASE_SERIAL >= 2) )
6571 EXTERN void TkConsoleCreate_
_((
void));
6575 ip_create_console_core(interp, argc, argv)
6580 struct tcltkip *ptr = get_ip(interp);
6583 tcltkip_init_tk(interp);
6586 if (Tcl_GetVar(ptr->
ip,
"tcl_interactive",TCL_GLOBAL_ONLY) == (
char*)NULL) {
6587 Tcl_SetVar(ptr->
ip,
"tcl_interactive",
"0", TCL_GLOBAL_ONLY);
6590 #if TCL_MAJOR_VERSION > 8 \
6591 || (TCL_MAJOR_VERSION == 8 \
6592 && (TCL_MINOR_VERSION > 1 \
6593 || (TCL_MINOR_VERSION == 1 \
6594 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \
6595 && TCL_RELEASE_SERIAL >= 1) ) )
6596 Tk_InitConsoleChannels(ptr->
ip);
6598 if (Tk_CreateConsoleWindow(ptr->
ip) !=
TCL_OK) {
6602 #if defined(MAC_TCL) || defined(__WIN32__)
6603 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6604 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE && TCL_RELEASE_SERIAL == 0) \
6605 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE && TCL_RELEASE_SERIAL >= 2) )
6611 if (TkConsoleInit(ptr->
ip) !=
TCL_OK) {
6623 ip_create_console(
self)
6626 struct tcltkip *ptr = get_ip(
self);
6629 if (deleted_ip(ptr)) {
6638 ip_make_safe_core(interp, argc, argv)
6643 struct tcltkip *ptr = get_ip(interp);
6647 if (deleted_ip(ptr)) {
6662 #if TCL_MAJOR_VERSION >= 8
6663 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6664 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6665 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6667 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6669 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6679 struct tcltkip *ptr = get_ip(
self);
6682 if (deleted_ip(ptr)) {
6694 struct tcltkip *ptr = get_ip(
self);
6697 if (deleted_ip(ptr)) {
6701 if (Tcl_IsSafe(ptr->
ip)) {
6710 ip_allow_ruby_exit_p(
self)
6713 struct tcltkip *ptr = get_ip(
self);
6716 if (deleted_ip(ptr)) {
6729 ip_allow_ruby_exit_set(
self, val)
6732 struct tcltkip *ptr = get_ip(
self);
6738 if (deleted_ip(ptr)) {
6742 if (Tcl_IsSafe(ptr->
ip)) {
6744 "insecure operation on a safe interpreter");
6757 #if TCL_MAJOR_VERSION >= 8
6758 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6759 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6760 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6762 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6764 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6770 #if TCL_MAJOR_VERSION >= 8
6771 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6772 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6773 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6775 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6777 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6789 struct tcltkip *ptr = get_ip(
self);
6792 if (deleted_ip(ptr)) {
6793 DUMP1(
"delete deleted IP");
6800 DUMP1(
"delete interp");
6801 if (!Tcl_InterpDeleted(ptr->
ip)) {
6802 DUMP1(
"call ip_finalize");
6805 Tcl_DeleteInterp(ptr->
ip);
6817 ip_has_invalid_namespace_p(
self)
6820 struct tcltkip *ptr = get_ip(
self);
6822 if (ptr == (
struct tcltkip *)NULL || ptr->
ip == (Tcl_Interp *)NULL) {
6827 #if TCL_NAMESPACE_DEBUG
6828 if (rbtk_invalid_namespace(ptr)) {
6839 ip_is_deleted_p(
self)
6842 struct tcltkip *ptr = get_ip(
self);
6844 if (deleted_ip(ptr)) {
6852 ip_has_mainwindow_p_core(
self, argc, argv)
6857 struct tcltkip *ptr = get_ip(
self);
6861 }
else if (Tk_MainWindow(ptr->
ip) == (Tk_Window)NULL) {
6869 ip_has_mainwindow_p(
self)
6877 #if TCL_MAJOR_VERSION >= 8
6879 get_str_from_obj(
obj)
6882 int len, binary = 0;
6886 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
6887 s = Tcl_GetStringFromObj(obj, &len);
6889 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 3
6891 if (Tcl_GetCharLength(obj) != Tcl_UniCharLen(Tcl_GetUnicode(obj))) {
6893 s = (
char *)Tcl_GetByteArrayFromObj(obj, &len);
6897 s = Tcl_GetStringFromObj(obj, &len);
6900 if (IS_TCL_BYTEARRAY(obj)) {
6901 s = (
char *)Tcl_GetByteArrayFromObj(obj, &len);
6904 s = Tcl_GetStringFromObj(obj, &len);
6911 #ifdef HAVE_RUBY_ENCODING_H
6914 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
6915 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
6917 #ifdef HAVE_RUBY_ENCODING_H
6927 get_obj_from_str(str)
6932 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
6933 return Tcl_NewStringObj((
char*)s,
RSTRING_LEN(str));
6941 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6946 #ifdef HAVE_RUBY_ENCODING_H
6949 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6953 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6966 #if TCL_MAJOR_VERSION >= 8
6970 retObj = Tcl_GetObjResult(interp);
6972 strval = get_str_from_obj(retObj);
6984 callq_safelevel_handler(arg,
callq)
6996 static int call_queue_handler
_((Tcl_Event *,
int));
6998 call_queue_handler(
evPtr, flags)
7008 DUMP2(
"do_call_queue_handler : evPtr = %p", evPtr);
7010 DUMP2(
"added by thread : %lx", thread);
7013 DUMP1(
"processed by another event-loop");
7016 DUMP1(
"process it on current event-loop");
7026 DUMP1(
"caller is not yet ready to receive the result -> pending");
7035 if (deleted_ip(ptr)) {
7050 q_dat = (
VALUE)NULL;
7052 DUMP2(
"call function (for caller thread:%lx)", thread);
7079 DUMP2(
"back to caller (caller thread:%lx)", thread);
7081 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
7082 have_rb_thread_waiting_for_value = 1;
7087 DUMP1(
"finish back to caller");
7088 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
7092 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7119 ptr = get_ip(ip_obj);
7120 if (deleted_ip(ptr))
return Qnil;
7125 #ifdef RUBY_USE_NATIVE_THREAD
7128 is_tk_evloop_thread = (ptr->tk_thread_id == (Tcl_ThreadId) 0
7129 || ptr->tk_thread_id == Tcl_GetCurrentThread());
7132 is_tk_evloop_thread = (tk_eventloop_thread_id == (Tcl_ThreadId) 0
7133 || tk_eventloop_thread_id == Tcl_GetCurrentThread());
7136 is_tk_evloop_thread = 1;
7139 if (is_tk_evloop_thread
7142 if (
NIL_P(eventloop_thread)) {
7143 DUMP2(
"tk_funcall from thread:%lx but no eventloop", current);
7145 DUMP2(
"tk_funcall from current eventloop %lx", current);
7147 result = (
func)(ip_obj, argc, argv);
7154 DUMP2(
"tk_funcall from thread %lx (NOT current eventloop)", current);
7197 callq->
ev.proc = call_queue_handler;
7200 DUMP1(
"add handler");
7201 #ifdef RUBY_USE_NATIVE_THREAD
7202 if (ptr && ptr->tk_thread_id) {
7205 Tcl_ThreadQueueEvent(ptr->tk_thread_id,
7206 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7207 Tcl_ThreadAlert(ptr->tk_thread_id);
7208 }
else if (tk_eventloop_thread_id) {
7211 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
7212 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7213 Tcl_ThreadAlert(tk_eventloop_thread_id);
7229 DUMP2(
"callq wait for handler (current thread:%lx)", current);
7230 while(*alloc_done >= 0) {
7231 DUMP2(
"*** callq wait for handler (current thread:%lx)", current);
7235 DUMP2(
"*** callq wakeup (current thread:%lx)", current);
7236 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
7238 DUMP1(
"*** callq lost eventloop thread");
7242 DUMP2(
"back from handler (current thread:%lx)", current);
7247 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7253 ckfree((
char*)alloc_done);
7260 for(i = 0; i <
argc; i++) { argv[
i] = (
VALUE)NULL; }
7263 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
7283 DUMP1(
"raise exception");
7289 DUMP1(
"exit tk_funcall");
7295 #if TCL_MAJOR_VERSION >= 8
7296 struct call_eval_info {
7302 #ifdef HAVE_PROTOTYPES
7303 call_tcl_eval(
VALUE arg)
7309 struct call_eval_info *
inf = (
struct call_eval_info *)arg;
7312 inf->ptr->return_value = Tcl_EvalObj(inf->ptr->ip, inf->cmd);
7325 struct tcltkip *ptr = get_ip(
self);
7328 #if TCL_MAJOR_VERSION >= 8
7336 cmd = Tcl_NewStringObj(cmd_str, cmd_len);
7340 if (deleted_ip(ptr)) {
7347 struct call_eval_info inf;
7363 "unknown exception");
7383 if (pending_exception_check1(thr_crit_bup, ptr)) {
7390 if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->
ip)) {
7395 exc = create_ip_exc(
self, eTkCallbackReturn,
7396 "ip_eval_real receives TCL_RETURN");
7398 exc = create_ip_exc(
self, eTkCallbackBreak,
7399 "ip_eval_real receives TCL_BREAK");
7401 exc = create_ip_exc(
self, eTkCallbackContinue,
7402 "ip_eval_real receives TCL_CONTINUE");
7412 if (event_loop_abort_on_exc < 0) {
7431 DUMP2(
"Tcl_Eval(%s)", cmd_str);
7434 if (deleted_ip(ptr)) {
7444 if (pending_exception_check1(thr_crit_bup, ptr)) {
7455 exc = create_ip_exc(
self, eTkCallbackReturn,
7456 "ip_eval_real receives TCL_RETURN");
7458 exc = create_ip_exc(
self, eTkCallbackBreak,
7459 "ip_eval_real receives TCL_BREAK");
7461 exc = create_ip_exc(
self, eTkCallbackContinue,
7462 "ip_eval_real receives TCL_CONTINUE");
7480 evq_safelevel_handler(arg,
evq)
7492 int eval_queue_handler
_((Tcl_Event *,
int));
7494 eval_queue_handler(evPtr, flags)
7504 DUMP2(
"do_eval_queue_handler : evPtr = %p", evPtr);
7506 DUMP2(
"added by thread : %lx", thread);
7509 DUMP1(
"processed by another event-loop");
7512 DUMP1(
"process it on current event-loop");
7522 DUMP1(
"caller is not yet ready to receive the result -> pending");
7531 if (deleted_ip(ptr)) {
7541 #ifdef HAVE_NATIVETHREAD
7542 #ifndef RUBY_USE_NATIVE_THREAD
7544 rb_bug(
"cross-thread violation on eval_queue_handler()");
7553 q_dat = (
VALUE)NULL;
7579 DUMP2(
"back to caller (caller thread:%lx)", thread);
7581 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
7582 have_rb_thread_waiting_for_value = 1;
7587 DUMP1(
"finish back to caller");
7588 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
7592 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7606 #ifdef RUBY_USE_NATIVE_THREAD
7613 volatile VALUE ip_obj =
self;
7624 #ifdef RUBY_USE_NATIVE_THREAD
7625 ptr = get_ip(ip_obj);
7626 DUMP2(
"eval status: ptr->tk_thread_id %p", ptr->tk_thread_id);
7627 DUMP2(
"eval status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7629 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7631 DUMP2(
"status: eventloopt_thread %lx", eventloop_thread);
7634 #ifdef RUBY_USE_NATIVE_THREAD
7635 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
7638 (
NIL_P(eventloop_thread) || current == eventloop_thread)
7640 if (
NIL_P(eventloop_thread)) {
7641 DUMP2(
"eval from thread:%lx but no eventloop", current);
7643 DUMP2(
"eval from current eventloop %lx", current);
7652 DUMP2(
"eval from thread %lx (NOT current eventloop)", current);
7691 evq->
ev.proc = eval_queue_handler;
7693 position = TCL_QUEUE_TAIL;
7696 DUMP1(
"add handler");
7697 #ifdef RUBY_USE_NATIVE_THREAD
7698 if (ptr->tk_thread_id) {
7700 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)evq, position);
7701 Tcl_ThreadAlert(ptr->tk_thread_id);
7702 }
else if (tk_eventloop_thread_id) {
7703 Tcl_ThreadQueueEvent(tk_eventloop_thread_id, (Tcl_Event*)evq, position);
7706 Tcl_ThreadAlert(tk_eventloop_thread_id);
7722 DUMP2(
"evq wait for handler (current thread:%lx)", current);
7723 while(*alloc_done >= 0) {
7724 DUMP2(
"*** evq wait for handler (current thread:%lx)", current);
7728 DUMP2(
"*** evq wakeup (current thread:%lx)", current);
7729 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
7730 if (
NIL_P(eventloop_thread)) {
7731 DUMP1(
"*** evq lost eventloop thread");
7735 DUMP2(
"back from handler (current thread:%lx)", current);
7741 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7747 ckfree((
char*)alloc_done);
7751 Tcl_EventuallyFree((ClientData)eval_str, TCL_DYNAMIC);
7769 DUMP1(
"raise exception");
7780 ip_cancel_eval_core(interp, msg, flag)
7785 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6)
7787 "cancel_eval is supported Tcl/Tk8.6 or later.");
7800 return Tcl_CancelEval(interp, msg_obj, 0, flag);
7805 ip_cancel_eval(argc, argv,
self)
7815 if (ip_cancel_eval_core(get_ip(
self)->ip, retval, 0) ==
TCL_OK) {
7822 #ifndef TCL_CANCEL_UNWIND
7823 #define TCL_CANCEL_UNWIND 0x100000
7826 ip_cancel_eval_unwind(argc, argv,
self)
7839 if (ip_cancel_eval_core(get_ip(
self)->ip, retval, flag) ==
TCL_OK) {
7848 lib_restart_core(interp, argc, argv)
7854 struct tcltkip *ptr = get_ip(interp);
7862 if (deleted_ip(ptr)) {
7878 #if TCL_MAJOR_VERSION >= 8
7893 exc = tcltkip_init_tk(interp);
7913 struct tcltkip *ptr = get_ip(
self);
7920 if (deleted_ip(ptr)) {
7932 struct tcltkip *ptr = get_ip(
self);
7939 if (deleted_ip(ptr)) {
7943 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)NULL) {
7960 Tcl_Encoding encoding;
7975 if (
NIL_P(ip_obj)) {
7976 interp = (Tcl_Interp *)NULL;
7978 ptr = get_ip(ip_obj);
7981 if (deleted_ip(ptr)) {
7982 interp = (Tcl_Interp *)NULL;
7991 if (
NIL_P(encodename)) {
7995 #ifdef HAVE_RUBY_ENCODING_H
8001 if (
NIL_P(ip_obj)) {
8002 encoding = (Tcl_Encoding)NULL;
8006 encoding = (Tcl_Encoding)NULL;
8012 encoding = (Tcl_Encoding)NULL;
8014 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8016 if (encoding == (Tcl_Encoding)NULL) {
8025 #ifdef HAVE_RUBY_ENCODING_H
8028 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8033 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8035 if (encoding == (Tcl_Encoding)NULL) {
8040 encoding = (Tcl_Encoding)NULL;
8044 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8045 #ifdef HAVE_RUBY_ENCODING_H
8048 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8053 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(encodename));
8054 if (encoding == (Tcl_Encoding)NULL) {
8074 Tcl_DStringInit(&dstr);
8075 Tcl_DStringFree(&dstr);
8077 Tcl_ExternalToUtfDString(encoding, buf,
RSTRING_LENINT(str), &dstr);
8081 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8082 #ifdef HAVE_RUBY_ENCODING_H
8093 Tcl_DStringFree(&dstr);
8105 lib_toUTF8(argc, argv,
self)
8119 ip_toUTF8(argc, argv,
self)
8126 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8142 Tcl_Encoding encoding;
8156 if (
NIL_P(ip_obj)) {
8157 interp = (Tcl_Interp *)NULL;
8158 }
else if (get_ip(ip_obj) == (
struct tcltkip *)NULL) {
8159 interp = (Tcl_Interp *)NULL;
8161 interp = get_ip(ip_obj)->ip;
8167 if (
NIL_P(encodename)) {
8175 #ifdef HAVE_RUBY_ENCODING_H
8178 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8182 #ifdef HAVE_RUBY_ENCODING_H
8185 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8192 if (
NIL_P(ip_obj)) {
8193 encoding = (Tcl_Encoding)NULL;
8197 encoding = (Tcl_Encoding)NULL;
8203 encoding = (Tcl_Encoding)NULL;
8205 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8207 if (encoding == (Tcl_Encoding)NULL) {
8219 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8227 s = (
char*)Tcl_GetByteArrayFromObj(tclstr, &len);
8231 #ifdef HAVE_RUBY_ENCODING_H
8234 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8241 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(encodename));
8242 if (encoding == (Tcl_Encoding)NULL) {
8265 Tcl_DStringInit(&dstr);
8266 Tcl_DStringFree(&dstr);
8268 Tcl_UtfToExternalDString(encoding,buf,
RSTRING_LENINT(str),&dstr);
8272 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8273 #ifdef HAVE_RUBY_ENCODING_H
8277 VALUE tbl = ip_get_encoding_table(ip_obj);
8278 VALUE encobj = encoding_table_get_obj(tbl, encodename);
8295 Tcl_DStringFree(&dstr);
8307 lib_fromUTF8(argc, argv,
self)
8314 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8321 ip_fromUTF8(argc, argv,
self)
8328 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8335 lib_UTF_backslash_core(
self, str,
all_bs)
8341 char *src_buf, *dst_buf, *
ptr;
8342 int read_len = 0, dst_len = 0;
8372 if (*ptr ==
'\\' && (all_bs || *(ptr + 1) ==
'u')) {
8373 dst_len += Tcl_UtfBackslash(ptr, &read_len, (dst_buf + dst_len));
8376 *(dst_buf + (dst_len++)) = *(ptr++);
8382 #ifdef HAVE_RUBY_ENCODING_H
8388 Tcl_EventuallyFree((ClientData)src_buf, TCL_DYNAMIC);
8398 Tcl_EventuallyFree((ClientData)dst_buf, TCL_DYNAMIC);
8415 lib_UTF_backslash(
self, str)
8419 return lib_UTF_backslash_core(
self, str, 0);
8423 lib_Tcl_backslash(
self, str)
8427 return lib_UTF_backslash_core(
self, str, 1);
8431 lib_get_system_encoding(
self)
8434 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
8436 return rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL));
8443 lib_set_system_encoding(
self,
enc_name)
8447 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
8450 if (
NIL_P(enc_name)) {
8451 Tcl_SetSystemEncoding((Tcl_Interp *)NULL, (
CONST char *)NULL);
8452 return lib_get_system_encoding(
self);
8455 enc_name =
rb_funcall(enc_name, ID_to_s, 0, 0);
8456 if (Tcl_SetSystemEncoding((Tcl_Interp *)NULL,
8473 #if TCL_MAJOR_VERSION >= 8
8483 #ifdef HAVE_PROTOTYPES
8484 invoke_tcl_proc(
VALUE arg)
8486 invoke_tcl_proc(arg)
8492 #if TCL_MAJOR_VERSION >= 8
8493 int argc = inf->objc;
8494 char **argv = (
char **)NULL;
8498 #if TCL_MAJOR_VERSION >= 8
8499 if (!inf->
cmdinfo.isNativeObjectProc) {
8506 for (i = 0; i <
argc; ++
i) {
8507 argv[
i] = Tcl_GetStringFromObj(inf->objv[i], &len);
8509 argv[
argc] = (
char *)NULL;
8516 #if TCL_MAJOR_VERSION >= 8
8517 if (inf->
cmdinfo.isNativeObjectProc) {
8520 inf->
ptr->
ip, inf->objc, inf->objv);
8525 #if TCL_MAJOR_VERSION >= 8
8531 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8552 #if TCL_MAJOR_VERSION >= 8
8578 #if TCL_MAJOR_VERSION >= 8
8580 char **argv = (
char **)NULL;
8586 ptr = get_ip(interp);
8589 #if TCL_MAJOR_VERSION >= 8
8590 cmd = Tcl_GetStringFromObj(objv[0], &len);
8596 ptr = get_ip(interp);
8599 if (deleted_ip(ptr)) {
8607 DUMP2(
"call Tcl_GetCommandInfo, %s", cmd);
8609 DUMP1(
"error Tcl_GetCommandInfo");
8610 DUMP1(
"try auto_load (call 'unknown' command)");
8612 #
if TCL_MAJOR_VERSION >= 8
8618 DUMP1(
"fail to get 'unknown' command");
8620 if (event_loop_abort_on_exc > 0) {
8625 "invalid command name `%s'", cmd);
8627 if (event_loop_abort_on_exc < 0) {
8628 rb_warning(
"invalid command name `%s' (ignore)", cmd);
8630 rb_warn(
"invalid command name `%s' (ignore)", cmd);
8638 #if TCL_MAJOR_VERSION >= 8
8639 Tcl_Obj **unknown_objv;
8641 char **unknown_argv;
8643 DUMP1(
"find 'unknown' command -> set arguemnts");
8646 #if TCL_MAJOR_VERSION >= 8
8652 unknown_objv[0] = Tcl_NewStringObj(
"::unknown", 9);
8654 memcpy(unknown_objv + 1, objv,
sizeof(Tcl_Obj *)*objc);
8655 unknown_objv[++
objc] = (Tcl_Obj*)NULL;
8656 objv = unknown_objv;
8663 unknown_argv[0] =
strdup(
"unknown");
8664 memcpy(unknown_argv + 1, argv,
sizeof(
char *)*argc);
8665 unknown_argv[++
argc] = (
char *)NULL;
8666 argv = unknown_argv;
8670 DUMP1(
"end Tcl_GetCommandInfo");
8679 #if TCL_MAJOR_VERSION >= 8
8693 "unknown exception");
8710 #if TCL_MAJOR_VERSION >= 8
8711 if (!info.isNativeObjectProc) {
8720 for (i = 0; i <
argc; ++
i) {
8721 argv[
i] = Tcl_GetStringFromObj(objv[i], &len);
8723 argv[
argc] = (
char *)NULL;
8730 #if TCL_MAJOR_VERSION >= 8
8731 if (info.isNativeObjectProc) {
8736 resultPtr = Tcl_GetObjResult(ptr->
ip);
8737 Tcl_SetResult(ptr->
ip, Tcl_GetStringFromObj(resultPtr, &len),
8744 #if TCL_MAJOR_VERSION >= 8
8749 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8768 #if TCL_MAJOR_VERSION >= 8
8771 Tcl_EventuallyFree((ClientData)objv, TCL_DYNAMIC);
8784 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8797 if (pending_exception_check1(thr_crit_bup, ptr)) {
8805 if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->
ip)) {
8808 return create_ip_exc(interp, eTkCallbackReturn,
8809 "ip_invoke_core receives TCL_RETURN");
8811 return create_ip_exc(interp, eTkCallbackBreak,
8812 "ip_invoke_core receives TCL_BREAK");
8814 return create_ip_exc(interp, eTkCallbackContinue,
8815 "ip_invoke_core receives TCL_CONTINUE");
8822 if (event_loop_abort_on_exc < 0) {
8837 #if TCL_MAJOR_VERSION >= 8
8842 alloc_invoke_arguments(argc, argv)
8849 #if TCL_MAJOR_VERSION >= 8
8859 #if TCL_MAJOR_VERSION >= 8
8865 for (i = 0; i <
argc; ++
i) {
8866 av[
i] = get_obj_from_str(argv[i]);
8878 for (i = 0; i <
argc; ++
i) {
8892 #if TCL_MAJOR_VERSION >= 8
8900 for (i = 0; i <
argc; ++
i) {
8901 #if TCL_MAJOR_VERSION >= 8
8903 av[
i] = (Tcl_Obj*)NULL;
8906 av[
i] = (
char*)NULL;
8909 #if TCL_MAJOR_VERSION >= 8
8911 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8921 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8934 ip_invoke_real(argc, argv, interp)
8942 #if TCL_MAJOR_VERSION >= 8
8943 Tcl_Obj **av = (Tcl_Obj **)NULL;
8945 char **av = (
char **)NULL;
8951 ptr = get_ip(interp);
8954 if (deleted_ip(ptr)) {
8959 av = alloc_invoke_arguments(argc, argv);
8972 ivq_safelevel_handler(arg,
ivq)
8984 int invoke_queue_handler
_((Tcl_Event *,
int));
8986 invoke_queue_handler(evPtr, flags)
8996 DUMP2(
"do_invoke_queue_handler : evPtr = %p", evPtr);
8998 DUMP2(
"added by thread : %lx", thread);
9001 DUMP1(
"processed by another event-loop");
9004 DUMP1(
"process it on current event-loop");
9014 DUMP1(
"caller is not yet ready to receive the result -> pending");
9023 if (deleted_ip(ptr)) {
9038 q_dat = (
VALUE)NULL;
9040 DUMP2(
"call invoke_real (for caller thread:%lx)", thread);
9066 DUMP2(
"back to caller (caller thread:%lx)", thread);
9068 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
9069 have_rb_thread_waiting_for_value = 1;
9074 DUMP1(
"finish back to caller");
9075 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
9079 DUMP2(
"caller is dead (caller thread:%lx)", thread);
9092 Tcl_QueuePosition position;
9095 #ifdef RUBY_USE_NATIVE_THREAD
9106 #if TCL_MAJOR_VERSION >= 8
9107 Tcl_Obj **av = (Tcl_Obj **)NULL;
9109 char **av = (
char **)NULL;
9116 #ifdef RUBY_USE_NATIVE_THREAD
9117 ptr = get_ip(ip_obj);
9118 DUMP2(
"invoke status: ptr->tk_thread_id %p", ptr->tk_thread_id);
9119 DUMP2(
"invoke status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9121 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9123 DUMP2(
"status: eventloopt_thread %lx", eventloop_thread);
9126 #ifdef RUBY_USE_NATIVE_THREAD
9127 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
9130 (
NIL_P(eventloop_thread) || current == eventloop_thread)
9132 if (
NIL_P(eventloop_thread)) {
9133 DUMP2(
"invoke from thread:%lx but no eventloop", current);
9135 DUMP2(
"invoke from current eventloop %lx", current);
9137 result = ip_invoke_real(argc, argv, ip_obj);
9144 DUMP2(
"invoke from thread %lx (NOT current eventloop)", current);
9150 av = alloc_invoke_arguments(argc, argv);
9178 ivq->
ev.proc = invoke_queue_handler;
9181 DUMP1(
"add handler");
9182 #ifdef RUBY_USE_NATIVE_THREAD
9183 if (ptr->tk_thread_id) {
9185 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)ivq, position);
9186 Tcl_ThreadAlert(ptr->tk_thread_id);
9187 }
else if (tk_eventloop_thread_id) {
9190 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
9191 (Tcl_Event*)ivq, position);
9192 Tcl_ThreadAlert(tk_eventloop_thread_id);
9208 DUMP2(
"ivq wait for handler (current thread:%lx)", current);
9209 while(*alloc_done >= 0) {
9213 DUMP2(
"*** ivq wakeup (current thread:%lx)", current);
9214 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
9215 if (
NIL_P(eventloop_thread)) {
9216 DUMP1(
"*** ivq lost eventloop thread");
9220 DUMP2(
"back from handler (current thread:%lx)", current);
9225 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
9231 ckfree((
char*)alloc_done);
9237 Tcl_EventuallyFree((ClientData)ivq, TCL_DYNAMIC);
9252 DUMP1(
"raise exception");
9258 DUMP1(
"exit ip_invoke");
9274 if (deleted_ip(ptr)) {
9282 ip_invoke(argc, argv, obj)
9291 ip_invoke_immediate(argc, argv, obj)
9304 ip_get_variable2_core(interp, argc, argv)
9309 struct tcltkip *ptr = get_ip(interp);
9322 #if TCL_MAJOR_VERSION >= 8
9331 if (deleted_ip(ptr)) {
9342 if (ret == (Tcl_Obj*)NULL) {
9355 strval = get_str_from_obj(ret);
9370 if (deleted_ip(ptr)) {
9380 if (ret == (
char*)NULL) {
9400 ip_get_variable2(
self, varname, index, flag)
9416 retval =
tk_funcall(ip_get_variable2_core, 3, argv,
self);
9426 ip_get_variable(
self, varname, flag)
9431 return ip_get_variable2(
self, varname,
Qnil, flag);
9435 ip_set_variable2_core(interp, argc, argv)
9440 struct tcltkip *ptr = get_ip(interp);
9455 #if TCL_MAJOR_VERSION >= 8
9457 Tcl_Obj *valobj, *
ret;
9463 valobj = get_obj_from_str(value);
9467 if (deleted_ip(ptr)) {
9481 if (ret == (Tcl_Obj*)NULL) {
9494 strval = get_str_from_obj(ret);
9510 if (deleted_ip(ptr)) {
9520 if (ret == (
char*)NULL) {
9536 ip_set_variable2(
self, varname, index, value, flag)
9555 retval =
tk_funcall(ip_set_variable2_core, 4, argv,
self);
9557 if (
NIL_P(retval)) {
9565 ip_set_variable(
self, varname, value, flag)
9571 return ip_set_variable2(
self, varname,
Qnil, value, flag);
9575 ip_unset_variable2_core(interp, argc, argv)
9580 struct tcltkip *ptr = get_ip(interp);
9593 if (deleted_ip(ptr)) {
9602 if (
FIX2INT(flag) & TCL_LEAVE_ERR_MSG) {
9614 ip_unset_variable2(
self, varname, index, flag)
9630 retval =
tk_funcall(ip_unset_variable2_core, 3, argv,
self);
9632 if (
NIL_P(retval)) {
9640 ip_unset_variable(
self, varname, flag)
9645 return ip_unset_variable2(
self, varname,
Qnil, flag);
9649 ip_get_global_var(
self, varname)
9653 return ip_get_variable(
self, varname,
9654 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9658 ip_get_global_var2(
self, varname, index)
9663 return ip_get_variable2(
self, varname, index,
9664 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9668 ip_set_global_var(
self, varname, value)
9673 return ip_set_variable(
self, varname, value,
9674 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9678 ip_set_global_var2(
self, varname, index, value)
9684 return ip_set_variable2(
self, varname, index, value,
9685 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9689 ip_unset_global_var(
self, varname)
9693 return ip_unset_variable(
self, varname,
9694 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9698 ip_unset_global_var2(
self, varname, index)
9703 return ip_unset_variable2(
self, varname, index,
9704 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9710 lib_split_tklist_core(ip_obj,
list_str)
9718 #ifdef HAVE_RUBY_ENCODING_H
9728 interp = (Tcl_Interp *)NULL;
9729 }
else if (get_ip(ip_obj) == (
struct tcltkip *)NULL) {
9730 interp = (Tcl_Interp *)NULL;
9732 interp = get_ip(ip_obj)->ip;
9736 #ifdef HAVE_RUBY_ENCODING_H
9742 #if TCL_MAJOR_VERSION >= 8
9749 listobj = get_obj_from_str(list_str);
9753 result = Tcl_ListObjGetElements(interp, listobj, &objc, &objv);
9757 if (interp == (Tcl_Interp*)NULL) {
9764 for(idx = 0; idx <
objc; idx++) {
9776 for(idx = 0; idx <
objc; idx++) {
9777 elem = get_str_from_obj(objv[idx]);
9780 #ifdef HAVE_RUBY_ENCODING_H
9783 rb_ivar_set(elem, ID_at_enc, ENCODING_NAME_BINARY);
9799 for(idx = 0; idx <
objc; idx++) {
9812 if (interp == (Tcl_Interp*)NULL) {
9824 for(idx = 0; idx <
argc; idx++) {
9844 lib_split_tklist(
self, list_str)
9848 return lib_split_tklist_core(
Qnil, list_str);
9853 ip_split_tklist(
self, list_str)
9857 return lib_split_tklist_core(
self, list_str);
9861 lib_merge_tklist(argc, argv, obj)
9891 for(num = 0; num <
argc; num++) {
9894 #if TCL_MAJOR_VERSION >= 8
9898 len += Tcl_ScanElement(dst, &flagPtr[num]) + 1;
9904 result = (
char *)ckalloc(len);
9909 for(num = 0; num <
argc; num++) {
9910 #if TCL_MAJOR_VERSION >= 8
9911 len = Tcl_ConvertCountedElement(
RSTRING_PTR(argv[num]),
9915 len = Tcl_ConvertElement(
RSTRING_PTR(argv[num]), dst, flagPtr[num]);
9921 if (dst == result) {
9928 Tcl_EventuallyFree((ClientData)flagPtr, TCL_DYNAMIC);
9942 Tcl_EventuallyFree((ClientData)result, TCL_DYNAMIC);
9959 lib_conv_listelement(
self, src)
9975 #if TCL_MAJOR_VERSION >= 8
9982 len = Tcl_ScanElement(
RSTRING_PTR(src), &scan_flag);
9996 lib_getversion(
self)
10008 lib_get_reltype_name(
self)
10033 static CONST char form[]
10034 =
"tcltklib %s :: Ruby%s (%s) %s pthread :: Tcl%s(%s)/Tk%s(%s) %s";
10042 +
strlen(TCL_PATCH_LEVEL)
10043 +
strlen(
"without stub")
10044 +
strlen(TK_PATCH_LEVEL)
10045 +
strlen(
"without stub")
10046 +
strlen(
"unknown tcl_threads");
10051 sprintf(info, form,
10060 #ifdef USE_TCL_STUBS
10066 #ifdef USE_TK_STUBS
10071 #ifdef WITH_TCL_ENABLE_THREAD
10072 #
if WITH_TCL_ENABLE_THREAD
10075 "without tcl_threads"
10078 "unknown tcl_threads"
10094 create_dummy_encoding_for_tk_core(interp, name,
error_mode)
10105 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10106 if (Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(name)) == (Tcl_Encoding)NULL) {
10107 if (
RTEST(error_mode)) {
10116 #ifdef HAVE_RUBY_ENCODING_H
10121 if (
RTEST(error_mode)) {
10135 create_dummy_encoding_for_tk(interp, name)
10139 return create_dummy_encoding_for_tk_core(interp, name,
Qtrue);
10143 #ifdef HAVE_RUBY_ENCODING_H
10145 update_encoding_table(
table, interp, error_mode)
10160 ptr = get_ip(interp);
10161 if (ptr == (
struct tcltkip *) NULL)
return 0;
10162 if (deleted_ip(ptr))
return 0;
10166 enc_list = Tcl_GetObjResult(ptr->
ip);
10169 if (Tcl_ListObjGetElements(ptr->
ip, enc_list,
10170 &objc, &objv) !=
TCL_OK) {
10177 for(i = 0; i <
objc; i++) {
10183 encobj = create_dummy_encoding_for_tk_core(interp,encname,error_mode);
10202 encoding_table_get_name_core(table,
enc_arg, error_mode)
10216 ptr = get_ip(interp);
10217 if (deleted_ip(ptr)) {
10218 ptr = (
struct tcltkip *) NULL;
10226 enc =
rb_funcall(interp, ID_encoding_name, 0, 0);
10235 enc =
rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL));
10249 if (!
NIL_P(name)) {
10256 if (update_encoding_table(table, interp, error_mode)) {
10260 if (!
NIL_P(name)) {
10289 if (update_encoding_table(table, interp, error_mode)) {
10309 encoding_table_get_obj_core(table, enc, error_mode)
10317 encoding_table_get_name_core(table, enc, error_mode));
10326 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10328 update_encoding_table(table, interp, error_mode)
10341 if (
NIL_P(interp))
return 0;
10342 ptr = get_ip(interp);
10343 if (ptr == (
struct tcltkip *) NULL)
return 0;
10344 if (deleted_ip(ptr))
return 0;
10348 enc_list = Tcl_GetObjResult(ptr->
ip);
10351 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) !=
TCL_OK) {
10358 for(i = 0; i <
objc; i++) {
10374 encoding_table_get_name_core(table, enc, error_mode)
10384 if (!
NIL_P(name)) {
10390 if (update_encoding_table(table,
rb_ivar_get(table, ID_at_interp),
10395 if (!
NIL_P(name)) {
10401 if (
RTEST(error_mode)) {
10407 encoding_table_get_obj_core(table, enc, error_mode)
10412 return encoding_table_get_name_core(table, enc, error_mode);
10417 encoding_table_get_name_core(table, enc, error_mode)
10425 encoding_table_get_obj_core(table, enc, error_mode)
10436 encoding_table_get_name(table, enc)
10440 return encoding_table_get_name_core(table, enc,
Qtrue);
10443 encoding_table_get_obj(table, enc)
10447 return encoding_table_get_obj_core(table, enc,
Qtrue);
10450 #ifdef HAVE_RUBY_ENCODING_H
10452 create_encoding_table_core(arg, interp)
10456 struct tcltkip *ptr = get_ip(interp);
10464 #ifdef HAVE_RB_SET_SAFE_LEVEL_FORCE
10481 enc_list = Tcl_GetObjResult(ptr->
ip);
10484 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) !=
TCL_OK) {
10490 for(i = 0; i <
objc; i++) {
10491 int name2obj, obj2name;
10493 name2obj = 1; obj2name = 1;
10498 if (strcmp(
RSTRING_PTR(encname),
"identity") == 0) {
10499 name2obj = 1; obj2name = 0;
10502 }
else if (strcmp(
RSTRING_PTR(encname),
"shiftjis") == 0) {
10503 name2obj = 1; obj2name = 0;
10506 }
else if (strcmp(
RSTRING_PTR(encname),
"unicode") == 0) {
10507 name2obj = 1; obj2name = 0;
10510 }
else if (strcmp(
RSTRING_PTR(encname),
"symbol") == 0) {
10511 name2obj = 1; obj2name = 0;
10516 name2obj = 1; obj2name = 1;
10522 encobj = create_dummy_encoding_for_tk(interp, encname);
10546 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10548 create_encoding_table_core(arg, interp)
10552 struct tcltkip *ptr = get_ip(interp);
10562 rb_hash_aset(table, ENCODING_NAME_BINARY, ENCODING_NAME_BINARY);
10566 enc_list = Tcl_GetObjResult(ptr->
ip);
10569 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) !=
TCL_OK) {
10575 for(i = 0; i <
objc; i++) {
10590 create_encoding_table_core(arg, interp)
10603 create_encoding_table(interp)
10611 ip_get_encoding_table(interp)
10620 table = create_encoding_table(interp);
10635 #if TCL_MAJOR_VERSION >= 8
10637 #define MASTER_MENU 0
10638 #define TEAROFF_MENU 1
10641 struct dummy_TkMenuEntry {
10643 struct dummy_TkMenu *menuPtr;
10647 struct dummy_TkMenu {
10651 Tcl_Command widgetCmd;
10652 struct dummy_TkMenuEntry **entries;
10656 Tcl_Obj *menuTypePtr;
10660 struct dummy_TkMenuRef {
10661 struct dummy_TkMenu *menuPtr;
10668 EXTERN struct dummy_TkMenuRef *TkFindMenuReferences(Tcl_Interp*,
char*);
10670 #define MENU_HASH_KEY "tkMenus"
10676 ip_make_menu_embeddable_core(interp, argc, argv)
10681 #if TCL_MAJOR_VERSION >= 8
10683 struct tcltkip *ptr = get_ip(interp);
10684 struct dummy_TkMenuRef *menuRefPtr =
NULL;
10686 Tcl_HashTable *menuTablePtr;
10687 Tcl_HashEntry *hashEntryPtr;
10689 menu_path = argv[0];
10693 menuRefPtr = TkFindMenuReferences(ptr->
ip,
RSTRING_PTR(menu_path));
10696 = (Tcl_HashTable *) Tcl_GetAssocData(ptr->
ip, MENU_HASH_KEY, NULL))
10699 = Tcl_FindHashEntry(menuTablePtr,
RSTRING_PTR(menu_path)))
10701 menuRefPtr = (
struct dummy_TkMenuRef *) Tcl_GetHashValue(hashEntryPtr);
10706 if (menuRefPtr == (
struct dummy_TkMenuRef *)
NULL) {
10710 if (menuRefPtr->menuPtr == (
struct dummy_TkMenu *) NULL) {
10712 "invalid menu widget (maybe already destroyed)");
10715 if ((menuRefPtr->menuPtr)->menuType != MENUBAR) {
10717 "target menu widget must be a MENUBAR type");
10720 (menuRefPtr->menuPtr)->menuType = TEAROFF_MENU;
10724 char *s =
"normal";
10726 (menuRefPtr->menuPtr)->menuTypePtr = Tcl_NewStringObj(s,
strlen(s));
10729 (menuRefPtr->menuPtr)->menuType = MASTER_MENU;
10734 TkEventuallyRecomputeMenu(menuRefPtr->menuPtr);
10735 TkEventuallyRedrawMenu(menuRefPtr->menuPtr,
10736 (
struct dummy_TkMenuEntry *)NULL);
10738 memset((
void *) &event, 0,
sizeof(event));
10739 event.xany.type = ConfigureNotify;
10740 event.xany.serial = NextRequest(Tk_Display((menuRefPtr->menuPtr)->tkwin));
10741 event.xany.send_event = 0;
10742 event.xany.window = Tk_WindowId((menuRefPtr->menuPtr)->tkwin);
10743 event.xany.display = Tk_Display((menuRefPtr->menuPtr)->tkwin);
10744 event.xconfigure.window =
event.xany.window;
10745 Tk_HandleEvent(&event);
10756 ip_make_menu_embeddable(interp, menu_path)
10763 return tk_funcall(ip_make_menu_embeddable_core, 1, argv, interp);
10784 tcltkip_class =
ip;
10788 #ifdef HAVE_RUBY_ENCODING_H
10827 # define TK_WINDOWING_SYSTEM "win32"
10830 # define TK_WINDOWING_SYSTEM "classic"
10833 # define TK_WINDOWING_SYSTEM "aqua"
10835 # define TK_WINDOWING_SYSTEM "x11"
10856 #ifdef TCL_NAMESPACE_ONLY
10864 #ifdef TCL_PARSE_PART1
10874 lib_get_reltype_name, -1);
10891 eTkLocalJumpError =
rb_define_class(
"TkLocalJumpError", eLocalJumpError);
10893 eTkCallbackRetry =
rb_define_class(
"TkCallbackRetry", eTkLocalJumpError);
10894 eTkCallbackRedo =
rb_define_class(
"TkCallbackRedo", eTkLocalJumpError);
10895 eTkCallbackThrow =
rb_define_class(
"TkCallbackThrow", eTkLocalJumpError);
10901 ID_encoding_name =
rb_intern(
"encoding_name");
10902 ID_encoding_table =
rb_intern(
"encoding_table");
10926 lib_evloop_thread_p, 0);
10930 lib_thread_callback, -1);
10937 set_eventloop_window_mode, 1);
10939 get_eventloop_window_mode, 0);
10948 get_eventloop_weight, 0);
10950 lib_num_of_mainwindows, 0);
10957 lib_conv_listelement, 1);
10961 lib_UTF_backslash, 1);
10963 lib_Tcl_backslash, 1);
10966 lib_get_system_encoding, 0);
10968 lib_set_system_encoding, 1);
10970 lib_get_system_encoding, 0);
10972 lib_set_system_encoding, 1);
10987 rb_define_method(ip,
"invalid_namespace?", ip_has_invalid_namespace_p, 0);
11004 create_dummy_encoding_for_tk, 1);
11024 rb_define_method(ip,
"_make_menu_embeddable", ip_make_menu_embeddable, 1);
11038 ip_evloop_abort_on_exc, 0);
11040 ip_evloop_abort_on_exc_set, 1);
11052 eventloop_thread =
Qnil;
11053 eventloop_interp = (Tcl_Interp*)NULL;
11055 #ifndef DEFAULT_EVENTLOOP_DEPTH
11056 #define DEFAULT_EVENTLOOP_DEPTH 7
11061 watchdog_thread =
Qnil;
11067 #ifdef HAVE_NATIVETHREAD
11093 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
11102 Tcl_ObjType_ByteArray = Tcl_GetObjType(Tcl_ObjTypeName_ByteArray);
11103 Tcl_ObjType_String = Tcl_GetObjType(Tcl_ObjTypeName_String);
11107 (
void)call_original_exit;
void invoke_queue_mark(struct invoke_queue *q)
VALUE rb_gc_disable(void)
int rb_enc_get_index(VALUE obj)
return lib_mainloop_watchdog(argc, argv, self)
static VALUE eTkCallbackRetry
int rb_thread_check_trap_pending()
VALUE rb_ary_pop(VALUE ary)
#define TCL_FINAL_RELEASE
#define TKWAIT_MODE_VISIBILITY
void rb_bug(const char *fmt,...)
int ruby_tcl_stubs_init()
static VALUE eTkCallbackRedo
static Tcl_Interp * eventloop_interp
size_t strlen(const char *)
Tcl_CallWhenDeleted(ptr->ip, ip_CallWhenDeleted,(ClientData) mainWin)
#define FAIL_Tcl_InitStubs
#define TCL_ALPHA_RELEASE
static int tcl_protect_core(Tcl_Interp *interp, VALUE(*proc)(), VALUE data)
VALUE rb_iv_set(VALUE, const char *, VALUE)
#define rb_tainted_str_new2
int ruby_open_tcl_dll(char *)
static VALUE tcltkip_class
void rb_define_singleton_method(VALUE obj, const char *name, VALUE(*func)(ANYARGS), int argc)
Defines a singleton method for obj.
#define NO_THREAD_INTERRUPT_TIME
return ip_invoke_with_position(2, argv, self, TCL_QUEUE_TAIL)
#define RUBY_RELEASE_DATE
#define TK_WINDOWING_SYSTEM
Tcl_AppendResult(interp, RSTRING_PTR(msg),(char *) NULL)
static int Tcl_Interp * interp
#define DEFAULT_EVENTLOOP_DEPTH
SSL_METHOD *(* func)(void)
VALUE rb_const_get(VALUE, ID)
void rb_gc_force_recycle(VALUE)
void rbtk_EventCheckProc(ClientData clientData, int flag)
void call_queue_mark(struct call_queue *q)
Tcl_DoWhenIdle(rb_threadUpdateProc,(ClientData) param)
VALUE rb_gv_get(const char *)
#define FAIL_CreateInterp
static int int thr_crit_bup
static Tcl_TimerToken timer_token
VALUE rb_enc_from_encoding(rb_encoding *encoding)
VALUE rb_obj_freeze(VALUE)
static ID ID_encoding_name
void rb_define_alloc_func(VALUE, rb_alloc_func_t)
Tcl_DeleteEventSource(rbtk_EventSetupProc, rbtk_EventCheckProc,(ClientData) args)
VALUE rb_ary_push(VALUE ary, VALUE item)
void eval_queue_mark(struct eval_queue *q)
Tcl_DeleteTimerHandler(timer_token)
#define TKWAIT_MODE_DESTROY
static VALUE VALUE check_rootwidget
VALUE rb_protect(VALUE(*proc)(VALUE), VALUE data, int *state)
static int rbtk_eventloop_depth
VALUE rb_funcall(VALUE, ID, int,...)
Calls a method.
static VALUE cRubyEncoding
void rb_raise(VALUE exc, const char *fmt,...)
VALUE rb_proc_new(VALUE(*)(ANYARGS), VALUE)
static VALUE VALUE flag_val
VALUE rb_obj_class(VALUE)
static int ENCODING_INDEX_BINARY
VALUE rb_ary_new3(long n,...)
VALUE rb_locale_charmap(VALUE klass)
static VALUE eLocalJumpError
free_invoke_arguments(argc, av)
#define rb_enc_to_index(enc)
return set_eventloop_weight(self, loop_max, no_event)
static CONST char * optionStrings[]
Tcl_GetEncodingNames(ptr->ip)
RUBY_EXTERN VALUE rb_argv0
VALUE rb_path2class(const char *)
static VALUE rb_thread_alive_p(VALUE thread)
ip_replace_wait_commands(slave, mainWin)
rb_encoding * rb_utf8_encoding(void)
static void set_tcltk_version()
VALUE rb_str_append(VALUE, VALUE)
#define Tcl_GetStringResult(interp)
VALUE rb_ivar_get(VALUE, ID)
Tcl_AllowExceptions(interp)
static const char finalize_hook_name[]
#define DEFAULT_NO_EVENT_TICK
void rb_exc_raise(VALUE mesg)
static VALUE eventloop_thread
#define WATCHDOG_INTERVAL
#define RbTk_OBJ_UNTRUST(x)
static VALUE watchdog_thread
int rb_to_encoding_index(VALUE enc)
memset(y->frac+ix+1, 0,(y->Prec-(ix+1))*sizeof(BDIGIT))
VALUE rb_block_proc(void)
return Data_Wrap_Struct(CLASS_OF(interp), 0, ip_free, slave)
static int have_rb_thread_waiting_for_value
static int int check_root
Tcl_CreateCommand(interp,"vwait", ip_rbVwaitCommand,(ClientData) NULL,(Tcl_CmdDeleteProc *) NULL)
ip_wrap_namespace_command(ptr->ip)
#define StringValuePtr(v)
VALUE rb_eval_string_protect(const char *, int *)
Evaluates the given string in an isolated binding.
vsnprintf(buf, BUFSIZ, fmt, args)
#define StringValueCStr(v)
VALUE rb_enc_default_external(void)
void rb_define_const(VALUE, const char *, VALUE)
VALUE rb_define_class(const char *name, VALUE super)
Defines a top-level class.
return lib_toUTF8_core(Qnil, str, encodename)
static VALUE eventloop_stack
#define Tcl_IncrRefCount(obj)
volatile VALUE current_thread
static ID ID_encoding_table
int rb_thread_alone(void)
volatile VALUE current_evloop
static void Tcl_Interp * ip
static int window_event_mode
unsigned char buf[MIME_BUF_SIZE]
VALUE rb_enc_associate_index(VALUE obj, int idx)
void rb_thread_check_ints(void)
static int rb_thread_critical
VALUE rb_eval_string(const char *)
Evaluates the given string in an isolated binding.
#define Tcl_DecrRefCount(obj)
static const char tcltklib_release_date[]
VALUE rb_obj_as_string(VALUE)
VALUE rb_hash_aset(VALUE, VALUE, VALUE)
VALUE rb_tainted_str_new(const char *, long)
static VALUE tcltklib_compile_info()
VALUE rb_str_resize(VALUE, long)
void rb_define_module_function(VALUE module, const char *name, VALUE(*func)(ANYARGS), int argc)
Defines a module function for module.
VALUE rb_str_export_to_enc(VALUE, rb_encoding *)
int ruby_tk_stubs_init(Tcl_Interp *)
VALUE rb_thread_current(void)
#define DEFAULT_NO_EVENT_WAIT
static VALUE rbtk_pending_exception
int rb_const_defined(VALUE, ID)
return tk_funcall(ip_create_slave_core, 2, callargv, self)
int rb_scan_args(int argc, const VALUE *argv, const char *fmt,...)
static int rbtk_internal_eventloop_handler
int ruby_tk_stubs_safeinit(Tcl_Interp *)
VALUE rb_exc_new2(VALUE etype, const char *s)
VALUE rb_thread_run(VALUE)
int rb_define_dummy_encoding(const char *name)
Tcl_CmdInfo orig_exit_info
static VALUE eTkCallbackContinue
static int event_loop_abort_on_exc
void rb_set_safe_level_force(int)
#define RbTk_ALLOC_N(type, n)
VALUE rb_obj_encoding(VALUE obj)
VALUE rb_attr_get(VALUE, ID)
VALUE rb_ensure(VALUE(*b_proc)(ANYARGS), VALUE data1, VALUE(*e_proc)(ANYARGS), VALUE data2)
#define FAIL_Tk_InitStubs
#define DUMP2(ARG1, ARG2)
#define TCL_NAMESPACE_DEBUG
void rb_thread_schedule(void)
RUBY_EXTERN VALUE rb_cString
void rb_jump_tag(int tag)
static int trap_check(int *check_var)
long strtol(const char *nptr, char **endptr, int base)
#define NO_FindExecutable
void rb_set_end_proc(void(*func)(VALUE), VALUE data)
#define MEMCPY(p1, p2, type, n)
VALUE rb_define_module_under(VALUE outer, const char *name)
#define TCL_CANCEL_UNWIND
static VALUE eTkLocalJumpError
RUBY_EXTERN VALUE rb_cFile
void rb_thread_sleep_forever(void)
#define va_init_list(a, b)
VALUE rb_ivar_set(VALUE, ID, VALUE)
VALUE rb_thread_wakeup(VALUE)
return lib_evloop_abort_on_exc(self)
static VALUE ENCODING_NAME_BINARY
Tcl_Interp * ruby_tcl_create_ip_and_stubs_init(int *)
Tcl_QueueEvent((Tcl_Event *) callq, TCL_QUEUE_HEAD)
static int pending_exception_check0()
void rb_thread_wait_for(struct timeval)
VALUE rb_obj_is_kind_of(VALUE, VALUE)
VALUE rb_exc_new3(VALUE etype, VALUE str)
volatile VALUE list_ivar_enc
static VALUE eTkCallbackBreak
void rbtk_EventSetupProc(ClientData clientData, int flag)
#define EVENT_HANDLER_TIMEOUT
#define DUMP3(ARG1, ARG2, ARG3)
return ip_eval_real(q->interp, q->str, q->len)
void rb_set_safe_level(int)
static int req_timer_tick
static void ClientData clientData
RUBY_EXTERN VALUE rb_cObject
return set_no_event_wait(self, wait)
static int event_loop_wait_event
static VALUE ENCODING_NAME_UTF8
#define Data_Get_Struct(obj, type, sval)
static VALUE eTkCallbackReturn
int rb_respond_to(VALUE, ID)
return set_eventloop_tick(self, tick)
void rb_notimplement(void)
VALUE rb_apply(VALUE, ID, VALUE)
Calls a method.
#define RSTRING_LENINT(str)
VALUE rb_ary_join(VALUE ary, VALUE sep)
VALUE rb_enc_default_internal(void)
Tcl_Interp * current_interp
VALUE rb_ary_new2(long capa)
VALUE rb_str_new(const char *, long)
#define DEFAULT_EVENT_LOOP_MAX
return lib_eventloop_launcher(RTEST(check_rootwidget), 0,(int *) NULL,(Tcl_Interp *) NULL)
static VALUE eTkCallbackThrow
static struct tcltkip *VALUE self
static int check_rootwidget_flag
#define ruby_native_thread_p()
void rb_global_variable(VALUE *)
static int event_loop_max
VALUE rb_fix2str(VALUE, int)
void rb_warning(const char *fmt,...)
#define TCLTKLIB_RELEASE_DATE
int rb_enc_find_index(const char *name)
VALUE rb_thread_create(VALUE(*)(ANYARGS), void *)
return lib_fromUTF8_core(Qnil, str, encodename)
void _thread_call_proc_arg_mark(struct thread_call_proc_arg *q)
static int run_timer_flag
&& Tcl_GetCommandInfo(ip,"after",&info))
Tcl_QueuePosition position
VALUE rb_define_module(const char *name)
static void tcl_stubs_check()
static struct @84 tcltk_version
RUBY_EXTERN VALUE rb_cData
static int check_eventloop_interp()
return ip_get_result_string_obj(ptr->ip)
void rb_define_method(VALUE klass, const char *name, VALUE(*func)(ANYARGS), int argc)
return ip_invoke_core(q->interp, q->argc, q->argv)
void rb_warn(const char *fmt,...)
Tcl_SetMaxBlockTime & tcl_time
static int Tcl_Event * evPtr
return lib_evloop_abort_on_exc_set(self, val)
#define EVLOOP_WAKEUP_CHANCE
static int ENCODING_INDEX_UTF8
static VALUE VALUE master
#define HAVE_NATIVETHREAD
#define DEFAULT_TIMER_TICK
rb_encoding * rb_enc_from_index(int index)
Tcl_CreateEventSource(rbtk_EventSetupProc, rbtk_EventCheckProc,(ClientData) args)