summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authornagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2003-07-25 16:43:03 +0000
committernagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2003-07-25 16:43:03 +0000
commitcc66b1fae449cd360ab33fbbe8b598510e3fec26 (patch)
treecbdd5cce8ccbe910203e03c97b4542e7240d8329 /ext
parent2b15bd05d3ec35390b07e1305a118040a4c320b3 (diff)
tcltklib.c : add TclTkIp#create_slave , TclTkIp#_make_safe and TclTkIp#safe?
MANUAL.euc : modify descriptions tk.rb : bug fix [ruby-talk:76980] and modify to support multi Tk IPs tkafter.rb : modify to support multi Tk IPs git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@4163 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'ext')
-rw-r--r--ext/tcltklib/MANUAL.euc39
-rw-r--r--ext/tcltklib/tcltklib.c83
-rw-r--r--ext/tk/lib/tk.rb69
-rw-r--r--ext/tk/lib/tkafter.rb31
4 files changed, 186 insertions, 36 deletions
diff --git a/ext/tcltklib/MANUAL.euc b/ext/tcltklib/MANUAL.euc
index 757cd40..f44e491 100644
--- a/ext/tcltklib/MANUAL.euc
+++ b/ext/tcltklib/MANUAL.euc
@@ -1,5 +1,5 @@
(tof)
- 2003/06/19 Hidetoshi NAGAI
+ 2003/07/25 Hidetoshi NAGAI
本ドキュメントには古い tcltk ライブラリ,tcltklib ライブラリの説明
が含まれていますが,その記述内容は古いものとなっています.
@@ -245,7 +245,35 @@ require "tcltklib" すると, 以下のモジュール, クラスが利用可能です.
: ( see set_eventloop_wait )
クラス TclTkIp
+ クラスメソッド
+ new(ip_name=nil, options='')
+ : TclTkIp クラスのインスタンスを生成する.
+ : ip_name に文字列を与えた場合は,それが winfo interps などで
+ : 表示される名前になる.
+ : options には,-geometry や -use など,wish のコマンドライン
+ : 引数として与えるオプションと同様の情報を文字列として与える.
+ : 与えられた情報は,root widget 生成の際に用いられる.
+ : ( e.g. TclTkIp.new('FOO', '-geometry 500x200 -use 0x2200009') )
+
インスタンスメソッド
+ create_slave(name, safe=false)
+ : レシーバを親とする name という名前のスレーブインタープリタを
+ : 生成する.
+ : safe には生成するインタープリタを safe インタープリタとする
+ : かを指定する.デフォルトは false ということになっているが,
+ : たとえ明確に false を指定していたとしても,親となるインター
+ : プリタが safe インタープリタであれば,その設定を引き継いで
+ : safe インタープリタとして生成される.
+
+ make_safe
+ : Tcl/Tk インタープリタを safe インタープリタに変更する.
+ : 戻り値はレシーバであるインタープリタ自身である.
+ : 失敗した場合は RuntimeError の例外を発生する.
+
+ safe?
+ : Tcl/Tk インタープリタを safe インタープリタであるかを調べる.
+ : safe インタープリタであれば true を返す.
+
restart
: Tcl/Tk インタープリタの Tk 部分の初期化,再起動を行う.
: 一旦 root widget を破壊した後に再度 Tk の機能が必要と
@@ -258,8 +286,13 @@ require "tcltklib" すると, 以下のモジュール, クラスが利用可能です.
: _invoke は評価スクリプトの token ごとに一つの引数とな
: るように与える.
: _invoke の方は Tcl/Tk インタープリタの字句解析器を用い
- : ないため,評価の負荷がより少なくてすむ.
-
+ : ないため,評価の負荷がより少なくてすむ.ただし,その代
+ : わりに auto_load のような機構は働かず,load 等によって
+ : Tcl/Tk インタープリタ上に既に登録済みのコマンドしか呼
+ : び出すことができない.
+ : _eval では auto_load 機構が働くため,一度 _eval を実行
+ : して登録に成功しさえすれば,以降は _invoke でも利用で
+ : きるようになる.
_toUTF8(str, encoding)
_fromUTF8(str, encoding)
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index 5331e1f..9df9874 100644
--- a/ext/tcltklib/tcltklib.c
+++ b/ext/tcltklib/tcltklib.c
@@ -614,22 +614,22 @@ ip_init(argc, argv, self)
cnt = rb_scan_args(argc, argv, "02", &argv0, &opts);
switch(cnt) {
case 2:
- /* options */
- Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), 0);
+ /* options */
+ Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), 0);
case 1:
- /* argv0 */
- if (argv0 != Qnil) {
- Tcl_SetVar(ptr->ip, "argv0", StringValuePtr(argv0), 0);
- }
+ /* argv0 */
+ if (argv0 != Qnil) {
+ Tcl_SetVar(ptr->ip, "argv0", StringValuePtr(argv0), 0);
+ }
case 0:
- /* no args */
- ;
+ /* no args */
+ ;
}
/* from Tcl_AppInit() */
DUMP1("Tk_Init");
if (Tk_Init(ptr->ip) == TCL_ERROR) {
- rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
}
DUMP1("Tcl_StaticPackage(\"Tk\")");
#if TCL_MAJOR_VERSION >= 8
@@ -653,6 +653,68 @@ ip_init(argc, argv, self)
return self;
}
+static VALUE
+ip_create_slave(argc, argv, self)
+ int argc;
+ VALUE *argv;
+ VALUE self;
+{
+ struct tcltkip *master = get_ip(self);
+ struct tcltkip *slave = ALLOC(struct tcltkip);
+ VALUE name;
+ VALUE safemode;
+ int safe;
+
+ /* safe-mode check */
+ if (rb_scan_args(argc, argv, "11", &name, &safemode) == 1) {
+ safemode = Qfalse;
+ }
+ if (Tcl_IsSafe(master->ip) == 1) {
+ safe = 1;
+ } else if (safemode == Qfalse || safemode == Qnil) {
+ safe = 0;
+ } else {
+ safe = 1;
+ }
+
+ /* create slave-ip */
+ if ((slave->ip = Tcl_CreateSlave(master->ip, StringValuePtr(name), safe))
+ == NULL) {
+ rb_raise(rb_eRuntimeError, "fail to create the new slave interpreter");
+ }
+ slave->return_value = 0;
+
+ return Data_Wrap_Struct(CLASS_OF(self), 0, ip_free, slave);
+}
+
+/* make ip "safe" */
+static VALUE
+ip_make_safe(self)
+ VALUE self;
+{
+ struct tcltkip *ptr = get_ip(self);
+
+ if (Tcl_MakeSafe(ptr->ip) == TCL_ERROR) {
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ }
+
+ return self;
+}
+
+/* is safe? */
+static VALUE
+ip_is_safe_p(self)
+ VALUE self;
+{
+ struct tcltkip *ptr = get_ip(self);
+
+ if (Tcl_IsSafe(ptr->ip)) {
+ return Qtrue;
+ } else {
+ return Qfalse;
+ }
+}
+
/* eval string in tcl by Tcl_Eval() */
static VALUE
ip_eval(self, str)
@@ -1012,6 +1074,9 @@ Init_tcltklib()
rb_define_alloc_func(ip, ip_alloc);
rb_define_method(ip, "initialize", ip_init, -1);
+ rb_define_method(ip, "create_slave", ip_create_slave, -1);
+ rb_define_method(ip, "make_safe", ip_make_safe, 0);
+ rb_define_method(ip, "safe?", ip_is_safe_p, 0);
rb_define_method(ip, "_eval", ip_eval, 1);
rb_define_method(ip, "_toUTF8",ip_toUTF8,2);
rb_define_method(ip, "_fromUTF8",ip_fromUTF8,2);
diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index e0c11c1..b84b0a7 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -1,4 +1,4 @@
-#
+
# tk.rb - Tk interface module using tcltklib
# $Date$
# by Yukihiro Matsumoto <matz@netlab.jp>
@@ -251,7 +251,8 @@ module TkComm
def procedure(val)
if val =~ /^rb_out (c\d+)/
#Tk_CMDTBL[$1]
- TkCore::INTERP.tk_cmd_tbl[$1]
+ #TkCore::INTERP.tk_cmd_tbl[$1]
+ TkCore::INTERP.tk_cmd_tbl[$1].cmd
else
#nil
val
@@ -291,6 +292,7 @@ module TkComm
return str
end
private :_get_eval_string
+ module_function :_get_eval_string
def ruby2tcl(v)
if v.kind_of?(Hash)
@@ -319,7 +321,7 @@ module TkComm
return '' if cmd == ''
id = _next_cmd_id
#Tk_CMDTBL[id] = cmd
- TkCore::INTERP.tk_cmd_tbl[id] = cmd
+ TkCore::INTERP.tk_cmd_tbl[id] = TkCore::INTERP.get_cb_entry(cmd)
@cmdtbl = [] unless defined? @cmdtbl
@cmdtbl.push id
return format("rb_out %s", id);
@@ -656,8 +658,8 @@ module TkCore
INTERP = TclTkIp.new(name, opts)
- def INTERP.__ip_id
- nil
+ def INTERP.__getip
+ self
end
INTERP.instance_eval{
@@ -667,8 +669,20 @@ module TkCore
@tk_table_list = []
@init_ip_env = [] # table of Procs
- @add_tk_procs = [] # table of [name, body]
+ @add_tk_procs = [] # table of [name, args, body]
+
+ @cb_entry_class = Class.new{|c|
+ def initialize(ip, cmd)
+ @ip = ip
+ @cmd = cmd
+ end
+ attr_reader :ip, :cmd
+ def call(*args)
+ @ip.cb_eval(@cmd, *args)
+ end
+ }
}
+
def INTERP.tk_cmd_tbl
@tk_cmd_tbl
end
@@ -691,13 +705,20 @@ module TkCore
return obj
end
+ def INTERP.get_cb_entry(cmd)
+ @cb_entry_class.new(__getip, cmd).freeze
+ end
+ def INTERP.cb_eval(cmd, *args)
+ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args))
+ end
+
def INTERP.init_ip_env(script = Proc.new)
@init_ip_env << script
script.call(self)
end
- def INTERP.add_tk_procs(name, args, body)
+ def INTERP.add_tk_procs(name, args = nil, body = nil)
@add_tk_procs << [name, args, body]
- self._invoke('proc', name, args, body)
+ self._invoke('proc', name, args, body) if args && body
end
def INTERP.init_ip_internal
ip = self
@@ -726,6 +747,20 @@ module TkCore
fail TkCallbackContinue, "Tk callback returns 'continue' status"
end
+ def TkCore.callback(arg)
+ # arg = tk_split_list(arg)
+ arg = tk_split_simplelist(arg)
+ #_get_eval_string(TkUtil.eval_cmd(Tk_CMDTBL[arg.shift], *arg))
+ #_get_eval_string(TkUtil.eval_cmd(TkCore::INTERP.tk_cmd_tbl[arg.shift],
+ # *arg))
+ cb_obj = TkCore::INTERP.tk_cmd_tbl[arg.shift]
+ cb_obj.call(*arg)
+ end
+
+ def load_cmd_on_ip(tk_cmd)
+ bool(tk_call('auto_load', tk_cmd))
+ end
+
def after(ms, cmd=Proc.new)
myid = _curr_cmd_id
cmdid = install_cmd(cmd)
@@ -794,14 +829,6 @@ module TkCore
tk_call('clock','seconds').to_i
end
- def TkCore.callback(arg)
- # arg = tk_split_list(arg)
- arg = tk_split_simplelist(arg)
- #_get_eval_string(TkUtil.eval_cmd(Tk_CMDTBL[arg.shift], *arg))
- _get_eval_string(TkUtil.eval_cmd(TkCore::INTERP.tk_cmd_tbl[arg.shift],
- *arg))
- end
-
def windowingsystem
tk_call('tk', 'windowingsystem')
end
@@ -898,7 +925,7 @@ module TkCore
TkCore::INTERP.init_ip_internal
tk_call('set', 'argv0', app_name) if app_name
- if keys.kind_of?(Hash) && keys.size > 0
+ if keys.kind_of?(Hash)
# tk_call('set', 'argc', keys.size * 2)
tk_call('set', 'argv', hash_kv(keys).join(' '))
end
@@ -937,10 +964,6 @@ module TkCore
tk_call 'tk_chooseColor', *hash_kv(keys)
end
- def chooseDirectory(keys = nil)
- tk_call 'tk_chooseDirectory', *hash_kv(keys)
- end
-
def ip_eval(cmd_string)
res = INTERP._eval(cmd_string)
if INTERP._return_value() != 0
@@ -1484,11 +1507,11 @@ if /^8\.[1-9]/ =~ Tk::TCL_VERSION && !Tk::JAPANIZED_TK
TkCommandNames = ['encoding'.freeze].freeze
def encoding=(name)
- INTERP.encoding = name
+ TkCore::INTERP.encoding = name
end
def encoding
- INTERP.encoding
+ TkCore::INTERP.encoding
end
def encoding_names
diff --git a/ext/tk/lib/tkafter.rb b/ext/tk/lib/tkafter.rb
index 4401bce..2ff60fe 100644
--- a/ext/tk/lib/tkafter.rb
+++ b/ext/tk/lib/tkafter.rb
@@ -25,7 +25,8 @@ class TkTimer
@after_id = nil
ex_obj = Tk_CBTBL[obj_id]
return nil if ex_obj == nil; # canceled
- _get_eval_string(ex_obj.do_callback)
+ #_get_eval_string(ex_obj.do_callback)
+ ex_obj.cb_call
end
def self.info
@@ -103,6 +104,8 @@ class TkTimer
@id = Tk_CBID.join
Tk_CBID[1].succ!
+ @cb_cmd = TkCore::INTERP.get_cb_entry(self.method(:do_callback))
+
@set_next = true
@init_sleep = 0
@@ -142,6 +145,10 @@ class TkTimer
attr_accessor :loop_exec
+ def cb_call
+ @cb_cmd.call
+ end
+
def get_procs
[@init_sleep, @init_proc, @init_args, @sleep_time, @loop_exec, @loop_proc]
end
@@ -220,6 +227,28 @@ class TkTimer
self
end
+ def delete_procs(*procs)
+ procs.each{|e|
+ if e.kind_of? Proc
+ @loop_proc.delete([e])
+ else
+ @loop_proc.delete(e)
+ end
+ }
+ @proc_max = @loop_proc.size
+
+ cancel if @proc_max == 0
+
+ self
+ end
+
+ def delete_at(n)
+ @loop_proc.delete_at(n)
+ @proc_max = @loop_proc.size
+ cancel if @proc_max == 0
+ self
+ end
+
def set_start_proc(sleep, init_proc, *init_args)
if !sleep == 'idle' && !sleep.kind_of?(Integer)
fail format("%s need to be Integer", sleep.inspect)