diff options
author | yugui <yugui@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 2008-08-25 15:02:05 +0000 |
---|---|---|
committer | yugui <yugui@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 2008-08-25 15:02:05 +0000 |
commit | 0dc342de848a642ecce8db697b8fecd83a63e117 (patch) | |
tree | 2b7ed4724aff1f86073e4740134bda9c4aac1a39 /trunk/ext/tk/lib/tkextlib/tile/style.rb | |
parent | ef70cf7138ab8034b5b806f466e4b484b24f0f88 (diff) |
added tag v1_9_0_4
git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/tags/v1_9_0_4@18845 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'trunk/ext/tk/lib/tkextlib/tile/style.rb')
-rw-r--r-- | trunk/ext/tk/lib/tkextlib/tile/style.rb | 316 |
1 files changed, 316 insertions, 0 deletions
diff --git a/trunk/ext/tk/lib/tkextlib/tile/style.rb b/trunk/ext/tk/lib/tkextlib/tile/style.rb new file mode 100644 index 0000000000..ca7ee99c32 --- /dev/null +++ b/trunk/ext/tk/lib/tkextlib/tile/style.rb @@ -0,0 +1,316 @@ +# +# 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 |