* ext/tk/tcltklib.c: bug fix on treating Unicode strings.

* ext/tk/tcltklib.c: add methods to treat encoding mode.
* ext/tk/MANUAL_tcltklib.eng: add description of TclTkLib#encoding,
  encoding_system, and so on.
* ext/tk/MANUAL_tcltklib.eucj: ditto.
* ext/tk/tkutil/tkutil.c: fail to create a Tcl's list string from
  an array including multiple kind of encoded strings.
* ext/tk/lib/tk.rb: ditto.
* ext/tk/lib/multi-tk.rb: 2nd arg of _{to|from}UTF8 is omissible.
* ext/tk/lib/remote-tk.rb: ditto.
* ext/tk/lib/tk.rb: override TclTkLib#encoding and encoding= to
  use TkCore::INTERP.encoding and encoding=.
* ext/tk/lib/tk.rb: when "require 'tk'" and $KCODE=='NONE', check
  DEFAULT_TK_ENCODING to decide Ruby/Tk's system encoding mode.
* ext/tk/lib/tk/encodedstr.rb: check both of Tk.encoding and
  Tk.encoding_system. Tk.encoding has higher priority.
* ext/tk/lib/tk/optiondb.rb: ditto.
* ext/tk/lib/tk/spinbox.rb: ditto.
* ext/tk/lib/tk/validation.rb: ditto.
* ext/tk/lib/tk/namespace.rb: arguemnts for TclTkIp#_merge_tklist
  should be UTF-8 strings.


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

ChangeLog

@@ -1,3 +1,41 @@
+Tue Jul  5 14:52:56 2005  Hidetoshi NAGAI  <nagai@ai.kyutech.ac.jp>
+
+	* ext/tk/tcltklib.c: bug fix on treating Unicode strings. 
+
+	* ext/tk/tcltklib.c: add methods to treat encoding mode.
+
+	* ext/tk/MANUAL_tcltklib.eng: add description of TclTkLib#encoding, 
+	  encoding_system, and so on.
+
+	* ext/tk/MANUAL_tcltklib.eucj: ditto.
+
+	* ext/tk/tkutil/tkutil.c: fail to create a Tcl's list string from 
+	  an array including multiple kind of encoded strings.
+
+	* ext/tk/lib/tk.rb: ditto.
+
+	* ext/tk/lib/multi-tk.rb: 2nd arg of _{to|from}UTF8 is omissible.
+
+	* ext/tk/lib/remote-tk.rb: ditto.
+
+	* ext/tk/lib/tk.rb: override TclTkLib#encoding and encoding= to 
+	  use TkCore::INTERP.encoding and encoding=.
+
+	* ext/tk/lib/tk.rb: when "require 'tk'" and $KCODE=='NONE', check 
+	  DEFAULT_TK_ENCODING to decide Ruby/Tk's system encoding mode.
+
+	* ext/tk/lib/tk/encodedstr.rb: check both of Tk.encoding and
+	  Tk.encoding_system. Tk.encoding has higher priority.
+
+	* ext/tk/lib/tk/optiondb.rb: ditto.
+
+	* ext/tk/lib/tk/spinbox.rb: ditto.
+
+	* ext/tk/lib/tk/validation.rb: ditto.
+
+	* ext/tk/lib/tk/namespace.rb: arguemnts for TclTkIp#_merge_tklist
+	  should be UTF-8 strings.
+
 Mon Jul  4 19:29:32 2005  Hirokazu Yamamoto  <ocean@m2.ccsnet.ne.jp>
 
 	* lib/set.rb: test change to follow revision 1.28. (duck typing?)

ext/tk/MANUAL_tcltklib.eng

@@ -1,5 +1,5 @@
 (tof)
-                                    2004/03/28  Hidetoshi NAGAI
+                                    2005/07/05  Hidetoshi NAGAI
 
 This document discribes about the 'tcltklib' library. Although there
 is the 'tcltk' library (tcltk.rb) under this directory, no description
@@ -126,7 +126,7 @@ module TclTklib
          : defined as 0. 
 
   [module methods]
-    mainloop(check_root = true)
+     mainloop(check_root = true)
        : Starts the eventloop. If 'check_root' is true, this method 
        : doesn't return when a root widget exists. 
        : If 'check_root' is false, doen't return by the other
@@ -227,8 +227,8 @@ module TclTklib
        : Convert the argument to a valid Tcl list element with
        : Tcl/Tk's library function.
 
-    _toUTF8(str, encoding)
+    _toUTF8(str, encoding=nil)
-    _fromUTF8(str, encoding)
+    _fromUTF8(str, encoding=nil)
        : Call the function (which is internal function of Tcl/Tk) to
        : convert to/from a UTF8 string.
 
