summaryrefslogtreecommitdiff
path: root/jni/ruby/ext/tk/lib/tkextlib/tile/style.rb
blob: 83a0c9a2e8b0356af05149959542e5add04c0c96 (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
#
#  style commands
#                               by Hidetoshi NAGAI (nagai@ai.kyutech.ac.jp)
#
require 'tk'
require 'tkextlib/tile.rb'

module Tk
  module Tile
    module Style
    end
  end
end

module Tk::Tile::Style
  extend TkCore
end

class << Tk::Tile::Style
  if Tk::Tile::TILE_SPEC_VERSION_ID < 8
    TkCommandNames = ['style'.freeze].freeze

    # --- Tk::Tile::Style.__define_wrapper_proc_for_compatibility__! ---
    # On Ttk (Tile) extension, 'style' command has incompatible changes
    # depend on the version of the extension. It requires modifying the
    # Tcl/Tk scripts to define local styles. The rule for modification
    # is a simple one. But, if users want to keep compatibility between
    # versions of the extension, they will have to contrive to do that.
    # It may be troublesome, especially for Ruby/Tk users.
    # This method may help such work. This method make some definitions
    # on the Tcl/Tk interpreter to work with different version of style
    # command format. Please give attention to use this method. It may
    # conflict with some definitions on Tcl/Tk scripts.
    if Tk::Tile::TILE_SPEC_VERSION_ID < 7
      def __define_wrapper_proc_for_compatibility__!
        __define_themes_and_setTheme_proc__!

        unless Tk.info(:commands, '::ttk::style').empty?
          # fail RuntimeError,
          #      "can't define '::ttk::style' command (already exist)"

          # do nothing !!!
          warn "Warning: can't define '::ttk::style' command (already exist)" if $DEBUG
          return
        end
        TkCore::INTERP.add_tk_procs('::ttk::style', 'args', <<-'EOS')
        if [string equal [lrange $args 0 1] {element create}] {
          if [string equal [lindex $args 3] image] {
            set spec [lindex $args 4]
            set map  [lrange $spec 1 end]
            if [llength $map] {
              # return [eval [concat [list ::style element create [lindex $args 2] image [lindex $spec 0] -map $map] [lrange $args 5 end]]]
              return [uplevel 1 [list ::style element create [lindex $args 2] image [lindex $spec 0] -map $map] [lrange $args 5 end]]
            }
          }
        }
        # return [eval "::style $args"]
        return [uplevel 1 ::style $args]
      EOS
        #########################
      end
    else ### TILE_SPEC_VERSION_ID == 7
      def __define_wrapper_proc_for_compatibility__!
        __define_themes_and_setTheme_proc__!

        unless Tk.info(:commands, '::ttk::style').empty?
          # fail RuntimeError,
          #     "can't define '::ttk::style' command (already exist)"

          # do nothing !!!
          warn "Warning: can't define '::ttk::style' command (already exist)" if $DEBUG
          return
        end
        TkCore::INTERP.add_tk_procs('::ttk::style', 'args', <<-'EOS')
        if [string equal [lrange $args 0 1] {element create}] {
          if [string equal [lindex $args 3] image] {
            set spec [lindex $args 4]
            set map  [lrange $spec 1 end]
            if [llength $map] {
              # return [eval [concat [list ::style element create [lindex $args 2] image [lindex $spec 0] -map $map] [lrange $args 5 end]]]
              return [uplevel 1 [list ::style element create [lindex $args 2] image [lindex $spec 0] -map $map] [lrange $args 5 end]]]
            }
          }
        } elseif [string equal [lindex $args 0] default] {
          # return [eval "::style [lreplace $args 0 0 configure]"]
          return [uplevel 1 ::style [lreplace $args 0 0 configure]]
        }
        # return [eval "::style $args"]
        return [uplevel 1 ::style $args]
      EOS
        #########################
      end
    end
  else ### TILE_SPEC_VERSION_ID >= 8
    TkCommandNames = ['::ttk::style'.freeze].freeze

    def __define_wrapper_proc_for_compatibility__!
      __define_themes_and_setTheme_proc__!

      unless Tk.info(:commands, '::style').empty?
        # fail RuntimeError, "can't define '::style' command (already exist)"

        # do nothing !!!
        warn "Warning: can't define '::style' command (already exist)" if $DEBUG
        return
      end
      TkCore::INTERP.add_tk_procs('::style', 'args', <<-'EOS')
        if [string equal [lrange $args 0 1] {element create}] {
          if [string equal [lindex $args 3] image] {
            set name [lindex $args 4]
            set opts [lrange $args 5 end]
            set idx [lsearch $opts -map]
            if {$idx >= 0 && [expr $idx % 2 == 0]} {
             # return [eval [concat [list ::ttk::style element create [lindex $args 2] image [concat $name [lindex $opts [expr $idx + 1]]]] [lreplace $opts $idx [expr $idx + 1]]]]
              return [uplevel 1 [list ::ttk::style element create [lindex $args 2] image [concat $name [lindex $opts [expr $idx + 1]]]] [lreplace $opts $idx [expr $idx + 1]]]
            }
          }
        } elseif [string equal [lindex $args 0] default] {
          # return [eval "::ttk::style [lreplace $args 0 0 configure]"]
          return [uplevel 1 ::ttk::style [lreplace $args 0 0 configure]]
        }
        # return [eval "::ttk::style $args"]
        return [uplevel 1 ::ttk::style $args]
      EOS
      #########################
    end
  end

  def __define_themes_and_setTheme_proc__!
    TkCore::INTERP.add_tk_procs('::ttk::themes', '{ptn *}', <<-'EOS')
      #set themes [list]
      set themes [::ttk::style theme names]
      foreach pkg [lsearch -inline -all -glob [package names] ttk::theme::$ptn] {
          set theme [namespace tail $pkg]
          if {[lsearch -exact $themes $theme] < 0} {
              lappend themes $theme
          }
      }
      foreach pkg [lsearch -inline -all -glob [package names] tile::theme::$ptn] {
          set theme [namespace tail $pkg]
          if {[lsearch -exact $themes $theme] < 0} {
              lappend themes $theme
          }
      }
      return $themes
    EOS
    #########################
    TkCore::INTERP.add_tk_procs('::ttk::setTheme', 'theme', <<-'EOS')
      variable currentTheme
      if {[lsearch -exact [::ttk::style theme names] $theme] < 0} {
          package require [lsearch -inline -regexp [package names] (ttk|tile)::theme::$theme]
      }
      ::ttk::style theme use $theme
      set currentTheme $theme
    EOS
  end
  private :__define_themes_and_setTheme_proc__!

  def configure(style=nil, keys=nil)
    if style.kind_of?(Hash)
      keys = style
      style = nil
    end
    style = '.' unless style

    if Tk::Tile::TILE_SPEC_VERSION_ID < 7
      sub_cmd = 'default'
    else
      sub_cmd = 'configure'
    end

    if keys && keys != None
      tk_call(TkCommandNames[0], sub_cmd, style, *hash_kv(keys))
    else
      tk_call(TkCommandNames[0], sub_cmd, style)
    end
  end
  alias default configure

  def map(style=nil, keys=nil)
    if style.kind_of?(Hash)
      keys = style
      style = nil
    end
    style = '.' unless style

    if keys && keys != None
      if keys.kind_of?(Hash)
        tk_call(TkCommandNames[0], 'map', style, *hash_kv(keys))
      else
        simplelist(tk_call(TkCommandNames[0], 'map', style, '-' << keys.to_s))
      end
    else
      ret = {}
      Hash[*(simplelist(tk_call(TkCommandNames[0], 'map', style)))].each{|k, v|
        ret[k[1..-1]] = list(v)
      }
      ret
    end
  end
  alias map_configure map

  def map_configinfo(style=nil, key=None)
    style = '.' unless style
    map(style, key)
  end

  def map_default_configinfo(key=None)
    map('.', key)
  end

  def lookup(style, opt, state=None, fallback_value=None)
    tk_call(TkCommandNames[0], 'lookup', style,
            '-' << opt.to_s, state, fallback_value)
  end

  include Tk::Tile::ParseStyleLayout

  def layout(style=nil, spec=nil)
    if style.kind_of?(Hash)
      spec = style
      style = nil
    end
    style = '.' unless style

    if spec
      tk_call(TkCommandNames[0], 'layout', style, spec)
    else
      _style_layout(list(tk_call(TkCommandNames[0], 'layout', style)))
    end
  end

  def element_create(name, type, *args)
    if type == 'image' || type == :image
      element_create_image(name, *args)
    elsif type == 'vsapi' || type == :vsapi
      element_create_vsapi(name, *args)
    else
      tk_call(TkCommandNames[0], 'element', 'create', name, type, *args)
    end
  end

  def element_create_image(name, *args)
    fail ArgumentError, 'Must supply a base image' unless (spec = args.shift)
    if (opts = args.shift)
      if opts.kind_of?(Hash)
        opts = _symbolkey2str(opts)
      else
        fail ArgumentError, 'bad option'
      end
    end
    fail ArgumentError, 'too many arguments' unless args.empty?

    if spec.kind_of?(Array)
      # probably, command format is tile 0.8+ (Tcl/Tk8.5+) style
      if Tk::Tile::TILE_SPEC_VERSION_ID >= 8
        if opts
          tk_call(TkCommandNames[0],
                  'element', 'create', name, 'image', spec, opts)
        else
          tk_call(TkCommandNames[0], 'element', 'create', name, 'image', spec)
        end
      else
        fail ArgumentError, 'illegal arguments' if opts.key?('map')
        base = spec.shift
        opts['map'] = spec
        tk_call(TkCommandNames[0],
                'element', 'create', name, 'image', base, opts)
      end
    else
      # probably, command format is tile 0.7.8 or older style
      if Tk::Tile::TILE_SPEC_VERSION_ID >= 8
        spec = [spec, *(opts.delete('map'))] if opts.key?('map')
      end
      if opts
        tk_call(TkCommandNames[0],
                'element', 'create', name, 'image', spec, opts)
      else
        tk_call(TkCommandNames[0], 'element', 'create', name, 'image', spec)
      end
    end
  end

  def element_create_vsapi(name, class_name, part_id, *args)
    # supported on Tcl/Tk 8.6 or later

    # argument check
    if (state_map = args.shift || None)
      if state_map.kind_of?(Hash)
        opts = _symbolkey2str(state_map)
        state_map = None
      end
    end
    opts = args.shift || None
    fail ArgumentError, "too many arguments" unless args.empty?

    # define a Microsoft Visual Styles element
    tk_call(TkCommandNames[0], 'element', 'create', name, 'vsapi',
            class_name, part_id, state_map, opts)
  end

  def element_names()
    list(tk_call(TkCommandNames[0], 'element', 'names'))
  end

  def element_options(elem)
    simplelist(tk_call(TkCommandNames[0], 'element', 'options', elem))
  end

  def theme_create(name, keys=nil)
    name = name.to_s
    if keys && keys != None
      tk_call(TkCommandNames[0], 'theme', 'create', name, *hash_kv(keys))
    else
      tk_call(TkCommandNames[0], 'theme', 'create', name)
    end
    name
  end

  def theme_settings(name, cmd=nil, &b)
    name = name.to_s
    cmd = Proc.new(&b) if !cmd && b
    tk_call(TkCommandNames[0], 'theme', 'settings', name, cmd)
    name
  end

  def theme_names()
    list(tk_call(TkCommandNames[0], 'theme', 'names'))
  end

  def theme_use(name)
    name = name.to_s
    tk_call(TkCommandNames[0], 'theme', 'use', name)
    name
  end
end