# # 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 imcompatible changes # depend on the version of the extention. 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) 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_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