* doc/ChangeLog-1.8.0: add changes of Ruby/Tk

* ext/tcltklib/tcltklib.c : some methods have no effect if on slave-IP
* ext/tcltklib/tcltklib.c : can create a interpreter without Tk
* ext/tcltklib/tcltklib.c : bug fix on handling exceptions
* ext/tcltklib/MANUAL.euc : modify
* ext/tk/lib/tk.rb : freeze some core modules
* ext/tk/lib/multi-tk.rb : more secure
* ext/tk/lib/tk.rb: TkVariable.new(array) --> treat the array as the
  Tk's list
* ext/tk/lib/tk.rb: improve accessibility of TkVariable object
* ext/tk/lib/tk.rb, ext/tk/lib/tkfont.rb, ext/tk/lib/tkcanvas.rb,
  ext/tk/lib/tktext.rb : fix bug of font handling
* ext/tk/lib/tkfont.rb TkFont.new() accepts compound fonts
* process.c: bug fix
* process.c: add rb_secure(2) to methods of Process::{UID,GID,Sys}
* process.c: deny handling IDs during evaluating the block given to
  the Process::{UID,GID}.switch method


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

5 files changed, 695 insertions, 104 deletions

diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb
index d1bf21164a..12ed7aceff 100644
--- a/ext/tk/lib/multi-tk.rb
+++ b/ext/tk/lib/multi-tk.rb
@@ -6,10 +6,12 @@ require 'tcltklib'
 require 'thread'
 
 ################################################
-# ignore exception on the mainloop
+# ignore exception on the mainloop?
 
+TclTkLib.mainloop_abort_on_exception = true
 # TclTkLib.mainloop_abort_on_exception = false
-TclTkLib.mainloop_abort_on_exception = nil
+# TclTkLib.mainloop_abort_on_exception = nil
+
 
 
 ################################################
@@ -71,9 +73,16 @@ class MultiTkIp
   end
   private :_keys2opts
 
-  def _check_and_return(thread, exception, wait=3)
-    # wait to stop the caller thread
+  def _check_and_return(thread, exception, wait=0)
     return nil unless thread
+
+    if wait == 0
+      # no wait
+      thread.raise exception
+      return thread
+    end
+
+    # wait to stop the caller thread
     wait.times{
       if thread.stop?
 	# ready to send exception
@@ -104,22 +113,36 @@ class MultiTkIp
   def _create_receiver_and_watchdog()
     # command-procedures receiver
     receiver = Thread.new{
+      safe_level = $SAFE
       loop do
 	thread, cmd, *args = @cmd_queue.deq
 	if thread == @system
+	  # control command
 	  case cmd
 	  when 'set_safe_level'
 	    begin
-	      $SAFE = args[0]
+	      safe_level = args[0] if safe_level < args[0] 
 	    rescue Exception
 	      nil
 	    end
 	  else
 	    # ignore
 	  end
+
 	else
+	  # procedure
 	  begin
-	    ret = cmd.call(*args)
+	    ret = proc{$SAFE = safe_level; cmd.call(*args)}.call
+	  rescue SystemExit
+	    # delete IP
+	    unless @interp.deleted?
+	      if @interp._invoke('info', 'command', '.') != ""
+		@interp._invoke('destroy', '.')
+	      end
+	      @interp.delete
+	    end
+	    _check_and_return(thread, MultiTkIp_OK.new(nil))
+	    break
 	  rescue Exception => e
 	    # raise exception
 	    _check_and_return(thread, e)
@@ -134,7 +157,10 @@ class MultiTkIp
     # watchdog of receiver
     watchdog = Thread.new{
       begin
-	receiver.join
+	loop do
+	  sleep 1
+	  break unless receiver.alive?
+	end
       rescue Exception
 	# ignore all kind of Exception
       end
@@ -621,7 +647,9 @@ end
 # instance methods to treat tables
 class MultiTkIp
   def _tk_cmd_tbl
-    MultiTkIp.tk_cmd_tbl.collect{|ent| ent.ip == self }
+    tbl = {}
+    MultiTkIp.tk_cmd_tbl.each{|id, ent| tbl[id] = ent if ent.ip == self }
+    tbl
   end
 
   def _tk_windows
@@ -632,6 +660,10 @@ class MultiTkIp
     @tk_table_list
   end
 
+  def _add_new_tables
+    (@@TK_TABLE_LIST.size - @tk_table_list.size).times{ @tk_table_list << {} }
+  end
+
   def _init_ip_env(script)
     script.call(self)
   end
@@ -669,10 +701,10 @@ class MultiTkIp
     __getip._tk_table_list[id]
   end
   def self.create_table
+    if __getip.slave?
+      raise SecurityError, "slave-IP has no permission creating a new table"
+    end
     id = @@TK_TABLE_LIST.size
-    @@IP_TABLE.each{|tg, ip| 
-      ip.instance_eval{@tk_table_list << {}}
-    }
     obj = Object.new
     @@TK_TABLE_LIST << obj
     obj.instance_eval <<-EOD
@@ -681,6 +713,7 @@ class MultiTkIp
       end
     EOD
     obj.freeze
+    @@IP_TABLE.each{|tg, ip| ip._add_new_tables }
     return obj
   end
 
@@ -719,33 +752,62 @@ end
 # evaluate a procedure on the proper interpreter
 class MultiTkIp
   # instance method
-  def eval_proc_core(req_val=true, cmd = Proc.new, *args)
+  def eval_proc_core(req_val, cmd, *args)
     # cmd string ==> proc
     if cmd.kind_of?(String)
-      cmd = proc{ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args)) }
+      xcmd  = cmd
+      xargs = args
+      cmd = proc{ TkComm._get_eval_string(TkUtil.eval_cmd(xcmd, *xargs)) }
       args = []
     end
 
+    # check
+    unless cmd.kind_of?(Proc)
+      raise RuntimeError, "A Proc object is expected for the 'cmd' argument"
+    end
+
     # on IP thread
     if (@cmd_receiver == Thread.current)
-      return cmd.call(*args)
+      begin
+	ret = cmd.call(*args)
+      rescue SystemExit
+	# exit IP
+	warn("Warning: "+ $! + " on " + self.inspect) if $DEBUG
+	self.delete
+	ret = nil
+      rescue Exception => e
+	warn("Warning: " + e.class.inspect + 
+	     ((e.message.length > 0)? ' "' + e.message + '"': '') +  
+	     " on " + self.inspect)
+	ret =  nil
+      end
+      return ret
     end
     
     # send cmd to the proc-queue
-    if req_val
-      @cmd_queue.enq([Thread.current, cmd, *args])
-    else
+    unless req_val
       @cmd_queue.enq([nil, cmd, *args])
       return nil
     end
 
-    # wait and get return value by exception
+    # send and get return value by exception
     begin
+      @cmd_queue.enq([Thread.current, cmd, *args])
       Thread.stop
     rescue MultiTkIp_OK => ret
       # return value
       return ret.value
+    rescue SystemExit
+      # exit IP
+      warn("Warning: " + $! + " on " + self.inspect) if $DEBUG
+      self.delete
+    rescue Exception => e
+      # others --> warning
+	warn("Warning: " + e.class.inspect + 
+	     ((e.message.length > 0)? ' "' + e.message + '"': '') +  
+	     " on " + self.inspect) 
     end
+    return nil
   end
   private :eval_proc_core
 
@@ -757,48 +819,57 @@ class MultiTkIp
     eval_proc_core(true, cmd, *args)
   end
   alias call eval_proc
-
+  alias eval_string eval_proc
+end
+class << MultiTkIp
   # class method
-  def self.eval_proc(cmd = Proc.new, *args)
+  def eval_proc(cmd = Proc.new, *args)
     # class ==> interp object
     __getip.eval_proc(cmd, *args)
   end
+  alias call eval_proc
+  alias eval_string eval_proc
 end
 
 
-# depend on TclTkLib
+# event loop
 # all master/slave IPs are controled by only one event-loop
 class << MultiTkIp
   def mainloop(check_root = true)
-    TclTkLib.mainloop(check_root)
+    __getip.mainloop(check_root)
   end
   def mainloop_watchdog(check_root = true)
-    TclTkLib.mainloop_watchdog(check_root)
+    __getip.mainloop_watchdog(check_root)
   end
   def do_one_event(flag = TclTkLib::EventFlag::ALL)
-    TclTkLib.do_one_event(flag)
+    __getip.do_one_event(flag)
+  end
+  def mainloop_abort_on_exception
+    __getip.mainloop_abort_on_exception
+  end
+  def mainloop_abort_on_exception=(mode)
+    __getip.mainloop_abort_on_exception=(mode)
   end
   def set_eventloop_tick(tick)
-    TclTkLib.set_eventloop_tick(tick)
+    __getip.set_eventloop_tick(tick)
   end
   def get_eventloop_tick
-    TclTkLib.get_eventloop_tick
+    __getip.get_eventloop_tick
   end
   def set_no_event_wait(tick)
-    TclTkLib.set_no_event_wait(tick)
+    __getip.set_no_event_wait(tick)
   end
   def get_no_event_wait
-    TclTkLib.get_no_event_wait
+    __getip.get_no_event_wait
   end
   def set_eventloop_weight(loop_max, no_event_tick)
-    TclTkLib.set_eventloop_weight(loop_max, no_event_tick)
+    __getip.set_eventloop_weight(loop_max, no_event_tick)
   end
   def get_eventloop_weight
-    TclTkLib.get_eventloop_weight
+    __getip.get_eventloop_weight
   end
 end
 
-
 # class methods to delegate to TclTkIp
 class << MultiTkIp
   def method_missing(id, *args)
@@ -839,32 +910,76 @@ class << MultiTkIp
 end
 
 
+# wrap methods on TclTkLib : not permit calling TclTkLib module methods
+class << TclTkLib
+  def mainloop(check_root = true)
+    MultiTkIp.mainloop(check_root)
+  end
+  def mainloop_watchdog(check_root = true)
+    MultiTkIp.mainloop_watchdog(check_root)
+  end
+  def do_one_event(flag = TclTkLib::EventFlag::ALL)
+    MultiTkIp.do_one_event(flag)
+  end
+  def mainloop_abort_on_exception
+    MultiTkIp.mainloop_abort_on_exception
+  end
+  def mainloop_abort_on_exception=(mode)
+    MultiTkIp.mainloop_abort_on_exception=(mode)
+  end
+  def set_eventloop_tick(tick)
+    MultiTkIp.set_eventloop_tick(tick)
+  end
+  def get_eventloop_tick
+    MultiTkIp.get_eventloop_tick
+  end
+  def set_no_event_wait(tick)
+    MultiTkIp.set_no_event_wait(tick)
+  end
+  def get_no_event_wait
+    MultiTkIp.get_no_event_wait
+  end
+  def set_eventloop_weight(loop_max, no_event_tick)
+    MultiTkIp.set_eventloop_weight(loop_max, no_event_tick)
+  end
+  def get_eventloop_weight
+    MultiTkIp.get_eventloop_weight
+  end
+  def restart
+    MultiTkIp.restart
+  end
+end
+
+
 # depend on TclTkIp
 class MultiTkIp
   def mainloop(check_root = true, restart_on_dead = true)
+    return self if self.slave?
     unless restart_on_dead
       @interp.mainloop(check_root)
     else
       begin
 	loop do
-	  @interp.mainloop(check_root)
+	  break unless self.alive?
 	  if check_root
 	    begin
-	      break if @interp._invoke('winfo', 'exists?', '.') == "1"
+	      break if TclTkLib.num_of_mainwindows == 0
 	    rescue Exception
 	      break
 	    end
 	  end
+	  @interp.mainloop(check_root)
 	end
       rescue StandardError
 	if TclTkLib.mainloop_abort_on_exception != nil
-	  STDERR.print("warning: Tk mainloop on ", @interp.inspect, 
+	  STDERR.print("Warning: Tk mainloop on ", @interp.inspect, 
 		       " receives ", $!.class.inspect, 
 		       " exception (ignore) : ", $!.message, "\n");
 	end
 	retry
       end
     end
+    self
   end
 
   def make_safe
@@ -1187,10 +1302,19 @@ class MultiTkIp
 end
 
 
-# end of MultiTkIp definition
+# remove methods for security
+class MultiTkIp
+  undef_method :instance_eval
+  undef_method :instance_variable_get
+  undef_method :instance_variable_set
+end
 
-MultiTkIp.freeze # defend against modification
 
+# end of MultiTkIp definition
+
+# defend against modification
+MultiTkIp.freeze
+TclTkLib.freeze
 
 ########################################
 #  start Tk which depends on MultiTkIp
diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index 0941635716..a03e6823bb 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -14,6 +14,7 @@ module TkComm
   def None.to_s
     'None'
   end
+  None.freeze
 
   #Tk_CMDTBL = {}
   #Tk_WINDOWS = {}
@@ -24,10 +25,16 @@ module TkComm
   def Tk_CMDTBL.method_missing(id, *args)
     TkCore::INTERP.tk_cmd_tbl.send(id, *args)
   end
+  Tk_CMDTBL.freeze
   Tk_WINDOWS = Object.new
   def Tk_WINDOWS.method_missing(id, *args)
     TkCore::INTERP.tk_windows.send(id, *args)
   end
+  Tk_WINDOWS.freeze
+
+  self.instance_eval{
+    @cmdtbl = []
+  }
 
   def error_at
     frames = caller()
@@ -894,30 +901,8 @@ module TkCore
     tk_call('info', *args)
   end
 
-  def mainloop(check_root = true, restart_on_dead = true)
-    unless restart_on_dead
-      TclTkLib.mainloop(check_root)
-    else
-      begin
-	loop do
-	  TclTkLib.mainloop(check_root)
-	  if check_root
-	    begin
-	      break if TkWinfo.exist?('.')
-	    rescue Exception
-	      break
-	    end
-	  end
-	end
-      rescue StandardError
-	if TclTkLib.mainloop_abort_on_exception != nil
-	  STDERR.print("warning: Tk mainloop on ", TkCore::INTERP.inspect, 
-		       " receives ", $!.class.inspect, 
-		       " exception (ignore) : ", $!.message, "\n");
-	end
-	retry
-      end
-    end
+  def mainloop(check_root = true)
+    TclTkLib.mainloop(check_root)
   end
 
   def mainloop_watchdog(check_root = true)
@@ -1020,15 +1005,15 @@ module TkCore
     print "=> ", args.join(" ").inspect, "\n" if $DEBUG
     begin
       # res = INTERP._invoke(*args).taint
-      res = INTERP._invoke(*args)   # _invoke returns a TAITED string
-    rescue NameError
-      err = $!
+      res = INTERP._invoke(*args)   # _invoke returns a TAINTED string
+    rescue NameError => err
+#      err = $!
       begin
         args.unshift "unknown"
         #res = INTERP._invoke(*args).taint 
-        res = INTERP._invoke(*args)   # _invoke returns a TAITED string
-      rescue
-	fail unless /^invalid command/ =~ $!
+        res = INTERP._invoke(*args)   # _invoke returns a TAINTED string
+      rescue StandardError => err2
+	fail err2 unless /^invalid command/ =~ err2
 	fail err
       end
     end
@@ -1136,7 +1121,7 @@ module Tk
     TkRoot.new
   end
 
-  def bell(nice = false)
+  def Tk.bell(nice = false)
     if nice
       tk_call 'bell', '-nice'
     else
@@ -1144,7 +1129,7 @@ module Tk
     end
   end
 
-  def bell_on_display(win, nice = false)
+  def Tk.bell_on_display(win, nice = false)
     if nice
       tk_call('bell', '-displayof', win, '-nice')
     else
@@ -1720,6 +1705,8 @@ class TkVariable
   include Tk
   extend TkCore
 
+  include Comparable
+
   TkCommandNames = ['tkwait'.freeze].freeze
 
   #TkVar_CB_TBL = {}
@@ -1749,13 +1736,16 @@ class TkVariable
     @trace_elem = nil
     @trace_opts = nil
 
+=begin
     if val == []
-      INTERP._eval(format('global %s; set %s(0) 0; unset %s(0)', 
-			  @id, @id, @id))
+      # INTERP._eval(format('global %s; set %s(0) 0; unset %s(0)', 
+      #	                    @id, @id, @id))
     elsif val.kind_of?(Array)
       a = []
-      val.each_with_index{|e,i| a.push(i); a.push(array2tk_list(e))}
-      s = '"' + a.join(" ").gsub(/[\[\]$"]/, '\\\\\&') + '"'
+      # val.each_with_index{|e,i| a.push(i); a.push(array2tk_list(e))}
+      # s = '"' + a.join(" ").gsub(/[\[\]$"]/, '\\\\\&') + '"'
+      val.each_with_index{|e,i| a.push(i); a.push(e)}
+      s = '"' + array2tk_list(a).gsub(/[\[\]$"]/, '\\\\\&') + '"'
       INTERP._eval(format('global %s; array set %s %s', @id, @id, s))
     elsif  val.kind_of?(Hash)
       s = '"' + val.to_a.collect{|e| array2tk_list(e)}.join(" ")\
@@ -1765,6 +1755,15 @@ class TkVariable
       s = '"' + _get_eval_string(val).gsub(/[\[\]$"]/, '\\\\\&') + '"'
       INTERP._eval(format('global %s; set %s %s', @id, @id, s))
     end
+=end
+    if  val.kind_of?(Hash)
+      s = '"' + val.to_a.collect{|e| array2tk_list(e)}.join(" ")\
+                   .gsub(/[\[\]$"]/, '\\\\\&') + '"'
+      INTERP._eval(format('global %s; array set %s %s', @id, @id, s))
+    else
+      s = '"' + _get_eval_string(val).gsub(/[\[\]$"]/, '\\\\\&') + '"'
+      INTERP._eval(format('global %s; set %s %s', @id, @id, s))
+    end
   end
 
   def wait
@@ -1782,8 +1781,9 @@ class TkVariable
       if INTERP._eval(format('global %s; array exists %s', @id, @id)) != "1"
 	fail
       else
-	Hash[*tk_split_simplelist(INTERP._eval(format('global %s; array get %s', 
-						      @id, @id)))]
+	Hash[*tk_split_simplelist(INTERP.
+				  _eval(format('global %s; array get %s', 
+					       @id, @id)))]
       end
     end
   end
@@ -1827,6 +1827,20 @@ class TkVariable
 			_get_eval_string(index), _get_eval_string(val)))
   end
 
+  def numeric
+    number(value)
+  end
+  def numeric=(val)
+    case val
+    when Numeric
+      self.value=(val)
+    when TkVariable
+      self.value=(val.numeric)
+    else
+      raise ArgumentError, "Numeric is expected"
+    end
+  end
+
   def to_i
     number(value).to_i
   end
@@ -1843,10 +1857,104 @@ class TkVariable
     value.intern
   end
 
+  def list
+    tk_split_list(value)
+  end
+  alias to_a list
+
+  def list=(val)
+    case val
+    when Array
+      self.value=(val)
+    when TkVariable
+      self.value=(val.list)
+    else
+      raise ArgumentError, "Array is expected"
+    end
+  end
+
   def inspect
     format "#<TkVariable: %s>", @id
   end
 
+  def coerce(other)
+    case other
+    when TkVariable
+      [other.value, self.value]
+    when String
+      [other, self.to_s]
+    when Symbol
+      [other, self.to_sym]
+    when Integer
+      [other, self.to_i]
+    when Float
+      [other, self.to_f]
+    when Array
+      [other, self.to_a]
+    else
+      [other, self.value]
+    end
+  end
+
+  def &(other)
+    if other.kind_of?(Array)
+      self.to_a & other.to_a
+    else
+      self.to_i & other.to_i
+    end
+  end
+  def |(other)
+    if other.kind_of?(Array)
+      self.to_a | other.to_a
+    else
+      self.to_i | other.to_i
+    end
+  end
+  def +(other)
+    case other
+    when Array
+      self.to_a + other
+    when String
+      self.value + other
+    else
+      begin
+	number(self.value) + other
+      rescue
+	self.value + other.to_s
+      end
+    end
+  end
+  def -(other)
+    if other.kind_of?(Array)
+      self.to_a - other
+    else
+      number(self.value) - other
+    end
+  end
+  def *(other)
+    begin
+      number(self.value) * other
+    rescue
+      self.value * other
+    end
+  end
+  def /(other)
+    number(self.value) / other
+  end
+  def %(other)
+    begin
+      number(self.value) % other
+    rescue
+      self.value % other
+    end
+  end
+  def **(other)
+    number(self.value) ** other
+  end
+  def =~(other)
+    self.value =~ other
+  end
+
   def ==(other)
     case other
     when TkVariable
@@ -1861,13 +1969,38 @@ class TkVariable
       self.to_f == other
     when Array
       self.to_a == other
+    when Hash
+      self.value == other
     else
       false
     end
   end
 
-  def to_a
-    list(value)
+  def zero?
+    numeric.zero?
+  end
+  def nonzero?
+    !(numeric.zero?)
+  end
+
+  def <=>(other)
+    if other.kind_of?(TkVariable)
+      begin
+	val = other.numeric
+	other = val
+      rescue
+	other = other.value
+      end
+    end
+    if other.kind_of?(Numeric)
+      begin
+	return self.numeric <=> other
+      rescue
+	return self.value <=> other.to_s
+      end
+    else
+      return self.value <=> other
+    end
   end
 
   def to_eval
@@ -3082,9 +3215,16 @@ TkOption = TkOptionDB
 TkResourceDB = TkOptionDB
 
 module TkTreatFont
-  def font_configinfo
+  def font_configinfo(name = nil)
     ret = TkFont.used_on(self.path)
     if ret == nil
+=begin
+      if name
+	ret = name
+      else
+	ret = TkFont.init_widget_font(self.path, self.path, 'configure')
+      end
+=end
       ret = TkFont.init_widget_font(self.path, self.path, 'configure')
     end
     ret
@@ -3097,7 +3237,10 @@ module TkTreatFont
       if fnt.kind_of? TkFont
 	return fnt.call_font_configure(self.path, self.path,'configure',slot)
       else
-	latinfont_configure(fnt) if fnt
+	if fnt
+	  latinfont_configure(fnt)
+	  kanjifont_configure(fnt)
+	end
       end
     end
     if (ltn = slot.delete('latinfont'))
@@ -3192,10 +3335,18 @@ module TkTreatItemFont
   end
   private :__conf_cmd, :__item_pathname
 
-  def tagfont_configinfo(tagOrId)
+  def tagfont_configinfo(tagOrId, name = nil)
     pathname = __item_pathname(tagOrId)
     ret = TkFont.used_on(pathname)
     if ret == nil
+=begin
+      if name
+	ret = name
+      else
+	ret = TkFont.init_widget_font(pathname, self.path, 
+				      __conf_cmd(0), __conf_cmd(1), tagOrId)
+      end
+=end
       ret = TkFont.init_widget_font(pathname, self.path, 
 				    __conf_cmd(0), __conf_cmd(1), tagOrId)
     end
@@ -3212,7 +3363,10 @@ module TkTreatItemFont
 				       __conf_cmd(0), __conf_cmd(1), 
 				       tagOrId, slot)
       else
-	latintagfont_configure(tagOrId, fnt) if fnt
+	if fnt
+	  latintagfont_configure(tagOrId, fnt)
+	  kanjitagfont_configure(tagOrId, fnt)
+	end
       end
     end
     if (ltn = slot.delete('latinfont'))
@@ -3358,6 +3512,12 @@ class TkObject<TkKernel
     case slot.to_s
     when 'text', 'label', 'show', 'data', 'file'
       tk_call path, 'cget', "-#{slot}"
+    when 'font', 'kanjifont'
+      fnt = tk_tcl2ruby(tk_call(path, 'cget', "-#{slot}"))
+      unless fnt.kind_of?(TkFont)
+	fnt = fontobj(fnt)
+      end
+      fnt
     else
       tk_tcl2ruby tk_call(path, 'cget', "-#{slot}")
     end
@@ -3398,7 +3558,10 @@ class TkObject<TkKernel
   def configinfo(slot = nil)
     if slot == 'font' || slot == :font || 
        slot == 'kanjifont' || slot == :kanjifont
-      fontobj
+      conf = tk_split_simplelist(tk_send('configure', "-#{slot}") )
+      conf[0] = conf[0][1..-1]
+      conf[4] = fontobj(conf[4])
+      conf
     else
       if slot
 	case slot.to_s
@@ -3436,7 +3599,7 @@ class TkObject<TkKernel
 	fontconf = ret.assoc('font')
 	if fontconf
 	  ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
-	  fontconf[4] = fontobj
+	  fontconf[4] = fontobj(fontconf[4])
 	  ret.push(fontconf)
 	else
 	  ret
@@ -4367,6 +4530,7 @@ class TkPanedWindow<TkWindow
     end
     self
   end
+  alias pane_config paneconfigure
 
   def paneconfiginfo(win, key=nil)
     if key
@@ -4395,6 +4559,7 @@ class TkPanedWindow<TkWindow
       }
     end
   end
+  alias pane_configinfo paneconfiginfo
 
   def panes
     list(tk_send('panes'))
@@ -4717,6 +4882,12 @@ class TkListbox<TkTextWin
     case key.to_s
     when 'text', 'label', 'show'
       tk_send('itemcget', index, "-#{key}")
+    when 'font', 'kanjifont'
+      fnt = tk_tcl2ruby(tk_send('itemcget', index, "-#{key}"))
+      unless fnt.kind_of?(TkFont)
+	fnt = tagfontobj(index, fnt)
+      end
+      fnt
     else
       tk_tcl2ruby(tk_send('itemcget', index, "-#{key}"))
     end
@@ -4750,13 +4921,17 @@ class TkListbox<TkTextWin
       case key.to_s
       when 'text', 'label', 'show'
 	conf = tk_split_simplelist(tk_send('itemconfigure',index,"-#{key}"))
+      when 'font', 'kanjifont'
+	conf = tk_split_simplelist(tk_send('itemconfigure',index,"-#{key}") )
+	conf[4] = tagfont_configinfo(index, conf[4])
       else
 	conf = tk_split_list(tk_send('itemconfigure',index,"-#{key}"))
       end
       conf[0] = conf[0][1..-1]
       conf
     else
-      tk_split_simplelist(tk_send('itemconfigure', index)).collect{|conflist|
+      ret = tk_split_simplelist(tk_send('itemconfigure', 
+					index)).collect{|conflist|
 	conf = tk_split_simplelist(conflist)
 	conf[0] = conf[0][1..-1]
 	case conf[0]
@@ -4779,6 +4954,14 @@ class TkListbox<TkTextWin
 	end
 	conf
       }
+      fontconf = ret.assoc('font')
+      if fontconf
+	ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
+	fontconf[4] = tagfont_configinfo(index, fontconf[4])
+	ret.push(fontconf)
+      else
+	ret
+      end
     end
   end
 end
@@ -4881,8 +5064,14 @@ class TkMenu<TkWindow
     case key.to_s
     when 'text', 'label', 'show'
       tk_send 'entrycget', index, "-#{key}"
+    when 'font', 'kanjifont'
+      fnt = tk_tcl2ruby(tk_send('entrycget', index, "-#{key}"))
+      unless fnt.kind_of?(TkFont)
+	fnt = tagfontobj(index, fnt)
+      end
+      fnt
     else
-      tk_tcl2ruby tk_send('entrycget', index, "-#{key}")
+      tk_tcl2ruby(tk_send('entrycget', index, "-#{key}"))
     end
   end
   def entryconfigure(index, key, val=None)
@@ -4914,13 +5103,17 @@ class TkMenu<TkWindow
       case key.to_s
       when 'text', 'label', 'show'
 	conf = tk_split_simplelist(tk_send('entryconfigure',index,"-#{key}"))
+      when 'font', 'kanjifont'
+	conf = tk_split_simplelist(tk_send('entryconfigure',index,"-#{key}"))
+	conf[4] = tagfont_configinfo(index, conf[4])
       else
 	conf = tk_split_list(tk_send('entryconfigure',index,"-#{key}"))
       end
       conf[0] = conf[0][1..-1]
       conf
     else
-      tk_split_simplelist(tk_send('entryconfigure', index)).collect{|conflist|
+      ret = tk_split_simplelist(tk_send('entryconfigure', 
+					index)).collect{|conflist|
 	conf = tk_split_simplelist(conflist)
 	conf[0] = conf[0][1..-1]
 	case conf[0]
@@ -4943,6 +5136,13 @@ class TkMenu<TkWindow
 	end
 	conf
       }
+      if fontconf
+	ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
+	  fontconf[4] = tagfont_configinfo(index, fontconf[4])
+	ret.push(fontconf)
+      else
+	ret
+      end
     end
   end
 end
@@ -5246,6 +5446,16 @@ TkBindTag::ALL.bind(TkVirtualEvent.new('Destroy'), proc{|xpath|
 		      end
 		    }, 'x%W')
 
+# freeze core modules
+TclTkLib.freeze
+TclTkIp.freeze
+TkUtil.freeze
+TkKernel.freeze
+TkComm.freeze
+TkComm::Event.freeze
+TkCore.freeze
+Tk.freeze
+
 # autoload
 autoload :TkCanvas, 'tkcanvas'
 autoload :TkImage, 'tkcanvas'
diff --git a/ext/tk/lib/tkcanvas.rb b/ext/tk/lib/tkcanvas.rb
index a899c9caaf..9e386ee50d 100644
--- a/ext/tk/lib/tkcanvas.rb
+++ b/ext/tk/lib/tkcanvas.rb
@@ -211,6 +211,12 @@ class TkCanvas<TkWindow
       end
     when 'text', 'label', 'show', 'data', 'file', 'maskdata', 'maskfile'
       tk_send 'itemcget', tagid(tagOrId), "-#{option}"
+    when 'font', 'kanjifont'
+      fnt = tk_tcl2ruby(tk_send('itemcget', tagid(tagOrId), "-#{option}"))
+      unless fnt.kind_of?(TkFont)
+	fnt = tagfontobj(tagid(tagOrId), fnt)
+      end
+      fnt
     else
       tk_tcl2ruby tk_send('itemcget', tagid(tagOrId), "-#{option}")
     end
@@ -264,6 +270,10 @@ class TkCanvas<TkWindow
       when 'text', 'label', 'show', 'data', 'file', 'maskdata', 'maskfile'
 	conf = tk_split_simplelist(tk_send('itemconfigure', 
 					   tagid(tagOrId), "-#{key}"))
+      when 'font', 'kanjifont'
+	conf = tk_split_simplelist(tk_send('itemconfigure',
+					   tagid(tagOrId),"-#{key}") )
+	conf[4] = tagfont_configinfo(tagid(tagOrId), conf[4])
       else
 	conf = tk_split_list(tk_send('itemconfigure', 
 				     tagid(tagOrId), "-#{key}"))
@@ -271,8 +281,8 @@ class TkCanvas<TkWindow
       conf[0] = conf[0][1..-1]
       conf
     else
-      tk_split_simplelist(tk_send('itemconfigure', 
-				  tagid(tagOrId))).collect{|conflist|
+      ret = tk_split_simplelist(tk_send('itemconfigure', 
+					tagid(tagOrId))).collect{|conflist|
 	conf = tk_split_simplelist(conflist)
 	conf[0] = conf[0][1..-1]
 	case conf[0]
@@ -302,6 +312,14 @@ class TkCanvas<TkWindow
 	end
 	conf
       }
+      fontconf = ret.assoc('font')
+      if fontconf
+	ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
+	fontconf[4] = tagfont_configinfo(tagid(tagOrId), fontconf[4])
+	ret.push(fontconf)
+      else
+	ret
+      end
     end
   end
 
diff --git a/ext/tk/lib/tkfont.rb b/ext/tk/lib/tkfont.rb
index eb21b1fabf..f0c88e432d 100644
--- a/ext/tk/lib/tkfont.rb
+++ b/ext/tk/lib/tkfont.rb
@@ -34,19 +34,21 @@ class TkFont
           # Tcl/Tk-JP for Windows
           ltn = 'defaultgui'
           knj = 'defaultgui'
-	when /Mincho:Helvetica-12/
+	when /Mincho:Helvetica-Bold-12/
           # Tcl/Tk-JP for UNIX/X
           ltn, knj = tk_split_simplelist(tk_call('font', 'configure', 
-                                                 'Mincho:Helvetica-12', 
+                                                 'Mincho:Helvetica-Bold-12', 
                                                  '-compound'))
         else
           # unknown Tcl/Tk-JP
 	  platform = tk_call('set', 'tcl_platform(platform)')
 	  case platform
 	  when 'unix'
-	    ltn = {'family'=>'Helvetica'.freeze, 'size'=>-12}
-	    knj = 'k14'
+	    ltn = {'family'=>'Helvetica'.freeze, 
+	           'size'=>-12, 'weight'=>'bold'.freeze}
+	    #knj = 'k14'
 	    #knj = '-misc-fixed-medium-r-normal--14-*-*-*-c-*-jisx0208.1983-0'
+	    knj = '-*-fixed-bold-r-normal--12-*-*-*-c-*-jisx0208.1983-0'
 	  when 'windows'
 	    ltn = {'family'=>'MS Sans Serif'.freeze, 'size'=>8}
 	    knj = 'mincho'
@@ -68,9 +70,11 @@ class TkFont
 	platform = tk_call('set', 'tcl_platform(platform)')
 	case platform
 	when 'unix'
-	  ltn = {'family'=>'Helvetica'.freeze, 'size'=>-12}
-	  knj = 'k14'
+	  ltn = {'family'=>'Helvetica'.freeze, 
+	         'size'=>-12, 'weight'=>'bold'.freeze}
+	  #knj = 'k14'
 	  #knj = '-misc-fixed-medium-r-normal--14-*-*-*-c-*-jisx0208.1983-0'
+	  knj = '-*-fixed-bold-r-normal--12-*-*-*-c-*-jisx0208.1983-0'
 	when 'windows'
 	  ltn = {'family'=>'MS Sans Serif'.freeze, 'size'=>8}
 	  knj = 'mincho'
@@ -133,7 +137,7 @@ class TkFont
   end
 
   def TkFont.create_copy(font)
-    fail 'source-font need to be TkFont' unless font.kind_of? TkFont
+    fail 'source-font must be a TkFont object' unless font.kind_of? TkFont
     keys = {}
     font.configinfo.each{|key,value| keys[key] = value }
     TkFont.new(font.latin_font, font.kanji_font, keys)
@@ -220,11 +224,46 @@ class TkFont
   ###################################
   private
   ###################################
-  def initialize(ltn=DEFAULT_LATIN_FONT_NAME, knj=nil, keys=nil)
+  def initialize(ltn=nil, knj=nil, keys=nil)
     @id = Tk_FontID.join
     Tk_FontID[1].succ!
     Tk_FontNameTBL[@id] = self
-    knj = DEFAULT_KANJI_FONT_NAME if JAPANIZED_TK && !knj
+
+    if knj.kind_of?(Hash) && !keys
+      keys = knj
+      knj = nil
+    end
+
+    # compound font check
+    if /^8\.*/ === Tk::TK_VERSION  && JAPANIZED_TK
+      begin
+	compound = tk_split_simplelist(tk_call('font', 'configure', 
+					       ltn, '-compound'))
+	if knj == nil
+	  if compound != []
+	    ltn, knj = compound
+	  end
+	else
+	  if compound != []
+	    ltn = compound[0]
+	  end
+	  compound = tk_split_simplelist(tk_call('font', 'configure', 
+						 knj, '-compound'))
+	  if compound != []
+	    knj = compound[1]
+	  end
+	end
+      rescue
+      end
+    end
+
+    if ltn
+      knj = ltn if JAPANIZED_TK && !knj
+    else
+      ltn = DEFAULT_LATIN_FONT_NAME
+      knj = DEFAULT_KANJI_FONT_NAME if JAPANIZED_TK && !knj
+    end
+
     create_compoundfont(ltn, knj, keys)
   end
 
@@ -457,8 +496,48 @@ class TkFont
     @compoundfont = @id + 'c'
     if JAPANIZED_TK
       @fontslot = {'font'=>@compoundfont}
-      tk_call('font', 'create', @compoundfont, 
-	      '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+      begin
+	tk_call('font', 'create', @compoundfont, 
+		'-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+      rescue RuntimeError => e
+	if ltn == knj
+	  if e.message =~ /kanji font .* specified/
+	    tk_call('font', 'delete', @latinfont)
+	    create_latinfont(DEFAULT_LATIN_FONT_NAME)
+	    opts = []
+	    Hash[*(tk_split_simplelist(tk_call('font', 'configure', 
+					       @kanjifont)))].each{|k,v|
+	      case k
+	      when '-size', '-weight', '-slant', '-underline', '-overstrike'
+		opts << k << v
+	      end
+	    }
+	    tk_call('font', 'configure', @latinfont, *opts)
+	    tk_call('font', 'create', @compoundfont, 
+		    '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+
+	  elsif e.message =~ /ascii font .* specified/
+	    tk_call('font', 'delete', @kanjifont)
+	    create_kanjifont(DEFAULT_KANJI_FONT_NAME)
+	    opts = []
+	    Hash[*(tk_split_simplelist(tk_call('font', 'configure', 
+					       @latinfont)))].each{|k,v|
+	      case k
+	      when '-size', '-weight', '-slant', '-underline', '-overstrike'
+		opts << k << v
+	      end
+	    }
+	    tk_call('font', 'configure', @kanjifont, *opts)
+	    tk_call('font', 'create', @compoundfont, 
+		    '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+
+	  else
+	    raise e
+	  end
+	else
+	  raise e
+	end
+      end
     else
       tk_call('font', 'create', @compoundfont)
 
@@ -529,7 +608,8 @@ class TkFont
   end
 
   def configure_core_tk4x(font, slot, value=None)
-    ""
+    #""
+    self
   end
 
   def configinfo_core_tk4x(font, option=nil)
@@ -544,11 +624,70 @@ class TkFont
   end
 
   def configure_core_tk8x(font, slot, value=None)
+    if JAPANIZED_TK
+      begin
+	padjust = tk_call('font', 'configure', font, '-pointadjust')
+      rescue
+	padjust = nil
+      end
+    else
+      padjust = nil
+    end
     if slot.kind_of? Hash
-      tk_call 'font', 'configure', font, *hash_kv(slot)
+      if JAPANIZED_TK && (slot.key?('family') || slot.key?(:family))
+	slot = _symbolkey2str(slot)
+	configure_core_tk8x(font, 'family', slot.delete('family'))
+      end
+
+      if ((slot.key?('size') || slot.key?(:size)) && 
+	  padjust && !slot.key?('pointadjust') && !slot.key?(:pointadjust))
+	tk_call('font', 'configure', font, 
+		'-pointadjust', padjust, *hash_kv(slot))
+      else
+	tk_call('font', 'configure', font, *hash_kv(slot))
+      end
+    elsif (slot == 'size' || slot == :size) && padjust != nil
+      tk_call('font', 'configure', font, 
+	      "-#{slot}", value, '-pointadjust', padjust)
+    elsif JAPANIZED_TK && (slot == 'family' || slot == :family)
+      # coumpund font?
+      begin
+	compound = tk_split_simplelist(tk_call('font', 'configure', 
+					       font, '-compound'))
+      rescue
+	tk_call('font', 'configure', font, '-family', value)
+	return self
+      end
+      if compound == []
+	tk_call('font', 'configure', font, '-family', value)
+	return self
+      end
+      ltn, knj = compound
+
+      lfnt = tk_call('font', 'create', '-copy', ltn)
+      begin
+	tk_call('font', 'configure', lfnt, '-family', value)
+	latin_replace_core_tk8x(lfnt)
+      rescue RuntimeError => e
+	fail e if $DEBUG
+      ensure
+	tk_call('font', 'delete', lfnt) if lfnt != ''
+      end
+
+      kfnt = tk_call('font', 'create', '-copy', knj)
+      begin
+	tk_call('font', 'configure', kfnt, '-family', value)
+	kanji_replace_core_tk8x(lfnt)
+      rescue RuntimeError => e
+	fail e if $DEBUG
+      ensure
+	tk_call('font', 'delete', kfnt) if kfnt != ''
+      end
+      
     else
-      tk_call 'font', 'configure', font, "-#{slot}", value
+      tk_call('font', 'configure', font, "-#{slot}", value)
     end
+    self
   end
 
   def configinfo_core_tk8x(font, option=nil)
@@ -659,20 +798,90 @@ class TkFont
   end
 
   def latin_replace_core_tk8x(ltn)
+    if JAPANIZED_TK
+      begin
+	tk_call('font', 'delete', '@font_tmp')
+      rescue
+      end
+      begin
+	fnt_bup = tk_call('font', 'create', '@font_tmp', '-copy', @latinfont)
+      rescue
+	fnt_bup = ''
+      end
+    end
+
     begin
       tk_call('font', 'delete', @latinfont)
     rescue
     end
     create_latinfont(ltn)
+
+    if JAPANIZED_TK
+      keys = self.configinfo
+      tk_call('font', 'delete', @compoundfont)
+      begin
+	tk_call('font', 'create', @compoundfont, 
+		'-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+      rescue RuntimeError => e
+	tk_call('font', 'delete', @latinfont)
+	if fnt_bup != ''
+	  tk_call('font', 'create', @latinfont, '-copy', fnt_bup)
+	  tk_call('font', 'create', @compoundfont, 
+		  '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+	  tk_call('font', 'delete', fnt_bup)
+	end
+	fail e
+      end
+    else
+      latinkeys = {}
+      begin
+	actual_core(@latinfont).each{|key,val| latinkeys[key] = val}
+      rescue
+	latinkeys {}
+      end
+      if latinkeys != {}
+	tk_call('font', 'configure', @compoundfont, *hash_kv(latinkeys))
+      end
+    end    
     self
   end
 
   def kanji_replace_core_tk8x(knj)
+    if JAPANIZED_TK
+      begin
+	tk_call('font', 'delete', '@font_tmp')
+      rescue
+      end
+      begin
+	fnt_bup = tk_call('font', 'create', '@font_tmp', '-copy', @kanjifont)
+      rescue
+	fnt_bup = ''
+      end
+    end
+
     begin
       tk_call('font', 'delete', @kanjifont)
     rescue
     end
     create_kanjifont(knj)
+
+    if JAPANIZED_TK
+      keys = self.configinfo
+      tk_call('font', 'delete', @compoundfont)
+      begin
+	tk_call('font', 'create', @compoundfont, 
+		'-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+      rescue RuntimeError => e
+	tk_call('font', 'delete', @kanjifont)
+	if fnt_bup != ''
+	  tk_call('font', 'create', @kanjifont, '-copy', fnt_bup)
+	  tk_call('font', 'create', @compoundfont, 
+		  '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+	  tk_call('font', 'delete', fnt_bup)
+	end
+	fail e
+      end
+    end    
     self
   end
 
@@ -737,7 +946,7 @@ class TkFont
     alias measure_core        measure_core_tk4x
     alias metrics_core        metrics_core_tk4x
 
-  when /^8\.[0123]/
+  when /^8\.[0-4]/
     alias create_latinfont    create_latinfont_tk8x
     alias create_kanjifont    create_kanjifont_tk8x
     alias create_compoundfont create_compoundfont_tk8x
diff --git a/ext/tk/lib/tktext.rb b/ext/tk/lib/tktext.rb
index ae40ac8750..9f1ad24665 100644
--- a/ext/tk/lib/tktext.rb
+++ b/ext/tk/lib/tktext.rb
@@ -330,6 +330,12 @@ class TkText<TkTextWin
     case key.to_s
     when 'text', 'label', 'show', 'data', 'file'
       tk_call(@path, 'tag', 'cget', tag, "-#{key}")
+    when 'font', 'kanjifont'
+      fnt = tk_tcl2ruby(tk_send('tag', 'cget', tag, "-#{key}"))
+      unless fnt.kind_of?(TkFont)
+	fnt = tagfontobj(tag, fnt)
+      end
+      fnt
     else
       tk_tcl2ruby(tk_call(@path, 'tag', 'cget', tag, "-#{key}"))
     end
@@ -363,13 +369,17 @@ class TkText<TkTextWin
       case key.to_s
       when 'text', 'label', 'show', 'data', 'file'
 	conf = tk_split_simplelist(tk_send('tag','configure',tag,"-#{key}"))
+      when 'font', 'kanjifont'
+	conf = tk_split_simplelist(tk_send('tag','configure',tag,"-#{key}") )
+	conf[4] = tagfont_configinfo(tag, conf[4])
       else
 	conf = tk_split_list(tk_send('tag','configure',tag,"-#{key}"))
       end
       conf[0] = conf[0][1..-1]
       conf
     else
-      tk_split_simplelist(tk_send('tag', 'configure', tag)).collect{|conflist|
+      ret = tk_split_simplelist(tk_send('tag', 'configure', 
+					tag)).collect{|conflist|
 	conf = tk_split_simplelist(conflist)
 	conf[0] = conf[0][1..-1]
 	case conf[0]
@@ -392,6 +402,14 @@ class TkText<TkTextWin
 	end
 	conf
       }
+      fontconf = ret.assoc('font')
+      if fontconf
+	ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
+	fontconf[4] = tagfont_configinfo(tag, fontconf[4])
+	ret.push(fontconf)
+      else
+	ret
+      end
     end
   end
 
@@ -431,6 +449,12 @@ class TkText<TkTextWin
     case slot.to_s
     when 'text', 'label', 'show', 'data', 'file'
       tk_send('window', 'cget', index, "-#{slot}")
+    when 'font', 'kanjifont'
+      fnt = tk_tcl2ruby(tk_send('window', 'cget', index, "-#{slot}"))
+      unless fnt.kind_of?(TkFont)
+	fnt = tagfontobj(index, fnt)
+      end
+      fnt
     else
       tk_tcl2ruby(tk_send('window', 'cget', index, "-#{slot}"))
     end
@@ -853,8 +877,14 @@ class TkTextTag<TkObject
     case key.to_s
     when 'text', 'label', 'show', 'data', 'file'
       tk_call @t.path, 'tag', 'cget', @id, "-#{key}"
+    when 'font', 'kanjifont'
+      fnt = tk_tcl2ruby(tk_call(@t.path, 'tag', 'cget', @id, "-#{key}"))
+      unless fnt.kind_of?(TkFont)
+	fnt = tagfontobj(@id, fnt)
+      end
+      fnt
     else
-      tk_tcl2ruby tk_call(@t.path, 'tag', 'cget', @id, "-#{key}")
+      tk_tcl2ruby(tk_call(@t.path, 'tag', 'cget', @id, "-#{key}"))
     end
   end