@@ -239,6 +239,16 @@ module TclTklib
        : _subst_Tcl_backslash method parses all backslash sequence. 
        : _subst_UTF_backslash method parses \uhhhh only.
 
+    encoding_system
+    encoding_system=(encoding)
+       : Get and set Tcl's system encoding.
+
+    encoding
+    encoding=(encoding)
+       : alias of encoding_system / encoding_system=
+       : ( probably, Ruby/Tk's tk.rb will override them )
+
+
 class TclTkIp
   [class methods]
     new(ip_name=nil, options='')
@@ -322,8 +332,8 @@ class TclTkIp
        : to _eval and regist the command once, after that, the
        : command can be called by _invoke. 
 
-    _toUTF8(str, encoding)
+    _toUTF8(str, encoding=nil)
-    _fromUTF8(str, encoding)
+    _fromUTF8(str, encoding=nil)
        : Call the function (which is internal function of Tcl/Tk) to
        : convert to/from a UTF8 string.
 

ext/tk/MANUAL_tcltklib.eucj

@@ -1,5 +1,5 @@
 (tof)
-                                    2004/03/28  Hidetoshi NAGAI
+                                    2005/07/05  Hidetoshi NAGAI
 
 本ドキュメントには古い tcltk ライブラリ，tcltklib ライブラリの説明
 が含まれていますが，その記述内容は古いものとなっています．
@@ -341,8 +341,8 @@ require "tcltklib"
          : 一つのリスト要素として適切な表現になるように変換した文
          : 字列を返す．
 
-      _toUTF8(str, encoding)
+      _toUTF8(str, encoding=nil)
-      _fromUTF8(str, encoding)
+      _fromUTF8(str, encoding=nil)
          : Tcl/Tk が内蔵している UTF8 変換処理を呼び出す．
 
       _subst_UTF_backslash(str)
@@ -353,6 +353,16 @@ require "tcltklib"
          : 置き換えるのに対し，_subst_UTF_backslash は \uhhhh 
          : による Unicode 文字表現だけを置き換える．
 
+      encoding_system
+      encoding_system=(encoding)
+         : Tcl の system encoding の獲得および設定
+
+      encoding
+      encoding=(encoding)
+         : encoding_system / encoding_system= の alias
+         : ( Ruby/Tk の tk.rb では置き換えられる予定のもの．)
+
+
 クラス TclTkIp
    クラスメソッド
       new(ip_name=nil, options='')
@@ -433,8 +443,8 @@ require "tcltklib"
          : して登録に成功しさえすれば，以降は _invoke でも利用で
          : きるようになる．
 
-      _toUTF8(str, encoding)
+      _toUTF8(str, encoding=nil)
-      _fromUTF8(str, encoding)
+      _fromUTF8(str, encoding=nil)
          : Tcl/Tk が内蔵している UTF8 変換処理を呼び出す．
 
       _thread_vwait(var_name)

ext/tk/lib/multi-tk.rb

@@ -1730,11 +1730,11 @@ class << MultiTkIp
     __getip._invoke_with_enc(*args)
   end
 
-  def _toUTF8(str, encoding)
+  def _toUTF8(str, encoding=nil)
     __getip._toUTF8(str, encoding)
   end
 
-  def _fromUTF8(str, encoding)
+  def _fromUTF8(str, encoding=nil)
     __getip._fromUTF8(str, encoding)
   end
 
@@ -2119,11 +2119,11 @@ class MultiTkIp
     @interp._invoke_with_enc(*args)
   end
 
-  def _toUTF8(str, encoding)
+  def _toUTF8(str, encoding=nil)
     @interp._toUTF8(str, encoding)
   end
 
-  def _fromUTF8(str, encoding)
+  def _fromUTF8(str, encoding=nil)
     @interp._fromUTF8(str, encoding)
   end
 

ext/tk/lib/remote-tk.rb

@@ -321,11 +321,11 @@ class RemoteTkIp
     _appsend(true, false, *args)
   end
 
-  def _toUTF8(str, encoding)
+  def _toUTF8(str, encoding=nil)
     @interp._toUTF8(str, encoding)
   end
 
-  def _fromUTF8(str, encoding)
+  def _fromUTF8(str, encoding=nil)
     @interp._fromUTF8(str, encoding)
   end
 

ext/tk/lib/tk.rb

@@ -309,19 +309,48 @@ if USE_TCLs_LIST_FUNCTIONS
   def array2tk_list(ary, enc=nil)
     return "" if ary.size == 0
 
+    sys_enc = TkCore::INTERP.encoding
+    sys_enc = TclTkLib.encoding_system unless sys_enc
+
+    dst_enc = (enc == nil)? sys_enc: enc
+
     dst = ary.collect{|e|
       if e.kind_of? Array
-        array2tk_list(e, enc)
+        s = array2tk_list(e, enc)
       elsif e.kind_of? Hash
         tmp_ary = []
         #e.each{|k,v| tmp_ary << k << v }
         e.each{|k,v| tmp_ary << "-#{_get_eval_string(k)}" << v }
-        array2tk_list(tmp_ary, enc)
+        s = array2tk_list(tmp_ary, enc)
       else
-        _get_eval_string(e, enc)
+        s = _get_eval_string(e, enc)
       end
+
+      if dst_enc != true && dst_enc != false
+        if (s_enc = s.instance_variable_get(:@encoding))
+          s_enc = s_enc.to_s
+        else
+          s_enc = sys_enc
+        end
+        dst_enc = true if s_enc != dst_enc
+      end
+
+      s
     }
-    TkCore::INTERP._merge_tklist(*dst)
+
+    if sys_enc && dst_enc
+      dst.map!{|s| _toUTF8(s)}
+      ret = TkCore::INTERP._merge_tklist(*dst)
+      if dst_enc.kind_of?(String)
+        ret = _fromUTF8(ret, dst_enc)
+        ret.instance_variable_set(:@encoding, dst_enc)
+      else
+        ret.instance_variable_set(:@encoding, 'utf-8')
+      end
+      ret
+    else
+      TkCore::INTERP._merge_tklist(*dst)
+    end
   end
 
 else
@@ -2163,6 +2192,15 @@ if (/^(8\.[1-9]|9\.|[1-9][0-9])/ =~ Tk::TCL_VERSION && !Tk::JAPANIZED_TK)
 =end
   end
 
+  module TclTkLib
+    def self.encoding=(name)
+      TkCore::INTERP.encoding = name
+    end
+    def self.encoding
+      TkCore::INTERP.encoding
+    end
+  end
+
   module Tk
     module Encoding
       extend Encoding
@@ -2231,6 +2269,9 @@ if (/^(8\.[1-9]|9\.|[1-9][0-9])/ =~ Tk::TCL_VERSION && !Tk::JAPANIZED_TK)
     Tk.encoding = 'utf-8'
     Tk.encoding_system = 'utf-8'
   else        # NONE
+    if defined? DEFAULT_TK_ENCODING
+      Tk.encoding_system = DEFAULT_TK_ENCODING
+    end
     begin
       Tk.encoding = Tk.encoding_system
     rescue StandardError, NameError
@@ -4153,7 +4194,7 @@ end
 #Tk.freeze
 
 module Tk
-  RELEASE_DATE = '2005-06-24'.freeze
+  RELEASE_DATE = '2005-07-05'.freeze
 
   autoload :AUTO_PATH,        'tk/variable'
   autoload :TCL_PACKAGE_PATH, 'tk/variable'

ext/tk/lib/tk/encodedstr.rb

@@ -67,9 +67,13 @@ module Tk
 
     def initialize(str, enc = nil)
       super(str)
+      # @encoding = ( enc || 
+      #              ((self.class::Encoding)? 
+      #                  self.class::Encoding : Tk.encoding_system) )
       @encoding = ( enc || 
-                   ((self.class::Encoding)? 
+                   ((self.class::Encoding)?
-                       self.class::Encoding : Tk.encoding_system) )
+                         self.class::Encoding : 
+                         ((Tk.encoding)? Tk.encoding : Tk.encoding_system) ) )
     end
 
     attr_reader :encoding

