From 5d502653a4d1d794683f622de69fcb0977645bf3 Mon Sep 17 00:00:00 2001 From: nagai Date: Mon, 31 Jan 2005 04:17:23 +0000 Subject: * ext/tk/extconf.rb: add tkutil configuration step (remove old schema) * ext/tk/depend: remove the information of tkutil * ext/tk/make-tkutil: sub-part of Makefile to compile tkutil * ext/tk/tkutil/tkutil.c: move tkutil.c to subdirectory * ext/tk/tkutil/subconf.rb: configuration file for tkutil.c * ext/tk/tkutil/depend: ditto git-svn-id: http://svn.ruby-lang.org/repos/ruby/trunk@7852 b2dd03c8-39d4-4d8f-98ff-823fe69b080e --- ext/tk/depend | 1 - ext/tk/extconf.rb | 93 +--- ext/tk/make-tkutil | 43 ++ ext/tk/tkutil.c | 1369 ---------------------------------------------- ext/tk/tkutil/.cvsignore | 3 + ext/tk/tkutil/depend | 1 + ext/tk/tkutil/subconf.rb | 2 + ext/tk/tkutil/tkutil.c | 1369 ++++++++++++++++++++++++++++++++++++++++++++++ 8 files changed, 1446 insertions(+), 1435 deletions(-) create mode 100644 ext/tk/make-tkutil delete mode 100644 ext/tk/tkutil.c create mode 100644 ext/tk/tkutil/.cvsignore create mode 100644 ext/tk/tkutil/depend create mode 100644 ext/tk/tkutil/subconf.rb create mode 100644 ext/tk/tkutil/tkutil.c (limited to 'ext/tk') diff --git a/ext/tk/depend b/ext/tk/depend index 95d5527e6..2cd9c400f 100644 --- a/ext/tk/depend +++ b/ext/tk/depend @@ -1,3 +1,2 @@ tcltklib.o: tcltklib.c $(hdrdir)/ruby.h $(topdir)/config.h $(hdrdir)/defines.h stubs.o: stubs.c $(hdrdir)/ruby.h $(topdir)/config.h $(hdrdir)/defines.h -tkutil.o: tkutil.c $(hdrdir)/ruby.h $(topdir)/config.h $(hdrdir)/defines.h diff --git a/ext/tk/extconf.rb b/ext/tk/extconf.rb index 996aa6cae..a677ea3a7 100644 --- a/ext/tk/extconf.rb +++ b/ext/tk/extconf.rb @@ -265,6 +265,7 @@ if mac_need_framework || $LDFLAGS += ' -framework Tk -framework Tcl' end + if stubs or pthread_check # create Makefile @@ -276,78 +277,40 @@ if mac_need_framework || $INSTALLFILES = [] end - cleanings_bup = CLEANINGS.dup - - if $objs - objs_bup = $objs.dup - else - objs_bup = nil - $objs = [] - end - # for SUPPORT_STATUS $INSTALLFILES << ["lib/tkextlib/SUPPORT_STATUS", "$(RUBYLIBDIR)", "lib"] - # for tcltklib.so - $objs << "stubs.o" << "tcltklib.o" - - # for tkutil.so - mk_tkutil = "\n\n" - mk_tkutil << "OBJS2 = tkutil.#{$OBJEXT}\n" - mk_tkutil << "TARGET2 = tkutil\n" - mk_tkutil << "DLLIB2 = $(TARGET2).#{CONFIG['DLEXT']}\n" - mk_tkutil << "STATIC_LIB2 = $(TARGET2).#{$LIBEXT}\n" - mk_tkutil << "\n" - mk_tkutil << 'CLEANLIBS2 = "$(TARGET2).{lib,exp,il?,tds,map}" $(DLLIB2)' - mk_tkutil << "\n\n" - mk_tkutil << "all: $(DLLIB2)\n" - mk_tkutil << "static: $(STATIC_LIB2)\n" - mk_tkutil << "\n" - - mk_tkutil << CLEANINGS.sub(/\$\(CLEANLIBS\)/, "$(CLEANLIBS) $(CLEANLIBS2)") - mk_tkutil << "\n\n" - - DLDFLAGS2 = "#$LDFLAGS #$DLDFLAGS #$ARCH_FLAG".gsub(/\$\(DEFFILE\)/, '$(DEFFILE2)') - mk_tkutil << "DLDFLAGS2 = #{DLDFLAGS2}\n" - mk_tkutil << "DEFFILE2 = $(TARGET2)-$(arch).def\n" if EXPORT_PREFIX - mk_tkutil << "\n" - - mk_tkutil << "$(DLLIB2): #{EXPORT_PREFIX ? '$(DEFFILE2) ':''}$(OBJS2)\n\t" - mk_tkutil << "@-$(RM) $@\n\t" - mk_tkutil << "@-$(RM) $(TARGET2).lib\n\t" if $mswin - - LINK_SO2 = LINK_SO.gsub(/\$\(DLLIB\)/, '$(DLLIB2)').gsub(/\$\(OBJS\)/, '$(OBJS2)').gsub(/\$\(DLDFLAGS\)/, '$(DLDFLAGS2)').gsub(/\$\(DEFFILE\)/, '$(DEFFILE2)') - mk_tkutil << LINK_SO2 - - mk_tkutil << "\n\n" - unless $static.nil? - mk_tkutil << "$(STATIC_LIB2): $(OBJS2)\n\t" - mk_tkutil << "$(AR) #{config_string('ARFLAGS') || 'cru '}$@ $(OBJS2)" - if ranlib = config_string('RANLIB') - mk_tkutil << "\n\t@-#{ranlib} $(DLLIB2) 2> /dev/null || true" - end - end - mk_tkutil << "\n\n" - - if EXPORT_PREFIX - mk_tkutil << "$(DEFFILE2):\n" - mk_tkutil << %Q!\t$(RUBY) -e "puts 'EXPORTS', '#{EXPORT_PREFIX}Init_$(TARGET2)'" > $@\n! - mk_tkutil << "\n\n" - end - mk_tkutil << "\n" - - mk_tkutil << "install: $(RUBYARCHDIR)/$(DLLIB2)\n" - mk_tkutil << "$(RUBYARCHDIR)/$(DLLIB2): $(DLLIB2) $(RUBYARCHDIR)\n" - mk_tkutil << "\t@$(INSTALL_PROG) $(DLLIB2) $(RUBYARCHDIR)\n" - - CLEANINGS.replace(mk_tkutil) - # create create_makefile("tcltklib") # reset $INSTALLFILES = installfiles_bup - CLEANINGS.replace(cleanings_bup) - $objs = objs_bup + + # add rules for tkutil + File::open('Makefile', 'a'){|mfile| + File::open('make-tkutil', 'r'){|dfile| + mfile.print "\n###\n" + while line = dfile.gets() + mfile.print line + end + } + } + + # create tkutil/Makefile + Dir.chdir 'tkutil' + if $extout || $extmk + $srcdir = '../' << $srcdir << '/tkutil' + $topdir = '../' << $topdir + $hdrdir = '../' << $hdrdir + $objs = nil + $defs = [] + Config::CONFIG["srcdir"] = $srcdir + else + puts "entering directory `tkutil'" + end + rm_f './Makefile' + init_mkmf + load 'subconf.rb' + Dir.chdir '..' end end diff --git a/ext/tk/make-tkutil b/ext/tk/make-tkutil new file mode 100644 index 000000000..a7884efdd --- /dev/null +++ b/ext/tk/make-tkutil @@ -0,0 +1,43 @@ +all: all-tkutil +all-tkutil: + @(cd tkutil; $(MAKE) all) + +static: static-tkutil +static-tkutil: + @(cd tkutil; $(MAKE) static) + +clean: clean-tkutil +clean-tkutil: + @(cd tkutil; $(MAKE) clean) + +distclean: distclean-tkutil +distclean-tkutil: + @(cd tkutil; $(MAKE) distclean) + +realclean: realclean-tkutil +realclean-tkutil: + @(cd tkutil; $(MAKE) realclean) + +install: install-tkutil +install-tkutil: + @(cd tkutil; $(MAKE) install) + +install-so: install-tkutil-so +install-tkutil-so: + @(cd tkutil; $(MAKE) install-so) + +install-rb: install-tkutil-rb +install-tkutil-rb: + @(cd tkutil; $(MAKE) install-rb) + +site-install: site-install-tkutil +site-install-tkutil: + @(cd tkutil; $(MAKE) site-install) + +site-install-so: site-install-tkutil-so +site-install-tkutil-so: + @(cd tkutil; $(MAKE) site-install-so) + +site-install-rb: site-install-tkutil-rb +site-install-tkutil-rb: + @(cd tkutil; $(MAKE) site-install-rb) diff --git a/ext/tk/tkutil.c b/ext/tk/tkutil.c deleted file mode 100644 index d88f7b9a7..000000000 --- a/ext/tk/tkutil.c +++ /dev/null @@ -1,1369 +0,0 @@ -/************************************************ - - tkutil.c - - - $Author$ - $Date$ - created at: Fri Nov 3 00:47:54 JST 1995 - -************************************************/ - -#define TKUTIL_RELEASE_DATE "2005-01-25" - -#include "ruby.h" -#include "rubysig.h" -#include "st.h" - -static VALUE cMethod; - -static VALUE cTclTkLib; - -static VALUE cTkObject; -static VALUE cTkCallbackEntry; - -static VALUE TK_None; - -static VALUE cCB_SUBST; -static VALUE cSUBST_INFO; - -static ID ID_split_tklist; -static ID ID_toUTF8; -static ID ID_fromUTF8; -static ID ID_path; -static ID ID_at_path; -static ID ID_to_eval; -static ID ID_to_s; -static ID ID_source; -static ID ID_downcase; -static ID ID_install_cmd; -static ID ID_merge_tklist; -static ID ID_call; - -static ID ID_SUBST_INFO; - -static VALUE CALLBACK_TABLE; -static unsigned long CALLBACK_ID_NUM = 0; - -/*************************************/ - -static VALUE -tk_s_new(argc, argv, klass) - int argc; - VALUE *argv; - VALUE klass; -{ - VALUE obj = rb_class_new_instance(argc, argv, klass); - - if (rb_block_given_p()) rb_obj_instance_eval(0, 0, obj); - return obj; -} - -/*************************************/ - -static VALUE -tkNone_to_s(self) - VALUE self; -{ - return rb_str_new2("None"); -} - -/*************************************/ - -static VALUE -tk_eval_cmd(argc, argv, self) - int argc; - VALUE argv[]; - VALUE self; -{ - volatile VALUE cmd, rest, arg; - volatile VALUE ret; - int status; - - rb_scan_args(argc, argv, "1*", &cmd, &rest); - return rb_eval_cmd(cmd, rest, 0); -} - -static VALUE -tk_do_callback(argc, argv, self) - int argc; - VALUE *argv; - VALUE self; -{ -#if 0 - volatile VALUE id; - volatile VALUE rest; - - rb_scan_args(argc, argv, "1*", &id, &rest); - return rb_apply(rb_hash_aref(CALLBACK_TABLE, id), ID_call, rest); -#endif - return rb_funcall2(rb_hash_aref(CALLBACK_TABLE, argv[0]), - ID_call, argc - 1, argv + 1); -} - -static char *cmd_id_head = "ruby_cmd TkUtil callback "; -static char *cmd_id_prefix = "cmd"; - -static VALUE -tk_install_cmd_core(cmd) - VALUE cmd; -{ - volatile VALUE id_num; - - id_num = ULONG2NUM(CALLBACK_ID_NUM++); - id_num = rb_funcall(id_num, ID_to_s, 0, 0); - id_num = rb_str_append(rb_str_new2(cmd_id_prefix), id_num); - rb_hash_aset(CALLBACK_TABLE, id_num, cmd); - return rb_str_append(rb_str_new2(cmd_id_head), id_num); -} - -static VALUE -tk_install_cmd(argc, argv, self) - int argc; - VALUE *argv; - VALUE self; -{ - volatile VALUE cmd; - -#if 0 - if (rb_scan_args(argc, argv, "01", &cmd) == 0) { - cmd = rb_block_proc(); - } - return tk_install_cmd_core(cmd); -#endif - if (argc == 0) { - cmd = rb_block_proc(); - } else { - cmd = argv[0]; - } - return tk_install_cmd_core(cmd); -} - -static VALUE -tk_uninstall_cmd(self, cmd_id) - VALUE self; - VALUE cmd_id; -{ - int head_len = strlen(cmd_id_head); - int prefix_len = strlen(cmd_id_prefix); - - StringValue(cmd_id); - if (strncmp(cmd_id_head, RSTRING(cmd_id)->ptr, head_len) != 0) { - return Qnil; - } - if (strncmp(cmd_id_prefix, - RSTRING(cmd_id)->ptr + head_len, prefix_len) != 0) { - return Qnil; - } - - return rb_hash_delete(CALLBACK_TABLE, - rb_str_new2(RSTRING(cmd_id)->ptr + head_len)); -} - -static VALUE -tk_toUTF8(argc, argv, self) - int argc; - VALUE *argv; - VALUE self; -{ - return rb_funcall2(cTclTkLib, ID_toUTF8, argc, argv); -} - -static VALUE -tk_fromUTF8(argc, argv, self) - int argc; - VALUE *argv; - VALUE self; -{ - return rb_funcall2(cTclTkLib, ID_fromUTF8, argc, argv); -} - -static VALUE -fromDefaultEnc_toUTF8(str, self) - VALUE str; - VALUE self; -{ - VALUE argv[1]; - - argv[0] = str; - return tk_toUTF8(1, argv, self); -} - -static VALUE -fromUTF8_toDefaultEnc(str, self) - VALUE str; - VALUE self; -{ - VALUE argv[1]; - - argv[0] = str; - return tk_fromUTF8(1, argv, self); -} - - -static void -hash_check(err) - int err; -{ - if (err) { - rb_raise(rb_eRuntimeError, "hash modified"); - } -} - -static int -to_strkey(key, value, hash, err) - VALUE key; - VALUE value; - VALUE hash; - int err; -{ - hash_check(err); - if (key == Qundef) return ST_CONTINUE; - rb_hash_aset(hash, rb_funcall(key, ID_to_s, 0, 0), value); - return ST_CHECK; -} - -static VALUE -tk_symbolkey2str(self, keys) - VALUE self; - VALUE keys; -{ - volatile VALUE new_keys = rb_hash_new(); - - if NIL_P(keys) return new_keys; - keys = rb_convert_type(keys, T_HASH, "Hash", "to_hash"); - st_foreach(RHASH(keys)->tbl, to_strkey, new_keys); - return new_keys; -} - -static VALUE get_eval_string_core _((VALUE, VALUE, VALUE)); -static VALUE ary2list _((VALUE, VALUE)); -static VALUE ary2list2 _((VALUE, VALUE)); -static VALUE hash2list _((VALUE, VALUE)); -static VALUE hash2kv _((VALUE, VALUE, VALUE)); - -static VALUE -ary2list(ary, self) - VALUE ary; - VALUE self; -{ - int idx, idx2, size, size2; - volatile VALUE val, val2; - volatile VALUE dst; - - /* size = RARRAY(ary)->len; */ - size = 0; - for(idx = 0; idx < RARRAY(ary)->len; idx++) { - if (TYPE(RARRAY(ary)->ptr[idx]) == T_HASH) { - size += 2 * RHASH(RARRAY(ary)->ptr[idx])->tbl->num_entries; - } else { - size++; - } - } - - dst = rb_ary_new2(size); - RARRAY(dst)->len = 0; - for(idx = 0; idx < RARRAY(ary)->len; idx++) { - val = RARRAY(ary)->ptr[idx]; - switch(TYPE(val)) { - case T_ARRAY: - RARRAY(dst)->ptr[RARRAY(dst)->len++] = ary2list(val, self); - break; - - case T_HASH: - /* RARRAY(dst)->ptr[RARRAY(dst)->len++] = hash2list(val, self); */ - val = hash2kv(val, Qnil, self); - size2 = RARRAY(val)->len; - for(idx2 = 0; idx2 < size2; idx2++) { - val2 = RARRAY(val)->ptr[idx2]; - switch(TYPE(val2)) { - case T_ARRAY: - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = ary2list(val2, self); - break; - - case T_HASH: - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = hash2list(val2, self); - - default: - if (val2 != TK_None) { - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = get_eval_string_core(val2, Qnil, self); - } - } - } - break; - - default: - if (val != TK_None) { - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = get_eval_string_core(val, Qnil, self); - } - } - } - return rb_apply(cTclTkLib, ID_merge_tklist, dst); -} - -static VALUE -ary2list2(ary, self) - VALUE ary; - VALUE self; -{ - int idx, size; - volatile VALUE val; - volatile VALUE dst; - - size = RARRAY(ary)->len; - dst = rb_ary_new2(size); - RARRAY(dst)->len = 0; - for(idx = 0; idx < RARRAY(ary)->len; idx++) { - val = RARRAY(ary)->ptr[idx]; - switch(TYPE(val)) { - case T_ARRAY: - RARRAY(dst)->ptr[RARRAY(dst)->len++] = ary2list(val, self); - break; - - case T_HASH: - RARRAY(dst)->ptr[RARRAY(dst)->len++] = hash2list(val, self); - break; - - default: - if (val != TK_None) { - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = get_eval_string_core(val, Qnil, self); - } - } - } - return rb_apply(cTclTkLib, ID_merge_tklist, dst); -} - -static VALUE -key2keyname(key) - VALUE key; -{ - return rb_str_append(rb_str_new2("-"), rb_funcall(key, ID_to_s, 0, 0)); -} - -static VALUE -assoc2kv(assoc, ary, self) - VALUE assoc; - VALUE ary; - VALUE self; -{ - int i, j, len; - volatile VALUE pair; - volatile VALUE val; - volatile VALUE dst = rb_ary_new2(2 * RARRAY(assoc)->len); - - len = RARRAY(assoc)->len; - - for(i = 0; i < len; i++) { - pair = RARRAY(assoc)->ptr[i]; - if (TYPE(pair) != T_ARRAY) { - RARRAY(dst)->ptr[RARRAY(dst)->len++] = key2keyname(pair); - continue; - } - switch(RARRAY(assoc)->len) { - case 2: - RARRAY(dst)->ptr[RARRAY(dst)->len++] = RARRAY(pair)->ptr[2]; - - case 1: - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = key2keyname(RARRAY(pair)->ptr[0]); - - case 0: - continue; - - default: - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = key2keyname(RARRAY(pair)->ptr[0]); - - val = rb_ary_new2(RARRAY(pair)->len - 1); - RARRAY(val)->len = 0; - for(j = 1; j < RARRAY(pair)->len; j++) { - RARRAY(val)->ptr[RARRAY(val)->len++] = RARRAY(pair)->ptr[j]; - } - - RARRAY(dst)->ptr[RARRAY(dst)->len++] = val; - } - } - - if (NIL_P(ary)) { - return dst; - } else { - return rb_ary_plus(ary, dst); - } -} - -static VALUE -assoc2kv_enc(assoc, ary, self) - VALUE assoc; - VALUE ary; - VALUE self; -{ - int i, j, len; - volatile VALUE pair; - volatile VALUE val; - volatile VALUE dst = rb_ary_new2(2 * RARRAY(assoc)->len); - - len = RARRAY(assoc)->len; - - for(i = 0; i < len; i++) { - pair = RARRAY(assoc)->ptr[i]; - if (TYPE(pair) != T_ARRAY) { - RARRAY(dst)->ptr[RARRAY(dst)->len++] = key2keyname(pair); - continue; - } - switch(RARRAY(assoc)->len) { - case 2: - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = get_eval_string_core(RARRAY(pair)->ptr[2], Qtrue, self); - - case 1: - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = key2keyname(RARRAY(pair)->ptr[0]); - - case 0: - continue; - - default: - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = key2keyname(RARRAY(pair)->ptr[0]); - - val = rb_ary_new2(RARRAY(pair)->len - 1); - RARRAY(val)->len = 0; - for(j = 1; j < RARRAY(pair)->len; j++) { - RARRAY(val)->ptr[RARRAY(val)->len++] = RARRAY(pair)->ptr[j]; - } - - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = get_eval_string_core(val, Qtrue, self); - } - } - - if (NIL_P(ary)) { - return dst; - } else { - return rb_ary_plus(ary, dst); - } -} - -static int -push_kv(key, val, args, err) - VALUE key; - VALUE val; - VALUE args; - int err; -{ - volatile VALUE ary; - - hash_check(err); - ary = RARRAY(args)->ptr[0]; - - if (key == Qundef) return ST_CONTINUE; -#if 0 - rb_ary_push(ary, key2keyname(key)); - if (val != TK_None) rb_ary_push(ary, val); -#endif - RARRAY(ary)->ptr[RARRAY(ary)->len++] = key2keyname(key); - - if (val == TK_None) return ST_CHECK; - - RARRAY(ary)->ptr[RARRAY(ary)->len++] - = get_eval_string_core(val, Qnil, RARRAY(args)->ptr[1]); - - return ST_CHECK; -} - -static VALUE -hash2kv(hash, ary, self) - VALUE hash; - VALUE ary; - VALUE self; -{ - volatile VALUE args = rb_ary_new2(2); - volatile VALUE dst = rb_ary_new2(2 * RHASH(hash)->tbl->num_entries); - - RARRAY(dst)->len = 0; - - RARRAY(args)->ptr[0] = dst; - RARRAY(args)->ptr[1] = self; - RARRAY(args)->len = 2; - st_foreach(RHASH(hash)->tbl, push_kv, args); - - if (NIL_P(ary)) { - return dst; - } else { - return rb_ary_concat(ary, dst); - } -} - -static int -push_kv_enc(key, val, args, err) - VALUE key; - VALUE val; - VALUE args; - int err; -{ - volatile VALUE ary; - - hash_check(err); - ary = RARRAY(args)->ptr[0]; - - if (key == Qundef) return ST_CONTINUE; -#if 0 - rb_ary_push(ary, key2keyname(key)); - if (val != TK_None) { - rb_ary_push(ary, get_eval_string_core(val, Qtrue, - RARRAY(args)->ptr[1])); - } -#endif - RARRAY(ary)->ptr[RARRAY(ary)->len++] = key2keyname(key); - - if (val == TK_None) return ST_CHECK; - - RARRAY(ary)->ptr[RARRAY(ary)->len++] - = get_eval_string_core(val, Qtrue, RARRAY(args)->ptr[1]); - - return ST_CHECK; -} - -static VALUE -hash2kv_enc(hash, ary, self) - VALUE hash; - VALUE ary; - VALUE self; -{ - volatile VALUE args = rb_ary_new2(2); - volatile VALUE dst = rb_ary_new2(2 * RHASH(hash)->tbl->num_entries); - - RARRAY(dst)->len = 0; - - RARRAY(args)->ptr[0] = dst; - RARRAY(args)->ptr[1] = self; - RARRAY(args)->len = 2; - st_foreach(RHASH(hash)->tbl, push_kv_enc, args); - - if (NIL_P(ary)) { - return dst; - } else { - return rb_ary_concat(ary, dst); - } -} - -static VALUE -hash2list(hash, self) - VALUE hash; - VALUE self; -{ - return ary2list2(hash2kv(hash, Qnil, self), self); -} - - -static VALUE -hash2list_enc(hash, self) - VALUE hash; - VALUE self; -{ - return ary2list2(hash2kv_enc(hash, Qnil, self), self); -} - -static VALUE -tk_hash_kv(argc, argv, self) - int argc; - VALUE *argv; - VALUE self; -{ - volatile VALUE hash, enc_flag, ary; - - ary = Qnil; - enc_flag = Qnil; - switch(argc) { - case 3: - ary = argv[2]; - case 2: - enc_flag = argv[1]; - case 1: - hash = argv[0]; - break; - case 0: - rb_raise(rb_eArgError, "too few arguments"); - default: /* >= 3 */ - rb_raise(rb_eArgError, "too many arguments"); - } - - switch(TYPE(hash)) { - case T_ARRAY: - if (RTEST(enc_flag)) { - return assoc2kv_enc(hash, ary, self); - } else { - return assoc2kv(hash, ary, self); - } - - case T_HASH: - if (RTEST(enc_flag)) { - return hash2kv_enc(hash, ary, self); - } else { - return hash2kv(hash, ary, self); - } - - case T_NIL: - if (NIL_P(ary)) { - return rb_ary_new(); - } else { - return ary; - } - - default: - if (hash == TK_None) { - if (NIL_P(ary)) { - return rb_ary_new(); - } else { - return ary; - } - } - rb_raise(rb_eArgError, "Hash is expected for 1st argument"); - } -} - -static VALUE -get_eval_string_core(obj, enc_flag, self) - VALUE obj; - VALUE enc_flag; - VALUE self; -{ - switch(TYPE(obj)) { - case T_FLOAT: - case T_FIXNUM: - case T_BIGNUM: - return rb_funcall(obj, ID_to_s, 0, 0); - - case T_STRING: - if (RTEST(enc_flag)) { - if (rb_respond_to(self, ID_toUTF8)) { - return rb_funcall(self, ID_toUTF8, 1, obj); - } else { - return fromDefaultEnc_toUTF8(obj, self); - } - } else { - return obj; - } - - case T_SYMBOL: - if (RTEST(enc_flag)) { - if (rb_respond_to(self, ID_toUTF8)) { - return rb_funcall(self, ID_toUTF8, 1, - rb_str_new2(rb_id2name(SYM2ID(obj)))); - } else { - return fromDefaultEnc_toUTF8(rb_str_new2(rb_id2name(SYM2ID(obj))), self); - } - } else { - return rb_str_new2(rb_id2name(SYM2ID(obj))); - } - - case T_HASH: - if (RTEST(enc_flag)) { - return hash2list_enc(obj, self); - } else { - return hash2list(obj, self); - } - - case T_ARRAY: - if (RTEST(enc_flag)) { - return fromDefaultEnc_toUTF8(ary2list(obj, self), self); - } else { - return ary2list(obj, self); - } - - case T_FALSE: - return rb_str_new2("0"); - - case T_TRUE: - return rb_str_new2("1"); - - case T_NIL: - return rb_str_new2(""); - - case T_REGEXP: - return rb_funcall(obj, ID_source, 0, 0); - - default: - if (rb_obj_is_kind_of(obj, cTkObject)) { - /* return rb_str_new3(rb_funcall(obj, ID_path, 0, 0)); */ - return get_eval_string_core(rb_funcall(obj, ID_path, 0, 0), - enc_flag, self); - } - - if (rb_obj_is_kind_of(obj, rb_cProc) - || rb_obj_is_kind_of(obj, cMethod) - || rb_obj_is_kind_of(obj, cTkCallbackEntry)) { - if (rb_respond_to(self, ID_install_cmd)) { - return rb_funcall(self, ID_install_cmd, 1, obj); - } else { - return tk_install_cmd_core(obj); - } - } - - if (obj == TK_None) return Qnil; - - if (rb_respond_to(obj, ID_to_eval)) { - /* return rb_funcall(obj, ID_to_eval, 0, 0); */ - return get_eval_string_core(rb_funcall(obj, ID_to_eval, 0, 0), - enc_flag, self); - } else if (rb_respond_to(obj, ID_path)) { - /* return rb_funcall(obj, ID_path, 0, 0); */ - return get_eval_string_core(rb_funcall(obj, ID_path, 0, 0), - enc_flag, self); - } else if (rb_respond_to(obj, ID_to_s)) { - return rb_funcall(obj, ID_to_s, 0, 0); - } - } - - rb_warning("fail to convert '%s' to string for Tk", - RSTRING(rb_funcall(obj, rb_intern("inspect"), 0, 0))->ptr); - - return obj; -} - -static VALUE -tk_get_eval_string(argc, argv, self) - int argc; - VALUE *argv; - VALUE self; -{ - volatile VALUE obj, enc_flag; - - if (rb_scan_args(argc, argv, "11", &obj, &enc_flag) == 1) { - enc_flag = Qnil; - } - - return get_eval_string_core(obj, enc_flag, self); -} - -static VALUE -tk_get_eval_enc_str(self, obj) - VALUE self; - VALUE obj; -{ - if (obj == TK_None) { - return obj; - } else { - return get_eval_string_core(obj, Qtrue, self); - } -} - -static VALUE -tk_conv_args(argc, argv, self) - int argc; - VALUE *argv; - VALUE self; -{ - int idx, size; - volatile VALUE dst; - int thr_crit_bup; - VALUE old_gc; - - thr_crit_bup = rb_thread_critical; - rb_thread_critical = Qtrue; - - old_gc = rb_gc_disable(); - - if (argc < 2) { - rb_raise(rb_eArgError, "too few arguments"); - } - for(size = 0, idx = 2; idx < argc; idx++) { - if (TYPE(argv[idx]) == T_HASH) { - size += 2 * RHASH(argv[idx])->tbl->num_entries; - } else { - size++; - } - } - /* dst = rb_ary_new2(argc - 2); */ - dst = rb_ary_new2(size); - RARRAY(dst)->len = 0; - for(idx = 2; idx < argc; idx++) { - if (TYPE(argv[idx]) == T_HASH) { - if (RTEST(argv[1])) { - hash2kv_enc(argv[idx], dst, self); - } else { - hash2kv(argv[idx], dst, self); - } - } else if (argv[idx] != TK_None) { - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = get_eval_string_core(argv[idx], argv[1], self); - } - } - - if (old_gc == Qfalse) rb_gc_enable(); - rb_thread_critical = thr_crit_bup; - - return rb_ary_plus(argv[0], dst); -} - - -/*************************************/ - -static VALUE -tcl2rb_bool(self, value) - VALUE self; - VALUE value; -{ - if (TYPE(value) == T_FIXNUM) { - if (NUM2INT(value) == 0) { - return Qfalse; - } else { - return Qtrue; - } - } - - if (TYPE(value) == T_TRUE || TYPE(value) == T_FALSE) { - return value; - } - - rb_check_type(value, T_STRING); - - value = rb_funcall(value, ID_downcase, 0); - - if (RSTRING(value)->ptr == (char*)NULL) return Qnil; - - if (RSTRING(value)->ptr[0] == '\0' - || strcmp(RSTRING(value)->ptr, "0") == 0 - || strcmp(RSTRING(value)->ptr, "no") == 0 - || strcmp(RSTRING(value)->ptr, "off") == 0 - || strcmp(RSTRING(value)->ptr, "false") == 0) { - return Qfalse; - } else { - return Qtrue; - } -} - -static VALUE -tkstr_to_dec(value) - VALUE value; -{ - return rb_cstr_to_inum(RSTRING(value)->ptr, 10, 1); -} - -static VALUE -tkstr_to_int(value) - VALUE value; -{ - return rb_cstr_to_inum(RSTRING(value)->ptr, 0, 1); -} - -static VALUE -tkstr_to_float(value) - VALUE value; -{ - return rb_float_new(rb_cstr_to_dbl(RSTRING(value)->ptr, 1)); -} - -static VALUE -tkstr_invalid_numstr(value) - VALUE value; -{ - rb_raise(rb_eArgError, - "invalid value for Number: '%s'", RSTRING(value)->ptr); - return Qnil; /*dummy*/ -} - -static VALUE -tkstr_rescue_float(value) - VALUE value; -{ - return rb_rescue2(tkstr_to_float, value, - tkstr_invalid_numstr, value, - rb_eArgError, 0); -} - -static VALUE -tkstr_to_number(value) - VALUE value; -{ - rb_check_type(value, T_STRING); - - if (RSTRING(value)->ptr == (char*)NULL) return INT2FIX(0); - - return rb_rescue2(tkstr_to_int, value, - tkstr_rescue_float, value, - rb_eArgError, 0); -} - -static VALUE -tcl2rb_number(self, value) - VALUE self; - VALUE value; -{ - return tkstr_to_number(value); -} - -static VALUE -tkstr_to_str(value) - VALUE value; -{ - char * ptr; - int len; - - ptr = RSTRING(value)->ptr; - len = RSTRING(value)->len; - - if (len > 1 && *ptr == '{' && *(ptr + len - 1) == '}') { - return rb_str_new(ptr + 1, len - 2); - } - return value; -} - -static VALUE -tcl2rb_string(self, value) - VALUE self; - VALUE value; -{ - rb_check_type(value, T_STRING); - - if (RSTRING(value)->ptr == (char*)NULL) return rb_tainted_str_new2(""); - - return tkstr_to_str(value); -} - -static VALUE -tcl2rb_num_or_str(self, value) - VALUE self; - VALUE value; -{ - rb_check_type(value, T_STRING); - - if (RSTRING(value)->ptr == (char*)NULL) return rb_tainted_str_new2(""); - - return rb_rescue2(tkstr_to_number, value, - tkstr_to_str, value, - rb_eArgError, 0); -} - - -/*************************************/ - -struct cbsubst_info { - int size; - char *key; - char *type; - ID *ivar; - VALUE proc; -}; - -static void -subst_mark(ptr) - struct cbsubst_info *ptr; -{ - rb_gc_mark(ptr->proc); -} - -static void -subst_free(ptr) - struct cbsubst_info *ptr; -{ - if (ptr) { - if (ptr->key != (char*)NULL) free(ptr->key); - if (ptr->type != (char*)NULL) free(ptr->type); - if (ptr->ivar != (ID*)NULL) free(ptr->ivar); - free(ptr); - } -} - -static void -cbsubst_init() -{ - struct cbsubst_info *inf; - ID *ivar; - volatile VALUE proc; - - inf = ALLOC(struct cbsubst_info); - - inf->size = 0; - - inf->key = ALLOC_N(char, 1); - inf->key[0] = '\0'; - - inf->type = ALLOC_N(char, 1); - inf->type[0] = '\0'; - - ivar = ALLOC_N(ID, 1); - inf->ivar = ivar; - - proc = rb_hash_new(); - inf->proc = proc; - - rb_const_set(cCB_SUBST, ID_SUBST_INFO, - Data_Wrap_Struct(cSUBST_INFO, subst_mark, subst_free, inf)); -} - -static VALUE -cbsubst_initialize(argc, argv, self) - int argc; - VALUE *argv; - VALUE self; -{ - struct cbsubst_info *inf; - volatile VALUE proc; - int idx; - - Data_Get_Struct(rb_const_get(rb_obj_class(self), ID_SUBST_INFO), - struct cbsubst_info, inf); - - for(idx = 0; idx < argc; idx++) { - rb_ivar_set(self, inf->ivar[idx], argv[idx]); - } - - return self; -} - - -static VALUE -cbsubst_ret_val(self, val) - VALUE self; - VALUE val; -{ - return val; -} - - -static VALUE -cbsubst_get_subst_key(self, str) - VALUE self; - VALUE str; -{ - volatile VALUE list; - volatile VALUE ret; - int i, len; - char *buf, *ptr; - - list = rb_funcall(cTclTkLib, ID_split_tklist, 1, str); - - len = RARRAY(list)->len; - buf = ALLOC_N(char, len + 1); - - for(i = 0; i < len; i++) { - ptr = RSTRING(RARRAY(list)->ptr[i])->ptr; - if (*ptr == '%' && *(ptr + 2) == '\0') { - *(buf + i) = *(ptr + 1); - } else { - *(buf + i) = ' '; - } - } - *(buf + len) = '\0'; - - ret = rb_str_new2(buf); - free(buf); - return ret; -} - -static VALUE -cbsubst_get_all_subst_keys(self) - VALUE self; -{ - struct cbsubst_info *inf; - char *buf, *ptr; - int i, len; - volatile VALUE ret; - - Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO), - struct cbsubst_info, inf); - - len = strlen(inf->key); - buf = ALLOC_N(char, 3*len + 1); - ptr = buf; - for(i = 0; i < len; i++) { - *(ptr++) = '%'; - *(ptr++) = *(inf->key + i); - *(ptr++) = ' '; - } - *(buf + 3*len) = '\0'; - - ret = rb_ary_new3(2, rb_str_new2(inf->key), rb_str_new2(buf)); - - free(buf); - - return ret; -} - -static VALUE -cbsubst_table_setup(self, key_inf, proc_inf) - VALUE self; - VALUE key_inf; - VALUE proc_inf; -{ - struct cbsubst_info *subst_inf; - int idx; - int len = RARRAY(key_inf)->len; - int real_len = 0; - char *key = ALLOC_N(char, len + 1); - char *type = ALLOC_N(char, len + 1); - ID *ivar = ALLOC_N(ID, len + 1); - volatile VALUE proc = rb_hash_new(); - volatile VALUE inf; - - /* init */ - subst_inf = ALLOC(struct cbsubst_info); - /* subst_inf->size = len; */ - subst_inf->key = key; - subst_inf->type = type; - subst_inf->ivar = ivar; - subst_inf->proc = proc; - - /* - * keys : array of [subst, type, ivar] - * subst ==> char code - * type ==> char code - * ivar ==> symbol - */ - for(idx = 0; idx < len; idx++) { - inf = RARRAY(key_inf)->ptr[idx]; - if (TYPE(inf) != T_ARRAY) continue; - *(key + real_len) = (char)NUM2INT(RARRAY(inf)->ptr[0]); - *(type + real_len) = (char)NUM2INT(RARRAY(inf)->ptr[1]); - - *(ivar + real_len) - = rb_intern( - RSTRING( - rb_str_cat2(rb_str_new2("@"), - rb_id2name(SYM2ID(RARRAY(inf)->ptr[2]))) - )->ptr - ); - - rb_attr(self, SYM2ID(RARRAY(inf)->ptr[2]), 1, 0, Qtrue); - real_len++; - } - *(key + real_len) = '\0'; - *(type + real_len) = '\0'; - subst_inf->size = real_len; - - /* - * procs : array of [type, proc] - * type ==> char code - * proc ==> proc/method/obj (must respond to 'call') - */ - len = RARRAY(proc_inf)->len; - for(idx = 0; idx < len; idx++) { - inf = RARRAY(proc_inf)->ptr[idx]; - if (TYPE(inf) != T_ARRAY) continue; - rb_hash_aset(proc, RARRAY(inf)->ptr[0], RARRAY(inf)->ptr[1]); - } - - rb_const_set(self, ID_SUBST_INFO, - Data_Wrap_Struct(cSUBST_INFO, subst_mark, - subst_free, subst_inf)); - - return self; -} - -static VALUE -cbsubst_get_extra_args_tbl(self) - VALUE self; -{ - return rb_ary_new(); -} - -static VALUE -cbsubst_scan_args(self, arg_key, val_ary) - VALUE self; - VALUE arg_key; - VALUE val_ary; -{ - struct cbsubst_info *inf; - int idx; - int len = RARRAY(val_ary)->len; - char c; - char *ptr; - volatile VALUE dst = rb_ary_new2(len); - volatile VALUE proc; - int thr_crit_bup; - VALUE old_gc; - - thr_crit_bup = rb_thread_critical; - rb_thread_critical = Qtrue; - - old_gc = rb_gc_disable(); - - Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO), - struct cbsubst_info, inf); - - RARRAY(dst)->len = 0; - for(idx = 0; idx < len; idx++) { - if (idx >= RSTRING(arg_key)->len) { - proc = Qnil; - } else if (*(RSTRING(arg_key)->ptr + idx) == ' ') { - proc = Qnil; - } else { - ptr = strchr(inf->key, *(RSTRING(arg_key)->ptr + idx)); - if (ptr == (char*)NULL) { - proc = Qnil; - } else { - c = *(inf->type + (ptr - inf->key)); - proc = rb_hash_aref(inf->proc, INT2FIX(c)); - } - } - - if (NIL_P(proc)) { - RARRAY(dst)->ptr[RARRAY(dst)->len++] = RARRAY(val_ary)->ptr[idx]; - } else { - RARRAY(dst)->ptr[RARRAY(dst)->len++] - = rb_funcall(proc, ID_call, 1, RARRAY(val_ary)->ptr[idx]); - } - } - - if (old_gc == Qfalse) rb_gc_enable(); - rb_thread_critical = thr_crit_bup; - - return dst; -} - -static VALUE -cbsubst_inspect(self) - VALUE self; -{ - return rb_str_new2("CallbackSubst"); -} - -static VALUE -substinfo_inspect(self) - VALUE self; -{ - return rb_str_new2("SubstInfo"); -} - -/*************************************/ - -static VALUE -tk_cbe_inspect(self) - VALUE self; -{ - return rb_str_new2("TkCallbackEntry"); -} - -/*************************************/ - -static VALUE -tkobj_path(self) - VALUE self; -{ - return rb_ivar_get(self, ID_at_path); -} - -/*************************************/ -/* release date */ -const char tkutil_release_date[] = TKUTIL_RELEASE_DATE; - -void -Init_tkutil() -{ - volatile VALUE tmp; - - VALUE cTK = rb_define_class("TkKernel", rb_cObject); - VALUE mTK = rb_define_module("TkUtil"); - - /* --------------------- */ - - rb_define_const(mTK, "RELEASE_DATE", - rb_obj_freeze(rb_str_new2(tkutil_release_date))); - - /* --------------------- */ - rb_global_variable(&cMethod); - cMethod = rb_const_get(rb_cObject, rb_intern("Method")); - - ID_path = rb_intern("path"); - ID_at_path = rb_intern("@path"); - ID_to_eval = rb_intern("to_eval"); - ID_to_s = rb_intern("to_s"); - ID_source = rb_intern("source"); - ID_downcase = rb_intern("downcase"); - ID_install_cmd = rb_intern("install_cmd"); - ID_merge_tklist = rb_intern("_merge_tklist"); - ID_call = rb_intern("call"); - - /* --------------------- */ - cCB_SUBST = rb_define_class_under(mTK, "CallbackSubst", rb_cObject); - rb_define_singleton_method(cCB_SUBST, "inspect", cbsubst_inspect, 0); - - cSUBST_INFO = rb_define_class_under(cCB_SUBST, "Info", rb_cObject); - rb_define_singleton_method(cSUBST_INFO, "inspect", substinfo_inspect, 0); - - ID_SUBST_INFO = rb_intern("SUBST_INFO"); - rb_define_singleton_method(cCB_SUBST, "ret_val", cbsubst_ret_val, 1); - rb_define_singleton_method(cCB_SUBST, "scan_args", cbsubst_scan_args, 2); - rb_define_singleton_method(cCB_SUBST, "_get_subst_key", - cbsubst_get_subst_key, 1); - rb_define_singleton_method(cCB_SUBST, "_get_all_subst_keys", - cbsubst_get_all_subst_keys, 0); - rb_define_singleton_method(cCB_SUBST, "_setup_subst_table", - cbsubst_table_setup, 2); - rb_define_singleton_method(cCB_SUBST, "_get_extra_args_tbl", - cbsubst_get_extra_args_tbl, 0); - - rb_define_method(cCB_SUBST, "initialize", cbsubst_initialize, -1); - - cbsubst_init(); - - /* --------------------- */ - rb_global_variable(&cTkCallbackEntry); - cTkCallbackEntry = rb_define_class("TkCallbackEntry", cTK); - rb_define_singleton_method(cTkCallbackEntry, "inspect", tk_cbe_inspect, 0); - - /* --------------------- */ - rb_global_variable(&cTkObject); - cTkObject = rb_define_class("TkObject", cTK); - rb_define_method(cTkObject, "path", tkobj_path, 0); - - /* --------------------- */ - rb_require("tcltklib"); - rb_global_variable(&cTclTkLib); - cTclTkLib = rb_const_get(rb_cObject, rb_intern("TclTkLib")); - ID_split_tklist = rb_intern("_split_tklist"); - ID_toUTF8 = rb_intern("_toUTF8"); - ID_fromUTF8 = rb_intern("_fromUTF8"); - - /* --------------------- */ - rb_define_singleton_method(cTK, "new", tk_s_new, -1); - - /* --------------------- */ - rb_global_variable(&TK_None); - TK_None = rb_obj_alloc(rb_cObject); - rb_define_const(mTK, "None", TK_None); - rb_define_singleton_method(TK_None, "to_s", tkNone_to_s, 0); - rb_define_singleton_method(TK_None, "inspect", tkNone_to_s, 0); - OBJ_FREEZE(TK_None); - - /* --------------------- */ - rb_global_variable(&CALLBACK_TABLE); - CALLBACK_TABLE = rb_hash_new(); - - /* --------------------- */ - rb_define_singleton_method(mTK, "eval_cmd", tk_eval_cmd, -1); - rb_define_singleton_method(mTK, "callback", tk_do_callback, -1); - rb_define_singleton_method(mTK, "install_cmd", tk_install_cmd, -1); - rb_define_singleton_method(mTK, "uninstall_cmd", tk_uninstall_cmd, 1); - rb_define_singleton_method(mTK, "_symbolkey2str", tk_symbolkey2str, 1); - rb_define_singleton_method(mTK, "hash_kv", tk_hash_kv, -1); - rb_define_singleton_method(mTK, "_get_eval_string", - tk_get_eval_string, -1); - rb_define_singleton_method(mTK, "_get_eval_enc_str", - tk_get_eval_enc_str, 1); - - rb_define_singleton_method(mTK, "bool", tcl2rb_bool, 1); - rb_define_singleton_method(mTK, "number", tcl2rb_number, 1); - rb_define_singleton_method(mTK, "string", tcl2rb_string, 1); - rb_define_singleton_method(mTK, "num_or_str", tcl2rb_num_or_str, 1); - - rb_define_method(mTK, "_toUTF8", tk_toUTF8, -1); - rb_define_method(mTK, "_fromUTF8", tk_fromUTF8, -1); - rb_define_method(mTK, "_symbolkey2str", tk_symbolkey2str, 1); - rb_define_method(mTK, "hash_kv", tk_hash_kv, -1); - rb_define_method(mTK, "_get_eval_string", tk_get_eval_string, -1); - rb_define_method(mTK, "_get_eval_enc_str", tk_get_eval_enc_str, 1); - rb_define_method(mTK, "_conv_args", tk_conv_args, -1); - - rb_define_method(mTK, "bool", tcl2rb_bool, 1); - rb_define_method(mTK, "number", tcl2rb_number, 1); - rb_define_method(mTK, "string", tcl2rb_string, 1); - rb_define_method(mTK, "num_or_str", tcl2rb_num_or_str, 1); - - /* --------------------- */ -} diff --git a/ext/tk/tkutil/.cvsignore b/ext/tk/tkutil/.cvsignore new file mode 100644 index 000000000..90c83ed9b --- /dev/null +++ b/ext/tk/tkutil/.cvsignore @@ -0,0 +1,3 @@ +Makefile +*.log +*.def diff --git a/ext/tk/tkutil/depend b/ext/tk/tkutil/depend new file mode 100644 index 000000000..fd63e230f --- /dev/null +++ b/ext/tk/tkutil/depend @@ -0,0 +1 @@ +tkutil.o: tkutil.c $(hdrdir)/ruby.h $(topdir)/config.h $(hdrdir)/defines.h diff --git a/ext/tk/tkutil/subconf.rb b/ext/tk/tkutil/subconf.rb new file mode 100644 index 000000000..5ff0bc1e6 --- /dev/null +++ b/ext/tk/tkutil/subconf.rb @@ -0,0 +1,2 @@ +require 'mkmf' +create_makefile('tkutil') diff --git a/ext/tk/tkutil/tkutil.c b/ext/tk/tkutil/tkutil.c new file mode 100644 index 000000000..d88f7b9a7 --- /dev/null +++ b/ext/tk/tkutil/tkutil.c @@ -0,0 +1,1369 @@ +/************************************************ + + tkutil.c - + + $Author$ + $Date$ + created at: Fri Nov 3 00:47:54 JST 1995 + +************************************************/ + +#define TKUTIL_RELEASE_DATE "2005-01-25" + +#include "ruby.h" +#include "rubysig.h" +#include "st.h" + +static VALUE cMethod; + +static VALUE cTclTkLib; + +static VALUE cTkObject; +static VALUE cTkCallbackEntry; + +static VALUE TK_None; + +static VALUE cCB_SUBST; +static VALUE cSUBST_INFO; + +static ID ID_split_tklist; +static ID ID_toUTF8; +static ID ID_fromUTF8; +static ID ID_path; +static ID ID_at_path; +static ID ID_to_eval; +static ID ID_to_s; +static ID ID_source; +static ID ID_downcase; +static ID ID_install_cmd; +static ID ID_merge_tklist; +static ID ID_call; + +static ID ID_SUBST_INFO; + +static VALUE CALLBACK_TABLE; +static unsigned long CALLBACK_ID_NUM = 0; + +/*************************************/ + +static VALUE +tk_s_new(argc, argv, klass) + int argc; + VALUE *argv; + VALUE klass; +{ + VALUE obj = rb_class_new_instance(argc, argv, klass); + + if (rb_block_given_p()) rb_obj_instance_eval(0, 0, obj); + return obj; +} + +/*************************************/ + +static VALUE +tkNone_to_s(self) + VALUE self; +{ + return rb_str_new2("None"); +} + +/*************************************/ + +static VALUE +tk_eval_cmd(argc, argv, self) + int argc; + VALUE argv[]; + VALUE self; +{ + volatile VALUE cmd, rest, arg; + volatile VALUE ret; + int status; + + rb_scan_args(argc, argv, "1*", &cmd, &rest); + return rb_eval_cmd(cmd, rest, 0); +} + +static VALUE +tk_do_callback(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ +#if 0 + volatile VALUE id; + volatile VALUE rest; + + rb_scan_args(argc, argv, "1*", &id, &rest); + return rb_apply(rb_hash_aref(CALLBACK_TABLE, id), ID_call, rest); +#endif + return rb_funcall2(rb_hash_aref(CALLBACK_TABLE, argv[0]), + ID_call, argc - 1, argv + 1); +} + +static char *cmd_id_head = "ruby_cmd TkUtil callback "; +static char *cmd_id_prefix = "cmd"; + +static VALUE +tk_install_cmd_core(cmd) + VALUE cmd; +{ + volatile VALUE id_num; + + id_num = ULONG2NUM(CALLBACK_ID_NUM++); + id_num = rb_funcall(id_num, ID_to_s, 0, 0); + id_num = rb_str_append(rb_str_new2(cmd_id_prefix), id_num); + rb_hash_aset(CALLBACK_TABLE, id_num, cmd); + return rb_str_append(rb_str_new2(cmd_id_head), id_num); +} + +static VALUE +tk_install_cmd(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ + volatile VALUE cmd; + +#if 0 + if (rb_scan_args(argc, argv, "01", &cmd) == 0) { + cmd = rb_block_proc(); + } + return tk_install_cmd_core(cmd); +#endif + if (argc == 0) { + cmd = rb_block_proc(); + } else { + cmd = argv[0]; + } + return tk_install_cmd_core(cmd); +} + +static VALUE +tk_uninstall_cmd(self, cmd_id) + VALUE self; + VALUE cmd_id; +{ + int head_len = strlen(cmd_id_head); + int prefix_len = strlen(cmd_id_prefix); + + StringValue(cmd_id); + if (strncmp(cmd_id_head, RSTRING(cmd_id)->ptr, head_len) != 0) { + return Qnil; + } + if (strncmp(cmd_id_prefix, + RSTRING(cmd_id)->ptr + head_len, prefix_len) != 0) { + return Qnil; + } + + return rb_hash_delete(CALLBACK_TABLE, + rb_str_new2(RSTRING(cmd_id)->ptr + head_len)); +} + +static VALUE +tk_toUTF8(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ + return rb_funcall2(cTclTkLib, ID_toUTF8, argc, argv); +} + +static VALUE +tk_fromUTF8(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ + return rb_funcall2(cTclTkLib, ID_fromUTF8, argc, argv); +} + +static VALUE +fromDefaultEnc_toUTF8(str, self) + VALUE str; + VALUE self; +{ + VALUE argv[1]; + + argv[0] = str; + return tk_toUTF8(1, argv, self); +} + +static VALUE +fromUTF8_toDefaultEnc(str, self) + VALUE str; + VALUE self; +{ + VALUE argv[1]; + + argv[0] = str; + return tk_fromUTF8(1, argv, self); +} + + +static void +hash_check(err) + int err; +{ + if (err) { + rb_raise(rb_eRuntimeError, "hash modified"); + } +} + +static int +to_strkey(key, value, hash, err) + VALUE key; + VALUE value; + VALUE hash; + int err; +{ + hash_check(err); + if (key == Qundef) return ST_CONTINUE; + rb_hash_aset(hash, rb_funcall(key, ID_to_s, 0, 0), value); + return ST_CHECK; +} + +static VALUE +tk_symbolkey2str(self, keys) + VALUE self; + VALUE keys; +{ + volatile VALUE new_keys = rb_hash_new(); + + if NIL_P(keys) return new_keys; + keys = rb_convert_type(keys, T_HASH, "Hash", "to_hash"); + st_foreach(RHASH(keys)->tbl, to_strkey, new_keys); + return new_keys; +} + +static VALUE get_eval_string_core _((VALUE, VALUE, VALUE)); +static VALUE ary2list _((VALUE, VALUE)); +static VALUE ary2list2 _((VALUE, VALUE)); +static VALUE hash2list _((VALUE, VALUE)); +static VALUE hash2kv _((VALUE, VALUE, VALUE)); + +static VALUE +ary2list(ary, self) + VALUE ary; + VALUE self; +{ + int idx, idx2, size, size2; + volatile VALUE val, val2; + volatile VALUE dst; + + /* size = RARRAY(ary)->len; */ + size = 0; + for(idx = 0; idx < RARRAY(ary)->len; idx++) { + if (TYPE(RARRAY(ary)->ptr[idx]) == T_HASH) { + size += 2 * RHASH(RARRAY(ary)->ptr[idx])->tbl->num_entries; + } else { + size++; + } + } + + dst = rb_ary_new2(size); + RARRAY(dst)->len = 0; + for(idx = 0; idx < RARRAY(ary)->len; idx++) { + val = RARRAY(ary)->ptr[idx]; + switch(TYPE(val)) { + case T_ARRAY: + RARRAY(dst)->ptr[RARRAY(dst)->len++] = ary2list(val, self); + break; + + case T_HASH: + /* RARRAY(dst)->ptr[RARRAY(dst)->len++] = hash2list(val, self); */ + val = hash2kv(val, Qnil, self); + size2 = RARRAY(val)->len; + for(idx2 = 0; idx2 < size2; idx2++) { + val2 = RARRAY(val)->ptr[idx2]; + switch(TYPE(val2)) { + case T_ARRAY: + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = ary2list(val2, self); + break; + + case T_HASH: + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = hash2list(val2, self); + + default: + if (val2 != TK_None) { + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = get_eval_string_core(val2, Qnil, self); + } + } + } + break; + + default: + if (val != TK_None) { + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = get_eval_string_core(val, Qnil, self); + } + } + } + return rb_apply(cTclTkLib, ID_merge_tklist, dst); +} + +static VALUE +ary2list2(ary, self) + VALUE ary; + VALUE self; +{ + int idx, size; + volatile VALUE val; + volatile VALUE dst; + + size = RARRAY(ary)->len; + dst = rb_ary_new2(size); + RARRAY(dst)->len = 0; + for(idx = 0; idx < RARRAY(ary)->len; idx++) { + val = RARRAY(ary)->ptr[idx]; + switch(TYPE(val)) { + case T_ARRAY: + RARRAY(dst)->ptr[RARRAY(dst)->len++] = ary2list(val, self); + break; + + case T_HASH: + RARRAY(dst)->ptr[RARRAY(dst)->len++] = hash2list(val, self); + break; + + default: + if (val != TK_None) { + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = get_eval_string_core(val, Qnil, self); + } + } + } + return rb_apply(cTclTkLib, ID_merge_tklist, dst); +} + +static VALUE +key2keyname(key) + VALUE key; +{ + return rb_str_append(rb_str_new2("-"), rb_funcall(key, ID_to_s, 0, 0)); +} + +static VALUE +assoc2kv(assoc, ary, self) + VALUE assoc; + VALUE ary; + VALUE self; +{ + int i, j, len; + volatile VALUE pair; + volatile VALUE val; + volatile VALUE dst = rb_ary_new2(2 * RARRAY(assoc)->len); + + len = RARRAY(assoc)->len; + + for(i = 0; i < len; i++) { + pair = RARRAY(assoc)->ptr[i]; + if (TYPE(pair) != T_ARRAY) { + RARRAY(dst)->ptr[RARRAY(dst)->len++] = key2keyname(pair); + continue; + } + switch(RARRAY(assoc)->len) { + case 2: + RARRAY(dst)->ptr[RARRAY(dst)->len++] = RARRAY(pair)->ptr[2]; + + case 1: + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = key2keyname(RARRAY(pair)->ptr[0]); + + case 0: + continue; + + default: + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = key2keyname(RARRAY(pair)->ptr[0]); + + val = rb_ary_new2(RARRAY(pair)->len - 1); + RARRAY(val)->len = 0; + for(j = 1; j < RARRAY(pair)->len; j++) { + RARRAY(val)->ptr[RARRAY(val)->len++] = RARRAY(pair)->ptr[j]; + } + + RARRAY(dst)->ptr[RARRAY(dst)->len++] = val; + } + } + + if (NIL_P(ary)) { + return dst; + } else { + return rb_ary_plus(ary, dst); + } +} + +static VALUE +assoc2kv_enc(assoc, ary, self) + VALUE assoc; + VALUE ary; + VALUE self; +{ + int i, j, len; + volatile VALUE pair; + volatile VALUE val; + volatile VALUE dst = rb_ary_new2(2 * RARRAY(assoc)->len); + + len = RARRAY(assoc)->len; + + for(i = 0; i < len; i++) { + pair = RARRAY(assoc)->ptr[i]; + if (TYPE(pair) != T_ARRAY) { + RARRAY(dst)->ptr[RARRAY(dst)->len++] = key2keyname(pair); + continue; + } + switch(RARRAY(assoc)->len) { + case 2: + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = get_eval_string_core(RARRAY(pair)->ptr[2], Qtrue, self); + + case 1: + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = key2keyname(RARRAY(pair)->ptr[0]); + + case 0: + continue; + + default: + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = key2keyname(RARRAY(pair)->ptr[0]); + + val = rb_ary_new2(RARRAY(pair)->len - 1); + RARRAY(val)->len = 0; + for(j = 1; j < RARRAY(pair)->len; j++) { + RARRAY(val)->ptr[RARRAY(val)->len++] = RARRAY(pair)->ptr[j]; + } + + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = get_eval_string_core(val, Qtrue, self); + } + } + + if (NIL_P(ary)) { + return dst; + } else { + return rb_ary_plus(ary, dst); + } +} + +static int +push_kv(key, val, args, err) + VALUE key; + VALUE val; + VALUE args; + int err; +{ + volatile VALUE ary; + + hash_check(err); + ary = RARRAY(args)->ptr[0]; + + if (key == Qundef) return ST_CONTINUE; +#if 0 + rb_ary_push(ary, key2keyname(key)); + if (val != TK_None) rb_ary_push(ary, val); +#endif + RARRAY(ary)->ptr[RARRAY(ary)->len++] = key2keyname(key); + + if (val == TK_None) return ST_CHECK; + + RARRAY(ary)->ptr[RARRAY(ary)->len++] + = get_eval_string_core(val, Qnil, RARRAY(args)->ptr[1]); + + return ST_CHECK; +} + +static VALUE +hash2kv(hash, ary, self) + VALUE hash; + VALUE ary; + VALUE self; +{ + volatile VALUE args = rb_ary_new2(2); + volatile VALUE dst = rb_ary_new2(2 * RHASH(hash)->tbl->num_entries); + + RARRAY(dst)->len = 0; + + RARRAY(args)->ptr[0] = dst; + RARRAY(args)->ptr[1] = self; + RARRAY(args)->len = 2; + st_foreach(RHASH(hash)->tbl, push_kv, args); + + if (NIL_P(ary)) { + return dst; + } else { + return rb_ary_concat(ary, dst); + } +} + +static int +push_kv_enc(key, val, args, err) + VALUE key; + VALUE val; + VALUE args; + int err; +{ + volatile VALUE ary; + + hash_check(err); + ary = RARRAY(args)->ptr[0]; + + if (key == Qundef) return ST_CONTINUE; +#if 0 + rb_ary_push(ary, key2keyname(key)); + if (val != TK_None) { + rb_ary_push(ary, get_eval_string_core(val, Qtrue, + RARRAY(args)->ptr[1])); + } +#endif + RARRAY(ary)->ptr[RARRAY(ary)->len++] = key2keyname(key); + + if (val == TK_None) return ST_CHECK; + + RARRAY(ary)->ptr[RARRAY(ary)->len++] + = get_eval_string_core(val, Qtrue, RARRAY(args)->ptr[1]); + + return ST_CHECK; +} + +static VALUE +hash2kv_enc(hash, ary, self) + VALUE hash; + VALUE ary; + VALUE self; +{ + volatile VALUE args = rb_ary_new2(2); + volatile VALUE dst = rb_ary_new2(2 * RHASH(hash)->tbl->num_entries); + + RARRAY(dst)->len = 0; + + RARRAY(args)->ptr[0] = dst; + RARRAY(args)->ptr[1] = self; + RARRAY(args)->len = 2; + st_foreach(RHASH(hash)->tbl, push_kv_enc, args); + + if (NIL_P(ary)) { + return dst; + } else { + return rb_ary_concat(ary, dst); + } +} + +static VALUE +hash2list(hash, self) + VALUE hash; + VALUE self; +{ + return ary2list2(hash2kv(hash, Qnil, self), self); +} + + +static VALUE +hash2list_enc(hash, self) + VALUE hash; + VALUE self; +{ + return ary2list2(hash2kv_enc(hash, Qnil, self), self); +} + +static VALUE +tk_hash_kv(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ + volatile VALUE hash, enc_flag, ary; + + ary = Qnil; + enc_flag = Qnil; + switch(argc) { + case 3: + ary = argv[2]; + case 2: + enc_flag = argv[1]; + case 1: + hash = argv[0]; + break; + case 0: + rb_raise(rb_eArgError, "too few arguments"); + default: /* >= 3 */ + rb_raise(rb_eArgError, "too many arguments"); + } + + switch(TYPE(hash)) { + case T_ARRAY: + if (RTEST(enc_flag)) { + return assoc2kv_enc(hash, ary, self); + } else { + return assoc2kv(hash, ary, self); + } + + case T_HASH: + if (RTEST(enc_flag)) { + return hash2kv_enc(hash, ary, self); + } else { + return hash2kv(hash, ary, self); + } + + case T_NIL: + if (NIL_P(ary)) { + return rb_ary_new(); + } else { + return ary; + } + + default: + if (hash == TK_None) { + if (NIL_P(ary)) { + return rb_ary_new(); + } else { + return ary; + } + } + rb_raise(rb_eArgError, "Hash is expected for 1st argument"); + } +} + +static VALUE +get_eval_string_core(obj, enc_flag, self) + VALUE obj; + VALUE enc_flag; + VALUE self; +{ + switch(TYPE(obj)) { + case T_FLOAT: + case T_FIXNUM: + case T_BIGNUM: + return rb_funcall(obj, ID_to_s, 0, 0); + + case T_STRING: + if (RTEST(enc_flag)) { + if (rb_respond_to(self, ID_toUTF8)) { + return rb_funcall(self, ID_toUTF8, 1, obj); + } else { + return fromDefaultEnc_toUTF8(obj, self); + } + } else { + return obj; + } + + case T_SYMBOL: + if (RTEST(enc_flag)) { + if (rb_respond_to(self, ID_toUTF8)) { + return rb_funcall(self, ID_toUTF8, 1, + rb_str_new2(rb_id2name(SYM2ID(obj)))); + } else { + return fromDefaultEnc_toUTF8(rb_str_new2(rb_id2name(SYM2ID(obj))), self); + } + } else { + return rb_str_new2(rb_id2name(SYM2ID(obj))); + } + + case T_HASH: + if (RTEST(enc_flag)) { + return hash2list_enc(obj, self); + } else { + return hash2list(obj, self); + } + + case T_ARRAY: + if (RTEST(enc_flag)) { + return fromDefaultEnc_toUTF8(ary2list(obj, self), self); + } else { + return ary2list(obj, self); + } + + case T_FALSE: + return rb_str_new2("0"); + + case T_TRUE: + return rb_str_new2("1"); + + case T_NIL: + return rb_str_new2(""); + + case T_REGEXP: + return rb_funcall(obj, ID_source, 0, 0); + + default: + if (rb_obj_is_kind_of(obj, cTkObject)) { + /* return rb_str_new3(rb_funcall(obj, ID_path, 0, 0)); */ + return get_eval_string_core(rb_funcall(obj, ID_path, 0, 0), + enc_flag, self); + } + + if (rb_obj_is_kind_of(obj, rb_cProc) + || rb_obj_is_kind_of(obj, cMethod) + || rb_obj_is_kind_of(obj, cTkCallbackEntry)) { + if (rb_respond_to(self, ID_install_cmd)) { + return rb_funcall(self, ID_install_cmd, 1, obj); + } else { + return tk_install_cmd_core(obj); + } + } + + if (obj == TK_None) return Qnil; + + if (rb_respond_to(obj, ID_to_eval)) { + /* return rb_funcall(obj, ID_to_eval, 0, 0); */ + return get_eval_string_core(rb_funcall(obj, ID_to_eval, 0, 0), + enc_flag, self); + } else if (rb_respond_to(obj, ID_path)) { + /* return rb_funcall(obj, ID_path, 0, 0); */ + return get_eval_string_core(rb_funcall(obj, ID_path, 0, 0), + enc_flag, self); + } else if (rb_respond_to(obj, ID_to_s)) { + return rb_funcall(obj, ID_to_s, 0, 0); + } + } + + rb_warning("fail to convert '%s' to string for Tk", + RSTRING(rb_funcall(obj, rb_intern("inspect"), 0, 0))->ptr); + + return obj; +} + +static VALUE +tk_get_eval_string(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ + volatile VALUE obj, enc_flag; + + if (rb_scan_args(argc, argv, "11", &obj, &enc_flag) == 1) { + enc_flag = Qnil; + } + + return get_eval_string_core(obj, enc_flag, self); +} + +static VALUE +tk_get_eval_enc_str(self, obj) + VALUE self; + VALUE obj; +{ + if (obj == TK_None) { + return obj; + } else { + return get_eval_string_core(obj, Qtrue, self); + } +} + +static VALUE +tk_conv_args(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ + int idx, size; + volatile VALUE dst; + int thr_crit_bup; + VALUE old_gc; + + thr_crit_bup = rb_thread_critical; + rb_thread_critical = Qtrue; + + old_gc = rb_gc_disable(); + + if (argc < 2) { + rb_raise(rb_eArgError, "too few arguments"); + } + for(size = 0, idx = 2; idx < argc; idx++) { + if (TYPE(argv[idx]) == T_HASH) { + size += 2 * RHASH(argv[idx])->tbl->num_entries; + } else { + size++; + } + } + /* dst = rb_ary_new2(argc - 2); */ + dst = rb_ary_new2(size); + RARRAY(dst)->len = 0; + for(idx = 2; idx < argc; idx++) { + if (TYPE(argv[idx]) == T_HASH) { + if (RTEST(argv[1])) { + hash2kv_enc(argv[idx], dst, self); + } else { + hash2kv(argv[idx], dst, self); + } + } else if (argv[idx] != TK_None) { + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = get_eval_string_core(argv[idx], argv[1], self); + } + } + + if (old_gc == Qfalse) rb_gc_enable(); + rb_thread_critical = thr_crit_bup; + + return rb_ary_plus(argv[0], dst); +} + + +/*************************************/ + +static VALUE +tcl2rb_bool(self, value) + VALUE self; + VALUE value; +{ + if (TYPE(value) == T_FIXNUM) { + if (NUM2INT(value) == 0) { + return Qfalse; + } else { + return Qtrue; + } + } + + if (TYPE(value) == T_TRUE || TYPE(value) == T_FALSE) { + return value; + } + + rb_check_type(value, T_STRING); + + value = rb_funcall(value, ID_downcase, 0); + + if (RSTRING(value)->ptr == (char*)NULL) return Qnil; + + if (RSTRING(value)->ptr[0] == '\0' + || strcmp(RSTRING(value)->ptr, "0") == 0 + || strcmp(RSTRING(value)->ptr, "no") == 0 + || strcmp(RSTRING(value)->ptr, "off") == 0 + || strcmp(RSTRING(value)->ptr, "false") == 0) { + return Qfalse; + } else { + return Qtrue; + } +} + +static VALUE +tkstr_to_dec(value) + VALUE value; +{ + return rb_cstr_to_inum(RSTRING(value)->ptr, 10, 1); +} + +static VALUE +tkstr_to_int(value) + VALUE value; +{ + return rb_cstr_to_inum(RSTRING(value)->ptr, 0, 1); +} + +static VALUE +tkstr_to_float(value) + VALUE value; +{ + return rb_float_new(rb_cstr_to_dbl(RSTRING(value)->ptr, 1)); +} + +static VALUE +tkstr_invalid_numstr(value) + VALUE value; +{ + rb_raise(rb_eArgError, + "invalid value for Number: '%s'", RSTRING(value)->ptr); + return Qnil; /*dummy*/ +} + +static VALUE +tkstr_rescue_float(value) + VALUE value; +{ + return rb_rescue2(tkstr_to_float, value, + tkstr_invalid_numstr, value, + rb_eArgError, 0); +} + +static VALUE +tkstr_to_number(value) + VALUE value; +{ + rb_check_type(value, T_STRING); + + if (RSTRING(value)->ptr == (char*)NULL) return INT2FIX(0); + + return rb_rescue2(tkstr_to_int, value, + tkstr_rescue_float, value, + rb_eArgError, 0); +} + +static VALUE +tcl2rb_number(self, value) + VALUE self; + VALUE value; +{ + return tkstr_to_number(value); +} + +static VALUE +tkstr_to_str(value) + VALUE value; +{ + char * ptr; + int len; + + ptr = RSTRING(value)->ptr; + len = RSTRING(value)->len; + + if (len > 1 && *ptr == '{' && *(ptr + len - 1) == '}') { + return rb_str_new(ptr + 1, len - 2); + } + return value; +} + +static VALUE +tcl2rb_string(self, value) + VALUE self; + VALUE value; +{ + rb_check_type(value, T_STRING); + + if (RSTRING(value)->ptr == (char*)NULL) return rb_tainted_str_new2(""); + + return tkstr_to_str(value); +} + +static VALUE +tcl2rb_num_or_str(self, value) + VALUE self; + VALUE value; +{ + rb_check_type(value, T_STRING); + + if (RSTRING(value)->ptr == (char*)NULL) return rb_tainted_str_new2(""); + + return rb_rescue2(tkstr_to_number, value, + tkstr_to_str, value, + rb_eArgError, 0); +} + + +/*************************************/ + +struct cbsubst_info { + int size; + char *key; + char *type; + ID *ivar; + VALUE proc; +}; + +static void +subst_mark(ptr) + struct cbsubst_info *ptr; +{ + rb_gc_mark(ptr->proc); +} + +static void +subst_free(ptr) + struct cbsubst_info *ptr; +{ + if (ptr) { + if (ptr->key != (char*)NULL) free(ptr->key); + if (ptr->type != (char*)NULL) free(ptr->type); + if (ptr->ivar != (ID*)NULL) free(ptr->ivar); + free(ptr); + } +} + +static void +cbsubst_init() +{ + struct cbsubst_info *inf; + ID *ivar; + volatile VALUE proc; + + inf = ALLOC(struct cbsubst_info); + + inf->size = 0; + + inf->key = ALLOC_N(char, 1); + inf->key[0] = '\0'; + + inf->type = ALLOC_N(char, 1); + inf->type[0] = '\0'; + + ivar = ALLOC_N(ID, 1); + inf->ivar = ivar; + + proc = rb_hash_new(); + inf->proc = proc; + + rb_const_set(cCB_SUBST, ID_SUBST_INFO, + Data_Wrap_Struct(cSUBST_INFO, subst_mark, subst_free, inf)); +} + +static VALUE +cbsubst_initialize(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ + struct cbsubst_info *inf; + volatile VALUE proc; + int idx; + + Data_Get_Struct(rb_const_get(rb_obj_class(self), ID_SUBST_INFO), + struct cbsubst_info, inf); + + for(idx = 0; idx < argc; idx++) { + rb_ivar_set(self, inf->ivar[idx], argv[idx]); + } + + return self; +} + + +static VALUE +cbsubst_ret_val(self, val) + VALUE self; + VALUE val; +{ + return val; +} + + +static VALUE +cbsubst_get_subst_key(self, str) + VALUE self; + VALUE str; +{ + volatile VALUE list; + volatile VALUE ret; + int i, len; + char *buf, *ptr; + + list = rb_funcall(cTclTkLib, ID_split_tklist, 1, str); + + len = RARRAY(list)->len; + buf = ALLOC_N(char, len + 1); + + for(i = 0; i < len; i++) { + ptr = RSTRING(RARRAY(list)->ptr[i])->ptr; + if (*ptr == '%' && *(ptr + 2) == '\0') { + *(buf + i) = *(ptr + 1); + } else { + *(buf + i) = ' '; + } + } + *(buf + len) = '\0'; + + ret = rb_str_new2(buf); + free(buf); + return ret; +} + +static VALUE +cbsubst_get_all_subst_keys(self) + VALUE self; +{ + struct cbsubst_info *inf; + char *buf, *ptr; + int i, len; + volatile VALUE ret; + + Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO), + struct cbsubst_info, inf); + + len = strlen(inf->key); + buf = ALLOC_N(char, 3*len + 1); + ptr = buf; + for(i = 0; i < len; i++) { + *(ptr++) = '%'; + *(ptr++) = *(inf->key + i); + *(ptr++) = ' '; + } + *(buf + 3*len) = '\0'; + + ret = rb_ary_new3(2, rb_str_new2(inf->key), rb_str_new2(buf)); + + free(buf); + + return ret; +} + +static VALUE +cbsubst_table_setup(self, key_inf, proc_inf) + VALUE self; + VALUE key_inf; + VALUE proc_inf; +{ + struct cbsubst_info *subst_inf; + int idx; + int len = RARRAY(key_inf)->len; + int real_len = 0; + char *key = ALLOC_N(char, len + 1); + char *type = ALLOC_N(char, len + 1); + ID *ivar = ALLOC_N(ID, len + 1); + volatile VALUE proc = rb_hash_new(); + volatile VALUE inf; + + /* init */ + subst_inf = ALLOC(struct cbsubst_info); + /* subst_inf->size = len; */ + subst_inf->key = key; + subst_inf->type = type; + subst_inf->ivar = ivar; + subst_inf->proc = proc; + + /* + * keys : array of [subst, type, ivar] + * subst ==> char code + * type ==> char code + * ivar ==> symbol + */ + for(idx = 0; idx < len; idx++) { + inf = RARRAY(key_inf)->ptr[idx]; + if (TYPE(inf) != T_ARRAY) continue; + *(key + real_len) = (char)NUM2INT(RARRAY(inf)->ptr[0]); + *(type + real_len) = (char)NUM2INT(RARRAY(inf)->ptr[1]); + + *(ivar + real_len) + = rb_intern( + RSTRING( + rb_str_cat2(rb_str_new2("@"), + rb_id2name(SYM2ID(RARRAY(inf)->ptr[2]))) + )->ptr + ); + + rb_attr(self, SYM2ID(RARRAY(inf)->ptr[2]), 1, 0, Qtrue); + real_len++; + } + *(key + real_len) = '\0'; + *(type + real_len) = '\0'; + subst_inf->size = real_len; + + /* + * procs : array of [type, proc] + * type ==> char code + * proc ==> proc/method/obj (must respond to 'call') + */ + len = RARRAY(proc_inf)->len; + for(idx = 0; idx < len; idx++) { + inf = RARRAY(proc_inf)->ptr[idx]; + if (TYPE(inf) != T_ARRAY) continue; + rb_hash_aset(proc, RARRAY(inf)->ptr[0], RARRAY(inf)->ptr[1]); + } + + rb_const_set(self, ID_SUBST_INFO, + Data_Wrap_Struct(cSUBST_INFO, subst_mark, + subst_free, subst_inf)); + + return self; +} + +static VALUE +cbsubst_get_extra_args_tbl(self) + VALUE self; +{ + return rb_ary_new(); +} + +static VALUE +cbsubst_scan_args(self, arg_key, val_ary) + VALUE self; + VALUE arg_key; + VALUE val_ary; +{ + struct cbsubst_info *inf; + int idx; + int len = RARRAY(val_ary)->len; + char c; + char *ptr; + volatile VALUE dst = rb_ary_new2(len); + volatile VALUE proc; + int thr_crit_bup; + VALUE old_gc; + + thr_crit_bup = rb_thread_critical; + rb_thread_critical = Qtrue; + + old_gc = rb_gc_disable(); + + Data_Get_Struct(rb_const_get(self, ID_SUBST_INFO), + struct cbsubst_info, inf); + + RARRAY(dst)->len = 0; + for(idx = 0; idx < len; idx++) { + if (idx >= RSTRING(arg_key)->len) { + proc = Qnil; + } else if (*(RSTRING(arg_key)->ptr + idx) == ' ') { + proc = Qnil; + } else { + ptr = strchr(inf->key, *(RSTRING(arg_key)->ptr + idx)); + if (ptr == (char*)NULL) { + proc = Qnil; + } else { + c = *(inf->type + (ptr - inf->key)); + proc = rb_hash_aref(inf->proc, INT2FIX(c)); + } + } + + if (NIL_P(proc)) { + RARRAY(dst)->ptr[RARRAY(dst)->len++] = RARRAY(val_ary)->ptr[idx]; + } else { + RARRAY(dst)->ptr[RARRAY(dst)->len++] + = rb_funcall(proc, ID_call, 1, RARRAY(val_ary)->ptr[idx]); + } + } + + if (old_gc == Qfalse) rb_gc_enable(); + rb_thread_critical = thr_crit_bup; + + return dst; +} + +static VALUE +cbsubst_inspect(self) + VALUE self; +{ + return rb_str_new2("CallbackSubst"); +} + +static VALUE +substinfo_inspect(self) + VALUE self; +{ + return rb_str_new2("SubstInfo"); +} + +/*************************************/ + +static VALUE +tk_cbe_inspect(self) + VALUE self; +{ + return rb_str_new2("TkCallbackEntry"); +} + +/*************************************/ + +static VALUE +tkobj_path(self) + VALUE self; +{ + return rb_ivar_get(self, ID_at_path); +} + +/*************************************/ +/* release date */ +const char tkutil_release_date[] = TKUTIL_RELEASE_DATE; + +void +Init_tkutil() +{ + volatile VALUE tmp; + + VALUE cTK = rb_define_class("TkKernel", rb_cObject); + VALUE mTK = rb_define_module("TkUtil"); + + /* --------------------- */ + + rb_define_const(mTK, "RELEASE_DATE", + rb_obj_freeze(rb_str_new2(tkutil_release_date))); + + /* --------------------- */ + rb_global_variable(&cMethod); + cMethod = rb_const_get(rb_cObject, rb_intern("Method")); + + ID_path = rb_intern("path"); + ID_at_path = rb_intern("@path"); + ID_to_eval = rb_intern("to_eval"); + ID_to_s = rb_intern("to_s"); + ID_source = rb_intern("source"); + ID_downcase = rb_intern("downcase"); + ID_install_cmd = rb_intern("install_cmd"); + ID_merge_tklist = rb_intern("_merge_tklist"); + ID_call = rb_intern("call"); + + /* --------------------- */ + cCB_SUBST = rb_define_class_under(mTK, "CallbackSubst", rb_cObject); + rb_define_singleton_method(cCB_SUBST, "inspect", cbsubst_inspect, 0); + + cSUBST_INFO = rb_define_class_under(cCB_SUBST, "Info", rb_cObject); + rb_define_singleton_method(cSUBST_INFO, "inspect", substinfo_inspect, 0); + + ID_SUBST_INFO = rb_intern("SUBST_INFO"); + rb_define_singleton_method(cCB_SUBST, "ret_val", cbsubst_ret_val, 1); + rb_define_singleton_method(cCB_SUBST, "scan_args", cbsubst_scan_args, 2); + rb_define_singleton_method(cCB_SUBST, "_get_subst_key", + cbsubst_get_subst_key, 1); + rb_define_singleton_method(cCB_SUBST, "_get_all_subst_keys", + cbsubst_get_all_subst_keys, 0); + rb_define_singleton_method(cCB_SUBST, "_setup_subst_table", + cbsubst_table_setup, 2); + rb_define_singleton_method(cCB_SUBST, "_get_extra_args_tbl", + cbsubst_get_extra_args_tbl, 0); + + rb_define_method(cCB_SUBST, "initialize", cbsubst_initialize, -1); + + cbsubst_init(); + + /* --------------------- */ + rb_global_variable(&cTkCallbackEntry); + cTkCallbackEntry = rb_define_class("TkCallbackEntry", cTK); + rb_define_singleton_method(cTkCallbackEntry, "inspect", tk_cbe_inspect, 0); + + /* --------------------- */ + rb_global_variable(&cTkObject); + cTkObject = rb_define_class("TkObject", cTK); + rb_define_method(cTkObject, "path", tkobj_path, 0); + + /* --------------------- */ + rb_require("tcltklib"); + rb_global_variable(&cTclTkLib); + cTclTkLib = rb_const_get(rb_cObject, rb_intern("TclTkLib")); + ID_split_tklist = rb_intern("_split_tklist"); + ID_toUTF8 = rb_intern("_toUTF8"); + ID_fromUTF8 = rb_intern("_fromUTF8"); + + /* --------------------- */ + rb_define_singleton_method(cTK, "new", tk_s_new, -1); + + /* --------------------- */ + rb_global_variable(&TK_None); + TK_None = rb_obj_alloc(rb_cObject); + rb_define_const(mTK, "None", TK_None); + rb_define_singleton_method(TK_None, "to_s", tkNone_to_s, 0); + rb_define_singleton_method(TK_None, "inspect", tkNone_to_s, 0); + OBJ_FREEZE(TK_None); + + /* --------------------- */ + rb_global_variable(&CALLBACK_TABLE); + CALLBACK_TABLE = rb_hash_new(); + + /* --------------------- */ + rb_define_singleton_method(mTK, "eval_cmd", tk_eval_cmd, -1); + rb_define_singleton_method(mTK, "callback", tk_do_callback, -1); + rb_define_singleton_method(mTK, "install_cmd", tk_install_cmd, -1); + rb_define_singleton_method(mTK, "uninstall_cmd", tk_uninstall_cmd, 1); + rb_define_singleton_method(mTK, "_symbolkey2str", tk_symbolkey2str, 1); + rb_define_singleton_method(mTK, "hash_kv", tk_hash_kv, -1); + rb_define_singleton_method(mTK, "_get_eval_string", + tk_get_eval_string, -1); + rb_define_singleton_method(mTK, "_get_eval_enc_str", + tk_get_eval_enc_str, 1); + + rb_define_singleton_method(mTK, "bool", tcl2rb_bool, 1); + rb_define_singleton_method(mTK, "number", tcl2rb_number, 1); + rb_define_singleton_method(mTK, "string", tcl2rb_string, 1); + rb_define_singleton_method(mTK, "num_or_str", tcl2rb_num_or_str, 1); + + rb_define_method(mTK, "_toUTF8", tk_toUTF8, -1); + rb_define_method(mTK, "_fromUTF8", tk_fromUTF8, -1); + rb_define_method(mTK, "_symbolkey2str", tk_symbolkey2str, 1); + rb_define_method(mTK, "hash_kv", tk_hash_kv, -1); + rb_define_method(mTK, "_get_eval_string", tk_get_eval_string, -1); + rb_define_method(mTK, "_get_eval_enc_str", tk_get_eval_enc_str, 1); + rb_define_method(mTK, "_conv_args", tk_conv_args, -1); + + rb_define_method(mTK, "bool", tcl2rb_bool, 1); + rb_define_method(mTK, "number", tcl2rb_number, 1); + rb_define_method(mTK, "string", tcl2rb_string, 1); + rb_define_method(mTK, "num_or_str", tcl2rb_num_or_str, 1); + + /* --------------------- */ +} -- cgit