summaryrefslogtreecommitdiff
path: root/ext/tk/lib/tcltk.rb
blob: 121f42c26edfd43f76e52cece38aff81374d51e4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
# frozen_string_literal: false
# 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/read variables 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("invalid # 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
      return res
    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(): returns 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()
  #     destroying 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