Ruby 2.0.0p247(2013-06-27revision41674)

- Main Page
- Modules
- Data Structures
- Files

- File List
- Globals

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 '%s' to string for Tk",
901 RSTRING_PTR(rb_funcall(obj, rb_intern("inspect"), 0, 0)));
902
903 return obj;
904 }
905
906 static VALUE
907 tk_get_eval_string(argc, argv, self)
908 int argc;
909 VALUE *argv;
910 VALUE self;
911 {
912 volatile VALUE obj, enc_flag;
913
914 if (rb_scan_args(argc, argv, "11", &obj, &enc_flag) == 1) {
915 enc_flag = Qnil;
916 }
917
918 return get_eval_string_core(obj, enc_flag, self);
919 }
920
921 static VALUE
922 tk_get_eval_enc_str(self, obj)
923 VALUE self;
924 VALUE obj;
925 {
926 if (obj == TK_None) {
927 return obj;
928 } else {
929 return get_eval_string_core(obj, Qtrue, self);
930 }
931 }
932
933 static VALUE
934 tk_conv_args(argc, argv, self)
935 int argc;
936 VALUE *argv; /* [0]:base_array, [1]:enc_mode, [2]..[n]:args */
937 VALUE self;
938 {
939 int idx, 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(RSTRING_PTR(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(RSTRING_PTR(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 const char *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_id2name(SYM2ID(ret));
1316 } else {
1317 str = rb_id2name(SYM2ID(sym));
1318 }
1319
1320 id = rb_intern(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), 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 const char *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 = RSTRING_PTR(argv[i]);
1373 arg_sym = ID2SYM(rb_intern(str));
1374 break;
1375 case T_SYMBOL:
1376 arg_sym = argv[i];
1377 str = rb_id2name(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_id2name(SYM2ID(ret));
1385 }
1386
1387 id = rb_intern(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), 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 :%s", 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(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), rb_id2name(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(RSTRING_PTR(rb_str_cat2(rb_str_new2("@"), rb_id2name(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