ruby-changes:35826
From: nagai <ko1@a...>
Date: Tue, 14 Oct 2014 02:32:42 +0900 (JST)
Subject: [ruby-changes:35826] nagai:r47908 (trunk): * ext/tk/tcltklib.c: (experimental) support Tcl/Tk8.6.2.
nagai 2014-10-14 02:32:17 +0900 (Tue, 14 Oct 2014) New Revision: 47908 http://svn.ruby-lang.org/cgi-bin/viewvc.cgi?view=revision&revision=47908 Log: * ext/tk/tcltklib.c: (experimental) support Tcl/Tk8.6.2. * ext/tk/extconf.rb: ditto. Modified files: trunk/ext/tk/extconf.rb trunk/ext/tk/tcltklib.c Index: ext/tk/tcltklib.c =================================================================== --- ext/tk/tcltklib.c (revision 47907) +++ ext/tk/tcltklib.c (revision 47908) @@ -6022,7 +6022,12 @@ ip_rbNamespaceObjCmd(clientData, interp, https://github.com/ruby/ruby/blob/trunk/ext/tk/tcltklib.c#L6022 Tcl_CmdInfo info; int ret; + DUMP1("call ip_rbNamespaceObjCmd"); + DUMP2("objc = %d", objc); + DUMP2("objv[0] = '%s'", Tcl_GetString(objv[0])); + DUMP2("objv[1] = '%s'", Tcl_GetString(objv[1])); if (!Tcl_GetCommandInfo(interp, "__orig_namespace_command__", &(info))) { + DUMP1("fail to get __orig_namespace_command__"); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "invalid command name \"namespace\"", (char*)NULL); @@ -6030,15 +6035,37 @@ ip_rbNamespaceObjCmd(clientData, interp, https://github.com/ruby/ruby/blob/trunk/ext/tk/tcltklib.c#L6035 } rbtk_eventloop_depth++; - /* DUMP2("namespace wrapper enter depth == %d", rbtk_eventloop_depth); */ + DUMP2("namespace wrapper enter depth == %d", rbtk_eventloop_depth); if (info.isNativeObjectProc) { +#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6 + DUMP1("call a native-object-proc"); ret = (*(info.objProc))(info.objClientData, interp, objc, objv); +#else + /* Tcl8.6 or later */ + int i; + Tcl_Obj **cp_objv; + char org_ns_cmd_name[] = "__orig_namespace_command__"; + + DUMP1("call a native-object-proc for tcl8.6 or later"); + cp_objv = RbTk_ALLOC_N(Tcl_Obj *, (objc + 1)); + + cp_objv[0] = Tcl_NewStringObj(org_ns_cmd_name, strlen(org_ns_cmd_name)); + for(i = 1; i < objc; i++) { + cp_objv[i] = objv[i]; + } + cp_objv[objc] = (Tcl_Obj *)NULL; + + ret = Tcl_EvalObjv(interp, objc, cp_objv, TCL_EVAL_DIRECT); + + ckfree((char*)cp_objv); +#endif } else { /* string interface */ int i; char **argv; + DUMP1("call with the string-interface"); /* argv = (char **)Tcl_Alloc(sizeof(char *) * (objc + 1)); */ argv = RbTk_ALLOC_N(char *, (objc + 1)); #if 0 /* use Tcl_Preserve/Release */ @@ -6066,9 +6093,10 @@ ip_rbNamespaceObjCmd(clientData, interp, https://github.com/ruby/ruby/blob/trunk/ext/tk/tcltklib.c#L6093 #endif } - /* DUMP2("namespace wrapper exit depth == %d", rbtk_eventloop_depth); */ + DUMP2("namespace wrapper exit depth == %d", rbtk_eventloop_depth); rbtk_eventloop_depth--; + DUMP1("end of ip_rbNamespaceObjCmd"); return ret; } #endif @@ -6078,6 +6106,8 @@ ip_wrap_namespace_command(interp) https://github.com/ruby/ruby/blob/trunk/ext/tk/tcltklib.c#L6106 Tcl_Interp *interp; { #if TCL_MAJOR_VERSION >= 8 + +#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 6 Tcl_CmdInfo orig_info; if (!Tcl_GetCommandInfo(interp, "namespace", &(orig_info))) { @@ -6094,6 +6124,11 @@ ip_wrap_namespace_command(interp) https://github.com/ruby/ruby/blob/trunk/ext/tk/tcltklib.c#L6124 orig_info.deleteProc); } +#else /* tcl8.6 or later */ + Tcl_Eval(interp, "rename namespace __orig_namespace_command__"); + +#endif + Tcl_CreateObjCommand(interp, "namespace", ip_rbNamespaceObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *)NULL); #endif @@ -8464,9 +8499,12 @@ invoke_tcl_proc(arg) https://github.com/ruby/ruby/blob/trunk/ext/tk/tcltklib.c#L8499 char **argv = (char **)NULL; #endif + DUMP1("call invoke_tcl_proc"); + /* memory allocation for arguments of this command */ #if TCL_MAJOR_VERSION >= 8 if (!inf->cmdinfo.isNativeObjectProc) { + DUMP1("called proc is not a native-obj-proc"); /* string interface */ /* argv = (char **)ALLOC_N(char *, argc+1);*/ /* XXXXXXXXXX */ argv = RbTk_ALLOC_N(char *, (argc+1)); @@ -8480,11 +8518,13 @@ invoke_tcl_proc(arg) https://github.com/ruby/ruby/blob/trunk/ext/tk/tcltklib.c#L8518 } #endif + DUMP1("reset result of tcl-interp"); Tcl_ResetResult(inf->ptr->ip); /* Invoke the C procedure */ #if TCL_MAJOR_VERSION >= 8 if (inf->cmdinfo.isNativeObjectProc) { + DUMP1("call tcl_proc as a native-obj-proc"); inf->ptr->return_value = (*(inf->cmdinfo.objProc))(inf->cmdinfo.objClientData, inf->ptr->ip, inf->objc, inf->objv); @@ -8493,6 +8533,7 @@ invoke_tcl_proc(arg) https://github.com/ruby/ruby/blob/trunk/ext/tk/tcltklib.c#L8533 #endif { #if TCL_MAJOR_VERSION >= 8 + DUMP1("call tcl_proc as not a native-obj-proc"); inf->ptr->return_value = (*(inf->cmdinfo.proc))(inf->cmdinfo.clientData, inf->ptr->ip, argc, (CONST84 char **)argv); @@ -8515,6 +8556,7 @@ invoke_tcl_proc(arg) https://github.com/ruby/ruby/blob/trunk/ext/tk/tcltklib.c#L8556 #endif } + DUMP1("end of invoke_tcl_proc"); return Qnil; } @@ -8654,7 +8696,9 @@ ip_invoke_core(interp, argc, argv) https://github.com/ruby/ruby/blob/trunk/ext/tk/tcltklib.c#L8696 #endif /* invoke tcl-proc */ + DUMP1("invoke tcl-proc"); rb_protect(invoke_tcl_proc, (VALUE)&inf, &status); + DUMP2("status of tcl-proc, %d", status); switch(status) { case TAG_RAISE: if (NIL_P(rb_errinfo())) { Index: ext/tk/extconf.rb =================================================================== --- ext/tk/extconf.rb (revision 47907) +++ ext/tk/extconf.rb (revision 47908) @@ -9,10 +9,10 @@ TkLib_Config['search_versions'] = https://github.com/ruby/ruby/blob/trunk/ext/tk/extconf.rb#L9 # %w[8.9 8.8 8.7 8.6 8.5 8.4 8.3 8.2 8.1 8.0 7.6 4.2] # %w[8.7 8.6 8.5 8.4 8.3 8.2 8.1 8.0] # %w[8.7 8.6 8.5 8.4 8.0] # to shorten search steps - %w[8.5 8.4] # At present, Tcl/Tk8.6 is not supported. + %w[8.5 8.4 8.6] # Tcl/Tk8.6 support is experimental. TkLib_Config['unsupported_versions'] = - %w[8.8 8.7 8.6] # At present, Tcl/Tk8.6 is not supported. + %w[8.8 8.7] # Tcl/Tk8.6 support is experimental. TkLib_Config['major_nums'] = '87' -- ML: ruby-changes@q... Info: http://www.atdot.net/~ko1/quickml/