thread bugs

git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/branches/ruby_1_3@482 b2dd03c8-39d4-4d8f-98ff-823fe69b080e

12 files changed, 361 insertions, 91 deletions

diff --git a/ext/extmk.rb.in b/ext/extmk.rb.in
index c564b59b70..8090c2ab19 100644
--- a/ext/extmk.rb.in
+++ b/ext/extmk.rb.in
@@ -324,6 +324,19 @@ def create_makefile(target)
     $DLDFLAGS = $DLDFLAGS + " -L" + $topdir
   end
 
+  defflag = ''
+  if PLATFORM =~ /cygwin/ and not $static
+    if File.exist? target + ".def"
+      defflag = "--def=" + target + ".def"
+    end
+    if $libs
+      $libs = $libs + " @LIBRUBYARG@"
+    else
+      $libs = "@LIBRUBYARG@"
+    end
+    $DLDFLAGS = $DLDFLAGS + " -L" + $topdir
+  end
+
   $srcdir = $top_srcdir + "/ext/" + $mdir
   mfile = open("Makefile", "w")
   mfile.printf "\
@@ -342,7 +355,7 @@ CC = @CC@
 prefix = @prefix@
 CFLAGS   = %s -I#{$topdir} -I#{$top_srcdir} -I@includedir@ #{CFLAGS} #$CFLAGS %s
 DLDFLAGS = #$DLDFLAGS #$LDFLAGS
-LDSHARED = @LDSHARED@
+LDSHARED = @LDSHARED@ #{defflag}
 ", if $static then "" else "@CCDLFLAGS@" end, $defs.join(" ")
 
   mfile.printf "\
@@ -367,7 +380,7 @@ archdir = $(pkglibdir)/@arch@
     $objs = []
     for f in Dir["#{$top_srcdir}/ext/#{$mdir}/*.{#{SRC_EXT.join(%q{,})}}"]
       f = File.basename(f)
-      f.sub!(/\.(c|cc)$/, ".o")
+      f.sub!(/(#{SRC_EXT.join(%q{|})})$/, "o")
       $objs.push f
     end
   end
@@ -418,23 +431,21 @@ $(DLLIB): $(OBJS)
 $(DLLIB): $(OBJS)
 	$(LDSHARED) $(DLDFLAGS) -o $(DLLIB) $(OBJS) $(LIBS) $(LOCAL_LIBS)
 "
-  elsif not SRC_EXT.detect{|ext| File.exist?(target + ext)}
-    if PLATFORM == "m68k-human"
-      mfile.printf "\
+  elsif PLATFORM == "m68k-human"
+    mfile.printf "\
 $(DLLIB): $(OBJS)
 	ar cru $(DLLIB) $(OBJS)
 "
-    elsif PLATFORM =~ "-nextstep" || PLATFORM =~ "-openstep" || PLATFORM =~ "-rhapsody"
-      mfile.printf "\
+  elsif PLATFORM =~ "-nextstep" || PLATFORM =~ "-openstep" || PLATFORM =~ "-rhapsody"
+    mfile.printf "\
 $(DLLIB): $(OBJS)
 	cc -r $(CFLAGS) -o $(DLLIB) $(OBJS)
 "
-    else
-      mfile.printf "\
+  else
+    mfile.printf "\
 $(DLLIB): $(OBJS)
 	ld $(DLDFLAGS) -r -o $(DLLIB) $(OBJS)
 "
-    end
   end
 
   if File.exist?("depend")
diff --git a/ext/md5/md5init.c b/ext/md5/md5init.c
index e95e135812..e63258f3f1 100644
--- a/ext/md5/md5init.c
+++ b/ext/md5/md5init.c
@@ -29,8 +29,9 @@ md5_update(obj, str)
     Data_Get_Struct(obj, MD5_CTX, md5);
     MD5Update(md5, str->ptr, str->len);
 
-    return Qnil;
+    return obj;
 }
+
 static VALUE
 md5_digest(obj)
     VALUE obj;
@@ -46,6 +47,26 @@ md5_digest(obj)
 }
 
 static VALUE
