Ruby  1.9.3p484(2013-11-22revision43786)
tkutil.c
Go to the documentation of this file.
1 /************************************************
2 
3  tkutil.c -
4 
5  $Author: nobu $
6  created at: Fri Nov 3 00:47:54 JST 1995
7 
8 ************************************************/
9 
10 #define TKUTIL_RELEASE_DATE "2010-03-26"
11 
12 #include "ruby.h"
13 
14 #ifdef RUBY_VM
15 static VALUE rb_thread_critical; /* dummy */
16 #else
17 /* On Ruby 1.8.x, use rb_thread_critical (defined at rubysig.h) */
18 #include "rubysig.h"
19 #endif
20 #ifdef HAVE_RUBY_ST_H
21 #include "ruby/st.h"
22 #else
23 #include "st.h"
24 #endif
25 
26 #if !defined(RHASH_TBL)
27 #define RHASH_TBL(h) (RHASH(h)->tbl)
28 #endif
29 #if !defined(RSTRING_PTR)
30 #define RSTRING_PTR(s) (RSTRING(s)->ptr)
31 #define RSTRING_LEN(s) (RSTRING(s)->len)
32 #endif
33 #if !defined(RARRAY_PTR)
34 #define RARRAY_PTR(s) (RARRAY(s)->ptr)
35 #define RARRAY_LEN(s) (RARRAY(s)->len)
36 #endif
37 
38 #if defined(HAVE_STRNDUP) && !defined(_GNU_SOURCE)
39 extern char *strndup(const char* _ptr, size_t _len);
40 #endif
41 
42 static VALUE cMethod;
43 
45 
48 
49 static VALUE TK_None;
50 
53 
54 static VALUE ENCODING_NAME_UTF8; /* for saving GC cost */
55 
57 static ID ID_toUTF8;
58 static ID ID_fromUTF8;
59 static ID ID_path;
60 static ID ID_at_path;
61 static ID ID_at_enc;
62 static ID ID_to_eval;
63 static ID ID_to_s;
64 static ID ID_source;
65 static ID ID_downcase;
68 static ID ID_encoding;
70 static ID ID_call;
71 
73 
75 static unsigned long CALLBACK_ID_NUM = 0;
76 
77 /*************************************/
78 
79 #if defined(HAVE_RB_OBJ_INSTANCE_EXEC) && !defined(RUBY_VM)
80 extern VALUE rb_obj_instance_exec _((int, VALUE*, VALUE));
81 #endif
82 static VALUE
83 tk_s_new(argc, argv, klass)
84  int argc;
85  VALUE *argv;
86  VALUE klass;
87 {
88  VALUE obj = rb_class_new_instance(argc, argv, klass);
89 
90  if (rb_block_given_p()) {
91 #ifndef HAVE_RB_OBJ_INSTANCE_EXEC
92  rb_obj_instance_eval(0, 0, obj);
93 #else
94  rb_obj_instance_exec(1, &obj, obj);
95 #endif
96  }
97  return obj;
98 }
99 
100 /*************************************/
101 
102 static VALUE
104  VALUE self;
105 {
106  return rb_str_new2("");
107 }
108 
109 static VALUE
111  VALUE self;
112 {
113  return rb_str_new2("None");
114 }
115 
116 /*************************************/
117 
118 static VALUE
119 tk_obj_untrust(self, obj)
120  VALUE self;
121  VALUE obj;
122 {
123 #ifdef HAVE_RB_OBJ_TAINT
124  rb_obj_taint(obj);
125 #endif
126 #ifdef HAVE_RB_OBJ_UNTRUST
127  rb_obj_untrust(obj);
128 #endif
129 
130  return obj;
131 }
132 
133 static VALUE
135  int argc;
136  VALUE argv[];
137  VALUE self;
138 {
139  volatile VALUE cmd, rest;
140 
141  rb_scan_args(argc, argv, "1*", &cmd, &rest);
142  return rb_eval_cmd(cmd, rest, 0);
143 }
144 
145 static VALUE
147  int argc;
148  VALUE *argv;
149  VALUE self;
150 {
151 #if 0
152  volatile VALUE id;
153  volatile VALUE rest;
154 
155  rb_scan_args(argc, argv, "1*", &id, &rest);
156  return rb_apply(rb_hash_aref(CALLBACK_TABLE, id), ID_call, rest);
157 #endif
158  return rb_funcall2(rb_hash_aref(CALLBACK_TABLE, argv[0]),
159  ID_call, argc - 1, argv + 1);
160 }
161 
162 static const char cmd_id_head[] = "ruby_cmd TkUtil callback ";
163 static const char cmd_id_prefix[] = "cmd";
164 
165 static VALUE
167  VALUE cmd;
168 {
169  volatile VALUE id_num;
170 
171  id_num = ULONG2NUM(CALLBACK_ID_NUM++);
172  id_num = rb_funcall(id_num, ID_to_s, 0, 0);
173  id_num = rb_str_append(rb_str_new2(cmd_id_prefix), id_num);
174  rb_hash_aset(CALLBACK_TABLE, id_num, cmd);
175  return rb_str_append(rb_str_new2(cmd_id_head), id_num);
176 }
177 
178 static VALUE
180  int argc;
181  VALUE *argv;
182  VALUE self;
183 {
184  volatile VALUE cmd;
185 
186 #if 0
187  if (rb_scan_args(argc, argv, "01", &cmd) == 0) {
188  cmd = rb_block_proc();
189  }
190  return tk_install_cmd_core(cmd);
191 #endif
192  if (argc == 0) {
193  cmd = rb_block_proc();
194  } else {
195  cmd = argv[0];
196  }
197  return tk_install_cmd_core(cmd);
198 }
199 
200 static VALUE
201 tk_uninstall_cmd(self, cmd_id)
202  VALUE self;
203  VALUE cmd_id;
204 {
205  int head_len = strlen(cmd_id_head);
206  int prefix_len = strlen(cmd_id_prefix);
207 
208  StringValue(cmd_id);
209  if (strncmp(cmd_id_head, RSTRING_PTR(cmd_id), head_len) != 0) {
210  return Qnil;
211  }
212  if (strncmp(cmd_id_prefix,
213  RSTRING_PTR(cmd_id) + head_len, prefix_len) != 0) {
214  return Qnil;
215  }
216 
218  rb_str_new2(RSTRING_PTR(cmd_id) + head_len));
219 }
220 
221 static VALUE
223  int argc;
224  VALUE *argv;
225  VALUE self;
226 {
227  return rb_funcall2(cTclTkLib, ID_toUTF8, argc, argv);
228 }
229 
230 static VALUE
232  int argc;
233  VALUE *argv;
234  VALUE self;
235 {
236  return rb_funcall2(cTclTkLib, ID_fromUTF8, argc, argv);
237 }
238 
239 static VALUE
241  VALUE str;
242  VALUE self;
243 {
244  VALUE argv[1];
245 
246  argv[0] = str;
247  return tk_toUTF8(1, argv, self);
248 }
249 
250 #if 0
251 static VALUE
252 fromUTF8_toDefaultEnc(str, self)
253  VALUE str;
254  VALUE self;
255 {
256  VALUE argv[1];
257 
258  argv[0] = str;
259  return tk_fromUTF8(1, argv, self);
260 }
261 #endif
262 
263 static int
265  VALUE key;
266  VALUE value;
267  VALUE hash;
268 {
269  if (key == Qundef) return ST_CONTINUE;
270  rb_hash_aset(hash, rb_funcall(key, ID_to_s, 0, 0), value);
271  return ST_CHECK;
272 }
273 
274 static VALUE
275 tk_symbolkey2str(self, keys)
276  VALUE self;
277  VALUE keys;
278 {
279  volatile VALUE new_keys = rb_hash_new();
280 
281  if NIL_P(keys) return new_keys;
282  keys = rb_convert_type(keys, T_HASH, "Hash", "to_hash");
283  st_foreach(RHASH_TBL(keys), to_strkey, new_keys);
284  return new_keys;
285 }
286 
288 static VALUE ary2list _((VALUE, VALUE, VALUE));
289 static VALUE ary2list2 _((VALUE, VALUE, VALUE));
290 static VALUE hash2list _((VALUE, VALUE));
291 static VALUE hash2list_enc _((VALUE, VALUE));
292 static VALUE hash2kv _((VALUE, VALUE, VALUE));
293 static VALUE hash2kv_enc _((VALUE, VALUE, VALUE));
294 
295 static VALUE
296 ary2list(ary, enc_flag, self)
297  VALUE ary;
298  VALUE enc_flag;
299  VALUE self;
300 {
301  int idx, idx2, size, size2, req_chk_flag;
302  volatile VALUE val, val2, str_val;
303  volatile VALUE dst;
304  volatile VALUE sys_enc, dst_enc, str_enc;
305 
306  sys_enc = rb_funcall(cTclTkLib, ID_encoding, 0, 0);
307  if (NIL_P(sys_enc)) {
308  sys_enc = rb_funcall(cTclTkLib, ID_encoding_system, 0, 0);
309  sys_enc = rb_funcall(sys_enc, ID_to_s, 0, 0);
310  }
311 
312  if NIL_P(enc_flag) {
313  dst_enc = sys_enc;
314  req_chk_flag = 1;
315  } else if (TYPE(enc_flag) == T_TRUE || TYPE(enc_flag) == T_FALSE) {
316  dst_enc = enc_flag;
317  req_chk_flag = 0;
318  } else {
319  dst_enc = rb_funcall(enc_flag, ID_to_s, 0, 0);
320  req_chk_flag = 0;
321  }
322 
323  /* size = RARRAY_LEN(ary); */
324  size = 0;
325  for(idx = 0; idx < RARRAY_LEN(ary); idx++) {
326  if (TYPE(RARRAY_PTR(ary)[idx]) == T_HASH) {
327  size += 2 * RHASH_SIZE(RARRAY_PTR(ary)[idx]);
328  } else {
329  size++;
330  }
331  }
332 
333  dst = rb_ary_new2(size);
334  for(idx = 0; idx < RARRAY_LEN(ary); idx++) {
335  val = RARRAY_PTR(ary)[idx];
336  str_val = Qnil;
337  switch(TYPE(val)) {
338  case T_ARRAY:
339  str_val = ary2list(val, enc_flag, self);
340  rb_ary_push(dst, str_val);
341 
342  if (req_chk_flag) {
343  str_enc = rb_ivar_get(str_val, ID_at_enc);
344  if (!NIL_P(str_enc)) {
345  str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
346  } else {
347  str_enc = sys_enc;
348  }
349  if (!rb_str_cmp(str_enc, dst_enc)) {
350  dst_enc = Qtrue;
351  req_chk_flag = 0;
352  }
353  }
354 
355  break;
356 
357  case T_HASH:
358  /* rb_ary_push(dst, hash2list(val, self)); */
359  if (RTEST(enc_flag)) {
360  val = hash2kv_enc(val, Qnil, self);
361  } else {
362  val = hash2kv(val, Qnil, self);
363  }
364  size2 = RARRAY_LEN(val);
365  for(idx2 = 0; idx2 < size2; idx2++) {
366  val2 = RARRAY_PTR(val)[idx2];
367  switch(TYPE(val2)) {
368  case T_ARRAY:
369  str_val = ary2list(val2, enc_flag, self);
370  rb_ary_push(dst, str_val);
371  break;
372 
373  case T_HASH:
374  if (RTEST(enc_flag)) {
375  str_val = hash2list_enc(val2, self);
376  } else {
377  str_val = hash2list(val2, self);
378  }
379  rb_ary_push(dst, str_val);
380  break;
381 
382  default:
383  if (val2 != TK_None) {
384  str_val = get_eval_string_core(val2, enc_flag, self);
385  rb_ary_push(dst, str_val);
386  }
387  }
388 
389  if (req_chk_flag) {
390  str_enc = rb_ivar_get(str_val, ID_at_enc);
391  if (!NIL_P(str_enc)) {
392  str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
393  } else {
394  str_enc = sys_enc;
395  }
396  if (!rb_str_cmp(str_enc, dst_enc)) {
397  dst_enc = Qtrue;
398  req_chk_flag = 0;
399  }
400  }
401  }
402  break;
403 
404  default:
405  if (val != TK_None) {
406  str_val = get_eval_string_core(val, enc_flag, self);
407  rb_ary_push(dst, str_val);
408 
409  if (req_chk_flag) {
410  str_enc = rb_ivar_get(str_val, ID_at_enc);
411  if (!NIL_P(str_enc)) {
412  str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
413  } else {
414  str_enc = sys_enc;
415  }
416  if (!rb_str_cmp(str_enc, dst_enc)) {
417  dst_enc = Qtrue;
418  req_chk_flag = 0;
419  }
420  }
421  }
422  }
423  }
424 
425  if (RTEST(dst_enc) && !NIL_P(sys_enc)) {
426  for(idx = 0; idx < RARRAY_LEN(dst); idx++) {
427  str_val = RARRAY_PTR(dst)[idx];
428  if (rb_obj_respond_to(self, ID_toUTF8, Qtrue)) {
429  str_val = rb_funcall(self, ID_toUTF8, 1, str_val);
430  } else {
431  str_val = rb_funcall(cTclTkLib, ID_toUTF8, 1, str_val);
432  }
433  RARRAY_PTR(dst)[idx] = str_val;
434  }
435  val = rb_apply(cTclTkLib, ID_merge_tklist, dst);
436  if (TYPE(dst_enc) == T_STRING) {
437  val = rb_funcall(cTclTkLib, ID_fromUTF8, 2, val, dst_enc);
438  rb_ivar_set(val, ID_at_enc, dst_enc);
439  } else {
441  }
442  return val;
443  } else {
444  return rb_apply(cTclTkLib, ID_merge_tklist, dst);
445  }
446 }
447 
448 static VALUE
449 ary2list2(ary, enc_flag, self)
450  VALUE ary;
451  VALUE enc_flag;
452  VALUE self;
453 {
454  int idx, size, req_chk_flag;
455  volatile VALUE val, str_val;
456  volatile VALUE dst;
457  volatile VALUE sys_enc, dst_enc, str_enc;
458 
459  sys_enc = rb_funcall(cTclTkLib, ID_encoding, 0, 0);
460  if NIL_P(sys_enc) {
461  sys_enc = rb_funcall(cTclTkLib, ID_encoding_system, 0, 0);
462  sys_enc = rb_funcall(sys_enc, ID_to_s, 0, 0);
463  }
464 
465  if NIL_P(enc_flag) {
466  dst_enc = sys_enc;
467  req_chk_flag = 1;
468  } else if (TYPE(enc_flag) == T_TRUE || TYPE(enc_flag) == T_FALSE) {
469  dst_enc = enc_flag;
470  req_chk_flag = 0;
471  } else {
472  dst_enc = rb_funcall(enc_flag, ID_to_s, 0, 0);
473  req_chk_flag = 0;
474  }
475 
476  size = RARRAY_LEN(ary);
477  dst = rb_ary_new2(size);
478  for(idx = 0; idx < RARRAY_LEN(ary); idx++) {
479  val = RARRAY_PTR(ary)[idx];
480  str_val = Qnil;
481  switch(TYPE(val)) {
482  case T_ARRAY:
483  str_val = ary2list(val, enc_flag, self);
484  break;
485 
486  case T_HASH:
487  if (RTEST(enc_flag)) {
488  str_val = hash2list(val, self);
489  } else {
490  str_val = hash2list_enc(val, self);
491  }
492  break;
493 
494  default:
495  if (val != TK_None) {
496  str_val = get_eval_string_core(val, enc_flag, self);
497  }
498  }
499 
500  if (!NIL_P(str_val)) {
501  rb_ary_push(dst, str_val);
502 
503  if (req_chk_flag) {
504  str_enc = rb_ivar_get(str_val, ID_at_enc);
505  if (!NIL_P(str_enc)) {
506  str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
507  } else {
508  str_enc = sys_enc;
509  }
510  if (!rb_str_cmp(str_enc, dst_enc)) {
511  dst_enc = Qtrue;
512  req_chk_flag = 0;
513  }
514  }
515  }
516  }
517 
518  if (RTEST(dst_enc) && !NIL_P(sys_enc)) {
519  for(idx = 0; idx < RARRAY_LEN(dst); idx++) {
520  str_val = RARRAY_PTR(dst)[idx];
521  if (rb_obj_respond_to(self, ID_toUTF8, Qtrue)) {
522  str_val = rb_funcall(self, ID_toUTF8, 1, str_val);
523  } else {
524  str_val = rb_funcall(cTclTkLib, ID_toUTF8, 1, str_val);
525  }
526  RARRAY_PTR(dst)[idx] = str_val;
527  }
528  val = rb_apply(cTclTkLib, ID_merge_tklist, dst);
529  if (TYPE(dst_enc) == T_STRING) {
530  val = rb_funcall(cTclTkLib, ID_fromUTF8, 2, val, dst_enc);
531  rb_ivar_set(val, ID_at_enc, dst_enc);
532  } else {
534  }
535  return val;
536  } else {
537  return rb_apply(cTclTkLib, ID_merge_tklist, dst);
538  }
539 }
540 
541 static VALUE
543  VALUE key;
544 {
545  return rb_str_append(rb_str_new2("-"), rb_funcall(key, ID_to_s, 0, 0));
546 }
547 
548 static VALUE
549 assoc2kv(assoc, ary, self)
550  VALUE assoc;
551  VALUE ary;
552  VALUE self;
553 {
554  int i, j, len;
555  volatile VALUE pair;
556  volatile VALUE val;
557  volatile VALUE dst = rb_ary_new2(2 * RARRAY_LEN(assoc));
558 
559  len = RARRAY_LEN(assoc);
560 
561  for(i = 0; i < len; i++) {
562  pair = RARRAY_PTR(assoc)[i];
563  if (TYPE(pair) != T_ARRAY) {
564  rb_ary_push(dst, key2keyname(pair));
565  continue;
566  }
567  switch(RARRAY_LEN(assoc)) {
568  case 2:
569  rb_ary_push(dst, RARRAY_PTR(pair)[2]);
570 
571  case 1:
572  rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
573 
574  case 0:
575  continue;
576 
577  default:
578  rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
579 
580  val = rb_ary_new2(RARRAY_LEN(pair) - 1);
581  for(j = 1; j < RARRAY_LEN(pair); j++) {
582  rb_ary_push(val, RARRAY_PTR(pair)[j]);
583  }
584 
585  rb_ary_push(dst, val);
586  }
587  }
588 
589  if (NIL_P(ary)) {
590  return dst;
591  } else {
592  return rb_ary_plus(ary, dst);
593  }
594 }
595 
596 static VALUE
597 assoc2kv_enc(assoc, ary, self)
598  VALUE assoc;
599  VALUE ary;
600  VALUE self;
601 {
602  int i, j, len;
603  volatile VALUE pair;
604  volatile VALUE val;
605  volatile VALUE dst = rb_ary_new2(2 * RARRAY_LEN(assoc));
606 
607  len = RARRAY_LEN(assoc);
608 
609  for(i = 0; i < len; i++) {
610  pair = RARRAY_PTR(assoc)[i];
611  if (TYPE(pair) != T_ARRAY) {
612  rb_ary_push(dst, key2keyname(pair));
613  continue;
614  }
615  switch(RARRAY_LEN(assoc)) {
616  case 2:
617  rb_ary_push(dst, get_eval_string_core(RARRAY_PTR(pair)[2], Qtrue, self));
618 
619  case 1:
620  rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
621 
622  case 0:
623  continue;
624 
625  default:
626  rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
627 
628  val = rb_ary_new2(RARRAY_LEN(pair) - 1);
629  for(j = 1; j < RARRAY_LEN(pair); j++) {
630  rb_ary_push(val, RARRAY_PTR(pair)[j]);
631  }
632 
633  rb_ary_push(dst, get_eval_string_core(val, Qtrue, self));
634  }
635  }
636 
637  if (NIL_P(ary)) {
638  return dst;
639  } else {
640  return rb_ary_plus(ary, dst);
641  }
642 }
643 
644 static int
646  VALUE key;
647  VALUE val;
648  VALUE args;
649 {
650  volatile VALUE ary;
651 
652  ary = RARRAY_PTR(args)[0];
653 
654  if (key == Qundef) return ST_CONTINUE;
655 #if 0
656  rb_ary_push(ary, key2keyname(key));
657  if (val != TK_None) rb_ary_push(ary, val);
658 #endif
659  rb_ary_push(ary, key2keyname(key));
660 
661  if (val == TK_None) return ST_CHECK;
662 
663  rb_ary_push(ary, get_eval_string_core(val, Qnil, RARRAY_PTR(args)[1]));
664 
665  return ST_CHECK;
666 }
667 
668 static VALUE
669 hash2kv(hash, ary, self)
670  VALUE hash;
671  VALUE ary;
672  VALUE self;
673 {
674  volatile VALUE dst = rb_ary_new2(2 * RHASH_SIZE(hash));
675  volatile VALUE args = rb_ary_new3(2, dst, self);
676 
677  st_foreach(RHASH_TBL(hash), push_kv, args);
678 
679  if (NIL_P(ary)) {
680  return dst;
681  } else {
682  return rb_ary_concat(ary, dst);
683  }
684 }
685 
686 static int
688  VALUE key;
689  VALUE val;
690  VALUE args;
691 {
692  volatile VALUE ary;
693 
694  ary = RARRAY_PTR(args)[0];
695 
696  if (key == Qundef) return ST_CONTINUE;
697 #if 0
698  rb_ary_push(ary, key2keyname(key));
699  if (val != TK_None) {
701  RARRAY_PTR(args)[1]));
702  }
703 #endif
704  rb_ary_push(ary, key2keyname(key));
705 
706  if (val == TK_None) return ST_CHECK;
707 
708  rb_ary_push(ary, get_eval_string_core(val, Qtrue, RARRAY_PTR(args)[1]));
709 
710  return ST_CHECK;
711 }
712 
713 static VALUE
714 hash2kv_enc(hash, ary, self)
715  VALUE hash;
716  VALUE ary;
717  VALUE self;
718 {
719  volatile VALUE dst = rb_ary_new2(2 * RHASH_SIZE(hash));
720  volatile VALUE args = rb_ary_new3(2, dst, self);
721 
722  st_foreach(RHASH_TBL(hash), push_kv_enc, args);
723 
724  if (NIL_P(ary)) {
725  return dst;
726  } else {
727  return rb_ary_concat(ary, dst);
728  }
729 }
730 
731 static VALUE
733  VALUE hash;
734  VALUE self;
735 {
736  return ary2list2(hash2kv(hash, Qnil, self), Qfalse, self);
737 }
738 
739 
740 static VALUE
742  VALUE hash;
743  VALUE self;
744 {
745  return ary2list2(hash2kv_enc(hash, Qnil, self), Qfalse, self);
746 }
747 
748 static VALUE
750  int argc;
751  VALUE *argv;
752  VALUE self;
753 {
754  volatile VALUE hash, enc_flag, ary;
755 
756  ary = Qnil;
757  enc_flag = Qnil;
758  switch(argc) {
759  case 3:
760  ary = argv[2];
761  case 2:
762  enc_flag = argv[1];
763  case 1:
764  hash = argv[0];
765  break;
766  case 0:
767  rb_raise(rb_eArgError, "too few arguments");
768  default: /* >= 3 */
769  rb_raise(rb_eArgError, "too many arguments");
770  }
771 
772  switch(TYPE(hash)) {
773  case T_ARRAY:
774  if (RTEST(enc_flag)) {
775  return assoc2kv_enc(hash, ary, self);
776  } else {
777  return assoc2kv(hash, ary, self);
778  }
779 
780  case T_HASH:
781  if (RTEST(enc_flag)) {
782  return hash2kv_enc(hash, ary, self);
783  } else {
784  return hash2kv(hash, ary, self);
785  }
786 
787  case T_NIL:
788  if (NIL_P(ary)) {
789  return rb_ary_new();
790  } else {
791  return ary;
792  }
793 
794  default:
795  if (hash == TK_None) {
796  if (NIL_P(ary)) {
797  return rb_ary_new();
798  } else {
799  return ary;
800  }
801  }
802  rb_raise(rb_eArgError, "Hash is expected for 1st argument");
803  }
804 }
805 
806 static VALUE
807 get_eval_string_core(obj, enc_flag, self)
808  VALUE obj;
809  VALUE enc_flag;
810  VALUE self;
811 {
812  switch(TYPE(obj)) {
813  case T_FLOAT:
814  case T_FIXNUM:
815  case T_BIGNUM:
816  return rb_funcall(obj, ID_to_s, 0, 0);
817 
818  case T_STRING:
819  if (RTEST(enc_flag)) {
820  if (rb_obj_respond_to(self, ID_toUTF8, Qtrue)) {
821  return rb_funcall(self, ID_toUTF8, 1, obj);
822  } else {
823  return fromDefaultEnc_toUTF8(obj, self);
824  }
825  } else {
826  return obj;
827  }
828 
829  case T_SYMBOL:
830  if (RTEST(enc_flag)) {
831  if (rb_obj_respond_to(self, ID_toUTF8, Qtrue)) {
832  return rb_funcall(self, ID_toUTF8, 1,
833  rb_str_new2(rb_id2name(SYM2ID(obj))));
834  } else {
835  return fromDefaultEnc_toUTF8(rb_str_new2(rb_id2name(SYM2ID(obj))), self);
836  }
837  } else {
838 #ifdef HAVE_RB_SYM_TO_S
839  return rb_sym_to_s(obj);
840 #else
841  return rb_str_new2(rb_id2name(SYM2ID(obj)));
842 #endif
843  }
844 
845  case T_HASH:
846  if (RTEST(enc_flag)) {
847  return hash2list_enc(obj, self);
848  } else {
849  return hash2list(obj, self);
850  }
851 
852  case T_ARRAY:
853  return ary2list(obj, enc_flag, self);
854 
855  case T_FALSE:
856  return rb_str_new2("0");
857 
858  case T_TRUE:
859  return rb_str_new2("1");
860 
861  case T_NIL:
862  return rb_str_new2("");
863 
864  case T_REGEXP:
865  return rb_funcall(obj, ID_source, 0, 0);
866 
867  default:
868  if (rb_obj_is_kind_of(obj, cTkObject)) {
869  /* return rb_str_new3(rb_funcall(obj, ID_path, 0, 0)); */
870  return get_eval_string_core(rb_funcall(obj, ID_path, 0, 0),
871  enc_flag, self);
872  }
873 
874  if (rb_obj_is_kind_of(obj, rb_cProc)
875  || rb_obj_is_kind_of(obj, cMethod)
877  if (rb_obj_respond_to(self, ID_install_cmd, Qtrue)) {
878  return rb_funcall(self, ID_install_cmd, 1, obj);
879  } else {
880  return tk_install_cmd_core(obj);
881  }
882  }
883 
884  if (obj == TK_None) return Qnil;
885 
886  if (rb_obj_respond_to(obj, ID_to_eval, Qtrue)) {
887  /* return rb_funcall(obj, ID_to_eval, 0, 0); */
888  return get_eval_string_core(rb_funcall(obj, ID_to_eval, 0, 0),
889  enc_flag, self);
890  } else if (rb_obj_respond_to(obj, ID_path, Qtrue)) {
891  /* return rb_funcall(obj, ID_path, 0, 0); */
892  return get_eval_string_core(rb_funcall(obj, ID_path, 0, 0),
893  enc_flag, self);
894  } else if (rb_obj_respond_to(obj, ID_to_s, Qtrue)) {
895  return rb_funcall(obj, ID_to_s, 0, 0);
896  }
897  }
898 
899  rb_warning("fail to convert '%s' to string for Tk",
900  RSTRING_PTR(rb_funcall(obj, rb_intern("inspect"), 0, 0)));
901 
902  return obj;
903 }
904 
905 static VALUE
907  int argc;
908  VALUE *argv;
909  VALUE self;
910 {
911  volatile VALUE obj, enc_flag;
912 
913  if (rb_scan_args(argc, argv, "11", &obj, &enc_flag) == 1) {
914  enc_flag = Qnil;
915  }
916 
917  return get_eval_string_core(obj, enc_flag, self);
918 }
919 
920 static VALUE
922  VALUE self;
923  VALUE obj;
924 {
925  if (obj == TK_None) {
926  return obj;
927  } else {
928  return get_eval_string_core(obj, Qtrue, self);
929  }
930 }
931 
932 static VALUE
934  int argc;
935  VALUE *argv; /* [0]:base_array, [1]:enc_mode, [2]..[n]:args */
936  VALUE self;
937 {
938  int idx, size;
939  volatile VALUE dst;
940  int thr_crit_bup;
941  VALUE old_gc;
942 
943  if (argc < 2) {
944  rb_raise(rb_eArgError, "too few arguments");
945  }
946 
947  thr_crit_bup = rb_thread_critical;
948  rb_thread_critical = Qtrue;
949  old_gc = rb_gc_disable();
950 
951  for(size = 0, idx = 2; idx < argc; idx++) {
952  if (TYPE(argv[idx]) == T_HASH) {
953  size += 2 * RHASH_SIZE(argv[idx]);
954  } else {
955  size++;
956  }
957  }
958  /* dst = rb_ary_new2(argc - 2); */
959  dst = rb_ary_new2(size);
960  for(idx = 2; idx < argc; idx++) {
961  if (TYPE(argv[idx]) == T_HASH) {
962  if (RTEST(argv[1])) {
963  hash2kv_enc(argv[idx], dst, self);
964  } else {
965  hash2kv(argv[idx], dst, self);
966  }
967  } else if (argv[idx] != TK_None) {
968  rb_ary_push(dst, get_eval_string_core(argv[idx], argv[1], self));
969  }
970  }
971 
972  if (old_gc == Qfalse) rb_gc_enable();
973  rb_thread_critical = thr_crit_bup;
974 
975  return rb_ary_plus(argv[0], dst);
976 }
977 
978 
979 /*************************************/
980 
981 static VALUE
982 tcl2rb_bool(self, value)
983  VALUE self;
984  VALUE value;
985 {
986  if (TYPE(value) == T_FIXNUM) {
987  if (NUM2INT(value) == 0) {
988  return Qfalse;
989  } else {
990  return Qtrue;
991  }
992  }
993 
994  if (TYPE(value) == T_TRUE || TYPE(value) == T_FALSE) {
995  return value;
996  }
997 
998  rb_check_type(value, T_STRING);
999 
1000  value = rb_funcall(value, ID_downcase, 0);
1001 
1002  if (RSTRING_PTR(value) == (char*)NULL) return Qnil;
1003 
1004  if (RSTRING_PTR(value)[0] == '\0'
1005  || strcmp(RSTRING_PTR(value), "0") == 0
1006  || strcmp(RSTRING_PTR(value), "no") == 0
1007  || strcmp(RSTRING_PTR(value), "off") == 0
1008  || strcmp(RSTRING_PTR(value), "false") == 0) {
1009  return Qfalse;
1010  } else {
1011  return Qtrue;
1012  }
1013 }
1014 
1015 #if 0
1016 static VALUE
1017 tkstr_to_dec(value)
1018  VALUE value;
1019 {
1020  return rb_cstr_to_inum(RSTRING_PTR(value), 10, 1);
1021 }
1022 #endif
1023 
1024 static VALUE
1026  VALUE value;
1027 {
1028  return rb_cstr_to_inum(RSTRING_PTR(value), 0, 1);
1029 }
1030 
1031 static VALUE
1033  VALUE value;
1034 {
1035  return rb_float_new(rb_cstr_to_dbl(RSTRING_PTR(value), 1));
1036 }
1037 
1038 static VALUE
1040  VALUE value;
1041 {
1043  "invalid value for Number: '%s'", RSTRING_PTR(value));
1044  return Qnil; /*dummy*/
1045 }
1046 
1047 static VALUE
1049  VALUE value;
1050 {
1051  return rb_rescue2(tkstr_to_float, value,
1052  tkstr_invalid_numstr, value,
1053  rb_eArgError, 0);
1054 }
1055 
1056 static VALUE
1058  VALUE value;
1059 {
1060  rb_check_type(value, T_STRING);
1061 
1062  if (RSTRING_PTR(value) == (char*)NULL) return INT2FIX(0);
1063 
1064  return rb_rescue2(tkstr_to_int, value,
1065  tkstr_rescue_float, value,
1066  rb_eArgError, 0);
1067 }
1068 
1069 static VALUE
1070 tcl2rb_number(self, value)
1071  VALUE self;
1072  VALUE value;
1073 {
1074  return tkstr_to_number(value);
1075 }
1076 
1077 static VALUE
1079  VALUE value;
1080 {
1081  char * ptr;
1082  int len;
1083 
1084  ptr = RSTRING_PTR(value);
1085  len = RSTRING_LEN(value);
1086 
1087  if (len > 1 && *ptr == '{' && *(ptr + len - 1) == '}') {
1088  return rb_str_new(ptr + 1, len - 2);
1089  }
1090  return value;
1091 }
1092 
1093 static VALUE
1094 tcl2rb_string(self, value)
1095  VALUE self;
1096  VALUE value;
1097 {
1098  rb_check_type(value, T_STRING);
1099 
1100  if (RSTRING_PTR(value) == (char*)NULL) return rb_tainted_str_new2("");
1101 
1102  return tkstr_to_str(value);
1103 }
1104 
1105 static VALUE
1106 tcl2rb_num_or_str(self, value)
1107  VALUE self;
1108  VALUE value;
1109 {
1110  rb_check_type(value, T_STRING);
1111 
1112  if (RSTRING_PTR(value) == (char*)NULL) return rb_tainted_str_new2("");
1113 
1114  return rb_rescue2(tkstr_to_number, value,
1115  tkstr_to_str, value,
1116  rb_eArgError, 0);
1117 }
1118 
1119 static VALUE
1120 tcl2rb_num_or_nil(self, value)
1121  VALUE self;
1122  VALUE value;
1123 {
1124  rb_check_type(value, T_STRING);
1125 
1126  if (RSTRING_LEN(value) == 0) return Qnil;
1127 
1128  return tkstr_to_number(value);
1129 }
1130 
1131 
1132 /*************************************/
1133 
1134 #define CBSUBST_TBL_MAX (256)
1143 };
1144 
1145 static void
1147  struct cbsubst_info *ptr;
1148 {
1149  rb_gc_mark(ptr->proc);
1150  rb_gc_mark(ptr->aliases);
1151 }
1152 
1153 static void
1155  struct cbsubst_info *ptr;
1156 {
1157  int i;
1158 
1159  if (ptr) {
1160  for(i = 0; i < CBSUBST_TBL_MAX; i++) {
1161  if (ptr->key[i] != NULL) {
1162  free(ptr->key[i]); /* allocated by malloc */
1163  ptr->key[i] = NULL;
1164  }
1165  }
1166  xfree(ptr); /* allocated by ALLOC */
1167  }
1168 }
1169 
1170 static VALUE
1172 {
1173  struct cbsubst_info *inf;
1174  volatile VALUE proc, aliases;
1175  int idx;
1176 
1177  inf = ALLOC(struct cbsubst_info);
1178 
1179  inf->full_subst_length = 0;
1180 
1181  for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
1182  inf->keylen[idx] = 0;
1183  inf->key[idx] = NULL;
1184  inf->type[idx] = '\0';
1185  inf->ivar[idx] = (ID) 0;
1186  }
1187 
1188  proc = rb_hash_new();
1189  inf->proc = proc;
1190 
1191  aliases = rb_hash_new();
1192  inf->aliases = aliases;
1193 
1194  if (inf_ptr != (struct cbsubst_info **)NULL) *inf_ptr = inf;
1195 
1197 }
1198 
1199 static void
1201 {
1204 }
1205 
1206 static VALUE
1208  int argc;
1209  VALUE *argv;
1210  VALUE self;
1211 {
1212  struct cbsubst_info *inf;
1213  int idx, iv_idx;
1214 
1216  struct cbsubst_info, inf);
1217 
1218  idx = 0;
1219  for(iv_idx = 0; iv_idx < CBSUBST_TBL_MAX; iv_idx++) {
1220  if ( inf->ivar[iv_idx] == (ID) 0 ) continue;
1221  rb_ivar_set(self, inf->ivar[iv_idx], argv[idx++]);
1222  if (idx >= argc) break;
1223  }
1224 
1225  return self;
1226 }
1227 
1228 static VALUE
1230  VALUE self;
1231  VALUE val;
1232 {
1233  /* This method may be overwritten on some sub-classes. */
1234  /* This method is used for converting from ruby's callback-return-value */
1235  /* to tcl's value (e.g. validation procedure of entry widget). */
1236  return val;
1237 }
1238 
1239 static int
1240 each_attr_def(key, value, klass)
1241  VALUE key, value, klass;
1242 {
1243  ID key_id, value_id;
1244 
1245  if (key == Qundef) return ST_CONTINUE;
1246 
1247  switch(TYPE(key)) {
1248  case T_STRING:
1249  key_id = rb_intern(RSTRING_PTR(key));
1250  break;
1251  case T_SYMBOL:
1252  key_id = SYM2ID(key);
1253  break;
1254  default:
1256  "includes invalid key(s). expected a String or a Symbol");
1257  }
1258 
1259  switch(TYPE(value)) {
1260  case T_STRING:
1261  value_id = rb_intern(RSTRING_PTR(value));
1262  break;
1263  case T_SYMBOL:
1264  value_id = SYM2ID(value);
1265  break;
1266  default:
1268  "includes invalid value(s). expected a String or a Symbol");
1269  }
1270 
1271  rb_alias(klass, key_id, value_id);
1272 
1273  return ST_CONTINUE;
1274 }
1275 
1276 static VALUE
1278  VALUE self;
1279  VALUE tbl;
1280 {
1281  struct cbsubst_info *inf;
1282 
1283  if (TYPE(tbl) != T_HASH) {
1284  rb_raise(rb_eArgError, "expected a Hash");
1285  }
1286 
1288  struct cbsubst_info, inf);
1289 
1290  rb_hash_foreach(tbl, each_attr_def, self);
1291 
1292  return rb_funcall(inf->aliases, rb_intern("update"), 1, tbl);
1293 }
1294 
1295 static VALUE
1297  VALUE self;
1298  VALUE sym;
1299 {
1300  struct cbsubst_info *inf;
1301  const char *str;
1302  char *buf, *ptr;
1303  int idx, len;
1304  ID id;
1305  volatile VALUE ret;
1306 
1307  if (TYPE(sym) != T_SYMBOL) return sym;
1308 
1310  struct cbsubst_info, inf);
1311 
1312  if (!NIL_P(ret = rb_hash_aref(inf->aliases, sym))) {
1313  str = rb_id2name(SYM2ID(ret));
1314  } else {
1315  str = rb_id2name(SYM2ID(sym));
1316  }
1317 
1318  id = rb_intern(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), str)));
1319 
1320  for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
1321  if (inf->ivar[idx] == id) break;
1322  }
1323  if (idx >= CBSUBST_TBL_MAX) return sym;
1324 
1325  ptr = buf = ALLOC_N(char, inf->full_subst_length + 1);
1326 
1327  *(ptr++) = '%';
1328 
1329  if (len = inf->keylen[idx]) {
1330  /* longname */
1331  strncpy(ptr, inf->key[idx], len);
1332  ptr += len;
1333  } else {
1334  /* single char */
1335  *(ptr++) = (unsigned char)idx;
1336  }
1337 
1338  *(ptr++) = ' ';
1339  *(ptr++) = '\0';
1340 
1341  ret = rb_str_new2(buf);
1342 
1343  xfree(buf);
1344 
1345  return ret;
1346 }
1347 
1348 static VALUE
1350  int argc;
1351  VALUE *argv;
1352  VALUE self;
1353 {
1354  struct cbsubst_info *inf;
1355  const char *str;
1356  char *buf, *ptr;
1357  int i, idx, len;
1358  ID id;
1359  volatile VALUE arg_sym, ret;
1360 
1362  struct cbsubst_info, inf);
1363 
1364  ptr = buf = ALLOC_N(char, inf->full_subst_length + 1);
1365 
1366  for(i = 0; i < argc; i++) {
1367  switch(TYPE(argv[i])) {
1368  case T_STRING:
1369  str = RSTRING_PTR(argv[i]);
1370  arg_sym = ID2SYM(rb_intern(str));
1371  break;
1372  case T_SYMBOL:
1373  arg_sym = argv[i];
1374  str = rb_id2name(SYM2ID(arg_sym));
1375  break;
1376  default:
1377  rb_raise(rb_eArgError, "arg #%d is not a String or a Symbol", i);
1378  }
1379 
1380  if (!NIL_P(ret = rb_hash_aref(inf->aliases, arg_sym))) {
1381  str = rb_id2name(SYM2ID(ret));
1382  }
1383 
1384  id = rb_intern(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), str)));
1385 
1386  for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
1387  if (inf->ivar[idx] == id) break;
1388  }
1389  if (idx >= CBSUBST_TBL_MAX) {
1390  rb_raise(rb_eArgError, "cannot find attribute :%s", str);
1391  }
1392 
1393  *(ptr++) = '%';
1394 
1395  if (len = inf->keylen[idx]) {
1396  /* longname */
1397  strncpy(ptr, inf->key[idx], len);
1398  ptr += len;
1399  } else {
1400  /* single char */
1401  *(ptr++) = (unsigned char)idx;
1402  }
1403 
1404  *(ptr++) = ' ';
1405  }
1406 
1407  *ptr = '\0';
1408 
1409  ret = rb_str_new2(buf);
1410 
1411  xfree(buf);
1412 
1413  return ret;
1414 }
1415 
1416 static VALUE
1418  VALUE self;
1419  VALUE str;
1420 {
1421  struct cbsubst_info *inf;
1422  volatile VALUE list;
1423  volatile VALUE ret;
1424  VALUE keyval;
1425  int i, len, keylen, idx;
1426  char *buf, *ptr, *key;
1427 
1428  list = rb_funcall(cTclTkLib, ID_split_tklist, 1, str);
1429  len = RARRAY_LEN(list);
1430 
1432  struct cbsubst_info, inf);
1433 
1434  ptr = buf = ALLOC_N(char, inf->full_subst_length + len + 1);
1435 
1436  for(i = 0; i < len; i++) {
1437  keyval = RARRAY_PTR(list)[i];
1438  key = RSTRING_PTR(keyval);
1439  if (*key == '%') {
1440  if (*(key + 2) == '\0') {
1441  /* single char */
1442  *(ptr++) = *(key + 1);
1443  } else {
1444  /* search longname-key */
1445  keylen = RSTRING_LEN(keyval) - 1;
1446  for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
1447  if (inf->keylen[idx] != keylen) continue;
1448  if ((unsigned char)inf->key[idx][0] != (unsigned char)*(key + 1)) continue;
1449  if (strncmp(inf->key[idx], key + 1, keylen)) continue;
1450  break;
1451  }
1452  if (idx < CBSUBST_TBL_MAX) {
1453  *(ptr++) = (unsigned char)idx;
1454  } else {
1455  *(ptr++) = ' ';
1456  }
1457  }
1458  } else {
1459  *(ptr++) = ' ';
1460  }
1461  }
1462  *ptr = '\0';
1463 
1464  ret = rb_str_new2(buf);
1465  xfree(buf);
1466  return ret;
1467 }
1468 
1469 static VALUE
1471  VALUE self;
1472 {
1473  struct cbsubst_info *inf;
1474  char *buf, *ptr;
1475  char *keys_buf, *keys_ptr;
1476  int idx, len;
1477  volatile VALUE ret;
1478 
1480  struct cbsubst_info, inf);
1481 
1482  ptr = buf = ALLOC_N(char, inf->full_subst_length + 1);
1483  keys_ptr = keys_buf = ALLOC_N(char, CBSUBST_TBL_MAX + 1);
1484 
1485  for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
1486  if (inf->ivar[idx] == (ID) 0) continue;
1487 
1488  *(keys_ptr++) = (unsigned char)idx;
1489 
1490  *(ptr++) = '%';
1491 
1492  if (len = inf->keylen[idx]) {
1493  /* longname */
1494  strncpy(ptr, inf->key[idx], len);
1495  ptr += len;
1496  } else {
1497  /* single char */
1498  *(ptr++) = (unsigned char)idx;
1499  }
1500 
1501  *(ptr++) = ' ';
1502  }
1503 
1504  *ptr = '\0';
1505  *keys_ptr = '\0';
1506 
1507  ret = rb_ary_new3(2, rb_str_new2(keys_buf), rb_str_new2(buf));
1508 
1509  xfree(buf);
1510  xfree(keys_buf);
1511 
1512  return ret;
1513 }
1514 
1515 static VALUE
1517  int argc;
1518  VALUE *argv;
1519  VALUE self;
1520 {
1521  volatile VALUE cbsubst_obj;
1522  volatile VALUE key_inf;
1523  volatile VALUE longkey_inf;
1524  volatile VALUE proc_inf;
1525  VALUE inf;
1526  ID id;
1527  struct cbsubst_info *subst_inf;
1528  int idx, len;
1529  unsigned char chr;
1530 
1531  /* accept (key_inf, proc_inf) or (key_inf, longkey_inf, procinf) */
1532  if (rb_scan_args(argc, argv, "21", &key_inf, &longkey_inf, &proc_inf) == 2) {
1533  proc_inf = longkey_inf;
1534  longkey_inf = rb_ary_new();
1535  }
1536 
1537  /* check the number of longkeys */
1538  if (RARRAY_LEN(longkey_inf) > 125 /* from 0x80 to 0xFD */) {
1539  rb_raise(rb_eArgError, "too many longname-key definitions");
1540  }
1541 
1542  /* init */
1543  cbsubst_obj = allocate_cbsubst_info(&subst_inf);
1544 
1545  /*
1546  * keys : array of [subst, type, ivar]
1547  * subst ==> char code or string
1548  * type ==> char code or string
1549  * ivar ==> symbol
1550  */
1551  len = RARRAY_LEN(key_inf);
1552  for(idx = 0; idx < len; idx++) {
1553  inf = RARRAY_PTR(key_inf)[idx];
1554  if (TYPE(inf) != T_ARRAY) continue;
1555 
1556  if (TYPE(RARRAY_PTR(inf)[0]) == T_STRING) {
1557  chr = *(RSTRING_PTR(RARRAY_PTR(inf)[0]));
1558  } else {
1559  chr = NUM2CHR(RARRAY_PTR(inf)[0]);
1560  }
1561  if (TYPE(RARRAY_PTR(inf)[1]) == T_STRING) {
1562  subst_inf->type[chr] = *(RSTRING_PTR(RARRAY_PTR(inf)[1]));
1563  } else {
1564  subst_inf->type[chr] = NUM2CHR(RARRAY_PTR(inf)[1]);
1565  }
1566 
1567  subst_inf->full_subst_length += 3;
1568 
1569  id = SYM2ID(RARRAY_PTR(inf)[2]);
1570  subst_inf->ivar[chr] = rb_intern(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), rb_id2name(id))));
1571 
1572  rb_attr(self, id, 1, 0, Qtrue);
1573  }
1574 
1575 
1576  /*
1577  * longkeys : array of [name, type, ivar]
1578  * name ==> longname key string
1579  * type ==> char code or string
1580  * ivar ==> symbol
1581  */
1582  len = RARRAY_LEN(longkey_inf);
1583  for(idx = 0; idx < len; idx++) {
1584  inf = RARRAY_PTR(longkey_inf)[idx];
1585  if (TYPE(inf) != T_ARRAY) continue;
1586 
1587  chr = (unsigned char)(0x80 + idx);
1588  subst_inf->keylen[chr] = RSTRING_LEN(RARRAY_PTR(inf)[0]);
1589 #if HAVE_STRNDUP
1590  subst_inf->key[chr] = strndup(RSTRING_PTR(RARRAY_PTR(inf)[0]),
1591  RSTRING_LEN(RARRAY_PTR(inf)[0]));
1592 #else
1593  subst_inf->key[chr] = malloc(RSTRING_LEN(RARRAY_PTR(inf)[0]) + 1);
1594  if (subst_inf->key[chr]) {
1595  strncpy(subst_inf->key[chr], RSTRING_PTR(RARRAY_PTR(inf)[0]),
1596  RSTRING_LEN(RARRAY_PTR(inf)[0]) + 1);
1597  subst_inf->key[chr][RSTRING_LEN(RARRAY_PTR(inf)[0])] = '\0';
1598  }
1599 #endif
1600  if (TYPE(RARRAY_PTR(inf)[1]) == T_STRING) {
1601  subst_inf->type[chr] = *(RSTRING_PTR(RARRAY_PTR(inf)[1]));
1602  } else {
1603  subst_inf->type[chr] = NUM2CHR(RARRAY_PTR(inf)[1]);
1604  }
1605 
1606  subst_inf->full_subst_length += (subst_inf->keylen[chr] + 2);
1607 
1608  id = SYM2ID(RARRAY_PTR(inf)[2]);
1609  subst_inf->ivar[chr] = rb_intern(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), rb_id2name(id))));
1610 
1611  rb_attr(self, id, 1, 0, Qtrue);
1612  }
1613 
1614  /*
1615  * procs : array of [type, proc]
1616  * type ==> char code or string
1617  * proc ==> proc/method/obj (must respond to 'call')
1618  */
1619  len = RARRAY_LEN(proc_inf);
1620  for(idx = 0; idx < len; idx++) {
1621  inf = RARRAY_PTR(proc_inf)[idx];
1622  if (TYPE(inf) != T_ARRAY) continue;
1623  rb_hash_aset(subst_inf->proc,
1624  ((TYPE(RARRAY_PTR(inf)[0]) == T_STRING)?
1625  INT2FIX(*(RSTRING_PTR(RARRAY_PTR(inf)[0]))) :
1626  RARRAY_PTR(inf)[0]),
1627  RARRAY_PTR(inf)[1]);
1628  }
1629 
1630  rb_const_set(self, ID_SUBST_INFO, cbsubst_obj);
1631 
1632  return self;
1633 }
1634 
1635 static VALUE
1637  VALUE self;
1638 {
1639  return rb_ary_new();
1640 }
1641 
1642 static VALUE
1643 cbsubst_scan_args(self, arg_key, val_ary)
1644  VALUE self;
1645  VALUE arg_key;
1646  VALUE val_ary;
1647 {
1648  struct cbsubst_info *inf;
1649  int idx;
1650  unsigned char *keyptr = (unsigned char*)RSTRING_PTR(arg_key);
1651  int keylen = RSTRING_LEN(arg_key);
1652  int vallen = RARRAY_LEN(val_ary);
1653  unsigned char type_chr;
1654  volatile VALUE dst = rb_ary_new2(vallen);
1655  volatile VALUE proc;
1656  int thr_crit_bup;
1657  VALUE old_gc;
1658 
1659  thr_crit_bup = rb_thread_critical;
1660  rb_thread_critical = Qtrue;
1661 
1662  old_gc = rb_gc_disable();
1663 
1665  struct cbsubst_info, inf);
1666 
1667  for(idx = 0; idx < vallen; idx++) {
1668  if (idx >= keylen) {
1669  proc = Qnil;
1670  } else if (*(keyptr + idx) == ' ') {
1671  proc = Qnil;
1672  } else {
1673  if (type_chr = inf->type[*(keyptr + idx)]) {
1674  proc = rb_hash_aref(inf->proc, INT2FIX((int)type_chr));
1675  } else {
1676  proc = Qnil;
1677  }
1678  }
1679 
1680  if (NIL_P(proc)) {
1681  rb_ary_push(dst, RARRAY_PTR(val_ary)[idx]);
1682  } else {
1683  rb_ary_push(dst, rb_funcall(proc, ID_call, 1,
1684  RARRAY_PTR(val_ary)[idx]));
1685  }
1686  }
1687 
1688  if (old_gc == Qfalse) rb_gc_enable();
1689  rb_thread_critical = thr_crit_bup;
1690 
1691  return dst;
1692 }
1693 
1694 static VALUE
1696  VALUE self;
1697 {
1698  return rb_str_new2("CallbackSubst");
1699 }
1700 
1701 static VALUE
1703  VALUE self;
1704 {
1705  return rb_str_new2("SubstInfo");
1706 }
1707 
1708 /*************************************/
1709 
1710 static VALUE
1712  VALUE self;
1713 {
1714  return rb_str_new2("TkCallbackEntry");
1715 }
1716 
1717 /*************************************/
1718 
1719 static VALUE
1721  VALUE self;
1722 {
1723  return rb_ivar_get(self, ID_at_path);
1724 }
1725 
1726 
1727 /*************************************/
1728 /* release date */
1730 
1731 void
1733 {
1734  VALUE cTK = rb_define_class("TkKernel", rb_cObject);
1735  VALUE mTK = rb_define_module("TkUtil");
1736 
1737  /* --------------------- */
1738 
1739  rb_define_const(mTK, "RELEASE_DATE",
1740  rb_obj_freeze(rb_str_new2(tkutil_release_date)));
1741 
1742  /* --------------------- */
1744  cMethod = rb_const_get(rb_cObject, rb_intern("Method"));
1745 
1746  ID_path = rb_intern("path");
1747  ID_at_path = rb_intern("@path");
1748  ID_at_enc = rb_intern("@encoding");
1749  ID_to_eval = rb_intern("to_eval");
1750  ID_to_s = rb_intern("to_s");
1751  ID_source = rb_intern("source");
1752  ID_downcase = rb_intern("downcase");
1753  ID_install_cmd = rb_intern("install_cmd");
1754  ID_merge_tklist = rb_intern("_merge_tklist");
1755  ID_encoding = rb_intern("encoding");
1756  ID_encoding_system = rb_intern("encoding_system");
1757  ID_call = rb_intern("call");
1758 
1759  /* --------------------- */
1760  cCB_SUBST = rb_define_class_under(mTK, "CallbackSubst", rb_cObject);
1762 
1765 
1766  ID_SUBST_INFO = rb_intern("SUBST_INFO");
1769  rb_define_singleton_method(cCB_SUBST, "_sym2subst",
1772  cbsubst_get_subst_arg, -1);
1773  rb_define_singleton_method(cCB_SUBST, "_get_subst_key",
1775  rb_define_singleton_method(cCB_SUBST, "_get_all_subst_keys",
1777  rb_define_singleton_method(cCB_SUBST, "_setup_subst_table",
1778  cbsubst_table_setup, -1);
1779  rb_define_singleton_method(cCB_SUBST, "_get_extra_args_tbl",
1781  rb_define_singleton_method(cCB_SUBST, "_define_attribute_aliases",
1783 
1784  rb_define_method(cCB_SUBST, "initialize", cbsubst_initialize, -1);
1785 
1786  cbsubst_init();
1787 
1788  /* --------------------- */
1790  cTkCallbackEntry = rb_define_class("TkCallbackEntry", cTK);
1792 
1793  /* --------------------- */
1795  cTkObject = rb_define_class("TkObject", cTK);
1796  rb_define_method(cTkObject, "path", tkobj_path, 0);
1797 
1798  /* --------------------- */
1799  rb_require("tcltklib");
1801  cTclTkLib = rb_const_get(rb_cObject, rb_intern("TclTkLib"));
1802  ID_split_tklist = rb_intern("_split_tklist");
1803  ID_toUTF8 = rb_intern("_toUTF8");
1804  ID_fromUTF8 = rb_intern("_fromUTF8");
1805 
1806  /* --------------------- */
1807  rb_define_singleton_method(cTK, "new", tk_s_new, -1);
1808 
1809  /* --------------------- */
1812  rb_define_const(mTK, "None", TK_None);
1816 
1817  /* --------------------- */
1820 
1821  /* --------------------- */
1822  rb_define_singleton_method(mTK, "untrust", tk_obj_untrust, 1);
1823 
1824  rb_define_singleton_method(mTK, "eval_cmd", tk_eval_cmd, -1);
1825  rb_define_singleton_method(mTK, "callback", tk_do_callback, -1);
1826  rb_define_singleton_method(mTK, "install_cmd", tk_install_cmd, -1);
1827  rb_define_singleton_method(mTK, "uninstall_cmd", tk_uninstall_cmd, 1);
1828  rb_define_singleton_method(mTK, "_symbolkey2str", tk_symbolkey2str, 1);
1829  rb_define_singleton_method(mTK, "hash_kv", tk_hash_kv, -1);
1830  rb_define_singleton_method(mTK, "_get_eval_string",
1831  tk_get_eval_string, -1);
1832  rb_define_singleton_method(mTK, "_get_eval_enc_str",
1833  tk_get_eval_enc_str, 1);
1834  rb_define_singleton_method(mTK, "_conv_args", tk_conv_args, -1);
1835 
1836  rb_define_singleton_method(mTK, "bool", tcl2rb_bool, 1);
1837  rb_define_singleton_method(mTK, "number", tcl2rb_number, 1);
1838  rb_define_singleton_method(mTK, "string", tcl2rb_string, 1);
1839  rb_define_singleton_method(mTK, "num_or_str", tcl2rb_num_or_str, 1);
1840  rb_define_singleton_method(mTK, "num_or_nil", tcl2rb_num_or_nil, 1);
1841 
1842  rb_define_method(mTK, "_toUTF8", tk_toUTF8, -1);
1843  rb_define_method(mTK, "_fromUTF8", tk_fromUTF8, -1);
1844  rb_define_method(mTK, "_symbolkey2str", tk_symbolkey2str, 1);
1845  rb_define_method(mTK, "hash_kv", tk_hash_kv, -1);
1846  rb_define_method(mTK, "_get_eval_string", tk_get_eval_string, -1);
1847  rb_define_method(mTK, "_get_eval_enc_str", tk_get_eval_enc_str, 1);
1848  rb_define_method(mTK, "_conv_args", tk_conv_args, -1);
1849 
1850  rb_define_method(mTK, "bool", tcl2rb_bool, 1);
1851  rb_define_method(mTK, "number", tcl2rb_number, 1);
1852  rb_define_method(mTK, "string", tcl2rb_string, 1);
1853  rb_define_method(mTK, "num_or_str", tcl2rb_num_or_str, 1);
1854  rb_define_method(mTK, "num_or_nil", tcl2rb_num_or_nil, 1);
1855 
1856  /* --------------------- */
1859 
1860  /* --------------------- */
1861 }
1862