diff options
Diffstat (limited to 'ruby_1_8_6/ext/tk/lib/tcltk.rb')
| -rw-r--r-- | ruby_1_8_6/ext/tk/lib/tcltk.rb | 367 |
1 files changed, 367 insertions, 0 deletions
diff --git a/ruby_1_8_6/ext/tk/lib/tcltk.rb b/ruby_1_8_6/ext/tk/lib/tcltk.rb new file mode 100644 index 0000000000..1a6694dbff --- /dev/null +++ b/ruby_1_8_6/ext/tk/lib/tcltk.rb @@ -0,0 +1,367 @@ +# tof + +#### tcltk library, more direct manipulation of tcl/tk +#### Sep. 5, 1997 Y. Shigehiro + +require "tcltklib" + +################ + +# module TclTk: collection of tcl/tk utilities (supplies namespace.) +module TclTk + + # initialize Hash to hold unique symbols and such + @namecnt = {} + + # initialize Hash to hold callbacks + @callback = {} +end + +# TclTk.mainloop(): call TclTkLib.mainloop() +def TclTk.mainloop() + print("mainloop: start\n") if $DEBUG + TclTkLib.mainloop() + print("mainloop: end\n") if $DEBUG +end + +# TclTk.deletecallbackkey(ca): remove callback from TclTk module +# this does not remove callbacks from tcl/tk interpreter +# without calling this method, TclTkInterpreter will not be GCed +# ca: callback(TclTkCallback) +def TclTk.deletecallbackkey(ca) + print("deletecallbackkey: ", ca.to_s(), "\n") if $DEBUG + @callback.delete(ca.to_s) +end + +# TclTk.dcb(ca, wid, W): call TclTk.deletecallbackkey() for each callbacks +# in an array. +# this is for callback for top-level <Destroy> +# ca: array of callbacks(TclTkCallback) +# wid: top-level widget(TclTkWidget) +# w: information about window given by %W(String) +def TclTk.dcb(ca, wid, w) + if wid.to_s() == w + ca.each{|i| + TclTk.deletecallbackkey(i) + } + end +end + +# TclTk._addcallback(ca): register callback +# ca: callback(TclTkCallback) +def TclTk._addcallback(ca) + print("_addcallback: ", ca.to_s(), "\n") if $DEBUG + @callback[ca.to_s()] = ca +end + +# TclTk._callcallback(key, arg): invoke registered callback +# key: key to select callback (to_s value of the TclTkCallback) +# arg: parameter from tcl/tk interpreter +def TclTk._callcallback(key, arg) + print("_callcallback: ", @callback[key].inspect, "\n") if $DEBUG + @callback[key]._call(arg) + # throw out callback value + # should return String to satisfy rb_eval_string() + return "" +end + +# TclTk._newname(prefix): generate unique name(String) +# prefix: prefix of the unique name +def TclTk._newname(prefix) + # generated name counter is stored in @namecnt + if !@namecnt.key?(prefix) + # first appearing prefix, initialize + @namecnt[prefix] = 1 + else + # already appeared prefix, generate next name + @namecnt[prefix] += 1 + end + return "#{prefix}#{@namecnt[prefix]}" +end + +################ + +# class TclTkInterpreter: tcl/tk interpreter +class TclTkInterpreter + + # initialize(): + def initialize() + # generate interpreter object + @ip = TclTkIp.new() + + # add ruby_fmt command to tcl interpreter + # ruby_fmt command format arguments by `format' and call `ruby' command + # (notice ruby command receives only one argument) + if $DEBUG + @ip._eval("proc ruby_fmt {fmt args} { puts \"ruby_fmt: $fmt $args\" ; set cmd [list ruby [format $fmt $args]] ; uplevel $cmd }") + else + @ip._eval("proc ruby_fmt {fmt args} { set cmd [list ruby [format $fmt $args]] ; uplevel $cmd }") + end + + # @ip._get_eval_string(*args): generate string to evaluate in tcl interpreter + # *args: script which is going to be evaluated under tcl/tk + def @ip._get_eval_string(*args) + argstr = "" + args.each{|arg| + argstr += " " if argstr != "" + # call to_eval if it is defined + if (arg.respond_to?(:to_eval)) + argstr += arg.to_eval() + else + # call to_s unless defined + argstr += arg.to_s() + end + } + return argstr + end + + # @ip._eval_args(*args): evaluate string under tcl/tk interpreter + # returns result string. + # *args: script which is going to be evaluated under tcl/tk + def @ip._eval_args(*args) + # calculate the string to eval in the interpreter + argstr = _get_eval_string(*args) + + # evaluate under the interpreter + 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 + + # generate tcl/tk command object and register in the hash + @commands = {} + # for all commands registered in tcl/tk interpreter: + @ip._eval("info command").split(/ /).each{|comname| + if comname =~ /^[.]/ + # if command is a widget (path), generate TclTkWidget, + # and register it in the hash + @commands[comname] = TclTkWidget.new(@ip, comname) + else + # otherwise, generate TclTkCommand + @commands[comname] = TclTkCommand.new(@ip, comname) + end + } + end + + # commands(): returns hash of the tcl/tk commands + def commands() + return @commands + end + + # rootwidget(): returns root widget(TclTkWidget) + def rootwidget() + return @commands["."] + end + + # _tcltkip(): returns @ip(TclTkIp) + def _tcltkip() + return @ip + end + + # method_missing(id, *args): execute undefined method as tcl/tk command + # id: method symbol + # *args: method arguments + def method_missing(id, *args) + # if command named by id registered, then execute it + if @commands.key?(id.id2name) + return @commands[id.id2name].e(*args) + else + # otherwise, exception + super + end + end +end + +# class TclTkObject: base class of the tcl/tk objects +class TclTkObject + + # initialize(ip, exp): + # ip: interpreter(TclTkIp) + # exp: tcl/tk representation + def initialize(ip, exp) + fail("type is not TclTkIp") if !ip.kind_of?(TclTkIp) + @ip = ip + @exp = exp + end + + # to_s(): returns tcl/tk representation + def to_s() + return @exp + end +end + +# class TclTkCommand: tcl/tk commands +# you should not call TclTkCommand.new() +# commands are created by TclTkInterpreter:initialize() +class TclTkCommand < TclTkObject + + # e(*args): execute command. returns String (e is for exec or eval) + # *args: command arguments + def e(*args) + return @ip._eval_args(to_s(), *args) + end +end + +# class TclTkLibCommand: tcl/tk commands in the library +class TclTkLibCommand < TclTkCommand + + # initialize(ip, name): + # ip: interpreter(TclTkInterpreter) + # name: command name (String) + def initialize(ip, name) + super(ip._tcltkip, name) + end +end + +# class TclTkVariable: tcl/tk variable +class TclTkVariable < TclTkObject + + # initialize(interp, dat): + # interp: interpreter(TclTkInterpreter) + # dat: the value to set(String) + # if nil, not initialize variable + def initialize(interp, dat) + # auto-generate tcl/tk representation (variable name) + exp = TclTk._newname("v_") + # initialize TclTkObject + super(interp._tcltkip(), exp) + # safe this for `set' command + @set = interp.commands()["set"] + # set value + set(dat) if dat + end + + # although you can set/refer variable by using set in tcl/tk, + # we provide the method for accessing variables + + # set(data): set tcl/tk variable using `set' + # data: new value + def set(data) + @set.e(to_s(), data.to_s()) + end + + # get(): read tcl/tk variable(String) using `set' + def get() + return @set.e(to_s()) + end +end + +# class TclTkWidget: tcl/tk widget +class TclTkWidget < TclTkCommand + + # initialize(*args): + # *args: parameters + def initialize(*args) + if args[0].kind_of?(TclTkIp) + # in case the 1st argument is TclTkIp: + + # Wrap tcl/tk widget by TclTkWidget + # (used in TclTkInterpreter#initialize()) + + # need two arguments + fail("illegal # of parameter") if args.size != 2 + + # ip: interpreter(TclTkIp) + # exp: tcl/tk representation + ip, exp = args + + # initialize TclTkObject + super(ip, exp) + elsif args[0].kind_of?(TclTkInterpreter) + # in case 1st parameter is TclTkInterpreter: + + # generate new widget from parent widget + + # interp: interpreter(TclTkInterpreter) + # parent: parent widget + # command: widget generating tk command(label Εω) + # *args: argument to the command + interp, parent, command, *args = args + + # generate widget name + exp = parent.to_s() + exp += "." if exp !~ /[.]$/ + exp += TclTk._newname("w_") + # initialize TclTkObject + super(interp._tcltkip(), exp) + # generate widget + res = @ip._eval_args(command, exp, *args) +# fail("can't create Widget") if res != exp + # for tk_optionMenu, it is legal res != exp + else + fail("first parameter is not TclTkInterpreter") + end + end +end + +# class TclTkCallback: tcl/tk callbacks +class TclTkCallback < TclTkObject + + # initialize(interp, pr, arg): + # interp: interpreter(TclTkInterpreter) + # pr: callback procedure(Proc) + # arg: string to pass as block parameters of pr + # bind command of tcl/tk uses % replacement for parameters + # pr can receive replaced data using block parameter + # its format is specified by arg string + # You should not specify arg for the command like + # scrollbar with -command option, which receives parameters + # without specifying any replacement + def initialize(interp, pr, arg = nil) + # auto-generate tcl/tk representation (variable name) + exp = TclTk._newname("c_") + # initialize TclTkObject + super(interp._tcltkip(), exp) + # save parameters + @pr = pr + @arg = arg + # register in the module + TclTk._addcallback(self) + end + + # to_eval(): retuens string representation for @ip._eval_args + def to_eval() + if @arg + # bind replaces %s before calling ruby_fmt, so %%s is used + 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): invoke callback + # arg: callback parameter + def _call(arg) + @pr.call(arg) + end +end + +# class TclTkImage: tcl/tk images +class TclTkImage < TclTkCommand + + # initialize(interp, t, *args): + # generating image is done by TclTkImage.new() + # destrying is done by image delete (inconsistent, sigh) + # interp: interpreter(TclTkInterpreter) + # t: image type (photo, bitmap, etc.) + # *args: command argument + def initialize(interp, t, *args) + # auto-generate tcl/tk representation + exp = TclTk._newname("i_") + # initialize TclTkObject + super(interp._tcltkip(), exp) + # generate image + res = @ip._eval_args("image create", t, exp, *args) + fail("can't create Image") if res != exp + end +end + +# eof |