+md5_hexdigest(obj)
+    VALUE obj;
+{
+    MD5_CTX *md5, ctx;
+    unsigned char digest[16];
+    char buf[35];
+    char *p = buf;
+    int i;
+
+    Data_Get_Struct(obj, MD5_CTX, md5);
+    ctx = *md5;
+    MD5Final(digest, &ctx);
+
+    for (i=0; i<16; i++) {
+	sprintf(buf+i*2, "%x", digest[i]);
+    }
+    return rb_str_new(buf, 32);
+}
+
+static VALUE
 md5_clone(obj)
     VALUE obj;
 {
@@ -90,5 +111,6 @@ Init_md5()
 
     rb_define_method(cMD5, "update", md5_update, 1);
     rb_define_method(cMD5, "digest", md5_digest, 0);
+    rb_define_method(cMD5, "hexdigest", md5_hexdigest, 0);
     rb_define_method(cMD5, "clone",  md5_clone, 0);
 }
diff --git a/ext/pty/pty.c b/ext/pty/pty.c
index 0d3ba7f060..6462c3c7ca 100644
--- a/ext/pty/pty.c
+++ b/ext/pty/pty.c
@@ -19,6 +19,10 @@
 #include <sys/stropts.h>
 #endif
 
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
 #define	DEVICELEN	16
 
 #if !defined(HAVE_OPENPTY)
diff --git a/ext/readline/extconf.rb b/ext/readline/extconf.rb
index 0bd11bb946..f532f8a21d 100644
--- a/ext/readline/extconf.rb
+++ b/ext/readline/extconf.rb
@@ -16,6 +16,7 @@ if readline_dir
   $LDFLAGS = "-L#{readline_dir}"
 end
 
+have_library("user32", nil) if /cygwin/ === PLATFORM
 have_library("termcap", "tgetnum")
 have_library("curses", "tgetnum")
 if have_header("readline/readline.h") and
diff --git a/ext/socket/addrinfo.h b/ext/socket/addrinfo.h
index 724f800c79..74fae207b9 100644
--- a/ext/socket/addrinfo.h
+++ b/ext/socket/addrinfo.h
@@ -27,6 +27,8 @@
  * SUCH DAMAGE.
  */
 
+#ifndef ADDR_INFO_H
+#define ADDR_INFO_H
 #ifndef HAVE_GETADDRINFO
 
 /* special compatibility hack */
@@ -167,3 +169,4 @@ Standard C system should have one. */
 #endif
 
 #endif
+#endif
diff --git a/ext/socket/depend b/ext/socket/depend
index 09e851498e..df2f0c5d16 100644
--- a/ext/socket/depend
+++ b/ext/socket/depend
@@ -1,3 +1,3 @@
 socket.o : socket.c $(hdrdir)/ruby.h $(hdrdir)/config.h $(hdrdir)/defines.h $(hdrdir)/rubyio.h $(hdrdir)/rubysig.h sockport.h
-getaddrinfo.o: getaddrinfo.c addrinfo.h sockport.h
-getnameinfo.o: getnameinfo.c addrinfo.h sockport.h
+getnameinfo.o: getnameinfo.c $(hdrdir)/config.h addrinfo.h sockport.h
+getaddrinfo.o: getaddrinfo.c $(hdrdir)/config.h addrinfo.h sockport.h
diff --git a/ext/socket/extconf.rb b/ext/socket/extconf.rb
index 37d8de5cbb..1e41c02261 100644
--- a/ext/socket/extconf.rb
+++ b/ext/socket/extconf.rb
@@ -6,8 +6,11 @@ case PLATFORM
 when /mswin32/
   test_func = "WSACleanup"
   have_library("wsock32", "WSACleanup")
-when /cygwin32/
+when /cygwin/
+  $LDFLAGS << " -L/usr/lib" if File.directory?("/usr/lib")
+  $CFLAGS << " -I/usr/include"
   test_func = "socket"
+  have_library("bind", "gethostbyaddr")
 when /beos/
   test_func = "socket"
   have_library("net", "socket")
@@ -252,8 +255,8 @@ if have_getaddrinfo
   $CFLAGS="-DHAVE_GETADDRINFO "+$CFLAGS
 else
   $CFLAGS="-I. "+$CFLAGS
-  $objs += "getaddrinfo.o"
-  $objs += "getnameinfo.o"
+  $objs += ["getaddrinfo.o"]
+  $objs += ["getnameinfo.o"]
   have_func("inet_ntop") or have_func("inet_ntoa")
   have_func("inet_pton") or have_func("inet_aton")
 end
diff --git a/ext/socket/getnameinfo.c b/ext/socket/getnameinfo.c
index f4da5bbf7a..5af329225c 100644
--- a/ext/socket/getnameinfo.c
+++ b/ext/socket/getnameinfo.c
@@ -61,6 +61,12 @@
 #define YES 1
 #define NO  0
 
+struct sockinet {
+	u_char	si_len;
+	u_char	si_family;
+	u_short	si_port;
+};
+
 static struct afd {
 	int a_af;
 	int a_addrlen;
@@ -68,18 +74,18 @@ static struct afd {
 	int a_off;
 } afdl [] = {
 #ifdef INET6
-	{PF_INET6, sizeof(struct in6_addr), sizeof(struct sockaddr_in6),
-		offsetof(struct sockaddr_in6, sin6_addr)},
+#define N_INET6 0
+	{PF_INET6, sizeof(struct in6_addr),
+	 sizeof(struct sockaddr_in6),
+	 offsetof(struct sockaddr_in6, sin6_addr)},
+#define N_INET  1
+#else
+#define N_INET  0
 #endif
-	{PF_INET, sizeof(struct in_addr), sizeof(struct sockaddr_in),
-		offsetof(struct sockaddr_in, sin_addr)},
-	{0, 0, 0},
-};
-
-struct sockinet {
-	u_char	si_len;
-	u_char	si_family;
-	u_short	si_port;
+	{PF_INET, sizeof(struct in_addr),
+	 sizeof(struct sockaddr_in),
+	 offsetof(struct sockaddr_in, sin_addr)},
+	{0, 0, 0, 0},
 };
 
 #define ENI_NOSOCKET 	0
diff --git a/ext/socket/socket.c b/ext/socket/socket.c
index dda7eb06fc..0912ca9dd1 100644
--- a/ext/socket/socket.c
+++ b/ext/socket/socket.c
@@ -583,6 +583,21 @@ thread_write_select(fd)
 }
 
 static int
+ruby_socket(domain, type, proto)
+    int domain, type, proto;
+{
+    int fd;
+
+    fd = socket(domain, type, proto);
+    if (fd < 0) {
+	if (errno == EMFILE || errno == ENFILE) {
+	    rb_gc();
+	    fd = socket(domain, type, proto);
+	}
+    }
+}
+
+static int
 ruby_connect(fd, sockaddr, len, socks)
     int fd;
     struct sockaddr *sockaddr;
