diff options
Diffstat (limited to 'ext/tcltklib/lib/tcltk.rb')
| -rw-r--r-- | ext/tcltklib/lib/tcltk.rb | 388 |
1 files changed, 388 insertions, 0 deletions
diff --git a/ext/tcltklib/lib/tcltk.rb b/ext/tcltklib/lib/tcltk.rb new file mode 100644 index 0000000000..81d01f930d --- /dev/null +++ b/ext/tcltklib/lib/tcltk.rb @@ -0,0 +1,388 @@ +# tof + +#### tcltk ライブラリ +#### Sep. 5, 1997 Y. Shigehiro + +require "tcltklib" + +################ + +# module TclTk: tcl/tk のライブラリ全体で必要になるものを集めたもの +# (主に, 名前空間の点から module にする使う.) +module TclTk + + # 単にここに書けば最初に 1 度実行されるのか?? + + # 生成した一意な名前を保持しておく連想配列を初期化する. + @namecnt = {} + + # コールバックを保持しておく連想配列を初期化する. + @callback = {} +end + +# TclTk.mainloop(): TclTkLib.mainloop() を呼ぶ. +def TclTk.mainloop() + print("mainloop: start\n") if $DEBUG + TclTkLib.mainloop() + print("mainloop: end\n") if $DEBUG +end + +# TclTk.deletecallbackkey(ca): コールバックを TclTk module から取り除く. +# tcl/tk インタプリタにおいてコールバックが取り消されるわけではない. +# これをしないと, 最後に TclTkInterpreter が GC できない. +# (GC したくなければ, 別に, これをしなくても良い.) +# ca: コールバック(TclTkCallback) +def TclTk.deletecallbackkey(ca) + print("deletecallbackkey: ", ca.to_s(), "\n") if $DEBUG + @callback.delete(ca.to_s) +end + +# TclTk.dcb(ca, wid, W): 配列に入っている複数のコールバックに対して +# TclTk.deletecallbackkey() を呼ぶ. +# トップレベルの <Destroy> イベントのコールバックとして呼ぶためのもの. +# ca: コールバック(TclTkCallback) の Array +# wid: トップレベルのウィジェット(TclTkWidget) +# w: コールバックに %W で与えられる, ウインドウに関するパラメータ(String) +def TclTk.dcb(ca, wid, w) + if wid.to_s() == w + ca.each{|i| + TclTk.deletecallbackkey(i) + } + end +end + +# TclTk._addcallback(ca): コールバックを登録する. +# ca: コールバック(TclTkCallback) +def TclTk._addcallback(ca) + print("_addcallback: ", ca.to_s(), "\n") if $DEBUG + @callback[ca.to_s()] = ca +end + +# TclTk._callcallback(key, arg): 登録したコールバックを呼び出す. +# key: コールバックを選択するキー (TclTkCallback が to_s() で返す値) +# arg: tcl/tk インタプリタからのパラメータ +def TclTk._callcallback(key, arg) + print("_callcallback: ", @callback[key].inspect, "\n") if $DEBUG + @callback[key]._call(arg) + # コールバックからの返り値はどうせ捨てられる. + # String を返さないと, rb_eval_string() がエラーになる. + return "" +end + +# TclTk._newname(prefix): 一意な名前(String)を生成して返す. +# prefix: 名前の接頭語 +def TclTk._newname(prefix) + # 生成した名前のカウンタは @namecnt に入っているので, 調べる. + if !@namecnt.key?(prefix) + # 初めて使う接頭語なので初期化する. + @namecnt[prefix] = 1 + else + # 使ったことのある接頭語なので, 次の名前にする. + @namecnt[prefix] += 1 + end + return "#{prefix}#{@namecnt[prefix]}" +end + +################ + +# class TclTkInterpreter: tcl/tk のインタプリタ +class TclTkInterpreter + + # initialize(): 初期化. + def initialize() + # インタプリタを生成する. + @ip = TclTkIp.new() + + # インタプリタに ruby_fmt コマンドを追加する. + # ruby_fmt コマンドとは, 後ろの引数を format コマンドで処理して + # ruby コマンドに渡すものである. + # (なお, ruby コマンドは, 引数を 1 つしかとれない.) + if $DEBUG + @ip._eval("proc ruby_fmt {fmt args} { puts \"ruby_fmt: $fmt $args\" ; ruby [format $fmt $args] }") + else + @ip._eval("proc ruby_fmt {fmt args} { ruby [format $fmt $args] }") + end + + # @ip._get_eval_string(*args): tcl/tk インタプリタで評価する + # 文字列(String)を生成して返す. + # *args: tcl/tk で評価するスクリプト(に対応するオブジェクト列) + def @ip._get_eval_string(*args) + argstr = "" + args.each{|arg| + argstr += " " if argstr != "" + # もし to_eval() メソッドが + if (arg.respond_to?(:to_eval)) + # 定義されていればそれを呼ぶ. + argstr += arg.to_eval() + else + # 定義されていなければ to_s() を呼ぶ. + argstr += arg.to_s() + end + } + return argstr + end + + # @ip._eval_args(*args): tcl/tk インタプリタで評価し, + # その結果(String)を返す. + # *args: tcl/tk で評価するスクリプト(に対応するオブジェクト列) + def @ip._eval_args(*args) + # インタプリタで評価する文字列を求める. + argstr = _get_eval_string(*args) + + # インタプリタで評価する. + print("_eval: \"", argstr, "\"") if $DEBUG + res = _eval(argstr) + if $DEBUG + print(" -> \"", res, "\"\n") + elsif _return_value() != 0 + print(res, "\n") + end + fail(%Q/can't eval "#{argstr}"/) if _return_value() != 0 + return res + end + + # tcl/tk のコマンドに対応するオブジェクトを生成し, 連想配列に入れておく. + @commands = {} + # tcl/tk インタプリタに登録されているすべてのコマンドに対して, + @ip._eval("info command").split(/ /).each{|comname| + if comname =~ /^[.]/ + # コマンドがウィジェット(のパス名)の場合は + # TclTkWidget のインスタンスを作って連想配列に入れる. + @commands[comname] = TclTkWidget.new(@ip, comname) + else + # そうでない場合は + # TclTkCommand のインスタンスを作って連想配列に入れる. + @commands[comname] = TclTkCommand.new(@ip, comname) + end + } + end + + # commands(): tcl/tk のコマンドに対応するオブジェクトを Hash に + # 入れたものを返す. + def commands() + return @commands + end + + # rootwidget(): ルートウィジェット(TclTkWidget)を返す. + def rootwidget() + return @commands["."] + end + + # _tcltkip(): @ip(TclTkIp) を返す. + def _tcltkip() + return @ip + end + + # method_missing(id, *args): 未定義のメソッドは tcl/tk のコマンドとみなして + # 実行し, その結果(String)を返す. + # id: メソッドのシンボル + # *args: コマンドの引数 + def method_missing(id, *args) + # もし, メソッドの tcl/tk コマンドが + if @commands.key?(id.id2name) + # あれば, 実行して結果を返す. + return @commands[id.id2name].e(*args) + else + # 無ければもともとの処理. + super + end + end +end + +# class TclTkObject: tcl/tk のオブジェクト +# (基底クラスとして使う. +# tcltk ライブラリを使う人が TclTkObject.new() することはないはず.) +class TclTkObject + + # initialize(ip, exp): 初期化. + # ip: インタプリタ(TclTkIp) + # exp: tcl/tk での表現形 + def initialize(ip, exp) + fail("type is not TclTkIp") if !ip.kind_of?(TclTkIp) + @ip = ip + @exp = exp + end + + # to_s(): tcl/tk での表現形(String)を返す. + def to_s() + return @exp + end +end + +# class TclTkCommand: tcl/tk のコマンド +# (tcltk ライブラリを使う人が TclTkCommand.new() することはないはず. +# TclTkInterpreter:initialize() から new() される.) +class TclTkCommand < TclTkObject + + # e(*args): コマンドを実行し, その結果(String)を返す. + # (e は exec または eval の e.) + # *args: コマンドの引数 + def e(*args) + return @ip._eval_args(to_s(), *args) + end +end + +# class TclTkLibCommand: tcl/tk のコマンド +# (ライブラリにより実現されるコマンドで, tcl/tk インタプリタに最初から +# 存在しないものは, インタプリタの commands() では生成できない. +# そのようなものに対し, コマンドの名前から TclTkCommand オブジェクトを +# 生成する. +class TclTkLibCommand < TclTkCommand + + # initialize(ip, name): 初期化 + # ip: インタプリタ(TclTkInterpreter) + # name: コマンド名 (String) + def initialize(ip, name) + super(ip._tcltkip, name) + end +end + +# class TclTkVariable: tcl/tk の変数 +class TclTkVariable < TclTkObject + + # initialize(interp, dat): 初期化. + # interp: インタプリタ(TclTkInterpreter) + # dat: 設定する値(String) + # nil なら, 設定しない. + def initialize(interp, dat) + # tcl/tk での表現形(変数名)を自動生成する. + exp = TclTk._newname("v_") + # TclTkObject を初期化する. + super(interp._tcltkip(), exp) + # set コマンドを使うのでとっておく. + @set = interp.commands()["set"] + # 値を設定する. + set(dat) if dat + end + + # tcl/tk の set を使えば, 値の設定/参照はできるが, + # それだけではなんなので, 一応, メソッドをかぶせたものも用意しておく. + + # set(data): tcl/tk の変数に set を用いて値を設定する. + # data: 設定する値 + def set(data) + @set.e(to_s(), data.to_s()) + end + + # get(): tcl/tk の変数の値(String)を set を用いて読みだし返す. + def get() + return @set.e(to_s()) + end +end + +# class TclTkWidget: tcl/tk のウィジェット +class TclTkWidget < TclTkCommand + + # initialize(*args): 初期化. + # *args: パラメータ + def initialize(*args) + if args[0].kind_of?(TclTkIp) + # 最初の引数が TclTkIp の場合: + + # 既に tcl/tk に定義されているウィジェットに TclTkWidget の構造を + # かぶせる. (TclTkInterpreter:initialize() から使われる.) + + # パラメータ数が 2 でなければエラー. + fail("illegal # of parameter") if args.size != 2 + + # ip: インタプリタ(TclTkIp) + # exp: tcl/tk での表現形 + ip, exp = args + + # TclTkObject を初期化する. + super(ip, exp) + elsif args[0].kind_of?(TclTkInterpreter) + # 最初の引数が TclTkInterpreter の場合: + + # 親ウィジェットから新たなウィジェトを生成する. + + # interp: インタプリタ(TclTkInterpreter) + # parent: 親ウィジェット + # command: ウィジェットを生成するコマンド(label 等) + # *args: command に渡す引数 + interp, parent, command, *args = args + + # ウィジェットの名前を作る. + exp = parent.to_s() + exp += "." if exp !~ /[.]$/ + exp += TclTk._newname("w_") + # TclTkObject を初期化する. + super(interp._tcltkip(), exp) + # ウィジェットを生成する. + res = @ip._eval_args(command, exp, *args) +# fail("can't create Widget") if res != exp + # tk_optionMenu では, ボタン名を exp で指定すると + # res にメニュー名を返すので res != exp となる. + else + fail("first parameter is not TclTkInterpreter") + end + end +end + +# class TclTkCallback: tcl/tk のコールバック +class TclTkCallback < TclTkObject + + # initialize(interp, pr, arg): 初期化. + # interp: インタプリタ(TclTkInterpreter) + # pr: コールバック手続き(Proc) + # arg: pr のイテレータ変数に渡す文字列 + # tcl/tk の bind コマンドではパラメータを受け取るために % 置換を + # 用いるが, pr の内部で % を書いてもうまくいかない. + # arg に文字列を書いておくと, その置換結果を, pr で + # イテレータ変数を通して受け取ることができる. + # scrollbar コマンドの -command オプションのように + # 何も指定しなくてもパラメータが付くコマンドに対しては, + # arg を指定してはならない. + def initialize(interp, pr, arg = nil) + # tcl/tk での表現形(変数名)を自動生成する. + exp = TclTk._newname("c_") + # TclTkObject を初期化する. + super(interp._tcltkip(), exp) + # パラメータをとっておく. + @pr = pr + @arg = arg + # モジュールに登録しておく. + TclTk._addcallback(self) + end + + # to_eval(): @ip._eval_args で評価するときの表現形(String)を返す. + def to_eval() + if @arg + # %s は ruby_fmt より前に bind により置換されてしまうので + # %%s としてある. したがって, これは bind 専用. + s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%%s")} #{@arg}}/ + else + s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%s")}}/ + end + + return s + end + + # _call(arg): コールバックを呼び出す. + # arg: コールバックに渡されるパラメータ + def _call(arg) + @pr.call(arg) + end +end + +# class TclTkImage: tcl/tk のイメージ +class TclTkImage < TclTkCommand + + # initialize(interp, t, *args): 初期化. + # イメージの生成は TclTkImage.new() で行うが, + # 破壊は image delete で行う. (いまいちだけど仕方が無い.) + # interp: インタプリタ(TclTkInterpreter) + # t: イメージのタイプ (photo, bitmap, etc.) + # *args: コマンドの引数 + def initialize(interp, t, *args) + # tcl/tk での表現形(変数名)を自動生成する. + exp = TclTk._newname("i_") + # TclTkObject を初期化する. + super(interp._tcltkip(), exp) + # イメージを生成する. + res = @ip._eval_args("image create", t, exp, *args) + fail("can't create Image") if res != exp + end +end + +# eof |