mirror of
https://github.com/ruby/ruby.git
synced 2022-11-09 12:17:21 -05:00
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
This commit is contained in:
nagai
parent
2b15bd05d3
commit
cc66b1fae4
4 changed files with 186 additions and 36 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue