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

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