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);
864 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
868 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 84
869 #error Ruby/Tk-Kit requires Tcl/Tk8.4 or later.
889 #if defined USE_TCL_STUBS || defined USE_TK_STUBS
890 # error Not support Tcl/Tk stubs with Ruby/Tk-Kit or Rubykit.
893 #ifndef KIT_INCLUDES_ZLIB
894 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
895 #define KIT_INCLUDES_ZLIB 1
897 #define KIT_INCLUDES_ZLIB 0
902 #define WIN32_LEAN_AND_MEAN
904 #undef WIN32_LEAN_AND_MEAN
907 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
908 EXTERN Tcl_Obj* TclGetStartupScriptPath();
909 EXTERN void TclSetStartupScriptPath
_((Tcl_Obj*));
910 #define Tcl_GetStartupScript(encPtr) TclGetStartupScriptPath()
911 #define Tcl_SetStartupScript(path,enc) TclSetStartupScriptPath(path)
913 #if !defined(TclSetPreInitScript) && !defined(TclSetPreInitScript_TCL_DECLARED)
914 EXTERN char* TclSetPreInitScript
_((
char *));
917 #ifndef KIT_INCLUDES_TK
918 # define KIT_INCLUDES_TK 1
923 Tcl_AppInitProc Vfs_Init, Rechan_Init;
924 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
925 Tcl_AppInitProc Pwb_Init;
929 Tcl_AppInitProc Vlerq_Init, Vlerq_SafeInit;
931 Tcl_AppInitProc Mk4tcl_Init;
934 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
935 Tcl_AppInitProc Thread_Init;
938 #if KIT_INCLUDES_ZLIB
939 Tcl_AppInitProc Zlib_Init;
942 #ifdef KIT_INCLUDES_ITCL
943 Tcl_AppInitProc Itcl_Init;
947 Tcl_AppInitProc Dde_Init, Dde_SafeInit, Registry_Init;
952 #define RUBYTK_KITPATH_CONST_NAME "RUBYTK_KITPATH"
954 static char *rubytk_kitpath =
NULL;
956 static char rubytkkit_preInitCmd[] =
957 "proc tclKitPreInit {} {\n"
958 "rename tclKitPreInit {}\n"
959 "load {} rubytk_kitpath\n"
960 #if KIT_INCLUDES_ZLIB
961 "catch {load {} zlib}\n"
965 "namespace eval ::vlerq {}\n"
966 "if {[catch { vlerq open $::tcl::kitpath } ::vlerq::starkit_root]} {\n"
969 "set files [vlerq get $::vlerq::starkit_root 0 dirs 0 files]\n"
970 "set n [lsearch [vlerq get $files * name] boot.tcl]\n"
973 "array set a [vlerq get $files $n]\n"
976 #if defined KIT_VFS_WRITABLE && !defined CREATE_RUBYKIT
978 "mk::file open exe $::tcl::kitpath\n"
980 "mk::file open exe $::tcl::kitpath -readonly\n"
982 "set n [mk::select exe.dirs!0.files name boot.tcl]\n"
983 "if {[llength $n] == 1} {\n"
984 "array set a [mk::get exe.dirs!0.files!$n]\n"
986 "if {![info exists a(contents)]} { error {no boot.tcl file} }\n"
987 "if {$a(size) != [string length $a(contents)]} {\n"
988 "set a(contents) [zlib decompress $a(contents)]\n"
990 "if {$a(contents) eq \"\"} { error {empty boot.tcl} }\n"
991 "uplevel #0 $a(contents)\n"
993 "} elseif {[lindex $::argv 0] eq \"-init-\"} {\n"
994 "uplevel #0 { source [lindex $::argv 1] }\n"
999 "set vfsdir \"[file rootname $::tcl::kitpath].vfs\"\n"
1000 "if {[file isdirectory $vfsdir]} {\n"
1001 "set ::tcl_library [file join $vfsdir lib tcl$::tcl_version]\n"
1002 "set ::tcl_libPath [list $::tcl_library [file join $vfsdir lib]]\n"
1003 "catch {uplevel #0 [list source [file join $vfsdir config.tcl]]}\n"
1004 "uplevel #0 [list source [file join $::tcl_library init.tcl]]\n"
1005 "set ::auto_path $::tcl_libPath\n"
1007 "error \"\n $::tcl::kitpath has no VFS data to start up\"\n"
1017 static const char initScript[] =
1018 "if {[file isfile [file join $::tcl::kitpath main.tcl]]} {\n"
1019 "if {[info commands console] != {}} { console hide }\n"
1020 "set tcl_interactive 0\n"
1022 "set argv [linsert $argv 0 $argv0]\n"
1023 "set argv0 [file join $::tcl::kitpath main.tcl]\n"
1031 set_rubytk_kitpath(
const char *kitpath)
1035 if (rubytk_kitpath) {
1039 rubytk_kitpath = (
char *)ckalloc(len + 1);
1040 memcpy(rubytk_kitpath, kitpath, len);
1041 rubytk_kitpath[
len] =
'\0';
1043 return rubytk_kitpath;
1049 #define DEV_NULL "NUL"
1051 #define DEV_NULL "/dev/null"
1055 check_tclkit_std_channels()
1064 chan = Tcl_GetStdChannel(TCL_STDIN);
1066 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"r", 0);
1068 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1070 Tcl_SetStdChannel(chan, TCL_STDIN);
1072 chan = Tcl_GetStdChannel(TCL_STDOUT);
1074 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"w", 0);
1076 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1078 Tcl_SetStdChannel(chan, TCL_STDOUT);
1080 chan = Tcl_GetStdChannel(TCL_STDERR);
1082 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"w", 0);
1084 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1086 Tcl_SetStdChannel(chan, TCL_STDERR);
1093 rubytk_kitpathObjCmd(ClientData
dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *
const objv[])
1097 set_rubytk_kitpath(Tcl_GetString(objv[1]));
1098 }
else if (objc > 2) {
1099 Tcl_WrongNumArgs(interp, 1, objv,
"?path?");
1101 str = rubytk_kitpath ? rubytk_kitpath : Tcl_GetNameOfExecutable();
1102 Tcl_SetObjResult(interp, Tcl_NewStringObj(str, -1));
1111 rubytk_kitpath_init(Tcl_Interp *interp)
1113 Tcl_CreateObjCommand(interp,
"::tcl::kitpath", rubytk_kitpathObjCmd, 0, 0);
1114 if (Tcl_LinkVar(interp,
"::tcl::kitpath", (
char *) &rubytk_kitpath,
1115 TCL_LINK_STRING | TCL_LINK_READ_ONLY) !=
TCL_OK) {
1119 Tcl_CreateObjCommand(interp,
"::tcl::rubytk_kitpath", rubytk_kitpathObjCmd, 0, 0);
1120 if (Tcl_LinkVar(interp,
"::tcl::rubytk_kitpath", (
char *) &rubytk_kitpath,
1121 TCL_LINK_STRING | TCL_LINK_READ_ONLY) !=
TCL_OK) {
1125 if (rubytk_kitpath ==
NULL) {
1130 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1133 return Tcl_PkgProvide(interp,
"rubytk_kitpath",
"1.0");
1139 init_static_tcltk_packages()
1144 check_tclkit_std_channels();
1146 #ifdef KIT_INCLUDES_ITCL
1147 Tcl_StaticPackage(0,
"Itcl", Itcl_Init,
NULL);
1150 Tcl_StaticPackage(0,
"Vlerq", Vlerq_Init, Vlerq_SafeInit);
1152 Tcl_StaticPackage(0,
"Mk4tcl", Mk4tcl_Init,
NULL);
1154 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
1155 Tcl_StaticPackage(0,
"pwb", Pwb_Init,
NULL);
1157 Tcl_StaticPackage(0,
"rubytk_kitpath", rubytk_kitpath_init,
NULL);
1158 Tcl_StaticPackage(0,
"rechan", Rechan_Init,
NULL);
1159 Tcl_StaticPackage(0,
"vfs", Vfs_Init,
NULL);
1160 #if KIT_INCLUDES_ZLIB
1161 Tcl_StaticPackage(0,
"zlib", Zlib_Init,
NULL);
1163 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
1164 Tcl_StaticPackage(0,
"Thread", Thread_Init, Thread_SafeInit);
1167 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
1168 Tcl_StaticPackage(0,
"dde", Dde_Init, Dde_SafeInit);
1170 Tcl_StaticPackage(0,
"dde", Dde_Init,
NULL);
1172 Tcl_StaticPackage(0,
"registry", Registry_Init,
NULL);
1174 #ifdef KIT_INCLUDES_TK
1175 Tcl_StaticPackage(0,
"Tk", Tk_Init, Tk_SafeInit);
1182 call_tclkit_init_script(Tcl_Interp *interp)
1188 if (Tcl_EvalEx(interp, initScript, -1, TCL_EVAL_GLOBAL) ==
TCL_OK) {
1189 const char *encoding =
NULL;
1190 Tcl_Obj*
path = Tcl_GetStartupScript(&encoding);
1191 Tcl_SetStartupScript(Tcl_GetObjResult(interp), encoding);
1193 Tcl_Eval(interp,
"incr argc -1; set argv [lrange $argv 1 end]");
1207 EXTERN void TkWinSetHINSTANCE(HINSTANCE hInstance);
1208 void rbtk_win32_SetHINSTANCE(
const char *module_name)
1215 hInst = GetModuleHandle(module_name);
1216 TkWinSetHINSTANCE(hInst);
1228 init_static_tcltk_packages();
1232 const_id =
rb_intern(RUBYTK_KITPATH_CONST_NAME);
1235 volatile VALUE pathobj;
1239 #ifdef HAVE_RUBY_ENCODING_H
1247 #ifdef CREATE_RUBYTK_KIT
1248 if (rubytk_kitpath ==
NULL) {
1252 volatile VALUE basename;
1262 if (rubytk_kitpath ==
NULL) {
1263 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1266 TclSetPreInitScript(rubytkkit_preInitCmd);
1306 tcltkip_init_tk(interp)
1309 struct tcltkip *ptr = get_ip(interp);
1311 #if TCL_MAJOR_VERSION >= 8
1314 if (Tcl_IsSafe(ptr->
ip)) {
1315 DUMP1(
"Tk_SafeInit");
1322 "tcltklib: can't find Tk_SafeInit()");
1325 "tcltklib: fail to Tk_SafeInit(). %s",
1329 "tcltklib: fail to Tk_InitStubs(). %s",
1333 "tcltklib: unknown error(%d) on ruby_tk_stubs_safeinit", st);
1343 "tcltklib: can't find Tk_Init()");
1346 "tcltklib: fail to Tk_Init(). %s",
1350 "tcltklib: fail to Tk_InitStubs(). %s",
1354 "tcltklib: unknown error(%d) on ruby_tk_stubs_init", st);
1365 #ifdef RUBY_USE_NATIVE_THREAD
1366 ptr->tk_thread_id = Tcl_GetCurrentThread();
1385 DUMP1(
"find a pending exception");
1394 DUMP1(
"pending_exception_check0: call rb_jump_tag(retry)");
1397 DUMP1(
"pending_exception_check0: call rb_jump_tag(redo)");
1400 DUMP1(
"pending_exception_check0: call rb_jump_tag(throw)");
1421 DUMP1(
"find a pending exception");
1438 DUMP1(
"pending_exception_check1: call rb_jump_tag(retry)");
1441 DUMP1(
"pending_exception_check1: call rb_jump_tag(redo)");
1444 DUMP1(
"pending_exception_check1: call rb_jump_tag(throw)");
1459 call_original_exit(ptr,
state)
1465 #if TCL_MAJOR_VERSION >= 8
1469 DUMP1(
"original_exit is called");
1471 if (!(ptr->has_orig_exit))
return;
1478 info = &(ptr->orig_exit_info);
1481 #if TCL_MAJOR_VERSION >= 8
1482 state_obj = Tcl_NewIntObj(state);
1485 if (info->isNativeObjectProc) {
1487 #define USE_RUBY_ALLOC 0
1489 argv = (Tcl_Obj **)
ALLOC_N(Tcl_Obj *, 3);
1496 cmd_obj = Tcl_NewStringObj(
"exit", 4);
1500 argv[1] = state_obj;
1501 argv[2] = (Tcl_Obj *)
NULL;
1504 = (*(info->objProc))(info->objClientData, ptr->ip, 2,
argv);
1512 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1522 #undef USE_RUBY_ALLOC
1527 #define USE_RUBY_ALLOC 0
1536 argv[0] = (
char *)
"exit";
1538 argv[1] = Tcl_GetStringFromObj(state_obj, (
int*)
NULL);
1539 argv[2] = (
char *)
NULL;
1541 ptr->return_value = (*(info->proc))(info->clientData, ptr->ip, 2,
argv);
1547 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1557 #undef USE_RUBY_ALLOC
1566 #define USE_RUBY_ALLOC 0
1568 argv = (
char **)
ALLOC_N(
char *, 3);
1577 argv[2] = (
char *)
NULL;
1579 ptr->return_value = (*(info->proc))(info->clientData, ptr->ip,
1586 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1596 #undef USE_RUBY_ALLOC
1599 DUMP1(
"complete original_exit");
1608 static void _timer_for_tcl
_((ClientData));
1618 DUMP1(
"call _timer_for_tcl");
1627 if (timer_tick > 0) {
1628 timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl,
1640 #ifdef RUBY_USE_NATIVE_THREAD
1641 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE
1643 toggle_eventloop_window_mode_for_idle()
1645 if (window_event_mode & TCL_IDLE_EVENTS) {
1647 window_event_mode |= TCL_WINDOW_EVENTS;
1648 window_event_mode &= ~TCL_IDLE_EVENTS;
1652 window_event_mode |= TCL_IDLE_EVENTS;
1653 window_event_mode &= ~TCL_WINDOW_EVENTS;
1661 set_eventloop_window_mode(
self,
mode)
1668 window_event_mode = ~0;
1670 window_event_mode = ~TCL_WINDOW_EVENTS;
1677 get_eventloop_window_mode(
self)
1680 if ( ~window_event_mode ) {
1699 "timer-tick parameter must be 0 or positive number");
1708 timer_tick = req_timer_tick = ttick;
1709 if (timer_tick > 0) {
1711 timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl,
1723 get_eventloop_tick(
self)
1730 ip_set_eventloop_tick(
self, tick)
1734 struct tcltkip *ptr = get_ip(
self);
1737 if (deleted_ip(ptr)) {
1738 return get_eventloop_tick(
self);
1741 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1743 return get_eventloop_tick(
self);
1749 ip_get_eventloop_tick(
self)
1752 return get_eventloop_tick(
self);
1766 "no_event_wait parameter must be positive number");
1769 no_event_wait = t_wait;
1775 get_no_event_wait(
self)
1778 return INT2NUM(no_event_wait);
1782 ip_set_no_event_wait(
self, wait)
1786 struct tcltkip *ptr = get_ip(
self);
1789 if (deleted_ip(ptr)) {
1790 return get_no_event_wait(
self);
1793 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1795 return get_no_event_wait(
self);
1801 ip_get_no_event_wait(
self)
1804 return get_no_event_wait(
self);
1813 int lpmax =
NUM2INT(loop_max);
1818 if (lpmax <= 0 || no_ev <= 0) {
1822 event_loop_max = lpmax;
1823 no_event_tick =
no_ev;
1829 get_eventloop_weight(
self)
1836 ip_set_eventloop_weight(
self, loop_max, no_event)
1841 struct tcltkip *ptr = get_ip(
self);
1844 if (deleted_ip(ptr)) {
1845 return get_eventloop_weight(
self);
1848 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1850 return get_eventloop_weight(
self);
1856 ip_get_eventloop_weight(
self)
1859 return get_eventloop_weight(
self);
1863 set_max_block_time(
self,
time)
1867 struct Tcl_Time tcl_time;
1893 Tcl_SetMaxBlockTime(&tcl_time);
1899 lib_evloop_thread_p(
self)
1902 if (
NIL_P(eventloop_thread)) {
1915 if (event_loop_abort_on_exc > 0) {
1917 }
else if (event_loop_abort_on_exc == 0) {
1925 ip_evloop_abort_on_exc(
self)
1937 event_loop_abort_on_exc = 1;
1939 event_loop_abort_on_exc = -1;
1941 event_loop_abort_on_exc = 0;
1947 ip_evloop_abort_on_exc_set(
self, val)
1950 struct tcltkip *ptr = get_ip(
self);
1955 if (deleted_ip(ptr)) {
1959 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1967 lib_num_of_mainwindows_core(
self,
argc, argv)
1973 return INT2FIX(Tk_GetNumMainWindows());
1980 lib_num_of_mainwindows(
self)
1983 #ifdef RUBY_USE_NATIVE_THREAD
1986 return lib_num_of_mainwindows_core(
self, 0, (
VALUE*)
NULL);
1995 tcl_time.usec = 1000L * (long)no_event_tick;
1996 Tcl_SetMaxBlockTime(&tcl_time);
2006 #ifdef RUBY_USE_NATIVE_THREAD
2008 #ifdef HAVE_PROTOTYPES
2011 call_DoOneEvent_core(flag_val)
2018 if (Tcl_DoOneEvent(flag)) {
2026 #ifdef HAVE_PROTOTYPES
2027 call_DoOneEvent(
VALUE flag_val)
2029 call_DoOneEvent(flag_val)
2038 #ifdef HAVE_PROTOTYPES
2039 call_DoOneEvent(
VALUE flag_val)
2041 call_DoOneEvent(flag_val)
2048 if (Tcl_DoOneEvent(flag)) {
2059 #ifdef HAVE_PROTOTYPES
2060 eventloop_sleep(
VALUE dummy)
2062 eventloop_sleep(dummy)
2068 if (no_event_wait <= 0) {
2073 t.tv_usec = (
int)(no_event_wait*1000.0);
2075 #ifdef HAVE_NATIVETHREAD
2076 #ifndef RUBY_USE_NATIVE_THREAD
2078 rb_bug(
"cross-thread violation on eventloop_sleep()");
2087 #ifdef HAVE_NATIVETHREAD
2088 #ifndef RUBY_USE_NATIVE_THREAD
2090 rb_bug(
"cross-thread violation on eventloop_sleep()");
2099 #define USE_EVLOOP_THREAD_ALONE_CHECK_FLAG 0
2101 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2103 get_thread_alone_check_flag()
2105 #ifdef RUBY_USE_NATIVE_THREAD
2137 #define TRAP_CHECK() do { \
2138 if (trap_check(check_var) == 0) return 0; \
2144 DUMP1(
"trap check");
2148 if (check_var != (
int*)
NULL) {
2157 if (rb_trap_pending) {
2159 if (rb_prohibit_interrupt || check_var != (
int*)
NULL) {
2174 DUMP1(
"check eventloop_interp");
2175 if (eventloop_interp != (Tcl_Interp*)
NULL
2176 && Tcl_InterpDeleted(eventloop_interp)) {
2177 DUMP2(
"eventloop_interp(%p) was deleted", eventloop_interp);
2198 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2199 int thread_alone_check_flag = 1;
2202 if (update_flag)
DUMP1(
"update loop start!!");
2209 if (timer_tick > 0) {
2212 timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl,
2219 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2221 thread_alone_check_flag = get_thread_alone_check_flag();
2227 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2232 DUMP1(
"no other thread");
2233 event_loop_wait_event = 0;
2239 event_flag = TCL_ALL_EVENTS;
2243 if (timer_tick == 0 && update_flag == 0) {
2250 if (check_var != (
int *)
NULL) {
2251 if (*check_var || !found_event) {
2254 if (interp != (Tcl_Interp*)
NULL
2255 && Tcl_InterpDeleted(interp)) {
2263 INT2FIX(event_flag), &status));
2295 DUMP2(
"DoOneEvent(1) abnormal exit!! %d",
2300 DUMP1(
"exception on wait");
2309 if (update_flag != 0) {
2311 DUMP1(
"next update loop");
2314 DUMP1(
"update complete");
2322 DUMP1(
"check Root Widget");
2329 if (loop_counter++ > 30000) {
2337 DUMP1(
"there are other threads");
2338 event_loop_wait_event = 1;
2346 event_flag = TCL_ALL_EVENTS;
2352 while(tick_counter < event_loop_max) {
2353 if (check_var != (
int *)
NULL) {
2354 if (*check_var || !found_event) {
2357 if (interp != (Tcl_Interp*)
NULL
2358 && Tcl_InterpDeleted(interp)) {
2364 if (
NIL_P(eventloop_thread) || current == eventloop_thread) {
2368 #ifdef RUBY_USE_NATIVE_THREAD
2371 INT2FIX(event_flag), &status));
2374 INT2FIX(event_flag & window_event_mode),
2376 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE
2378 if (toggle_eventloop_window_mode_for_idle()) {
2391 INT2FIX(event_flag), &status));
2394 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
2395 if (have_rb_thread_waiting_for_value) {
2396 have_rb_thread_waiting_for_value = 0;
2407 "unknown exception");
2433 DUMP2(
"DoOneEvent(2) abnormal exit!! %d",
2440 if (check_var != (
int*)
NULL
2442 DUMP1(
"exception on wait");
2454 if (update_flag != 0) {
2455 DUMP1(
"update complete");
2471 "unknown exception");
2500 DUMP2(
"sleep eventloop %lx", current);
2501 DUMP2(
"eventloop thread is %lx", eventloop_thread);
2506 if (!
NIL_P(watchdog_thread) && eventloop_thread != current) {
2513 DUMP1(
"check Root Widget");
2520 if (loop_counter++ > 30000) {
2525 if (run_timer_flag) {
2534 DUMP1(
"thread scheduling");
2538 DUMP1(
"check interrupts");
2539 #if defined(RUBY_USE_NATIVE_THREAD) || defined(RUBY_VM)
2559 lib_eventloop_main_core(args)
2579 lib_eventloop_main(args)
2582 return lib_eventloop_main_core(args);
2588 ret =
rb_protect(lib_eventloop_main_core, args, &status);
2614 lib_eventloop_ensure(args)
2622 DUMP2(
"eventloop_ensure: current-thread : %lx", current_evloop);
2623 DUMP2(
"eventloop_ensure: eventloop-thread : %lx", eventloop_thread);
2624 if (eventloop_thread != current_evloop) {
2625 DUMP2(
"finish eventloop %lx (NOT current eventloop)", current_evloop);
2636 DUMP2(
"eventloop-ensure: new eventloop-thread -> %lx",
2639 if (eventloop_thread == current_evloop) {
2641 DUMP2(
"eventloop %lx : back from recursive call", current_evloop);
2645 if (
NIL_P(eventloop_thread)) {
2657 DUMP2(
"eventloop-enshure: wake up parent %lx", eventloop_thread);
2664 #ifdef RUBY_USE_NATIVE_THREAD
2665 if (
NIL_P(eventloop_thread)) {
2666 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2675 DUMP2(
"finish current eventloop %lx", current_evloop);
2693 #ifdef RUBY_USE_NATIVE_THREAD
2694 tk_eventloop_thread_id = Tcl_GetCurrentThread();
2697 if (parent_evloop == eventloop_thread) {
2698 DUMP2(
"eventloop: recursive call on %lx", parent_evloop);
2702 if (!
NIL_P(parent_evloop) && parent_evloop != eventloop_thread) {
2703 DUMP2(
"wait for stop of parent_evloop %lx", parent_evloop);
2705 DUMP2(
"parent_evloop %lx doesn't stop", parent_evloop);
2708 DUMP1(
"succeed to stop parent");
2713 DUMP3(
"tcltklib: eventloop-thread : %lx -> %lx\n",
2714 parent_evloop, eventloop_thread);
2726 lib_eventloop_ensure, (
VALUE)args);
2729 lib_eventloop_ensure, (
VALUE)args);
2734 lib_mainloop(
argc, argv,
self)
2742 check_rootwidget =
Qtrue;
2744 check_rootwidget =
Qtrue;
2746 check_rootwidget =
Qfalse;
2754 ip_mainloop(argc, argv,
self)
2760 struct tcltkip *ptr = get_ip(
self);
2763 if (deleted_ip(ptr)) {
2767 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2772 eventloop_interp = ptr->
ip;
2773 ret = lib_mainloop(argc, argv,
self);
2774 eventloop_interp = (Tcl_Interp*)
NULL;
2780 watchdog_evloop_launcher(check_rootwidget)
2787 #define EVLOOP_WAKEUP_CHANCE 3
2790 lib_watchdog_core(check_rootwidget)
2791 VALUE check_rootwidget;
2816 if (
NIL_P(eventloop_thread)
2819 DUMP2(
"eventloop thread %lx is sleeping or dead",
2822 (
void*)&check_rootwidget);
2823 DUMP2(
"create new eventloop thread %lx", evloop);
2834 if (event_loop_wait_event) {
2847 lib_watchdog_ensure(
arg)
2850 eventloop_thread =
Qnil;
2851 #ifdef RUBY_USE_NATIVE_THREAD
2852 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2867 "eventloop_watchdog is not implemented on Ruby VM.");
2870 if (
rb_scan_args(argc, argv,
"01", &check_rootwidget) == 0) {
2871 check_rootwidget =
Qtrue;
2872 }
else if (
RTEST(check_rootwidget)) {
2873 check_rootwidget =
Qtrue;
2875 check_rootwidget =
Qfalse;
2878 return rb_ensure(lib_watchdog_core, check_rootwidget,
2879 lib_watchdog_ensure,
Qnil);
2883 ip_mainloop_watchdog(argc, argv,
self)
2888 struct tcltkip *ptr = get_ip(
self);
2891 if (deleted_ip(ptr)) {
2895 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2916 _thread_call_proc_core(
arg)
2924 _thread_call_proc_ensure(
arg)
2933 _thread_call_proc(
arg)
2939 _thread_call_proc_ensure, (
VALUE)q);
2943 #ifdef HAVE_PROTOTYPES
2944 _thread_call_proc_value(
VALUE th)
2946 _thread_call_proc_value(th)
2954 lib_thread_callback(argc, argv,
self)
2991 ret =
rb_protect(_thread_call_proc_value, th, &status);
3017 lib_do_one_event_core(argc, argv,
self,
is_ip)
3023 volatile VALUE vflags;
3034 flags = TCL_ALL_EVENTS | TCL_DONT_WAIT;
3041 flags |= TCL_DONT_WAIT;
3046 struct tcltkip *ptr = get_ip(
self);
3049 if (deleted_ip(ptr)) {
3053 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
3055 flags |= TCL_DONT_WAIT;
3060 found_event = Tcl_DoOneEvent(flags);
3074 lib_do_one_event(argc, argv,
self)
3079 return lib_do_one_event_core(argc, argv,
self, 0);
3083 ip_do_one_event(argc, argv,
self)
3088 return lib_do_one_event_core(argc, argv,
self, 0);
3093 ip_set_exc_message(interp, exc)
3102 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
3104 Tcl_Encoding encoding;
3113 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
3119 encoding = (Tcl_Encoding)
NULL;
3138 Tcl_DStringInit(&dstr);
3139 Tcl_DStringFree(&dstr);
3140 Tcl_ExternalToUtfDString(encoding, buf,
RSTRING_LENINT(msg), &dstr);
3143 DUMP2(
"error message:%s", Tcl_DStringValue(&dstr));
3144 Tcl_DStringFree(&dstr);
3185 #ifdef HAVE_PROTOTYPES
3228 DUMP1(
"rb_protect: retry");
3229 exc =
rb_exc_new2(eTkCallbackRetry,
"retry jump error");
3237 DUMP1(
"rb_protect: redo");
3238 exc =
rb_exc_new2(eTkCallbackRedo,
"redo jump error");
3262 DUMP1(
"rb_protect: throw");
3263 exc =
rb_exc_new2(eTkCallbackThrow,
"throw jump error");
3272 sprintf(buf,
"unknown loncaljmp status %d", status);
3291 volatile VALUE backtrace;
3298 DUMP1(
"set backtrace");
3306 ip_set_exc_message(interp, exc);
3308 if (eclass == eTkCallbackReturn)
3311 if (eclass == eTkCallbackBreak)
3314 if (eclass == eTkCallbackContinue)
3315 return TCL_CONTINUE;
3331 if (
SYM2ID(reason) == ID_return)
3334 if (
SYM2ID(reason) == ID_break)
3337 if (
SYM2ID(reason) == ID_next)
3338 return TCL_CONTINUE;
3351 ret = TkStringValue(ret);
3352 DUMP1(
"Tcl_AppendResult");
3364 tcl_protect(interp, proc, data)
3371 #ifdef HAVE_NATIVETHREAD
3372 #ifndef RUBY_USE_NATIVE_THREAD
3374 rb_bug(
"cross-thread violation on tcl_protect()");
3383 int old_trapflag = rb_trap_immediate;
3384 rb_trap_immediate = 0;
3386 rb_trap_immediate = old_trapflag;
3394 #if TCL_MAJOR_VERSION >= 8
3395 ip_ruby_eval(clientData, interp, argc, argv)
3396 ClientData clientData;
3399 Tcl_Obj *
CONST argv[];
3401 ip_ruby_eval(clientData, interp, argc, argv)
3402 ClientData clientData;
3422 "wrong number of arguments (%d for 1)", argc - 1);
3424 char buf[
sizeof(
int)*8 + 1];
3426 sprintf(
buf,
"%d", argc-1);
3428 buf,
" for 1)", (
char *)
NULL);
3436 #if TCL_MAJOR_VERSION >= 8
3444 str = Tcl_GetStringFromObj(argv[1], &len);
3458 DUMP2(
"rb_eval_string(%s)", arg);
3462 #if TCL_MAJOR_VERSION >= 8
3473 ip_ruby_cmd_core(arg)
3479 DUMP1(
"call ip_ruby_cmd_core");
3482 ret =
rb_apply(arg->receiver, arg->method, arg->args);
3483 DUMP2(
"rb_apply return:%lx", ret);
3485 DUMP1(
"finish ip_ruby_cmd_core");
3490 #define SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER 1
3493 ip_ruby_cmd_receiver_const_get(
name)
3502 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3521 head = name =
strdup(name);
3524 if (*head ==
':') head += 2;
3545 ip_ruby_cmd_receiver_get(str)
3549 #if !SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3553 if (str[0] ==
':' || (
'A' <= str[0] && str[0] <=
'Z')) {
3555 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3556 receiver = ip_ruby_cmd_receiver_const_get(str);
3558 receiver =
rb_protect(ip_ruby_cmd_receiver_const_get, (
VALUE)str, &state);
3559 if (state)
return Qnil;
3561 }
else if (str[0] ==
'$') {
3573 memcpy(buf + 1, str, len);
3585 #if TCL_MAJOR_VERSION >= 8
3586 ip_ruby_cmd(clientData, interp, argc, argv)
3587 ClientData clientData;
3590 Tcl_Obj *
CONST argv[];
3592 ip_ruby_cmd(clientData, interp, argc, argv)
3593 ClientData clientData;
3610 if (interp == (Tcl_Interp*)
NULL) {
3634 #if TCL_MAJOR_VERSION >= 8
3635 str = Tcl_GetStringFromObj(argv[1], &len);
3639 DUMP2(
"receiver:%s",str);
3641 receiver = ip_ruby_cmd_receiver_get(str);
3645 "unknown class/module/global-variable '%s'", str);
3649 str,
"'", (
char *)
NULL);
3658 #if TCL_MAJOR_VERSION >= 8
3659 str = Tcl_GetStringFromObj(argv[2], &len);
3669 #if TCL_MAJOR_VERSION >= 8
3670 str = Tcl_GetStringFromObj(argv[i], &len);
3676 DUMP2(
"arg:%s",str);
3677 #ifndef HAVE_STRUCT_RARRAY_LEN
3696 code = tcl_protect(interp, ip_ruby_cmd_core, (
VALUE)arg);
3709 #if TCL_MAJOR_VERSION >= 8
3710 #ifdef HAVE_PROTOTYPES
3711 ip_InterpExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3712 int argc, Tcl_Obj *
CONST argv[])
3714 ip_InterpExitObjCmd(clientData, interp, argc, argv)
3715 ClientData clientData;
3718 Tcl_Obj *
CONST argv[];
3721 #ifdef HAVE_PROTOTYPES
3722 ip_InterpExitCommand(ClientData clientData, Tcl_Interp *interp,
3723 int argc,
char *argv[])
3725 ip_InterpExitCommand(clientData, interp, argc, argv)
3726 ClientData clientData;
3733 DUMP1(
"start ip_InterpExitCommand");
3734 if (interp != (Tcl_Interp*)
NULL
3735 && !Tcl_InterpDeleted(interp)
3737 && !ip_null_namespace(interp)
3743 if (!Tcl_InterpDeleted(interp)) {
3746 Tcl_DeleteInterp(interp);
3754 #if TCL_MAJOR_VERSION >= 8
3755 #ifdef HAVE_PROTOTYPES
3756 ip_RubyExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3757 int argc, Tcl_Obj *
CONST argv[])
3759 ip_RubyExitObjCmd(clientData, interp, argc, argv)
3760 ClientData clientData;
3763 Tcl_Obj *
CONST argv[];
3766 #ifdef HAVE_PROTOTYPES
3767 ip_RubyExitCommand(ClientData clientData, Tcl_Interp *interp,
3768 int argc,
char *argv[])
3770 ip_RubyExitCommand(clientData, interp, argc, argv)
3771 ClientData clientData;
3780 #if TCL_MAJOR_VERSION < 8
3785 DUMP1(
"start ip_RubyExitCommand");
3787 #if TCL_MAJOR_VERSION >= 8
3789 cmd = Tcl_GetStringFromObj(argv[0], (
int*)
NULL);
3792 if (argc < 1 || argc > 2) {
3795 "wrong number of arguments: should be \"",
3796 cmd,
" ?returnCode?\"", (
char *)
NULL);
3800 if (interp == (Tcl_Interp*)
NULL)
return TCL_OK;
3805 if (!Tcl_InterpDeleted(interp)) {
3808 Tcl_DeleteInterp(interp);
3818 "fail to call \"", cmd,
"\"", (
char *)
NULL);
3827 #if TCL_MAJOR_VERSION >= 8
3828 if (Tcl_GetIntFromObj(interp, argv[1], &state) ==
TCL_ERROR) {
3832 param = Tcl_GetStringFromObj(argv[1], (
int*)
NULL);
3834 state = (
int)
strtol(argv[1], &endptr, 0);
3837 "expected integer but got \"",
3838 argv[1],
"\"", (
char *)
NULL);
3846 param,
"\"", (
char *)
NULL);
3857 "wrong number of arguments: should be \"",
3858 cmd,
" ?returnCode?\"", (
char *)
NULL);
3871 #if TCL_MAJOR_VERSION >= 8
3872 static int ip_rbUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
3873 Tcl_Obj *
CONST []));
3875 ip_rbUpdateObjCmd(clientData, interp, objc, objv)
3876 ClientData clientData;
3879 Tcl_Obj *
CONST objv[];
3881 static int ip_rbUpdateCommand
_((ClientData, Tcl_Interp *,
int,
char *[]));
3883 ip_rbUpdateCommand(clientData, interp, objc, objv)
3884 ClientData clientData;
3896 DUMP1(
"Ruby's 'update' is called");
3897 if (interp == (Tcl_Interp*)
NULL) {
3902 #ifdef HAVE_NATIVETHREAD
3903 #ifndef RUBY_USE_NATIVE_THREAD
3905 rb_bug(
"cross-thread violation on ip_ruby_eval()");
3913 flags = TCL_DONT_WAIT;
3915 }
else if (objc == 2) {
3916 #if TCL_MAJOR_VERSION >= 8
3917 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
3918 "option", 0, &optionIndex) !=
TCL_OK) {
3921 switch ((
enum updateOptions) optionIndex) {
3923 flags = TCL_IDLE_EVENTS;
3927 rb_bug(
"ip_rbUpdateObjCmd: bad option index to UpdateOptions");
3931 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
3933 "\": must be idletasks", (
char *)
NULL);
3936 flags = TCL_IDLE_EVENTS;
3939 #ifdef Tcl_WrongNumArgs
3940 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
3942 # if TCL_MAJOR_VERSION >= 8
3945 Tcl_GetStringFromObj(objv[0], &dummy),
3950 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
3981 if (rb_trap_pending) {
3997 DUMP1(
"finish Ruby's 'update'");
4010 static void rb_threadUpdateProc
_((ClientData));
4012 rb_threadUpdateProc(clientData)
4013 ClientData clientData;
4017 DUMP1(
"threadUpdateProc is called");
4024 #if TCL_MAJOR_VERSION >= 8
4025 static int ip_rb_threadUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
4026 Tcl_Obj *
CONST []));
4028 ip_rb_threadUpdateObjCmd(clientData, interp, objc, objv)
4029 ClientData clientData;
4032 Tcl_Obj *
CONST objv[];
4034 static int ip_rb_threadUpdateCommand
_((ClientData, Tcl_Interp *,
int,
4037 ip_rb_threadUpdateCommand(clientData, interp, objc, objv)
4038 ClientData clientData;
4047 static CONST char *updateOptions[] = {
"idletasks", (
char *)
NULL};
4052 DUMP1(
"Ruby's 'thread_update' is called");
4053 if (interp == (Tcl_Interp*)
NULL) {
4058 #ifdef HAVE_NATIVETHREAD
4059 #ifndef RUBY_USE_NATIVE_THREAD
4061 rb_bug(
"cross-thread violation on ip_rb_threadUpdateCommand()");
4067 ||
NIL_P(eventloop_thread) || eventloop_thread == current_thread) {
4068 #if TCL_MAJOR_VERSION >= 8
4069 DUMP1(
"call ip_rbUpdateObjCmd");
4070 return ip_rbUpdateObjCmd(clientData, interp, objc, objv);
4072 DUMP1(
"call ip_rbUpdateCommand");
4073 return ip_rbUpdateCommand(clientData, interp, objc, objv);
4077 DUMP1(
"start Ruby's 'thread_update' body");
4082 flags = TCL_DONT_WAIT;
4084 }
else if (objc == 2) {
4085 #if TCL_MAJOR_VERSION >= 8
4086 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
4087 "option", 0, &optionIndex) !=
TCL_OK) {
4090 switch ((
enum updateOptions) optionIndex) {
4092 flags = TCL_IDLE_EVENTS;
4096 rb_bug(
"ip_rb_threadUpdateObjCmd: bad option index to UpdateOptions");
4100 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
4102 "\": must be idletasks", (
char *)
NULL);
4105 flags = TCL_IDLE_EVENTS;
4108 #ifdef Tcl_WrongNumArgs
4109 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
4111 # if TCL_MAJOR_VERSION >= 8
4114 Tcl_GetStringFromObj(objv[0], &dummy),
4119 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
4125 DUMP1(
"pass argument check");
4135 DUMP1(
"set idle proc");
4142 DUMP1(
"wait for complete idle proc");
4146 if (
NIL_P(eventloop_thread)) {
4152 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
4162 DUMP1(
"finish Ruby's 'thread_update'");
4170 #if TCL_MAJOR_VERSION >= 8
4171 static int ip_rbVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4172 Tcl_Obj *
CONST []));
4173 static int ip_rb_threadVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4174 Tcl_Obj *
CONST []));
4175 static int ip_rbTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4176 Tcl_Obj *
CONST []));
4177 static int ip_rb_threadTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4178 Tcl_Obj *
CONST []));
4180 static int ip_rbVwaitCommand
_((ClientData, Tcl_Interp *,
int,
char *[]));
4181 static int ip_rb_threadVwaitCommand
_((ClientData, Tcl_Interp *,
int,
4183 static int ip_rbTkWaitCommand
_((ClientData, Tcl_Interp *,
int,
char *[]));
4184 static int ip_rb_threadTkWaitCommand
_((ClientData, Tcl_Interp *,
int,
4188 #if TCL_MAJOR_VERSION >= 8
4189 static char *VwaitVarProc
_((ClientData, Tcl_Interp *,
4192 VwaitVarProc(clientData, interp, name1, name2, flags)
4193 ClientData clientData;
4199 static char *VwaitVarProc
_((ClientData, Tcl_Interp *,
char *,
char *,
int));
4201 VwaitVarProc(clientData, interp, name1, name2, flags)
4202 ClientData clientData;
4209 int *
donePtr = (
int *) clientData;
4215 #if TCL_MAJOR_VERSION >= 8
4217 ip_rbVwaitObjCmd(clientData, interp, objc, objv)
4218 ClientData clientData;
4221 Tcl_Obj *
CONST objv[];
4224 ip_rbVwaitCommand(clientData, interp, objc, objv)
4225 ClientData clientData;
4236 DUMP1(
"Ruby's 'vwait' is called");
4237 if (interp == (Tcl_Interp*)
NULL) {
4245 && eventloop_thread !=
Qnil
4247 #if TCL_MAJOR_VERSION >= 8
4248 DUMP1(
"call ip_rb_threadVwaitObjCmd");
4249 return ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv);
4251 DUMP1(
"call ip_rb_threadVwaitCommand");
4252 return ip_rb_threadVwaitCommand(clientData, interp, objc, objv);
4258 #ifdef HAVE_NATIVETHREAD
4259 #ifndef RUBY_USE_NATIVE_THREAD
4261 rb_bug(
"cross-thread violation on ip_rbVwaitCommand()");
4269 #ifdef Tcl_WrongNumArgs
4270 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4275 #if TCL_MAJOR_VERSION >= 8
4277 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4279 nameString = objv[0];
4282 nameString,
" name\"", (
char *)
NULL);
4294 #if TCL_MAJOR_VERSION >= 8
4297 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4299 nameString = objv[1];
4309 ret = Tcl_TraceVar(interp, nameString,
4310 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4311 VwaitVarProc, (ClientData) &done);
4316 #if TCL_MAJOR_VERSION >= 8
4331 Tcl_UntraceVar(interp, nameString,
4332 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4333 VwaitVarProc, (ClientData) &done);
4339 #if TCL_MAJOR_VERSION >= 8
4359 if (rb_trap_pending) {
4361 #if TCL_MAJOR_VERSION >= 8
4380 "\": would wait forever", (
char *)
NULL);
4384 #if TCL_MAJOR_VERSION >= 8
4391 #if TCL_MAJOR_VERSION >= 8
4402 #if TCL_MAJOR_VERSION >= 8
4403 static char *WaitVariableProc
_((ClientData, Tcl_Interp *,
4406 WaitVariableProc(clientData, interp, name1, name2, flags)
4407 ClientData clientData;
4413 static char *WaitVariableProc
_((ClientData, Tcl_Interp *,
4414 char *,
char *,
int));
4416 WaitVariableProc(clientData, interp, name1, name2, flags)
4417 ClientData clientData;
4424 int *donePtr = (
int *) clientData;
4427 return (
char *)
NULL;
4430 static void WaitVisibilityProc
_((ClientData, XEvent *));
4432 WaitVisibilityProc(clientData,
eventPtr)
4433 ClientData clientData;
4436 int *donePtr = (
int *) clientData;
4438 if (eventPtr->type == VisibilityNotify) {
4441 if (eventPtr->type == DestroyNotify) {
4446 static void WaitWindowProc
_((ClientData, XEvent *));
4448 WaitWindowProc(clientData, eventPtr)
4449 ClientData clientData;
4452 int *donePtr = (
int *) clientData;
4454 if (eventPtr->type == DestroyNotify) {
4459 #if TCL_MAJOR_VERSION >= 8
4461 ip_rbTkWaitObjCmd(clientData, interp, objc, objv)
4462 ClientData clientData;
4465 Tcl_Obj *
CONST objv[];
4468 ip_rbTkWaitCommand(clientData, interp, objc, objv)
4469 ClientData clientData;
4475 Tk_Window
tkwin = (Tk_Window) clientData;
4485 DUMP1(
"Ruby's 'tkwait' is called");
4486 if (interp == (Tcl_Interp*)
NULL) {
4494 && eventloop_thread !=
Qnil
4496 #if TCL_MAJOR_VERSION >= 8
4497 DUMP1(
"call ip_rb_threadTkWaitObjCmd");
4498 return ip_rb_threadTkWaitObjCmd((ClientData)tkwin, interp, objc, objv);
4500 DUMP1(
"call ip_rb_threadTkWaitCommand");
4501 return ip_rb_threadTkWwaitCommand((ClientData)tkwin, interp, objc, objv);
4510 #ifdef Tcl_WrongNumArgs
4511 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
4516 #if TCL_MAJOR_VERSION >= 8
4518 Tcl_GetStringFromObj(objv[0], &dummy),
4519 " variable|visibility|window name\"",
4523 objv[0],
" variable|visibility|window name\"",
4534 #if TCL_MAJOR_VERSION >= 8
4545 ret = Tcl_GetIndexFromObj(interp, objv[1],
4546 (
CONST84 char **)optionStrings,
4547 "option", 0, &index);
4560 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
4563 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
4566 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
4570 "\": must be variable, visibility, or window",
4581 #if TCL_MAJOR_VERSION >= 8
4584 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
4586 nameString = objv[2];
4602 ret = Tcl_TraceVar(interp, nameString,
4603 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4604 WaitVariableProc, (ClientData) &done);
4609 #if TCL_MAJOR_VERSION >= 8
4623 Tcl_UntraceVar(interp, nameString,
4624 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4625 WaitVariableProc, (ClientData) &done);
4627 #if TCL_MAJOR_VERSION >= 8
4652 if (rb_trap_pending) {
4669 window = Tk_NameToWindow(interp, nameString, tkwin);
4672 if (window == NULL) {
4674 "no main-window (not Tk application?)",
4677 #if TCL_MAJOR_VERSION >= 8
4684 Tk_CreateEventHandler(window,
4685 VisibilityChangeMask|StructureNotifyMask,
4686 WaitVisibilityProc, (ClientData) &done);
4696 #if TCL_MAJOR_VERSION >= 8
4716 if (rb_trap_pending) {
4718 #if TCL_MAJOR_VERSION >= 8
4736 "\" was deleted before its visibility changed",
4741 #if TCL_MAJOR_VERSION >= 8
4751 #if TCL_MAJOR_VERSION >= 8
4755 Tk_DeleteEventHandler(window,
4756 VisibilityChangeMask|StructureNotifyMask,
4757 WaitVisibilityProc, (ClientData) &done);
4771 window = Tk_NameToWindow(interp, nameString, tkwin);
4774 #if TCL_MAJOR_VERSION >= 8
4778 if (window == NULL) {
4780 "no main-window (not Tk application?)",
4787 Tk_CreateEventHandler(window, StructureNotifyMask,
4788 WaitWindowProc, (ClientData) &done);
4815 if (rb_trap_pending) {
4847 #if TCL_MAJOR_VERSION >= 8
4848 static char *rb_threadVwaitProc
_((ClientData, Tcl_Interp *,
4851 rb_threadVwaitProc(clientData, interp, name1, name2, flags)
4852 ClientData clientData;
4858 static char *rb_threadVwaitProc
_((ClientData, Tcl_Interp *,
4859 char *,
char *,
int));
4861 rb_threadVwaitProc(clientData, interp, name1, name2, flags)
4862 ClientData clientData;
4871 if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
4878 return (
char *)
NULL;
4881 #define TKWAIT_MODE_VISIBILITY 1
4882 #define TKWAIT_MODE_DESTROY 2
4884 static void rb_threadWaitVisibilityProc
_((ClientData, XEvent *));
4886 rb_threadWaitVisibilityProc(clientData, eventPtr)
4887 ClientData clientData;
4892 if (eventPtr->type == VisibilityNotify) {
4895 if (eventPtr->type == DestroyNotify) {
4901 static void rb_threadWaitWindowProc
_((ClientData, XEvent *));
4903 rb_threadWaitWindowProc(clientData, eventPtr)
4904 ClientData clientData;
4909 if (eventPtr->type == DestroyNotify) {
4915 #if TCL_MAJOR_VERSION >= 8
4917 ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv)
4918 ClientData clientData;
4921 Tcl_Obj *
CONST objv[];
4924 ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
4925 ClientData clientData;
4938 DUMP1(
"Ruby's 'thread_vwait' is called");
4939 if (interp == (Tcl_Interp*)NULL) {
4946 #if TCL_MAJOR_VERSION >= 8
4947 DUMP1(
"call ip_rbVwaitObjCmd");
4948 return ip_rbVwaitObjCmd(clientData, interp, objc, objv);
4950 DUMP1(
"call ip_rbVwaitCommand");
4951 return ip_rbVwaitCommand(clientData, interp, objc, objv);
4959 #ifdef Tcl_WrongNumArgs
4960 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4965 #if TCL_MAJOR_VERSION >= 8
4967 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4969 nameString = objv[0];
4972 nameString,
" name\"", (
char *) NULL);
4981 #if TCL_MAJOR_VERSION >= 8
4984 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4986 nameString = objv[1];
5006 ret = Tcl_TraceVar(interp, nameString,
5007 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5008 rb_threadVwaitProc, (ClientData) param);
5014 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5024 #if TCL_MAJOR_VERSION >= 8
5034 while(!param->
done) {
5038 if (
NIL_P(eventloop_thread)) {
5046 if (param->
done > 0) {
5047 Tcl_UntraceVar(interp, nameString,
5048 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5049 rb_threadVwaitProc, (ClientData) param);
5053 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5065 #if TCL_MAJOR_VERSION >= 8
5072 #if TCL_MAJOR_VERSION >= 8
5074 ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv)
5075 ClientData clientData;
5078 Tcl_Obj *
CONST objv[];
5081 ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
5082 ClientData clientData;
5089 Tk_Window tkwin = (Tk_Window) clientData;
5092 static CONST char *optionStrings[] = {
"variable",
"visibility",
"window",
5101 DUMP1(
"Ruby's 'thread_tkwait' is called");
5102 if (interp == (Tcl_Interp*)NULL) {
5109 #if TCL_MAJOR_VERSION >= 8
5110 DUMP1(
"call ip_rbTkWaitObjCmd");
5111 DUMP2(
"eventloop_thread %lx", eventloop_thread);
5112 DUMP2(
"current_thread %lx", current_thread);
5113 return ip_rbTkWaitObjCmd(clientData, interp, objc, objv);
5115 DUMP1(
"call rb_VwaitCommand");
5116 return ip_rbTkWaitCommand(clientData, interp, objc, objv);
5126 #ifdef Tcl_WrongNumArgs
5127 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
5132 #if TCL_MAJOR_VERSION >= 8
5134 Tcl_GetStringFromObj(objv[0], &dummy),
5135 " variable|visibility|window name\"",
5139 objv[0],
" variable|visibility|window name\"",
5151 #if TCL_MAJOR_VERSION >= 8
5161 ret = Tcl_GetIndexFromObj(interp, objv[1],
5162 (
CONST84 char **)optionStrings,
5163 "option", 0, &index);
5175 size_t length =
strlen(objv[1]);
5177 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
5180 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
5183 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
5187 "\": must be variable, visibility, or window",
5199 #if TCL_MAJOR_VERSION >= 8
5202 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
5204 nameString = objv[2];
5217 switch ((
enum options) index) {
5228 ret = Tcl_TraceVar(interp, nameString,
5229 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5230 rb_threadVwaitProc, (ClientData) param);
5236 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5246 #if TCL_MAJOR_VERSION >= 8
5258 while(!param->
done) {
5262 if (
NIL_P(eventloop_thread)) {
5270 if (param->
done > 0) {
5271 Tcl_UntraceVar(interp, nameString,
5272 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5273 rb_threadVwaitProc, (ClientData) param);
5276 #if TCL_MAJOR_VERSION >= 8
5292 window = Tk_NameToWindow(interp, nameString, tkwin);
5301 window = Tk_NameToWindow(interp, nameString, tkwin);
5308 if (window == NULL) {
5310 "no main-window (not Tk application?)",
5316 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5326 #if TCL_MAJOR_VERSION >= 8
5335 Tk_CreateEventHandler(window,
5336 VisibilityChangeMask|StructureNotifyMask,
5337 rb_threadWaitVisibilityProc, (ClientData) param);
5349 if (
NIL_P(eventloop_thread)) {
5359 Tk_DeleteEventHandler(window,
5360 VisibilityChangeMask|StructureNotifyMask,
5361 rb_threadWaitVisibilityProc,
5362 (ClientData) param);
5365 if (param->
done != 1) {
5368 "\" was deleted before its visibility changed",
5376 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5386 #if TCL_MAJOR_VERSION >= 8
5397 #if TCL_MAJOR_VERSION >= 8
5413 window = Tk_NameToWindow(interp, nameString, tkwin);
5422 window = Tk_NameToWindow(interp, nameString, tkwin);
5429 #if TCL_MAJOR_VERSION >= 8
5433 if (window == NULL) {
5435 "no main-window (not Tk application?)",
5441 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5458 Tk_CreateEventHandler(window, StructureNotifyMask,
5459 rb_threadWaitWindowProc, (ClientData) param);
5470 if (
NIL_P(eventloop_thread)) {
5491 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5514 ip_thread_vwait(
self,
var)
5528 ip_thread_tkwait(
self, mode,
target)
5545 #if TCL_MAJOR_VERSION >= 8
5556 DUMP1(
"delete slaves");
5560 if (!Tcl_InterpDeleted(ip) &&
Tcl_Eval(ip,
"interp slaves") ==
TCL_OK) {
5561 slave_list = Tcl_GetObjResult(ip);
5564 if (Tcl_ListObjLength((Tcl_Interp*)NULL, slave_list, &len) ==
TCL_OK) {
5565 for(i = 0; i <
len; i++) {
5566 Tcl_ListObjIndex((Tcl_Interp*)NULL, slave_list, i, &elem);
5568 if (elem == (Tcl_Obj*)NULL)
continue;
5574 slave_name = Tcl_GetStringFromObj(elem, (
int*)NULL);
5575 DUMP2(
"delete slave:'%s'", slave_name);
5579 slave = Tcl_GetSlave(ip, slave_name);
5580 if (slave == (Tcl_Interp*)NULL)
continue;
5582 if (!Tcl_InterpDeleted(slave)) {
5586 Tcl_DeleteInterp(slave);
5610 DUMP1(
"delete slaves");
5615 slave_list = ip->result;
5616 if (Tcl_SplitList((Tcl_Interp*)NULL,
5617 slave_list, &argc, &argv) ==
TCL_OK) {
5618 for(i = 0; i <
argc; i++) {
5619 slave_name = argv[
i];
5621 DUMP2(
"delete slave:'%s'", slave_name);
5623 slave = Tcl_GetSlave(ip, slave_name);
5624 if (slave == (Tcl_Interp*)NULL)
continue;
5626 if (!Tcl_InterpDeleted(slave)) {
5630 Tcl_DeleteInterp(slave);
5643 #ifdef HAVE_PROTOTYPES
5644 lib_mark_at_exit(
VALUE self)
5646 lib_mark_at_exit(
self)
5654 #if TCL_MAJOR_VERSION >= 8
5655 #ifdef HAVE_PROTOTYPES
5656 ip_null_proc(ClientData clientData, Tcl_Interp *interp,
5657 int argc, Tcl_Obj *
CONST argv[])
5659 ip_null_proc(clientData, interp, argc, argv)
5660 ClientData clientData;
5663 Tcl_Obj *
CONST argv[];
5666 #ifdef HAVE_PROTOTYPES
5667 ip_null_proc(ClientData clientData, Tcl_Interp *interp,
int argc,
char *argv[])
5669 ip_null_proc(clientData, interp, argc, argv)
5670 ClientData clientData;
5696 DUMP1(
"start ip_finalize");
5698 if (ip == (Tcl_Interp*)NULL) {
5699 DUMP1(
"ip is NULL");
5703 if (Tcl_InterpDeleted(ip)) {
5704 DUMP2(
"ip(%p) is already deleted", ip);
5708 #if TCL_NAMESPACE_DEBUG
5709 if (ip_null_namespace(ip)) {
5710 DUMP2(
"ip(%p) has null namespace", ip);
5732 #if TCL_MAJOR_VERSION >= 8
5733 Tcl_CreateObjCommand(ip,
"ruby", ip_null_proc,
5734 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5735 Tcl_CreateObjCommand(ip,
"ruby_eval", ip_null_proc,
5736 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5737 Tcl_CreateObjCommand(ip,
"ruby_cmd", ip_null_proc,
5738 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5741 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5743 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5745 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5757 DUMP1(
"check `destroy'");
5759 DUMP1(
"call `destroy .'");
5764 DUMP1(
"destroy root widget");
5778 Tk_Window win = Tk_MainWindow(ip);
5780 DUMP1(
"call Tk_DestroyWindow");
5783 if (! (((Tk_FakeWin*)win)->flags & TK_ALREADY_DEAD)) {
5784 Tk_DestroyWindow(win);
5792 DUMP1(
"check `finalize-hook-proc'");
5794 DUMP2(
"call finalize hook proc '%s'", finalize_hook_name);
5802 DUMP1(
"check `foreach' & `after'");
5805 DUMP1(
"cancel after callbacks");
5808 Tcl_GlobalEval(ip,
"catch {foreach id [after info] {after cancel $id}}");
5815 DUMP1(
"finish ip_finalize");
5829 DUMP2(
"free Tcl Interp %lx", (
unsigned long)ptr->ip);
5834 if ( ptr->ip != (Tcl_Interp*)NULL
5835 && !Tcl_InterpDeleted(ptr->ip)
5836 && Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL
5837 && !Tcl_InterpDeleted(Tcl_GetMaster(ptr->ip)) ) {
5838 DUMP2(
"parent IP(%lx) is not deleted",
5839 (
unsigned long)Tcl_GetMaster(ptr->ip));
5840 DUMP2(
"slave IP(%lx) should not be deleted",
5841 (
unsigned long)ptr->ip);
5848 if (ptr->ip == (Tcl_Interp*)NULL) {
5849 DUMP1(
"ip_free is called for deleted IP");
5856 if (!Tcl_InterpDeleted(ptr->ip)) {
5859 Tcl_DeleteInterp(ptr->ip);
5863 ptr->ip = (Tcl_Interp*)NULL;
5870 DUMP1(
"complete freeing Tcl Interp");
5889 #if TCL_MAJOR_VERSION >= 8
5890 DUMP1(
"Tcl_CreateObjCommand(\"vwait\")");
5891 Tcl_CreateObjCommand(interp,
"vwait", ip_rbVwaitObjCmd,
5892 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5894 DUMP1(
"Tcl_CreateCommand(\"vwait\")");
5896 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5900 #if TCL_MAJOR_VERSION >= 8
5901 DUMP1(
"Tcl_CreateObjCommand(\"tkwait\")");
5902 Tcl_CreateObjCommand(interp,
"tkwait", ip_rbTkWaitObjCmd,
5903 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5905 DUMP1(
"Tcl_CreateCommand(\"tkwait\")");
5907 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5911 #if TCL_MAJOR_VERSION >= 8
5912 DUMP1(
"Tcl_CreateObjCommand(\"thread_vwait\")");
5913 Tcl_CreateObjCommand(interp,
"thread_vwait", ip_rb_threadVwaitObjCmd,
5914 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5916 DUMP1(
"Tcl_CreateCommand(\"thread_vwait\")");
5918 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5922 #if TCL_MAJOR_VERSION >= 8
5923 DUMP1(
"Tcl_CreateObjCommand(\"thread_tkwait\")");
5924 Tcl_CreateObjCommand(interp,
"thread_tkwait", ip_rb_threadTkWaitObjCmd,
5925 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5927 DUMP1(
"Tcl_CreateCommand(\"thread_tkwait\")");
5929 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5933 #if TCL_MAJOR_VERSION >= 8
5934 DUMP1(
"Tcl_CreateObjCommand(\"update\")");
5935 Tcl_CreateObjCommand(interp,
"update", ip_rbUpdateObjCmd,
5936 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5938 DUMP1(
"Tcl_CreateCommand(\"update\")");
5940 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5944 #if TCL_MAJOR_VERSION >= 8
5945 DUMP1(
"Tcl_CreateObjCommand(\"thread_update\")");
5946 Tcl_CreateObjCommand(interp,
"thread_update", ip_rb_threadUpdateObjCmd,
5947 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5949 DUMP1(
"Tcl_CreateCommand(\"thread_update\")");
5951 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5956 #if TCL_MAJOR_VERSION >= 8
5958 ip_rb_replaceSlaveTkCmdsObjCmd(clientData, interp, objc, objv)
5959 ClientData clientData;
5962 Tcl_Obj *
CONST objv[];
5965 ip_rb_replaceSlaveTkCmdsCommand(clientData, interp, objc, objv)
5966 ClientData clientData;
5977 #ifdef Tcl_WrongNumArgs
5978 Tcl_WrongNumArgs(interp, 1, objv,
"slave_name");
5981 #if TCL_MAJOR_VERSION >= 8
5982 nameString = Tcl_GetStringFromObj(objv[0], (
int*)NULL);
5984 nameString = objv[0];
5987 nameString,
" slave_name\"", (
char *) NULL);
5991 #if TCL_MAJOR_VERSION >= 8
5992 slave_name = Tcl_GetStringFromObj(objv[1], (
int*)NULL);
5994 slave_name = objv[1];
5997 slave = Tcl_GetSlave(interp, slave_name);
5998 if (slave == NULL) {
6000 slave_name,
"\"", (
char *)NULL);
6003 mainWin = Tk_MainWindow(slave);
6006 #if TCL_MAJOR_VERSION >= 8
6007 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6008 Tcl_CreateObjCommand(slave,
"exit", ip_InterpExitObjCmd,
6009 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6011 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6013 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6023 #if TCL_MAJOR_VERSION >= 8
6024 static int ip_rbNamespaceObjCmd
_((ClientData, Tcl_Interp *,
int,
6025 Tcl_Obj *
CONST []));
6027 ip_rbNamespaceObjCmd(clientData, interp, objc, objv)
6028 ClientData clientData;
6031 Tcl_Obj *
CONST objv[];
6039 "invalid command name \"namespace\"", (
char*)NULL);
6046 if (info.isNativeObjectProc) {
6059 for(i = 0; i <
objc; i++) {
6061 argv[
i] = Tcl_GetStringFromObj(objv[i], (
int*)NULL);
6063 argv[
objc] = (
char *)NULL;
6065 ret = (*(info.proc))(info.clientData,
interp,
6069 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
6091 #if TCL_MAJOR_VERSION >= 8
6092 Tcl_CmdInfo orig_info;
6098 if (orig_info.isNativeObjectProc) {
6099 Tcl_CreateObjCommand(interp,
"__orig_namespace_command__",
6100 orig_info.objProc, orig_info.objClientData,
6101 orig_info.deleteProc);
6104 orig_info.proc, orig_info.clientData,
6105 orig_info.deleteProc);
6108 Tcl_CreateObjCommand(interp,
"namespace", ip_rbNamespaceObjCmd,
6109 (ClientData) 0, (Tcl_CmdDeleteProc *)NULL);
6116 #ifdef HAVE_PROTOTYPES
6117 ip_CallWhenDeleted(ClientData clientData, Tcl_Interp *ip)
6119 ip_CallWhenDeleted(clientData, ip)
6120 ClientData clientData;
6127 DUMP1(
"start ip_CallWhenDeleted");
6133 DUMP1(
"finish ip_CallWhenDeleted");
6141 ip_init(argc, argv,
self)
6151 Tk_Window mainWin = (Tk_Window)NULL;
6156 "Cannot create a TclTkIp object at level %d",
6165 #ifdef RUBY_USE_NATIVE_THREAD
6166 ptr->tk_thread_id = 0;
6173 DUMP1(
"Tcl_CreateInterp");
6175 if (ptr->
ip == NULL) {
6196 #if TCL_MAJOR_VERSION >= 8
6197 #if TCL_NAMESPACE_DEBUG
6198 DUMP1(
"get current namespace");
6199 if ((ptr->default_ns = Tcl_GetCurrentNamespace(ptr->
ip))
6200 == (Tcl_Namespace*)NULL) {
6208 current_interp = ptr->
ip;
6213 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
6214 call_tclkit_init_script(current_interp);
6216 # if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
6218 Tcl_DString encodingName;
6219 Tcl_GetEncodingNameFromEnvironment(&encodingName);
6220 if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(NULL))) {
6222 Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName));
6224 Tcl_SetVar(current_interp,
"tclkit_system_encoding", Tcl_DStringValue(&encodingName), 0);
6225 Tcl_DStringFree(&encodingName);
6231 Tcl_Eval(ptr->
ip,
"set argc 0; set argv {}; set argv0 tcltklib.so");
6243 Tcl_Eval(ptr->
ip,
"set argc [llength $argv]");
6247 if (!
NIL_P(argv0)) {
6250 Tcl_SetVar(ptr->
ip,
"argv0",
"ruby", TCL_GLOBAL_ONLY);
6264 #if (defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT) && (!defined KIT_LITE) && (10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION == 85)
6271 Tcl_Eval(ptr->
ip,
"catch {rename ::chan ::_tmp_chan}");
6275 Tcl_Eval(ptr->
ip,
"catch {rename ::_tmp_chan ::chan}");
6302 DUMP1(
"Tcl_StaticPackage(\"Tk\")");
6303 #if TCL_MAJOR_VERSION >= 8
6304 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init, Tk_SafeInit);
6306 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init,
6307 (Tcl_PackageInitProc *) NULL);
6310 #ifdef RUBY_USE_NATIVE_THREAD
6312 ptr->tk_thread_id = Tcl_GetCurrentThread();
6315 mainWin = Tk_MainWindow(ptr->
ip);
6316 Tk_Preserve((ClientData)mainWin);
6320 #if TCL_MAJOR_VERSION >= 8
6321 DUMP1(
"Tcl_CreateObjCommand(\"ruby\")");
6322 Tcl_CreateObjCommand(ptr->
ip,
"ruby", ip_ruby_eval, (ClientData)NULL,
6323 (Tcl_CmdDeleteProc *)NULL);
6324 DUMP1(
"Tcl_CreateObjCommand(\"ruby_eval\")");
6325 Tcl_CreateObjCommand(ptr->
ip,
"ruby_eval", ip_ruby_eval, (ClientData)NULL,
6326 (Tcl_CmdDeleteProc *)NULL);
6327 DUMP1(
"Tcl_CreateObjCommand(\"ruby_cmd\")");
6328 Tcl_CreateObjCommand(ptr->
ip,
"ruby_cmd", ip_ruby_cmd, (ClientData)NULL,
6329 (Tcl_CmdDeleteProc *)NULL);
6331 DUMP1(
"Tcl_CreateCommand(\"ruby\")");
6333 (Tcl_CmdDeleteProc *)NULL);
6334 DUMP1(
"Tcl_CreateCommand(\"ruby_eval\")");
6336 (Tcl_CmdDeleteProc *)NULL);
6337 DUMP1(
"Tcl_CreateCommand(\"ruby_cmd\")");
6339 (Tcl_CmdDeleteProc *)NULL);
6343 #if TCL_MAJOR_VERSION >= 8
6344 DUMP1(
"Tcl_CreateObjCommand(\"interp_exit\")");
6345 Tcl_CreateObjCommand(ptr->
ip,
"interp_exit", ip_InterpExitObjCmd,
6346 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6347 DUMP1(
"Tcl_CreateObjCommand(\"ruby_exit\")");
6348 Tcl_CreateObjCommand(ptr->
ip,
"ruby_exit", ip_RubyExitObjCmd,
6349 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6350 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6351 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6352 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6354 DUMP1(
"Tcl_CreateCommand(\"interp_exit\")");
6356 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6357 DUMP1(
"Tcl_CreateCommand(\"ruby_exit\")");
6359 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6360 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6362 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6372 #if TCL_MAJOR_VERSION >= 8
6373 Tcl_CreateObjCommand(ptr->
ip,
"__replace_slave_tk_commands__",
6374 ip_rb_replaceSlaveTkCmdsObjCmd,
6375 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6378 ip_rb_replaceSlaveTkCmdsCommand,
6379 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6385 if (mainWin != (Tk_Window)NULL) {
6386 Tk_Release((ClientData)mainWin);
6393 ip_create_slave_core(interp, argc, argv)
6408 if (deleted_ip(master)) {
6410 "deleted master cannot create a new slave");
6416 if (Tcl_IsSafe(master->
ip) == 1) {
6430 if (
RTEST(with_tk)) {
6433 exc = tcltkip_init_tk(interp);
6443 #ifdef RUBY_USE_NATIVE_THREAD
6445 slave->tk_thread_id = master->tk_thread_id;
6455 "fail to create the new slave interpreter");
6457 #if TCL_MAJOR_VERSION >= 8
6458 #if TCL_NAMESPACE_DEBUG
6459 slave->default_ns = Tcl_GetCurrentNamespace(slave->
ip);
6469 #if TCL_MAJOR_VERSION >= 8
6470 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6471 Tcl_CreateObjCommand(slave->
ip,
"exit", ip_InterpExitObjCmd,
6472 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6474 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6476 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6486 #if TCL_MAJOR_VERSION >= 8
6487 Tcl_CreateObjCommand(slave->
ip,
"__replace_slave_tk_commands__",
6488 ip_rb_replaceSlaveTkCmdsObjCmd,
6489 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6492 ip_rb_replaceSlaveTkCmdsCommand,
6493 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6505 ip_create_slave(argc, argv,
self)
6510 struct tcltkip *master = get_ip(
self);
6516 if (deleted_ip(master)) {
6518 "deleted master cannot create a new slave interpreter");
6525 if (Tcl_IsSafe(master->
ip) != 1
6534 return tk_funcall(ip_create_slave_core, 2, callargv,
self);
6540 ip_is_slave_of_p(
self, master)
6547 if (Tcl_GetMaster(get_ip(
self)->ip) == get_ip(master)->ip) {
6556 #if defined(MAC_TCL) || defined(__WIN32__)
6557 #if TCL_MAJOR_VERSION < 8 \
6558 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) \
6559 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6560 && (TCL_RELEASE_LEVEL == TCL_ALPHA_RELEASE \
6561 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \
6562 && TCL_RELEASE_SERIAL < 2) ) )
6563 EXTERN void TkConsoleCreate
_((
void));
6565 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6566 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \
6567 && TCL_RELEASE_SERIAL == 0) \
6568 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \
6569 && TCL_RELEASE_SERIAL >= 2) )
6570 EXTERN void TkConsoleCreate_
_((
void));
6574 ip_create_console_core(interp, argc, argv)
6579 struct tcltkip *ptr = get_ip(interp);
6582 tcltkip_init_tk(interp);
6585 if (Tcl_GetVar(ptr->
ip,
"tcl_interactive",TCL_GLOBAL_ONLY) == (
char*)NULL) {
6586 Tcl_SetVar(ptr->
ip,
"tcl_interactive",
"0", TCL_GLOBAL_ONLY);
6589 #if TCL_MAJOR_VERSION > 8 \
6590 || (TCL_MAJOR_VERSION == 8 \
6591 && (TCL_MINOR_VERSION > 1 \
6592 || (TCL_MINOR_VERSION == 1 \
6593 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \
6594 && TCL_RELEASE_SERIAL >= 1) ) )
6595 Tk_InitConsoleChannels(ptr->
ip);
6597 if (Tk_CreateConsoleWindow(ptr->
ip) !=
TCL_OK) {
6601 #if defined(MAC_TCL) || defined(__WIN32__)
6602 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6603 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE && TCL_RELEASE_SERIAL == 0) \
6604 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE && TCL_RELEASE_SERIAL >= 2) )
6610 if (TkConsoleInit(ptr->
ip) !=
TCL_OK) {
6622 ip_create_console(
self)
6625 struct tcltkip *ptr = get_ip(
self);
6628 if (deleted_ip(ptr)) {
6637 ip_make_safe_core(interp, argc, argv)
6642 struct tcltkip *ptr = get_ip(interp);
6646 if (deleted_ip(ptr)) {
6661 #if TCL_MAJOR_VERSION >= 8
6662 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6663 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6664 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6666 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6668 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6678 struct tcltkip *ptr = get_ip(
self);
6681 if (deleted_ip(ptr)) {
6693 struct tcltkip *ptr = get_ip(
self);
6696 if (deleted_ip(ptr)) {
6700 if (Tcl_IsSafe(ptr->
ip)) {
6709 ip_allow_ruby_exit_p(
self)
6712 struct tcltkip *ptr = get_ip(
self);
6715 if (deleted_ip(ptr)) {
6728 ip_allow_ruby_exit_set(
self, val)
6731 struct tcltkip *ptr = get_ip(
self);
6737 if (deleted_ip(ptr)) {
6741 if (Tcl_IsSafe(ptr->
ip)) {
6743 "insecure operation on a safe interpreter");
6756 #if TCL_MAJOR_VERSION >= 8
6757 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6758 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6759 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6761 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6763 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6769 #if TCL_MAJOR_VERSION >= 8
6770 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6771 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6772 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6774 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6776 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6788 struct tcltkip *ptr = get_ip(
self);
6791 if (deleted_ip(ptr)) {
6792 DUMP1(
"delete deleted IP");
6799 DUMP1(
"delete interp");
6800 if (!Tcl_InterpDeleted(ptr->
ip)) {
6801 DUMP1(
"call ip_finalize");
6804 Tcl_DeleteInterp(ptr->
ip);
6816 ip_has_invalid_namespace_p(
self)
6819 struct tcltkip *ptr = get_ip(
self);
6821 if (ptr == (
struct tcltkip *)NULL || ptr->
ip == (Tcl_Interp *)NULL) {
6826 #if TCL_NAMESPACE_DEBUG
6827 if (rbtk_invalid_namespace(ptr)) {
6838 ip_is_deleted_p(
self)
6841 struct tcltkip *ptr = get_ip(
self);
6843 if (deleted_ip(ptr)) {
6851 ip_has_mainwindow_p_core(
self, argc, argv)
6856 struct tcltkip *ptr = get_ip(
self);
6860 }
else if (Tk_MainWindow(ptr->
ip) == (Tk_Window)NULL) {
6868 ip_has_mainwindow_p(
self)
6876 #if TCL_MAJOR_VERSION >= 8
6878 get_str_from_obj(
obj)
6881 int len, binary = 0;
6885 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
6886 s = Tcl_GetStringFromObj(obj, &len);
6888 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 3
6890 if (Tcl_GetCharLength(obj) != Tcl_UniCharLen(Tcl_GetUnicode(obj))) {
6892 s = (
char *)Tcl_GetByteArrayFromObj(obj, &len);
6896 s = Tcl_GetStringFromObj(obj, &len);
6899 if (IS_TCL_BYTEARRAY(obj)) {
6900 s = (
char *)Tcl_GetByteArrayFromObj(obj, &len);
6903 s = Tcl_GetStringFromObj(obj, &len);
6910 #ifdef HAVE_RUBY_ENCODING_H
6913 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
6914 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
6916 #ifdef HAVE_RUBY_ENCODING_H
6926 get_obj_from_str(str)
6931 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
6932 return Tcl_NewStringObj((
char*)s,
RSTRING_LEN(str));
6940 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6945 #ifdef HAVE_RUBY_ENCODING_H
6948 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6952 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6965 #if TCL_MAJOR_VERSION >= 8
6969 retObj = Tcl_GetObjResult(interp);
6971 strval = get_str_from_obj(retObj);
6983 callq_safelevel_handler(arg,
callq)
6995 static int call_queue_handler
_((Tcl_Event *,
int));
6997 call_queue_handler(
evPtr, flags)
7007 DUMP2(
"do_call_queue_handler : evPtr = %p", evPtr);
7009 DUMP2(
"added by thread : %lx", thread);
7012 DUMP1(
"processed by another event-loop");
7015 DUMP1(
"process it on current event-loop");
7025 DUMP1(
"caller is not yet ready to receive the result -> pending");
7034 if (deleted_ip(ptr)) {
7049 q_dat = (
VALUE)NULL;
7051 DUMP2(
"call function (for caller thread:%lx)", thread);
7078 DUMP2(
"back to caller (caller thread:%lx)", thread);
7080 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
7081 have_rb_thread_waiting_for_value = 1;
7086 DUMP1(
"finish back to caller");
7087 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
7091 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7118 ptr = get_ip(ip_obj);
7119 if (deleted_ip(ptr))
return Qnil;
7124 #ifdef RUBY_USE_NATIVE_THREAD
7127 is_tk_evloop_thread = (ptr->tk_thread_id == (Tcl_ThreadId) 0
7128 || ptr->tk_thread_id == Tcl_GetCurrentThread());
7131 is_tk_evloop_thread = (tk_eventloop_thread_id == (Tcl_ThreadId) 0
7132 || tk_eventloop_thread_id == Tcl_GetCurrentThread());
7135 is_tk_evloop_thread = 1;
7138 if (is_tk_evloop_thread
7141 if (
NIL_P(eventloop_thread)) {
7142 DUMP2(
"tk_funcall from thread:%lx but no eventloop", current);
7144 DUMP2(
"tk_funcall from current eventloop %lx", current);
7146 result = (
func)(ip_obj, argc, argv);
7153 DUMP2(
"tk_funcall from thread %lx (NOT current eventloop)", current);
7196 callq->
ev.proc = call_queue_handler;
7199 DUMP1(
"add handler");
7200 #ifdef RUBY_USE_NATIVE_THREAD
7201 if (ptr && ptr->tk_thread_id) {
7204 Tcl_ThreadQueueEvent(ptr->tk_thread_id,
7205 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7206 Tcl_ThreadAlert(ptr->tk_thread_id);
7207 }
else if (tk_eventloop_thread_id) {
7210 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
7211 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7212 Tcl_ThreadAlert(tk_eventloop_thread_id);
7228 DUMP2(
"callq wait for handler (current thread:%lx)", current);
7229 while(*alloc_done >= 0) {
7230 DUMP2(
"*** callq wait for handler (current thread:%lx)", current);
7234 DUMP2(
"*** callq wakeup (current thread:%lx)", current);
7235 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
7237 DUMP1(
"*** callq lost eventloop thread");
7241 DUMP2(
"back from handler (current thread:%lx)", current);
7246 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7252 ckfree((
char*)alloc_done);
7259 for(i = 0; i <
argc; i++) { argv[
i] = (
VALUE)NULL; }
7262 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
7282 DUMP1(
"raise exception");
7288 DUMP1(
"exit tk_funcall");
7294 #if TCL_MAJOR_VERSION >= 8
7295 struct call_eval_info {
7301 #ifdef HAVE_PROTOTYPES
7302 call_tcl_eval(
VALUE arg)
7308 struct call_eval_info *
inf = (
struct call_eval_info *)arg;
7311 inf->ptr->return_value = Tcl_EvalObj(inf->ptr->ip, inf->cmd);
7324 struct tcltkip *ptr = get_ip(
self);
7327 #if TCL_MAJOR_VERSION >= 8
7335 cmd = Tcl_NewStringObj(cmd_str, cmd_len);
7339 if (deleted_ip(ptr)) {
7346 struct call_eval_info inf;
7362 "unknown exception");
7382 if (pending_exception_check1(thr_crit_bup, ptr)) {
7389 if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->
ip)) {
7394 exc = create_ip_exc(
self, eTkCallbackReturn,
7395 "ip_eval_real receives TCL_RETURN");
7397 exc = create_ip_exc(
self, eTkCallbackBreak,
7398 "ip_eval_real receives TCL_BREAK");
7400 exc = create_ip_exc(
self, eTkCallbackContinue,
7401 "ip_eval_real receives TCL_CONTINUE");
7411 if (event_loop_abort_on_exc < 0) {
7430 DUMP2(
"Tcl_Eval(%s)", cmd_str);
7433 if (deleted_ip(ptr)) {
7443 if (pending_exception_check1(thr_crit_bup, ptr)) {
7454 exc = create_ip_exc(
self, eTkCallbackReturn,
7455 "ip_eval_real receives TCL_RETURN");
7457 exc = create_ip_exc(
self, eTkCallbackBreak,
7458 "ip_eval_real receives TCL_BREAK");
7460 exc = create_ip_exc(
self, eTkCallbackContinue,
7461 "ip_eval_real receives TCL_CONTINUE");
7479 evq_safelevel_handler(arg,
evq)
7491 int eval_queue_handler
_((Tcl_Event *,
int));
7493 eval_queue_handler(evPtr, flags)
7503 DUMP2(
"do_eval_queue_handler : evPtr = %p", evPtr);
7505 DUMP2(
"added by thread : %lx", thread);
7508 DUMP1(
"processed by another event-loop");
7511 DUMP1(
"process it on current event-loop");
7521 DUMP1(
"caller is not yet ready to receive the result -> pending");
7530 if (deleted_ip(ptr)) {
7540 #ifdef HAVE_NATIVETHREAD
7541 #ifndef RUBY_USE_NATIVE_THREAD
7543 rb_bug(
"cross-thread violation on eval_queue_handler()");
7552 q_dat = (
VALUE)NULL;
7578 DUMP2(
"back to caller (caller thread:%lx)", thread);
7580 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
7581 have_rb_thread_waiting_for_value = 1;
7586 DUMP1(
"finish back to caller");
7587 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
7591 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7605 #ifdef RUBY_USE_NATIVE_THREAD
7612 volatile VALUE ip_obj =
self;
7623 #ifdef RUBY_USE_NATIVE_THREAD
7624 ptr = get_ip(ip_obj);
7625 DUMP2(
"eval status: ptr->tk_thread_id %p", ptr->tk_thread_id);
7626 DUMP2(
"eval status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7628 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7630 DUMP2(
"status: eventloopt_thread %lx", eventloop_thread);
7633 #ifdef RUBY_USE_NATIVE_THREAD
7634 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
7637 (
NIL_P(eventloop_thread) || current == eventloop_thread)
7639 if (
NIL_P(eventloop_thread)) {
7640 DUMP2(
"eval from thread:%lx but no eventloop", current);
7642 DUMP2(
"eval from current eventloop %lx", current);
7651 DUMP2(
"eval from thread %lx (NOT current eventloop)", current);
7690 evq->
ev.proc = eval_queue_handler;
7692 position = TCL_QUEUE_TAIL;
7695 DUMP1(
"add handler");
7696 #ifdef RUBY_USE_NATIVE_THREAD
7697 if (ptr->tk_thread_id) {
7699 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)evq, position);
7700 Tcl_ThreadAlert(ptr->tk_thread_id);
7701 }
else if (tk_eventloop_thread_id) {
7702 Tcl_ThreadQueueEvent(tk_eventloop_thread_id, (Tcl_Event*)evq, position);
7705 Tcl_ThreadAlert(tk_eventloop_thread_id);
7721 DUMP2(
"evq wait for handler (current thread:%lx)", current);
7722 while(*alloc_done >= 0) {
7723 DUMP2(
"*** evq wait for handler (current thread:%lx)", current);
7727 DUMP2(
"*** evq wakeup (current thread:%lx)", current);
7728 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
7729 if (
NIL_P(eventloop_thread)) {
7730 DUMP1(
"*** evq lost eventloop thread");
7734 DUMP2(
"back from handler (current thread:%lx)", current);
7740 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7746 ckfree((
char*)alloc_done);
7750 Tcl_EventuallyFree((ClientData)eval_str, TCL_DYNAMIC);
7768 DUMP1(
"raise exception");
7779 ip_cancel_eval_core(interp, msg, flag)
7784 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6)
7786 "cancel_eval is supported Tcl/Tk8.6 or later.");
7799 return Tcl_CancelEval(interp, msg_obj, 0, flag);
7804 ip_cancel_eval(argc, argv,
self)
7814 if (ip_cancel_eval_core(get_ip(
self)->ip, retval, 0) ==
TCL_OK) {
7821 #ifndef TCL_CANCEL_UNWIND
7822 #define TCL_CANCEL_UNWIND 0x100000
7825 ip_cancel_eval_unwind(argc, argv,
self)
7838 if (ip_cancel_eval_core(get_ip(
self)->ip, retval, flag) ==
TCL_OK) {
7847 lib_restart_core(interp, argc, argv)
7853 struct tcltkip *ptr = get_ip(interp);
7861 if (deleted_ip(ptr)) {
7877 #if TCL_MAJOR_VERSION >= 8
7892 exc = tcltkip_init_tk(interp);
7912 struct tcltkip *ptr = get_ip(
self);
7919 if (deleted_ip(ptr)) {
7931 struct tcltkip *ptr = get_ip(
self);
7938 if (deleted_ip(ptr)) {
7942 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)NULL) {
7959 Tcl_Encoding encoding;
7974 if (
NIL_P(ip_obj)) {
7975 interp = (Tcl_Interp *)NULL;
7977 ptr = get_ip(ip_obj);
7980 if (deleted_ip(ptr)) {
7981 interp = (Tcl_Interp *)NULL;
7990 if (
NIL_P(encodename)) {
7994 #ifdef HAVE_RUBY_ENCODING_H
8000 if (
NIL_P(ip_obj)) {
8001 encoding = (Tcl_Encoding)NULL;
8005 encoding = (Tcl_Encoding)NULL;
8011 encoding = (Tcl_Encoding)NULL;
8013 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8015 if (encoding == (Tcl_Encoding)NULL) {
8024 #ifdef HAVE_RUBY_ENCODING_H
8027 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8032 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8034 if (encoding == (Tcl_Encoding)NULL) {
8039 encoding = (Tcl_Encoding)NULL;
8043 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8044 #ifdef HAVE_RUBY_ENCODING_H
8047 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8052 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(encodename));
8053 if (encoding == (Tcl_Encoding)NULL) {
8073 Tcl_DStringInit(&dstr);
8074 Tcl_DStringFree(&dstr);
8076 Tcl_ExternalToUtfDString(encoding, buf,
RSTRING_LENINT(str), &dstr);
8080 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8081 #ifdef HAVE_RUBY_ENCODING_H
8092 Tcl_DStringFree(&dstr);
8104 lib_toUTF8(argc, argv,
self)
8118 ip_toUTF8(argc, argv,
self)
8125 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8141 Tcl_Encoding encoding;
8155 if (
NIL_P(ip_obj)) {
8156 interp = (Tcl_Interp *)NULL;
8157 }
else if (get_ip(ip_obj) == (
struct tcltkip *)NULL) {
8158 interp = (Tcl_Interp *)NULL;
8160 interp = get_ip(ip_obj)->ip;
8166 if (
NIL_P(encodename)) {
8174 #ifdef HAVE_RUBY_ENCODING_H
8177 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8181 #ifdef HAVE_RUBY_ENCODING_H
8184 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8191 if (
NIL_P(ip_obj)) {
8192 encoding = (Tcl_Encoding)NULL;
8196 encoding = (Tcl_Encoding)NULL;
8202 encoding = (Tcl_Encoding)NULL;
8204 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8206 if (encoding == (Tcl_Encoding)NULL) {
8218 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8226 s = (
char*)Tcl_GetByteArrayFromObj(tclstr, &len);
8230 #ifdef HAVE_RUBY_ENCODING_H
8233 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8240 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(encodename));
8241 if (encoding == (Tcl_Encoding)NULL) {
8264 Tcl_DStringInit(&dstr);
8265 Tcl_DStringFree(&dstr);
8267 Tcl_UtfToExternalDString(encoding,buf,
RSTRING_LENINT(str),&dstr);
8271 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8272 #ifdef HAVE_RUBY_ENCODING_H
8276 VALUE tbl = ip_get_encoding_table(ip_obj);
8277 VALUE encobj = encoding_table_get_obj(tbl, encodename);
8294 Tcl_DStringFree(&dstr);
8306 lib_fromUTF8(argc, argv,
self)
8313 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8320 ip_fromUTF8(argc, argv,
self)
8327 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8334 lib_UTF_backslash_core(
self, str,
all_bs)
8340 char *src_buf, *dst_buf, *
ptr;
8341 int read_len = 0, dst_len = 0;
8371 if (*ptr ==
'\\' && (all_bs || *(ptr + 1) ==
'u')) {
8372 dst_len += Tcl_UtfBackslash(ptr, &read_len, (dst_buf + dst_len));
8375 *(dst_buf + (dst_len++)) = *(ptr++);
8381 #ifdef HAVE_RUBY_ENCODING_H
8387 Tcl_EventuallyFree((ClientData)src_buf, TCL_DYNAMIC);
8397 Tcl_EventuallyFree((ClientData)dst_buf, TCL_DYNAMIC);
8414 lib_UTF_backslash(
self, str)
8418 return lib_UTF_backslash_core(
self, str, 0);
8422 lib_Tcl_backslash(
self, str)
8426 return lib_UTF_backslash_core(
self, str, 1);
8430 lib_get_system_encoding(
self)
8433 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
8435 return rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL));
8442 lib_set_system_encoding(
self,
enc_name)
8446 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
8449 if (
NIL_P(enc_name)) {
8450 Tcl_SetSystemEncoding((Tcl_Interp *)NULL, (
CONST char *)NULL);
8451 return lib_get_system_encoding(
self);
8454 enc_name =
rb_funcall(enc_name, ID_to_s, 0, 0);
8455 if (Tcl_SetSystemEncoding((Tcl_Interp *)NULL,
8472 #if TCL_MAJOR_VERSION >= 8
8482 #ifdef HAVE_PROTOTYPES
8483 invoke_tcl_proc(
VALUE arg)
8485 invoke_tcl_proc(arg)
8491 #if TCL_MAJOR_VERSION >= 8
8492 int argc = inf->objc;
8493 char **argv = (
char **)NULL;
8497 #if TCL_MAJOR_VERSION >= 8
8498 if (!inf->
cmdinfo.isNativeObjectProc) {
8505 for (i = 0; i <
argc; ++
i) {
8506 argv[
i] = Tcl_GetStringFromObj(inf->objv[i], &len);
8508 argv[
argc] = (
char *)NULL;
8515 #if TCL_MAJOR_VERSION >= 8
8516 if (inf->
cmdinfo.isNativeObjectProc) {
8519 inf->
ptr->
ip, inf->objc, inf->objv);
8524 #if TCL_MAJOR_VERSION >= 8
8530 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8551 #if TCL_MAJOR_VERSION >= 8
8577 #if TCL_MAJOR_VERSION >= 8
8579 char **argv = (
char **)NULL;
8585 ptr = get_ip(interp);
8588 #if TCL_MAJOR_VERSION >= 8
8589 cmd = Tcl_GetStringFromObj(objv[0], &len);
8595 ptr = get_ip(interp);
8598 if (deleted_ip(ptr)) {
8606 DUMP2(
"call Tcl_GetCommandInfo, %s", cmd);
8608 DUMP1(
"error Tcl_GetCommandInfo");
8609 DUMP1(
"try auto_load (call 'unknown' command)");
8611 #
if TCL_MAJOR_VERSION >= 8
8617 DUMP1(
"fail to get 'unknown' command");
8619 if (event_loop_abort_on_exc > 0) {
8624 "invalid command name `%s'", cmd);
8626 if (event_loop_abort_on_exc < 0) {
8627 rb_warning(
"invalid command name `%s' (ignore)", cmd);
8629 rb_warn(
"invalid command name `%s' (ignore)", cmd);
8637 #if TCL_MAJOR_VERSION >= 8
8638 Tcl_Obj **unknown_objv;
8640 char **unknown_argv;
8642 DUMP1(
"find 'unknown' command -> set arguemnts");
8645 #if TCL_MAJOR_VERSION >= 8
8651 unknown_objv[0] = Tcl_NewStringObj(
"::unknown", 9);
8653 memcpy(unknown_objv + 1, objv,
sizeof(Tcl_Obj *)*objc);
8654 unknown_objv[++
objc] = (Tcl_Obj*)NULL;
8655 objv = unknown_objv;
8662 unknown_argv[0] =
strdup(
"unknown");
8663 memcpy(unknown_argv + 1, argv,
sizeof(
char *)*argc);
8664 unknown_argv[++
argc] = (
char *)NULL;
8665 argv = unknown_argv;
8669 DUMP1(
"end Tcl_GetCommandInfo");
8678 #if TCL_MAJOR_VERSION >= 8
8692 "unknown exception");
8709 #if TCL_MAJOR_VERSION >= 8
8710 if (!info.isNativeObjectProc) {
8719 for (i = 0; i <
argc; ++
i) {
8720 argv[
i] = Tcl_GetStringFromObj(objv[i], &len);
8722 argv[
argc] = (
char *)NULL;
8729 #if TCL_MAJOR_VERSION >= 8
8730 if (info.isNativeObjectProc) {
8735 resultPtr = Tcl_GetObjResult(ptr->
ip);
8736 Tcl_SetResult(ptr->
ip, Tcl_GetStringFromObj(resultPtr, &len),
8743 #if TCL_MAJOR_VERSION >= 8
8748 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8767 #if TCL_MAJOR_VERSION >= 8
8770 Tcl_EventuallyFree((ClientData)objv, TCL_DYNAMIC);
8783 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8796 if (pending_exception_check1(thr_crit_bup, ptr)) {
8804 if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->
ip)) {
8807 return create_ip_exc(interp, eTkCallbackReturn,
8808 "ip_invoke_core receives TCL_RETURN");
8810 return create_ip_exc(interp, eTkCallbackBreak,
8811 "ip_invoke_core receives TCL_BREAK");
8813 return create_ip_exc(interp, eTkCallbackContinue,
8814 "ip_invoke_core receives TCL_CONTINUE");
8821 if (event_loop_abort_on_exc < 0) {
8836 #if TCL_MAJOR_VERSION >= 8
8841 alloc_invoke_arguments(argc, argv)
8848 #if TCL_MAJOR_VERSION >= 8
8858 #if TCL_MAJOR_VERSION >= 8
8864 for (i = 0; i <
argc; ++
i) {
8865 av[
i] = get_obj_from_str(argv[i]);
8877 for (i = 0; i <
argc; ++
i) {
8891 #if TCL_MAJOR_VERSION >= 8
8899 for (i = 0; i <
argc; ++
i) {
8900 #if TCL_MAJOR_VERSION >= 8
8902 av[
i] = (Tcl_Obj*)NULL;
8905 av[
i] = (
char*)NULL;
8908 #if TCL_MAJOR_VERSION >= 8
8910 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8920 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8933 ip_invoke_real(argc, argv, interp)
8941 #if TCL_MAJOR_VERSION >= 8
8942 Tcl_Obj **av = (Tcl_Obj **)NULL;
8944 char **av = (
char **)NULL;
8950 ptr = get_ip(interp);
8953 if (deleted_ip(ptr)) {
8958 av = alloc_invoke_arguments(argc, argv);
8971 ivq_safelevel_handler(arg,
ivq)
8983 int invoke_queue_handler
_((Tcl_Event *,
int));
8985 invoke_queue_handler(evPtr, flags)
8995 DUMP2(
"do_invoke_queue_handler : evPtr = %p", evPtr);
8997 DUMP2(
"added by thread : %lx", thread);
9000 DUMP1(
"processed by another event-loop");
9003 DUMP1(
"process it on current event-loop");
9013 DUMP1(
"caller is not yet ready to receive the result -> pending");
9022 if (deleted_ip(ptr)) {
9037 q_dat = (
VALUE)NULL;
9039 DUMP2(
"call invoke_real (for caller thread:%lx)", thread);
9065 DUMP2(
"back to caller (caller thread:%lx)", thread);
9067 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
9068 have_rb_thread_waiting_for_value = 1;
9073 DUMP1(
"finish back to caller");
9074 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
9078 DUMP2(
"caller is dead (caller thread:%lx)", thread);
9091 Tcl_QueuePosition position;
9094 #ifdef RUBY_USE_NATIVE_THREAD
9105 #if TCL_MAJOR_VERSION >= 8
9106 Tcl_Obj **av = (Tcl_Obj **)NULL;
9108 char **av = (
char **)NULL;
9115 #ifdef RUBY_USE_NATIVE_THREAD
9116 ptr = get_ip(ip_obj);
9117 DUMP2(
"invoke status: ptr->tk_thread_id %p", ptr->tk_thread_id);
9118 DUMP2(
"invoke status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9120 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9122 DUMP2(
"status: eventloopt_thread %lx", eventloop_thread);
9125 #ifdef RUBY_USE_NATIVE_THREAD
9126 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
9129 (
NIL_P(eventloop_thread) || current == eventloop_thread)
9131 if (
NIL_P(eventloop_thread)) {
9132 DUMP2(
"invoke from thread:%lx but no eventloop", current);
9134 DUMP2(
"invoke from current eventloop %lx", current);
9136 result = ip_invoke_real(argc, argv, ip_obj);
9143 DUMP2(
"invoke from thread %lx (NOT current eventloop)", current);
9149 av = alloc_invoke_arguments(argc, argv);
9177 ivq->
ev.proc = invoke_queue_handler;
9180 DUMP1(
"add handler");
9181 #ifdef RUBY_USE_NATIVE_THREAD
9182 if (ptr->tk_thread_id) {
9184 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)ivq, position);
9185 Tcl_ThreadAlert(ptr->tk_thread_id);
9186 }
else if (tk_eventloop_thread_id) {
9189 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
9190 (Tcl_Event*)ivq, position);
9191 Tcl_ThreadAlert(tk_eventloop_thread_id);
9207 DUMP2(
"ivq wait for handler (current thread:%lx)", current);
9208 while(*alloc_done >= 0) {
9212 DUMP2(
"*** ivq wakeup (current thread:%lx)", current);
9213 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
9214 if (
NIL_P(eventloop_thread)) {
9215 DUMP1(
"*** ivq lost eventloop thread");
9219 DUMP2(
"back from handler (current thread:%lx)", current);
9224 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
9230 ckfree((
char*)alloc_done);
9236 Tcl_EventuallyFree((ClientData)ivq, TCL_DYNAMIC);
9251 DUMP1(
"raise exception");
9257 DUMP1(
"exit ip_invoke");
9273 if (deleted_ip(ptr)) {
9281 ip_invoke(argc, argv, obj)
9290 ip_invoke_immediate(argc, argv, obj)
9303 ip_get_variable2_core(interp, argc, argv)
9308 struct tcltkip *ptr = get_ip(interp);
9321 #if TCL_MAJOR_VERSION >= 8
9330 if (deleted_ip(ptr)) {
9341 if (ret == (Tcl_Obj*)NULL) {
9354 strval = get_str_from_obj(ret);
9369 if (deleted_ip(ptr)) {
9379 if (ret == (
char*)NULL) {
9399 ip_get_variable2(
self, varname, index, flag)
9415 retval =
tk_funcall(ip_get_variable2_core, 3, argv,
self);
9425 ip_get_variable(
self, varname, flag)
9430 return ip_get_variable2(
self, varname,
Qnil, flag);
9434 ip_set_variable2_core(interp, argc, argv)
9439 struct tcltkip *ptr = get_ip(interp);
9454 #if TCL_MAJOR_VERSION >= 8
9456 Tcl_Obj *valobj, *
ret;
9462 valobj = get_obj_from_str(value);
9466 if (deleted_ip(ptr)) {
9480 if (ret == (Tcl_Obj*)NULL) {
9493 strval = get_str_from_obj(ret);
9509 if (deleted_ip(ptr)) {
9519 if (ret == (
char*)NULL) {
9535 ip_set_variable2(
self, varname, index, value, flag)
9554 retval =
tk_funcall(ip_set_variable2_core, 4, argv,
self);
9556 if (
NIL_P(retval)) {
9564 ip_set_variable(
self, varname, value, flag)
9570 return ip_set_variable2(
self, varname,
Qnil, value, flag);
9574 ip_unset_variable2_core(interp, argc, argv)
9579 struct tcltkip *ptr = get_ip(interp);
9592 if (deleted_ip(ptr)) {
9601 if (
FIX2INT(flag) & TCL_LEAVE_ERR_MSG) {
9613 ip_unset_variable2(
self, varname, index, flag)
9629 retval =
tk_funcall(ip_unset_variable2_core, 3, argv,
self);
9631 if (
NIL_P(retval)) {
9639 ip_unset_variable(
self, varname, flag)
9644 return ip_unset_variable2(
self, varname,
Qnil, flag);
9648 ip_get_global_var(
self, varname)
9652 return ip_get_variable(
self, varname,
9653 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9657 ip_get_global_var2(
self, varname, index)
9662 return ip_get_variable2(
self, varname, index,
9663 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9667 ip_set_global_var(
self, varname, value)
9672 return ip_set_variable(
self, varname, value,
9673 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9677 ip_set_global_var2(
self, varname, index, value)
9683 return ip_set_variable2(
self, varname, index, value,
9684 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9688 ip_unset_global_var(
self, varname)
9692 return ip_unset_variable(
self, varname,
9693 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9697 ip_unset_global_var2(
self, varname, index)
9702 return ip_unset_variable2(
self, varname, index,
9703 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9709 lib_split_tklist_core(ip_obj,
list_str)
9717 #ifdef HAVE_RUBY_ENCODING_H
9727 interp = (Tcl_Interp *)NULL;
9728 }
else if (get_ip(ip_obj) == (
struct tcltkip *)NULL) {
9729 interp = (Tcl_Interp *)NULL;
9731 interp = get_ip(ip_obj)->ip;
9735 #ifdef HAVE_RUBY_ENCODING_H
9741 #if TCL_MAJOR_VERSION >= 8
9748 listobj = get_obj_from_str(list_str);
9752 result = Tcl_ListObjGetElements(interp, listobj, &objc, &objv);
9756 if (interp == (Tcl_Interp*)NULL) {
9763 for(idx = 0; idx <
objc; idx++) {
9775 for(idx = 0; idx <
objc; idx++) {
9776 elem = get_str_from_obj(objv[idx]);
9779 #ifdef HAVE_RUBY_ENCODING_H
9782 rb_ivar_set(elem, ID_at_enc, ENCODING_NAME_BINARY);
9798 for(idx = 0; idx <
objc; idx++) {
9811 if (interp == (Tcl_Interp*)NULL) {
9823 for(idx = 0; idx <
argc; idx++) {
9843 lib_split_tklist(
self, list_str)
9847 return lib_split_tklist_core(
Qnil, list_str);
9852 ip_split_tklist(
self, list_str)
9856 return lib_split_tklist_core(
self, list_str);
9860 lib_merge_tklist(argc, argv, obj)
9890 for(num = 0; num <
argc; num++) {
9893 #if TCL_MAJOR_VERSION >= 8
9897 len += Tcl_ScanElement(dst, &flagPtr[num]) + 1;
9903 result = (
char *)ckalloc(len);
9908 for(num = 0; num <
argc; num++) {
9909 #if TCL_MAJOR_VERSION >= 8
9910 len = Tcl_ConvertCountedElement(
RSTRING_PTR(argv[num]),
9914 len = Tcl_ConvertElement(
RSTRING_PTR(argv[num]), dst, flagPtr[num]);
9920 if (dst == result) {
9927 Tcl_EventuallyFree((ClientData)flagPtr, TCL_DYNAMIC);
9941 Tcl_EventuallyFree((ClientData)result, TCL_DYNAMIC);
9958 lib_conv_listelement(
self, src)
9974 #if TCL_MAJOR_VERSION >= 8
9981 len = Tcl_ScanElement(
RSTRING_PTR(src), &scan_flag);
9995 lib_getversion(
self)
10007 lib_get_reltype_name(
self)
10032 static CONST char form[]
10033 =
"tcltklib %s :: Ruby%s (%s) %s pthread :: Tcl%s(%s)/Tk%s(%s) %s";
10041 +
strlen(TCL_PATCH_LEVEL)
10042 +
strlen(
"without stub")
10043 +
strlen(TK_PATCH_LEVEL)
10044 +
strlen(
"without stub")
10045 +
strlen(
"unknown tcl_threads");
10050 sprintf(info, form,
10059 #ifdef USE_TCL_STUBS
10065 #ifdef USE_TK_STUBS
10070 #ifdef WITH_TCL_ENABLE_THREAD
10071 #
if WITH_TCL_ENABLE_THREAD
10074 "without tcl_threads"
10077 "unknown tcl_threads"
10093 create_dummy_encoding_for_tk_core(interp, name,
error_mode)
10104 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10105 if (Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(name)) == (Tcl_Encoding)NULL) {
10106 if (
RTEST(error_mode)) {
10115 #ifdef HAVE_RUBY_ENCODING_H
10120 if (
RTEST(error_mode)) {
10134 create_dummy_encoding_for_tk(interp, name)
10138 return create_dummy_encoding_for_tk_core(interp, name,
Qtrue);
10142 #ifdef HAVE_RUBY_ENCODING_H
10144 update_encoding_table(
table, interp, error_mode)
10159 ptr = get_ip(interp);
10160 if (ptr == (
struct tcltkip *) NULL)
return 0;
10161 if (deleted_ip(ptr))
return 0;
10165 enc_list = Tcl_GetObjResult(ptr->
ip);
10168 if (Tcl_ListObjGetElements(ptr->
ip, enc_list,
10169 &objc, &objv) !=
TCL_OK) {
10176 for(i = 0; i <
objc; i++) {
10182 encobj = create_dummy_encoding_for_tk_core(interp,encname,error_mode);
10201 encoding_table_get_name_core(table,
enc_arg, error_mode)
10215 ptr = get_ip(interp);
10216 if (deleted_ip(ptr)) {
10217 ptr = (
struct tcltkip *) NULL;
10225 enc =
rb_funcall(interp, ID_encoding_name, 0, 0);
10234 enc =
rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL));
10248 if (!
NIL_P(name)) {
10255 if (update_encoding_table(table, interp, error_mode)) {
10259 if (!
NIL_P(name)) {
10288 if (update_encoding_table(table, interp, error_mode)) {
10308 encoding_table_get_obj_core(table, enc, error_mode)
10316 encoding_table_get_name_core(table, enc, error_mode));
10325 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10327 update_encoding_table(table, interp, error_mode)
10340 if (
NIL_P(interp))
return 0;
10341 ptr = get_ip(interp);
10342 if (ptr == (
struct tcltkip *) NULL)
return 0;
10343 if (deleted_ip(ptr))
return 0;
10347 enc_list = Tcl_GetObjResult(ptr->
ip);
10350 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) !=
TCL_OK) {
10357 for(i = 0; i <
objc; i++) {
10373 encoding_table_get_name_core(table, enc, error_mode)
10383 if (!
NIL_P(name)) {
10389 if (update_encoding_table(table,
rb_ivar_get(table, ID_at_interp),
10394 if (!
NIL_P(name)) {
10400 if (
RTEST(error_mode)) {
10406 encoding_table_get_obj_core(table, enc, error_mode)
10411 return encoding_table_get_name_core(table, enc, error_mode);
10416 encoding_table_get_name_core(table, enc, error_mode)
10424 encoding_table_get_obj_core(table, enc, error_mode)
10435 encoding_table_get_name(table, enc)
10439 return encoding_table_get_name_core(table, enc,
Qtrue);
10442 encoding_table_get_obj(table, enc)
10446 return encoding_table_get_obj_core(table, enc,
Qtrue);
10449 #ifdef HAVE_RUBY_ENCODING_H
10451 create_encoding_table_core(arg, interp)
10455 struct tcltkip *ptr = get_ip(interp);
10463 #ifdef HAVE_RB_SET_SAFE_LEVEL_FORCE
10480 enc_list = Tcl_GetObjResult(ptr->
ip);
10483 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) !=
TCL_OK) {
10489 for(i = 0; i <
objc; i++) {
10490 int name2obj, obj2name;
10492 name2obj = 1; obj2name = 1;
10497 if (strcmp(
RSTRING_PTR(encname),
"identity") == 0) {
10498 name2obj = 1; obj2name = 0;
10501 }
else if (strcmp(
RSTRING_PTR(encname),
"shiftjis") == 0) {
10502 name2obj = 1; obj2name = 0;
10505 }
else if (strcmp(
RSTRING_PTR(encname),
"unicode") == 0) {
10506 name2obj = 1; obj2name = 0;
10509 }
else if (strcmp(
RSTRING_PTR(encname),
"symbol") == 0) {
10510 name2obj = 1; obj2name = 0;
10515 name2obj = 1; obj2name = 1;
10521 encobj = create_dummy_encoding_for_tk(interp, encname);
10545 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10547 create_encoding_table_core(arg, interp)
10551 struct tcltkip *ptr = get_ip(interp);
10561 rb_hash_aset(table, ENCODING_NAME_BINARY, ENCODING_NAME_BINARY);
10565 enc_list = Tcl_GetObjResult(ptr->
ip);
10568 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) !=
TCL_OK) {
10574 for(i = 0; i <
objc; i++) {
10589 create_encoding_table_core(arg, interp)
10602 create_encoding_table(interp)
10610 ip_get_encoding_table(interp)
10619 table = create_encoding_table(interp);
10634 #if TCL_MAJOR_VERSION >= 8
10636 #define MASTER_MENU 0
10637 #define TEAROFF_MENU 1
10640 struct dummy_TkMenuEntry {
10642 struct dummy_TkMenu *menuPtr;
10646 struct dummy_TkMenu {
10650 Tcl_Command widgetCmd;
10651 struct dummy_TkMenuEntry **entries;
10655 Tcl_Obj *menuTypePtr;
10659 struct dummy_TkMenuRef {
10660 struct dummy_TkMenu *menuPtr;
10667 EXTERN struct dummy_TkMenuRef *TkFindMenuReferences(Tcl_Interp*,
char*);
10669 #define MENU_HASH_KEY "tkMenus"
10675 ip_make_menu_embeddable_core(interp, argc, argv)
10680 #if TCL_MAJOR_VERSION >= 8
10682 struct tcltkip *ptr = get_ip(interp);
10683 struct dummy_TkMenuRef *menuRefPtr =
NULL;
10685 Tcl_HashTable *menuTablePtr;
10686 Tcl_HashEntry *hashEntryPtr;
10688 menu_path = argv[0];
10692 menuRefPtr = TkFindMenuReferences(ptr->
ip,
RSTRING_PTR(menu_path));
10695 = (Tcl_HashTable *) Tcl_GetAssocData(ptr->
ip, MENU_HASH_KEY, NULL))
10698 = Tcl_FindHashEntry(menuTablePtr,
RSTRING_PTR(menu_path)))
10700 menuRefPtr = (
struct dummy_TkMenuRef *) Tcl_GetHashValue(hashEntryPtr);
10705 if (menuRefPtr == (
struct dummy_TkMenuRef *)
NULL) {
10709 if (menuRefPtr->menuPtr == (
struct dummy_TkMenu *) NULL) {
10711 "invalid menu widget (maybe already destroyed)");
10714 if ((menuRefPtr->menuPtr)->menuType != MENUBAR) {
10716 "target menu widget must be a MENUBAR type");
10719 (menuRefPtr->menuPtr)->menuType = TEAROFF_MENU;
10723 char *s =
"normal";
10725 (menuRefPtr->menuPtr)->menuTypePtr = Tcl_NewStringObj(s,
strlen(s));
10728 (menuRefPtr->menuPtr)->menuType = MASTER_MENU;
10733 TkEventuallyRecomputeMenu(menuRefPtr->menuPtr);
10734 TkEventuallyRedrawMenu(menuRefPtr->menuPtr,
10735 (
struct dummy_TkMenuEntry *)NULL);
10737 memset((
void *) &event, 0,
sizeof(event));
10738 event.xany.type = ConfigureNotify;
10739 event.xany.serial = NextRequest(Tk_Display((menuRefPtr->menuPtr)->tkwin));
10740 event.xany.send_event = 0;
10741 event.xany.window = Tk_WindowId((menuRefPtr->menuPtr)->tkwin);
10742 event.xany.display = Tk_Display((menuRefPtr->menuPtr)->tkwin);
10743 event.xconfigure.window =
event.xany.window;
10744 Tk_HandleEvent(&event);
10755 ip_make_menu_embeddable(interp, menu_path)
10762 return tk_funcall(ip_make_menu_embeddable_core, 1, argv, interp);
10783 tcltkip_class =
ip;
10787 #ifdef HAVE_RUBY_ENCODING_H
10826 # define TK_WINDOWING_SYSTEM "win32"
10829 # define TK_WINDOWING_SYSTEM "classic"
10832 # define TK_WINDOWING_SYSTEM "aqua"
10834 # define TK_WINDOWING_SYSTEM "x11"
10855 #ifdef TCL_NAMESPACE_ONLY
10863 #ifdef TCL_PARSE_PART1
10873 lib_get_reltype_name, -1);
10890 eTkLocalJumpError =
rb_define_class(
"TkLocalJumpError", eLocalJumpError);
10892 eTkCallbackRetry =
rb_define_class(
"TkCallbackRetry", eTkLocalJumpError);
10893 eTkCallbackRedo =
rb_define_class(
"TkCallbackRedo", eTkLocalJumpError);
10894 eTkCallbackThrow =
rb_define_class(
"TkCallbackThrow", eTkLocalJumpError);
10900 ID_encoding_name =
rb_intern(
"encoding_name");
10901 ID_encoding_table =
rb_intern(
"encoding_table");
10925 lib_evloop_thread_p, 0);
10929 lib_thread_callback, -1);
10936 set_eventloop_window_mode, 1);
10938 get_eventloop_window_mode, 0);
10947 get_eventloop_weight, 0);
10949 lib_num_of_mainwindows, 0);
10956 lib_conv_listelement, 1);
10960 lib_UTF_backslash, 1);
10962 lib_Tcl_backslash, 1);
10965 lib_get_system_encoding, 0);
10967 lib_set_system_encoding, 1);
10969 lib_get_system_encoding, 0);
10971 lib_set_system_encoding, 1);
10986 rb_define_method(ip,
"invalid_namespace?", ip_has_invalid_namespace_p, 0);
11003 create_dummy_encoding_for_tk, 1);
11023 rb_define_method(ip,
"_make_menu_embeddable", ip_make_menu_embeddable, 1);
11037 ip_evloop_abort_on_exc, 0);
11039 ip_evloop_abort_on_exc_set, 1);
11051 eventloop_thread =
Qnil;
11052 eventloop_interp = (Tcl_Interp*)NULL;
11054 #ifndef DEFAULT_EVENTLOOP_DEPTH
11055 #define DEFAULT_EVENTLOOP_DEPTH 7
11060 watchdog_thread =
Qnil;
11066 #ifdef HAVE_NATIVETHREAD
11092 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
11101 Tcl_ObjType_ByteArray = Tcl_GetObjType(Tcl_ObjTypeName_ByteArray);
11102 Tcl_ObjType_String = Tcl_GetObjType(Tcl_ObjTypeName_String);
11106 (
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.
#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)
VALUE rb_vsprintf(const char *, va_list)
#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)