From e8ab40d239baa5a473e81731c828f2c75dfcb06d Mon Sep 17 00:00:00 2001 From: nagai Date: Sat, 21 Jun 2003 08:47:22 +0000 Subject: [PATCH] Ruby/Tk libraries except tk.rb : * remove direct-accesses to a TkComm::INTERP * remove direct-accesses to a TkComm::INITIALIZE_TARGETS * use TkINTERP_SETUP_SCRIPTS constant for setting up the interpreter tcltklib.c : * support to create a safe interpreter with safe-Tk ( Tk8.x ) you can test it by the following --------------------------------------------- require 'tk' safeip = Tk::INTERP._eval('::safe::interpCreate') Tk::INTERP._eval('::safe::loadTk ' + safeip) Tk::INTERP._eval(safeip + ' eval button .b -text SlaveIP -command exit') Tk::INTERP._eval(safeip + ' eval pack .b') Tk.mainloop --------------------------------------------- git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@3971 b2dd03c8-39d4-4d8f-98ff-823fe69b080e --- ext/tcltklib/tcltklib.c | 20 ++++++++++++++- ext/tk/lib/tk.rb | 54 +++++++++++++++++++++++++++++++++------ ext/tk/lib/tkafter.rb | 10 +++++--- ext/tk/lib/tkcanvas.rb | 6 ++--- ext/tk/lib/tkdialog.rb | 8 +++--- ext/tk/lib/tkfont.rb | 2 +- ext/tk/lib/tktext.rb | 2 +- ext/tk/lib/tkvirtevent.rb | 2 +- 8 files changed, 82 insertions(+), 22 deletions(-) diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c index 9f6f54b5cc..b99b4e94a9 100644 --- a/ext/tcltklib/tcltklib.c +++ b/ext/tcltklib/tcltklib.c @@ -470,11 +470,25 @@ lib_restart(self) /* ignore ERROR */ DUMP2("(TCL_Eval result) %d", ptr->return_value); - /* execute Tk_Init */ + /* execute Tk_Init of Tk_SafeInit */ +#if TCL_MAJOR_VERSION >= 8 + if (Tcl_IsSafe(ptr->ip)) { + DUMP1("Tk_SafeInit"); + if (Tk_SafeInit(ptr->ip) == TCL_ERROR) { + rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); + } + } else { + DUMP1("Tk_Init"); + if (Tk_Init(ptr->ip) == TCL_ERROR) { + rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); + } + } +#else DUMP1("Tk_Init"); if (Tk_Init(ptr->ip) == TCL_ERROR) { rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); } +#endif return Qnil; } @@ -596,8 +610,12 @@ ip_init(self) rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); } DUMP1("Tcl_StaticPackage(\"Tk\")"); +#if TCL_MAJOR_VERSION >= 8 + Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, Tk_SafeInit); +#else Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL); +#endif /* add ruby command to the interpreter */ #if TCL_MAJOR_VERSION >= 8 diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb index c1550680cc..bfa435f326 100644 --- a/ext/tk/lib/tk.rb +++ b/ext/tk/lib/tk.rb @@ -25,6 +25,24 @@ module TkComm Tk_WINDOWS.clear end + def self.__add_target_for_init__(target) + INITIALIZE_TARGETS << target + + if target.const_defined? :TkINTERP_SETUP_SCRIPTS + target::TkINTERP_SETUP_SCRIPTS.collect{|script| + if script.kind_of? Proc + script.call + elsif script.kind_of? Array + Tk.ip_invoke(*script) + else + Tk.ip_eval(script) + end + } + else + nil + end + end + def error_at frames = caller() frames.delete_if do |c| @@ -39,7 +57,7 @@ module TkComm begin #tk_class = TkCore::INTERP._invoke('winfo', 'class', path) - tk_class = Tk.tk_call('winfo', 'class', path) + tk_class = Tk.ip_invoke('winfo', 'class', path) rescue return path end @@ -840,6 +858,22 @@ module TkCore tk_call 'tk_chooseDirectory', *hash_kv(keys) end + def ip_eval(cmd_string) + res = INTERP._eval(cmd_string) + if INTERP._return_value() != 0 + fail RuntimeError, res, error_at + end + return res + end + + def ip_invoke(*args) + res = INTERP._invoke(*args) + if INTERP._return_value() != 0 + fail RuntimeError, res, error_at + end + return res + end + def tk_call(*args) puts args.inspect if $DEBUG args.collect! {|x|ruby2tcl(x)} @@ -937,12 +971,13 @@ module Tk TK_LIBRARY = INTERP._invoke("set", "tk_library").freeze LIBRARY = INTERP._invoke("info", "library").freeze - PLATFORM = Hash[*tk_split_simplelist(INTERP._eval('array get tcl_platform'))] + PLATFORM = Hash[*tk_split_simplelist(INTERP._invoke('array', 'get', + 'tcl_platform'))] PLATFORM.each{|k, v| k.freeze; v.freeze} PLATFORM.freeze TK_PREV = {} - Hash[*tk_split_simplelist(INTERP._eval('array get tkPriv'))].each{|k,v| + Hash[*tk_split_simplelist(INTERP._invoke('array','get','tkPriv'))].each{|k,v| k.freeze case v when /^-?\d+$/ @@ -1437,7 +1472,7 @@ class TkBindTag BTagID_TBL = {} Tk_BINDTAG_ID = ["btag00000"] - TkComm::INITIALIZE_TARGETS << self + TkComm.__add_target_for_init__(self) def self.__init_tables__ BTagID_TBL.clear @@ -1509,16 +1544,19 @@ class TkVariable TkVar_ID_TBL = {} Tk_VARIABLE_ID = ["v00000"] - TkComm::INITIALIZE_TARGETS << self + # this constant must be defined befor calling __add_target_for_init__ + TkINTERP_SETUP_SCRIPTS = [ + ["proc", "rb_var", "args", + "ruby [format \"TkVariable.callback %%Q!%s!\" $args]"] + ] + + TkComm.__add_target_for_init__(self) def self.__init_tables__ # cannot clear # Tcl interpreter may keeps callbacks end - INTERP._invoke("proc", "rb_var", "args", - "ruby [format \"TkVariable.callback %%Q!%s!\" $args]") - def TkVariable.callback(args) name1,name2,op = tk_split_list(args) if TkVar_CB_TBL[name1] diff --git a/ext/tk/lib/tkafter.rb b/ext/tk/lib/tkafter.rb index a75ad5a237..fec93a6a04 100644 --- a/ext/tk/lib/tkafter.rb +++ b/ext/tk/lib/tkafter.rb @@ -12,15 +12,19 @@ class TkTimer Tk_CBID = [0] Tk_CBTBL = {} - TkComm::INITIALIZE_TARGETS << self + # this constant must be defined befor calling __add_target_for_init__ + TkINTERP_SETUP_SCRIPTS = [ + ["proc", "rb_after", "id", + "ruby [format \"#{self.name}.callback %%Q!%s!\" $id]"] + ] + + TkComm.__add_target_for_init__(self) def self.__init_tables__ # cannot clear # Tcl interpreter may keep callbacks end - INTERP._invoke("proc", "rb_after", "id", - "ruby [format \"#{self.name}.callback %%Q!%s!\" $id]") ############################### # class methods diff --git a/ext/tk/lib/tkcanvas.rb b/ext/tk/lib/tkcanvas.rb index ef6b54c876..8c5b610f18 100644 --- a/ext/tk/lib/tkcanvas.rb +++ b/ext/tk/lib/tkcanvas.rb @@ -521,7 +521,7 @@ class TkcTag