summaryrefslogtreecommitdiff
path: root/ext/tcltklib/lib/tcltk.rb
diff options
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/tcltk.rb
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/tcltk.rb')
-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 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 [email protected]?(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