ext/tk/lib/tk/namespace.rb

@@ -115,19 +115,19 @@ class TkNamespace < TkObject
     # alias __tk_call_with_enc    tk_call_with_enc
     def tk_call(*args)
       #super('namespace', 'eval', @namespace, *args)
-      args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+      args = args.collect{|arg| (s = _get_eval_string(arg, true))? s: ''}
       super('namespace', 'eval', @namespace, 
             TkCore::INTERP._merge_tklist(*args))
     end
     def tk_call_without_enc(*args)
       #super('namespace', 'eval', @namespace, *args)
-      args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+      args = args.collect{|arg| (s = _get_eval_string(arg, true))? s: ''}
       super('namespace', 'eval', @namespace, 
             TkCore::INTERP._merge_tklist(*args))
     end
     def tk_call_with_enc(*args)
       #super('namespace', 'eval', @namespace, *args)
-      args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+      args = args.collect{|arg| (s = _get_eval_string(arg, true))? s: ''}
       super('namespace', 'eval', @namespace, 
             TkCore::INTERP._merge_tklist(*args))
     end
@@ -159,19 +159,19 @@ class TkNamespace < TkObject
   alias __tk_call_with_enc    tk_call_with_enc
   def tk_call(*args)
     #super('namespace', 'eval', @fullname, *args)
