Ruby  2.0.0p247(2013-06-27revision41674)
ext/tk/tkutil/tkutil.c
Go to the documentation of this file.
00001 /************************************************
00002 
00003   tkutil.c -
00004 
00005   $Author: nobu $
00006   created at: Fri Nov  3 00:47:54 JST 1995
00007 
00008 ************************************************/
00009 
00010 #define TKUTIL_RELEASE_DATE "2010-03-26"
00011 
00012 #include "ruby.h"
00013 
00014 #ifdef RUBY_VM
00015 static int rb_thread_critical; /* dummy */
00016 #else
00017 /* On Ruby 1.8.x, use rb_thread_critical (defined at rubysig.h) */
00018 #include "rubysig.h"
00019 #endif
00020 #ifdef HAVE_RUBY_ST_H
00021 #include "ruby/st.h"
00022 #else
00023 #include "st.h"
00024 #endif
00025 
00026 #if !defined(RHASH_TBL)
00027 #define RHASH_TBL(h) (RHASH(h)->tbl)
00028 #endif
00029 #if !defined(RSTRING_PTR)
00030 #define RSTRING_PTR(s) (RSTRING(s)->ptr)
00031 #define RSTRING_LEN(s) (RSTRING(s)->len)
00032 #endif
00033 #if !defined(RARRAY_PTR)
00034 #define RARRAY_PTR(s) (RARRAY(s)->ptr)
00035 #define RARRAY_LEN(s) (RARRAY(s)->len)
00036 #endif
00037 
00038 #if defined(HAVE_STRNDUP) && !defined(_GNU_SOURCE)
00039 extern char *strndup(const char* _ptr, size_t _len);
00040 #endif
00041 
00042 static VALUE cMethod;
00043 
00044 static VALUE cTclTkLib;
00045 
00046 static VALUE cTkObject;
00047 static VALUE cTkCallbackEntry;
00048 
00049 static VALUE TK_None;
00050 
00051 static VALUE cCB_SUBST;
00052 static VALUE cSUBST_INFO;
00053 
00054 static VALUE ENCODING_NAME_UTF8; /* for saving GC cost */
00055 
00056 static ID ID_split_tklist;
00057 static ID ID_toUTF8;
00058 static ID ID_fromUTF8;
00059 static ID ID_path;
00060 static ID ID_at_path;
00061 static ID ID_at_enc;
00062 static ID ID_to_eval;
00063 static ID ID_to_s;
00064 static ID ID_source;
00065 static ID ID_downcase;
00066 static ID ID_install_cmd;
00067 static ID ID_merge_tklist;
00068 static ID ID_encoding;
00069 static ID ID_encoding_system;
00070 static ID ID_call;
00071 
00072 static ID ID_SUBST_INFO;
00073 
00074 static VALUE CALLBACK_TABLE;
00075 static unsigned long CALLBACK_ID_NUM = 0;
00076 
00077 /*************************************/
00078 
00079 #if defined(HAVE_RB_OBJ_INSTANCE_EXEC) && !defined(RUBY_VM)
00080 extern VALUE rb_obj_instance_exec _((int, VALUE*, VALUE));
00081 #endif
00082 static VALUE
00083 tk_s_new(argc, argv, klass)
00084     int argc;
00085     VALUE *argv;
00086     VALUE klass;
00087 {
00088     VALUE obj = rb_class_new_instance(argc, argv, klass);
00089 
00090     if (rb_block_given_p()) {
00091 #ifndef HAVE_RB_OBJ_INSTANCE_EXEC
00092       rb_obj_instance_eval(0, 0, obj);
00093 #else
00094       rb_obj_instance_exec(1, &obj, obj);
00095 #endif
00096     }
00097     return obj;
00098 }
00099 
00100 /*************************************/
00101 
00102 static VALUE
00103 tkNone_to_s(self)
00104     VALUE self;
00105 {
00106     return rb_str_new2("");
00107 }
00108 
00109 static VALUE
00110 tkNone_inspect(self)
00111     VALUE self;
00112 {
00113     return rb_str_new2("None");
00114 }
00115 
00116 /*************************************/
00117 
00118 static VALUE
00119 tk_obj_untrust(self, obj)
00120     VALUE self;
00121     VALUE obj;
00122 {
00123 #ifdef HAVE_RB_OBJ_TAINT
00124   rb_obj_taint(obj);
00125 #endif
00126 #ifdef HAVE_RB_OBJ_UNTRUST
00127   rb_obj_untrust(obj);
00128 #endif
00129 
00130   return obj;
00131 }
00132 
00133 static VALUE
00134 tk_eval_cmd(argc, argv, self)
00135     int argc;
00136     VALUE argv[];
00137     VALUE self;
00138 {
00139     volatile VALUE cmd, rest;
00140 
00141     rb_scan_args(argc, argv, "1*", &cmd, &rest);
00142     return rb_eval_cmd(cmd, rest, 0);
00143 }
00144 
00145 static VALUE
00146 tk_do_callback(argc, argv, self)
00147     int   argc;
00148     VALUE *argv;
00149     VALUE self;
00150 {
00151 #if 0
00152     volatile VALUE id;
00153     volatile VALUE rest;
00154 
00155     rb_scan_args(argc, argv, "1*", &id, &rest);
00156     return rb_apply(rb_hash_aref(CALLBACK_TABLE, id), ID_call, rest);
00157 #endif
00158     return rb_funcall2(rb_hash_aref(CALLBACK_TABLE, argv[0]),
00159                        ID_call, argc - 1, argv + 1);
00160 }
00161 
00162 static const char cmd_id_head[] = "ruby_cmd TkUtil callback ";
00163 static const char cmd_id_prefix[] = "cmd";
00164 
00165 static VALUE
00166 tk_install_cmd_core(cmd)
00167     VALUE cmd;
00168 {
00169     volatile VALUE id_num;
00170 
00171     id_num = ULONG2NUM(CALLBACK_ID_NUM++);
00172     id_num = rb_funcall(id_num, ID_to_s, 0, 0);
00173     id_num = rb_str_append(rb_str_new2(cmd_id_prefix), id_num);
00174     rb_hash_aset(CALLBACK_TABLE, id_num, cmd);
00175     return rb_str_append(rb_str_new2(cmd_id_head), id_num);
00176 }
00177 
00178 static VALUE
00179 tk_install_cmd(argc, argv, self)
00180     int   argc;
00181     VALUE *argv;
00182     VALUE self;
00183 {
00184     volatile VALUE cmd;
00185 
00186 #if 0
00187     if (rb_scan_args(argc, argv, "01", &cmd) == 0) {
00188         cmd = rb_block_proc();
00189     }
00190     return tk_install_cmd_core(cmd);
00191 #endif
00192     if (argc == 0) {
00193         cmd = rb_block_proc();
00194     } else {
00195         cmd = argv[0];
00196     }
00197     return tk_install_cmd_core(cmd);
00198 }
00199 
00200 static VALUE
00201 tk_uninstall_cmd(self, cmd_id)
00202     VALUE self;
00203     VALUE cmd_id;
00204 {
00205     size_t head_len = strlen(cmd_id_head);
00206     size_t prefix_len = strlen(cmd_id_prefix);
00207 
00208     StringValue(cmd_id);
00209     if (strncmp(cmd_id_head, RSTRING_PTR(cmd_id), head_len) != 0) {
00210         return Qnil;
00211     }
00212     if (strncmp(cmd_id_prefix,
00213                 RSTRING_PTR(cmd_id) + head_len, prefix_len) != 0) {
00214         return Qnil;
00215     }
00216 
00217     return rb_hash_delete(CALLBACK_TABLE,
00218                           rb_str_new2(RSTRING_PTR(cmd_id) + head_len));
00219 }
00220 
00221 static VALUE
00222 tk_toUTF8(argc, argv, self)
00223     int   argc;
00224     VALUE *argv;
00225     VALUE self;
00226 {
00227     return rb_funcall2(cTclTkLib, ID_toUTF8, argc, argv);
00228 }
00229 
00230 static VALUE
00231 tk_fromUTF8(argc, argv, self)
00232     int   argc;
00233     VALUE *argv;
00234     VALUE self;
00235 {
00236     return rb_funcall2(cTclTkLib, ID_fromUTF8, argc, argv);
00237 }
00238 
00239 static VALUE
00240 fromDefaultEnc_toUTF8(str, self)
00241     VALUE str;
00242     VALUE self;
00243 {
00244     VALUE argv[1];
00245 
00246     argv[0] = str;
00247     return tk_toUTF8(1, argv, self);
00248 }
00249 
00250 #if 0
00251 static VALUE
00252 fromUTF8_toDefaultEnc(str, self)
00253     VALUE str;
00254     VALUE self;
00255 {
00256     VALUE argv[1];
00257 
00258     argv[0] = str;
00259     return tk_fromUTF8(1, argv, self);
00260 }
00261 #endif
00262 
00263 static int
00264 to_strkey(key, value, hash)
00265     VALUE key;
00266     VALUE value;
00267     VALUE hash;
00268 {
00269     rb_hash_aset(hash, rb_funcall(key, ID_to_s, 0, 0), value);
00270     return ST_CHECK;
00271 }
00272 
00273 static VALUE
00274 tk_symbolkey2str(self, keys)
00275     VALUE self;
00276     VALUE keys;
00277 {
00278     volatile VALUE new_keys = rb_hash_new();
00279 
00280     if (NIL_P(keys)) return new_keys;
00281     keys = rb_convert_type(keys, T_HASH, "Hash", "to_hash");
00282     st_foreach_check(RHASH_TBL(keys), to_strkey, new_keys, Qundef);
00283     return new_keys;
00284 }
00285 
00286 static VALUE get_eval_string_core _((VALUE, VALUE, VALUE));
00287 static VALUE ary2list _((VALUE, VALUE, VALUE));
00288 static VALUE ary2list2 _((VALUE, VALUE, VALUE));
00289 static VALUE hash2list _((VALUE, VALUE));
00290 static VALUE hash2list_enc _((VALUE, VALUE));
00291 static VALUE hash2kv _((VALUE, VALUE, VALUE));
00292 static VALUE hash2kv_enc _((VALUE, VALUE, VALUE));
00293 
00294 static VALUE
00295 ary2list(ary, enc_flag, self)
00296     VALUE ary;
00297     VALUE enc_flag;
00298     VALUE self;
00299 {
00300     long idx, idx2, size, size2;
00301     int req_chk_flag;
00302     volatile VALUE val, val2, str_val;
00303     volatile VALUE dst;
00304     volatile VALUE sys_enc, dst_enc, str_enc;
00305 
00306     sys_enc = rb_funcall(cTclTkLib, ID_encoding, 0, 0);
00307     if (NIL_P(sys_enc)) {
00308       sys_enc = rb_funcall(cTclTkLib, ID_encoding_system, 0, 0);
00309       sys_enc = rb_funcall(sys_enc, ID_to_s, 0, 0);
00310     }
00311 
00312     if (NIL_P(enc_flag)) {
00313         dst_enc = sys_enc;
00314         req_chk_flag = 1;
00315     } else if (TYPE(enc_flag) == T_TRUE || TYPE(enc_flag) == T_FALSE) {
00316         dst_enc = enc_flag;
00317         req_chk_flag = 0;
00318     } else {
00319         dst_enc = rb_funcall(enc_flag, ID_to_s, 0, 0);
00320         req_chk_flag = 0;
00321     }
00322 
00323     /* size = RARRAY_LEN(ary); */
00324     size = 0;
00325     for(idx = 0; idx < RARRAY_LEN(ary); idx++) {
00326         if (TYPE(RARRAY_PTR(ary)[idx]) == T_HASH) {
00327             size += 2 * RHASH_SIZE(RARRAY_PTR(ary)[idx]);
00328         } else {
00329             size++;
00330         }
00331     }
00332 
00333     dst = rb_ary_new2(size);
00334     for(idx = 0; idx < RARRAY_LEN(ary); idx++) {
00335         val = RARRAY_PTR(ary)[idx];
00336         str_val = Qnil;
00337         switch(TYPE(val)) {
00338         case T_ARRAY:
00339             str_val = ary2list(val, enc_flag, self);
00340             rb_ary_push(dst, str_val);
00341 
00342             if (req_chk_flag) {
00343                 str_enc = rb_ivar_get(str_val, ID_at_enc);
00344                 if (!NIL_P(str_enc)) {
00345                     str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
00346                 } else {
00347                     str_enc = sys_enc;
00348                 }
00349                 if (!rb_str_cmp(str_enc, dst_enc)) {
00350                     dst_enc = Qtrue;
00351                     req_chk_flag = 0;
00352                 }
00353             }
00354 
00355             break;
00356 
00357         case T_HASH:
00358             /* rb_ary_push(dst, hash2list(val, self)); */
00359             if (RTEST(enc_flag)) {
00360                 val = hash2kv_enc(val, Qnil, self);
00361             } else {
00362                 val = hash2kv(val, Qnil, self);
00363             }
00364             size2 = RARRAY_LEN(val);
00365             for(idx2 = 0; idx2 < size2; idx2++) {
00366                 val2 = RARRAY_PTR(val)[idx2];
00367                 switch(TYPE(val2)) {
00368                 case T_ARRAY:
00369                     str_val = ary2list(val2, enc_flag, self);
00370                     rb_ary_push(dst, str_val);
00371                     break;
00372 
00373                 case T_HASH:
00374                     if (RTEST(enc_flag)) {
00375                         str_val = hash2list_enc(val2, self);
00376                     } else {
00377                         str_val = hash2list(val2, self);
00378                     }
00379                     rb_ary_push(dst, str_val);
00380                     break;
00381 
00382                 default:
00383                     if (val2 != TK_None) {
00384                         str_val = get_eval_string_core(val2, enc_flag, self);
00385                         rb_ary_push(dst, str_val);
00386                     }
00387                 }
00388 
00389                 if (req_chk_flag) {
00390                     str_enc = rb_ivar_get(str_val, ID_at_enc);
00391                     if (!NIL_P(str_enc)) {
00392                         str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
00393                     } else {
00394                         str_enc = sys_enc;
00395                     }
00396                     if (!rb_str_cmp(str_enc, dst_enc)) {
00397                         dst_enc = Qtrue;
00398                         req_chk_flag = 0;
00399                     }
00400                 }
00401             }
00402             break;
00403 
00404         default:
00405             if (val != TK_None) {
00406                 str_val = get_eval_string_core(val, enc_flag, self);
00407                 rb_ary_push(dst, str_val);
00408 
00409                 if (req_chk_flag) {
00410                     str_enc = rb_ivar_get(str_val, ID_at_enc);
00411                     if (!NIL_P(str_enc)) {
00412                         str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
00413                     } else {
00414                         str_enc = sys_enc;
00415                     }
00416                     if (!rb_str_cmp(str_enc, dst_enc)) {
00417                         dst_enc = Qtrue;
00418                         req_chk_flag = 0;
00419                     }
00420                 }
00421             }
00422         }
00423     }
00424 
00425     if (RTEST(dst_enc) && !NIL_P(sys_enc)) {
00426         for(idx = 0; idx < RARRAY_LEN(dst); idx++) {
00427             str_val = RARRAY_PTR(dst)[idx];
00428             if (rb_obj_respond_to(self, ID_toUTF8, Qtrue)) {
00429                 str_val = rb_funcall(self, ID_toUTF8, 1, str_val);
00430             } else {
00431                 str_val = rb_funcall(cTclTkLib, ID_toUTF8, 1, str_val);
00432             }
00433             RARRAY_PTR(dst)[idx] = str_val;
00434         }
00435         val = rb_apply(cTclTkLib, ID_merge_tklist, dst);
00436         if (TYPE(dst_enc) == T_STRING) {
00437             val = rb_funcall(cTclTkLib, ID_fromUTF8, 2, val, dst_enc);
00438             rb_ivar_set(val, ID_at_enc, dst_enc);
00439         } else {
00440             rb_ivar_set(val, ID_at_enc, ENCODING_NAME_UTF8);
00441         }
00442         return val;
00443     } else {
00444         return rb_apply(cTclTkLib, ID_merge_tklist, dst);
00445     }
00446 }
00447 
00448 static VALUE
00449 ary2list2(ary, enc_flag, self)
00450     VALUE ary;
00451     VALUE enc_flag;
00452     VALUE self;
00453 {
00454     long idx, size;
00455     int req_chk_flag;
00456     volatile VALUE val, str_val;
00457     volatile VALUE dst;
00458     volatile VALUE sys_enc, dst_enc, str_enc;
00459 
00460     sys_enc = rb_funcall(cTclTkLib, ID_encoding, 0, 0);
00461     if (NIL_P(sys_enc)) {
00462       sys_enc = rb_funcall(cTclTkLib, ID_encoding_system, 0, 0);
00463       sys_enc = rb_funcall(sys_enc, ID_to_s, 0, 0);
00464     }
00465 
00466     if (NIL_P(enc_flag)) {
00467         dst_enc = sys_enc;
00468         req_chk_flag = 1;
00469     } else if (TYPE(enc_flag) == T_TRUE || TYPE(enc_flag) == T_FALSE) {
00470         dst_enc = enc_flag;
00471         req_chk_flag = 0;
00472     } else {
00473         dst_enc = rb_funcall(enc_flag, ID_to_s, 0, 0);
00474         req_chk_flag = 0;
00475     }
00476 
00477     size = RARRAY_LEN(ary);
00478     dst = rb_ary_new2(size);
00479     for(idx = 0; idx < RARRAY_LEN(ary); idx++) {
00480         val = RARRAY_PTR(ary)[idx];
00481         str_val = Qnil;
00482         switch(TYPE(val)) {
00483         case T_ARRAY:
00484             str_val = ary2list(val, enc_flag, self);
00485             break;
00486 
00487         case T_HASH:
00488             if (RTEST(enc_flag)) {
00489                 str_val = hash2list(val, self);
00490             } else {
00491                 str_val = hash2list_enc(val, self);
00492             }
00493             break;
00494 
00495         default:
00496             if (val != TK_None) {
00497                 str_val = get_eval_string_core(val, enc_flag, self);
00498             }
00499         }
00500 
00501         if (!NIL_P(str_val)) {
00502             rb_ary_push(dst, str_val);
00503 
00504             if (req_chk_flag) {
00505                 str_enc = rb_ivar_get(str_val, ID_at_enc);
00506                 if (!NIL_P(str_enc)) {
00507                     str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
00508                 } else {
00509                     str_enc = sys_enc;
00510                 }
00511                 if (!rb_str_cmp(str_enc, dst_enc)) {
00512                     dst_enc = Qtrue;
00513                     req_chk_flag = 0;
00514                 }
00515             }
00516         }
00517     }
00518 
00519     if (RTEST(dst_enc) && !NIL_P(sys_enc)) {
00520         for(idx = 0; idx < RARRAY_LEN(dst); idx++) {
00521             str_val = RARRAY_PTR(dst)[idx];
00522             if (rb_obj_respond_to(self, ID_toUTF8, Qtrue)) {
00523                 str_val = rb_funcall(self, ID_toUTF8, 1, str_val);
00524             } else {
00525                 str_val = rb_funcall(cTclTkLib, ID_toUTF8, 1, str_val);
00526             }
00527             RARRAY_PTR(dst)[idx] = str_val;
00528         }
00529         val = rb_apply(cTclTkLib, ID_merge_tklist, dst);
00530         if (TYPE(dst_enc) == T_STRING) {
00531             val = rb_funcall(cTclTkLib, ID_fromUTF8, 2, val, dst_enc);
00532             rb_ivar_set(val, ID_at_enc, dst_enc);
00533         } else {
00534             rb_ivar_set(val, ID_at_enc, ENCODING_NAME_UTF8);
00535         }
00536         return val;
00537     } else {
00538         return rb_apply(cTclTkLib, ID_merge_tklist, dst);
00539     }
00540 }
00541 
00542 static VALUE
00543 key2keyname(key)
00544     VALUE key;
00545 {
00546     return rb_str_append(rb_str_new2("-"), rb_funcall(key, ID_to_s, 0, 0));
00547 }
00548 
00549 static VALUE
00550 assoc2kv(assoc, ary, self)
00551     VALUE assoc;
00552     VALUE ary;
00553     VALUE self;
00554 {
00555     long i, j, len;
00556     volatile VALUE pair;
00557     volatile VALUE val;
00558     volatile VALUE dst = rb_ary_new2(2 * RARRAY_LEN(assoc));
00559 
00560     len = RARRAY_LEN(assoc);
00561 
00562     for(i = 0; i < len; i++) {
00563         pair = RARRAY_PTR(assoc)[i];
00564         if (TYPE(pair) != T_ARRAY) {
00565             rb_ary_push(dst, key2keyname(pair));
00566             continue;
00567         }
00568         switch(RARRAY_LEN(assoc)) {
00569         case 2:
00570             rb_ary_push(dst, RARRAY_PTR(pair)[2]);
00571 
00572         case 1:
00573             rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
00574 
00575         case 0:
00576             continue;
00577 
00578         default:
00579             rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
00580 
00581             val = rb_ary_new2(RARRAY_LEN(pair) - 1);
00582             for(j = 1; j < RARRAY_LEN(pair); j++) {
00583                 rb_ary_push(val, RARRAY_PTR(pair)[j]);
00584             }
00585 
00586             rb_ary_push(dst, val);
00587         }
00588     }
00589 
00590     if (NIL_P(ary)) {
00591         return dst;
00592     } else {
00593         return rb_ary_plus(ary, dst);
00594     }
00595 }
00596 
00597 static VALUE
00598 assoc2kv_enc(assoc, ary, self)
00599     VALUE assoc;
00600     VALUE ary;
00601     VALUE self;
00602 {
00603     long i, j, len;
00604     volatile VALUE pair;
00605     volatile VALUE val;
00606     volatile VALUE dst = rb_ary_new2(2 * RARRAY_LEN(assoc));
00607 
00608     len = RARRAY_LEN(assoc);
00609 
00610     for(i = 0; i < len; i++) {
00611         pair = RARRAY_PTR(assoc)[i];
00612         if (TYPE(pair) != T_ARRAY) {
00613             rb_ary_push(dst, key2keyname(pair));
00614             continue;
00615         }
00616         switch(RARRAY_LEN(assoc)) {
00617         case 2:
00618             rb_ary_push(dst, get_eval_string_core(RARRAY_PTR(pair)[2], Qtrue, self));
00619 
00620         case 1:
00621             rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
00622 
00623         case 0:
00624             continue;
00625 
00626         default:
00627             rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
00628 
00629             val = rb_ary_new2(RARRAY_LEN(pair) - 1);
00630             for(j = 1; j < RARRAY_LEN(pair); j++) {
00631                 rb_ary_push(val, RARRAY_PTR(pair)[j]);
00632             }
00633 
00634             rb_ary_push(dst, get_eval_string_core(val, Qtrue, self));
00635         }
00636     }
00637 
00638     if (NIL_P(ary)) {
00639         return dst;
00640     } else {
00641         return rb_ary_plus(ary, dst);
00642     }
00643 }
00644 
00645 static int
00646 push_kv(key, val, args)
00647     VALUE key;
00648     VALUE val;
00649     VALUE args;
00650 {
00651     volatile VALUE ary;
00652 
00653     ary = RARRAY_PTR(args)[0];
00654 
00655 #if 0
00656     rb_ary_push(ary, key2keyname(key));
00657     if (val != TK_None) rb_ary_push(ary, val);
00658 #endif
00659     rb_ary_push(ary, key2keyname(key));
00660 
00661     if (val == TK_None) return ST_CHECK;
00662 
00663     rb_ary_push(ary, get_eval_string_core(val, Qnil, RARRAY_PTR(args)[1]));
00664 
00665     return ST_CHECK;
00666 }
00667 
00668 static VALUE
00669 hash2kv(hash, ary, self)
00670     VALUE hash;
00671     VALUE ary;
00672     VALUE self;
00673 {
00674     volatile VALUE dst = rb_ary_new2(2 * RHASH_SIZE(hash));
00675     volatile VALUE args = rb_ary_new3(2, dst, self);
00676 
00677     st_foreach_check(RHASH_TBL(hash), push_kv, args, Qundef);
00678 
00679     if (NIL_P(ary)) {
00680         return dst;
00681     } else {
00682         return rb_ary_concat(ary, dst);
00683     }
00684 }
00685 
00686 static int
00687 push_kv_enc(key, val, args)
00688     VALUE key;
00689     VALUE val;
00690     VALUE args;
00691 {
00692     volatile VALUE ary;
00693 
00694     ary = RARRAY_PTR(args)[0];
00695 
00696 #if 0
00697     rb_ary_push(ary, key2keyname(key));
00698     if (val != TK_None) {
00699         rb_ary_push(ary, get_eval_string_core(val, Qtrue,
00700                                               RARRAY_PTR(args)[1]));
00701     }
00702 #endif
00703     rb_ary_push(ary, key2keyname(key));
00704 
00705     if (val == TK_None) return ST_CHECK;
00706 
00707     rb_ary_push(ary, get_eval_string_core(val, Qtrue, RARRAY_PTR(args)[1]));
00708 
00709     return ST_CHECK;
00710 }
00711 
00712 static VALUE
00713 hash2kv_enc(hash, ary, self)
00714     VALUE hash;
00715     VALUE ary;
00716     VALUE self;
00717 {
00718     volatile VALUE dst = rb_ary_new2(2 * RHASH_SIZE(hash));
00719     volatile VALUE args = rb_ary_new3(2, dst, self);
00720 
00721     st_foreach_check(RHASH_TBL(hash), push_kv_enc, args, Qundef);
00722 
00723     if (NIL_P(ary)) {
00724         return dst;
00725     } else {
00726         return rb_ary_concat(ary, dst);
00727     }
00728 }
00729 
00730 static VALUE
00731 hash2list(hash, self)
00732     VALUE hash;
00733     VALUE self;
00734 {
00735     return ary2list2(hash2kv(hash, Qnil, self), Qfalse, self);
00736 }
00737 
00738 
00739 static VALUE
00740 hash2list_enc(hash, self)
00741     VALUE hash;
00742     VALUE self;
00743 {
00744     return ary2list2(hash2kv_enc(hash, Qnil, self), Qfalse, self);
00745 }
00746 
00747 static VALUE
00748 tk_hash_kv(argc, argv, self)
00749     int   argc;
00750     VALUE *argv;
00751     VALUE self;
00752 {
00753     volatile VALUE hash, enc_flag, ary;
00754 
00755     ary = Qnil;
00756     enc_flag = Qnil;
00757     switch(argc) {
00758     case 3:
00759         ary = argv[2];
00760     case 2:
00761         enc_flag = argv[1];
00762     case 1:
00763         hash = argv[0];
00764         break;
00765     case 0:
00766         rb_raise(rb_eArgError, "too few arguments");
00767     default: /* >= 3 */
00768         rb_raise(rb_eArgError, "too many arguments");
00769     }
00770 
00771     switch(TYPE(hash)) {
00772     case T_ARRAY:
00773         if (RTEST(enc_flag)) {
00774             return assoc2kv_enc(hash, ary, self);
00775         } else {
00776             return assoc2kv(hash, ary, self);
00777         }
00778 
00779     case T_HASH:
00780         if (RTEST(enc_flag)) {
00781             return hash2kv_enc(hash, ary, self);
00782         } else {
00783             return hash2kv(hash, ary, self);
00784         }
00785 
00786     case T_NIL:
00787         if (NIL_P(ary)) {
00788             return rb_ary_new();
00789         } else {
00790             return ary;
00791         }
00792 
00793     default:
00794         if (hash == TK_None) {
00795             if (NIL_P(ary)) {
00796                 return rb_ary_new();
00797             } else {
00798                 return ary;
00799             }
00800         }
00801         rb_raise(rb_eArgError, "Hash is expected for 1st argument");
00802     }
00803 
00804     UNREACHABLE;
00805 }
00806 
00807 static VALUE
00808 get_eval_string_core(obj, enc_flag, self)
00809     VALUE obj;
00810     VALUE enc_flag;
00811     VALUE self;
00812 {
00813     switch(TYPE(obj)) {
00814     case T_FLOAT:
00815     case T_FIXNUM:
00816     case T_BIGNUM:
00817         return rb_funcall(obj, ID_to_s, 0, 0);
00818 
00819     case T_STRING:
00820         if (RTEST(enc_flag)) {
00821             if (rb_obj_respond_to(self, ID_toUTF8, Qtrue)) {
00822                 return rb_funcall(self, ID_toUTF8, 1, obj);
00823             } else {
00824                 return fromDefaultEnc_toUTF8(obj, self);
00825             }
00826         } else {
00827             return obj;
00828         }
00829 
00830     case T_SYMBOL:
00831         if (RTEST(enc_flag)) {
00832             if (rb_obj_respond_to(self, ID_toUTF8, Qtrue)) {
00833                 return rb_funcall(self, ID_toUTF8, 1,
00834                                   rb_str_new2(rb_id2name(SYM2ID(obj))));
00835             } else {
00836                 return fromDefaultEnc_toUTF8(rb_str_new2(rb_id2name(SYM2ID(obj))), self);
00837             }
00838         } else {
00839 #ifdef HAVE_RB_SYM_TO_S
00840             return rb_sym_to_s(obj);
00841 #else
00842             return rb_str_new2(rb_id2name(SYM2ID(obj)));
00843 #endif
00844         }
00845 
00846     case T_HASH:
00847         if (RTEST(enc_flag)) {
00848             return hash2list_enc(obj, self);
00849         } else {
00850             return hash2list(obj, self);
00851         }
00852 
00853     case T_ARRAY:
00854         return ary2list(obj, enc_flag, self);
00855 
00856     case T_FALSE:
00857         return rb_str_new2("0");
00858 
00859     case T_TRUE:
00860         return rb_str_new2("1");
00861 
00862     case T_NIL:
00863         return rb_str_new2("");
00864 
00865     case T_REGEXP:
00866         return rb_funcall(obj, ID_source, 0, 0);
00867 
00868     default:
00869         if (rb_obj_is_kind_of(obj, cTkObject)) {
00870             /* return rb_str_new3(rb_funcall(obj, ID_path, 0, 0)); */
00871             return get_eval_string_core(rb_funcall(obj, ID_path, 0, 0),
00872                                         enc_flag, self);
00873         }
00874 
00875         if (rb_obj_is_kind_of(obj, rb_cProc)
00876             || rb_obj_is_kind_of(obj, cMethod)
00877             || rb_obj_is_kind_of(obj, cTkCallbackEntry)) {
00878             if (rb_obj_respond_to(self, ID_install_cmd, Qtrue)) {
00879                 return rb_funcall(self, ID_install_cmd, 1, obj);
00880             } else {
00881                 return tk_install_cmd_core(obj);
00882             }
00883         }
00884 
00885         if (obj == TK_None)  return Qnil;
00886 
00887         if (rb_obj_respond_to(obj, ID_to_eval, Qtrue)) {
00888             /* return rb_funcall(obj, ID_to_eval, 0, 0); */
00889             return get_eval_string_core(rb_funcall(obj, ID_to_eval, 0, 0),
00890                                         enc_flag, self);
00891         } else if (rb_obj_respond_to(obj, ID_path, Qtrue)) {
00892             /* return rb_funcall(obj, ID_path, 0, 0); */
00893             return get_eval_string_core(rb_funcall(obj, ID_path, 0, 0),
00894                                         enc_flag, self);
00895         } else if (rb_obj_respond_to(obj, ID_to_s, Qtrue)) {
00896             return rb_funcall(obj, ID_to_s, 0, 0);
00897         }
00898     }
00899 
00900     rb_warning("fail to convert '%s' to string for Tk",
00901                RSTRING_PTR(rb_funcall(obj, rb_intern("inspect"), 0, 0)));
00902 
00903     return obj;
00904 }
00905 
00906 static VALUE
00907 tk_get_eval_string(argc, argv, self)
00908     int   argc;
00909     VALUE *argv;
00910     VALUE self;
00911 {
00912     volatile VALUE obj, enc_flag;
00913 
00914     if (rb_scan_args(argc, argv, "11", &obj, &enc_flag) == 1) {
00915         enc_flag = Qnil;
00916     }
00917 
00918     return get_eval_string_core(obj, enc_flag, self);
00919 }
00920 
00921 static VALUE
00922 tk_get_eval_enc_str(self, obj)
00923     VALUE self;
00924     VALUE obj;
00925 {
00926     if (obj == TK_None) {
00927         return obj;
00928     } else {
00929         return get_eval_string_core(obj, Qtrue, self);
00930     }
00931 }
00932 
00933 static VALUE
00934 tk_conv_args(argc, argv, self)
00935     int   argc;
00936     VALUE *argv; /* [0]:base_array, [1]:enc_mode, [2]..[n]:args */
00937     VALUE self;
00938 {
00939     int idx, size;
00940     volatile VALUE dst;
00941     int thr_crit_bup;
00942     VALUE old_gc;
00943 
00944     if (argc < 2) {
00945       rb_raise(rb_eArgError, "too few arguments");
00946     }
00947 
00948     thr_crit_bup = rb_thread_critical;
00949     rb_thread_critical = Qtrue;
00950     old_gc = rb_gc_disable();
00951 
00952     for(size = 0, idx = 2; idx < argc; idx++) {
00953         if (TYPE(argv[idx]) == T_HASH) {
00954             size += 2 * RHASH_SIZE(argv[idx]);
00955         } else {
00956             size++;
00957         }
00958     }
00959     /* dst = rb_ary_new2(argc - 2); */
00960     dst = rb_ary_new2(size);
00961     for(idx = 2; idx < argc; idx++) {
00962         if (TYPE(argv[idx]) == T_HASH) {
00963             if (RTEST(argv[1])) {
00964                 hash2kv_enc(argv[idx], dst, self);
00965             } else {
00966                 hash2kv(argv[idx], dst, self);
00967             }
00968         } else if (argv[idx] != TK_None) {
00969             rb_ary_push(dst, get_eval_string_core(argv[idx], argv[1], self));
00970         }
00971     }
00972 
00973     if (old_gc == Qfalse) rb_gc_enable();
00974     rb_thread_critical = thr_crit_bup;
00975 
00976     return rb_ary_plus(argv[0], dst);
00977 }
00978 
00979 
00980 /*************************************/
00981 
00982 static VALUE
00983 tcl2rb_bool(self, value)
00984     VALUE self;
00985     VALUE value;
00986 {
00987     if (TYPE(value) == T_FIXNUM) {
00988         if (NUM2INT(value) == 0) {
00989             return Qfalse;
00990         } else {
00991             return Qtrue;
00992         }
00993     }
00994 
00995     if (TYPE(value) == T_TRUE || TYPE(value) == T_FALSE) {
00996         return value;
00997     }
00998 
00999     rb_check_type(value, T_STRING);
01000 
01001     value = rb_funcall(value, ID_downcase, 0);
01002 
01003     if (RSTRING_PTR(value) == (char*)NULL) return Qnil;
01004 
01005     if (RSTRING_PTR(value)[0] == '\0'
01006         || strcmp(RSTRING_PTR(value), "0") == 0
01007         || strcmp(RSTRING_PTR(value), "no") == 0
01008         || strcmp(RSTRING_PTR(value), "off") == 0
01009         || strcmp(RSTRING_PTR(value), "false") == 0) {
01010         return Qfalse;
01011     } else {
01012         return Qtrue;
01013     }
01014 }
01015 
01016 #if 0
01017 static VALUE
01018 tkstr_to_dec(value)
01019     VALUE value;
01020 {
01021     return rb_cstr_to_inum(RSTRING_PTR(value), 10, 1);
01022 }
01023 #endif
01024 
01025 static VALUE
01026 tkstr_to_int(value)
01027     VALUE value;
01028 {
01029     return rb_cstr_to_inum(RSTRING_PTR(value), 0, 1);
01030 }
01031 
01032 static VALUE
01033 tkstr_to_float(value)
01034     VALUE value;
01035 {
01036     return rb_float_new(rb_cstr_to_dbl(RSTRING_PTR(value), 1));
01037 }
01038 
01039 static VALUE
01040 tkstr_invalid_numstr(value)
01041     VALUE value;
01042 {
01043     rb_raise(rb_eArgError,
01044              "invalid value for Number: '%s'", RSTRING_PTR(value));
01045     return Qnil; /*dummy*/
01046 }
01047 
01048 static VALUE
01049 tkstr_rescue_float(value)
01050     VALUE value;
01051 {
01052     return rb_rescue2(tkstr_to_float, value,
01053                       tkstr_invalid_numstr, value,
01054                       rb_eArgError, 0);
01055 }
01056 
01057 static VALUE
01058 tkstr_to_number(value)
01059     VALUE value;
01060 {
01061     rb_check_type(value, T_STRING);
01062 
01063     if (RSTRING_PTR(value) == (char*)NULL) return INT2FIX(0);
01064 
01065     return rb_rescue2(tkstr_to_int, value,
01066                       tkstr_rescue_float, value,
01067                       rb_eArgError, 0);
01068 }
01069 
01070 static VALUE
01071 tcl2rb_number(self, value)
01072     VALUE self;
01073     VALUE value;
01074 {
01075     return tkstr_to_number(value);
01076 }
01077 
01078 static VALUE
01079 tkstr_to_str(value)
01080     VALUE value;
01081 {
01082     char * ptr;
01083     long len;
01084 
01085     ptr = RSTRING_PTR(value);
01086     len = RSTRING_LEN(value);
01087 
01088     if (len > 1 && *ptr == '{' && *(ptr + len - 1) == '}') {
01089         return rb_str_new(ptr + 1, len - 2);
01090     }
01091     return value;
01092 }
01093 
01094 static VALUE
01095 tcl2rb_string(self, value)
01096     VALUE self;
01097     VALUE value;
01098 {
01099     rb_check_type(value, T_STRING);
01100 
01101     if (RSTRING_PTR(value) == (char*)NULL) return rb_tainted_str_new2("");
01102 
01103     return tkstr_to_str(value);
01104 }
01105 
01106 static VALUE
01107 tcl2rb_num_or_str(self, value)
01108     VALUE self;
01109     VALUE value;
01110 {
01111     rb_check_type(value, T_STRING);
01112 
01113     if (RSTRING_PTR(value) == (char*)NULL) return rb_tainted_str_new2("");
01114 
01115     return rb_rescue2(tkstr_to_number, value,
01116                       tkstr_to_str, value,
01117                       rb_eArgError, 0);
01118 }
01119 
01120 static VALUE
01121 tcl2rb_num_or_nil(self, value)
01122     VALUE self;
01123     VALUE value;
01124 {
01125     rb_check_type(value, T_STRING);
01126 
01127     if (RSTRING_LEN(value) == 0) return Qnil;
01128 
01129     return tkstr_to_number(value);
01130 }
01131 
01132 
01133 /*************************************/
01134 
01135 #define CBSUBST_TBL_MAX (256)
01136 struct cbsubst_info {
01137     long  full_subst_length;
01138     long  keylen[CBSUBST_TBL_MAX];
01139     char  *key[CBSUBST_TBL_MAX];
01140     char  type[CBSUBST_TBL_MAX];
01141     ID    ivar[CBSUBST_TBL_MAX];
01142     VALUE proc;
01143     VALUE aliases;
01144 };
01145 
01146 static void
01147 subst_mark(ptr)
01148     struct cbsubst_info *ptr;
01149 {
01150     rb_gc_mark(ptr->proc);
01151     rb_gc_mark(ptr->aliases);
01152 }
01153 
01154 static void
01155 subst_free(ptr)
01156     struct cbsubst_info *ptr;
01157 {
01158     int i;
01159 
01160     if (ptr) {
01161       for(i = 0; i < CBSUBST_TBL_MAX; i++) {
01162         if (ptr->key[i] != NULL) {
01163           free(ptr->key[i]); /* allocated by malloc */
01164           ptr->key[i] = NULL;
01165         }
01166       }
01167       xfree(ptr); /* allocated by ALLOC */
01168     }
01169 }
01170 
01171 static VALUE
01172 allocate_cbsubst_info(struct cbsubst_info **inf_ptr)
01173 {
01174   struct cbsubst_info *inf;
01175   volatile VALUE proc, aliases;
01176   int idx;
01177 
01178   inf = ALLOC(struct cbsubst_info);
01179 
01180   inf->full_subst_length = 0;
01181 
01182   for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
01183     inf->keylen[idx] = 0;
01184     inf->key[idx]    = NULL;
01185     inf->type[idx]   = '\0';
01186     inf->ivar[idx]   = (ID) 0;
01187   }
01188 
01189   proc = rb_hash_new();
01190   inf->proc = proc;
01191 
01192   aliases = rb_hash_new();
01193   inf->aliases = aliases;
01194 
01195   if (inf_ptr != (struct cbsubst_info **)NULL) *inf_ptr = inf;
01196 
01197   return Data_Wrap_Struct(cSUBST_INFO, subst_mark, subst_free, inf);
01198 }
01199 
01200 static void
01201 cbsubst_init()
01202 {
01203   rb_const_set(cCB_SUBST, ID_SUBST_INFO,
01204                allocate_cbsubst_info((struct cbsubst_info **)NULL));
01205 }
01206 
01207 static VALUE
01208 cbsubst_initialize(argc, argv, self)
01209     int   argc;
01210     VALUE *argv;
01211     VALUE self;
01212 {
01213     struct cbsubst_info *inf;
01214     int idx, iv_idx;
01215 
01216     Data_Get_Struct(rb_const_get(rb_obj_class(self), ID_SUBST_INFO),
01217                     struct cbsubst_info, inf);
01218 
01219    idx = 0;
01220     for(iv_idx = 0; iv_idx < CBSUBST_TBL_MAX; iv_idx++) {
01221       if ( inf->ivar[iv_idx] == (ID) 0 ) continue;
01222       rb_ivar_set(self, inf->ivar[iv_idx], argv[idx++]);
01223       if (idx >= argc) break;
01224     }
01225 
01226     return self;
01227 }
01228 
01229 static VALUE
01230 cbsubst_ret_val(self, val)
01231     VALUE self;
01232     VALUE val;
01233 {
01234     /* This method may be overwritten on some sub-classes.                  */
01235     /* This method is used for converting from ruby's callback-return-value */
01236     /* to tcl's value (e.g. validation procedure of entry widget).          */
01237     return val;
01238 }
01239 
01240 static int
01241 each_attr_def(key, value, klass)
01242     VALUE key, value, klass;
01243 {
01244     ID key_id, value_id;
01245 
01246     if (key == Qundef) return ST_CONTINUE;
01247 
01248     switch(TYPE(key)) {
01249     case T_STRING:
01250         key_id = rb_intern(RSTRING_PTR(key));
01251         break;
01252     case T_SYMBOL:
01253         key_id = SYM2ID(key);
01254         break;
01255     default:
01256         rb_raise(rb_eArgError,
01257                  "includes invalid key(s). expected a String or a Symbol");
01258     }
01259 
01260     switch(TYPE(value)) {
01261     case T_STRING:
01262         value_id = rb_intern(RSTRING_PTR(value));
01263         break;
01264     case T_SYMBOL:
01265         value_id = SYM2ID(value);
01266         break;
01267     default:
01268         rb_raise(rb_eArgError,
01269                  "includes invalid value(s). expected a String or a Symbol");
01270     }
01271 
01272     rb_alias(klass, key_id, value_id);
01273 
01274     return ST_CONTINUE;
01275 }
01276 
01277 static VALUE
01278 cbsubst_def_attr_aliases(self, tbl)
01279     VALUE self;
01280     VALUE tbl;
01281 {
01282     struct cbsubst_info *inf;
01283 
01284     if (TYPE(tbl) != T_HASH) {
01285         rb_raise(rb_eArgError, "expected a Hash");
01286     }
01287 
01288     Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
01289                     struct cbsubst_info, inf);
01290 
01291     rb_hash_foreach(tbl, each_attr_def, self);
01292 
01293     return rb_funcall(inf->aliases, rb_intern("update"), 1, tbl);
01294 }
01295 
01296 static VALUE
01297 cbsubst_sym_to_subst(self, sym)
01298     VALUE self;
01299     VALUE sym;
01300 {
01301     struct cbsubst_info *inf;
01302     const char *str;
01303     char *buf, *ptr;
01304     int idx;
01305     long len;
01306     ID id;
01307     volatile VALUE ret;
01308 
01309     if (TYPE(sym) != T_SYMBOL) return sym;
01310 
01311     Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
01312                     struct cbsubst_info, inf);
01313 
01314     if (!NIL_P(ret = rb_hash_aref(inf->aliases, sym))) {
01315       str = rb_id2name(SYM2ID(ret));
01316     } else {
01317       str = rb_id2name(SYM2ID(sym));
01318     }
01319 
01320     id = rb_intern(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), str)));
01321 
01322     for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
01323       if (inf->ivar[idx] == id) break;
01324     }
01325     if (idx >= CBSUBST_TBL_MAX)  return sym;
01326 
01327     ptr = buf = ALLOC_N(char, inf->full_subst_length + 1);
01328 
01329     *(ptr++) = '%';
01330 
01331     if (len = inf->keylen[idx]) {
01332       /* longname */
01333       strncpy(ptr, inf->key[idx], len);
01334       ptr += len;
01335     } else {
01336       /* single char */
01337       *(ptr++) = (unsigned char)idx;
01338     }
01339 
01340     *(ptr++) = ' ';
01341     *(ptr++) = '\0';
01342 
01343     ret = rb_str_new2(buf);
01344 
01345     xfree(buf);
01346 
01347     return ret;
01348 }
01349 
01350 static VALUE
01351 cbsubst_get_subst_arg(argc, argv, self)
01352     int   argc;
01353     VALUE *argv;
01354     VALUE self;
01355 {
01356     struct cbsubst_info *inf;
01357     const char *str;
01358     char *buf, *ptr;
01359     int i, idx;
01360     long len;
01361     ID id;
01362     volatile VALUE arg_sym, ret;
01363 
01364     Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
01365                     struct cbsubst_info, inf);
01366 
01367     ptr = buf = ALLOC_N(char, inf->full_subst_length + 1);
01368 
01369     for(i = 0; i < argc; i++) {
01370         switch(TYPE(argv[i])) {
01371         case T_STRING:
01372             str = RSTRING_PTR(argv[i]);
01373             arg_sym = ID2SYM(rb_intern(str));
01374             break;
01375         case T_SYMBOL:
01376             arg_sym = argv[i];
01377             str = rb_id2name(SYM2ID(arg_sym));
01378             break;
01379         default:
01380             rb_raise(rb_eArgError, "arg #%d is not a String or a Symbol", i);
01381         }
01382 
01383         if (!NIL_P(ret = rb_hash_aref(inf->aliases, arg_sym))) {
01384             str = rb_id2name(SYM2ID(ret));
01385         }
01386 
01387         id = rb_intern(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), str)));
01388 
01389         for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
01390           if (inf->ivar[idx] == id) break;
01391         }
01392         if (idx >= CBSUBST_TBL_MAX) {
01393             rb_raise(rb_eArgError, "cannot find attribute :%s", str);
01394         }
01395 
01396         *(ptr++) = '%';
01397 
01398         if (len = inf->keylen[idx]) {
01399           /* longname */
01400           strncpy(ptr, inf->key[idx], len);
01401           ptr += len;
01402         } else {
01403           /* single char */
01404           *(ptr++) = (unsigned char)idx;
01405         }
01406 
01407         *(ptr++) = ' ';
01408     }
01409 
01410     *ptr = '\0';
01411 
01412     ret = rb_str_new2(buf);
01413 
01414     xfree(buf);
01415 
01416     return ret;
01417 }
01418 
01419 static VALUE
01420 cbsubst_get_subst_key(self, str)
01421     VALUE self;
01422     VALUE str;
01423 {
01424     struct cbsubst_info *inf;
01425     volatile VALUE list;
01426     volatile VALUE ret;
01427     VALUE keyval;
01428     long i, len, keylen;
01429     int idx;
01430     char *buf, *ptr, *key;
01431 
01432     list = rb_funcall(cTclTkLib, ID_split_tklist, 1, str);
01433     len = RARRAY_LEN(list);
01434 
01435     Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
01436                     struct cbsubst_info, inf);
01437 
01438     ptr = buf = ALLOC_N(char, inf->full_subst_length + len + 1);
01439 
01440     for(i = 0; i < len; i++) {
01441       keyval = RARRAY_PTR(list)[i];
01442       key = RSTRING_PTR(keyval);
01443       if (*key == '%') {
01444         if (*(key + 2) == '\0') {
01445           /* single char */
01446           *(ptr++) = *(key + 1);
01447         } else {
01448           /* search longname-key */
01449           keylen = RSTRING_LEN(keyval) - 1;
01450           for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
01451             if (inf->keylen[idx] != keylen) continue;
01452             if ((unsigned char)inf->key[idx][0] != (unsigned char)*(key + 1)) continue;
01453             if (strncmp(inf->key[idx], key + 1, keylen)) continue;
01454             break;
01455           }
01456           if (idx < CBSUBST_TBL_MAX) {
01457             *(ptr++) = (unsigned char)idx;
01458           } else {
01459             *(ptr++) = ' ';
01460           }
01461         }
01462       } else {
01463         *(ptr++) = ' ';
01464       }
01465     }
01466     *ptr = '\0';
01467 
01468     ret = rb_str_new2(buf);
01469     xfree(buf);
01470     return ret;
01471 }
01472 
01473 static VALUE
01474 cbsubst_get_all_subst_keys(self)
01475     VALUE self;
01476 {
01477     struct cbsubst_info *inf;
01478     char *buf, *ptr;
01479     char *keys_buf, *keys_ptr;
01480     int idx;
01481     long len;
01482     volatile VALUE ret;
01483 
01484     Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
01485                     struct cbsubst_info, inf);
01486 
01487     ptr = buf = ALLOC_N(char, inf->full_subst_length + 1);
01488     keys_ptr = keys_buf = ALLOC_N(char, CBSUBST_TBL_MAX + 1);
01489 
01490     for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
01491       if (inf->ivar[idx] == (ID) 0) continue;
01492 
01493       *(keys_ptr++) = (unsigned char)idx;
01494 
01495       *(ptr++) = '%';
01496 
01497       if (len = inf->keylen[idx]) {
01498         /* longname */
01499         strncpy(ptr, inf->key[idx], len);
01500         ptr += len;
01501       } else {
01502         /* single char */
01503         *(ptr++) = (unsigned char)idx;
01504       }
01505 
01506       *(ptr++) = ' ';
01507     }
01508 
01509     *ptr = '\0';
01510     *keys_ptr = '\0';
01511 
01512     ret = rb_ary_new3(2, rb_str_new2(keys_buf), rb_str_new2(buf));
01513 
01514     xfree(buf);
01515     xfree(keys_buf);
01516 
01517     return ret;
01518 }
01519 
01520 static VALUE
01521 cbsubst_table_setup(argc, argv, self)
01522      int   argc;
01523      VALUE *argv;
01524      VALUE self;
01525 {
01526   volatile VALUE cbsubst_obj;
01527   volatile VALUE key_inf;
01528   volatile VALUE longkey_inf;
01529   volatile VALUE proc_inf;
01530   VALUE inf;
01531   ID id;
01532   struct cbsubst_info *subst_inf;
01533   long idx, len;
01534   unsigned char chr;
01535 
01536   /* accept (key_inf, proc_inf) or (key_inf, longkey_inf, procinf) */
01537   if (rb_scan_args(argc, argv, "21", &key_inf, &longkey_inf, &proc_inf) == 2) {
01538     proc_inf = longkey_inf;
01539     longkey_inf = rb_ary_new();
01540   }
01541 
01542   /* check the number of longkeys */
01543   if (RARRAY_LEN(longkey_inf) > 125 /* from 0x80 to 0xFD */) {
01544     rb_raise(rb_eArgError, "too many longname-key definitions");
01545   }
01546 
01547   /* init */
01548   cbsubst_obj = allocate_cbsubst_info(&subst_inf);
01549 
01550   /*
01551    * keys : array of [subst, type, ivar]
01552    *         subst ==> char code or string
01553    *         type  ==> char code or string
01554    *         ivar  ==> symbol
01555    */
01556   len = RARRAY_LEN(key_inf);
01557   for(idx = 0; idx < len; idx++) {
01558     inf = RARRAY_PTR(key_inf)[idx];
01559     if (TYPE(inf) != T_ARRAY) continue;
01560 
01561     if (TYPE(RARRAY_PTR(inf)[0]) == T_STRING) {
01562       chr = *(RSTRING_PTR(RARRAY_PTR(inf)[0]));
01563     } else {
01564       chr = NUM2CHR(RARRAY_PTR(inf)[0]);
01565     }
01566     if (TYPE(RARRAY_PTR(inf)[1]) == T_STRING) {
01567       subst_inf->type[chr] = *(RSTRING_PTR(RARRAY_PTR(inf)[1]));
01568     } else {
01569       subst_inf->type[chr] = NUM2CHR(RARRAY_PTR(inf)[1]);
01570     }
01571 
01572     subst_inf->full_subst_length += 3;
01573 
01574     id = SYM2ID(RARRAY_PTR(inf)[2]);
01575     subst_inf->ivar[chr] = rb_intern(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), rb_id2name(id))));
01576 
01577     rb_attr(self, id, 1, 0, Qtrue);
01578   }
01579 
01580 
01581   /*
01582    * longkeys : array of [name, type, ivar]
01583    *         name ==> longname key string
01584    *         type ==> char code or string
01585    *         ivar ==> symbol
01586    */
01587   len = RARRAY_LEN(longkey_inf);
01588   for(idx = 0; idx < len; idx++) {
01589     inf = RARRAY_PTR(longkey_inf)[idx];
01590     if (TYPE(inf) != T_ARRAY) continue;
01591 
01592     chr = (unsigned char)(0x80 + idx);
01593     subst_inf->keylen[chr] = RSTRING_LEN(RARRAY_PTR(inf)[0]);
01594 #if HAVE_STRNDUP
01595     subst_inf->key[chr] = strndup(RSTRING_PTR(RARRAY_PTR(inf)[0]),
01596                                   RSTRING_LEN(RARRAY_PTR(inf)[0]));
01597 #else
01598     subst_inf->key[chr] = malloc(RSTRING_LEN(RARRAY_PTR(inf)[0]) + 1);
01599     if (subst_inf->key[chr]) {
01600       strncpy(subst_inf->key[chr], RSTRING_PTR(RARRAY_PTR(inf)[0]),
01601               RSTRING_LEN(RARRAY_PTR(inf)[0]) + 1);
01602       subst_inf->key[chr][RSTRING_LEN(RARRAY_PTR(inf)[0])] = '\0';
01603     }
01604 #endif
01605     if (TYPE(RARRAY_PTR(inf)[1]) == T_STRING) {
01606       subst_inf->type[chr] = *(RSTRING_PTR(RARRAY_PTR(inf)[1]));
01607     } else {
01608       subst_inf->type[chr] = NUM2CHR(RARRAY_PTR(inf)[1]);
01609     }
01610 
01611     subst_inf->full_subst_length += (subst_inf->keylen[chr] + 2);
01612 
01613     id = SYM2ID(RARRAY_PTR(inf)[2]);
01614     subst_inf->ivar[chr] = rb_intern(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), rb_id2name(id))));
01615 
01616     rb_attr(self, id, 1, 0, Qtrue);
01617   }
01618 
01619   /*
01620    * procs : array of [type, proc]
01621    *         type  ==> char code or string
01622    *         proc  ==> proc/method/obj (must respond to 'call')
01623    */
01624   len = RARRAY_LEN(proc_inf);
01625   for(idx = 0; idx < len; idx++) {
01626     inf = RARRAY_PTR(proc_inf)[idx];
01627     if (TYPE(inf) != T_ARRAY) continue;
01628     rb_hash_aset(subst_inf->proc,
01629                  ((TYPE(RARRAY_PTR(inf)[0]) == T_STRING)?
01630                   INT2FIX(*(RSTRING_PTR(RARRAY_PTR(inf)[0]))) :
01631                   RARRAY_PTR(inf)[0]),
01632                  RARRAY_PTR(inf)[1]);
01633   }
01634 
01635   rb_const_set(self, ID_SUBST_INFO, cbsubst_obj);
01636 
01637   return self;
01638 }
01639 
01640 static VALUE
01641 cbsubst_get_extra_args_tbl(self)
01642     VALUE self;
01643 {
01644   return rb_ary_new();
01645 }
01646 
01647 static VALUE
01648 cbsubst_scan_args(self, arg_key, val_ary)
01649     VALUE self;
01650     VALUE arg_key;
01651     VALUE val_ary;
01652 {
01653     struct cbsubst_info *inf;
01654     long idx;
01655     unsigned char *keyptr = (unsigned char*)RSTRING_PTR(arg_key);
01656     long keylen = RSTRING_LEN(arg_key);
01657     long vallen = RARRAY_LEN(val_ary);
01658     unsigned char type_chr;
01659     volatile VALUE dst = rb_ary_new2(vallen);
01660     volatile VALUE proc;
01661     int thr_crit_bup;
01662     VALUE old_gc;
01663 
01664     thr_crit_bup = rb_thread_critical;
01665     rb_thread_critical = Qtrue;
01666 
01667     old_gc = rb_gc_disable();
01668 
01669     Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
01670                     struct cbsubst_info, inf);
01671 
01672     for(idx = 0; idx < vallen; idx++) {
01673       if (idx >= keylen) {
01674         proc = Qnil;
01675       } else if (*(keyptr + idx) == ' ') {
01676         proc = Qnil;
01677       } else {
01678         if (type_chr = inf->type[*(keyptr + idx)]) {
01679           proc = rb_hash_aref(inf->proc, INT2FIX((int)type_chr));
01680         } else {
01681           proc = Qnil;
01682         }
01683       }
01684 
01685       if (NIL_P(proc)) {
01686         rb_ary_push(dst, RARRAY_PTR(val_ary)[idx]);
01687       } else {
01688         rb_ary_push(dst, rb_funcall(proc, ID_call, 1,
01689                                     RARRAY_PTR(val_ary)[idx]));
01690       }
01691     }
01692 
01693     if (old_gc == Qfalse) rb_gc_enable();
01694     rb_thread_critical = thr_crit_bup;
01695 
01696     return dst;
01697 }
01698 
01699 static VALUE
01700 cbsubst_inspect(self)
01701     VALUE self;
01702 {
01703     return rb_str_new2("CallbackSubst");
01704 }
01705 
01706 static VALUE
01707 substinfo_inspect(self)
01708     VALUE self;
01709 {
01710     return rb_str_new2("SubstInfo");
01711 }
01712 
01713 /*************************************/
01714 
01715 static VALUE
01716 tk_cbe_inspect(self)
01717     VALUE self;
01718 {
01719     return rb_str_new2("TkCallbackEntry");
01720 }
01721 
01722 /*************************************/
01723 
01724 static VALUE
01725 tkobj_path(self)
01726     VALUE self;
01727 {
01728     return rb_ivar_get(self, ID_at_path);
01729 }
01730 
01731 
01732 /*************************************/
01733 /* release date */
01734 const char tkutil_release_date[] = TKUTIL_RELEASE_DATE;
01735 
01736 void
01737 Init_tkutil()
01738 {
01739     VALUE cTK = rb_define_class("TkKernel", rb_cObject);
01740     VALUE mTK = rb_define_module("TkUtil");
01741 
01742     /* --------------------- */
01743 
01744     rb_define_const(mTK, "RELEASE_DATE",
01745                     rb_obj_freeze(rb_str_new2(tkutil_release_date)));
01746 
01747     /* --------------------- */
01748     rb_global_variable(&cMethod);
01749     cMethod = rb_const_get(rb_cObject, rb_intern("Method"));
01750 
01751     ID_path = rb_intern("path");
01752     ID_at_path = rb_intern("@path");
01753     ID_at_enc = rb_intern("@encoding");
01754     ID_to_eval = rb_intern("to_eval");
01755     ID_to_s = rb_intern("to_s");
01756     ID_source = rb_intern("source");
01757     ID_downcase = rb_intern("downcase");
01758     ID_install_cmd = rb_intern("install_cmd");
01759     ID_merge_tklist = rb_intern("_merge_tklist");
01760     ID_encoding = rb_intern("encoding");
01761     ID_encoding_system = rb_intern("encoding_system");
01762     ID_call = rb_intern("call");
01763 
01764     /* --------------------- */
01765     cCB_SUBST = rb_define_class_under(mTK, "CallbackSubst", rb_cObject);
01766     rb_define_singleton_method(cCB_SUBST, "inspect", cbsubst_inspect, 0);
01767 
01768     cSUBST_INFO = rb_define_class_under(cCB_SUBST, "Info", rb_cObject);
01769     rb_define_singleton_method(cSUBST_INFO, "inspect", substinfo_inspect, 0);
01770 
01771     ID_SUBST_INFO = rb_intern("SUBST_INFO");
01772     rb_define_singleton_method(cCB_SUBST, "ret_val", cbsubst_ret_val, 1);
01773     rb_define_singleton_method(cCB_SUBST, "scan_args", cbsubst_scan_args, 2);
01774     rb_define_singleton_method(cCB_SUBST, "_sym2subst",
01775                                cbsubst_sym_to_subst, 1);
01776     rb_define_singleton_method(cCB_SUBST, "subst_arg",
01777                                cbsubst_get_subst_arg, -1);
01778     rb_define_singleton_method(cCB_SUBST, "_get_subst_key",
01779                                cbsubst_get_subst_key,  1);
01780     rb_define_singleton_method(cCB_SUBST, "_get_all_subst_keys",
01781                                cbsubst_get_all_subst_keys,  0);
01782     rb_define_singleton_method(cCB_SUBST, "_setup_subst_table",
01783                                cbsubst_table_setup, -1);
01784     rb_define_singleton_method(cCB_SUBST, "_get_extra_args_tbl",
01785                                cbsubst_get_extra_args_tbl,  0);
01786     rb_define_singleton_method(cCB_SUBST, "_define_attribute_aliases",
01787                                cbsubst_def_attr_aliases,  1);
01788 
01789     rb_define_method(cCB_SUBST, "initialize", cbsubst_initialize, -1);
01790 
01791     cbsubst_init();
01792 
01793     /* --------------------- */
01794     rb_global_variable(&cTkCallbackEntry);
01795     cTkCallbackEntry = rb_define_class("TkCallbackEntry", cTK);
01796     rb_define_singleton_method(cTkCallbackEntry, "inspect", tk_cbe_inspect, 0);
01797 
01798     /* --------------------- */
01799     rb_global_variable(&cTkObject);
01800     cTkObject = rb_define_class("TkObject", cTK);
01801     rb_define_method(cTkObject, "path", tkobj_path, 0);
01802 
01803     /* --------------------- */
01804     rb_require("tcltklib");
01805     rb_global_variable(&cTclTkLib);
01806     cTclTkLib = rb_const_get(rb_cObject, rb_intern("TclTkLib"));
01807     ID_split_tklist = rb_intern("_split_tklist");
01808     ID_toUTF8 = rb_intern("_toUTF8");
01809     ID_fromUTF8 = rb_intern("_fromUTF8");
01810 
01811     /* --------------------- */
01812     rb_define_singleton_method(cTK, "new", tk_s_new, -1);
01813 
01814     /* --------------------- */
01815     rb_global_variable(&TK_None);
01816     TK_None = rb_obj_alloc(rb_cObject);
01817     rb_define_const(mTK, "None", TK_None);
01818     rb_define_singleton_method(TK_None, "to_s", tkNone_to_s, 0);
01819     rb_define_singleton_method(TK_None, "inspect", tkNone_inspect, 0);
01820     OBJ_FREEZE(TK_None);
01821 
01822     /* --------------------- */
01823     rb_global_variable(&CALLBACK_TABLE);
01824     CALLBACK_TABLE = rb_hash_new();
01825 
01826     /* --------------------- */
01827     rb_define_singleton_method(mTK, "untrust", tk_obj_untrust, 1);
01828 
01829     rb_define_singleton_method(mTK, "eval_cmd", tk_eval_cmd, -1);
01830     rb_define_singleton_method(mTK, "callback", tk_do_callback, -1);
01831     rb_define_singleton_method(mTK, "install_cmd", tk_install_cmd, -1);
01832     rb_define_singleton_method(mTK, "uninstall_cmd", tk_uninstall_cmd, 1);
01833     rb_define_singleton_method(mTK, "_symbolkey2str", tk_symbolkey2str, 1);
01834     rb_define_singleton_method(mTK, "hash_kv", tk_hash_kv, -1);
01835     rb_define_singleton_method(mTK, "_get_eval_string",
01836                                tk_get_eval_string, -1);
01837     rb_define_singleton_method(mTK, "_get_eval_enc_str",
01838                                tk_get_eval_enc_str, 1);
01839     rb_define_singleton_method(mTK, "_conv_args", tk_conv_args, -1);
01840 
01841     rb_define_singleton_method(mTK, "bool", tcl2rb_bool, 1);
01842     rb_define_singleton_method(mTK, "number", tcl2rb_number, 1);
01843     rb_define_singleton_method(mTK, "string", tcl2rb_string, 1);
01844     rb_define_singleton_method(mTK, "num_or_str", tcl2rb_num_or_str, 1);
01845     rb_define_singleton_method(mTK, "num_or_nil", tcl2rb_num_or_nil, 1);
01846 
01847     rb_define_method(mTK, "_toUTF8", tk_toUTF8, -1);
01848     rb_define_method(mTK, "_fromUTF8", tk_fromUTF8, -1);
01849     rb_define_method(mTK, "_symbolkey2str", tk_symbolkey2str, 1);
01850     rb_define_method(mTK, "hash_kv", tk_hash_kv, -1);
01851     rb_define_method(mTK, "_get_eval_string", tk_get_eval_string, -1);
01852     rb_define_method(mTK, "_get_eval_enc_str", tk_get_eval_enc_str, 1);
01853     rb_define_method(mTK, "_conv_args", tk_conv_args, -1);
01854 
01855     rb_define_method(mTK, "bool", tcl2rb_bool, 1);
01856     rb_define_method(mTK, "number", tcl2rb_number, 1);
01857     rb_define_method(mTK, "string", tcl2rb_string, 1);
01858     rb_define_method(mTK, "num_or_str", tcl2rb_num_or_str, 1);
01859     rb_define_method(mTK, "num_or_nil", tcl2rb_num_or_nil, 1);
01860 
01861     /* --------------------- */
01862     rb_global_variable(&ENCODING_NAME_UTF8);
01863     ENCODING_NAME_UTF8 = rb_obj_freeze(rb_str_new2("utf-8"));
01864 
01865     /* --------------------- */
01866 }
01867