DEFINITIONS
This source file includes following functions.
1 # tof
2
3 #### tcltk library, more direct manipulation of tcl/tk
4 #### Sep. 5, 1997 Y. Shigehiro
5
6 require "tcltklib"
7
8 ################
9
10 # module TclTk: collection of tcl/tk utilities (supplies namespace.)
11 module TclTk
12
13 # initialize Hash to hold unique symbols and such
14 @namecnt = {}
15
16 # initialize Hash to hold callbacks
17 @callback = {}
18 end
19
20 # TclTk.mainloop(): call TclTkLib.mainloop()
21 def TclTk.mainloop()
22 print("mainloop: start\n") if $DEBUG
23 TclTkLib.mainloop()
24 print("mainloop: end\n") if $DEBUG
25 end
26
27 # TclTk.deletecallbackkey(ca): remove callback from TclTk module
28 # this does not remove callbacks from tcl/tk interpreter
29 # without calling this method, TclTkInterpreter will not be GCed
30 # ca: callback(TclTkCallback)
31 def TclTk.deletecallbackkey(ca)
32 print("deletecallbackkey: ", ca.to_s(), "\n") if $DEBUG
33 @callback.delete(ca.to_s)
34 end
35
36 # TclTk.dcb(ca, wid, W): call TclTk.deletecallbackkey() for each callbacks
37 # in an array.
38 # this is for callback for top-level <Destroy>
39 # ca: array of callbacks(TclTkCallback)
40 # wid: top-level widget(TclTkWidget)
41 # w: information about window given by %W(String)
42 def TclTk.dcb(ca, wid, w)
43 if wid.to_s() == w
44 ca.each{|i|
45 TclTk.deletecallbackkey(i)
46 }
47 end
48 end
49
50 # TclTk._addcallback(ca): register callback
51 # ca: callback(TclTkCallback)
52 def TclTk._addcallback(ca)
53 print("_addcallback: ", ca.to_s(), "\n") if $DEBUG
54 @callback[ca.to_s()] = ca
55 end
56
57 # TclTk._callcallback(key, arg): invoke registered callback
58 # key: key to select callback (to_s value of the TclTkCallback)
59 # arg: parameter from tcl/tk interpreter
60 def TclTk._callcallback(key, arg)
61 print("_callcallback: ", @callback[key].inspect, "\n") if $DEBUG
62 @callback[key]._call(arg)
63 # throw out callback value
64 # should return String to satisfy rb_eval_string()
65 return ""
66 end
67
68 # TclTk._newname(prefix): generate unique name(String)
69 # prefix: prefix of the unique name
70 def TclTk._newname(prefix)
71 # generated name counter is stored in @namecnt
72 if !@namecnt.key?(prefix)
73 # first appearing prefix, initialize
74 @namecnt[prefix] = 1
75 else
76 # already appeared prefix, generate next name
77 @namecnt[prefix] += 1
78 end
79 return "#{prefix}#{@namecnt[prefix]}"
80 end
81
82 ################
83
84 # class TclTkInterpreter: tcl/tk interpreter
85 class TclTkInterpreter
86
87 # initialize():
88 def initialize()
89 # generate interpreter object
90 @ip = TclTkIp.new()
91
92 # add ruby_fmt command to tcl interpreter
93 # ruby_fmt command format arguments by `format' and call `ruby' command
94 # (notice ruby command receives only one argument)
95 if $DEBUG
96 @ip._eval("proc ruby_fmt {fmt args} { puts \"ruby_fmt: $fmt $args\" ; ruby [format $fmt $args] }")
97 else
98 @ip._eval("proc ruby_fmt {fmt args} { ruby [format $fmt $args] }")
99 end
100
101 # @ip._get_eval_string(*args): generate string to evaluate in tcl interpreter
102 # *args: script which is going to be evaluated under tcl/tk
103 def @ip._get_eval_string(*args)
104 argstr = ""
105 args.each{|arg|
106 argstr += " " if argstr != ""
107 # call to_eval if it is defined
108 if (arg.respond_to?(:to_eval))
109 argstr += arg.to_eval()
110 else
111 # call to_s unless defined
112 argstr += arg.to_s()
113 end
114 }
115 return argstr
116 end
117
118 # @ip._eval_args(*args): evaluate string under tcl/tk interpreter
119 # returns result string.
120 # *args: script which is going to be evaluated under tcl/tk
121 def @ip._eval_args(*args)
122 # calculate the string to eval in the interpreter
123 argstr = _get_eval_string(*args)
124
125 # evaluate under the interpreter
126 print("_eval: \"", argstr, "\"") if $DEBUG
127 res = _eval(argstr)
128 if $DEBUG
129 print(" -> \"", res, "\"\n")
130 elsif _return_value() != 0
131 print(res, "\n")
132 end
133 fail(%Q/can't eval "#{argstr}"/) if _return_value() != 0 #'
134 return res
135 end
136
137 # generate tcl/tk command object and register in the hash
138 @commands = {}
139 # for all commands registered in tcl/tk interpreter:
140 @ip._eval("info command").split(/ /).each{|comname|
141 if comname =~ /^[.]/
142 # if command is a widget (path), generate TclTkWidget,
143 # and register it in the hash
144 @commands[comname] = TclTkWidget.new(@ip, comname)
145 else
146 # otherwise, generate TclTkCommand
147 @commands[comname] = TclTkCommand.new(@ip, comname)
148 end
149 }
150 end
151
152 # commands(): returns hash of the tcl/tk commands
153 def commands()
154 return @commands
155 end
156
157 # rootwidget(): returns root widget(TclTkWidget)
158 def rootwidget()
159 return @commands["."]
160 end
161
162 # _tcltkip(): returns @ip(TclTkIp)
163 def _tcltkip()
164 return @ip
165 end
166
167 # method_missing(id, *args): execute undefined method as tcl/tk command
168 # id: method symbol
169 # *args: method arguments
170 def method_missing(id, *args)
171 # if command named by id registered, then execute it
172 if @commands.key?(id.id2name)
173 return @commands[id.id2name].e(*args)
174 else
175 # otherwise, exception
176 super
177 end
178 end
179 end
180
181 # class TclTkObject: base class of the tcl/tk objects
182 class TclTkObject
183
184 # initialize(ip, exp):
185 # ip: interpreter(TclTkIp)
186 # exp: tcl/tk representation
187 def initialize(ip, exp)
188 fail("type is not TclTkIp") if !ip.kind_of?(TclTkIp)
189 @ip = ip
190 @exp = exp
191 end
192
193 # to_s(): returns tcl/tk representation
194 def to_s()
195 return @exp
196 end
197 end
198
199 # class TclTkCommand: tcl/tk commands
200 # you should not call TclTkCommand.new()
201 # commands are created by TclTkInterpreter:initialize()
202 class TclTkCommand < TclTkObject
203
204 # e(*args): execute command. returns String (e is for exec or eval)
205 # *args: command arguments
206 def e(*args)
207 return @ip._eval_args(to_s(), *args)
208 end
209 end
210
211 # class TclTkLibCommand: tcl/tk commands in the library
212 class TclTkLibCommand < TclTkCommand
213
214 # initialize(ip, name):
215 # ip: interpreter(TclTkInterpreter)
216 # name: command name (String)
217 def initialize(ip, name)
218 super(ip._tcltkip, name)
219 end
220 end
221
222 # class TclTkVariable: tcl/tk variable
223 class TclTkVariable < TclTkObject
224
225 # initialize(interp, dat):
226 # interp: interpreter(TclTkInterpreter)
227 # dat: the value to set(String)
228 # if nil, not initialize variable
229 def initialize(interp, dat)
230 # auto-generate tcl/tk representation (variable name)
231 exp = TclTk._newname("v_")
232 # initialize TclTkObject
233 super(interp._tcltkip(), exp)
234 # safe this for `set' command
235 @set = interp.commands()["set"]
236 # set value
237 set(dat) if dat
238 end
239
240 # although you can set/refer variable by using set in tcl/tk,
241 # we provide the method for accessing variables
242
243 # set(data): set tcl/tk variable using `set'
244 # data: new value
245 def set(data)
246 @set.e(to_s(), data.to_s())
247 end
248
249 # get(): read tcl/tk variable(String) using `set'
250 def get()
251 return @set.e(to_s())
252 end
253 end
254
255 # class TclTkWidget: tcl/tk widget
256 class TclTkWidget < TclTkCommand
257
258 # initialize(*args):
259 # *args: parameters
260 def initialize(*args)
261 if args[0].kind_of?(TclTkIp)
262 # in case the 1st argument is TclTkIp:
263
264 # Wrap tcl/tk widget by TclTkWidget
265 # (used in TclTkInterpreter#initialize())
266
267 # need two arguments
268 fail("illegal # of parameter") if args.size != 2
269
270 # ip: interpreter(TclTkIp)
271 # exp: tcl/tk representation
272 ip, exp = args
273
274 # initialize TclTkObject
275 super(ip, exp)
276 elsif args[0].kind_of?(TclTkInterpreter)
277 # in case 1st parameter is TclTkInterpreter:
278
279 # generate new widget from parent widget
280
281 # interp: interpreter(TclTkInterpreter)
282 # parent: parent widget
283 # command: widget generating tk command(label Εω)
284 # *args: argument to the command
285 interp, parent, command, *args = args
286
287 # generate widget name
288 exp = parent.to_s()
289 exp += "." if exp !~ /[.]$/
290 exp += TclTk._newname("w_")
291 # initialize TclTkObject
292 super(interp._tcltkip(), exp)
293 # generate widget
294 res = @ip._eval_args(command, exp, *args)
295 # fail("can't create Widget") if res != exp
296 # for tk_optionMenu, it is legal res != exp
297 else
298 fail("first parameter is not TclTkInterpreter")
299 end
300 end
301 end
302
303 # class TclTkCallback: tcl/tk callbacks
304 class TclTkCallback < TclTkObject
305
306 # initialize(interp, pr, arg):
307 # interp: interpreter(TclTkInterpreter)
308 # pr: callback procedure(Proc)
309 # arg: string to pass as block parameters of pr
310 # bind command of tcl/tk uses % replacement for parameters
311 # pr can receive replaced data using block parameter
312 # its format is specified by arg string
313 # You should not specify arg for the command like
314 # scrollbar with -command option, which receives parameters
315 # without specifying any replacement
316 def initialize(interp, pr, arg = nil)
317 # auto-generate tcl/tk representation (variable name)
318 exp = TclTk._newname("c_")
319 # initialize TclTkObject
320 super(interp._tcltkip(), exp)
321 # save parameters
322 @pr = pr
323 @arg = arg
324 # register in the module
325 TclTk._addcallback(self)
326 end
327
328 # to_eval(): retuens string representation for @ip._eval_args
329 def to_eval()
330 if @arg
331 # bind replaces %s before calling ruby_fmt, so %%s is used
332 s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%%s")} #{@arg}}/
333 else
334 s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%s")}}/
335 end
336
337 return s
338 end
339
340 # _call(arg): invoke callback
341 # arg: callback parameter
342 def _call(arg)
343 @pr.call(arg)
344 end
345 end
346
347 # class TclTkImage: tcl/tk images
348 class TclTkImage < TclTkCommand
349
350 # initialize(interp, t, *args):
351 # generating image is done by TclTkImage.new()
352 # destrying is done by image delete (inconsistent, sigh)
353 # interp: interpreter(TclTkInterpreter)
354 # t: image type (photo, bitmap, etc.)
355 # *args: command argument
356 def initialize(interp, t, *args)
357 # auto-generate tcl/tk representation
358 exp = TclTk._newname("i_")
359 # initialize TclTkObject
360 super(interp._tcltkip(), exp)
361 # generate image
362 res = @ip._eval_args("image create", t, exp, *args)
363 fail("can't create Image") if res != exp
364 end
365 end
366
367 # eof