@@ -683,11 +698,12 @@ open_inet(class, h, serv, type)
 
     fd = -1;
     for (res = res0; res; res = res->ai_next) {
-	status = socket(res->ai_family, res->ai_socktype, res->ai_protocol);
+	status = ruby_socket(res->ai_family,res->ai_socktype,res->ai_protocol);
 	syscall = "socket(2)";
 	fd = status;
-	if (fd < 0)
+	if (fd < 0) {
 	    continue;
+	}
 	if (type == INET_SERVER) {
 	    status = 1;
 	    setsockopt(fd, SOL_SOCKET, SO_REUSEADDR,
@@ -939,8 +955,10 @@ open_unix(class, path, server)
     OpenFile *fptr;
 
     Check_SafeStr(path);
-    fd = socket(AF_UNIX, SOCK_STREAM, 0);
-    if (fd < 0) rb_sys_fail("socket(2)");
+    fd = ruby_socket(AF_UNIX, SOCK_STREAM, 0);
+    if (fd < 0) {
+	rb_sys_fail("socket(2)");
+    }
 
     MEMZERO(&sockaddr, struct sockaddr_un, 1);
     sockaddr.sun_family = AF_UNIX;
@@ -1017,11 +1035,17 @@ udp_s_open(argc, argv, class)
 {
     VALUE arg;
     int socktype = AF_INET;
+    int fd;
 
     if (rb_scan_args(argc, argv, "01", &arg) == 1) {
 	socktype = NUM2INT(arg);
     }
-    return sock_new(class, socket(socktype, SOCK_DGRAM, 0));
+    fd = ruby_socket(socktype, SOCK_DGRAM, 0);
+    if (fd < 0) {
+	rb_sys_fail("socket(2) - udp");
+    }
+
+    return sock_new(class, fd);
 }
 
 static VALUE
@@ -1312,7 +1336,7 @@ sock_s_open(class, domain, type, protocol)
     int d, t;
 
     setup_domain_and_type(domain, &d, type, &t);
-    fd = socket(d, t, NUM2INT(protocol));
+    fd = ruby_socket(d, t, NUM2INT(protocol));
     if (fd < 0) rb_sys_fail("socket(2)");
 
     return sock_new(class, fd);
@@ -1333,8 +1357,14 @@ sock_s_socketpair(class, domain, type, protocol)
     int d, t, sp[2];
 
     setup_domain_and_type(domain, &d, type, &t);
-    if (socketpair(d, t, NUM2INT(protocol), sp) < 0)
+  again:
+    if (socketpair(d, t, NUM2INT(protocol), sp) < 0) {
+	if (errno == EMFILE || errno == ENFILE) {
+	    rb_gc();
+	    goto again;
+	}
 	rb_sys_fail("socketpair(2)");
+    }
 
     return rb_assoc_new(sock_new(class, sp[0]), sock_new(class, sp[1]));
 #else
@@ -1920,6 +1950,8 @@ Init_socket()
 #endif
 #ifdef AF_INET6
     sock_define_const("AF_INET6", AF_INET6);
+#endif
+#ifdef PF_INET6
     sock_define_const("PF_INET6", PF_INET6);
 #endif
 
diff --git a/ext/socket/sockport.h b/ext/socket/sockport.h
index 3a2007362f..99bec91a1a 100644
--- a/ext/socket/sockport.h
+++ b/ext/socket/sockport.h
@@ -1,6 +1,6 @@
 /************************************************
 
-  sockcomm.h -
+  sockport.h -
 
   $Author$
   $Date$
@@ -8,8 +8,8 @@
 
 ************************************************/
 
-#ifndef SOCKCOMM_H
-#define SOCKCOMM_H
+#ifndef SOCKPORT_H
+#define SOCKPORT_H
 
 #ifndef SA_LEN
 # ifdef HAVE_SA_LEN
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index 5f6f9a0c02..6652b9409a 100644
--- a/ext/tcltklib/tcltklib.c
+++ b/ext/tcltklib/tcltklib.c
@@ -30,6 +30,8 @@ fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); }
 static VALUE eTkCallbackBreak;
 static VALUE eTkCallbackContinue;
 
+static VALUE ip_invoke_real _((int, VALUE*, VALUE));
+
 /* from tkAppInit.c */
 
 /*
@@ -42,55 +44,47 @@ int *tclDummyMathPtr = (int *) matherr;
 
 /*---- module TclTkLib ----*/
 
-/* Tk_ThreadTimer */
-typedef struct {
-    Tcl_TimerToken token;
-    int  flag;
-} Tk_TimerData;
-
-/* timer callback */
-static void
-_timer_for_tcl(clientData)
-    ClientData clientData;
-{
-    Tk_TimerData *timer = (Tk_TimerData*)clientData;
+static VALUE main_thread;
 
-    timer->flag = 0;
-    CHECK_INTS;
+struct invoke_queue {
+    int argc;
+    VALUE *argv;
+    VALUE obj;
+    int done;
+    VALUE result;
+    VALUE thread;
+    struct invoke_queue *next;
+};
 
-    if (timer->flag) {
-      Tk_DeleteTimerHandler(timer->token);
-    }
-    timer->token = Tk_CreateTimerHandler(200, _timer_for_tcl, 
-					 (ClientData)timer);
-    timer->flag = 1;
-}
+static struct invoke_queue *iqueue;
 
 /* execute Tk_MainLoop */
 static VALUE
 lib_mainloop(self)
     VALUE self;
 {
-    Tk_TimerData *timer;
-
-    timer = (Tk_TimerData *)ALLOC(Tk_TimerData);
-    timer->flag = 0;
-    timer->token = Tk_CreateTimerHandler(200, _timer_for_tcl, 
-					 (ClientData)timer);
-    timer->flag = 1;
+    struct invoke_queue *q, *tmp;
+    VALUE thread;
 
     DUMP1("start Tk_Mainloop");
     while (Tk_GetNumMainWindows() > 0) {
-        Tcl_DoOneEvent(0);
+        Tcl_DoOneEvent(TCL_DONT_WAIT);
 	CHECK_INTS;
+	q = iqueue;
+	while (q) {
+	    tmp = q;
+	    q = q->next;
+	    if (!tmp->done) {
+		tmp->done = 1;
+		tmp->result = ip_invoke_real(tmp->argc, tmp->argv, tmp->obj);
+		thread = tmp->thread;
+		tmp = tmp->next;
+		rb_thread_run(thread);
+	    }
+	}
     }
     DUMP1("stop Tk_Mainloop");
 
-    if (timer->flag) {
-	Tk_DeleteTimerHandler(timer->token);
-    }
-    free(timer);
-
     return Qnil;
 }
 
@@ -206,11 +200,11 @@ ip_new(self)
     /* from Tcl_AppInit() */
     DUMP1("Tcl_Init");
     if (Tcl_Init(ptr->ip) == TCL_ERROR) {
-	rb_raise(rb_eRuntimeError, "Tcl_Init");
+	rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
     }
     DUMP1("Tk_Init");
     if (Tk_Init(ptr->ip) == TCL_ERROR) {
-	rb_raise(rb_eRuntimeError, "Tk_Init");
+	rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
     }
     DUMP1("Tcl_StaticPackage(\"Tk\")");
     Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init,
@@ -324,14 +318,13 @@ ip_fromUTF8(self, str, encodename)
 
 
 static VALUE
-ip_invoke(argc, argv, obj)
+ip_invoke_real(argc, argv, obj)
     int argc;
     VALUE *argv;
     VALUE obj;
 {
     struct tcltkip *ptr;	/* tcltkip data struct */
     int i;
-    int object = 0;
     Tcl_CmdInfo info;
     char *cmd;
     char **av = (char **)NULL;
@@ -350,13 +343,10 @@ ip_invoke(argc, argv, obj)
     if (!Tcl_GetCommandInfo(ptr->ip, cmd, &info)) {
 	rb_raise(rb_eNameError, "invalid command name `%s'", cmd);
     }
-#if TCL_MAJOR_VERSION >= 8
-    object = info.isNativeObjectProc;
-#endif
 
     /* memory allocation for arguments of this command */
-    if (object) {
 #if TCL_MAJOR_VERSION >= 8
+    if (info.isNativeObjectProc) {
 	/* object interface */
 	ov = (Tcl_Obj **)ALLOCA_N(Tcl_Obj *, argc+1);
 	for (i = 0; i < argc; ++i) {
@@ -365,8 +355,10 @@ ip_invoke(argc, argv, obj)
 	    Tcl_IncrRefCount(ov[i]);
 	}
 	ov[argc] = (Tcl_Obj *)NULL;
+    } 
+    else
 #endif
-    } else {
+    {
       /* string interface */
 	av = (char **)ALLOCA_N(char *, argc+1);
 	for (i = 0; i < argc; ++i) {
@@ -381,8 +373,8 @@ ip_invoke(argc, argv, obj)
     Tcl_ResetResult(ptr->ip);
 
     /* Invoke the C procedure */
-    if (object) {
 #if TCL_MAJOR_VERSION >= 8
+    if (info.isNativeObjectProc) {
 	int dummy;
 	ptr->return_value = (*info.objProc)(info.objClientData,
 					    ptr->ip, argc, ov);
@@ -395,9 +387,10 @@ ip_invoke(argc, argv, obj)
 	for (i=0; i<argc; i++) {
 	    Tcl_DecrRefCount(ov[i]);
 	}
-#endif
     }
-    else {
+    else
+#endif
+    {
 	ptr->return_value = (*info.proc)(info.clientData,
 					 ptr->ip, argc, av);
     }
@@ -410,6 +403,51 @@ ip_invoke(argc, argv, obj)
     return rb_str_new2(ptr->ip->result);
 }
 
+static VALUE
+ip_invoke(argc, argv, obj)
+    int argc;
+    VALUE *argv;
+    VALUE obj;
+{
+    struct invoke_queue *tmp, *p;
+    VALUE result = rb_thread_current();
+
+    if (result == main_thread) {
+	return ip_invoke_real(argc, argv, obj);
+    }
+    tmp = ALLOC(struct invoke_queue);
+    tmp->obj = obj;
+    tmp->argc = argc;
+    tmp->argv = ALLOC_N(VALUE, argc);
+    MEMCPY(tmp->argv, argv, VALUE, argc);
+    tmp->thread = result;
+    tmp->done = 0;
+
+    tmp->next = iqueue;
+    iqueue = tmp;
+
+    rb_thread_stop();
+    result = tmp->result;
+    if (iqueue == tmp) {
+	iqueue = tmp->next;
+	free(tmp->argv);
+	free(tmp);
+	return result;
+    }
+
+    p = iqueue;
+    while (p->next) {
+	if (p->next == tmp) {
+	    p->next = tmp->next;
+	    free(tmp->argv);
+	    free(tmp);
+	    break;
+	}
+	p = p->next;
+    }
+    return result;
+}
+
 /* get return code from Tcl_Eval() */
 static VALUE
 ip_retval(self)
@@ -454,6 +492,7 @@ Init_tcltklib()
     rb_define_method(ip, "_return_value", ip_retval, 0);
     rb_define_method(ip, "mainloop", lib_mainloop, 0);
 
+    main_thread = rb_thread_current();
 #ifdef __MACOS__
     _macinit();
 #endif
diff --git a/ext/tk/lib/tktext.rb b/ext/tk/lib/tktext.rb
index 3dde30d60d..3d8e4fa405 100644
--- a/ext/tk/lib/tktext.rb
+++ b/ext/tk/lib/tktext.rb
@@ -285,8 +285,8 @@ class TkText<TkTextWin
       end
 
     else
-      if ( key == 'font' || key == 'kanjifont' \
-	  || key == 'latinfont' || key == 'asciifont' )
+      if  key == 'font' || key == 'kanjifont' ||
+	  key == 'latinfont' || key == 'asciifont'
 	tagfont_configure({key=>val})
       else
 	tk_send 'tag', 'configure', tag, "-#{key}", val
@@ -320,7 +320,7 @@ class TkText<TkTextWin
   end
 
   def tag_ranges(tag)
-    l = tk_split_list(tk_send('tag', 'ranges', tag))
+    l = tk_split_simplelist(tk_send('tag', 'ranges', tag))
     r = []
     while key=l.shift
       r.push [key, l.shift]
@@ -329,11 +329,11 @@ class TkText<TkTextWin
   end
 
   def tag_nextrange(tag, first, last=None)
-    tk_split_list(tk_send('tag', 'nextrange', tag, first, last))
+    tk_split_simplelist(tk_send('tag', 'nextrange', tag, first, last))
   end
 
   def tag_prevrange(tag, first, last=None)
-    tk_split_list(tk_send('tag', 'prevrange', tag, first, last))
+    tk_split_simplelist(tk_send('tag', 'prevrange', tag, first, last))
   end
 
   def search_with_length(pat,start,stop=None)
@@ -437,9 +437,19 @@ class TkTextTag<TkObject
     @path = @id = $tk_text_tag
     $tk_text_tag = $tk_text_tag.succ
     #tk_call @t.path, "tag", "configure", @id, *hash_kv(keys)
-    configure(keys) if keys
+    if args != [] then
+      keys = args.pop
+      if keys.kind_of? Hash then
+	add(*args) if args != []
+	configure(keys)
+      else
+	args.push keys
+	add(*args)
+      end
+    end
     @t._addtag id, self
   end
+
   def id
     return @id
   end
@@ -470,11 +480,11 @@ class TkTextTag<TkObject
   end
 
   def nextrange(first, last=None)
-    tk_split_list(tk_call(@t.path, 'tag', 'nextrange', @id, first, last))
+    tk_split_simplelist(tk_call(@t.path, 'tag', 'nextrange', @id, first, last))
   end
 
   def prevrange(first, last=None)
-    tk_split_list(tk_call(@t.path, 'tag', 'prevrange', @id, first, last))
+    tk_split_simplelist(tk_call(@t.path, 'tag', 'prevrange', @id, first, last))
   end
 
   def [](key)
@@ -631,6 +641,18 @@ class TkTextMarkCurrent<TkTextMark
   end
 end
 
+class TkTextMarkAnchor<TkTextMark
+  def initialize(parent,index=nil)
+    if not parent.kind_of?(TkText)
+      fail format("%s need to be TkText", parent.inspect)
+    end
+    @t = parent
+    @path = @id = 'anchor'
+    tk_call @t.path, 'mark', 'set', @id, index if index
+    @t._addtag id, self
+  end
+end
+
 class TkTextWindow<TkObject
   def initialize(parent, index, keys)
     if not parent.kind_of?(TkText)
@@ -726,6 +748,133 @@ class TkTextWindow<TkObject
       }
     end
   end
+
+  def _dump(type, *index)
+    str = tk_send('dump', type, *index)
+    result = []
+    sel = nil
+    i = 0
+    while i < str.size
+      # retrieve key
+      idx = str.index(/ /, i)
+      result.push str[i..(idx-1)]
+      i = idx + 1
+      
+      # retrieve value
+      case result[-1]
+      when 'text'
+	if str[i] == ?{
+	  # text formed as {...}
+	  val, i = _retrieve_braced_text(str, i)
+	  result.push val
+	else
+	  # text which may contain backslahes
+	  val, i = _retrieve_backslashed_text(str, i)
+	  result.push val
+	end
+      else
+	idx = str.index(/ /, i)
+	val = str[i..(idx-1)]
+	case result[-1]
+	when 'mark'
+	  case val
+	  when 'insert'
+	    result.push TkTextMarkInsert.new(self)
+	  when 'current'
+	    result.push TkTextMarkCurrent.new(self)
+	  when 'anchor'
+	    result.push TkTextMarkAnchor.new(self)
+	  else
+	    result.push tk_tcl2rb(val)
+	  end
+	when 'tagon'
+	  if val == 'sel'
+	    if sel
+	      result.push sel
+	    else
+	      result.push TkTextTagSel.new(self)
+	    end
+	  else
+	    result.push tk_tcl2rb val
+	  end
+	when 'tagoff'
+	    result.push tk_tcl2rb sel
+	when 'window'
+	  result.push tk_tcl2rb val
+	end
+	i = idx + 1
+      end
+
+      # retrieve index
+      idx = str.index(/ /, i)
+      if idx
+	result.push str[i..(idx-1)]
+	i = idx + 1
+      else
+	result.push str[i..-1]
+	break
+      end
+    end
+    
+    kvis = []
+    until result.empty?
+      kvis.push [result.shift, result.shift, result.shift]
+    end
+    kvis  # result is [[key1, value1, index1], [key2, value2, index2], ...]
+  end
+  private :_dump
+
+  def _retrieve_braced_text(str, i)
+    cnt = 0
+    idx = i
+    while idx < str.size
+      case str[idx]
+      when ?{
+	cnt += 1
+      when ?}
+	cnt -= 1
+	if cnt == 0
+	  break
+	end
+      end
+      idx += 1
+    end
+    return str[i+1..idx-1], idx + 2
+  end
+  private :_retrieve_braced_text
+
+  def _retrieve_backslashed_text(str, i)
+    j = i
+    idx = nil
+    loop {
+      idx = str.index(/ /, j)
+      if str[idx-1] == ?\\
+	j += 1
+      else
+	break
+      end
+    }
+    val = str[i..(idx-1)]
+    val.gsub!(/\\( |\{|\})/, '\1')
+    return val, idx + 1
+  end
+  private :_retrieve_backslashed_text
+
+  def dump_all(*index)
+    _dump('-all', *index)
+  end
+  def dump_mark(*index)
+    _dump('-mark', *index)
+  end
+  def dump_tag(*index)
+    _dump('-tag', *index)
+  end
+  def dump_text(*index)
+    _dump('-text', *index)
+  end
+  def dump_window(*index)
+    _dump('-window', *index)
+  end
 end
 
 class TkTextImage<TkObject