* renewal Ruby/Tk

git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@6237 b2dd03c8-39d4-4d8f-98ff-823fe69b080e

1 files changed, 318 insertions, 27 deletions

diff --git a/ext/tk/sample/demos-en/widget b/ext/tk/sample/demos-en/widget
index aa702883de..f529792e78 100644
--- a/ext/tk/sample/demos-en/widget
+++ b/ext/tk/sample/demos-en/widget
@@ -10,12 +10,7 @@
 # as needed.
 
 require 'tk'
-
-#unless /^8\.[1-9]/ =~ Tk::TCL_VERSION && !Tk::JAPANIZED_TK
-#  require 'tkencoding'
-#end
-
-require 'tkafter'
+# require 'tkafter'
 
 ### $DEBUG=1 ##########
 
@@ -33,12 +28,78 @@ $root = TkRoot.new{title "Ruby/Tk Widget Demonstration"}
 
 # tk 
 $tk_version = Tk::TK_VERSION
+$tk_major_ver, $tk_minor_ver = $tk_version.split('.').map{|n| n.to_i}
+$tk_patchlevel = Tk::TK_PATCHLEVEL
 
 # tcl_platform 
 $tk_platform = TkVarAccess.new('tcl_platform')
 
 #
-$font = TkFont.new('-*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-*', nil)
+case($tk_version)
+when /^4.*/
+  $font = TkFont.new('-*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-*', nil)
+else
+  $font = TkFont.new('Helvetica -12')
+end
+
+# images
+$image = {}
+
+if $tk_major_ver >= 8
+$image['refresh'] = TkPhotoImage.new(:height=>16, :format=>'GIF', :data=><<EOD)
+    R0lGODlhEAAQAPMAAMz/zCpnKdb/1z9mPypbKBtLGy9NMPL/9Or+6+P+4j1Y
+    PwQKBP7//xMLFAYBCAEBASH5BAEAAAAALAAAAAAQABAAAwR0EAD3Gn0Vyw0e
+    ++CncU7IIAezMA/nhUqSLJizvSdCEEjy2ZIV46AwDAoDHwPYGSoEiUJAAGJ6
+    EDHBNCFINW5OqABKSFk/B9lUa94IDwIFgewFMwQDQwCZQCztTgM9Sl8SOEMG
+    KSAthiaOjBMPDhQONBiXABEAOw==
+EOD
+end
+
+if $tk_major_ver >= 8
+$image['view'] = TkPhotoImage.new(:height=>16, :format=>'GIF', :data=><<EOD)
+    R0lGODlhEAAQAPMAAMz/zP///8DAwICAgH9/fwAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAwRIcMhJB7h3hM33
+    KFjWdQQYap1QrCaGBmrRrS4nj5b53jOgbwXBKGACoYLDIuAoHCmZyYvR1rT5
+    RMAq8LqcIYGsrjPsW1XOmFUEADs=
+EOD
+end
+
+if $tk_major_ver >= 8
+$image['delete'] = TkPhotoImage.new(:height=>16, :format=>'GIF', :data=><<EOD)
+    R0lGODlhEAAOAKEAAIQAAO/n3v///////yH5BAEKAAIALAAAAAAQAA4AAAIm
+    lI9pAKHbIHNoVhYhTdjlJ2AWKG2g+CldmB6rxo2uybYhbS80eRQAOw==
+EOD
+end
+
+if $tk_major_ver >= 8
+$image['print'] = TkPhotoImage.new(:height=>16, :format=>'GIF', :data=><<EOD)
+    R0lGODlhGgATAPcAACEQOTEpQjEpUkIpc0IxY0I5c0oxjEo5SlJCY1JCe1JK
+    UlpChFpCjFpGkFpSc1paa2NKc2NKnGNja2tapWtjc29KnHNanHNjc3NjrXNr
+    jHNrnHNzc3tjpXtrtXtzhICAgIRzvYSEjIZzqox7tYyEnIyMjJSEtZSEvZSM
+    lJyMtZyMvZyUlJyUrZyUvZycnKWctaWlpa2czq2lzrWtvbWtzrW1tb21xr21
+    1sa9zs693s7OztbO3tbO597W1t7W7+fe7+fn5////+/n7+/v7+/v9////wAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAACH5BAEAAEEALAAAAAAaABMAQAj/AIMIHBhkg0GC
+    CBMGIQEiQgseQT4oeCBBAokgRYYQ0JBixg8hRIiUUEBBYYmTByBwiCBCRYwH
+    CxY8cKFw4AogRXLqLAJkQ80gCBBg3BkxZswTNGh4MGqgQQUMJRHCwMkTSE+D
+    Pn8eCKBhxIMhO3ei2OHDBw6sWSlMMMoWgwwfMDZI8GBjx44NARZwEGGi5MkS
+    PcIWKRGz5YgLbAco+KkQBQoJIRgjdGEVq+SaJajqtNrzMgsPCmoIzqmDgmWE
+    KOBuUKAAwYabYTfs4OHjY0giGyhk4MAWRI4eKyRQqPgggYUXPH4A+XBAgwoK
+    DiIsCFxjA9sFEVQQCRJCAYAFDJxiKhAxvMTonEFimrhhYinTBgWiCvxLNX3M
+    DkkpsKV5OYhjBxCMYAICAigUEAA7
+EOD
+end
 
 # 
 TkMenubar.new($root, 
@@ -48,6 +109,7 @@ TkMenubar.new($root,
 		  ['Quit', proc{exit}, 0, 'Meta-Q']
 		]]).pack('side'=>'top', 'fill'=>'x')
 $root.bind('F1', proc{aboutBox})