-    args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+    args = args.collect{|arg| (s = _get_eval_string(arg, true))? s: ''}
     super('namespace', 'eval', @fullname, 
           TkCore::INTERP._merge_tklist(*args))
   end
   def tk_call_without_enc(*args)
     #super('namespace', 'eval', @fullname, *args)
-    args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+    args = args.collect{|arg| (s = _get_eval_string(arg, true))? s: ''}
     super('namespace', 'eval', @fullname,  
           TkCore::INTERP._merge_tklist(*args))
   end
   def tk_call_with_enc(*args)
     #super('namespace', 'eval', @fullname, *args)
-    args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+    args = args.collect{|arg| (s = _get_eval_string(arg, true))? s: ''}
     super('namespace', 'eval', @fullname, 
           TkCore::INTERP._merge_tklist(*args))
   end

ext/tk/lib/tk/optiondb.rb

@@ -44,7 +44,7 @@ module TkOptionDB
         "can't call 'TkOptionDB.read_entries' on a safe interpreter"
     end
 
-    i_enc = Tk.encoding()
+    i_enc = ((Tk.encoding)? Tk.encoding : Tk.encoding_system)
 
     unless f_enc
       f_enc = i_enc

ext/tk/lib/tk/spinbox.rb

@@ -25,7 +25,8 @@ class TkSpinbox<TkEntry
         [ ?w, TkComm.method(:window) ], 
 
         [ ?e, proc{|val|
-            enc = Tk.encoding
+            #enc = Tk.encoding
+            enc = ((Tk.encoding)? Tk.encoding : Tk.encoding_system)
             if enc
               Tk.fromUTF8(TkComm::string(val), enc)
             else

ext/tk/lib/tk/validation.rb

@@ -226,7 +226,8 @@ class TkValidateCommand
       [ ?w, TkComm.method(:window) ], 
 
       [ ?e, proc{|val|
-          enc = Tk.encoding
+          #enc = Tk.encoding
+          enc = ((Tk.encoding)? Tk.encoding : Tk.encoding_system)
           if enc
             Tk.fromUTF8(TkComm::string(val), enc)
           else

ext/tk/tcltklib.c

@@ -4,7 +4,7 @@
  *              Oct. 24, 1997   Y. Matsumoto
  */
 
-#define TCLTKLIB_RELEASE_DATE "2005-06-16"
+#define TCLTKLIB_RELEASE_DATE "2005-07-05"
 
 #include "ruby.h"
 #include "rubysig.h"
@@ -1894,7 +1894,7 @@ ip_set_exc_message(interp, exc)
 
     /* to avoid a garbled error message dialog */
     buf = ALLOC_N(char, (RSTRING(msg)->len)+1);
-    strncpy(buf, RSTRING(msg)->ptr, RSTRING(msg)->len);
+    memcpy(buf, RSTRING(msg)->ptr, RSTRING(msg)->len);
     buf[RSTRING(msg)->len] = 0;
 
     Tcl_DStringInit(&dstr);
@@ -1990,10 +1990,10 @@ ip_ruby_eval_body(arg)
             errtype_len = strlen(errtype);
             len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
             buf = ALLOC_N(char, len + 1);
-            strncpy(buf, errtype, errtype_len);
+            memcpy(buf, errtype, errtype_len);
-            strncpy(buf + errtype_len, 
+            memcpy(buf + errtype_len, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->len);
             *(buf + len) = 0;
 
             RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackReturn, buf);
@@ -2005,10 +2005,10 @@ ip_ruby_eval_body(arg)
             errtype_len = strlen(errtype);
             len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
             buf = ALLOC_N(char, len + 1);
-            strncpy(buf, errtype, errtype_len);
+            memcpy(buf, errtype, errtype_len);
-            strncpy(buf + errtype_len, 
+            memcpy(buf + errtype_len, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->len);
             *(buf + len) = 0;
 
             RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackBreak, buf);
@@ -2020,10 +2020,10 @@ ip_ruby_eval_body(arg)
             errtype_len = strlen(errtype);
             len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
             buf = ALLOC_N(char, len + 1);
-            strncpy(buf, errtype, errtype_len);
+            memcpy(buf, errtype, errtype_len);
-            strncpy(buf + errtype_len, 
+            memcpy(buf + errtype_len, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->len);
             *(buf + len) = 0;
 
             RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackContinue,buf);
@@ -2155,7 +2155,7 @@ ip_ruby_eval(clientData, interp, argc, argv)
 
       str = Tcl_GetStringFromObj(argv[1], &len);
       arg->string = ALLOC_N(char, len + 1);
-      strncpy(arg->string, str, len);
+      memcpy(arg->string, str, len);
       arg->string[len] = 0;
 
       rb_thread_critical = thr_crit_bup;
@@ -2377,10 +2377,10 @@ ip_ruby_cmd_body(arg)
             errtype_len = strlen(errtype);
             len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
             buf = ALLOC_N(char, len + 1);
-            strncpy(buf, errtype, errtype_len);
+            memcpy(buf, errtype, errtype_len);
-            strncpy(buf + errtype_len, 
+            memcpy(buf + errtype_len, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->len);
             *(buf + len) = 0;
 
             RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackReturn, buf);
@@ -2392,10 +2392,10 @@ ip_ruby_cmd_body(arg)
             errtype_len = strlen(errtype);
             len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
             buf = ALLOC_N(char, len + 1);
-            strncpy(buf, errtype, errtype_len);
+            memcpy(buf, errtype, errtype_len);
-            strncpy(buf + errtype_len, 
+            memcpy(buf + errtype_len, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->len);
             *(buf + len) = 0;
 
             RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackBreak, buf);
@@ -2407,10 +2407,10 @@ ip_ruby_cmd_body(arg)
             errtype_len = strlen(errtype);
             len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
             buf = ALLOC_N(char, len + 1);
-            strncpy(buf, errtype, errtype_len);
+            memcpy(buf, errtype, errtype_len);
-            strncpy(buf + errtype_len, 
+            memcpy(buf + errtype_len, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->ptr, 
-                    RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+                   RSTRING(rb_obj_as_string(ruby_errinfo))->len);
             *(buf + len) = 0;
 
             RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackContinue,buf);
@@ -2559,7 +2559,7 @@ ip_ruby_cmd(clientData, interp, argc, argv)
         len = strlen(str);
         buf = ALLOC_N(char, len + 2);
         buf[0] = '$';
-        strncpy(buf + 1, str, len);
+        memcpy(buf + 1, str, len);
         buf[len + 1] = 0;
         receiver = rb_gv_get(buf);
         free(buf);
@@ -5814,7 +5814,7 @@ ip_eval(self, str)
     *alloc_done = 0;
 
     eval_str = ALLOC_N(char, RSTRING(str)->len + 1);
-    strncpy(eval_str, RSTRING(str)->ptr, RSTRING(str)->len);
+    memcpy(eval_str, RSTRING(str)->ptr, RSTRING(str)->len);
     eval_str[RSTRING(str)->len] = 0;
 
     /* allocate memory (freed by Tcl_ServiceEvent) */
@@ -6101,9 +6101,8 @@ lib_toUTF8_core(ip_obj, src, encodename)
         rb_thread_critical = thr_crit_bup;
         return str;
     }
-
     buf = ALLOC_N(char,(RSTRING(str)->len)+1);
-    strncpy(buf, RSTRING(str)->ptr, RSTRING(str)->len);
+    memcpy(buf, RSTRING(str)->ptr, RSTRING(str)->len);
     buf[RSTRING(str)->len] = 0;
 
     Tcl_DStringInit(&dstr);
@@ -6112,7 +6111,8 @@ lib_toUTF8_core(ip_obj, src, encodename)
     Tcl_ExternalToUtfDString(encoding, buf, RSTRING(str)->len, &dstr);
 
     /* str = rb_tainted_str_new2(Tcl_DStringValue(&dstr)); */
-    str = rb_str_new2(Tcl_DStringValue(&dstr));
+    /* str = rb_str_new2(Tcl_DStringValue(&dstr)); */
+    str = rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
     rb_ivar_set(str, ID_at_enc, rb_tainted_str_new2("utf-8"));
     if (taint_flag) OBJ_TAINT(str);
 
@@ -6261,7 +6261,7 @@ lib_fromUTF8_core(ip_obj, src, encodename)
     }
 
     buf = ALLOC_N(char,strlen(RSTRING(str)->ptr)+1);
-    strncpy(buf, RSTRING(str)->ptr, RSTRING(str)->len);
+    memcpy(buf, RSTRING(str)->ptr, RSTRING(str)->len);
     buf[RSTRING(str)->len] = 0;
 
     Tcl_DStringInit(&dstr);
@@ -6270,7 +6270,8 @@ lib_fromUTF8_core(ip_obj, src, encodename)
     Tcl_UtfToExternalDString(encoding,buf,RSTRING(str)->len,&dstr);
 
     /* str = rb_tainted_str_new2(Tcl_DStringValue(&dstr)); */
-    str = rb_str_new2(Tcl_DStringValue(&dstr));
+    /* str = rb_str_new2(Tcl_DStringValue(&dstr)); */
+    str = rb_str_new(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
     rb_ivar_set(str, ID_at_enc, encodename);
 
     if (taint_flag) OBJ_TAINT(str);
@@ -6337,7 +6338,7 @@ lib_UTF_backslash_core(self, str, all_bs)
     rb_thread_critical = Qtrue;
 
     src_buf = ALLOC_N(char,(RSTRING(str)->len)+1);
-    strncpy(src_buf, RSTRING(str)->ptr, RSTRING(str)->len);
+    memcpy(src_buf, RSTRING(str)->ptr, RSTRING(str)->len);
     src_buf[RSTRING(str)->len] = 0;
 
     dst_buf = ALLOC_N(char,(RSTRING(str)->len)+1);
@@ -6380,6 +6381,41 @@ lib_Tcl_backslash(self, str)
     return lib_UTF_backslash_core(self, str, 1);
 }
 
+static VALUE
+lib_get_system_encoding(self)
+    VALUE self;
+{
+#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
+    return rb_str_new2(Tcl_GetEncodingName((Tcl_Encoding)NULL));
+#else
+    return Qnil;
+#endif
+}
+
+static VALUE
+lib_set_system_encoding(self, enc_name)
+    VALUE self;
+    VALUE enc_name;
+{
+#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
+    if NIL_P(enc_name) {
+        Tcl_SetSystemEncoding((Tcl_Interp *)NULL, (CONST char *)NULL);
+        return lib_get_system_encoding(self);
+    }
+
+    enc_name = rb_funcall(enc_name, ID_to_s, 0, 0);
+    if (Tcl_SetSystemEncoding((Tcl_Interp *)NULL, 
+                              RSTRING(enc_name)->ptr) != TCL_OK) {
+        rb_raise(rb_eArgError, "unknown encoding name '%s'", 
+                 RSTRING(enc_name)->ptr);
+    }
+
+    return enc_name;
+#else
+    return Qnil;
+#endif
+}
+
 
 /* invoke Tcl proc */
 struct invoke_info {
@@ -8500,6 +8536,15 @@ Init_tcltklib()
     rb_define_module_function(lib, "_subst_Tcl_backslash", 
                               lib_Tcl_backslash, 1);
 
+    rb_define_module_function(lib, "encoding_system", 
+                              lib_get_system_encoding, 0);
+    rb_define_module_function(lib, "encoding_system=", 
+                              lib_set_system_encoding, 1);
+    rb_define_module_function(lib, "encoding", 
+                              lib_get_system_encoding, 0);
+    rb_define_module_function(lib, "encoding=", 
+                              lib_set_system_encoding, 1);
+
     /* --------------------------------------------------------------- */
 
     rb_define_alloc_func(ip, ip_alloc);

ext/tk/tkutil/tkutil.c

@@ -8,7 +8,7 @@
 
 ************************************************/
 
-#define TKUTIL_RELEASE_DATE "2005-06-14"
+#define TKUTIL_RELEASE_DATE "2005-07-05"
 
 #include "ruby.h"
 #include "rubysig.h"
@@ -31,12 +31,15 @@ static ID ID_toUTF8;
 static ID ID_fromUTF8;
 static ID ID_path;
 static ID ID_at_path;
+static ID ID_at_enc;
 static ID ID_to_eval;
 static ID ID_to_s;
 static ID ID_source;
 static ID ID_downcase;
 static ID ID_install_cmd;
 static ID ID_merge_tklist;
+static ID ID_encoding;
+static ID ID_encoding_system;
 static ID ID_call;
 
 static ID ID_SUBST_INFO;
@@ -237,9 +240,23 @@ ary2list(ary, enc_flag, self)
     VALUE enc_flag;
     VALUE self;
 {
-    int idx, idx2, size, size2;
+    int idx, idx2, size, size2, req_chk_flag;
-    volatile VALUE val, val2;
+    volatile VALUE val, val2, str_val;
     volatile VALUE dst;
+    volatile VALUE sys_enc, dst_enc, str_enc;
+
+    sys_enc = rb_funcall(cTclTkLib, ID_encoding, 0, 0);
+    if NIL_P(sys_enc) {
+      sys_enc = rb_funcall(cTclTkLib, ID_encoding_system, 0, 0);
+    }
+
+    if NIL_P(enc_flag) {
+        dst_enc = sys_enc;
+        req_chk_flag = 1;
+    } else {
+        dst_enc = enc_flag;
+        req_chk_flag = 0;
+    }
 
     /* size = RARRAY(ary)->len; */
     size = 0;
@@ -255,10 +272,25 @@ ary2list(ary, enc_flag, self)
     RARRAY(dst)->len = 0;
     for(idx = 0; idx < RARRAY(ary)->len; idx++) {
         val = RARRAY(ary)->ptr[idx];
+        str_val = Qnil;
         switch(TYPE(val)) {
         case T_ARRAY:
-            RARRAY(dst)->ptr[RARRAY(dst)->len++] 
+            str_val = ary2list(val, enc_flag, self);
-              = ary2list(val, enc_flag, self);
+            RARRAY(dst)->ptr[RARRAY(dst)->len++] = str_val;
+
+            if (req_chk_flag) {
+                str_enc = rb_ivar_get(str_val, ID_at_enc);
+                if NIL_P(str_enc) {
+                    str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
+                } else {
+                    str_enc = sys_enc;
+                }
+                if (!rb_str_cmp(str_enc, dst_enc)) {
+                    dst_enc = Qtrue;
+                    req_chk_flag = 0;
+                }
+            }
+
             break;
 
         case T_HASH:
@@ -273,24 +305,36 @@ ary2list(ary, enc_flag, self)
                 val2 = RARRAY(val)->ptr[idx2];
                 switch(TYPE(val2)) {
                 case T_ARRAY:
-                    RARRAY(dst)->ptr[RARRAY(dst)->len++] 
+                    str_val = ary2list(val2, enc_flag, self);
-                        = ary2list(val2, enc_flag, self);
+                    RARRAY(dst)->ptr[RARRAY(dst)->len++] = str_val;
                     break;
 
                 case T_HASH:
                     if (RTEST(enc_flag)) {
-                        RARRAY(dst)->ptr[RARRAY(dst)->len++] 
+                        str_val = hash2list_enc(val2, self);
-                            = hash2list_enc(val2, self);
                     } else {
-                        RARRAY(dst)->ptr[RARRAY(dst)->len++] 
+                        str_val = hash2list(val2, self);
-                            = hash2list(val2, self);
                     }
+                    RARRAY(dst)->ptr[RARRAY(dst)->len++] = str_val;
                     break;
 
                 default:
                     if (val2 != TK_None) {
-                        RARRAY(dst)->ptr[RARRAY(dst)->len++] 
+                        str_val = get_eval_string_core(val2, enc_flag, self);
-                            = get_eval_string_core(val2, enc_flag, self);
+                        RARRAY(dst)->ptr[RARRAY(dst)->len++] = str_val;
+                    }
+                }
+
+                if (req_chk_flag) {
+                    str_enc = rb_ivar_get(str_val, ID_at_enc);
+                    if NIL_P(str_enc) {
+                        str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
+                    } else {
+                        str_enc = sys_enc;
+                    }
+                    if (!rb_str_cmp(str_enc, dst_enc)) {
+                        dst_enc = Qtrue;
+                        req_chk_flag = 0;
                     }
                 }
             }
@@ -298,12 +342,46 @@ ary2list(ary, enc_flag, self)
 
         default:
             if (val != TK_None) {
-                RARRAY(dst)->ptr[RARRAY(dst)->len++] 
+                str_val = get_eval_string_core(val, enc_flag, self);
-                    = get_eval_string_core(val, enc_flag, self);
+                RARRAY(dst)->ptr[RARRAY(dst)->len++] = str_val;
+
+                if (req_chk_flag) {
+                    str_enc = rb_ivar_get(str_val, ID_at_enc);
+                    if NIL_P(str_enc) {
+                        str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
+                    } else {
+                        str_enc = sys_enc;
+                    }
+                    if (!rb_str_cmp(str_enc, dst_enc)) {
+                        dst_enc = Qtrue;
+                        req_chk_flag = 0;
+                    }
+                }
             }
         }
     }
-    return rb_apply(cTclTkLib, ID_merge_tklist, dst);
+
+    if (RTEST(dst_enc) && !NIL_P(sys_enc)) {
+        for(idx = 0; idx < RARRAY(dst)->len; idx++) {
+            str_val = RARRAY(dst)->ptr[idx];
+            if (rb_respond_to(self, ID_toUTF8)) {
+                str_val = rb_funcall(self, ID_toUTF8, 1, str_val);
+            } else {
+                str_val = rb_funcall(cTclTkLib, ID_toUTF8, 1, str_val);
+            }
+            RARRAY(dst)->ptr[idx] = str_val;
+        }
+        val = rb_apply(cTclTkLib, ID_merge_tklist, dst);
+        if (TYPE(dst_enc) == T_STRING) {
+            val = rb_fun_call(cTclTkLib, ID_fromUTF8, 2, val, dst_enc);
+            rb_ivar_set(val, ID_at_enc, dst_enc);
+        } else {
+            rb_ivar_set(val, ID_at_enc, rb_str_new2("utf-8"));
+        }
+        return val;
+    } else {
+        return rb_apply(cTclTkLib, ID_merge_tklist, dst);
+    }
 }
 
 static VALUE
@@ -312,38 +390,88 @@ ary2list2(ary, enc_flag, self)
     VALUE enc_flag;
     VALUE self;
 {
-    int idx, size;
+    int idx, size, req_chk_flag;
-    volatile VALUE val;
+    volatile VALUE val, str_val;
     volatile VALUE dst;
+    volatile VALUE sys_enc, dst_enc, str_enc;
+
+    sys_enc = rb_funcall(cTclTkLib, ID_encoding, 0, 0);
+    if NIL_P(sys_enc) {
+      sys_enc = rb_funcall(cTclTkLib, ID_encoding_system, 0, 0);
+    }
+
+    if NIL_P(enc_flag) {
+        dst_enc = sys_enc;
+        req_chk_flag = 1;
+    } else {
+        dst_enc = enc_flag;
+        req_chk_flag = 0;
+    }
 
     size = RARRAY(ary)->len;
     dst = rb_ary_new2(size);
     RARRAY(dst)->len = 0;
     for(idx = 0; idx < RARRAY(ary)->len; idx++) {
         val = RARRAY(ary)->ptr[idx];
+        str_val = Qnil;
         switch(TYPE(val)) {
         case T_ARRAY:
-            RARRAY(dst)->ptr[RARRAY(dst)->len++] 
+            str_val = ary2list(val, enc_flag, self);
-              = ary2list(val, enc_flag, self);
             break;
 
         case T_HASH:
             if (RTEST(enc_flag)) {
-                RARRAY(dst)->ptr[RARRAY(dst)->len++] = hash2list(val, self);
+                str_val = hash2list(val, self);
             } else {
-                RARRAY(dst)->ptr[RARRAY(dst)->len++] 
+                str_val = hash2list_enc(val, self);
-                    = hash2list_enc(val, self);
             }
             break;
 
         default:
             if (val != TK_None) {
-                RARRAY(dst)->ptr[RARRAY(dst)->len++] 
+                str_val = get_eval_string_core(val, enc_flag, self);
-                    = get_eval_string_core(val, enc_flag, self);
+            }
+        }
+
+        if (!NIL_P(str_val)) {
+            RARRAY(dst)->ptr[RARRAY(dst)->len++] = str_val;
+
+            if (req_chk_flag) {
+                str_enc = rb_ivar_get(str_val, ID_at_enc);
+                if NIL_P(str_enc) {
+                    str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
+                } else {
+                    str_enc = sys_enc;
+                }
+                if (!rb_str_cmp(str_enc, dst_enc)) {
+                    dst_enc = Qtrue;
+                    req_chk_flag = 0;
+                }
             }
         }
     }
-    return rb_apply(cTclTkLib, ID_merge_tklist, dst);
+
+    if (RTEST(dst_enc) && !NIL_P(sys_enc)) {
+        for(idx = 0; idx < RARRAY(dst)->len; idx++) {
+            str_val = RARRAY(dst)->ptr[idx];
+            if (rb_respond_to(self, ID_toUTF8)) {
+                str_val = rb_funcall(self, ID_toUTF8, 1, str_val);
+            } else {
+                str_val = rb_funcall(cTclTkLib, ID_toUTF8, 1, str_val);
+            }
+            RARRAY(dst)->ptr[idx] = str_val;
+        }
+        val = rb_apply(cTclTkLib, ID_merge_tklist, dst);
+        if (TYPE(dst_enc) == T_STRING) {
+            val = rb_fun_call(cTclTkLib, ID_fromUTF8, 2, val, dst_enc);
+            rb_ivar_set(val, ID_at_enc, dst_enc);
+        } else {
+            rb_ivar_set(val, ID_at_enc, rb_str_new2("utf-8"));
+        }
+        return val;
+    } else {
+        return rb_apply(cTclTkLib, ID_merge_tklist, dst);
+    }
 }
 
 static VALUE
@@ -1395,12 +1523,15 @@ Init_tkutil()
 
     ID_path = rb_intern("path");
     ID_at_path = rb_intern("@path");
+    ID_at_enc = rb_intern("@encoding");
     ID_to_eval = rb_intern("to_eval");
     ID_to_s = rb_intern("to_s");
     ID_source = rb_intern("source");
     ID_downcase = rb_intern("downcase");
     ID_install_cmd = rb_intern("install_cmd");
     ID_merge_tklist = rb_intern("_merge_tklist");
+    ID_encoding = rb_intern("encoding");
+    ID_encoding_system = rb_intern("encoding_system");
     ID_call = rb_intern("call");
 
     /* --------------------- */