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"
22 #ifdef HAVE_RB_THREAD_CHECK_TRAP_PENDING
28 #define rb_thread_check_trap_pending() (0+rb_trap_pending)
31 #if !defined(RSTRING_PTR)
32 #define RSTRING_PTR(s) (RSTRING(s)->ptr)
33 #define RSTRING_LEN(s) (RSTRING(s)->len)
35 #if !defined(RSTRING_LENINT)
36 #define RSTRING_LENINT(s) ((int)RSTRING_LEN(s))
38 #if !defined(RARRAY_PTR)
39 #define RARRAY_PTR(s) (RARRAY(s)->ptr)
40 #define RARRAY_LEN(s) (RARRAY(s)->len)
44 #define RbTk_OBJ_UNTRUST(x) do {OBJ_TAINT(x); OBJ_UNTRUST(x);} while (0)
46 #define RbTk_OBJ_UNTRUST(x) OBJ_TAINT(x)
48 #define RbTk_ALLOC_N(type, n) (type *)ckalloc((int)(sizeof(type) * (n)))
50 #if defined(HAVE_RB_PROC_NEW) && !defined(RUBY_VM)
57 #ifdef HAVE_STDARG_PROTOTYPES
59 #define va_init_list(a,b) va_start(a,b)
62 #define va_init_list(a,b) va_start(a)
66 #if !defined HAVE_VSNPRINTF && !defined vsnprintf
69 # define vsnprintf _vsnprintf
71 # ifdef HAVE_RUBY_RUBY_H
82 #ifndef HAVE_RUBY_NATIVE_THREAD_P
83 #define ruby_native_thread_p() is_ruby_native_thread()
84 #undef RUBY_USE_NATIVE_THREAD
86 #define RUBY_USE_NATIVE_THREAD 1
89 #ifndef HAVE_RB_ERRINFO
90 #define rb_errinfo() (ruby_errinfo+0)
94 #ifndef HAVE_RB_SAFE_LEVEL
95 #define rb_safe_level() (ruby_safe_level+0)
97 #ifndef HAVE_RB_SOURCEFILE
98 #define rb_sourcefile() (ruby_sourcefile+0)
103 #ifndef TCL_ALPHA_RELEASE
104 #define TCL_ALPHA_RELEASE 0
105 #define TCL_BETA_RELEASE 1
106 #define TCL_FINAL_RELEASE 2
127 #if TCL_MAJOR_VERSION >= 8
129 # if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 4
133 # define CONST84 CONST
141 # define CONST84 CONST
149 # if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 5
152 # define CONST86 CONST84
157 #define TAG_RETURN 0x1
158 #define TAG_BREAK 0x2
160 #define TAG_RETRY 0x4
162 #define TAG_RAISE 0x6
163 #define TAG_THROW 0x7
164 #define TAG_FATAL 0x8
167 #define DUMP1(ARG1) if (ruby_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1); fflush(stderr); }
168 #define DUMP2(ARG1, ARG2) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\
169 fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); fflush(stderr); }
170 #define DUMP3(ARG1, ARG2, ARG3) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\
171 fprintf(stderr, ARG1, ARG2, ARG3); fprintf(stderr, "\n"); fflush(stderr); }
188 #ifdef HAVE_RUBY_ENCODING_H
254 #if TCL_MAJOR_VERSION >= 8
255 static const char Tcl_ObjTypeName_ByteArray[] =
"bytearray";
256 static CONST86 Tcl_ObjType *Tcl_ObjType_ByteArray;
258 static const char Tcl_ObjTypeName_String[] =
"string";
259 static CONST86 Tcl_ObjType *Tcl_ObjType_String;
261 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
262 #define IS_TCL_BYTEARRAY(obj) ((obj)->typePtr == Tcl_ObjType_ByteArray)
263 #define IS_TCL_STRING(obj) ((obj)->typePtr == Tcl_ObjType_String)
264 #define IS_TCL_VALID_STRING(obj) ((obj)->bytes != (char*)NULL)
268 #ifndef HAVE_RB_HASH_LOOKUP
269 #define rb_hash_lookup rb_hash_aref
272 #ifndef HAVE_RB_THREAD_ALIVE_P
273 #define rb_thread_alive_p(thread) rb_funcall2((thread), ID_alive_p, 0, NULL)
278 #ifdef HAVE_PROTOTYPES
279 tcl_eval(Tcl_Interp *
interp,
const char *
cmd)
281 tcl_eval(interp, cmd)
296 #define Tcl_Eval tcl_eval
299 #ifdef HAVE_PROTOTYPES
300 tcl_global_eval(Tcl_Interp *interp,
const char *cmd)
302 tcl_global_eval(interp, cmd)
316 #undef Tcl_GlobalEval
317 #define Tcl_GlobalEval tcl_global_eval
320 #if TCL_MAJOR_VERSION < 8
321 #define Tcl_IncrRefCount(obj) (1)
322 #define Tcl_DecrRefCount(obj) (1)
326 #if TCL_MAJOR_VERSION < 8
327 #define Tcl_GetStringResult(interp) ((interp)->result)
331 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
339 Tcl_Obj *nameObj1, *nameObj2 =
NULL, *retObj;
341 nameObj1 = Tcl_NewStringObj((
char*)name1, -1);
345 nameObj2 = Tcl_NewStringObj((
char*)name2, -1);
349 retObj = Tcl_ObjGetVar2(interp, nameObj1, nameObj2, flags);
368 Tcl_Obj *nameObj1, *nameObj2 =
NULL, *retObj;
370 nameObj1 = Tcl_NewStringObj((
char*)name1, -1);
374 nameObj2 = Tcl_NewStringObj((
char*)name2, -1);
378 retObj = Tcl_ObjSetVar2(interp, nameObj1, nameObj2, newValObj, flags);
392 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4)
393 # if !defined __MINGW32__ && !defined __BORLANDC__
409 #if TCL_MAJOR_VERSION >= 8
465 for(i = 0; i < q->
argc; i++) {
477 #ifdef RUBY_USE_NATIVE_THREAD
478 Tcl_ThreadId tk_eventloop_thread_id;
493 #ifdef RUBY_USE_NATIVE_THREAD
494 #define CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 1
495 #define USE_TOGGLE_WINDOW_MODE_FOR_IDLE 0
496 #define DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 1
498 #define CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE 1
499 #define USE_TOGGLE_WINDOW_MODE_FOR_IDLE 0
500 #define DO_THREAD_SCHEDULE_AT_CALLBACK_DONE 0
503 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
514 #ifdef RUBY_USE_NATIVE_THREAD
515 #define DEFAULT_EVENT_LOOP_MAX 800
516 #define DEFAULT_NO_EVENT_TICK 10
517 #define DEFAULT_NO_EVENT_WAIT 5
518 #define WATCHDOG_INTERVAL 10
519 #define DEFAULT_TIMER_TICK 0
520 #define NO_THREAD_INTERRUPT_TIME 100
522 #define DEFAULT_EVENT_LOOP_MAX 800
523 #define DEFAULT_NO_EVENT_TICK 10
524 #define DEFAULT_NO_EVENT_WAIT 20
525 #define WATCHDOG_INTERVAL 10
526 #define DEFAULT_TIMER_TICK 0
527 #define NO_THREAD_INTERRUPT_TIME 100
530 #define EVENT_HANDLER_TIMEOUT 100
547 #if TCL_MAJOR_VERSION >= 8
548 static int ip_ruby_eval
_((ClientData, Tcl_Interp *,
int, Tcl_Obj *
CONST*));
549 static int ip_ruby_cmd
_((ClientData, Tcl_Interp *,
int, Tcl_Obj *
CONST*));
551 static int ip_ruby_eval
_((ClientData, Tcl_Interp *,
int,
char **));
552 static int ip_ruby_cmd
_((ClientData, Tcl_Interp *,
int,
char **));
564 #ifndef TCL_NAMESPACE_DEBUG
565 #define TCL_NAMESPACE_DEBUG 0
568 #if TCL_NAMESPACE_DEBUG
570 #if TCL_MAJOR_VERSION >= 8
571 EXTERN struct TclIntStubs *tclIntStubsPtr;
575 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5
578 # ifndef Tcl_GetCurrentNamespace
579 EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace
_((Tcl_Interp *));
581 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
582 # ifndef Tcl_GetCurrentNamespace
583 # ifndef FunctionNum_of_GetCurrentNamespace
584 #define FunctionNum_of_GetCurrentNamespace 124
586 struct DummyTclIntStubs_for_GetCurrentNamespace {
588 struct TclIntStubHooks *hooks;
589 void (*
func[FunctionNum_of_GetCurrentNamespace])();
590 Tcl_Namespace * (*tcl_GetCurrentNamespace)
_((Tcl_Interp *));
593 #define Tcl_GetCurrentNamespace \
594 (((struct DummyTclIntStubs_for_GetCurrentNamespace *)tclIntStubsPtr)->tcl_GetCurrentNamespace)
601 #if TCL_MAJOR_VERSION < 8
602 #define ip_null_namespace(interp) (0)
604 #define ip_null_namespace(interp) \
605 (Tcl_GetCurrentNamespace(interp) == (Tcl_Namespace *)NULL)
609 #if TCL_MAJOR_VERSION < 8
610 #define rbtk_invalid_namespace(ptr) (0)
612 #define rbtk_invalid_namespace(ptr) \
613 ((ptr)->default_ns == (Tcl_Namespace*)NULL || Tcl_GetCurrentNamespace((ptr)->ip) != (ptr)->default_ns)
617 #if TCL_MAJOR_VERSION >= 8
619 typedef struct CallFrame {
620 Tcl_Namespace *nsPtr;
624 struct CallFrame *callerPtr;
625 struct CallFrame *callerVarPtr;
634 # if !defined(TclGetFrame) && !defined(TclGetFrame_TCL_DECLARED)
635 EXTERN int TclGetFrame
_((Tcl_Interp *,
CONST char *, CallFrame **));
637 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
639 # ifndef FunctionNum_of_GetFrame
640 #define FunctionNum_of_GetFrame 32
642 struct DummyTclIntStubs_for_GetFrame {
644 struct TclIntStubHooks *hooks;
645 void (*
func[FunctionNum_of_GetFrame])();
646 int (*tclGetFrame)
_((Tcl_Interp *,
CONST char *, CallFrame **));
648 #define TclGetFrame \
649 (((struct DummyTclIntStubs_for_GetFrame *)tclIntStubsPtr)->tclGetFrame)
653 # if !defined(Tcl_PopCallFrame) && !defined(Tcl_PopCallFrame_TCL_DECLARED)
654 EXTERN void Tcl_PopCallFrame
_((Tcl_Interp *));
655 EXTERN int Tcl_PushCallFrame
_((Tcl_Interp *, Tcl_CallFrame *, Tcl_Namespace *,
int));
657 # if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
658 # ifndef Tcl_PopCallFrame
659 # ifndef FunctionNum_of_PopCallFrame
660 #define FunctionNum_of_PopCallFrame 128
662 struct DummyTclIntStubs_for_PopCallFrame {
664 struct TclIntStubHooks *hooks;
665 void (*
func[FunctionNum_of_PopCallFrame])();
666 void (*tcl_PopCallFrame)
_((Tcl_Interp *));
667 int (*tcl_PushCallFrame)
_((Tcl_Interp *, Tcl_CallFrame *, Tcl_Namespace *,
int));
670 #define Tcl_PopCallFrame \
671 (((struct DummyTclIntStubs_for_PopCallFrame *)tclIntStubsPtr)->tcl_PopCallFrame)
672 #define Tcl_PushCallFrame \
673 (((struct DummyTclIntStubs_for_PopCallFrame *)tclIntStubsPtr)->tcl_PushCallFrame)
679 typedef struct CallFrame {
680 Tcl_HashTable varTable;
684 struct CallFrame *callerPtr;
685 struct CallFrame *callerVarPtr;
688 # ifndef Tcl_CallFrame
689 #define Tcl_CallFrame CallFrame
692 # if !defined(TclGetFrame) && !defined(TclGetFrame_TCL_DECLARED)
693 EXTERN int TclGetFrame
_((Tcl_Interp *,
CONST char *, CallFrame **));
696 # if !defined(Tcl_PopCallFrame) && !defined(Tcl_PopCallFrame_TCL_DECLARED)
697 typedef struct DummyInterp {
701 Tcl_HashTable dummy4;
702 Tcl_HashTable dummy5;
703 Tcl_HashTable dummy6;
707 CallFrame *varFramePtr;
711 Tcl_PopCallFrame(interp)
714 DummyInterp *iPtr = (DummyInterp*)interp;
715 CallFrame *frame = iPtr->varFramePtr;
718 iPtr->framePtr = frame.callerPtr;
719 iPtr->varFramePtr = frame.callerVarPtr;
725 #define Tcl_Namespace char
728 Tcl_PushCallFrame(interp, framePtr, nsPtr, isProcCallFrame)
730 Tcl_CallFrame *framePtr;
731 Tcl_Namespace *nsPtr;
734 DummyInterp *iPtr = (DummyInterp*)interp;
735 CallFrame *frame = (CallFrame *)framePtr;
738 Tcl_InitHashTable(&frame.varTable, TCL_STRING_KEYS);
739 if (iPtr->varFramePtr !=
NULL) {
740 frame.level = iPtr->varFramePtr->level + 1;
744 frame.callerPtr = iPtr->framePtr;
745 frame.callerVarPtr = iPtr->varFramePtr;
746 iPtr->framePtr = &frame;
747 iPtr->varFramePtr = &frame;
761 #if TCL_NAMESPACE_DEBUG
762 Tcl_Namespace *default_ns;
764 #ifdef RUBY_USE_NATIVE_THREAD
765 Tcl_ThreadId tk_thread_id;
796 if (!ptr || !ptr->ip || Tcl_InterpDeleted(ptr->ip)
798 || rbtk_invalid_namespace(ptr)
801 DUMP1(
"ip is deleted");
813 if (ptr->ip == (Tcl_Interp*)
NULL) {
819 return(ptr->ref_count);
827 if (ptr->ref_count < 0) {
829 }
else if (ptr->ip == (Tcl_Interp*)
NULL) {
835 return(ptr->ref_count);
840 #ifdef HAVE_STDARG_PROTOTYPES
843 create_ip_exc(interp, exc, fmt, va_alist)
853 struct tcltkip *ptr = get_ip(interp);
869 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
873 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 84
874 #error Ruby/Tk-Kit requires Tcl/Tk8.4 or later.
894 #if defined USE_TCL_STUBS || defined USE_TK_STUBS
895 # error Not support Tcl/Tk stubs with Ruby/Tk-Kit or Rubykit.
898 #ifndef KIT_INCLUDES_ZLIB
899 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
900 #define KIT_INCLUDES_ZLIB 1
902 #define KIT_INCLUDES_ZLIB 0
907 #define WIN32_LEAN_AND_MEAN
909 #undef WIN32_LEAN_AND_MEAN
912 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
913 EXTERN Tcl_Obj* TclGetStartupScriptPath();
914 EXTERN void TclSetStartupScriptPath
_((Tcl_Obj*));
915 #define Tcl_GetStartupScript(encPtr) TclGetStartupScriptPath()
916 #define Tcl_SetStartupScript(path,enc) TclSetStartupScriptPath(path)
918 #if !defined(TclSetPreInitScript) && !defined(TclSetPreInitScript_TCL_DECLARED)
919 EXTERN char* TclSetPreInitScript
_((
char *));
922 #ifndef KIT_INCLUDES_TK
923 # define KIT_INCLUDES_TK 1
928 Tcl_AppInitProc Vfs_Init, Rechan_Init;
929 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
930 Tcl_AppInitProc Pwb_Init;
934 Tcl_AppInitProc Vlerq_Init, Vlerq_SafeInit;
936 Tcl_AppInitProc Mk4tcl_Init;
939 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
940 Tcl_AppInitProc Thread_Init;
943 #if KIT_INCLUDES_ZLIB
944 Tcl_AppInitProc Zlib_Init;
947 #ifdef KIT_INCLUDES_ITCL
948 Tcl_AppInitProc Itcl_Init;
952 Tcl_AppInitProc Dde_Init, Dde_SafeInit, Registry_Init;
957 #define RUBYTK_KITPATH_CONST_NAME "RUBYTK_KITPATH"
959 static char *rubytk_kitpath =
NULL;
961 static char rubytkkit_preInitCmd[] =
962 "proc tclKitPreInit {} {\n"
963 "rename tclKitPreInit {}\n"
964 "load {} rubytk_kitpath\n"
965 #if KIT_INCLUDES_ZLIB
966 "catch {load {} zlib}\n"
970 "namespace eval ::vlerq {}\n"
971 "if {[catch { vlerq open $::tcl::kitpath } ::vlerq::starkit_root]} {\n"
974 "set files [vlerq get $::vlerq::starkit_root 0 dirs 0 files]\n"
975 "set n [lsearch [vlerq get $files * name] boot.tcl]\n"
978 "array set a [vlerq get $files $n]\n"
981 #if defined KIT_VFS_WRITABLE && !defined CREATE_RUBYKIT
983 "mk::file open exe $::tcl::kitpath\n"
985 "mk::file open exe $::tcl::kitpath -readonly\n"
987 "set n [mk::select exe.dirs!0.files name boot.tcl]\n"
988 "if {[llength $n] == 1} {\n"
989 "array set a [mk::get exe.dirs!0.files!$n]\n"
991 "if {![info exists a(contents)]} { error {no boot.tcl file} }\n"
992 "if {$a(size) != [string length $a(contents)]} {\n"
993 "set a(contents) [zlib decompress $a(contents)]\n"
995 "if {$a(contents) eq \"\"} { error {empty boot.tcl} }\n"
996 "uplevel #0 $a(contents)\n"
998 "} elseif {[lindex $::argv 0] eq \"-init-\"} {\n"
999 "uplevel #0 { source [lindex $::argv 1] }\n"
1004 "set vfsdir \"[file rootname $::tcl::kitpath].vfs\"\n"
1005 "if {[file isdirectory $vfsdir]} {\n"
1006 "set ::tcl_library [file join $vfsdir lib tcl$::tcl_version]\n"
1007 "set ::tcl_libPath [list $::tcl_library [file join $vfsdir lib]]\n"
1008 "catch {uplevel #0 [list source [file join $vfsdir config.tcl]]}\n"
1009 "uplevel #0 [list source [file join $::tcl_library init.tcl]]\n"
1010 "set ::auto_path $::tcl_libPath\n"
1012 "error \"\n $::tcl::kitpath has no VFS data to start up\"\n"
1022 static const char initScript[] =
1023 "if {[file isfile [file join $::tcl::kitpath main.tcl]]} {\n"
1024 "if {[info commands console] != {}} { console hide }\n"
1025 "set tcl_interactive 0\n"
1027 "set argv [linsert $argv 0 $argv0]\n"
1028 "set argv0 [file join $::tcl::kitpath main.tcl]\n"
1036 set_rubytk_kitpath(
const char *kitpath)
1040 if (rubytk_kitpath) {
1044 rubytk_kitpath = (
char *)ckalloc(len + 1);
1045 memcpy(rubytk_kitpath, kitpath, len);
1046 rubytk_kitpath[
len] =
'\0';
1048 return rubytk_kitpath;
1054 #define DEV_NULL "NUL"
1056 #define DEV_NULL "/dev/null"
1060 check_tclkit_std_channels()
1069 chan = Tcl_GetStdChannel(TCL_STDIN);
1071 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"r", 0);
1073 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1075 Tcl_SetStdChannel(chan, TCL_STDIN);
1077 chan = Tcl_GetStdChannel(TCL_STDOUT);
1079 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"w", 0);
1081 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1083 Tcl_SetStdChannel(chan, TCL_STDOUT);
1085 chan = Tcl_GetStdChannel(TCL_STDERR);
1087 chan = Tcl_OpenFileChannel(
NULL, DEV_NULL,
"w", 0);
1089 Tcl_SetChannelOption(
NULL, chan,
"-encoding",
"utf-8");
1091 Tcl_SetStdChannel(chan, TCL_STDERR);
1098 rubytk_kitpathObjCmd(ClientData
dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *
const objv[])
1102 set_rubytk_kitpath(Tcl_GetString(objv[1]));
1103 }
else if (objc > 2) {
1104 Tcl_WrongNumArgs(interp, 1, objv,
"?path?");
1106 str = rubytk_kitpath ? rubytk_kitpath : Tcl_GetNameOfExecutable();
1107 Tcl_SetObjResult(interp, Tcl_NewStringObj(str, -1));
1116 rubytk_kitpath_init(Tcl_Interp *interp)
1118 Tcl_CreateObjCommand(interp,
"::tcl::kitpath", rubytk_kitpathObjCmd, 0, 0);
1119 if (Tcl_LinkVar(interp,
"::tcl::kitpath", (
char *) &rubytk_kitpath,
1120 TCL_LINK_STRING | TCL_LINK_READ_ONLY) !=
TCL_OK) {
1124 Tcl_CreateObjCommand(interp,
"::tcl::rubytk_kitpath", rubytk_kitpathObjCmd, 0, 0);
1125 if (Tcl_LinkVar(interp,
"::tcl::rubytk_kitpath", (
char *) &rubytk_kitpath,
1126 TCL_LINK_STRING | TCL_LINK_READ_ONLY) !=
TCL_OK) {
1130 if (rubytk_kitpath ==
NULL) {
1135 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1138 return Tcl_PkgProvide(interp,
"rubytk_kitpath",
"1.0");
1144 init_static_tcltk_packages()
1149 check_tclkit_std_channels();
1151 #ifdef KIT_INCLUDES_ITCL
1152 Tcl_StaticPackage(0,
"Itcl", Itcl_Init,
NULL);
1155 Tcl_StaticPackage(0,
"Vlerq", Vlerq_Init, Vlerq_SafeInit);
1157 Tcl_StaticPackage(0,
"Mk4tcl", Mk4tcl_Init,
NULL);
1159 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
1160 Tcl_StaticPackage(0,
"pwb", Pwb_Init,
NULL);
1162 Tcl_StaticPackage(0,
"rubytk_kitpath", rubytk_kitpath_init,
NULL);
1163 Tcl_StaticPackage(0,
"rechan", Rechan_Init,
NULL);
1164 Tcl_StaticPackage(0,
"vfs", Vfs_Init,
NULL);
1165 #if KIT_INCLUDES_ZLIB
1166 Tcl_StaticPackage(0,
"zlib", Zlib_Init,
NULL);
1168 #if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
1169 Tcl_StaticPackage(0,
"Thread", Thread_Init, Thread_SafeInit);
1172 #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
1173 Tcl_StaticPackage(0,
"dde", Dde_Init, Dde_SafeInit);
1175 Tcl_StaticPackage(0,
"dde", Dde_Init,
NULL);
1177 Tcl_StaticPackage(0,
"registry", Registry_Init,
NULL);
1179 #ifdef KIT_INCLUDES_TK
1180 Tcl_StaticPackage(0,
"Tk", Tk_Init, Tk_SafeInit);
1187 call_tclkit_init_script(Tcl_Interp *interp)
1193 if (Tcl_EvalEx(interp, initScript, -1, TCL_EVAL_GLOBAL) ==
TCL_OK) {
1194 const char *encoding =
NULL;
1195 Tcl_Obj*
path = Tcl_GetStartupScript(&encoding);
1196 Tcl_SetStartupScript(Tcl_GetObjResult(interp), encoding);
1198 Tcl_Eval(interp,
"incr argc -1; set argv [lrange $argv 1 end]");
1212 EXTERN void TkWinSetHINSTANCE(HINSTANCE hInstance);
1213 void rbtk_win32_SetHINSTANCE(
const char *module_name)
1220 hInst = GetModuleHandle(module_name);
1221 TkWinSetHINSTANCE(hInst);
1233 init_static_tcltk_packages();
1237 const_id =
rb_intern(RUBYTK_KITPATH_CONST_NAME);
1240 volatile VALUE pathobj;
1244 #ifdef HAVE_RUBY_ENCODING_H
1252 #ifdef CREATE_RUBYTK_KIT
1253 if (rubytk_kitpath ==
NULL) {
1257 volatile VALUE basename;
1267 if (rubytk_kitpath ==
NULL) {
1268 set_rubytk_kitpath(Tcl_GetNameOfExecutable());
1271 TclSetPreInitScript(rubytkkit_preInitCmd);
1311 tcltkip_init_tk(interp)
1314 struct tcltkip *ptr = get_ip(interp);
1316 #if TCL_MAJOR_VERSION >= 8
1319 if (Tcl_IsSafe(ptr->
ip)) {
1320 DUMP1(
"Tk_SafeInit");
1327 "tcltklib: can't find Tk_SafeInit()");
1330 "tcltklib: fail to Tk_SafeInit(). %s",
1334 "tcltklib: fail to Tk_InitStubs(). %s",
1338 "tcltklib: unknown error(%d) on ruby_tk_stubs_safeinit", st);
1348 "tcltklib: can't find Tk_Init()");
1351 "tcltklib: fail to Tk_Init(). %s",
1355 "tcltklib: fail to Tk_InitStubs(). %s",
1359 "tcltklib: unknown error(%d) on ruby_tk_stubs_init", st);
1370 #ifdef RUBY_USE_NATIVE_THREAD
1371 ptr->tk_thread_id = Tcl_GetCurrentThread();
1390 DUMP1(
"find a pending exception");
1399 DUMP1(
"pending_exception_check0: call rb_jump_tag(retry)");
1402 DUMP1(
"pending_exception_check0: call rb_jump_tag(redo)");
1405 DUMP1(
"pending_exception_check0: call rb_jump_tag(throw)");
1426 DUMP1(
"find a pending exception");
1443 DUMP1(
"pending_exception_check1: call rb_jump_tag(retry)");
1446 DUMP1(
"pending_exception_check1: call rb_jump_tag(redo)");
1449 DUMP1(
"pending_exception_check1: call rb_jump_tag(throw)");
1464 call_original_exit(ptr,
state)
1470 #if TCL_MAJOR_VERSION >= 8
1474 DUMP1(
"original_exit is called");
1476 if (!(ptr->has_orig_exit))
return;
1483 info = &(ptr->orig_exit_info);
1486 #if TCL_MAJOR_VERSION >= 8
1487 state_obj = Tcl_NewIntObj(state);
1490 if (info->isNativeObjectProc) {
1492 #define USE_RUBY_ALLOC 0
1494 argv = (Tcl_Obj **)
ALLOC_N(Tcl_Obj *, 3);
1501 cmd_obj = Tcl_NewStringObj(
"exit", 4);
1505 argv[1] = state_obj;
1506 argv[2] = (Tcl_Obj *)
NULL;
1509 = (*(info->objProc))(info->objClientData, ptr->ip, 2,
argv);
1517 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1527 #undef USE_RUBY_ALLOC
1532 #define USE_RUBY_ALLOC 0
1541 argv[0] = (
char *)
"exit";
1543 argv[1] = Tcl_GetStringFromObj(state_obj, (
int*)
NULL);
1544 argv[2] = (
char *)
NULL;
1546 ptr->return_value = (*(info->proc))(info->clientData, ptr->ip, 2,
argv);
1552 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1562 #undef USE_RUBY_ALLOC
1571 #define USE_RUBY_ALLOC 0
1573 argv = (
char **)
ALLOC_N(
char *, 3);
1582 argv[2] = (
char *)
NULL;
1584 ptr->return_value = (*(info->proc))(info->clientData, ptr->ip,
1591 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
1601 #undef USE_RUBY_ALLOC
1604 DUMP1(
"complete original_exit");
1613 static void _timer_for_tcl
_((ClientData));
1623 DUMP1(
"call _timer_for_tcl");
1632 if (timer_tick > 0) {
1633 timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl,
1645 #ifdef RUBY_USE_NATIVE_THREAD
1646 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE
1648 toggle_eventloop_window_mode_for_idle()
1650 if (window_event_mode & TCL_IDLE_EVENTS) {
1652 window_event_mode |= TCL_WINDOW_EVENTS;
1653 window_event_mode &= ~TCL_IDLE_EVENTS;
1657 window_event_mode |= TCL_IDLE_EVENTS;
1658 window_event_mode &= ~TCL_WINDOW_EVENTS;
1666 set_eventloop_window_mode(
self,
mode)
1672 window_event_mode = ~0;
1674 window_event_mode = ~TCL_WINDOW_EVENTS;
1681 get_eventloop_window_mode(
self)
1684 if ( ~window_event_mode ) {
1702 "timer-tick parameter must be 0 or positive number");
1711 timer_tick = req_timer_tick = ttick;
1712 if (timer_tick > 0) {
1714 timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl,
1726 get_eventloop_tick(
self)
1733 ip_set_eventloop_tick(
self, tick)
1737 struct tcltkip *ptr = get_ip(
self);
1740 if (deleted_ip(ptr)) {
1741 return get_eventloop_tick(
self);
1744 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1746 return get_eventloop_tick(
self);
1752 ip_get_eventloop_tick(
self)
1755 return get_eventloop_tick(
self);
1768 "no_event_wait parameter must be positive number");
1771 no_event_wait = t_wait;
1777 get_no_event_wait(
self)
1780 return INT2NUM(no_event_wait);
1784 ip_set_no_event_wait(
self, wait)
1788 struct tcltkip *ptr = get_ip(
self);
1791 if (deleted_ip(ptr)) {
1792 return get_no_event_wait(
self);
1795 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1797 return get_no_event_wait(
self);
1803 ip_get_no_event_wait(
self)
1806 return get_no_event_wait(
self);
1815 int lpmax =
NUM2INT(loop_max);
1819 if (lpmax <= 0 || no_ev <= 0) {
1823 event_loop_max = lpmax;
1824 no_event_tick =
no_ev;
1830 get_eventloop_weight(
self)
1837 ip_set_eventloop_weight(
self, loop_max, no_event)
1842 struct tcltkip *ptr = get_ip(
self);
1845 if (deleted_ip(ptr)) {
1846 return get_eventloop_weight(
self);
1849 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1851 return get_eventloop_weight(
self);
1857 ip_get_eventloop_weight(
self)
1860 return get_eventloop_weight(
self);
1864 set_max_block_time(
self,
time)
1868 struct Tcl_Time tcl_time;
1894 Tcl_SetMaxBlockTime(&tcl_time);
1900 lib_evloop_thread_p(
self)
1903 if (
NIL_P(eventloop_thread)) {
1913 lib_evloop_abort_on_exc(
self)
1916 if (event_loop_abort_on_exc > 0) {
1918 }
else if (event_loop_abort_on_exc == 0) {
1926 ip_evloop_abort_on_exc(
self)
1929 return lib_evloop_abort_on_exc(
self);
1937 event_loop_abort_on_exc = 1;
1938 }
else if (
NIL_P(val)) {
1939 event_loop_abort_on_exc = -1;
1941 event_loop_abort_on_exc = 0;
1943 return lib_evloop_abort_on_exc(
self);
1947 ip_evloop_abort_on_exc_set(
self,
val)
1950 struct tcltkip *ptr = get_ip(
self);
1954 if (deleted_ip(ptr)) {
1955 return lib_evloop_abort_on_exc(
self);
1958 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
1960 return lib_evloop_abort_on_exc(
self);
1966 lib_num_of_mainwindows_core(
self,
argc, argv)
1972 return INT2FIX(Tk_GetNumMainWindows());
1979 lib_num_of_mainwindows(
self)
1982 #ifdef RUBY_USE_NATIVE_THREAD
1985 return lib_num_of_mainwindows_core(
self, 0, (
VALUE*)
NULL);
1994 tcl_time.usec = 1000L * (long)no_event_tick;
1995 Tcl_SetMaxBlockTime(&tcl_time);
2005 #ifdef RUBY_USE_NATIVE_THREAD
2007 #ifdef HAVE_PROTOTYPES
2010 call_DoOneEvent_core(flag_val)
2017 if (Tcl_DoOneEvent(flag)) {
2025 #ifdef HAVE_PROTOTYPES
2026 call_DoOneEvent(
VALUE flag_val)
2028 call_DoOneEvent(flag_val)
2037 #ifdef HAVE_PROTOTYPES
2038 call_DoOneEvent(
VALUE flag_val)
2040 call_DoOneEvent(flag_val)
2047 if (Tcl_DoOneEvent(flag)) {
2058 #ifdef HAVE_PROTOTYPES
2059 eventloop_sleep(
VALUE dummy)
2061 eventloop_sleep(dummy)
2067 if (no_event_wait <= 0) {
2072 t.tv_usec = (
int)(no_event_wait*1000.0);
2074 #ifdef HAVE_NATIVETHREAD
2075 #ifndef RUBY_USE_NATIVE_THREAD
2077 rb_bug(
"cross-thread violation on eventloop_sleep()");
2086 #ifdef HAVE_NATIVETHREAD
2087 #ifndef RUBY_USE_NATIVE_THREAD
2089 rb_bug(
"cross-thread violation on eventloop_sleep()");
2098 #define USE_EVLOOP_THREAD_ALONE_CHECK_FLAG 0
2100 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2102 get_thread_alone_check_flag()
2104 #ifdef RUBY_USE_NATIVE_THREAD
2136 #define TRAP_CHECK() do { \
2137 if (trap_check(check_var) == 0) return 0; \
2143 DUMP1(
"trap check");
2147 if (check_var != (
int*)
NULL) {
2156 if (rb_trap_pending) {
2158 if (rb_prohibit_interrupt || check_var != (
int*)
NULL) {
2173 DUMP1(
"check eventloop_interp");
2174 if (eventloop_interp != (Tcl_Interp*)
NULL
2175 && Tcl_InterpDeleted(eventloop_interp)) {
2176 DUMP2(
"eventloop_interp(%p) was deleted", eventloop_interp);
2199 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2202 enum {thread_alone_check_flag = 1};
2205 if (update_flag)
DUMP1(
"update loop start!!");
2214 if (timer_tick > 0) {
2217 timer_token = Tcl_CreateTimerHandler(timer_tick, _timer_for_tcl,
2224 #if USE_EVLOOP_THREAD_ALONE_CHECK_FLAG
2226 thread_alone_check_flag = get_thread_alone_check_flag();
2233 DUMP1(
"no other thread");
2234 event_loop_wait_event = 0;
2240 event_flag = TCL_ALL_EVENTS;
2244 if (timer_tick == 0 && update_flag == 0) {
2251 if (check_var != (
int *)
NULL) {
2252 if (*check_var || !found_event) {
2255 if (interp != (Tcl_Interp*)
NULL
2256 && Tcl_InterpDeleted(interp)) {
2264 INT2FIX(event_flag), &status));
2296 DUMP2(
"DoOneEvent(1) abnormal exit!! %d",
2301 DUMP1(
"exception on wait");
2310 if (update_flag != 0) {
2312 DUMP1(
"next update loop");
2315 DUMP1(
"update complete");
2323 DUMP1(
"check Root Widget");
2330 if (loop_counter++ > 30000) {
2338 DUMP1(
"there are other threads");
2339 event_loop_wait_event = 1;
2347 event_flag = TCL_ALL_EVENTS;
2353 while(tick_counter < event_loop_max) {
2354 if (check_var != (
int *)
NULL) {
2355 if (*check_var || !found_event) {
2358 if (interp != (Tcl_Interp*)
NULL
2359 && Tcl_InterpDeleted(interp)) {
2365 if (
NIL_P(eventloop_thread) || current == eventloop_thread) {
2369 #ifdef RUBY_USE_NATIVE_THREAD
2372 INT2FIX(event_flag), &status));
2375 INT2FIX(event_flag & window_event_mode),
2377 #if USE_TOGGLE_WINDOW_MODE_FOR_IDLE
2379 if (toggle_eventloop_window_mode_for_idle()) {
2392 INT2FIX(event_flag), &status));
2395 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
2396 if (have_rb_thread_waiting_for_value) {
2397 have_rb_thread_waiting_for_value = 0;
2408 "unknown exception");
2434 DUMP2(
"DoOneEvent(2) abnormal exit!! %d",
2441 if (check_var != (
int*)
NULL
2443 DUMP1(
"exception on wait");
2455 if (update_flag != 0) {
2456 DUMP1(
"update complete");
2472 "unknown exception");
2501 DUMP2(
"sleep eventloop %lx", current);
2502 DUMP2(
"eventloop thread is %lx", eventloop_thread);
2507 if (!
NIL_P(watchdog_thread) && eventloop_thread != current) {
2514 DUMP1(
"check Root Widget");
2521 if (loop_counter++ > 30000) {
2526 if (run_timer_flag) {
2535 DUMP1(
"thread scheduling");
2539 DUMP1(
"check interrupts");
2540 #if defined(RUBY_USE_NATIVE_THREAD) || defined(RUBY_VM)
2560 lib_eventloop_main_core(args)
2580 lib_eventloop_main(args)
2583 return lib_eventloop_main_core(args);
2589 ret =
rb_protect(lib_eventloop_main_core, args, &status);
2615 lib_eventloop_ensure(args)
2623 DUMP2(
"eventloop_ensure: current-thread : %lx", current_evloop);
2624 DUMP2(
"eventloop_ensure: eventloop-thread : %lx", eventloop_thread);
2625 if (eventloop_thread != current_evloop) {
2626 DUMP2(
"finish eventloop %lx (NOT current eventloop)", current_evloop);
2637 DUMP2(
"eventloop-ensure: new eventloop-thread -> %lx",
2640 if (eventloop_thread == current_evloop) {
2642 DUMP2(
"eventloop %lx : back from recursive call", current_evloop);
2646 if (
NIL_P(eventloop_thread)) {
2654 DUMP2(
"eventloop-enshure: wake up parent %lx", eventloop_thread);
2661 #ifdef RUBY_USE_NATIVE_THREAD
2662 if (
NIL_P(eventloop_thread)) {
2663 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2672 DUMP2(
"finish current eventloop %lx", current_evloop);
2690 #ifdef RUBY_USE_NATIVE_THREAD
2691 tk_eventloop_thread_id = Tcl_GetCurrentThread();
2694 if (parent_evloop == eventloop_thread) {
2695 DUMP2(
"eventloop: recursive call on %lx", parent_evloop);
2699 if (!
NIL_P(parent_evloop) && parent_evloop != eventloop_thread) {
2700 DUMP2(
"wait for stop of parent_evloop %lx", parent_evloop);
2702 DUMP2(
"parent_evloop %lx doesn't stop", parent_evloop);
2705 DUMP1(
"succeed to stop parent");
2710 DUMP3(
"tcltklib: eventloop-thread : %lx -> %lx\n",
2711 parent_evloop, eventloop_thread);
2723 lib_eventloop_ensure, (
VALUE)args);
2726 lib_eventloop_ensure, (
VALUE)args);
2731 lib_mainloop(
argc, argv,
self)
2739 check_rootwidget =
Qtrue;
2741 check_rootwidget =
Qtrue;
2743 check_rootwidget =
Qfalse;
2751 ip_mainloop(argc, argv,
self)
2757 struct tcltkip *ptr = get_ip(
self);
2760 if (deleted_ip(ptr)) {
2764 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2769 eventloop_interp = ptr->
ip;
2770 ret = lib_mainloop(argc, argv,
self);
2771 eventloop_interp = (Tcl_Interp*)
NULL;
2777 watchdog_evloop_launcher(check_rootwidget)
2784 #define EVLOOP_WAKEUP_CHANCE 3
2787 lib_watchdog_core(check_rootwidget)
2788 VALUE check_rootwidget;
2813 if (
NIL_P(eventloop_thread)
2816 DUMP2(
"eventloop thread %lx is sleeping or dead",
2819 (
void*)&check_rootwidget);
2820 DUMP2(
"create new eventloop thread %lx", evloop);
2831 if (event_loop_wait_event) {
2844 lib_watchdog_ensure(
arg)
2847 eventloop_thread =
Qnil;
2848 #ifdef RUBY_USE_NATIVE_THREAD
2849 tk_eventloop_thread_id = (Tcl_ThreadId) 0;
2864 "eventloop_watchdog is not implemented on Ruby VM.");
2867 if (
rb_scan_args(argc, argv,
"01", &check_rootwidget) == 0) {
2868 check_rootwidget =
Qtrue;
2869 }
else if (
RTEST(check_rootwidget)) {
2870 check_rootwidget =
Qtrue;
2872 check_rootwidget =
Qfalse;
2875 return rb_ensure(lib_watchdog_core, check_rootwidget,
2876 lib_watchdog_ensure,
Qnil);
2880 ip_mainloop_watchdog(argc, argv,
self)
2885 struct tcltkip *ptr = get_ip(
self);
2888 if (deleted_ip(ptr)) {
2892 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
2913 _thread_call_proc_core(
arg)
2921 _thread_call_proc_ensure(
arg)
2930 _thread_call_proc(
arg)
2936 _thread_call_proc_ensure, (
VALUE)q);
2940 #ifdef HAVE_PROTOTYPES
2941 _thread_call_proc_value(
VALUE th)
2943 _thread_call_proc_value(th)
2951 lib_thread_callback(argc, argv,
self)
2984 ret =
rb_protect(_thread_call_proc_value, th, &status);
3010 lib_do_one_event_core(argc, argv,
self,
is_ip)
3016 volatile VALUE vflags;
3027 flags = TCL_ALL_EVENTS | TCL_DONT_WAIT;
3034 flags |= TCL_DONT_WAIT;
3039 struct tcltkip *ptr = get_ip(
self);
3042 if (deleted_ip(ptr)) {
3046 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)
NULL) {
3048 flags |= TCL_DONT_WAIT;
3053 found_event = Tcl_DoOneEvent(flags);
3067 lib_do_one_event(argc, argv,
self)
3072 return lib_do_one_event_core(argc, argv,
self, 0);
3076 ip_do_one_event(argc, argv,
self)
3081 return lib_do_one_event_core(argc, argv,
self, 0);
3086 ip_set_exc_message(interp, exc)
3095 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
3097 Tcl_Encoding encoding;
3106 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
3112 encoding = (Tcl_Encoding)
NULL;
3131 Tcl_DStringInit(&dstr);
3132 Tcl_DStringFree(&dstr);
3133 Tcl_ExternalToUtfDString(encoding, buf,
RSTRING_LENINT(msg), &dstr);
3136 DUMP2(
"error message:%s", Tcl_DStringValue(&dstr));
3137 Tcl_DStringFree(&dstr);
3178 #ifdef HAVE_PROTOTYPES
3221 DUMP1(
"rb_protect: retry");
3222 exc =
rb_exc_new2(eTkCallbackRetry,
"retry jump error");
3230 DUMP1(
"rb_protect: redo");
3231 exc =
rb_exc_new2(eTkCallbackRedo,
"redo jump error");
3255 DUMP1(
"rb_protect: throw");
3256 exc =
rb_exc_new2(eTkCallbackThrow,
"throw jump error");
3265 sprintf(buf,
"unknown loncaljmp status %d", status);
3284 volatile VALUE backtrace;
3291 DUMP1(
"set backtrace");
3299 ip_set_exc_message(interp, exc);
3301 if (eclass == eTkCallbackReturn)
3304 if (eclass == eTkCallbackBreak)
3307 if (eclass == eTkCallbackContinue)
3308 return TCL_CONTINUE;
3324 if (
SYM2ID(reason) == ID_return)
3327 if (
SYM2ID(reason) == ID_break)
3330 if (
SYM2ID(reason) == ID_next)
3331 return TCL_CONTINUE;
3344 ret = TkStringValue(ret);
3345 DUMP1(
"Tcl_AppendResult");
3357 tcl_protect(interp, proc, data)
3364 #ifdef HAVE_NATIVETHREAD
3365 #ifndef RUBY_USE_NATIVE_THREAD
3367 rb_bug(
"cross-thread violation on tcl_protect()");
3376 int old_trapflag = rb_trap_immediate;
3377 rb_trap_immediate = 0;
3379 rb_trap_immediate = old_trapflag;
3387 #if TCL_MAJOR_VERSION >= 8
3388 ip_ruby_eval(clientData, interp, argc, argv)
3389 ClientData clientData;
3392 Tcl_Obj *
CONST argv[];
3394 ip_ruby_eval(clientData, interp, argc, argv)
3395 ClientData clientData;
3415 "wrong number of arguments (%d for 1)", argc - 1);
3417 char buf[
sizeof(
int)*8 + 1];
3421 buf,
" for 1)", (
char *)
NULL);
3429 #if TCL_MAJOR_VERSION >= 8
3437 str = Tcl_GetStringFromObj(argv[1], &len);
3451 DUMP2(
"rb_eval_string(%s)", arg);
3455 #if TCL_MAJOR_VERSION >= 8
3466 ip_ruby_cmd_core(arg)
3472 DUMP1(
"call ip_ruby_cmd_core");
3475 ret =
rb_apply(arg->receiver, arg->method, arg->args);
3476 DUMP2(
"rb_apply return:%lx", ret);
3478 DUMP1(
"finish ip_ruby_cmd_core");
3483 #define SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER 1
3486 ip_ruby_cmd_receiver_const_get(
name)
3495 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3514 head = name =
strdup(name);
3517 if (*head ==
':') head += 2;
3538 ip_ruby_cmd_receiver_get(str)
3542 #if !SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3546 if (str[0] ==
':' || (
'A' <= str[0] && str[0] <=
'Z')) {
3548 #if SUPPORT_NESTED_CONST_AS_IP_RUBY_CMD_RECEIVER
3549 receiver = ip_ruby_cmd_receiver_const_get(str);
3551 receiver =
rb_protect(ip_ruby_cmd_receiver_const_get, (
VALUE)str, &state);
3552 if (state)
return Qnil;
3554 }
else if (str[0] ==
'$') {
3566 memcpy(buf + 1, str, len);
3578 #if TCL_MAJOR_VERSION >= 8
3579 ip_ruby_cmd(clientData, interp, argc, argv)
3580 ClientData clientData;
3583 Tcl_Obj *
CONST argv[];
3585 ip_ruby_cmd(clientData, interp, argc, argv)
3586 ClientData clientData;
3603 if (interp == (Tcl_Interp*)
NULL) {
3627 #if TCL_MAJOR_VERSION >= 8
3628 str = Tcl_GetStringFromObj(argv[1], &len);
3632 DUMP2(
"receiver:%s",str);
3634 receiver = ip_ruby_cmd_receiver_get(str);
3638 "unknown class/module/global-variable '%s'", str);
3642 str,
"'", (
char *)
NULL);
3651 #if TCL_MAJOR_VERSION >= 8
3652 str = Tcl_GetStringFromObj(argv[2], &len);
3662 #if TCL_MAJOR_VERSION >= 8
3663 str = Tcl_GetStringFromObj(argv[i], &len);
3669 DUMP2(
"arg:%s",str);
3670 #ifndef HAVE_STRUCT_RARRAY_LEN
3689 code = tcl_protect(interp, ip_ruby_cmd_core, (
VALUE)arg);
3702 #if TCL_MAJOR_VERSION >= 8
3703 #ifdef HAVE_PROTOTYPES
3704 ip_InterpExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3705 int argc, Tcl_Obj *
CONST argv[])
3707 ip_InterpExitObjCmd(clientData, interp, argc, argv)
3708 ClientData clientData;
3711 Tcl_Obj *
CONST argv[];
3714 #ifdef HAVE_PROTOTYPES
3715 ip_InterpExitCommand(ClientData clientData, Tcl_Interp *interp,
3716 int argc,
char *argv[])
3718 ip_InterpExitCommand(clientData, interp, argc, argv)
3719 ClientData clientData;
3726 DUMP1(
"start ip_InterpExitCommand");
3727 if (interp != (Tcl_Interp*)
NULL
3728 && !Tcl_InterpDeleted(interp)
3730 && !ip_null_namespace(interp)
3736 if (!Tcl_InterpDeleted(interp)) {
3739 Tcl_DeleteInterp(interp);
3747 #if TCL_MAJOR_VERSION >= 8
3748 #ifdef HAVE_PROTOTYPES
3749 ip_RubyExitObjCmd(ClientData clientData, Tcl_Interp *interp,
3750 int argc, Tcl_Obj *
CONST argv[])
3752 ip_RubyExitObjCmd(clientData, interp, argc, argv)
3753 ClientData clientData;
3756 Tcl_Obj *
CONST argv[];
3759 #ifdef HAVE_PROTOTYPES
3760 ip_RubyExitCommand(ClientData clientData, Tcl_Interp *interp,
3761 int argc,
char *argv[])
3763 ip_RubyExitCommand(clientData, interp, argc, argv)
3764 ClientData clientData;
3773 #if TCL_MAJOR_VERSION < 8
3778 DUMP1(
"start ip_RubyExitCommand");
3780 #if TCL_MAJOR_VERSION >= 8
3782 cmd = Tcl_GetStringFromObj(argv[0], (
int*)
NULL);
3785 if (argc < 1 || argc > 2) {
3788 "wrong number of arguments: should be \"",
3789 cmd,
" ?returnCode?\"", (
char *)
NULL);
3793 if (interp == (Tcl_Interp*)
NULL)
return TCL_OK;
3798 if (!Tcl_InterpDeleted(interp)) {
3801 Tcl_DeleteInterp(interp);
3811 "fail to call \"", cmd,
"\"", (
char *)
NULL);
3820 #if TCL_MAJOR_VERSION >= 8
3821 if (Tcl_GetIntFromObj(interp, argv[1], &state) ==
TCL_ERROR) {
3825 param = Tcl_GetStringFromObj(argv[1], (
int*)
NULL);
3827 state = (
int)
strtol(argv[1], &endptr, 0);
3830 "expected integer but got \"",
3831 argv[1],
"\"", (
char *)
NULL);
3839 param,
"\"", (
char *)
NULL);
3850 "wrong number of arguments: should be \"",
3851 cmd,
" ?returnCode?\"", (
char *)
NULL);
3864 #if TCL_MAJOR_VERSION >= 8
3865 static int ip_rbUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
3866 Tcl_Obj *
CONST []));
3868 ip_rbUpdateObjCmd(clientData, interp, objc, objv)
3869 ClientData clientData;
3872 Tcl_Obj *
CONST objv[];
3874 static int ip_rbUpdateCommand
_((ClientData, Tcl_Interp *,
int,
char *[]));
3876 ip_rbUpdateCommand(clientData, interp, objc, objv)
3877 ClientData clientData;
3887 DUMP1(
"Ruby's 'update' is called");
3888 if (interp == (Tcl_Interp*)
NULL) {
3893 #ifdef HAVE_NATIVETHREAD
3894 #ifndef RUBY_USE_NATIVE_THREAD
3896 rb_bug(
"cross-thread violation on ip_ruby_eval()");
3904 flags = TCL_DONT_WAIT;
3906 }
else if (objc == 2) {
3907 #if TCL_MAJOR_VERSION >= 8
3909 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
3910 "option", 0, &optionIndex) !=
TCL_OK) {
3913 switch ((
enum updateOptions) optionIndex) {
3915 flags = TCL_IDLE_EVENTS;
3919 rb_bug(
"ip_rbUpdateObjCmd: bad option index to UpdateOptions");
3923 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
3925 "\": must be idletasks", (
char *)
NULL);
3928 flags = TCL_IDLE_EVENTS;
3931 #ifdef Tcl_WrongNumArgs
3932 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
3934 # if TCL_MAJOR_VERSION >= 8
3937 Tcl_GetStringFromObj(objv[0], &dummy),
3942 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
3985 DUMP1(
"finish Ruby's 'update'");
3998 static void rb_threadUpdateProc
_((ClientData));
4000 rb_threadUpdateProc(clientData)
4001 ClientData clientData;
4005 DUMP1(
"threadUpdateProc is called");
4012 #if TCL_MAJOR_VERSION >= 8
4013 static int ip_rb_threadUpdateObjCmd
_((ClientData, Tcl_Interp *,
int,
4014 Tcl_Obj *
CONST []));
4016 ip_rb_threadUpdateObjCmd(clientData, interp, objc, objv)
4017 ClientData clientData;
4020 Tcl_Obj *
CONST objv[];
4022 static int ip_rb_threadUpdateCommand
_((ClientData, Tcl_Interp *,
int,
4025 ip_rb_threadUpdateCommand(clientData, interp, objc, objv)
4026 ClientData clientData;
4036 static CONST char *updateOptions[] = {
"idletasks", (
char *)
NULL};
4041 DUMP1(
"Ruby's 'thread_update' is called");
4042 if (interp == (Tcl_Interp*)
NULL) {
4047 #ifdef HAVE_NATIVETHREAD
4048 #ifndef RUBY_USE_NATIVE_THREAD
4050 rb_bug(
"cross-thread violation on ip_rb_threadUpdateCommand()");
4056 ||
NIL_P(eventloop_thread) || eventloop_thread == current_thread) {
4057 #if TCL_MAJOR_VERSION >= 8
4058 DUMP1(
"call ip_rbUpdateObjCmd");
4059 return ip_rbUpdateObjCmd(clientData, interp, objc, objv);
4061 DUMP1(
"call ip_rbUpdateCommand");
4062 return ip_rbUpdateCommand(clientData, interp, objc, objv);
4066 DUMP1(
"start Ruby's 'thread_update' body");
4072 flags = TCL_DONT_WAIT;
4074 }
else if (objc == 2) {
4075 #if TCL_MAJOR_VERSION >= 8
4077 if (Tcl_GetIndexFromObj(interp, objv[1], (
CONST84 char **)updateOptions,
4078 "option", 0, &optionIndex) !=
TCL_OK) {
4081 switch ((
enum updateOptions) optionIndex) {
4084 flags = TCL_IDLE_EVENTS;
4089 rb_bug(
"ip_rb_threadUpdateObjCmd: bad option index to UpdateOptions");
4093 if (strncmp(objv[1],
"idletasks",
strlen(objv[1])) != 0) {
4095 "\": must be idletasks", (
char *)
NULL);
4099 flags = TCL_IDLE_EVENTS;
4103 #ifdef Tcl_WrongNumArgs
4104 Tcl_WrongNumArgs(interp, 1, objv,
"[ idletasks ]");
4106 # if TCL_MAJOR_VERSION >= 8
4109 Tcl_GetStringFromObj(objv[0], &dummy),
4114 objv[0],
" [ idletasks ]\"", (
char *)
NULL);
4120 DUMP1(
"pass argument check");
4130 DUMP1(
"set idle proc");
4137 DUMP1(
"wait for complete idle proc");
4141 if (
NIL_P(eventloop_thread)) {
4147 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
4157 DUMP1(
"finish Ruby's 'thread_update'");
4165 #if TCL_MAJOR_VERSION >= 8
4166 static int ip_rbVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4167 Tcl_Obj *
CONST []));
4168 static int ip_rb_threadVwaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4169 Tcl_Obj *
CONST []));
4170 static int ip_rbTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4171 Tcl_Obj *
CONST []));
4172 static int ip_rb_threadTkWaitObjCmd
_((ClientData, Tcl_Interp *,
int,
4173 Tcl_Obj *
CONST []));
4175 static int ip_rbVwaitCommand
_((ClientData, Tcl_Interp *,
int,
char *[]));
4176 static int ip_rb_threadVwaitCommand
_((ClientData, Tcl_Interp *,
int,
4178 static int ip_rbTkWaitCommand
_((ClientData, Tcl_Interp *,
int,
char *[]));
4179 static int ip_rb_threadTkWaitCommand
_((ClientData, Tcl_Interp *,
int,
4183 #if TCL_MAJOR_VERSION >= 8
4184 static char *VwaitVarProc
_((ClientData, Tcl_Interp *,
4187 VwaitVarProc(clientData, interp, name1, name2, flags)
4188 ClientData clientData;
4194 static char *VwaitVarProc
_((ClientData, Tcl_Interp *,
char *,
char *,
int));
4196 VwaitVarProc(clientData, interp, name1, name2, flags)
4197 ClientData clientData;
4204 int *
donePtr = (
int *) clientData;
4210 #if TCL_MAJOR_VERSION >= 8
4212 ip_rbVwaitObjCmd(clientData, interp, objc, objv)
4213 ClientData clientData;
4216 Tcl_Obj *
CONST objv[];
4219 ip_rbVwaitCommand(clientData, interp, objc, objv)
4220 ClientData clientData;
4231 DUMP1(
"Ruby's 'vwait' is called");
4232 if (interp == (Tcl_Interp*)
NULL) {
4240 && eventloop_thread !=
Qnil
4242 #if TCL_MAJOR_VERSION >= 8
4243 DUMP1(
"call ip_rb_threadVwaitObjCmd");
4244 return ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv);
4246 DUMP1(
"call ip_rb_threadVwaitCommand");
4247 return ip_rb_threadVwaitCommand(clientData, interp, objc, objv);
4253 #ifdef HAVE_NATIVETHREAD
4254 #ifndef RUBY_USE_NATIVE_THREAD
4256 rb_bug(
"cross-thread violation on ip_rbVwaitCommand()");
4264 #ifdef Tcl_WrongNumArgs
4265 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4270 #if TCL_MAJOR_VERSION >= 8
4272 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4274 nameString = objv[0];
4277 nameString,
" name\"", (
char *)
NULL);
4289 #if TCL_MAJOR_VERSION >= 8
4292 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4294 nameString = objv[1];
4304 ret = Tcl_TraceVar(interp, nameString,
4305 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4306 VwaitVarProc, (ClientData) &done);
4311 #if TCL_MAJOR_VERSION >= 8
4326 Tcl_UntraceVar(interp, nameString,
4327 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4328 VwaitVarProc, (ClientData) &done);
4334 #if TCL_MAJOR_VERSION >= 8
4352 #if TCL_MAJOR_VERSION >= 8
4371 "\": would wait forever", (
char *)
NULL);
4375 #if TCL_MAJOR_VERSION >= 8
4382 #if TCL_MAJOR_VERSION >= 8
4393 #if TCL_MAJOR_VERSION >= 8
4394 static char *WaitVariableProc
_((ClientData, Tcl_Interp *,
4397 WaitVariableProc(clientData, interp, name1, name2, flags)
4398 ClientData clientData;
4404 static char *WaitVariableProc
_((ClientData, Tcl_Interp *,
4405 char *,
char *,
int));
4407 WaitVariableProc(clientData, interp, name1, name2, flags)
4408 ClientData clientData;
4415 int *donePtr = (
int *) clientData;
4418 return (
char *)
NULL;
4421 static void WaitVisibilityProc
_((ClientData, XEvent *));
4423 WaitVisibilityProc(clientData,
eventPtr)
4424 ClientData clientData;
4427 int *donePtr = (
int *) clientData;
4429 if (eventPtr->type == VisibilityNotify) {
4432 if (eventPtr->type == DestroyNotify) {
4437 static void WaitWindowProc
_((ClientData, XEvent *));
4439 WaitWindowProc(clientData, eventPtr)
4440 ClientData clientData;
4443 int *donePtr = (
int *) clientData;
4445 if (eventPtr->type == DestroyNotify) {
4450 #if TCL_MAJOR_VERSION >= 8
4452 ip_rbTkWaitObjCmd(clientData, interp, objc, objv)
4453 ClientData clientData;
4456 Tcl_Obj *
CONST objv[];
4459 ip_rbTkWaitCommand(clientData, interp, objc, objv)
4460 ClientData clientData;
4466 Tk_Window
tkwin = (Tk_Window) clientData;
4476 DUMP1(
"Ruby's 'tkwait' is called");
4477 if (interp == (Tcl_Interp*)
NULL) {
4485 && eventloop_thread !=
Qnil
4487 #if TCL_MAJOR_VERSION >= 8
4488 DUMP1(
"call ip_rb_threadTkWaitObjCmd");
4489 return ip_rb_threadTkWaitObjCmd((ClientData)tkwin, interp, objc, objv);
4491 DUMP1(
"call ip_rb_threadTkWaitCommand");
4492 return ip_rb_threadTkWwaitCommand((ClientData)tkwin, interp, objc, objv);
4501 #ifdef Tcl_WrongNumArgs
4502 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
4507 #if TCL_MAJOR_VERSION >= 8
4509 Tcl_GetStringFromObj(objv[0], &dummy),
4510 " variable|visibility|window name\"",
4514 objv[0],
" variable|visibility|window name\"",
4525 #if TCL_MAJOR_VERSION >= 8
4536 ret = Tcl_GetIndexFromObj(interp, objv[1],
4537 (
CONST84 char **)optionStrings,
4538 "option", 0, &index);
4551 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
4554 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
4557 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
4561 "\": must be variable, visibility, or window",
4572 #if TCL_MAJOR_VERSION >= 8
4575 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
4577 nameString = objv[2];
4593 ret = Tcl_TraceVar(interp, nameString,
4594 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4595 WaitVariableProc, (ClientData) &done);
4600 #if TCL_MAJOR_VERSION >= 8
4614 Tcl_UntraceVar(interp, nameString,
4615 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4616 WaitVariableProc, (ClientData) &done);
4618 #if TCL_MAJOR_VERSION >= 8
4656 window = Tk_NameToWindow(interp, nameString, tkwin);
4659 if (window == NULL) {
4661 "no main-window (not Tk application?)",
4664 #if TCL_MAJOR_VERSION >= 8
4671 Tk_CreateEventHandler(window,
4672 VisibilityChangeMask|StructureNotifyMask,
4673 WaitVisibilityProc, (ClientData) &done);
4683 #if TCL_MAJOR_VERSION >= 8
4701 #if TCL_MAJOR_VERSION >= 8
4719 "\" was deleted before its visibility changed",
4724 #if TCL_MAJOR_VERSION >= 8
4734 #if TCL_MAJOR_VERSION >= 8
4738 Tk_DeleteEventHandler(window,
4739 VisibilityChangeMask|StructureNotifyMask,
4740 WaitVisibilityProc, (ClientData) &done);
4754 window = Tk_NameToWindow(interp, nameString, tkwin);
4757 #if TCL_MAJOR_VERSION >= 8
4761 if (window == NULL) {
4763 "no main-window (not Tk application?)",
4770 Tk_CreateEventHandler(window, StructureNotifyMask,
4771 WaitWindowProc, (ClientData) &done);
4826 #if TCL_MAJOR_VERSION >= 8
4827 static char *rb_threadVwaitProc
_((ClientData, Tcl_Interp *,
4830 rb_threadVwaitProc(clientData, interp, name1, name2, flags)
4831 ClientData clientData;
4837 static char *rb_threadVwaitProc
_((ClientData, Tcl_Interp *,
4838 char *,
char *,
int));
4840 rb_threadVwaitProc(clientData, interp, name1, name2, flags)
4841 ClientData clientData;
4850 if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
4857 return (
char *)
NULL;
4860 #define TKWAIT_MODE_VISIBILITY 1
4861 #define TKWAIT_MODE_DESTROY 2
4863 static void rb_threadWaitVisibilityProc
_((ClientData, XEvent *));
4865 rb_threadWaitVisibilityProc(clientData, eventPtr)
4866 ClientData clientData;
4871 if (eventPtr->type == VisibilityNotify) {
4874 if (eventPtr->type == DestroyNotify) {
4880 static void rb_threadWaitWindowProc
_((ClientData, XEvent *));
4882 rb_threadWaitWindowProc(clientData, eventPtr)
4883 ClientData clientData;
4888 if (eventPtr->type == DestroyNotify) {
4894 #if TCL_MAJOR_VERSION >= 8
4896 ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv)
4897 ClientData clientData;
4900 Tcl_Obj *
CONST objv[];
4903 ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
4904 ClientData clientData;
4917 DUMP1(
"Ruby's 'thread_vwait' is called");
4918 if (interp == (Tcl_Interp*)
NULL) {
4925 #if TCL_MAJOR_VERSION >= 8
4926 DUMP1(
"call ip_rbVwaitObjCmd");
4927 return ip_rbVwaitObjCmd(clientData, interp, objc, objv);
4929 DUMP1(
"call ip_rbVwaitCommand");
4930 return ip_rbVwaitCommand(clientData, interp, objc, objv);
4938 #ifdef Tcl_WrongNumArgs
4939 Tcl_WrongNumArgs(interp, 1, objv,
"name");
4944 #if TCL_MAJOR_VERSION >= 8
4946 nameString = Tcl_GetStringFromObj(objv[0], &dummy);
4948 nameString = objv[0];
4951 nameString,
" name\"", (
char *)
NULL);
4960 #if TCL_MAJOR_VERSION >= 8
4963 nameString = Tcl_GetStringFromObj(objv[1], &dummy);
4965 nameString = objv[1];
4985 ret = Tcl_TraceVar(interp, nameString,
4986 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
4987 rb_threadVwaitProc, (ClientData) param);
4993 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5003 #if TCL_MAJOR_VERSION >= 8
5013 while(!param->
done) {
5017 if (
NIL_P(eventloop_thread)) {
5025 if (param->
done > 0) {
5026 Tcl_UntraceVar(interp, nameString,
5027 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5028 rb_threadVwaitProc, (ClientData) param);
5032 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5044 #if TCL_MAJOR_VERSION >= 8
5051 #if TCL_MAJOR_VERSION >= 8
5053 ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv)
5054 ClientData clientData;
5057 Tcl_Obj *
CONST objv[];
5060 ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
5061 ClientData clientData;
5068 Tk_Window tkwin = (Tk_Window) clientData;
5071 static CONST char *optionStrings[] = {
"variable",
"visibility",
"window",
5080 DUMP1(
"Ruby's 'thread_tkwait' is called");
5081 if (interp == (Tcl_Interp*)
NULL) {
5088 #if TCL_MAJOR_VERSION >= 8
5089 DUMP1(
"call ip_rbTkWaitObjCmd");
5090 DUMP2(
"eventloop_thread %lx", eventloop_thread);
5091 DUMP2(
"current_thread %lx", current_thread);
5092 return ip_rbTkWaitObjCmd(clientData, interp, objc, objv);
5094 DUMP1(
"call rb_VwaitCommand");
5095 return ip_rbTkWaitCommand(clientData, interp, objc, objv);
5105 #ifdef Tcl_WrongNumArgs
5106 Tcl_WrongNumArgs(interp, 1, objv,
"variable|visibility|window name");
5111 #if TCL_MAJOR_VERSION >= 8
5113 Tcl_GetStringFromObj(objv[0], &dummy),
5114 " variable|visibility|window name\"",
5118 objv[0],
" variable|visibility|window name\"",
5130 #if TCL_MAJOR_VERSION >= 8
5140 ret = Tcl_GetIndexFromObj(interp, objv[1],
5141 (
CONST84 char **)optionStrings,
5142 "option", 0, &index);
5154 size_t length =
strlen(objv[1]);
5156 if ((c ==
'v') && (strncmp(objv[1],
"variable", length) == 0)
5159 }
else if ((c ==
'v') && (strncmp(objv[1],
"visibility", length) == 0)
5162 }
else if ((c ==
'w') && (strncmp(objv[1],
"window", length) == 0)) {
5166 "\": must be variable, visibility, or window",
5178 #if TCL_MAJOR_VERSION >= 8
5181 nameString = Tcl_GetStringFromObj(objv[2], &dummy);
5183 nameString = objv[2];
5196 switch ((
enum options) index) {
5207 ret = Tcl_TraceVar(interp, nameString,
5208 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5209 rb_threadVwaitProc, (ClientData) param);
5215 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5225 #if TCL_MAJOR_VERSION >= 8
5237 while(!param->
done) {
5241 if (
NIL_P(eventloop_thread)) {
5249 if (param->
done > 0) {
5250 Tcl_UntraceVar(interp, nameString,
5251 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
5252 rb_threadVwaitProc, (ClientData) param);
5255 #if TCL_MAJOR_VERSION >= 8
5271 window = Tk_NameToWindow(interp, nameString, tkwin);
5280 window = Tk_NameToWindow(interp, nameString, tkwin);
5287 if (window == NULL) {
5289 "no main-window (not Tk application?)",
5295 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5305 #if TCL_MAJOR_VERSION >= 8
5314 Tk_CreateEventHandler(window,
5315 VisibilityChangeMask|StructureNotifyMask,
5316 rb_threadWaitVisibilityProc, (ClientData) param);
5328 if (
NIL_P(eventloop_thread)) {
5338 Tk_DeleteEventHandler(window,
5339 VisibilityChangeMask|StructureNotifyMask,
5340 rb_threadWaitVisibilityProc,
5341 (ClientData) param);
5344 if (param->
done != 1) {
5347 "\" was deleted before its visibility changed",
5355 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5365 #if TCL_MAJOR_VERSION >= 8
5376 #if TCL_MAJOR_VERSION >= 8
5392 window = Tk_NameToWindow(interp, nameString, tkwin);
5401 window = Tk_NameToWindow(interp, nameString, tkwin);
5408 #if TCL_MAJOR_VERSION >= 8
5412 if (window == NULL) {
5414 "no main-window (not Tk application?)",
5420 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5437 Tk_CreateEventHandler(window, StructureNotifyMask,
5438 rb_threadWaitWindowProc, (ClientData) param);
5449 if (
NIL_P(eventloop_thread)) {
5470 Tcl_EventuallyFree((ClientData)param, TCL_DYNAMIC);
5493 ip_thread_vwait(
self,
var)
5524 #if TCL_MAJOR_VERSION >= 8
5535 DUMP1(
"delete slaves");
5539 if (!Tcl_InterpDeleted(ip) &&
Tcl_Eval(ip,
"interp slaves") ==
TCL_OK) {
5540 slave_list = Tcl_GetObjResult(ip);
5543 if (Tcl_ListObjLength((Tcl_Interp*)NULL, slave_list, &len) ==
TCL_OK) {
5544 for(i = 0; i <
len; i++) {
5545 Tcl_ListObjIndex((Tcl_Interp*)NULL, slave_list, i, &elem);
5547 if (elem == (Tcl_Obj*)NULL)
continue;
5553 slave_name = Tcl_GetStringFromObj(elem, (
int*)NULL);
5554 DUMP2(
"delete slave:'%s'", slave_name);
5558 slave = Tcl_GetSlave(ip, slave_name);
5559 if (slave == (Tcl_Interp*)NULL)
continue;
5561 if (!Tcl_InterpDeleted(slave)) {
5565 Tcl_DeleteInterp(slave);
5589 DUMP1(
"delete slaves");
5594 slave_list = ip->result;
5595 if (Tcl_SplitList((Tcl_Interp*)NULL,
5596 slave_list, &argc, &argv) ==
TCL_OK) {
5597 for(i = 0; i <
argc; i++) {
5598 slave_name = argv[
i];
5600 DUMP2(
"delete slave:'%s'", slave_name);
5602 slave = Tcl_GetSlave(ip, slave_name);
5603 if (slave == (Tcl_Interp*)NULL)
continue;
5605 if (!Tcl_InterpDeleted(slave)) {
5609 Tcl_DeleteInterp(slave);
5622 #ifdef HAVE_PROTOTYPES
5623 lib_mark_at_exit(
VALUE self)
5625 lib_mark_at_exit(
self)
5633 #if TCL_MAJOR_VERSION >= 8
5634 #ifdef HAVE_PROTOTYPES
5635 ip_null_proc(ClientData clientData, Tcl_Interp *interp,
5636 int argc, Tcl_Obj *
CONST argv[])
5638 ip_null_proc(clientData, interp, argc, argv)
5639 ClientData clientData;
5642 Tcl_Obj *
CONST argv[];
5645 #ifdef HAVE_PROTOTYPES
5646 ip_null_proc(ClientData clientData, Tcl_Interp *interp,
int argc,
char *argv[])
5648 ip_null_proc(clientData, interp, argc, argv)
5649 ClientData clientData;
5675 DUMP1(
"start ip_finalize");
5677 if (ip == (Tcl_Interp*)NULL) {
5678 DUMP1(
"ip is NULL");
5682 if (Tcl_InterpDeleted(ip)) {
5683 DUMP2(
"ip(%p) is already deleted", ip);
5687 #if TCL_NAMESPACE_DEBUG
5688 if (ip_null_namespace(ip)) {
5689 DUMP2(
"ip(%p) has null namespace", ip);
5711 #if TCL_MAJOR_VERSION >= 8
5712 Tcl_CreateObjCommand(ip,
"ruby", ip_null_proc,
5713 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5714 Tcl_CreateObjCommand(ip,
"ruby_eval", ip_null_proc,
5715 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5716 Tcl_CreateObjCommand(ip,
"ruby_cmd", ip_null_proc,
5717 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5720 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5722 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5724 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5736 DUMP1(
"check `destroy'");
5738 DUMP1(
"call `destroy .'");
5743 DUMP1(
"destroy root widget");
5757 Tk_Window win = Tk_MainWindow(ip);
5759 DUMP1(
"call Tk_DestroyWindow");
5762 if (! (((Tk_FakeWin*)win)->flags & TK_ALREADY_DEAD)) {
5763 Tk_DestroyWindow(win);
5771 DUMP1(
"check `finalize-hook-proc'");
5773 DUMP2(
"call finalize hook proc '%s'", finalize_hook_name);
5781 DUMP1(
"check `foreach' & `after'");
5784 DUMP1(
"cancel after callbacks");
5787 Tcl_GlobalEval(ip,
"catch {foreach id [after info] {after cancel $id}}");
5794 DUMP1(
"finish ip_finalize");
5808 DUMP2(
"free Tcl Interp %lx", (
unsigned long)ptr->ip);
5813 if ( ptr->ip != (Tcl_Interp*)NULL
5814 && !Tcl_InterpDeleted(ptr->ip)
5815 && Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL
5816 && !Tcl_InterpDeleted(Tcl_GetMaster(ptr->ip)) ) {
5817 DUMP2(
"parent IP(%lx) is not deleted",
5818 (
unsigned long)Tcl_GetMaster(ptr->ip));
5819 DUMP2(
"slave IP(%lx) should not be deleted",
5820 (
unsigned long)ptr->ip);
5827 if (ptr->ip == (Tcl_Interp*)NULL) {
5828 DUMP1(
"ip_free is called for deleted IP");
5835 if (!Tcl_InterpDeleted(ptr->ip)) {
5838 Tcl_DeleteInterp(ptr->ip);
5842 ptr->ip = (Tcl_Interp*)NULL;
5849 DUMP1(
"complete freeing Tcl Interp");
5868 #if TCL_MAJOR_VERSION >= 8
5869 DUMP1(
"Tcl_CreateObjCommand(\"vwait\")");
5870 Tcl_CreateObjCommand(interp,
"vwait", ip_rbVwaitObjCmd,
5871 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5873 DUMP1(
"Tcl_CreateCommand(\"vwait\")");
5875 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5879 #if TCL_MAJOR_VERSION >= 8
5880 DUMP1(
"Tcl_CreateObjCommand(\"tkwait\")");
5881 Tcl_CreateObjCommand(interp,
"tkwait", ip_rbTkWaitObjCmd,
5882 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5884 DUMP1(
"Tcl_CreateCommand(\"tkwait\")");
5886 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5890 #if TCL_MAJOR_VERSION >= 8
5891 DUMP1(
"Tcl_CreateObjCommand(\"thread_vwait\")");
5892 Tcl_CreateObjCommand(interp,
"thread_vwait", ip_rb_threadVwaitObjCmd,
5893 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5895 DUMP1(
"Tcl_CreateCommand(\"thread_vwait\")");
5897 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
5901 #if TCL_MAJOR_VERSION >= 8
5902 DUMP1(
"Tcl_CreateObjCommand(\"thread_tkwait\")");
5903 Tcl_CreateObjCommand(interp,
"thread_tkwait", ip_rb_threadTkWaitObjCmd,
5904 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5906 DUMP1(
"Tcl_CreateCommand(\"thread_tkwait\")");
5908 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5912 #if TCL_MAJOR_VERSION >= 8
5913 DUMP1(
"Tcl_CreateObjCommand(\"update\")");
5914 Tcl_CreateObjCommand(interp,
"update", ip_rbUpdateObjCmd,
5915 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5917 DUMP1(
"Tcl_CreateCommand(\"update\")");
5919 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5923 #if TCL_MAJOR_VERSION >= 8
5924 DUMP1(
"Tcl_CreateObjCommand(\"thread_update\")");
5925 Tcl_CreateObjCommand(interp,
"thread_update", ip_rb_threadUpdateObjCmd,
5926 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5928 DUMP1(
"Tcl_CreateCommand(\"thread_update\")");
5930 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5935 #if TCL_MAJOR_VERSION >= 8
5937 ip_rb_replaceSlaveTkCmdsObjCmd(clientData, interp, objc, objv)
5938 ClientData clientData;
5941 Tcl_Obj *
CONST objv[];
5944 ip_rb_replaceSlaveTkCmdsCommand(clientData, interp, objc, objv)
5945 ClientData clientData;
5956 #ifdef Tcl_WrongNumArgs
5957 Tcl_WrongNumArgs(interp, 1, objv,
"slave_name");
5960 #if TCL_MAJOR_VERSION >= 8
5961 nameString = Tcl_GetStringFromObj(objv[0], (
int*)NULL);
5963 nameString = objv[0];
5966 nameString,
" slave_name\"", (
char *) NULL);
5970 #if TCL_MAJOR_VERSION >= 8
5971 slave_name = Tcl_GetStringFromObj(objv[1], (
int*)NULL);
5973 slave_name = objv[1];
5976 slave = Tcl_GetSlave(interp, slave_name);
5977 if (slave == NULL) {
5979 slave_name,
"\"", (
char *)NULL);
5982 mainWin = Tk_MainWindow(slave);
5985 #if TCL_MAJOR_VERSION >= 8
5986 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
5987 Tcl_CreateObjCommand(slave,
"exit", ip_InterpExitObjCmd,
5988 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
5990 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
5992 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6002 #if TCL_MAJOR_VERSION >= 8
6003 static int ip_rbNamespaceObjCmd
_((ClientData, Tcl_Interp *,
int,
6004 Tcl_Obj *
CONST []));
6006 ip_rbNamespaceObjCmd(clientData, interp, objc, objv)
6007 ClientData clientData;
6010 Tcl_Obj *
CONST objv[];
6015 DUMP1(
"call ip_rbNamespaceObjCmd");
6016 DUMP2(
"objc = %d", objc);
6017 DUMP2(
"objv[0] = '%s'", Tcl_GetString(objv[0]));
6018 DUMP2(
"objv[1] = '%s'", Tcl_GetString(objv[1]));
6020 DUMP1(
"fail to get __orig_namespace_command__");
6023 "invalid command name \"namespace\"", (
char*)NULL);
6030 if (info.isNativeObjectProc) {
6031 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6
6032 DUMP1(
"call a native-object-proc");
6038 char org_ns_cmd_name[] =
"__orig_namespace_command__";
6040 DUMP1(
"call a native-object-proc for tcl8.6 or later");
6043 cp_objv[0] = Tcl_NewStringObj(org_ns_cmd_name,
strlen(org_ns_cmd_name));
6044 for(i = 1; i <
objc; i++) {
6045 cp_objv[
i] = objv[
i];
6047 cp_objv[
objc] = (Tcl_Obj *)NULL;
6050 ret = Tcl_EvalObjv(interp, objc, cp_objv, 0);
6059 DUMP1(
"call with the string-interface");
6066 for(i = 0; i <
objc; i++) {
6068 argv[
i] = Tcl_GetStringFromObj(objv[i], (
int*)NULL);
6070 argv[
objc] = (
char *)NULL;
6072 ret = (*(info.proc))(info.clientData,
interp,
6076 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
6090 DUMP1(
"end of ip_rbNamespaceObjCmd");
6099 #if TCL_MAJOR_VERSION >= 8
6101 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6
6102 Tcl_CmdInfo orig_info;
6108 if (orig_info.isNativeObjectProc) {
6109 Tcl_CreateObjCommand(interp,
"__orig_namespace_command__",
6110 orig_info.objProc, orig_info.objClientData,
6111 orig_info.deleteProc);
6114 orig_info.proc, orig_info.clientData,
6115 orig_info.deleteProc);
6119 Tcl_GlobalEval(interp,
"rename namespace __orig_namespace_command__");
6123 Tcl_CreateObjCommand(interp,
"namespace", ip_rbNamespaceObjCmd,
6124 (ClientData) 0, (Tcl_CmdDeleteProc *)NULL);
6131 #ifdef HAVE_PROTOTYPES
6132 ip_CallWhenDeleted(ClientData clientData, Tcl_Interp *ip)
6134 ip_CallWhenDeleted(clientData, ip)
6135 ClientData clientData;
6142 DUMP1(
"start ip_CallWhenDeleted");
6148 DUMP1(
"finish ip_CallWhenDeleted");
6156 ip_init(argc, argv,
self)
6166 Tk_Window mainWin = (Tk_Window)NULL;
6171 "Cannot create a TclTkIp object at level %d",
6180 #ifdef RUBY_USE_NATIVE_THREAD
6181 ptr->tk_thread_id = 0;
6188 DUMP1(
"Tcl_CreateInterp");
6190 if (ptr->
ip == NULL) {
6211 #if TCL_MAJOR_VERSION >= 8
6212 #if TCL_NAMESPACE_DEBUG
6213 DUMP1(
"get current namespace");
6214 if ((ptr->default_ns = Tcl_GetCurrentNamespace(ptr->
ip))
6215 == (Tcl_Namespace*)NULL) {
6223 current_interp = ptr->
ip;
6228 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
6229 call_tclkit_init_script(current_interp);
6231 # if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 84
6233 Tcl_DString encodingName;
6234 Tcl_GetEncodingNameFromEnvironment(&encodingName);
6235 if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(NULL))) {
6237 Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName));
6239 Tcl_SetVar(current_interp,
"tclkit_system_encoding", Tcl_DStringValue(&encodingName), 0);
6240 Tcl_DStringFree(&encodingName);
6246 Tcl_Eval(ptr->
ip,
"set argc 0; set argv {}; set argv0 tcltklib.so");
6258 Tcl_Eval(ptr->
ip,
"set argc [llength $argv]");
6262 if (!
NIL_P(argv0)) {
6265 Tcl_SetVar(ptr->
ip,
"argv0",
"ruby", TCL_GLOBAL_ONLY);
6279 #if (defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT) && (!defined KIT_LITE) && (10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION == 85)
6286 Tcl_Eval(ptr->
ip,
"catch {rename ::chan ::_tmp_chan}");
6290 Tcl_Eval(ptr->
ip,
"catch {rename ::_tmp_chan ::chan}");
6317 DUMP1(
"Tcl_StaticPackage(\"Tk\")");
6318 #if TCL_MAJOR_VERSION >= 8
6319 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init, Tk_SafeInit);
6321 Tcl_StaticPackage(ptr->
ip,
"Tk", Tk_Init,
6322 (Tcl_PackageInitProc *) NULL);
6325 #ifdef RUBY_USE_NATIVE_THREAD
6327 ptr->tk_thread_id = Tcl_GetCurrentThread();
6330 mainWin = Tk_MainWindow(ptr->
ip);
6331 Tk_Preserve((ClientData)mainWin);
6335 #if TCL_MAJOR_VERSION >= 8
6336 DUMP1(
"Tcl_CreateObjCommand(\"ruby\")");
6337 Tcl_CreateObjCommand(ptr->
ip,
"ruby", ip_ruby_eval, (ClientData)NULL,
6338 (Tcl_CmdDeleteProc *)NULL);
6339 DUMP1(
"Tcl_CreateObjCommand(\"ruby_eval\")");
6340 Tcl_CreateObjCommand(ptr->
ip,
"ruby_eval", ip_ruby_eval, (ClientData)NULL,
6341 (Tcl_CmdDeleteProc *)NULL);
6342 DUMP1(
"Tcl_CreateObjCommand(\"ruby_cmd\")");
6343 Tcl_CreateObjCommand(ptr->
ip,
"ruby_cmd", ip_ruby_cmd, (ClientData)NULL,
6344 (Tcl_CmdDeleteProc *)NULL);
6346 DUMP1(
"Tcl_CreateCommand(\"ruby\")");
6348 (Tcl_CmdDeleteProc *)NULL);
6349 DUMP1(
"Tcl_CreateCommand(\"ruby_eval\")");
6351 (Tcl_CmdDeleteProc *)NULL);
6352 DUMP1(
"Tcl_CreateCommand(\"ruby_cmd\")");
6354 (Tcl_CmdDeleteProc *)NULL);
6358 #if TCL_MAJOR_VERSION >= 8
6359 DUMP1(
"Tcl_CreateObjCommand(\"interp_exit\")");
6360 Tcl_CreateObjCommand(ptr->
ip,
"interp_exit", ip_InterpExitObjCmd,
6361 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6362 DUMP1(
"Tcl_CreateObjCommand(\"ruby_exit\")");
6363 Tcl_CreateObjCommand(ptr->
ip,
"ruby_exit", ip_RubyExitObjCmd,
6364 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6365 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6366 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6367 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6369 DUMP1(
"Tcl_CreateCommand(\"interp_exit\")");
6371 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6372 DUMP1(
"Tcl_CreateCommand(\"ruby_exit\")");
6374 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6375 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6377 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6387 #if TCL_MAJOR_VERSION >= 8
6388 Tcl_CreateObjCommand(ptr->
ip,
"__replace_slave_tk_commands__",
6389 ip_rb_replaceSlaveTkCmdsObjCmd,
6390 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6393 ip_rb_replaceSlaveTkCmdsCommand,
6394 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6400 if (mainWin != (Tk_Window)NULL) {
6401 Tk_Release((ClientData)mainWin);
6408 ip_create_slave_core(interp, argc, argv)
6423 if (deleted_ip(master)) {
6425 "deleted master cannot create a new slave");
6431 if (Tcl_IsSafe(master->
ip) == 1) {
6444 if (
RTEST(with_tk)) {
6447 exc = tcltkip_init_tk(interp);
6457 #ifdef RUBY_USE_NATIVE_THREAD
6459 slave->tk_thread_id = master->tk_thread_id;
6469 "fail to create the new slave interpreter");
6471 #if TCL_MAJOR_VERSION >= 8
6472 #if TCL_NAMESPACE_DEBUG
6473 slave->default_ns = Tcl_GetCurrentNamespace(slave->
ip);
6483 #if TCL_MAJOR_VERSION >= 8
6484 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6485 Tcl_CreateObjCommand(slave->
ip,
"exit", ip_InterpExitObjCmd,
6486 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6488 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6490 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6500 #if TCL_MAJOR_VERSION >= 8
6501 Tcl_CreateObjCommand(slave->
ip,
"__replace_slave_tk_commands__",
6502 ip_rb_replaceSlaveTkCmdsObjCmd,
6503 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6506 ip_rb_replaceSlaveTkCmdsCommand,
6507 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
6519 ip_create_slave(argc, argv,
self)
6524 struct tcltkip *master = get_ip(
self);
6530 if (deleted_ip(master)) {
6532 "deleted master cannot create a new slave interpreter");
6539 if (Tcl_IsSafe(master->
ip) != 1
6547 return tk_funcall(ip_create_slave_core, 2, callargv,
self);
6553 ip_is_slave_of_p(
self, master)
6560 if (Tcl_GetMaster(get_ip(
self)->ip) == get_ip(master)->ip) {
6569 #if defined(MAC_TCL) || defined(__WIN32__)
6570 #if TCL_MAJOR_VERSION < 8 \
6571 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) \
6572 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6573 && (TCL_RELEASE_LEVEL == TCL_ALPHA_RELEASE \
6574 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \
6575 && TCL_RELEASE_SERIAL < 2) ) )
6576 EXTERN void TkConsoleCreate
_((
void));
6578 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6579 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \
6580 && TCL_RELEASE_SERIAL == 0) \
6581 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE \
6582 && TCL_RELEASE_SERIAL >= 2) )
6583 EXTERN void TkConsoleCreate_
_((
void));
6587 ip_create_console_core(interp, argc, argv)
6592 struct tcltkip *ptr = get_ip(interp);
6595 tcltkip_init_tk(interp);
6598 if (Tcl_GetVar(ptr->
ip,
"tcl_interactive",TCL_GLOBAL_ONLY) == (
char*)NULL) {
6599 Tcl_SetVar(ptr->
ip,
"tcl_interactive",
"0", TCL_GLOBAL_ONLY);
6602 #if TCL_MAJOR_VERSION > 8 \
6603 || (TCL_MAJOR_VERSION == 8 \
6604 && (TCL_MINOR_VERSION > 1 \
6605 || (TCL_MINOR_VERSION == 1 \
6606 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE \
6607 && TCL_RELEASE_SERIAL >= 1) ) )
6608 Tk_InitConsoleChannels(ptr->
ip);
6610 if (Tk_CreateConsoleWindow(ptr->
ip) !=
TCL_OK) {
6614 #if defined(MAC_TCL) || defined(__WIN32__)
6615 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 \
6616 && ( (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE && TCL_RELEASE_SERIAL == 0) \
6617 || (TCL_RELEASE_LEVEL == TCL_BETA_RELEASE && TCL_RELEASE_SERIAL >= 2) )
6623 if (TkConsoleInit(ptr->
ip) !=
TCL_OK) {
6635 ip_create_console(
self)
6638 struct tcltkip *ptr = get_ip(
self);
6641 if (deleted_ip(ptr)) {
6650 ip_make_safe_core(interp, argc, argv)
6655 struct tcltkip *ptr = get_ip(interp);
6659 if (deleted_ip(ptr)) {
6674 #if TCL_MAJOR_VERSION >= 8
6675 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6676 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6677 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6679 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6681 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6691 struct tcltkip *ptr = get_ip(
self);
6694 if (deleted_ip(ptr)) {
6706 struct tcltkip *ptr = get_ip(
self);
6709 if (deleted_ip(ptr)) {
6713 if (Tcl_IsSafe(ptr->
ip)) {
6722 ip_allow_ruby_exit_p(
self)
6725 struct tcltkip *ptr = get_ip(
self);
6728 if (deleted_ip(ptr)) {
6741 ip_allow_ruby_exit_set(
self, val)
6744 struct tcltkip *ptr = get_ip(
self);
6749 if (deleted_ip(ptr)) {
6753 if (Tcl_IsSafe(ptr->
ip)) {
6755 "insecure operation on a safe interpreter");
6768 #if TCL_MAJOR_VERSION >= 8
6769 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"ruby_exit\"");
6770 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_RubyExitObjCmd,
6771 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6773 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"ruby_exit\"");
6775 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6781 #if TCL_MAJOR_VERSION >= 8
6782 DUMP1(
"Tcl_CreateObjCommand(\"exit\") --> \"interp_exit\"");
6783 Tcl_CreateObjCommand(ptr->
ip,
"exit", ip_InterpExitObjCmd,
6784 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6786 DUMP1(
"Tcl_CreateCommand(\"exit\") --> \"interp_exit\"");
6788 (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
6800 struct tcltkip *ptr = get_ip(
self);
6803 if (deleted_ip(ptr)) {
6804 DUMP1(
"delete deleted IP");
6811 DUMP1(
"delete interp");
6812 if (!Tcl_InterpDeleted(ptr->
ip)) {
6813 DUMP1(
"call ip_finalize");
6816 Tcl_DeleteInterp(ptr->
ip);
6828 ip_has_invalid_namespace_p(
self)
6831 struct tcltkip *ptr = get_ip(
self);
6833 if (ptr == (
struct tcltkip *)NULL || ptr->
ip == (Tcl_Interp *)NULL) {
6838 #if TCL_NAMESPACE_DEBUG
6839 if (rbtk_invalid_namespace(ptr)) {
6850 ip_is_deleted_p(
self)
6853 struct tcltkip *ptr = get_ip(
self);
6855 if (deleted_ip(ptr)) {
6863 ip_has_mainwindow_p_core(
self, argc, argv)
6868 struct tcltkip *ptr = get_ip(
self);
6872 }
else if (Tk_MainWindow(ptr->
ip) == (Tk_Window)NULL) {
6880 ip_has_mainwindow_p(
self)
6888 #if TCL_MAJOR_VERSION >= 8
6890 get_str_from_obj(
obj)
6893 int len, binary = 0;
6897 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
6898 s = Tcl_GetStringFromObj(obj, &len);
6900 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 3
6902 if (Tcl_GetCharLength(obj) != Tcl_UniCharLen(Tcl_GetUnicode(obj))) {
6904 s = (
char *)Tcl_GetByteArrayFromObj(obj, &len);
6908 s = Tcl_GetStringFromObj(obj, &len);
6911 if (IS_TCL_BYTEARRAY(obj)) {
6912 s = (
char *)Tcl_GetByteArrayFromObj(obj, &len);
6915 s = Tcl_GetStringFromObj(obj, &len);
6922 #ifdef HAVE_RUBY_ENCODING_H
6925 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
6926 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
6928 #ifdef HAVE_RUBY_ENCODING_H
6938 get_obj_from_str(str)
6943 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
6944 return Tcl_NewStringObj((
char*)s,
RSTRING_LEN(str));
6952 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6957 #ifdef HAVE_RUBY_ENCODING_H
6960 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6964 return Tcl_NewByteArrayObj((
const unsigned char *)s,
RSTRING_LENINT(str));
6977 #if TCL_MAJOR_VERSION >= 8
6981 retObj = Tcl_GetObjResult(interp);
6983 strval = get_str_from_obj(retObj);
6995 callq_safelevel_handler(arg,
callq)
7007 static int call_queue_handler
_((Tcl_Event *,
int));
7009 call_queue_handler(
evPtr, flags)
7019 DUMP2(
"do_call_queue_handler : evPtr = %p", evPtr);
7021 DUMP2(
"added by thread : %lx", thread);
7024 DUMP1(
"processed by another event-loop");
7027 DUMP1(
"process it on current event-loop");
7032 DUMP1(
"caller is not yet ready to receive the result -> pending");
7041 if (deleted_ip(ptr)) {
7056 q_dat = (
VALUE)NULL;
7058 DUMP2(
"call function (for caller thread:%lx)", thread);
7081 DUMP2(
"back to caller (caller thread:%lx)", thread);
7083 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
7084 have_rb_thread_waiting_for_value = 1;
7089 DUMP1(
"finish back to caller");
7090 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
7094 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7121 ptr = get_ip(ip_obj);
7122 if (deleted_ip(ptr))
return Qnil;
7127 #ifdef RUBY_USE_NATIVE_THREAD
7130 is_tk_evloop_thread = (ptr->tk_thread_id == (Tcl_ThreadId) 0
7131 || ptr->tk_thread_id == Tcl_GetCurrentThread());
7134 is_tk_evloop_thread = (tk_eventloop_thread_id == (Tcl_ThreadId) 0
7135 || tk_eventloop_thread_id == Tcl_GetCurrentThread());
7138 is_tk_evloop_thread = 1;
7141 if (is_tk_evloop_thread
7144 if (
NIL_P(eventloop_thread)) {
7145 DUMP2(
"tk_funcall from thread:%lx but no eventloop", current);
7147 DUMP2(
"tk_funcall from current eventloop %lx", current);
7149 result = (
func)(ip_obj, argc, argv);
7156 DUMP2(
"tk_funcall from thread %lx (NOT current eventloop)", current);
7199 callq->
ev.proc = call_queue_handler;
7202 DUMP1(
"add handler");
7203 #ifdef RUBY_USE_NATIVE_THREAD
7204 if (ptr && ptr->tk_thread_id) {
7207 Tcl_ThreadQueueEvent(ptr->tk_thread_id,
7208 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7209 Tcl_ThreadAlert(ptr->tk_thread_id);
7210 }
else if (tk_eventloop_thread_id) {
7213 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
7214 (Tcl_Event*)callq, TCL_QUEUE_HEAD);
7215 Tcl_ThreadAlert(tk_eventloop_thread_id);
7231 DUMP2(
"callq wait for handler (current thread:%lx)", current);
7232 while(*alloc_done >= 0) {
7233 DUMP2(
"*** callq wait for handler (current thread:%lx)", current);
7237 DUMP2(
"*** callq wakeup (current thread:%lx)", current);
7238 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
7240 DUMP1(
"*** callq lost eventloop thread");
7244 DUMP2(
"back from handler (current thread:%lx)", current);
7249 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7255 ckfree((
char*)alloc_done);
7262 for(i = 0; i <
argc; i++) { argv[
i] = (
VALUE)NULL; }
7265 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
7285 DUMP1(
"raise exception");
7291 DUMP1(
"exit tk_funcall");
7297 #if TCL_MAJOR_VERSION >= 8
7298 struct call_eval_info {
7304 #ifdef HAVE_PROTOTYPES
7305 call_tcl_eval(
VALUE arg)
7311 struct call_eval_info *
inf = (
struct call_eval_info *)arg;
7314 inf->ptr->return_value = Tcl_EvalObj(inf->ptr->ip, inf->cmd);
7327 struct tcltkip *ptr = get_ip(
self);
7330 #if TCL_MAJOR_VERSION >= 8
7338 cmd = Tcl_NewStringObj(cmd_str, cmd_len);
7342 if (deleted_ip(ptr)) {
7349 struct call_eval_info inf;
7365 "unknown exception");
7385 if (pending_exception_check1(thr_crit_bup, ptr)) {
7392 if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->
ip)) {
7397 exc = create_ip_exc(
self, eTkCallbackReturn,
7398 "ip_eval_real receives TCL_RETURN");
7400 exc = create_ip_exc(
self, eTkCallbackBreak,
7401 "ip_eval_real receives TCL_BREAK");
7403 exc = create_ip_exc(
self, eTkCallbackContinue,
7404 "ip_eval_real receives TCL_CONTINUE");
7414 if (event_loop_abort_on_exc < 0) {
7433 DUMP2(
"Tcl_Eval(%s)", cmd_str);
7436 if (deleted_ip(ptr)) {
7446 if (pending_exception_check1(thr_crit_bup, ptr)) {
7457 exc = create_ip_exc(
self, eTkCallbackReturn,
7458 "ip_eval_real receives TCL_RETURN");
7460 exc = create_ip_exc(
self, eTkCallbackBreak,
7461 "ip_eval_real receives TCL_BREAK");
7463 exc = create_ip_exc(
self, eTkCallbackContinue,
7464 "ip_eval_real receives TCL_CONTINUE");
7482 evq_safelevel_handler(arg,
evq)
7494 int eval_queue_handler
_((Tcl_Event *,
int));
7496 eval_queue_handler(evPtr, flags)
7506 DUMP2(
"do_eval_queue_handler : evPtr = %p", evPtr);
7508 DUMP2(
"added by thread : %lx", thread);
7511 DUMP1(
"processed by another event-loop");
7514 DUMP1(
"process it on current event-loop");
7519 DUMP1(
"caller is not yet ready to receive the result -> pending");
7528 if (deleted_ip(ptr)) {
7538 #ifdef HAVE_NATIVETHREAD
7539 #ifndef RUBY_USE_NATIVE_THREAD
7541 rb_bug(
"cross-thread violation on eval_queue_handler()");
7550 q_dat = (
VALUE)NULL;
7572 DUMP2(
"back to caller (caller thread:%lx)", thread);
7574 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
7575 have_rb_thread_waiting_for_value = 1;
7580 DUMP1(
"finish back to caller");
7581 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
7585 DUMP2(
"caller is dead (caller thread:%lx)", thread);
7599 #ifdef RUBY_USE_NATIVE_THREAD
7606 volatile VALUE ip_obj =
self;
7617 #ifdef RUBY_USE_NATIVE_THREAD
7618 ptr = get_ip(ip_obj);
7619 DUMP2(
"eval status: ptr->tk_thread_id %p", ptr->tk_thread_id);
7620 DUMP2(
"eval status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7622 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
7624 DUMP2(
"status: eventloopt_thread %lx", eventloop_thread);
7627 #ifdef RUBY_USE_NATIVE_THREAD
7628 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
7631 (
NIL_P(eventloop_thread) || current == eventloop_thread)
7633 if (
NIL_P(eventloop_thread)) {
7634 DUMP2(
"eval from thread:%lx but no eventloop", current);
7636 DUMP2(
"eval from current eventloop %lx", current);
7645 DUMP2(
"eval from thread %lx (NOT current eventloop)", current);
7684 evq->
ev.proc = eval_queue_handler;
7686 position = TCL_QUEUE_TAIL;
7689 DUMP1(
"add handler");
7690 #ifdef RUBY_USE_NATIVE_THREAD
7691 if (ptr->tk_thread_id) {
7693 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)evq, position);
7694 Tcl_ThreadAlert(ptr->tk_thread_id);
7695 }
else if (tk_eventloop_thread_id) {
7696 Tcl_ThreadQueueEvent(tk_eventloop_thread_id, (Tcl_Event*)evq, position);
7699 Tcl_ThreadAlert(tk_eventloop_thread_id);
7715 DUMP2(
"evq wait for handler (current thread:%lx)", current);
7716 while(*alloc_done >= 0) {
7717 DUMP2(
"*** evq wait for handler (current thread:%lx)", current);
7721 DUMP2(
"*** evq wakeup (current thread:%lx)", current);
7722 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
7723 if (
NIL_P(eventloop_thread)) {
7724 DUMP1(
"*** evq lost eventloop thread");
7728 DUMP2(
"back from handler (current thread:%lx)", current);
7734 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
7740 ckfree((
char*)alloc_done);
7744 Tcl_EventuallyFree((ClientData)eval_str, TCL_DYNAMIC);
7762 DUMP1(
"raise exception");
7773 ip_cancel_eval_core(interp, msg, flag)
7778 #if TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6)
7780 "cancel_eval is supported Tcl/Tk8.6 or later.");
7793 return Tcl_CancelEval(interp, msg_obj, 0, flag);
7798 ip_cancel_eval(argc, argv,
self)
7808 if (ip_cancel_eval_core(get_ip(
self)->ip, retval, 0) ==
TCL_OK) {
7815 #ifndef TCL_CANCEL_UNWIND
7816 #define TCL_CANCEL_UNWIND 0x100000
7819 ip_cancel_eval_unwind(argc, argv,
self)
7832 if (ip_cancel_eval_core(get_ip(
self)->ip, retval, flag) ==
TCL_OK) {
7841 lib_restart_core(interp, argc, argv)
7847 struct tcltkip *ptr = get_ip(interp);
7854 if (deleted_ip(ptr)) {
7870 #if TCL_MAJOR_VERSION >= 8
7885 exc = tcltkip_init_tk(interp);
7905 struct tcltkip *ptr = get_ip(
self);
7911 if (deleted_ip(ptr)) {
7923 struct tcltkip *ptr = get_ip(
self);
7929 if (deleted_ip(ptr)) {
7933 if (Tcl_GetMaster(ptr->
ip) != (Tcl_Interp*)NULL) {
7952 Tcl_Encoding encoding;
7967 if (
NIL_P(ip_obj)) {
7969 interp = (Tcl_Interp *)NULL;
7972 ptr = get_ip(ip_obj);
7975 if (deleted_ip(ptr)) {
7977 interp = (Tcl_Interp *)NULL;
7987 if (
NIL_P(encodename)) {
7991 #ifdef HAVE_RUBY_ENCODING_H
7997 if (
NIL_P(ip_obj)) {
7998 encoding = (Tcl_Encoding)NULL;
8002 encoding = (Tcl_Encoding)NULL;
8008 encoding = (Tcl_Encoding)NULL;
8010 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8012 if (encoding == (Tcl_Encoding)NULL) {
8021 #ifdef HAVE_RUBY_ENCODING_H
8024 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8029 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8031 if (encoding == (Tcl_Encoding)NULL) {
8036 encoding = (Tcl_Encoding)NULL;
8040 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8041 #ifdef HAVE_RUBY_ENCODING_H
8044 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8049 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(encodename));
8050 if (encoding == (Tcl_Encoding)NULL) {
8070 Tcl_DStringInit(&dstr);
8071 Tcl_DStringFree(&dstr);
8073 Tcl_ExternalToUtfDString(encoding, buf,
RSTRING_LENINT(str), &dstr);
8077 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8078 #ifdef HAVE_RUBY_ENCODING_H
8089 Tcl_DStringFree(&dstr);
8101 lib_toUTF8(argc, argv,
self)
8115 ip_toUTF8(argc, argv,
self)
8122 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8138 Tcl_Encoding encoding;
8152 if (
NIL_P(ip_obj)) {
8153 interp = (Tcl_Interp *)NULL;
8154 }
else if (get_ip(ip_obj) == (
struct tcltkip *)NULL) {
8155 interp = (Tcl_Interp *)NULL;
8157 interp = get_ip(ip_obj)->ip;
8163 if (
NIL_P(encodename)) {
8171 #ifdef HAVE_RUBY_ENCODING_H
8174 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8178 #ifdef HAVE_RUBY_ENCODING_H
8181 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8188 if (
NIL_P(ip_obj)) {
8189 encoding = (Tcl_Encoding)NULL;
8193 encoding = (Tcl_Encoding)NULL;
8199 encoding = (Tcl_Encoding)NULL;
8201 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
8203 if (encoding == (Tcl_Encoding)NULL) {
8215 if (strcmp(
RSTRING_PTR(encodename),
"binary") == 0) {
8223 s = (
char*)Tcl_GetByteArrayFromObj(tclstr, &len);
8227 #ifdef HAVE_RUBY_ENCODING_H
8230 rb_ivar_set(str, ID_at_enc, ENCODING_NAME_BINARY);
8237 encoding = Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(encodename));
8238 if (encoding == (Tcl_Encoding)NULL) {
8261 Tcl_DStringInit(&dstr);
8262 Tcl_DStringFree(&dstr);
8264 Tcl_UtfToExternalDString(encoding,buf,
RSTRING_LENINT(str),&dstr);
8268 str =
rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
8269 #ifdef HAVE_RUBY_ENCODING_H
8273 VALUE tbl = ip_get_encoding_table(ip_obj);
8274 VALUE encobj = encoding_table_get_obj(tbl, encodename);
8291 Tcl_DStringFree(&dstr);
8303 lib_fromUTF8(argc, argv,
self)
8310 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8317 ip_fromUTF8(argc, argv,
self)
8324 if (
rb_scan_args(argc, argv,
"11", &str, &encodename) == 1) {
8331 lib_UTF_backslash_core(
self, str,
all_bs)
8337 char *src_buf, *dst_buf, *
ptr;
8338 int read_len = 0, dst_len = 0;
8368 if (*ptr ==
'\\' && (all_bs || *(ptr + 1) ==
'u')) {
8369 dst_len += Tcl_UtfBackslash(ptr, &read_len, (dst_buf + dst_len));
8372 *(dst_buf + (dst_len++)) = *(ptr++);
8378 #ifdef HAVE_RUBY_ENCODING_H
8384 Tcl_EventuallyFree((ClientData)src_buf, TCL_DYNAMIC);
8394 Tcl_EventuallyFree((ClientData)dst_buf, TCL_DYNAMIC);
8411 lib_UTF_backslash(
self, str)
8415 return lib_UTF_backslash_core(
self, str, 0);
8419 lib_Tcl_backslash(
self, str)
8423 return lib_UTF_backslash_core(
self, str, 1);
8427 lib_get_system_encoding(
self)
8430 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
8432 return rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL));
8439 lib_set_system_encoding(
self,
enc_name)
8443 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
8446 if (
NIL_P(enc_name)) {
8447 Tcl_SetSystemEncoding((Tcl_Interp *)NULL, (
CONST char *)NULL);
8448 return lib_get_system_encoding(
self);
8451 enc_name =
rb_funcall(enc_name, ID_to_s, 0, 0);
8452 if (Tcl_SetSystemEncoding((Tcl_Interp *)NULL,
8469 #if TCL_MAJOR_VERSION >= 8
8479 #ifdef HAVE_PROTOTYPES
8480 invoke_tcl_proc(
VALUE arg)
8482 invoke_tcl_proc(arg)
8488 #if TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION < 6
8490 int argc = inf->objc;
8491 char **argv = (
char **)NULL;
8494 DUMP1(
"call invoke_tcl_proc");
8496 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 6)
8505 #if TCL_MAJOR_VERSION == 8
8507 if (!inf->
cmdinfo.isNativeObjectProc) {
8508 DUMP1(
"called proc is not a native-obj-proc");
8515 for (i = 0; i <
argc; ++
i) {
8516 argv[
i] = Tcl_GetStringFromObj(inf->objv[i], &len);
8518 argv[
argc] = (
char *)NULL;
8522 DUMP1(
"reset result of tcl-interp");
8526 #if TCL_MAJOR_VERSION == 8
8528 if (inf->
cmdinfo.isNativeObjectProc) {
8529 DUMP1(
"call tcl_proc as a native-obj-proc");
8532 inf->
ptr->
ip, inf->objc, inf->objv);
8537 #if TCL_MAJOR_VERSION == 8
8539 DUMP1(
"call tcl_proc as not a native-obj-proc");
8545 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8564 DUMP1(
"end of invoke_tcl_proc");
8569 #if TCL_MAJOR_VERSION >= 8
8594 #if TCL_MAJOR_VERSION >= 8
8596 char **argv = (
char **)NULL;
8602 ptr = get_ip(interp);
8605 #if TCL_MAJOR_VERSION >= 8
8606 cmd = Tcl_GetStringFromObj(objv[0], &len);
8612 ptr = get_ip(interp);
8615 if (deleted_ip(ptr)) {
8623 DUMP2(
"call Tcl_GetCommandInfo, %s", cmd);
8625 DUMP1(
"error Tcl_GetCommandInfo");
8626 DUMP1(
"try auto_load (call 'unknown' command)");
8628 #
if TCL_MAJOR_VERSION >= 8
8634 DUMP1(
"fail to get 'unknown' command");
8636 if (event_loop_abort_on_exc > 0) {
8641 "invalid command name `%s'", cmd);
8643 if (event_loop_abort_on_exc < 0) {
8644 rb_warning(
"invalid command name `%s' (ignore)", cmd);
8646 rb_warn(
"invalid command name `%s' (ignore)", cmd);
8654 #if TCL_MAJOR_VERSION >= 8
8655 Tcl_Obj **unknown_objv;
8657 char **unknown_argv;
8659 DUMP1(
"find 'unknown' command -> set arguemnts");
8662 #if TCL_MAJOR_VERSION >= 8
8668 unknown_objv[0] = Tcl_NewStringObj(
"::unknown", 9);
8670 memcpy(unknown_objv + 1, objv,
sizeof(Tcl_Obj *)*objc);
8671 unknown_objv[++
objc] = (Tcl_Obj*)NULL;
8672 objv = unknown_objv;
8679 unknown_argv[0] =
strdup(
"unknown");
8680 memcpy(unknown_argv + 1, argv,
sizeof(
char *)*argc);
8681 unknown_argv[++
argc] = (
char *)NULL;
8682 argv = unknown_argv;
8686 DUMP1(
"end Tcl_GetCommandInfo");
8695 #if TCL_MAJOR_VERSION >= 8
8704 DUMP1(
"invoke tcl-proc");
8706 DUMP2(
"status of tcl-proc, %d", status);
8711 "unknown exception");
8728 #if TCL_MAJOR_VERSION >= 8
8729 if (!info.isNativeObjectProc) {
8738 for (i = 0; i <
argc; ++
i) {
8739 argv[
i] = Tcl_GetStringFromObj(objv[i], &len);
8741 argv[
argc] = (
char *)NULL;
8748 #if TCL_MAJOR_VERSION >= 8
8749 if (info.isNativeObjectProc) {
8754 resultPtr = Tcl_GetObjResult(ptr->
ip);
8755 Tcl_SetResult(ptr->
ip, Tcl_GetStringFromObj(resultPtr, &len),
8762 #if TCL_MAJOR_VERSION >= 8
8767 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8786 #if TCL_MAJOR_VERSION >= 8
8789 Tcl_EventuallyFree((ClientData)objv, TCL_DYNAMIC);
8802 Tcl_EventuallyFree((ClientData)argv, TCL_DYNAMIC);
8815 if (pending_exception_check1(thr_crit_bup, ptr)) {
8823 if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->
ip)) {
8826 return create_ip_exc(interp, eTkCallbackReturn,
8827 "ip_invoke_core receives TCL_RETURN");
8829 return create_ip_exc(interp, eTkCallbackBreak,
8830 "ip_invoke_core receives TCL_BREAK");
8832 return create_ip_exc(interp, eTkCallbackContinue,
8833 "ip_invoke_core receives TCL_CONTINUE");
8840 if (event_loop_abort_on_exc < 0) {
8855 #if TCL_MAJOR_VERSION >= 8
8860 alloc_invoke_arguments(argc, argv)
8867 #if TCL_MAJOR_VERSION >= 8
8877 #if TCL_MAJOR_VERSION >= 8
8883 for (i = 0; i <
argc; ++
i) {
8884 av[
i] = get_obj_from_str(argv[i]);
8896 for (i = 0; i <
argc; ++
i) {
8910 #if TCL_MAJOR_VERSION >= 8
8918 for (i = 0; i <
argc; ++
i) {
8919 #if TCL_MAJOR_VERSION >= 8
8921 av[
i] = (Tcl_Obj*)NULL;
8924 av[
i] = (
char*)NULL;
8927 #if TCL_MAJOR_VERSION >= 8
8929 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8939 Tcl_EventuallyFree((ClientData)av, TCL_DYNAMIC);
8952 ip_invoke_real(argc, argv, interp)
8960 #if TCL_MAJOR_VERSION >= 8
8961 Tcl_Obj **av = (Tcl_Obj **)NULL;
8963 char **av = (
char **)NULL;
8969 ptr = get_ip(interp);
8972 if (deleted_ip(ptr)) {
8977 av = alloc_invoke_arguments(argc, argv);
8990 ivq_safelevel_handler(arg,
ivq)
9002 int invoke_queue_handler
_((Tcl_Event *,
int));
9004 invoke_queue_handler(evPtr, flags)
9014 DUMP2(
"do_invoke_queue_handler : evPtr = %p", evPtr);
9016 DUMP2(
"added by thread : %lx", thread);
9019 DUMP1(
"processed by another event-loop");
9022 DUMP1(
"process it on current event-loop");
9027 DUMP1(
"caller is not yet ready to receive the result -> pending");
9036 if (deleted_ip(ptr)) {
9051 q_dat = (
VALUE)NULL;
9053 DUMP2(
"call invoke_real (for caller thread:%lx)", thread);
9075 DUMP2(
"back to caller (caller thread:%lx)", thread);
9077 #if CONTROL_BY_STATUS_OF_RB_THREAD_WAITING_FOR_VALUE
9078 have_rb_thread_waiting_for_value = 1;
9083 DUMP1(
"finish back to caller");
9084 #if DO_THREAD_SCHEDULE_AT_CALLBACK_DONE
9088 DUMP2(
"caller is dead (caller thread:%lx)", thread);
9101 Tcl_QueuePosition position;
9104 #ifdef RUBY_USE_NATIVE_THREAD
9115 #if TCL_MAJOR_VERSION >= 8
9116 Tcl_Obj **av = (Tcl_Obj **)NULL;
9118 char **av = (
char **)NULL;
9125 #ifdef RUBY_USE_NATIVE_THREAD
9126 ptr = get_ip(ip_obj);
9127 DUMP2(
"invoke status: ptr->tk_thread_id %p", ptr->tk_thread_id);
9128 DUMP2(
"invoke status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9130 DUMP2(
"status: Tcl_GetCurrentThread %p", Tcl_GetCurrentThread());
9132 DUMP2(
"status: eventloopt_thread %lx", eventloop_thread);
9135 #ifdef RUBY_USE_NATIVE_THREAD
9136 (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread())
9139 (
NIL_P(eventloop_thread) || current == eventloop_thread)
9141 if (
NIL_P(eventloop_thread)) {
9142 DUMP2(
"invoke from thread:%lx but no eventloop", current);
9144 DUMP2(
"invoke from current eventloop %lx", current);
9146 result = ip_invoke_real(argc, argv, ip_obj);
9153 DUMP2(
"invoke from thread %lx (NOT current eventloop)", current);
9159 av = alloc_invoke_arguments(argc, argv);
9187 ivq->
ev.proc = invoke_queue_handler;
9190 DUMP1(
"add handler");
9191 #ifdef RUBY_USE_NATIVE_THREAD
9192 if (ptr->tk_thread_id) {
9194 Tcl_ThreadQueueEvent(ptr->tk_thread_id, (Tcl_Event*)ivq, position);
9195 Tcl_ThreadAlert(ptr->tk_thread_id);
9196 }
else if (tk_eventloop_thread_id) {
9199 Tcl_ThreadQueueEvent(tk_eventloop_thread_id,
9200 (Tcl_Event*)ivq, position);
9201 Tcl_ThreadAlert(tk_eventloop_thread_id);
9217 DUMP2(
"ivq wait for handler (current thread:%lx)", current);
9218 while(*alloc_done >= 0) {
9222 DUMP2(
"*** ivq wakeup (current thread:%lx)", current);
9223 DUMP2(
"*** (eventloop thread:%lx)", eventloop_thread);
9224 if (
NIL_P(eventloop_thread)) {
9225 DUMP1(
"*** ivq lost eventloop thread");
9229 DUMP2(
"back from handler (current thread:%lx)", current);
9234 Tcl_EventuallyFree((ClientData)alloc_done, TCL_DYNAMIC);
9240 ckfree((
char*)alloc_done);
9246 Tcl_EventuallyFree((ClientData)ivq, TCL_DYNAMIC);
9261 DUMP1(
"raise exception");
9267 DUMP1(
"exit ip_invoke");
9283 if (deleted_ip(ptr)) {
9291 ip_invoke(argc, argv, obj)
9300 ip_invoke_immediate(argc, argv, obj)
9312 ip_get_variable2_core(interp, argc, argv)
9317 struct tcltkip *ptr = get_ip(interp);
9330 #if TCL_MAJOR_VERSION >= 8
9339 if (deleted_ip(ptr)) {
9350 if (ret == (Tcl_Obj*)NULL) {
9363 strval = get_str_from_obj(ret);
9378 if (deleted_ip(ptr)) {
9388 if (ret == (
char*)NULL) {
9408 ip_get_variable2(
self, varname, index, flag)
9424 retval =
tk_funcall(ip_get_variable2_core, 3, argv,
self);
9434 ip_get_variable(
self, varname, flag)
9439 return ip_get_variable2(
self, varname,
Qnil, flag);
9443 ip_set_variable2_core(interp, argc, argv)
9448 struct tcltkip *ptr = get_ip(interp);
9463 #if TCL_MAJOR_VERSION >= 8
9465 Tcl_Obj *valobj, *
ret;
9471 valobj = get_obj_from_str(value);
9475 if (deleted_ip(ptr)) {
9489 if (ret == (Tcl_Obj*)NULL) {
9502 strval = get_str_from_obj(ret);
9518 if (deleted_ip(ptr)) {
9528 if (ret == (
char*)NULL) {
9544 ip_set_variable2(
self, varname, index, value, flag)
9563 retval =
tk_funcall(ip_set_variable2_core, 4, argv,
self);
9565 if (
NIL_P(retval)) {
9573 ip_set_variable(
self, varname, value, flag)
9579 return ip_set_variable2(
self, varname,
Qnil, value, flag);
9583 ip_unset_variable2_core(interp, argc, argv)
9588 struct tcltkip *ptr = get_ip(interp);
9601 if (deleted_ip(ptr)) {
9610 if (
FIX2INT(flag) & TCL_LEAVE_ERR_MSG) {
9622 ip_unset_variable2(
self, varname, index, flag)
9638 retval =
tk_funcall(ip_unset_variable2_core, 3, argv,
self);
9640 if (
NIL_P(retval)) {
9648 ip_unset_variable(
self, varname, flag)
9653 return ip_unset_variable2(
self, varname,
Qnil, flag);
9657 ip_get_global_var(
self, varname)
9661 return ip_get_variable(
self, varname,
9662 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9666 ip_get_global_var2(
self, varname, index)
9671 return ip_get_variable2(
self, varname, index,
9672 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9676 ip_set_global_var(
self, varname, value)
9681 return ip_set_variable(
self, varname, value,
9682 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9686 ip_set_global_var2(
self, varname, index, value)
9692 return ip_set_variable2(
self, varname, index, value,
9693 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9697 ip_unset_global_var(
self, varname)
9701 return ip_unset_variable(
self, varname,
9702 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9706 ip_unset_global_var2(
self, varname, index)
9711 return ip_unset_variable2(
self, varname, index,
9712 INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
9718 lib_split_tklist_core(ip_obj,
list_str)
9726 #ifdef HAVE_RUBY_ENCODING_H
9736 interp = (Tcl_Interp *)NULL;
9737 }
else if (get_ip(ip_obj) == (
struct tcltkip *)NULL) {
9738 interp = (Tcl_Interp *)NULL;
9740 interp = get_ip(ip_obj)->ip;
9744 #ifdef HAVE_RUBY_ENCODING_H
9750 #if TCL_MAJOR_VERSION >= 8
9757 listobj = get_obj_from_str(list_str);
9761 result = Tcl_ListObjGetElements(interp, listobj, &objc, &objv);
9765 if (interp == (Tcl_Interp*)NULL) {
9772 for(idx = 0; idx <
objc; idx++) {
9784 for(idx = 0; idx <
objc; idx++) {
9785 elem = get_str_from_obj(objv[idx]);
9788 #ifdef HAVE_RUBY_ENCODING_H
9791 rb_ivar_set(elem, ID_at_enc, ENCODING_NAME_BINARY);
9807 for(idx = 0; idx <
objc; idx++) {
9820 if (interp == (Tcl_Interp*)NULL) {
9832 for(idx = 0; idx <
argc; idx++) {
9852 lib_split_tklist(
self, list_str)
9856 return lib_split_tklist_core(
Qnil, list_str);
9861 ip_split_tklist(
self, list_str)
9865 return lib_split_tklist_core(
self, list_str);
9869 lib_merge_tklist(argc, argv, obj)
9899 for(num = 0; num <
argc; num++) {
9902 #if TCL_MAJOR_VERSION >= 8
9906 len += Tcl_ScanElement(dst, &flagPtr[num]) + 1;
9912 result = (
char *)ckalloc(len);
9917 for(num = 0; num <
argc; num++) {
9918 #if TCL_MAJOR_VERSION >= 8
9919 len = Tcl_ConvertCountedElement(
RSTRING_PTR(argv[num]),
9923 len = Tcl_ConvertElement(
RSTRING_PTR(argv[num]), dst, flagPtr[num]);
9929 if (dst == result) {
9936 Tcl_EventuallyFree((ClientData)flagPtr, TCL_DYNAMIC);
9950 Tcl_EventuallyFree((ClientData)result, TCL_DYNAMIC);
9967 lib_conv_listelement(
self, src)
9983 #if TCL_MAJOR_VERSION >= 8
9990 len = Tcl_ScanElement(
RSTRING_PTR(src), &scan_flag);
10004 lib_getversion(
self)
10016 lib_get_reltype_name(
self)
10041 static CONST char form[]
10042 =
"tcltklib %s :: Ruby%s (%s) %s pthread :: Tcl%s(%s)/Tk%s(%s) %s";
10050 +
strlen(TCL_PATCH_LEVEL)
10051 +
strlen(
"without stub")
10052 +
strlen(TK_PATCH_LEVEL)
10053 +
strlen(
"without stub")
10054 +
strlen(
"unknown tcl_threads");
10068 #ifdef USE_TCL_STUBS
10074 #ifdef USE_TK_STUBS
10079 #ifdef WITH_TCL_ENABLE_THREAD
10080 #
if WITH_TCL_ENABLE_THREAD
10083 "without tcl_threads"
10086 "unknown tcl_threads"
10102 create_dummy_encoding_for_tk_core(interp, name,
error_mode)
10112 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10113 if (Tcl_GetEncoding((Tcl_Interp*)NULL,
RSTRING_PTR(name)) == (Tcl_Encoding)NULL) {
10114 if (
RTEST(error_mode)) {
10123 #ifdef HAVE_RUBY_ENCODING_H
10128 if (
RTEST(error_mode)) {
10142 create_dummy_encoding_for_tk(interp, name)
10146 return create_dummy_encoding_for_tk_core(interp, name,
Qtrue);
10150 #ifdef HAVE_RUBY_ENCODING_H
10152 update_encoding_table(
table, interp, error_mode)
10167 ptr = get_ip(interp);
10168 if (ptr == (
struct tcltkip *) NULL)
return 0;
10169 if (deleted_ip(ptr))
return 0;
10173 enc_list = Tcl_GetObjResult(ptr->
ip);
10176 if (Tcl_ListObjGetElements(ptr->
ip, enc_list,
10177 &objc, &objv) !=
TCL_OK) {
10184 for(i = 0; i <
objc; i++) {
10190 encobj = create_dummy_encoding_for_tk_core(interp,encname,error_mode);
10209 encoding_table_get_name_core(table,
enc_arg, error_mode)
10223 ptr = get_ip(interp);
10224 if (deleted_ip(ptr)) {
10225 ptr = (
struct tcltkip *) NULL;
10233 enc =
rb_funcall(interp, ID_encoding_name, 0, 0);
10242 enc =
rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL));
10256 if (!
NIL_P(name)) {
10263 if (update_encoding_table(table, interp, error_mode)) {
10267 if (!
NIL_P(name)) {
10296 if (update_encoding_table(table, interp, error_mode)) {
10316 encoding_table_get_obj_core(table, enc, error_mode)
10324 encoding_table_get_name_core(table, enc, error_mode));
10333 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10335 update_encoding_table(table, interp, error_mode)
10348 if (
NIL_P(interp))
return 0;
10349 ptr = get_ip(interp);
10350 if (ptr == (
struct tcltkip *) NULL)
return 0;
10351 if (deleted_ip(ptr))
return 0;
10355 enc_list = Tcl_GetObjResult(ptr->
ip);
10358 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) !=
TCL_OK) {
10365 for(i = 0; i <
objc; i++) {
10381 encoding_table_get_name_core(table, enc, error_mode)
10391 if (!
NIL_P(name)) {
10397 if (update_encoding_table(table,
rb_ivar_get(table, ID_at_interp),
10402 if (!
NIL_P(name)) {
10408 if (
RTEST(error_mode)) {
10414 encoding_table_get_obj_core(table, enc, error_mode)
10419 return encoding_table_get_name_core(table, enc, error_mode);
10424 encoding_table_get_name_core(table, enc, error_mode)
10432 encoding_table_get_obj_core(table, enc, error_mode)
10443 encoding_table_get_name(table, enc)
10447 return encoding_table_get_name_core(table, enc,
Qtrue);
10450 encoding_table_get_obj(table, enc)
10454 return encoding_table_get_obj_core(table, enc,
Qtrue);
10457 #ifdef HAVE_RUBY_ENCODING_H
10459 create_encoding_table_core(arg, interp)
10463 struct tcltkip *ptr = get_ip(interp);
10471 #ifdef HAVE_RB_SET_SAFE_LEVEL_FORCE
10488 enc_list = Tcl_GetObjResult(ptr->
ip);
10491 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) !=
TCL_OK) {
10497 for(i = 0; i <
objc; i++) {
10498 int name2obj, obj2name;
10500 name2obj = 1; obj2name = 1;
10505 if (strcmp(
RSTRING_PTR(encname),
"identity") == 0) {
10506 name2obj = 1; obj2name = 0;
10509 }
else if (strcmp(
RSTRING_PTR(encname),
"shiftjis") == 0) {
10510 name2obj = 1; obj2name = 0;
10513 }
else if (strcmp(
RSTRING_PTR(encname),
"unicode") == 0) {
10514 name2obj = 1; obj2name = 0;
10517 }
else if (strcmp(
RSTRING_PTR(encname),
"symbol") == 0) {
10518 name2obj = 1; obj2name = 0;
10523 name2obj = 1; obj2name = 1;
10529 encobj = create_dummy_encoding_for_tk(interp, encname);
10553 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)
10555 create_encoding_table_core(arg, interp)
10559 struct tcltkip *ptr = get_ip(interp);
10568 rb_hash_aset(table, ENCODING_NAME_BINARY, ENCODING_NAME_BINARY);
10572 enc_list = Tcl_GetObjResult(ptr->
ip);
10575 if (Tcl_ListObjGetElements(ptr->
ip, enc_list, &objc, &objv) !=
TCL_OK) {
10581 for(i = 0; i <
objc; i++) {
10596 create_encoding_table_core(arg, interp)
10608 create_encoding_table(interp)
10616 ip_get_encoding_table(interp)
10625 table = create_encoding_table(interp);
10640 #if TCL_MAJOR_VERSION >= 8
10642 #define MASTER_MENU 0
10643 #define TEAROFF_MENU 1
10646 struct dummy_TkMenuEntry {
10648 struct dummy_TkMenu *menuPtr;
10652 struct dummy_TkMenu {
10656 Tcl_Command widgetCmd;
10657 struct dummy_TkMenuEntry **entries;
10661 Tcl_Obj *menuTypePtr;
10665 struct dummy_TkMenuRef {
10666 struct dummy_TkMenu *menuPtr;
10673 EXTERN struct dummy_TkMenuRef *TkFindMenuReferences(Tcl_Interp*,
char*);
10675 #define MENU_HASH_KEY "tkMenus"
10681 ip_make_menu_embeddable_core(interp, argc, argv)
10686 #if TCL_MAJOR_VERSION >= 8
10688 struct tcltkip *ptr = get_ip(interp);
10689 struct dummy_TkMenuRef *menuRefPtr =
NULL;
10691 Tcl_HashTable *menuTablePtr;
10692 Tcl_HashEntry *hashEntryPtr;
10694 menu_path = argv[0];
10698 menuRefPtr = TkFindMenuReferences(ptr->
ip,
RSTRING_PTR(menu_path));
10701 = (Tcl_HashTable *) Tcl_GetAssocData(ptr->
ip, MENU_HASH_KEY, NULL))
10704 = Tcl_FindHashEntry(menuTablePtr,
RSTRING_PTR(menu_path)))
10706 menuRefPtr = (
struct dummy_TkMenuRef *) Tcl_GetHashValue(hashEntryPtr);
10711 if (menuRefPtr == (
struct dummy_TkMenuRef *)
NULL) {
10715 if (menuRefPtr->menuPtr == (
struct dummy_TkMenu *) NULL) {
10717 "invalid menu widget (maybe already destroyed)");
10720 if ((menuRefPtr->menuPtr)->menuType != MENUBAR) {
10722 "target menu widget must be a MENUBAR type");
10725 (menuRefPtr->menuPtr)->menuType = TEAROFF_MENU;
10729 char *s =
"normal";
10731 (menuRefPtr->menuPtr)->menuTypePtr = Tcl_NewStringObj(s,
strlen(s));
10734 (menuRefPtr->menuPtr)->menuType = MASTER_MENU;
10739 TkEventuallyRecomputeMenu(menuRefPtr->menuPtr);
10740 TkEventuallyRedrawMenu(menuRefPtr->menuPtr,
10741 (
struct dummy_TkMenuEntry *)NULL);
10743 memset((
void *) &event, 0,
sizeof(event));
10744 event.xany.type = ConfigureNotify;
10745 event.xany.serial = NextRequest(Tk_Display((menuRefPtr->menuPtr)->tkwin));
10746 event.xany.send_event = 0;
10747 event.xany.window = Tk_WindowId((menuRefPtr->menuPtr)->tkwin);
10748 event.xany.display = Tk_Display((menuRefPtr->menuPtr)->tkwin);
10749 event.xconfigure.window =
event.xany.window;
10750 Tk_HandleEvent(&event);
10761 ip_make_menu_embeddable(interp, menu_path)
10768 return tk_funcall(ip_make_menu_embeddable_core, 1, argv, interp);
10789 tcltkip_class =
ip;
10793 #ifdef HAVE_RUBY_ENCODING_H
10832 # define TK_WINDOWING_SYSTEM "win32"
10835 # define TK_WINDOWING_SYSTEM "classic"
10838 # define TK_WINDOWING_SYSTEM "aqua"
10840 # define TK_WINDOWING_SYSTEM "x11"
10861 #ifdef TCL_NAMESPACE_ONLY
10869 #ifdef TCL_PARSE_PART1
10879 lib_get_reltype_name, -1);
10896 eTkLocalJumpError =
rb_define_class(
"TkLocalJumpError", eLocalJumpError);
10898 eTkCallbackRetry =
rb_define_class(
"TkCallbackRetry", eTkLocalJumpError);
10899 eTkCallbackRedo =
rb_define_class(
"TkCallbackRedo", eTkLocalJumpError);
10900 eTkCallbackThrow =
rb_define_class(
"TkCallbackThrow", eTkLocalJumpError);
10906 ID_encoding_name =
rb_intern(
"encoding_name");
10907 ID_encoding_table =
rb_intern(
"encoding_table");
10910 #ifndef HAVE_RB_THREAD_ALIVE_P
10933 lib_evloop_thread_p, 0);
10937 lib_thread_callback, -1);
10940 lib_evloop_abort_on_exc, 0);
10944 set_eventloop_window_mode, 1);
10946 get_eventloop_window_mode, 0);
10955 get_eventloop_weight, 0);
10957 lib_num_of_mainwindows, 0);
10964 lib_conv_listelement, 1);
10968 lib_UTF_backslash, 1);
10970 lib_Tcl_backslash, 1);
10973 lib_get_system_encoding, 0);
10975 lib_set_system_encoding, 1);
10977 lib_get_system_encoding, 0);
10979 lib_set_system_encoding, 1);
10994 rb_define_method(ip,
"invalid_namespace?", ip_has_invalid_namespace_p, 0);
11011 create_dummy_encoding_for_tk, 1);
11031 rb_define_method(ip,
"_make_menu_embeddable", ip_make_menu_embeddable, 1);
11045 ip_evloop_abort_on_exc, 0);
11047 ip_evloop_abort_on_exc_set, 1);
11059 eventloop_thread =
Qnil;
11060 eventloop_interp = (Tcl_Interp*)NULL;
11062 #ifndef DEFAULT_EVENTLOOP_DEPTH
11063 #define DEFAULT_EVENTLOOP_DEPTH 7
11068 watchdog_thread =
Qnil;
11074 #ifdef HAVE_NATIVETHREAD
11100 #if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
11109 Tcl_ObjType_ByteArray = Tcl_GetObjType(Tcl_ObjTypeName_ByteArray);
11110 Tcl_ObjType_String = Tcl_GetObjType(Tcl_ObjTypeName_String);
11114 (
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
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
rb_funcall(memo->yielder, id_lshift, 1, rb_assoc_new(memo->prev_value, memo->prev_elts))
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 *)
VALUE rb_exc_new_str(VALUE etype, VALUE str)
#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
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_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 *)
ip_replace_wait_commands(slave, mainWin)
rb_encoding * rb_utf8_encoding(void)
static void set_tcltk_version()
#define rb_thread_alive_p(thread)
#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]
sprintf(psz,"E%"PRIdSIZE, ex)
VALUE rb_enc_associate_index(VALUE obj, int idx)
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_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_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)
rb_hash_aset(hash, RARRAY_AREF(key_value_pair, 0), RARRAY_AREF(key_value_pair, 1))
#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_thread_wakeup(VALUE)
static VALUE ENCODING_NAME_BINARY
Tcl_Interp * ruby_tcl_create_ip_and_stubs_init(int *)
Tcl_QueueEvent((Tcl_Event *) callq, TCL_QUEUE_HEAD)
static struct @118 tcltk_version
static int pending_exception_check0()
void rb_thread_wait_for(struct timeval)
VALUE rb_obj_is_kind_of(VALUE, VALUE)
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)
rb_ivar_set(yielder, id_memo, LONG2NUM(++count))
VALUE rb_enc_default_internal(void)
Tcl_Interp * current_interp
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()
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
#define rb_thread_check_trap_pending()
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)