Ruby  2.1.3p242(2014-09-19revision47630)
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 int 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 
44 static VALUE cTclTkLib;
45 
46 static VALUE cTkObject;
47 static VALUE cTkCallbackEntry;
48 
49 static VALUE TK_None;
50 
51 static VALUE cCB_SUBST;
52 static VALUE cSUBST_INFO;
53 
54 static VALUE ENCODING_NAME_UTF8; /* for saving GC cost */
55 
56 static ID ID_split_tklist;
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;
66 static ID ID_install_cmd;
67 static ID ID_merge_tklist;
68 static ID ID_encoding;
69 static ID ID_encoding_system;
70 static ID ID_call;
71 
72 static ID ID_SUBST_INFO;
73 
74 static VALUE CALLBACK_TABLE;
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
103 tkNone_to_s(self)
104  VALUE self;
105 {
106  return rb_str_new2("");
107 }
108 
109 static VALUE
110 tkNone_inspect(self)
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
134 tk_eval_cmd(argc, argv, self)
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
146 tk_do_callback(argc, argv, self)
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
166 tk_install_cmd_core(cmd)
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
179 tk_install_cmd(argc, argv, self)
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  size_t head_len = strlen(cmd_id_head);
206  size_t 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 
217  return rb_hash_delete(CALLBACK_TABLE,
218  rb_str_new2(RSTRING_PTR(cmd_id) + head_len));
219 }
220 
221 static VALUE
222 tk_toUTF8(argc, argv, self)
223  int argc;
224  VALUE *argv;
225  VALUE self;
226 {
227  return rb_funcall2(cTclTkLib, ID_toUTF8, argc, argv);
228 }
229 
230 static VALUE
231 tk_fromUTF8(argc, argv, self)
232  int argc;
233  VALUE *argv;
234  VALUE self;
235 {
236  return rb_funcall2(cTclTkLib, ID_fromUTF8, argc, argv);
237 }
238 
239 static VALUE
240 fromDefaultEnc_toUTF8(str, self)
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
264 to_strkey(key, value, hash)
265  VALUE key;
266  VALUE value;
267  VALUE hash;
268 {
269  rb_hash_aset(hash, rb_funcall(key, ID_to_s, 0, 0), value);
270  return ST_CHECK;
271 }
272 
273 static VALUE
274 tk_symbolkey2str(self, keys)
275  VALUE self;
276  VALUE keys;
277 {
278  volatile VALUE new_keys = rb_hash_new();
279 
280  if (NIL_P(keys)) return new_keys;
281  keys = rb_convert_type(keys, T_HASH, "Hash", "to_hash");
282  st_foreach_check(RHASH_TBL(keys), to_strkey, new_keys, Qundef);
283  return new_keys;
284 }
285 
286 static VALUE get_eval_string_core _((VALUE, VALUE, VALUE));
287 static VALUE ary2list _((VALUE, VALUE, VALUE));
288 static VALUE ary2list2 _((VALUE, VALUE, VALUE));
289 static VALUE hash2list _((VALUE, VALUE));
290 static VALUE hash2list_enc _((VALUE, VALUE));
291 static VALUE hash2kv _((VALUE, VALUE, VALUE));
292 static VALUE hash2kv_enc _((VALUE, VALUE, VALUE));
293 
294 static VALUE
295 ary2list(ary, enc_flag, self)
296  VALUE ary;
297  VALUE enc_flag;
298  VALUE self;
299 {
300  long idx, idx2, size, size2;
301  int 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 {
440  rb_ivar_set(val, ID_at_enc, ENCODING_NAME_UTF8);
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  long idx, size;
455  int req_chk_flag;
456  volatile VALUE val, str_val;
457  volatile VALUE dst;
458  volatile VALUE sys_enc, dst_enc, str_enc;
459 
460  sys_enc = rb_funcall(cTclTkLib, ID_encoding, 0, 0);
461  if (NIL_P(sys_enc)) {
462  sys_enc = rb_funcall(cTclTkLib, ID_encoding_system, 0, 0);
463  sys_enc = rb_funcall(sys_enc, ID_to_s, 0, 0);
464  }
465 
466  if (NIL_P(enc_flag)) {
467  dst_enc = sys_enc;
468  req_chk_flag = 1;
469  } else if (TYPE(enc_flag) == T_TRUE || TYPE(enc_flag) == T_FALSE) {
470  dst_enc = enc_flag;
471  req_chk_flag = 0;
472  } else {
473  dst_enc = rb_funcall(enc_flag, ID_to_s, 0, 0);
474  req_chk_flag = 0;
475  }
476 
477  size = RARRAY_LEN(ary);
478  dst = rb_ary_new2(size);
479  for(idx = 0; idx < RARRAY_LEN(ary); idx++) {
480  val = RARRAY_PTR(ary)[idx];
481  str_val = Qnil;
482  switch(TYPE(val)) {
483  case T_ARRAY:
484  str_val = ary2list(val, enc_flag, self);
485  break;
486 
487  case T_HASH:
488  if (RTEST(enc_flag)) {
489  str_val = hash2list(val, self);
490  } else {
491  str_val = hash2list_enc(val, self);
492  }
493  break;
494 
495  default:
496  if (val != TK_None) {
497  str_val = get_eval_string_core(val, enc_flag, self);
498  }
499  }
500 
501  if (!NIL_P(str_val)) {
502  rb_ary_push(dst, str_val);
503 
504  if (req_chk_flag) {
505  str_enc = rb_ivar_get(str_val, ID_at_enc);
506  if (!NIL_P(str_enc)) {
507  str_enc = rb_funcall(str_enc, ID_to_s, 0, 0);
508  } else {
509  str_enc = sys_enc;
510  }
511  if (!rb_str_cmp(str_enc, dst_enc)) {
512  dst_enc = Qtrue;
513  req_chk_flag = 0;
514  }
515  }
516  }
517  }
518 
519  if (RTEST(dst_enc) && !NIL_P(sys_enc)) {
520  for(idx = 0; idx < RARRAY_LEN(dst); idx++) {
521  str_val = RARRAY_PTR(dst)[idx];
522  if (rb_obj_respond_to(self, ID_toUTF8, Qtrue)) {
523  str_val = rb_funcall(self, ID_toUTF8, 1, str_val);
524  } else {
525  str_val = rb_funcall(cTclTkLib, ID_toUTF8, 1, str_val);
526  }
527  RARRAY_PTR(dst)[idx] = str_val;
528  }
529  val = rb_apply(cTclTkLib, ID_merge_tklist, dst);
530  if (TYPE(dst_enc) == T_STRING) {
531  val = rb_funcall(cTclTkLib, ID_fromUTF8, 2, val, dst_enc);
532  rb_ivar_set(val, ID_at_enc, dst_enc);
533  } else {
534  rb_ivar_set(val, ID_at_enc, ENCODING_NAME_UTF8);
535  }
536  return val;
537  } else {
538  return rb_apply(cTclTkLib, ID_merge_tklist, dst);
539  }
540 }
541 
542 static VALUE
543 key2keyname(key)
544  VALUE key;
545 {
546  return rb_str_append(rb_str_new2("-"), rb_funcall(key, ID_to_s, 0, 0));
547 }
548 
549 static VALUE
550 assoc2kv(assoc, ary, self)
551  VALUE assoc;
552  VALUE ary;
553  VALUE self;
554 {
555  long i, j, len;
556  volatile VALUE pair;
557  volatile VALUE val;
558  volatile VALUE dst = rb_ary_new2(2 * RARRAY_LEN(assoc));
559 
560  len = RARRAY_LEN(assoc);
561 
562  for(i = 0; i < len; i++) {
563  pair = RARRAY_PTR(assoc)[i];
564  if (TYPE(pair) != T_ARRAY) {
565  rb_ary_push(dst, key2keyname(pair));
566  continue;
567  }
568  switch(RARRAY_LEN(assoc)) {
569  case 2:
570  rb_ary_push(dst, RARRAY_PTR(pair)[2]);
571 
572  case 1:
573  rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
574 
575  case 0:
576  continue;
577 
578  default:
579  rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
580 
581  val = rb_ary_new2(RARRAY_LEN(pair) - 1);
582  for(j = 1; j < RARRAY_LEN(pair); j++) {
583  rb_ary_push(val, RARRAY_PTR(pair)[j]);
584  }
585 
586  rb_ary_push(dst, val);
587  }
588  }
589 
590  if (NIL_P(ary)) {
591  return dst;
592  } else {
593  return rb_ary_plus(ary, dst);
594  }
595 }
596 
597 static VALUE
598 assoc2kv_enc(assoc, ary, self)
599  VALUE assoc;
600  VALUE ary;
601  VALUE self;
602 {
603  long i, j, len;
604  volatile VALUE pair;
605  volatile VALUE val;
606  volatile VALUE dst = rb_ary_new2(2 * RARRAY_LEN(assoc));
607 
608  len = RARRAY_LEN(assoc);
609 
610  for(i = 0; i < len; i++) {
611  pair = RARRAY_PTR(assoc)[i];
612  if (TYPE(pair) != T_ARRAY) {
613  rb_ary_push(dst, key2keyname(pair));
614  continue;
615  }
616  switch(RARRAY_LEN(assoc)) {
617  case 2:
618  rb_ary_push(dst, get_eval_string_core(RARRAY_PTR(pair)[2], Qtrue, self));
619 
620  case 1:
621  rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
622 
623  case 0:
624  continue;
625 
626  default:
627  rb_ary_push(dst, key2keyname(RARRAY_PTR(pair)[0]));
628 
629  val = rb_ary_new2(RARRAY_LEN(pair) - 1);
630  for(j = 1; j < RARRAY_LEN(pair); j++) {
631  rb_ary_push(val, RARRAY_PTR(pair)[j]);
632  }
633 
634  rb_ary_push(dst, get_eval_string_core(val, Qtrue, self));
635  }
636  }
637 
638  if (NIL_P(ary)) {
639  return dst;
640  } else {
641  return rb_ary_plus(ary, dst);
642  }
643 }
644 
645 static int
646 push_kv(key, val, args)
647  VALUE key;
648  VALUE val;
649  VALUE args;
650 {
651  volatile VALUE ary;
652 
653  ary = RARRAY_PTR(args)[0];
654 
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_check(RHASH_TBL(hash), push_kv, args, Qundef);
678 
679  if (NIL_P(ary)) {
680  return dst;
681  } else {
682  return rb_ary_concat(ary, dst);
683  }
684 }
685 
686 static int
687 push_kv_enc(key, val, args)
688  VALUE key;
689  VALUE val;
690  VALUE args;
691 {
692  volatile VALUE ary;
693 
694  ary = RARRAY_PTR(args)[0];
695 
696 #if 0
697  rb_ary_push(ary, key2keyname(key));
698  if (val != TK_None) {
699  rb_ary_push(ary, get_eval_string_core(val, Qtrue,
700  RARRAY_PTR(args)[1]));
701  }
702 #endif
703  rb_ary_push(ary, key2keyname(key));
704 
705  if (val == TK_None) return ST_CHECK;
706 
707  rb_ary_push(ary, get_eval_string_core(val, Qtrue, RARRAY_PTR(args)[1]));
708 
709  return ST_CHECK;
710 }
711 
712 static VALUE
713 hash2kv_enc(hash, ary, self)
714  VALUE hash;
715  VALUE ary;
716  VALUE self;
717 {
718  volatile VALUE dst = rb_ary_new2(2 * RHASH_SIZE(hash));
719  volatile VALUE args = rb_ary_new3(2, dst, self);
720 
721  st_foreach_check(RHASH_TBL(hash), push_kv_enc, args, Qundef);
722 
723  if (NIL_P(ary)) {
724  return dst;
725  } else {
726  return rb_ary_concat(ary, dst);
727  }
728 }
729 
730 static VALUE
731 hash2list(hash, self)
732  VALUE hash;
733  VALUE self;
734 {
735  return ary2list2(hash2kv(hash, Qnil, self), Qfalse, self);
736 }
737 
738 
739 static VALUE
740 hash2list_enc(hash, self)
741  VALUE hash;
742  VALUE self;
743 {
744  return ary2list2(hash2kv_enc(hash, Qnil, self), Qfalse, self);
745 }
746 
747 static VALUE
748 tk_hash_kv(argc, argv, self)
749  int argc;
750  VALUE *argv;
751  VALUE self;
752 {
753  volatile VALUE hash, enc_flag, ary;
754 
755  ary = Qnil;
756  enc_flag = Qnil;
757  switch(argc) {
758  case 3:
759  ary = argv[2];
760  case 2:
761  enc_flag = argv[1];
762  case 1:
763  hash = argv[0];
764  break;
765  case 0:
766  rb_raise(rb_eArgError, "too few arguments");
767  default: /* >= 3 */
768  rb_raise(rb_eArgError, "too many arguments");
769  }
770 
771  switch(TYPE(hash)) {
772  case T_ARRAY:
773  if (RTEST(enc_flag)) {
774  return assoc2kv_enc(hash, ary, self);
775  } else {
776  return assoc2kv(hash, ary, self);
777  }
778 
779  case T_HASH:
780  if (RTEST(enc_flag)) {
781  return hash2kv_enc(hash, ary, self);
782  } else {
783  return hash2kv(hash, ary, self);
784  }
785 
786  case T_NIL:
787  if (NIL_P(ary)) {
788  return rb_ary_new();
789  } else {
790  return ary;
791  }
792 
793  default:
794  if (hash == TK_None) {
795  if (NIL_P(ary)) {
796  return rb_ary_new();
797  } else {
798  return ary;
799  }
800  }
801  rb_raise(rb_eArgError, "Hash is expected for 1st argument");
802  }
803 
804  UNREACHABLE;
805 }
806 
807 static VALUE
808 get_eval_string_core(obj, enc_flag, self)
809  VALUE obj;
810  VALUE enc_flag;
811  VALUE self;
812 {
813  switch(TYPE(obj)) {
814  case T_FLOAT:
815  case T_FIXNUM:
816  case T_BIGNUM:
817  return rb_funcall(obj, ID_to_s, 0, 0);
818 
819  case T_STRING:
820  if (RTEST(enc_flag)) {
821  if (rb_obj_respond_to(self, ID_toUTF8, Qtrue)) {
822  return rb_funcall(self, ID_toUTF8, 1, obj);
823  } else {
824  return fromDefaultEnc_toUTF8(obj, self);
825  }
826  } else {
827  return obj;
828  }
829 
830  case T_SYMBOL:
831  if (RTEST(enc_flag)) {
832  if (rb_obj_respond_to(self, ID_toUTF8, Qtrue)) {
833  return rb_funcall(self, ID_toUTF8, 1,
834  rb_str_new2(rb_id2name(SYM2ID(obj))));
835  } else {
836  return fromDefaultEnc_toUTF8(rb_str_new2(rb_id2name(SYM2ID(obj))), self);
837  }
838  } else {
839 #ifdef HAVE_RB_SYM_TO_S
840  return rb_sym_to_s(obj);
841 #else
842  return rb_str_new2(rb_id2name(SYM2ID(obj)));
843 #endif
844  }
845 
846  case T_HASH:
847  if (RTEST(enc_flag)) {
848  return hash2list_enc(obj, self);
849  } else {
850  return hash2list(obj, self);
851  }
852 
853  case T_ARRAY:
854  return ary2list(obj, enc_flag, self);
855 
856  case T_FALSE:
857  return rb_str_new2("0");
858 
859  case T_TRUE:
860  return rb_str_new2("1");
861 
862  case T_NIL:
863  return rb_str_new2("");
864 
865  case T_REGEXP:
866  return rb_funcall(obj, ID_source, 0, 0);
867 
868  default:
869  if (rb_obj_is_kind_of(obj, cTkObject)) {
870  /* return rb_str_new3(rb_funcall(obj, ID_path, 0, 0)); */
871  return get_eval_string_core(rb_funcall(obj, ID_path, 0, 0),
872  enc_flag, self);
873  }
874 
875  if (rb_obj_is_kind_of(obj, rb_cProc)
876  || rb_obj_is_kind_of(obj, cMethod)
877  || rb_obj_is_kind_of(obj, cTkCallbackEntry)) {
878  if (rb_obj_respond_to(self, ID_install_cmd, Qtrue)) {
879  return rb_funcall(self, ID_install_cmd, 1, obj);
880  } else {
881  return tk_install_cmd_core(obj);
882  }
883  }
884 
885  if (obj == TK_None) return Qnil;
886 
887  if (rb_obj_respond_to(obj, ID_to_eval, Qtrue)) {
888  /* return rb_funcall(obj, ID_to_eval, 0, 0); */
889  return get_eval_string_core(rb_funcall(obj, ID_to_eval, 0, 0),
890  enc_flag, self);
891  } else if (rb_obj_respond_to(obj, ID_path, Qtrue)) {
892  /* return rb_funcall(obj, ID_path, 0, 0); */
893  return get_eval_string_core(rb_funcall(obj, ID_path, 0, 0),
894  enc_flag, self);
895  } else if (rb_obj_respond_to(obj, ID_to_s, Qtrue)) {
896  return rb_funcall(obj, ID_to_s, 0, 0);
897  }
898  }
899 
900  rb_warning("fail to convert '%+"PRIsVALUE"' to string for Tk", obj);
901 
902  return obj;
903 }
904 
905 static VALUE
906 tk_get_eval_string(argc, argv, self)
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
921 tk_get_eval_enc_str(self, obj)
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
933 tk_conv_args(argc, argv, self)
934  int argc;
935  VALUE *argv; /* [0]:base_array, [1]:enc_mode, [2]..[n]:args */
936  VALUE self;
937 {
938  int idx;
939  long size;
940  volatile VALUE dst;
941  int thr_crit_bup;
942  VALUE old_gc;
943 
944  if (argc < 2) {
945  rb_raise(rb_eArgError, "too few arguments");
946  }
947 
948  thr_crit_bup = rb_thread_critical;
949  rb_thread_critical = Qtrue;
950  old_gc = rb_gc_disable();
951 
952  for(size = 0, idx = 2; idx < argc; idx++) {
953  if (TYPE(argv[idx]) == T_HASH) {
954  size += 2 * RHASH_SIZE(argv[idx]);
955  } else {
956  size++;
957  }
958  }
959  /* dst = rb_ary_new2(argc - 2); */
960  dst = rb_ary_new2(size);
961  for(idx = 2; idx < argc; idx++) {
962  if (TYPE(argv[idx]) == T_HASH) {
963  if (RTEST(argv[1])) {
964  hash2kv_enc(argv[idx], dst, self);
965  } else {
966  hash2kv(argv[idx], dst, self);
967  }
968  } else if (argv[idx] != TK_None) {
969  rb_ary_push(dst, get_eval_string_core(argv[idx], argv[1], self));
970  }
971  }
972 
973  if (old_gc == Qfalse) rb_gc_enable();
974  rb_thread_critical = thr_crit_bup;
975 
976  return rb_ary_plus(argv[0], dst);
977 }
978 
979 
980 /*************************************/
981 
982 static VALUE
983 tcl2rb_bool(self, value)
984  VALUE self;
985  VALUE value;
986 {
987  if (TYPE(value) == T_FIXNUM) {
988  if (NUM2INT(value) == 0) {
989  return Qfalse;
990  } else {
991  return Qtrue;
992  }
993  }
994 
995  if (TYPE(value) == T_TRUE || TYPE(value) == T_FALSE) {
996  return value;
997  }
998 
999  rb_check_type(value, T_STRING);
1000 
1001  value = rb_funcall(value, ID_downcase, 0);
1002 
1003  if (RSTRING_PTR(value) == (char*)NULL) return Qnil;
1004 
1005  if (RSTRING_PTR(value)[0] == '\0'
1006  || strcmp(RSTRING_PTR(value), "0") == 0
1007  || strcmp(RSTRING_PTR(value), "no") == 0
1008  || strcmp(RSTRING_PTR(value), "off") == 0
1009  || strcmp(RSTRING_PTR(value), "false") == 0) {
1010  return Qfalse;
1011  } else {
1012  return Qtrue;
1013  }
1014 }
1015 
1016 #if 0
1017 static VALUE
1018 tkstr_to_dec(value)
1019  VALUE value;
1020 {
1021  return rb_cstr_to_inum(RSTRING_PTR(value), 10, 1);
1022 }
1023 #endif
1024 
1025 static VALUE
1026 tkstr_to_int(value)
1027  VALUE value;
1028 {
1029  return rb_cstr_to_inum(RSTRING_PTR(value), 0, 1);
1030 }
1031 
1032 static VALUE
1033 tkstr_to_float(value)
1034  VALUE value;
1035 {
1036  return rb_float_new(rb_cstr_to_dbl(RSTRING_PTR(value), 1));
1037 }
1038 
1039 static VALUE
1040 tkstr_invalid_numstr(value)
1041  VALUE value;
1042 {
1043  rb_raise(rb_eArgError,
1044  "invalid value for Number: '%s'", RSTRING_PTR(value));
1045  return Qnil; /*dummy*/
1046 }
1047 
1048 static VALUE
1049 tkstr_rescue_float(value)
1050  VALUE value;
1051 {
1052  return rb_rescue2(tkstr_to_float, value,
1053  tkstr_invalid_numstr, value,
1054  rb_eArgError, 0);
1055 }
1056 
1057 static VALUE
1058 tkstr_to_number(value)
1059  VALUE value;
1060 {
1061  rb_check_type(value, T_STRING);
1062 
1063  if (RSTRING_PTR(value) == (char*)NULL) return INT2FIX(0);
1064 
1065  return rb_rescue2(tkstr_to_int, value,
1066  tkstr_rescue_float, value,
1067  rb_eArgError, 0);
1068 }
1069 
1070 static VALUE
1071 tcl2rb_number(self, value)
1072  VALUE self;
1073  VALUE value;
1074 {
1075  return tkstr_to_number(value);
1076 }
1077 
1078 static VALUE
1079 tkstr_to_str(value)
1080  VALUE value;
1081 {
1082  char * ptr;
1083  long len;
1084 
1085  ptr = RSTRING_PTR(value);
1086  len = RSTRING_LEN(value);
1087 
1088  if (len > 1 && *ptr == '{' && *(ptr + len - 1) == '}') {
1089  return rb_str_new(ptr + 1, len - 2);
1090  }
1091  return value;
1092 }
1093 
1094 static VALUE
1095 tcl2rb_string(self, value)
1096  VALUE self;
1097  VALUE value;
1098 {
1099  rb_check_type(value, T_STRING);
1100 
1101  if (RSTRING_PTR(value) == (char*)NULL) return rb_tainted_str_new2("");
1102 
1103  return tkstr_to_str(value);
1104 }
1105 
1106 static VALUE
1107 tcl2rb_num_or_str(self, value)
1108  VALUE self;
1109  VALUE value;
1110 {
1111  rb_check_type(value, T_STRING);
1112 
1113  if (RSTRING_PTR(value) == (char*)NULL) return rb_tainted_str_new2("");
1114 
1115  return rb_rescue2(tkstr_to_number, value,
1116  tkstr_to_str, value,
1117  rb_eArgError, 0);
1118 }
1119 
1120 static VALUE
1121 tcl2rb_num_or_nil(self, value)
1122  VALUE self;
1123  VALUE value;
1124 {
1125  rb_check_type(value, T_STRING);
1126 
1127  if (RSTRING_LEN(value) == 0) return Qnil;
1128 
1129  return tkstr_to_number(value);
1130 }
1131 
1132 
1133 /*************************************/
1134 
1135 #define CBSUBST_TBL_MAX (256)
1136 struct cbsubst_info {
1137  long full_subst_length;
1138  long keylen[CBSUBST_TBL_MAX];
1139  char *key[CBSUBST_TBL_MAX];
1140  char type[CBSUBST_TBL_MAX];
1141  ID ivar[CBSUBST_TBL_MAX];
1142  VALUE proc;
1143  VALUE aliases;
1144 };
1145 
1146 static void
1147 subst_mark(ptr)
1148  struct cbsubst_info *ptr;
1149 {
1150  rb_gc_mark(ptr->proc);
1151  rb_gc_mark(ptr->aliases);
1152 }
1153 
1154 static void
1155 subst_free(ptr)
1156  struct cbsubst_info *ptr;
1157 {
1158  int i;
1159 
1160  if (ptr) {
1161  for(i = 0; i < CBSUBST_TBL_MAX; i++) {
1162  if (ptr->key[i] != NULL) {
1163  free(ptr->key[i]); /* allocated by malloc */
1164  ptr->key[i] = NULL;
1165  }
1166  }
1167  xfree(ptr); /* allocated by ALLOC */
1168  }
1169 }
1170 
1171 static VALUE
1172 allocate_cbsubst_info(struct cbsubst_info **inf_ptr)
1173 {
1174  struct cbsubst_info *inf;
1175  volatile VALUE proc, aliases;
1176  int idx;
1177 
1178  inf = ALLOC(struct cbsubst_info);
1179 
1180  inf->full_subst_length = 0;
1181 
1182  for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
1183  inf->keylen[idx] = 0;
1184  inf->key[idx] = NULL;
1185  inf->type[idx] = '\0';
1186  inf->ivar[idx] = (ID) 0;
1187  }
1188 
1189  proc = rb_hash_new();
1190  inf->proc = proc;
1191 
1192  aliases = rb_hash_new();
1193  inf->aliases = aliases;
1194 
1195  if (inf_ptr != (struct cbsubst_info **)NULL) *inf_ptr = inf;
1196 
1197  return Data_Wrap_Struct(cSUBST_INFO, subst_mark, subst_free, inf);
1198 }
1199 
1200 static void
1201 cbsubst_init()
1202 {
1203  rb_const_set(cCB_SUBST, ID_SUBST_INFO,
1204  allocate_cbsubst_info((struct cbsubst_info **)NULL));
1205 }
1206 
1207 static VALUE
1208 cbsubst_initialize(argc, argv, self)
1209  int argc;
1210  VALUE *argv;
1211  VALUE self;
1212 {
1213  struct cbsubst_info *inf;
1214  int idx, iv_idx;
1215 
1216  Data_Get_Struct(rb_const_get(rb_obj_class(self), ID_SUBST_INFO),
1217  struct cbsubst_info, inf);
1218 
1219  idx = 0;
1220  for(iv_idx = 0; iv_idx < CBSUBST_TBL_MAX; iv_idx++) {
1221  if ( inf->ivar[iv_idx] == (ID) 0 ) continue;
1222  rb_ivar_set(self, inf->ivar[iv_idx], argv[idx++]);
1223  if (idx >= argc) break;
1224  }
1225 
1226  return self;
1227 }
1228 
1229 static VALUE
1230 cbsubst_ret_val(self, val)
1231  VALUE self;
1232  VALUE val;
1233 {
1234  /* This method may be overwritten on some sub-classes. */
1235  /* This method is used for converting from ruby's callback-return-value */
1236  /* to tcl's value (e.g. validation procedure of entry widget). */
1237  return val;
1238 }
1239 
1240 static int
1241 each_attr_def(key, value, klass)
1242  VALUE key, value, klass;
1243 {
1244  ID key_id, value_id;
1245 
1246  if (key == Qundef) return ST_CONTINUE;
1247 
1248  switch(TYPE(key)) {
1249  case T_STRING:
1250  key_id = rb_intern_str(key);
1251  break;
1252  case T_SYMBOL:
1253  key_id = SYM2ID(key);
1254  break;
1255  default:
1256  rb_raise(rb_eArgError,
1257  "includes invalid key(s). expected a String or a Symbol");
1258  }
1259 
1260  switch(TYPE(value)) {
1261  case T_STRING:
1262  value_id = rb_intern_str(value);
1263  break;
1264  case T_SYMBOL:
1265  value_id = SYM2ID(value);
1266  break;
1267  default:
1268  rb_raise(rb_eArgError,
1269  "includes invalid value(s). expected a String or a Symbol");
1270  }
1271 
1272  rb_alias(klass, key_id, value_id);
1273 
1274  return ST_CONTINUE;
1275 }
1276 
1277 static VALUE
1278 cbsubst_def_attr_aliases(self, tbl)
1279  VALUE self;
1280  VALUE tbl;
1281 {
1282  struct cbsubst_info *inf;
1283 
1284  if (TYPE(tbl) != T_HASH) {
1285  rb_raise(rb_eArgError, "expected a Hash");
1286  }
1287 
1288  Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
1289  struct cbsubst_info, inf);
1290 
1291  rb_hash_foreach(tbl, each_attr_def, self);
1292 
1293  return rb_funcall(inf->aliases, rb_intern("update"), 1, tbl);
1294 }
1295 
1296 static VALUE
1297 cbsubst_sym_to_subst(self, sym)
1298  VALUE self;
1299  VALUE sym;
1300 {
1301  struct cbsubst_info *inf;
1302  VALUE str;
1303  char *buf, *ptr;
1304  int idx;
1305  long len;
1306  ID id;
1307  volatile VALUE ret;
1308 
1309  if (TYPE(sym) != T_SYMBOL) return sym;
1310 
1311  Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
1312  struct cbsubst_info, inf);
1313 
1314  if (!NIL_P(ret = rb_hash_aref(inf->aliases, sym))) {
1315  str = rb_id2str(SYM2ID(ret));
1316  } else {
1317  str = rb_id2str(SYM2ID(sym));
1318  }
1319 
1320  id = rb_intern_str(rb_sprintf("@%"PRIsVALUE, str));
1321 
1322  for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
1323  if (inf->ivar[idx] == id) break;
1324  }
1325  if (idx >= CBSUBST_TBL_MAX) return sym;
1326 
1327  ptr = buf = ALLOC_N(char, inf->full_subst_length + 1);
1328 
1329  *(ptr++) = '%';
1330 
1331  if (len = inf->keylen[idx]) {
1332  /* longname */
1333  strncpy(ptr, inf->key[idx], len);
1334  ptr += len;
1335  } else {
1336  /* single char */
1337  *(ptr++) = (unsigned char)idx;
1338  }
1339 
1340  *(ptr++) = ' ';
1341  *(ptr++) = '\0';
1342 
1343  ret = rb_str_new2(buf);
1344 
1345  xfree(buf);
1346 
1347  return ret;
1348 }
1349 
1350 static VALUE
1351 cbsubst_get_subst_arg(argc, argv, self)
1352  int argc;
1353  VALUE *argv;
1354  VALUE self;
1355 {
1356  struct cbsubst_info *inf;
1357  VALUE str;
1358  char *buf, *ptr;
1359  int i, idx;
1360  long len;
1361  ID id;
1362  volatile VALUE arg_sym, ret;
1363 
1364  Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
1365  struct cbsubst_info, inf);
1366 
1367  ptr = buf = ALLOC_N(char, inf->full_subst_length + 1);
1368 
1369  for(i = 0; i < argc; i++) {
1370  switch(TYPE(argv[i])) {
1371  case T_STRING:
1372  str = argv[i];
1373  arg_sym = ID2SYM(rb_intern_str(argv[i]));
1374  break;
1375  case T_SYMBOL:
1376  arg_sym = argv[i];
1377  str = rb_id2str(SYM2ID(arg_sym));
1378  break;
1379  default:
1380  rb_raise(rb_eArgError, "arg #%d is not a String or a Symbol", i);
1381  }
1382 
1383  if (!NIL_P(ret = rb_hash_aref(inf->aliases, arg_sym))) {
1384  str = rb_id2str(SYM2ID(ret));
1385  }
1386 
1387  id = rb_intern_str(rb_sprintf("@%"PRIsVALUE, str));
1388 
1389  for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
1390  if (inf->ivar[idx] == id) break;
1391  }
1392  if (idx >= CBSUBST_TBL_MAX) {
1393  rb_raise(rb_eArgError, "cannot find attribute :%"PRIsVALUE, str);
1394  }
1395 
1396  *(ptr++) = '%';
1397 
1398  if (len = inf->keylen[idx]) {
1399  /* longname */
1400  strncpy(ptr, inf->key[idx], len);
1401  ptr += len;
1402  } else {
1403  /* single char */
1404  *(ptr++) = (unsigned char)idx;
1405  }
1406 
1407  *(ptr++) = ' ';
1408  }
1409 
1410  *ptr = '\0';
1411 
1412  ret = rb_str_new2(buf);
1413 
1414  xfree(buf);
1415 
1416  return ret;
1417 }
1418 
1419 static VALUE
1420 cbsubst_get_subst_key(self, str)
1421  VALUE self;
1422  VALUE str;
1423 {
1424  struct cbsubst_info *inf;
1425  volatile VALUE list;
1426  volatile VALUE ret;
1427  VALUE keyval;
1428  long i, len, keylen;
1429  int idx;
1430  char *buf, *ptr, *key;
1431 
1432  list = rb_funcall(cTclTkLib, ID_split_tklist, 1, str);
1433  len = RARRAY_LEN(list);
1434 
1435  Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
1436  struct cbsubst_info, inf);
1437 
1438  ptr = buf = ALLOC_N(char, inf->full_subst_length + len + 1);
1439 
1440  for(i = 0; i < len; i++) {
1441  keyval = RARRAY_PTR(list)[i];
1442  key = RSTRING_PTR(keyval);
1443  if (*key == '%') {
1444  if (*(key + 2) == '\0') {
1445  /* single char */
1446  *(ptr++) = *(key + 1);
1447  } else {
1448  /* search longname-key */
1449  keylen = RSTRING_LEN(keyval) - 1;
1450  for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
1451  if (inf->keylen[idx] != keylen) continue;
1452  if ((unsigned char)inf->key[idx][0] != (unsigned char)*(key + 1)) continue;
1453  if (strncmp(inf->key[idx], key + 1, keylen)) continue;
1454  break;
1455  }
1456  if (idx < CBSUBST_TBL_MAX) {
1457  *(ptr++) = (unsigned char)idx;
1458  } else {
1459  *(ptr++) = ' ';
1460  }
1461  }
1462  } else {
1463  *(ptr++) = ' ';
1464  }
1465  }
1466  *ptr = '\0';
1467 
1468  ret = rb_str_new2(buf);
1469  xfree(buf);
1470  return ret;
1471 }
1472 
1473 static VALUE
1474 cbsubst_get_all_subst_keys(self)
1475  VALUE self;
1476 {
1477  struct cbsubst_info *inf;
1478  char *buf, *ptr;
1479  char *keys_buf, *keys_ptr;
1480  int idx;
1481  long len;
1482  volatile VALUE ret;
1483 
1484  Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
1485  struct cbsubst_info, inf);
1486 
1487  ptr = buf = ALLOC_N(char, inf->full_subst_length + 1);
1488  keys_ptr = keys_buf = ALLOC_N(char, CBSUBST_TBL_MAX + 1);
1489 
1490  for(idx = 0; idx < CBSUBST_TBL_MAX; idx++) {
1491  if (inf->ivar[idx] == (ID) 0) continue;
1492 
1493  *(keys_ptr++) = (unsigned char)idx;
1494 
1495  *(ptr++) = '%';
1496 
1497  if (len = inf->keylen[idx]) {
1498  /* longname */
1499  strncpy(ptr, inf->key[idx], len);
1500  ptr += len;
1501  } else {
1502  /* single char */
1503  *(ptr++) = (unsigned char)idx;
1504  }
1505 
1506  *(ptr++) = ' ';
1507  }
1508 
1509  *ptr = '\0';
1510  *keys_ptr = '\0';
1511 
1512  ret = rb_ary_new3(2, rb_str_new2(keys_buf), rb_str_new2(buf));
1513 
1514  xfree(buf);
1515  xfree(keys_buf);
1516 
1517  return ret;
1518 }
1519 
1520 static VALUE
1521 cbsubst_table_setup(argc, argv, self)
1522  int argc;
1523  VALUE *argv;
1524  VALUE self;
1525 {
1526  volatile VALUE cbsubst_obj;
1527  volatile VALUE key_inf;
1528  volatile VALUE longkey_inf;
1529  volatile VALUE proc_inf;
1530  VALUE inf;
1531  ID id;
1532  struct cbsubst_info *subst_inf;
1533  long idx, len;
1534  unsigned char chr;
1535 
1536  /* accept (key_inf, proc_inf) or (key_inf, longkey_inf, procinf) */
1537  if (rb_scan_args(argc, argv, "21", &key_inf, &longkey_inf, &proc_inf) == 2) {
1538  proc_inf = longkey_inf;
1539  longkey_inf = rb_ary_new();
1540  }
1541 
1542  /* check the number of longkeys */
1543  if (RARRAY_LEN(longkey_inf) > 125 /* from 0x80 to 0xFD */) {
1544  rb_raise(rb_eArgError, "too many longname-key definitions");
1545  }
1546 
1547  /* init */
1548  cbsubst_obj = allocate_cbsubst_info(&subst_inf);
1549 
1550  /*
1551  * keys : array of [subst, type, ivar]
1552  * subst ==> char code or string
1553  * type ==> char code or string
1554  * ivar ==> symbol
1555  */
1556  len = RARRAY_LEN(key_inf);
1557  for(idx = 0; idx < len; idx++) {
1558  inf = RARRAY_PTR(key_inf)[idx];
1559  if (TYPE(inf) != T_ARRAY) continue;
1560 
1561  if (TYPE(RARRAY_PTR(inf)[0]) == T_STRING) {
1562  chr = *(RSTRING_PTR(RARRAY_PTR(inf)[0]));
1563  } else {
1564  chr = NUM2CHR(RARRAY_PTR(inf)[0]);
1565  }
1566  if (TYPE(RARRAY_PTR(inf)[1]) == T_STRING) {
1567  subst_inf->type[chr] = *(RSTRING_PTR(RARRAY_PTR(inf)[1]));
1568  } else {
1569  subst_inf->type[chr] = NUM2CHR(RARRAY_PTR(inf)[1]);
1570  }
1571 
1572  subst_inf->full_subst_length += 3;
1573 
1574  id = SYM2ID(RARRAY_PTR(inf)[2]);
1575  subst_inf->ivar[chr] = rb_intern_str(rb_sprintf("@%"PRIsVALUE, rb_id2str(id)));
1576 
1577  rb_attr(self, id, 1, 0, Qtrue);
1578  }
1579 
1580 
1581  /*
1582  * longkeys : array of [name, type, ivar]
1583  * name ==> longname key string
1584  * type ==> char code or string
1585  * ivar ==> symbol
1586  */
1587  len = RARRAY_LEN(longkey_inf);
1588  for(idx = 0; idx < len; idx++) {
1589  inf = RARRAY_PTR(longkey_inf)[idx];
1590  if (TYPE(inf) != T_ARRAY) continue;
1591 
1592  chr = (unsigned char)(0x80 + idx);
1593  subst_inf->keylen[chr] = RSTRING_LEN(RARRAY_PTR(inf)[0]);
1594 #if HAVE_STRNDUP
1595  subst_inf->key[chr] = strndup(RSTRING_PTR(RARRAY_PTR(inf)[0]),
1596  RSTRING_LEN(RARRAY_PTR(inf)[0]));
1597 #else
1598  subst_inf->key[chr] = malloc(RSTRING_LEN(RARRAY_PTR(inf)[0]) + 1);
1599  if (subst_inf->key[chr]) {
1600  strncpy(subst_inf->key[chr], RSTRING_PTR(RARRAY_PTR(inf)[0]),
1601  RSTRING_LEN(RARRAY_PTR(inf)[0]) + 1);
1602  subst_inf->key[chr][RSTRING_LEN(RARRAY_PTR(inf)[0])] = '\0';
1603  }
1604 #endif
1605  if (TYPE(RARRAY_PTR(inf)[1]) == T_STRING) {
1606  subst_inf->type[chr] = *(RSTRING_PTR(RARRAY_PTR(inf)[1]));
1607  } else {
1608  subst_inf->type[chr] = NUM2CHR(RARRAY_PTR(inf)[1]);
1609  }
1610 
1611  subst_inf->full_subst_length += (subst_inf->keylen[chr] + 2);
1612 
1613  id = SYM2ID(RARRAY_PTR(inf)[2]);
1614  subst_inf->ivar[chr] = rb_intern_str(rb_sprintf("@%"PRIsVALUE, rb_id2str(id)));
1615 
1616  rb_attr(self, id, 1, 0, Qtrue);
1617  }
1618 
1619  /*
1620  * procs : array of [type, proc]
1621  * type ==> char code or string
1622  * proc ==> proc/method/obj (must respond to 'call')
1623  */
1624  len = RARRAY_LEN(proc_inf);
1625  for(idx = 0; idx < len; idx++) {
1626  inf = RARRAY_PTR(proc_inf)[idx];
1627  if (TYPE(inf) != T_ARRAY) continue;
1628  rb_hash_aset(subst_inf->proc,
1629  ((TYPE(RARRAY_PTR(inf)[0]) == T_STRING)?
1630  INT2FIX(*(RSTRING_PTR(RARRAY_PTR(inf)[0]))) :
1631  RARRAY_PTR(inf)[0]),
1632  RARRAY_PTR(inf)[1]);
1633  }
1634 
1635  rb_const_set(self, ID_SUBST_INFO, cbsubst_obj);
1636 
1637  return self;
1638 }
1639 
1640 static VALUE
1641 cbsubst_get_extra_args_tbl(self)
1642  VALUE self;
1643 {
1644  return rb_ary_new();
1645 }
1646 
1647 static VALUE
1648 cbsubst_scan_args(self, arg_key, val_ary)
1649  VALUE self;
1650  VALUE arg_key;
1651  VALUE val_ary;
1652 {
1653  struct cbsubst_info *inf;
1654  long idx;
1655  unsigned char *keyptr = (unsigned char*)RSTRING_PTR(arg_key);
1656  long keylen = RSTRING_LEN(arg_key);
1657  long vallen = RARRAY_LEN(val_ary);
1658  unsigned char type_chr;
1659  volatile VALUE dst = rb_ary_new2(vallen);
1660  volatile VALUE proc;
1661  int thr_crit_bup;
1662  VALUE old_gc;
1663 
1664  thr_crit_bup = rb_thread_critical;
1665  rb_thread_critical = Qtrue;
1666 
1667  old_gc = rb_gc_disable();
1668 
1669  Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO),
1670  struct cbsubst_info, inf);
1671 
1672  for(idx = 0; idx < vallen; idx++) {
1673  if (idx >= keylen) {
1674  proc = Qnil;
1675  } else if (*(keyptr + idx) == ' ') {
1676  proc = Qnil;
1677  } else {
1678  if (type_chr = inf->type[*(keyptr + idx)]) {
1679  proc = rb_hash_aref(inf->proc, INT2FIX((int)type_chr));
1680  } else {
1681  proc = Qnil;
1682  }
1683  }
1684 
1685  if (NIL_P(proc)) {
1686  rb_ary_push(dst, RARRAY_PTR(val_ary)[idx]);
1687  } else {
1688  rb_ary_push(dst, rb_funcall(proc, ID_call, 1,
1689  RARRAY_PTR(val_ary)[idx]));
1690  }
1691  }
1692 
1693  if (old_gc == Qfalse) rb_gc_enable();
1694  rb_thread_critical = thr_crit_bup;
1695 
1696  return dst;
1697 }
1698 
1699 static VALUE
1700 cbsubst_inspect(self)
1701  VALUE self;
1702 {
1703  return rb_str_new2("CallbackSubst");
1704 }
1705 
1706 static VALUE
1707 substinfo_inspect(self)
1708  VALUE self;
1709 {
1710  return rb_str_new2("SubstInfo");
1711 }
1712 
1713 /*************************************/
1714 
1715 static VALUE
1716 tk_cbe_inspect(self)
1717  VALUE self;
1718 {
1719  return rb_str_new2("TkCallbackEntry");
1720 }
1721 
1722 /*************************************/
1723 
1724 static VALUE
1725 tkobj_path(self)
1726  VALUE self;
1727 {
1728  return rb_ivar_get(self, ID_at_path);
1729 }
1730 
1731 
1732 /*************************************/
1733 /* release date */
1734 const char tkutil_release_date[] = TKUTIL_RELEASE_DATE;
1735 
1736 void
1737 Init_tkutil()
1738 {
1739  VALUE cTK = rb_define_class("TkKernel", rb_cObject);
1740  VALUE mTK = rb_define_module("TkUtil");
1741 
1742  /* --------------------- */
1743 
1744  rb_define_const(mTK, "RELEASE_DATE",
1745  rb_obj_freeze(rb_str_new2(tkutil_release_date)));
1746 
1747  /* --------------------- */
1748  rb_global_variable(&cMethod);
1749  cMethod = rb_const_get(rb_cObject, rb_intern("Method"));
1750 
1751  ID_path = rb_intern("path");
1752  ID_at_path = rb_intern("@path");
1753  ID_at_enc = rb_intern("@encoding");
1754  ID_to_eval = rb_intern("to_eval");
1755  ID_to_s = rb_intern("to_s");
1756  ID_source = rb_intern("source");
1757  ID_downcase = rb_intern("downcase");
1758  ID_install_cmd = rb_intern("install_cmd");
1759  ID_merge_tklist = rb_intern("_merge_tklist");
1760  ID_encoding = rb_intern("encoding");
1761  ID_encoding_system = rb_intern("encoding_system");
1762  ID_call = rb_intern("call");
1763 
1764  /* --------------------- */
1765  cCB_SUBST = rb_define_class_under(mTK, "CallbackSubst", rb_cObject);
1766  rb_define_singleton_method(cCB_SUBST, "inspect", cbsubst_inspect, 0);
1767 
1768  cSUBST_INFO = rb_define_class_under(cCB_SUBST, "Info", rb_cObject);
1769  rb_define_singleton_method(cSUBST_INFO, "inspect", substinfo_inspect, 0);
1770 
1771  ID_SUBST_INFO = rb_intern("SUBST_INFO");
1772  rb_define_singleton_method(cCB_SUBST, "ret_val", cbsubst_ret_val, 1);
1773  rb_define_singleton_method(cCB_SUBST, "scan_args", cbsubst_scan_args, 2);
1774  rb_define_singleton_method(cCB_SUBST, "_sym2subst",
1775  cbsubst_sym_to_subst, 1);
1776  rb_define_singleton_method(cCB_SUBST, "subst_arg",
1777  cbsubst_get_subst_arg, -1);
1778  rb_define_singleton_method(cCB_SUBST, "_get_subst_key",
1779  cbsubst_get_subst_key, 1);
1780  rb_define_singleton_method(cCB_SUBST, "_get_all_subst_keys",
1781  cbsubst_get_all_subst_keys, 0);
1782  rb_define_singleton_method(cCB_SUBST, "_setup_subst_table",
1783  cbsubst_table_setup, -1);
1784  rb_define_singleton_method(cCB_SUBST, "_get_extra_args_tbl",
1785  cbsubst_get_extra_args_tbl, 0);
1786  rb_define_singleton_method(cCB_SUBST, "_define_attribute_aliases",
1787  cbsubst_def_attr_aliases, 1);
1788 
1789  rb_define_method(cCB_SUBST, "initialize", cbsubst_initialize, -1);
1790 
1791  cbsubst_init();
1792 
1793  /* --------------------- */
1794  rb_global_variable(&cTkCallbackEntry);
1795  cTkCallbackEntry = rb_define_class("TkCallbackEntry", cTK);
1796  rb_define_singleton_method(cTkCallbackEntry, "inspect", tk_cbe_inspect, 0);
1797 
1798  /* --------------------- */
1799  rb_global_variable(&cTkObject);
1800  cTkObject = rb_define_class("TkObject", cTK);
1801  rb_define_method(cTkObject, "path", tkobj_path, 0);
1802 
1803  /* --------------------- */
1804  rb_require("tcltklib");
1805  rb_global_variable(&cTclTkLib);
1806  cTclTkLib = rb_const_get(rb_cObject, rb_intern("TclTkLib"));
1807  ID_split_tklist = rb_intern("_split_tklist");
1808  ID_toUTF8 = rb_intern("_toUTF8");
1809  ID_fromUTF8 = rb_intern("_fromUTF8");
1810 
1811  /* --------------------- */
1812  rb_define_singleton_method(cTK, "new", tk_s_new, -1);
1813 
1814  /* --------------------- */
1815  rb_global_variable(&TK_None);
1816  TK_None = rb_obj_alloc(rb_cObject);
1817  rb_define_const(mTK, "None", TK_None);
1818  rb_define_singleton_method(TK_None, "to_s", tkNone_to_s, 0);
1819  rb_define_singleton_method(TK_None, "inspect", tkNone_inspect, 0);
1820  OBJ_FREEZE(TK_None);
1821 
1822  /* --------------------- */
1823  rb_global_variable(&CALLBACK_TABLE);
1824  CALLBACK_TABLE = rb_hash_new();
1825 
1826  /* --------------------- */
1827  rb_define_singleton_method(mTK, "untrust", tk_obj_untrust, 1);
1828 
1829  rb_define_singleton_method(mTK, "eval_cmd", tk_eval_cmd, -1);
1830  rb_define_singleton_method(mTK, "callback", tk_do_callback, -1);
1831  rb_define_singleton_method(mTK, "install_cmd", tk_install_cmd, -1);
1832  rb_define_singleton_method(mTK, "uninstall_cmd", tk_uninstall_cmd, 1);
1833  rb_define_singleton_method(mTK, "_symbolkey2str", tk_symbolkey2str, 1);
1834  rb_define_singleton_method(mTK, "hash_kv", tk_hash_kv, -1);
1835  rb_define_singleton_method(mTK, "_get_eval_string",
1836  tk_get_eval_string, -1);
1837  rb_define_singleton_method(mTK, "_get_eval_enc_str",
1838  tk_get_eval_enc_str, 1);
1839  rb_define_singleton_method(mTK, "_conv_args", tk_conv_args, -1);
1840 
1841  rb_define_singleton_method(mTK, "bool", tcl2rb_bool, 1);
1842  rb_define_singleton_method(mTK, "number", tcl2rb_number, 1);
1843  rb_define_singleton_method(mTK, "string", tcl2rb_string, 1);
1844  rb_define_singleton_method(mTK, "num_or_str", tcl2rb_num_or_str, 1);
1845  rb_define_singleton_method(mTK, "num_or_nil", tcl2rb_num_or_nil, 1);
1846 
1847  rb_define_method(mTK, "_toUTF8", tk_toUTF8, -1);
1848  rb_define_method(mTK, "_fromUTF8", tk_fromUTF8, -1);
1849  rb_define_method(mTK, "_symbolkey2str", tk_symbolkey2str, 1);
1850  rb_define_method(mTK, "hash_kv", tk_hash_kv, -1);
1851  rb_define_method(mTK, "_get_eval_string", tk_get_eval_string, -1);
1852  rb_define_method(mTK, "_get_eval_enc_str", tk_get_eval_enc_str, 1);
1853  rb_define_method(mTK, "_conv_args", tk_conv_args, -1);
1854 
1855  rb_define_method(mTK, "bool", tcl2rb_bool, 1);
1856  rb_define_method(mTK, "number", tcl2rb_number, 1);
1857  rb_define_method(mTK, "string", tcl2rb_string, 1);
1858  rb_define_method(mTK, "num_or_str", tcl2rb_num_or_str, 1);
1859  rb_define_method(mTK, "num_or_nil", tcl2rb_num_or_nil, 1);
1860 
1861  /* --------------------- */
1862  rb_global_variable(&ENCODING_NAME_UTF8);
1863  ENCODING_NAME_UTF8 = rb_obj_freeze(rb_str_new2("utf-8"));
1864 
1865  /* --------------------- */
1866 }
1867 
Generated on Mon Sep 22 2014 11:05:31 for Ruby by   doxygen 1.8.2