+$root.bind('Meta-q', proc{exit})
 
 =begin
 TkFrame.new($root){|frame|
@@ -67,7 +129,7 @@ if $tk_version =~ /^4\.[01]/
   scr = TkScrollbar.new($root, 'orient'=>'vertical')
   txt = TkText.new($root) {
     wrap 'word'
-    width 60
+    width 70
     height 30
     font $font
     setgrid 'yes'
@@ -84,7 +146,7 @@ else
   }
   txt = TkText.new($root) {
     wrap 'word'
-    width 60
+    width 70
     height 30
     font $font
     setgrid 'yes'
@@ -92,6 +154,7 @@ else
     padx 4
     pady 2
     takefocus 0
+    bd 1
     yscrollcommand proc{|first,last| scr.set first,last}
   }
   scr.command(proc{|*args| txt.yview(*args)})
@@ -123,7 +186,7 @@ tag_title = TkTextTag.new(txt, 'font'=>'-*-Helvetica-Bold-R-Normal--*-180-*-*-*-
 
 tag_demospace = TkTextTag.new(txt, 'lmargin1'=>'1c', 'lmargin2'=>'1c')
 
-if TkWinfo.depth($root) == '1'
+if TkWinfo.depth($root) == 1
   tag_demo = TkTextTag.new(txt, 'lmargin1'=>'1c', 'lmargin2'=>'1c', 
 			   'underline'=>1)
   $tag_visited = TkTextTag.new(txt, 'lmargin1'=>'1c', 'lmargin2'=>'1c', 
@@ -206,21 +269,25 @@ txt.insert('end', "3. Buttons.\n", tag_demo, "demo-button")
 txt.insert('end', " \n ", tag_demospace)
 txt.insert('end', "4. Checkbuttons (select any of a group).\n", tag_demo, "demo-check")
 txt.insert('end', " \n ", tag_demospace)
-txt.insert('end', "5. Radiobuttons (select one of a group).\n", tag_demo, "demo-radio")
+txt.insert('end', "5. Checkbuttons (if supported).\n", tag_demo, "demo-check2")
+txt.insert('end', " \n ", tag_demospace)
+txt.insert('end', "6. Radiobuttons (select one of a group).\n", tag_demo, "demo-radio")
 txt.insert('end', " \n ", tag_demospace)
-txt.insert('end', "6. Radiobuttons (if supported 'compound' option).\n", tag_demo, "demo-radio2")
+txt.insert('end', "7. Radiobuttons (if supported 'compound' option).\n", tag_demo, "demo-radio2")
 txt.insert('end', " \n ", tag_demospace)
-txt.insert('end', "7. A 15-puzzle game made out of buttons.\n", tag_demo, "demo-puzzle")
+txt.insert('end', "8. Radiobuttons (if supported).\n", tag_demo, "demo-radio3")
 txt.insert('end', " \n ", tag_demospace)
-txt.insert('end', "8. Iconic buttons that use bitmaps.\n", tag_demo, "demo-icon")
+txt.insert('end', "9. A 15-puzzle game made out of buttons.\n", tag_demo, "demo-puzzle")
 txt.insert('end', " \n ", tag_demospace)
-txt.insert('end', "9. Two labels displaying images.\n", tag_demo, "demo-image1")
+txt.insert('end', "10. Iconic buttons that use bitmaps.\n", tag_demo, "demo-icon")
 txt.insert('end', " \n ", tag_demospace)
-txt.insert('end', "10. A simple user interface for viewing images.\n", tag_demo, "demo-image2")
+txt.insert('end', "11. Two labels displaying images.\n", tag_demo, "demo-image1")
 txt.insert('end', " \n ", tag_demospace)
-txt.insert('end', "11. A simple user interface for viewing images. (if supported)\n", tag_demo, "demo-image3")
+txt.insert('end', "12. A simple user interface for viewing images.\n", tag_demo, "demo-image2")
 txt.insert('end', " \n ", tag_demospace)
-txt.insert('end', "12. Labelled frames (if supported)\n", tag_demo, "demo-labelframe")
+txt.insert('end', "13. A simple user interface for viewing images. (if supported)\n", tag_demo, "demo-image3")
+txt.insert('end', " \n ", tag_demospace)
+txt.insert('end', "14. Labelled frames (if supported)\n", tag_demo, "demo-labelframe")
 txt.insert('end', " \n ", tag_demospace)
 
 txt.insert('end', "\n")
@@ -260,7 +327,9 @@ txt.insert('end', "3. Hypertext (tag bindings).\n", tag_demo, "demo-bind")
 txt.insert('end', " \n ", tag_demospace)
 txt.insert('end', "4. A text widget with embedded windows.\n", tag_demo, "demo-twind")
 txt.insert('end', " \n ", tag_demospace)
-txt.insert('end', "5. A search tool built with a text widget.\n", tag_demo, "demo-search")
+txt.insert('end', "5. A text widget with embedded windows. (if supported)\n", tag_demo, "demo-twind2")
+txt.insert('end', " \n ", tag_demospace)
+txt.insert('end', "6. A search tool built with a text widget.\n", tag_demo, "demo-search")
 txt.insert('end', " \n ", tag_demospace)
 
 txt.insert('end', "\n")
@@ -278,7 +347,9 @@ txt.insert('end', "5. A ruler with adjustable tab stops.\n", tag_demo, "demo-rul
 txt.insert('end', " \n ", tag_demospace)
 txt.insert('end', "6. A building floor plan.\n", tag_demo, "demo-floor")
 txt.insert('end', " \n ", tag_demospace)
-txt.insert('end', "7. A simple scrollable canvas.\n", tag_demo, "demo-cscroll")
+txt.insert('end', "7. A building floor plan. (another way to create canvas items)\n", tag_demo, "demo-floor2")
+txt.insert('end', " \n ", tag_demospace)
+txt.insert('end', "8. A simple scrollable canvas.\n", tag_demo, "demo-cscroll")
 txt.insert('end', " \n ", tag_demospace)
 
 txt.insert('end', "\n")
@@ -350,7 +421,7 @@ end
 # args -	Any number of names of variables.
 
 $showVarsWin = {}
-def showVars (parent, *args)
+def showVars1(parent, *args)
   if $showVarsWin[parent.path]
     begin
       $showVarsWin[parent.path].destroy 
@@ -385,11 +456,54 @@ def showVars (parent, *args)
   $showVarsWin[parent.path] = w
 end
 
+def showVars2(parent, *args)
+  if $showVarsWin[parent.path]
+    begin
+      $showVarsWin[parent.path].destroy 
+    rescue
+    end
+  end
+  $showVarsWin[parent.path] = TkToplevel.new(parent) {|w|
+    title "Variable values"
+
+    TkLabelFrame.new(w, :text=>"Variable values:", 
+		     :font=>{:family=>'Helvetica', :size=>14}){|f|
+      args.each{|vnam,vbody|
+	TkGrid(TkLabel.new(f, :text=>"#{vnam}: ", :anchor=>'w'), 
+	       TkLabel.new(f, :textvariable=>vbody, :anchor=>'w'), 
+	       :padx=>2, :pady=>2, :sticky=>'w')
+      }
+
+      f.grid(:sticky=>'news', :padx=>4)
+      f.grid_columnconfig(1, :weight=>1)
+      f.grid_rowconfig(100, :weight=>1)
+    }
+    TkButton.new(w, :text=>"OK", :width=>8, :default=>:active, 
+		 :command=>proc{w.destroy}){|b|
+      w.bind('Return', proc{b.invoke})
+      w.bind('Escape', proc{b.invoke})
+
+      b.grid(:sticky=>'e', :padx=>4, :pady=>[6, 4])
+    }
+    w.grid_columnconfig(0, :weight=>1)
+    w.grid_rowconfig(0, :weight=>1)
+  }
+end
+
+if $tk_major_ver < 8
+  alias showVars showVars1
+elsif $tk_major_ver == 8 && $tk_minor_ver < 5
+  alias showVars showVars1
+else # ver >= 8.5
+  alias showVars showVars2
+end
+
 # invoke --
 # This procedure is called when the user clicks on a demo description.
 # It is responsible for invoking the demonstration.
 #
 # Arguments:
+# txt -		Name of text widget
 # index -	The index of the character that the user clicked on.
 
 def invoke (txt, index)
@@ -399,7 +513,8 @@ def invoke (txt, index)
   txt.cursor('watch')
   Tk.update
 #  eval `cat #{tag[5..-1]}.rb`
-  eval `cat #{[$demo_dir, tag[5..-1]].join(File::Separator)}.rb`
+#  eval `cat #{[$demo_dir, tag[5..-1]].join(File::Separator)}.rb`
+  eval IO.readlines("#{[$demo_dir, tag[5..-1]].join(File::Separator)}.rb").join
   Tk.update
 #  txt.cursor('xterm')
   txt.cursor(cursor)
@@ -433,13 +548,13 @@ end
 # a demonstration and allows it to be edited and reinvoked.
 #
 # Arguments:
-# w -		The name of the demonstration's window, which can be
+# demo -	The name of the demonstration's window, which can be
 #		used to derive the name of the file containing its code.
 
-def showCode (demo)
+def showCode1(demo)
   file = "#{demo}.rb"
   $code_window = nil unless defined? $code_window
-  if $code_window == nil || TkWinfo.exist?($code_window) == '0'
+  if $code_window == nil || TkWinfo.exist?($code_window) == false
     $code_window = TkToplevel.new(nil)
     f = TkFrame.new($code_window)
     TkButton.new(f) {
@@ -516,16 +631,192 @@ def showCode (demo)
   fid.close
 end
 
+def showCode2(demo)
+  file = "#{demo}.rb"
+  $code_window = nil unless defined? $code_window
+  if $code_window == nil || TkWinfo.exist?($code_window) == false
+    $code_window = TkToplevel.new(nil)
+    tf = TkFrame.new($code_window)
+    $code_text = TkText.new(tf, :font=>'Courier 10', :height=>30, 
+			    :wrap=>'word', :bd=>1, :setgrid=>true, 
+			    :highlightthickness=>0, :pady=>2, :padx=>3)
+    xscr = TkScrollbar.new(tf, :bd=>1){assign($code_text)}
+    yscr = TkScrollbar.new(tf, :bd=>1){assign($code_text)}
+    TkGrid($code_text, yscr, :sticky=>'news')
+    #TkGrid(xscr)
+    tf.grid_rowconfigure(0, :weight=>1)
+    tf.grid_columnconfigure(0, :weight=>1)
+
+    bf = TkFrame.new($code_window)
+    
+    b_dis = TkButton.new(bf, :text=>'Dismiss', :default=>:active, 
+			 :command=>proc{
+			   $code_window.destroy
+			   $code_window = nil
+			 }, 
+			 :image=>$image['delete'], :compound=>:left)
+    b_prn = TkButton.new(bf, :text=>'Print Code', 
+			 :command=>proc{printCode($code_text, file)}, 
+			 :image=>$image['print'], :compound=>:left)
+    b_run = TkButton.new(bf, :text=>'Rerun Demo', 
+			 :command=>proc{eval($code_text.get('1.0','end'))}, 
+			 :image=>$image['refresh'], :compound=>:left)
+
+    TkGrid('x', b_run, b_prn, b_dis, :padx=>4, :pady=>[6,4])
+    bf.grid_columnconfigure(0, :weight=>1)
+
+    TkGrid(tf, :sticky=>'news')
+    TkGrid(bf, :sticky=>'ew')
+    $code_window.grid_columnconfigure(0, :weight=>1)
+    $code_window.grid_rowconfigure(0, :weight=>1)
+
+    $code_window.bind('Return', proc{|win|
+			b_dis.invoke unless win.kind_of?(TkText)
+		      }, '%W')
+    $code_window.bindinfo('Return').each{|cmd, arg|
+      $code_window.bind_append('Escape', cmd, arg)
+    }
+  else
+    $code_window.deiconify
+    $code_window.raise
+  end
+
+  $code_window.title("Demo code: #{file}")
+  $code_window.iconname(file)
+  fid = open([$demo_dir, file].join(File::Separator), 'r')
+  $code_text.delete('1.0', 'end')
+  $code_text.insert('1.0', fid.read)
+  TkTextMarkInsert.new($code_text,'1.0')
+  fid.close
+end
+
+if $tk_major_ver < 8
+  alias showCode showCode1
+elsif $tk_major_ver == 8 && $tk_minor_ver < 5
+  alias showCode showCode1
+else # ver >= 8.5
+  alias showCode showCode2
+end
+
+
+# printCode --
+# Prints the source code currently displayed in the See Code dialog.
+# Much thanks to Arjen Markus for this.
+#
+# Arguments:
+# txt -		Name of text widget containing code to print
+# file -	Name of the original file (implicitly for title)
+
+def printCode(txt, file)
+  code = txt.get('1.0', 'end - 1c')
+  dir = '.'
+  dir = ENV['HOME'] if ENV['HOME']
+  dir = ENV['TMP'] if ENV['TMP']
+  dir = ENV['TEMP'] if ENV['TEMP']
+
+  fname = [dir, 'tkdemo-' + file].join(File::Separator)
+  open(fname, 'w'){|fid| fid.print(code)}
+  begin
+    case Tk::TCL_PLATFORM('platform')
+    when 'unix'
+      msg = `lp -c #{fname}`
+      unless $?.exitstatus == 0
+	Tk.messageBox(:title=>'Print spooling failure', 
+		      :message=>'Print spooling probably failed: ' + msg)
+      end
+    when 'windows'
+      begin
+	printTextWin32(fname)
+      rescue => e
+	Tk.messageBox(:title=>'Print spooling failure', 
+		      :message=>'Print spooling probably failed: ' + 
+		      e.message)
+      end      
+    when 'macintosh'
+      Tk.messageBox(:title=>'Operation not Implemented', 
+		    :message=>'Oops, sorry: not implemented yet!')
+    else
+      Tk.messageBox(:title=>'Operation not Implemented', 
+		    :message=>'Wow! Unknown platform: ' + 
+		    Tk::TCL_PLATFORM('platform'))
+    end
+  ensure
+    File.delete(fname)
+  end
+end
+
+# printTextWin32 --
+#    Print a file under Windows
+#
+# Arguments:
+# filename -		Name of the file
+#
+def printTextWin32(fname)
+  require 'win32/registry'
+  begin
+    app = Win32::Registry::HKEY_CLASSES_ROOT['.txt']
+    pcmd = nil
+    Win32::Registry::HKEY_CLASSES_ROOT.open("#{app}\\shell\\print"){|reg|
+      pcmd = reg['command']
+    }
+  rescue
+    app = Tk.tk_call('auto_execok', 'notepad.exe')
+    pcmd = "#{app} /p %1"
+  end
+
+  pcmd.gsub!('%1', fname)
+  puts pcmd
+  cmd = Tk.tk_call('auto_execok', 'start') + ' /min ' + pcmd
+  
+  msg = `#{cmd}`
+  unless $?.exitstatus == 0
+    fail RuntimeError, msg
+  end
+end
+
 # aboutBox
 #
 #      Pops up a message box with an "about" message
 #
 def aboutBox
   Tk.messageBox('icon'=>'info', 'type'=>'ok', 'title'=>'About Widget Demo', 
-		'message'=>"Ruby/Tk widget demonstration Ver.1.3.2-en\n\n( based on Tk 8.1 Copyright (c) 1996-1997 Sun Microsystems, Inc. )\n\nRunning Version :: Ruby#{VERSION}/Tk#{$tk_version}")
+		'message'=>"Ruby/Tk widget demonstration Ver.1.4.3-en\n\n" + 
+                           "based on demos of Tk8.1 -- 8.5  " + 
+		           "( Copyright:: " + 
+		           "(c) 1996-1997 Sun Microsystems, Inc. / " + 
+                           "(c) 1997-2000 Ajuba Solutions, Inc. / " + 
+		           "(c) 2001-2003 Donal K. Fellows )\n\n" +
+                           "Your Ruby & Tk Version ::\n" + 
+                           "Ruby#{RUBY_VERSION}(#{RUBY_RELEASE_DATE})[#{RUBY_PLATFORM}] / Tk#{$tk_patchlevel}#{(Tk::JAPANIZED_TK)? '-jp': ''}")
 end
 
-################################
+#########################################
+# start demos if given at command line
+no_launcher = false
+if ARGV[0] == '-n'
+  ARGV.shift
+  no_launcher = true if ARGV.size > 0
+end
+ARGV.each{|cmd| 
+  if cmd =~ /(.*).rb/
+    cmd = $1
+  end
+  eval IO.readlines("#{[$demo_dir, cmd].join(File::Separator)}.rb").join
+}
+if no_launcher
+  $root.withdraw   # hide root window
+  Thread.start{
+    loop do
+      count = 0
+      $root.winfo_children.each{|w|
+	count += 1 if w.kind_of?(TkToplevel)
+      }
+      $root.destroy if count == 0
+    end
+  }
+end
 
+#########################################
+# start eventloop
 Tk.mainloop