summaryrefslogtreecommitdiff
path: root/ext/tcltklib/lib
diff options
context:
space:
mode:
authormatz <matz@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>1998-01-16 12:19:09 +0000
committermatz <matz@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>1998-01-16 12:19:09 +0000
commit62e41d3f2e48422bbdf1bb2db83ae60b255b1a1a (patch)
tree4d0edb1c1986e1578b181ebe2441acfee27f1fab /ext/tcltklib/lib
parent3db12e8b236ac8f88db8eb4690d10e4a3b8dbcd4 (diff)
Initial revision
git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@8 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'ext/tcltklib/lib')
-rw-r--r--ext/tcltklib/lib/tcltk.rb388
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 0000000..81d01f9
--- /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