This commit was manufactured by cvs2svn to create branch 'RUBY'.

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

.cvsignore

@@ -0,0 +1,17 @@
+parse.c
+newver.rb
+ruby
+miniruby
+README.fat-patch
+config.cache
+config.h
+config.log
+config.status
+Makefile
+ppack
+archive
+*.orig
+*.rej
+*.bak
+*.sav
+*~

COPYING

@@ -0,0 +1,248 @@
+		    GNU GENERAL PUBLIC LICENSE
+		     Version 1, February 1989
+
+ Copyright (C) 1989 Free Software Foundation, Inc.
+                    675 Mass Ave, Cambridge, MA 02139, USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The license agreements of most software companies try to keep users
+at the mercy of those companies.  By contrast, our General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  The
+General Public License applies to the Free Software Foundation's
+software and to any other program whose authors commit to using it.
+You can use it for your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Specifically, the General Public License is designed to make
+sure that you have the freedom to give away or sell copies of free
+software, that you receive source code or can get it if you want it,
+that you can change the software or use pieces of it in new free
+programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of a such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must tell them their rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any program or other work which
+contains a notice placed by the copyright holder saying it may be
+distributed under the terms of this General Public License.  The
+"Program", below, refers to any such program or work, and a "work based
+on the Program" means either the Program or any work containing the
+Program or a portion of it, either verbatim or with modifications.  Each
+licensee is addressed as "you".
+
+  1. You may copy and distribute verbatim copies of the Program's source
+code as you receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice and
+disclaimer of warranty; keep intact all the notices that refer to this
+General Public License and to the absence of any warranty; and give any
+other recipients of the Program a copy of this General Public License
+along with the Program.  You may charge a fee for the physical act of
+transferring a copy.
+
+  2. You may modify your copy or copies of the Program or any portion of
+it, and copy and distribute such modifications under the terms of Paragraph
+1 above, provided that you also do the following:
+
+    a) cause the modified files to carry prominent notices stating that
+    you changed the files and the date of any change; and
+
+    b) cause the whole of any work that you distribute or publish, that
+    in whole or in part contains the Program or any part thereof, either
+    with or without modifications, to be licensed at no charge to all
+    third parties under the terms of this General Public License (except
+    that you may choose to grant warranty protection to some or all
+    third parties, at your option).
+
+    c) If the modified program normally reads commands interactively when
+    run, you must cause it, when started running for such interactive use
+    in the simplest and most usual way, to print or display an
+    announcement including an appropriate copyright notice and a notice
+    that there is no warranty (or else, saying that you provide a
+    warranty) and that users may redistribute the program under these
+    conditions, and telling the user how to view a copy of this General
+    Public License.
+
+    d) You may charge a fee for the physical act of transferring a
+    copy, and you may at your option offer warranty protection in
+    exchange for a fee.
+
+Mere aggregation of another independent work with the Program (or its
+derivative) on a volume of a storage or distribution medium does not bring
+the other work under the scope of these terms.
+
+  3. You may copy and distribute the Program (or a portion or derivative of
+it, under Paragraph 2) in object code or executable form under the terms of
+Paragraphs 1 and 2 above provided that you also do one of the following:
+
+    a) accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of
+    Paragraphs 1 and 2 above; or,
+
+    b) accompany it with a written offer, valid for at least three
+    years, to give any third party free (except for a nominal charge
+    for the cost of distribution) a complete machine-readable copy of the
+    corresponding source code, to be distributed under the terms of
+    Paragraphs 1 and 2 above; or,
+
+    c) accompany it with the information you received as to where the
+    corresponding source code may be obtained.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form alone.)
+
+Source code for a work means the preferred form of the work for making
+modifications to it.  For an executable file, complete source code means
+all the source code for all modules it contains; but, as a special
+exception, it need not include source code for modules which are standard
+libraries that accompany the operating system on which the executable
+file runs, or for standard header files or definitions files that
+accompany that operating system.
+
+  4. You may not copy, modify, sublicense, distribute or transfer the
+Program except as expressly provided under this General Public License.
+Any attempt otherwise to copy, modify, sublicense, distribute or transfer
+the Program is void, and will automatically terminate your rights to use
+the Program under this License.  However, parties who have received
+copies, or rights to use copies, from you under this General Public
+License will not have their licenses terminated so long as such parties
+remain in full compliance.
+
+  5. By copying, distributing or modifying the Program (or any work based
+on the Program) you indicate your acceptance of this license to do so,
+and all its terms and conditions.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the original
+licensor to copy, distribute or modify the Program subject to these
+terms and conditions.  You may not impose any further restrictions on the
+recipients' exercise of the rights granted herein.
+
+  7. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of the license which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+the license, you may choose any version ever published by the Free Software
+Foundation.
+
+  8. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+	Appendix: How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to humanity, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these
+terms.
+
+  To do so, attach the following notices to the program.  It is safest to
+attach them to the start of each source file to most effectively convey
+the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) 19yy  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 1, or (at your option)
+    any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) 19xx name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the
+appropriate parts of the General Public License.  Of course, the
+commands you use may be called something other than `show w' and `show
+c'; they could even be mouse-clicks or menu items--whatever suits your
+program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  program `Gnomovision' (a program to direct compilers to make passes
+  at assemblers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+That's all there is to it!

ext/gtk/MANIFEST

@@ -0,0 +1,18 @@
+MANIFEST
+extconf.rb
+gtk.c
+test.rb
+test.xpm
+test0.rb
+test1.rb
+test2.rb
+test3.rb
+test4.rb
+test5.rb
+test6.rb
+test7.rb
+test8.rb
+test9.rb
+testa.rb
+testb.rb
+testc.rb

ext/gtk/extconf.rb

@@ -0,0 +1,6 @@
+require "mkmf"
+if have_library("glib", "g_print") and
+    have_library("gdk", "gdk_init") and
+    have_library("gtk", "gtk_init")
+  create_makefile("gtk")
+end

ext/gtk/test.rb

@@ -0,0 +1,96 @@
+require 'gtk'
+
+def create_menu(depth)
+  return nil if depth < 1
+  
+  menu = Gtk::Menu::new()
+  group = nil
+  submenu = nil
+
+  for i in 0..4
+    buf = sprintf("item %2d - %d", depth, i+1)
+#    menuitem = Gtk::MenuItem::new(buf)
+    menuitem = Gtk::RadioMenuItem.new(group, buf)
+    group = menuitem.group
+    if depth % 2
+      menuitem.set_show_toggle TRUE
+    end
+    menu.append menuitem
+    menuitem.show
+    if depth > 0
+      unless submenu
+	submenu = create_menu(depth - 1)
+      end
+      menuitem.set_submenu submenu
+    end
+  end
+  return menu
+end
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.signal_connect("destroy") do
+  exit
+end
+window.signal_connect("delete_event") do
+  exit
+end
+window.set_title("menus")
+window.border_width(0)
+
+box1 = Gtk::VBox::new(FALSE, 0)
+window.add box1
+box1.show
+
+menubar = Gtk::MenuBar::new()
+box1.pack_start menubar, FALSE, TRUE, 0
+menubar.show
+
+menu = create_menu(2)
+menuitem = Gtk::MenuItem::new("test\nline2")
+menuitem.set_submenu menu
+menubar.append menuitem
+menuitem.show
+
+menuitem = Gtk::MenuItem::new("foo")
+menuitem.set_submenu menu
+menubar.append menuitem
+menuitem.show
+
+menuitem = Gtk::MenuItem::new("bar")
+menuitem.set_submenu menu
+menubar.append menuitem
+menuitem.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width 10
+box1.pack_start box2, TRUE, TRUE, 0
+box2.show
+
+optionmenu = Gtk::OptionMenu::new()
+optionmenu.set_menu create_menu(1)
+optionmenu.set_history 4
+box2.pack_start optionmenu, TRUE, TRUE, 0
+optionmenu.show
+
+separator = Gtk::HSeparator::new()
+box1.pack_start(separator, FALSE, TRUE, 0)
+separator.show
+
+box2 = Gtk::HBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, FALSE, TRUE, 0)
+box2.show
+
+button = Gtk::Button::new("close")
+button.signal_connect("clicked") do
+  window.destroy
+  exit
+end
+box2.pack_start(button, TRUE, TRUE, 0)
+button.set_flags(Gtk::CAN_DEFAULT);
+button.grab_default
+button.show
+
+window.show
+
+Gtk::main()

ext/gtk/test.xpm

@@ -0,0 +1,92 @@
+/* XPM */
+static char *openfile[] = {
+/* width height num_colors chars_per_pixel */
+"    20    19       66            2",
+/* colors */
+".. c None",
+".# c #000000",
+".a c #dfdfdf",
+".b c #7f7f7f",
+".c c #006f6f",
+".d c #00efef",
+".e c #009f9f",
+".f c #004040",
+".g c #00bfbf",
+".h c #ff0000",
+".i c #ffffff",
+".j c #7f0000",
+".k c #007070",
+".l c #00ffff",
+".m c #00a0a0",
+".n c #004f4f",
+".o c #00cfcf",
+".p c #8f8f8f",
+".q c #6f6f6f",
+".r c #a0a0a0",
+".s c #7f7f00",
+".t c #007f7f",
+".u c #5f5f5f",
+".v c #707070",
+".w c #00f0f0",
+".x c #009090",
+".y c #ffff00",
+".z c #0000ff",
+".A c #00afaf",
+".B c #00d0d0",
+".C c #00dfdf",
+".D c #005f5f",
+".E c #00b0b0",
+".F c #001010",
+".G c #00c0c0",
+".H c #000f0f",
+".I c #00007f",
+".J c #005050",
+".K c #002f2f",
+".L c #dfcfcf",
+".M c #dfd0d0",
+".N c #006060",
+".O c #00e0e0",
+".P c #00ff00",
+".Q c #002020",
+".R c #dfc0c0",
+".S c #008080",
+".T c #001f1f",
+".U c #003f3f",
+".V c #007f00",
+".W c #00000f",
+".X c #000010",
+".Y c #00001f",
+".Z c #000020",
+".0 c #00002f",
+".1 c #000030",
+".2 c #00003f",
+".3 c #000040",
+".4 c #00004f",
+".5 c #000050",
+".6 c #00005f",
+".7 c #000060",
+".8 c #00006f",
+".9 c #000070",
+"#. c #7f7f80",
+"## c #9f9f9f",
+/* pixels */
+"........................................",
+"........................................",
+"........................................",
+".......................#.#.#............",
+".....................#.......#...#......",
+"...............................#.#......",
+".......#.#.#.................#.#.#......",
+".....#.y.i.y.#.#.#.#.#.#.#..............",
+".....#.i.y.i.y.i.y.i.y.i.#..............",
+".....#.y.i.y.i.y.i.y.i.y.#..............",
+".....#.i.y.i.y.#.#.#.#.#.#.#.#.#.#.#....",
+".....#.y.i.y.#.s.s.s.s.s.s.s.s.s.#......",
+".....#.i.y.#.s.s.s.s.s.s.s.s.s.#........",
+".....#.y.#.s.s.s.s.s.s.s.s.s.#..........",
+".....#.#.s.s.s.s.s.s.s.s.s.#............",
+".....#.#.#.#.#.#.#.#.#.#.#..............",
+"........................................",
+"........................................",
+"........................................"
+};

ext/gtk/test0.rb

@@ -0,0 +1,13 @@
+require 'gtk'
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.border_width(10)
+button = Gtk::Button::new("Hello World")
+button.signal_connect("clicked") do
+  print "hello world\n"
+  exit
+end
+window.add(button)
+button.show
+window.show
+Gtk::main()

ext/gtk/test1.rb

@@ -0,0 +1,41 @@
+require 'gtk'
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.set_title("entry")
+window.border_width(0)
+
+box1 = Gtk::VBox::new(FALSE, 0)
+window.add(box1)
+box1.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, TRUE, TRUE, 0)
+box2.show
+
+entry = Gtk::Entry::new()
+entry.set_text("hello world")
+box2.pack_start(entry, TRUE, TRUE, 0)
+entry.show
+
+separator = Gtk::HSeparator::new()
+box1.pack_start(separator, FALSE, TRUE, 0)
+separator.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, FALSE, TRUE, 0)
+box2.show
+
+button = Gtk::Button::new("close")
+button.signal_connect("clicked") do
+  window.destroy
+  exit
+end
+box2.pack_start(button, TRUE, TRUE, 0)
+button.set_flags(Gtk::CAN_DEFAULT);
+button.grab_default
+button.show
+window.show
+
+Gtk::main()

ext/gtk/test2.rb

@@ -0,0 +1,89 @@
+require 'gtk'
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.set_title("list")
+window.border_width(0)
+
+box1 = Gtk::VBox::new(FALSE, 0)
+window.add(box1)
+box1.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, TRUE, TRUE, 0)
+box2.show
+
+scrolled_win = Gtk::ScrolledWindow::new()
+scrolled_win.set_policy(Gtk::POLICY_AUTOMATIC,Gtk::POLICY_AUTOMATIC)
+box2.pack_start(scrolled_win, TRUE, TRUE, 0)
+scrolled_win.show
+
+list = Gtk::List::new()
+list.set_selection_mode(Gtk::SELECTION_MULTIPLE)
+list.set_selection_mode(Gtk::SELECTION_BROWSE)
+scrolled_win.add(list)
+list.show
+
+for i in [
+    "hello",
+    "world",
+    "blah",
+    "foo",
+    "bar",
+    "argh",
+    "spencer",
+    "is a",
+    "wussy",
+    "programmer",
+  ]
+  list_item = Gtk::ListItem::new(i)
+  list.add(list_item)
+  list_item.show
+end
+
+button = Gtk::Button::new("add")
+button.set_flags(Gtk::CAN_FOCUS);
+i = 1
+button.signal_connect("clicked") do
+  list_item = Gtk::ListItem::new(format("added item %d", i))
+  list.add(list_item)
+  list_item.show
+  i += 1
+end
+box2.pack_start(button, FALSE, TRUE, 0)
+button.show
+
+button = Gtk::Button::new("remove")
+button.set_flags(Gtk::CAN_FOCUS);
+button.signal_connect("clicked") do
+  tmp_list = list.selection
+  list.remove_items(tmp_list)
+  for i in tmp_list
+    i.destroy
+  end
+end
+box2.pack_start(button, FALSE, TRUE, 0)
+button.show
+
+separator = Gtk::HSeparator::new()
+box1.pack_start(separator, FALSE, TRUE, 0)
+separator.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, FALSE, TRUE, 0)
+box2.show
+
+button = Gtk::Button::new("close")
+button.signal_connect("clicked") do
+  window.destroy
+  exit
+end
+box2.pack_start(button, TRUE, TRUE, 0)
+button.set_flags(Gtk::CAN_DEFAULT);
+button.grab_default
+button.show
+
+window.show
+
+Gtk::main()

ext/gtk/test3.rb

@@ -0,0 +1,16 @@
+require 'gtk'
+
+window = Gtk::FileSelection::new("file selection dialog")
+window.position(Gtk::WIN_POS_MOUSE)
+window.border_width(0)
+
+window.ok_button.signal_connect("clicked") do
+  print window.get_filename, "\n"
+end
+window.cancel_button.signal_connect("clicked") do
+  window.destroy
+  exit
+end
+window.show
+
+Gtk::main()

ext/gtk/test4.rb

@@ -0,0 +1,77 @@
+require 'gtk'
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.set_title("notebook")
+window.border_width(0)
+
+box1 = Gtk::VBox::new(FALSE, 0)
+window.add(box1)
+box1.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, TRUE, TRUE, 0)
+box2.show
+
+notebook = Gtk::Notebook::new()
+notebook.set_tab_pos(Gtk::POS_TOP)
+box2.pack_start(notebook, TRUE, TRUE, 0)
+notebook.show
+
+for i in 1..5
+  frame = Gtk::Frame::new(format("Page %d", i))
+  frame.border_width(10)
+  frame.set_usize(200, 150)
+  frame.show
+
+  label = Gtk::Label::new(format("Box %d", i))
+  frame.add label
+  label.show
+
+  label = Gtk::Label::new(format("Tab %d", i))
+  notebook.append_page frame, label
+end
+
+separator = Gtk::HSeparator::new()
+box1.pack_start(separator, FALSE, TRUE, 0)
+separator.show
+
+box2 = Gtk::HBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, FALSE, TRUE, 0)
+box2.show
+
+button = Gtk::Button::new("close")
+button.signal_connect("clicked") do
+  window.destroy
+  exit
+end
+box2.pack_start(button, TRUE, TRUE, 0)
+button.set_flags(Gtk::CAN_DEFAULT);
+button.grab_default
+button.show
+
+button = Gtk::Button::new("next")
+button.signal_connect("clicked") do
+  notebook.next_page
+end
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+button = Gtk::Button::new("prev")
+button.signal_connect("clicked") do
+  notebook.prev_page
+end
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+button = Gtk::Button::new("rotate")
+button.signal_connect("clicked") do
+  notebook.set_tab_pos((notebook.tab_pos+1)%4)
+end
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+window.show
+
+Gtk::main()

ext/gtk/test5.rb

@@ -0,0 +1,63 @@
+require 'gtk'
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.set_title("buttons")
+window.border_width(0)
+
+box1 = Gtk::VBox::new(FALSE, 0)
+window.add(box1)
+box1.show
+
+table = Gtk::Table::new(3, 3, FALSE)
+table.set_row_spacings(5)
+table.set_col_spacings(5)
+table.border_width(10)
+box1.pack_start(table, TRUE, TRUE, 0)
+table.show
+
+button = []
+0.upto(8) do |i|
+  button.push Gtk::Button::new("button"+(i+1))
+end
+0.upto(8) do |i|
+  button[i].signal_connect("clicked") do |w|
+    if button[i+1].visible?
+      button[i+1].hide
+    else
+      button[i+1].show
+    end
+  end
+  button[i].show
+end
+table.attach(button[0], 0, 1, 0, 1, nil, nil, 0, 0)
+table.attach(button[1], 1, 2, 1, 2, nil, nil, 0, 0)
+table.attach(button[2], 2, 3, 2, 3, nil, nil, 0, 0)
+table.attach(button[3], 0, 1, 2, 3, nil, nil, 0, 0)
+table.attach(button[4], 2, 3, 0, 1, nil, nil, 0, 0)
+table.attach(button[5], 1, 2, 2, 3, nil, nil, 0, 0)
+table.attach(button[6], 1, 2, 0, 1, nil, nil, 0, 0)
+table.attach(button[7], 2, 3, 1, 2, nil, nil, 0, 0)
+table.attach(button[8], 0, 1, 1, 2, nil, nil, 0, 0)
+
+separator = Gtk::HSeparator::new()
+box1.pack_start(separator, FALSE, TRUE, 0)
+separator.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, FALSE, TRUE, 0)
+box2.show
+
+close = Gtk::Button::new("close")
+close.signal_connect("clicked") do
+  window.destroy
+  exit
+end
+box2.pack_start(close, TRUE, TRUE, 0)
+close.set_flags(Gtk::CAN_DEFAULT);
+close.grab_default
+close.show
+
+window.show
+
+Gtk::main()

ext/gtk/test6.rb

@@ -0,0 +1,49 @@
+require 'gtk'
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.set_title("toggle buttons")
+window.border_width(0)
+
+box1 = Gtk::VBox::new(FALSE, 0)
+window.add(box1)
+box1.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, TRUE, TRUE, 0)
+box2.show
+
+button = Gtk::ToggleButton::new("button1")
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+button = Gtk::ToggleButton::new("button2")
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+button = Gtk::ToggleButton::new("button3")
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+separator = Gtk::HSeparator::new()
+box1.pack_start(separator, FALSE, TRUE, 0)
+separator.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, FALSE, TRUE, 0)
+box2.show
+
+close = Gtk::Button::new("close")
+close.signal_connect("clicked") do
+  window.destroy
+  exit
+end
+box2.pack_start(close, TRUE, TRUE, 0)
+close.set_flags(Gtk::CAN_DEFAULT);
+close.grab_default
+close.show
+
+window.show
+
+Gtk::main()

ext/gtk/test7.rb

@@ -0,0 +1,49 @@
+require 'gtk'
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.set_title("check buttons")
+window.border_width(0)
+
+box1 = Gtk::VBox::new(FALSE, 0)
+window.add(box1)
+box1.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, TRUE, TRUE, 0)
+box2.show
+
+button = Gtk::CheckButton::new("button1")
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+button = Gtk::CheckButton::new("button2")
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+button = Gtk::CheckButton::new("button3")
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+separator = Gtk::HSeparator::new()
+box1.pack_start(separator, FALSE, TRUE, 0)
+separator.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, FALSE, TRUE, 0)
+box2.show
+
+close = Gtk::Button::new("close")
+close.signal_connect("clicked") do
+  window.destroy
+  exit
+end
+box2.pack_start(close, TRUE, TRUE, 0)
+close.set_flags(Gtk::CAN_DEFAULT);
+close.grab_default
+close.show
+
+window.show
+
+Gtk::main()

ext/gtk/test8.rb

@@ -0,0 +1,49 @@
+require 'gtk'
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.set_title("radio buttons")
+window.border_width(0)
+
+box1 = Gtk::VBox::new(FALSE, 0)
+window.add(box1)
+box1.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width 10
+box1.pack_start(box2, TRUE, TRUE, 0)
+box2.show
+
+button = Gtk::RadioButton::new("button1")
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+button = Gtk::RadioButton::new(button, "button2")
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+button = Gtk::RadioButton::new(button, "button3")
+box2.pack_start(button, TRUE, TRUE, 0)
+button.show
+
+separator = Gtk::HSeparator::new()
+box1.pack_start(separator, FALSE, TRUE, 0)
+separator.show
+
+box2 = Gtk::VBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, FALSE, TRUE, 0)
+box2.show
+
+close = Gtk::Button::new("close")
+close.signal_connect("clicked") do
+  window.destroy
+  exit
+end
+box2.pack_start(close, TRUE, TRUE, 0)
+close.set_flags(Gtk::CAN_DEFAULT);
+close.grab_default
+close.show
+
+window.show
+
+Gtk::main()

ext/gtk/test9.rb

@@ -0,0 +1,98 @@
+require 'gtk'
+
+def create_bbox_window(horizontal, title, pos, spacing, cw, ch, layout)
+  window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+  window.set_title(title)
+  window.signal_connect("destroy") do
+    window.destroy
+  end
+  window.signal_connect("delete_event") do
+    window.hide
+    window.destroy
+  end
+  if horizontal
+    window.set_usize(550, 60)
+    window.set_uposition(150, pos)
+  else
+    window.set_usize(150, 400)
+    window.set_uposition(pos, 200)
+  end
+  box1 = Gtk::VBox::new(FALSE, 0)
+  window.add box1
+  box1.show
+  if horizontal
+    bbox = Gtk::HButtonBox::new()
+  else
+    bbox = Gtk::VButtonBox::new()
+  end
+  bbox.set_layout layout
+  bbox.set_spacing spacing
+  bbox.set_child_size cw, ch
+  bbox.show
+  box1.border_width 25
+  box1.pack_start(bbox, TRUE, TRUE, 0)
+  button = Gtk::Button::new("OK")
+  bbox.add button
+  button.signal_connect("clicked") do
+    window.hide
+    window.destroy
+  end
+  button.show
+
+  button = Gtk::Button::new("Cancel")
+  bbox.add button
+  button.signal_connect("clicked") do
+    window.hide
+    window.destroy
+  end
+  button.show
+
+  button = Gtk::Button::new("Help")
+  bbox.add button
+  button.show
+
+  window.show
+end
+
+def test_hbbox
+  create_bbox_window(TRUE, "Spread", 50, 40, 85, 25, Gtk::BUTTONBOX_SPREAD);
+  create_bbox_window(TRUE, "Edge", 250, 40, 85, 28, Gtk::BUTTONBOX_EDGE);
+  create_bbox_window(TRUE, "Start", 450, 40, 85, 25, Gtk::BUTTONBOX_START);
+  create_bbox_window(TRUE, "End", 650, 15, 30, 25, Gtk::BUTTONBOX_END);
+end
+
+def test_vbbox
+  create_bbox_window(FALSE, "Spread", 50, 40, 85, 25, Gtk::BUTTONBOX_SPREAD);
+  create_bbox_window(FALSE, "Edge", 250, 40, 85, 28, Gtk::BUTTONBOX_EDGE);
+  create_bbox_window(FALSE, "Start", 450, 40, 85, 25, Gtk::BUTTONBOX_START);
+  create_bbox_window(FALSE, "End", 650, 15, 30, 25, Gtk::BUTTONBOX_END);
+end
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.signal_connect("delete_event") do
+  window.destroy
+  exit
+end
+window.set_title("button box")
+window.border_width(20)
+
+bbox = Gtk::HButtonBox::new()
+window.add(bbox)
+bbox.show
+
+button = Gtk::Button::new("Horizontal")
+def button.clicked(*args)
+  test_hbbox
+end
+bbox.add button
+button.show
+
+button = Gtk::Button::new("Vertical")
+def button.clicked(*args)
+  test_vbbox
+end
+bbox.add button
+button.show
+window.show
+
+Gtk::main()

ext/gtk/testa.rb

@@ -0,0 +1,78 @@
+require 'gtk'
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.set_title("toolbar test")
+window.set_policy(TRUE, TRUE, TRUE)
+window.signal_connect("destroy") do
+  exit
+end
+window.signal_connect("delete_event") do
+  exit
+end
+window.border_width(0)
+window.realize
+
+toolbar = Gtk::Toolbar::new(Gtk::ORIENTATION_HORIZONTAL, Gtk::TOOLBAR_BOTH)
+toolbar.append_item "Horizontal", "Horizontal toolbar layout",
+  Gtk::Pixmap::new(*Gdk::Pixmap::create_from_xpm(window.window,
+						 nil,
+						 #window.style.bg[Gtk::STATE_NORMAL],
+						 "test.xpm")), nil do
+  toolbar.set_orientation Gtk::ORIENTATION_HORIZONTAL
+end
+toolbar.append_item "Vertival", "Vertical toolbar layout",
+  Gtk::Pixmap::new(*Gdk::Pixmap::create_from_xpm(window.window,
+						 nil, #window.style.bg[Gtk::STATE_NORMAL],
+						 "test.xpm")), nil do
+  toolbar.set_orientation Gtk::ORIENTATION_VERTICAL
+end
+toolbar.append_space
+toolbar.append_item "Icons", "Only show toolbar icons",
+  Gtk::Pixmap::new(*Gdk::Pixmap::create_from_xpm(window.window,
+						 nil, #window.style.bg[Gtk::STATE_NORMAL],
+						 "test.xpm")), nil do
+  toolbar.set_style Gtk::TOOLBAR_ICONS
+end
+toolbar.append_item "Text", "Only show toolbar text",
+  Gtk::Pixmap::new(*Gdk::Pixmap::create_from_xpm(window.window,
+						 nil,#window.style.bg[Gtk::STATE_NORMAL],
+						 "test.xpm")), nil do
+  toolbar.set_style Gtk::TOOLBAR_TEXT
+end
+toolbar.append_item "Both", "Show toolbar icons and text",
+  Gtk::Pixmap::new(*Gdk::Pixmap::create_from_xpm(window.window,
+						 nil, #window.style.bg[Gtk::STATE_NORMAL],
+						 "test.xpm")), nil do
+  toolbar.set_style Gtk::TOOLBAR_BOTH
+end
+toolbar.append_space
+toolbar.append_item "Small", "User small spaces",
+  Gtk::Pixmap::new(*Gdk::Pixmap::create_from_xpm(window.window,
+						 nil,#window.style.bg[Gtk::STATE_NORMAL],
+						 "test.xpm")), nil do
+  toolbar.set_space_size 5
+end
+toolbar.append_item "Big", "User big spaces",
+  Gtk::Pixmap::new(*Gdk::Pixmap::create_from_xpm(window.window,
+						 nil,#window.style.bg[Gtk::STATE_NORMAL],
+						 "test.xpm")), nil do
+  toolbar.set_space_size 10
+end
+toolbar.append_space
+toolbar.append_item "Enable", "Enable tooltips",
+  Gtk::Pixmap::new(*Gdk::Pixmap::create_from_xpm(window.window,
+						 nil,#window.style.bg[Gtk::STATE_NORMAL],
+						 "test.xpm")), nil do
+  toolbar.set_tooltips TRUE
+end
+toolbar.append_item "Disable", "Disable tooltips",
+  Gtk::Pixmap::new(*Gdk::Pixmap::create_from_xpm(window.window,
+						 nil,#window.style.bg[Gtk::STATE_NORMAL],
+						 "test.xpm")), nil do
+  toolbar.set_tooltips FALSE
+end
+window.add toolbar
+toolbar.show
+window.show
+
+Gtk::main()

ext/gtk/testb.rb

@@ -0,0 +1,78 @@
+require 'gtk'
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.signal_connect("destroy") do
+  exit
+end
+window.signal_connect("delete_event") do
+  exit
+end
+window.set_title("buttons")
+window.border_width(0)
+
+box1 = Gtk::VBox::new(FALSE, 0)
+window.add box1
+box1.show
+
+box2 = Gtk::HBox::new(FALSE, 5)
+box2.border_width 10
+box1.pack_start box2, TRUE, TRUE, 0
+box2.show
+
+label = Gtk::Label::new("Hello World")
+frame = Gtk::Frame::new("Frame 1")
+box2.pack_start frame, TRUE, TRUE, 0
+frame.show
+
+box3 = Gtk::VBox::new(FALSE, 5)
+box3.border_width 5
+frame.add box3
+box3.show
+
+button = Gtk::Button::new("switch")
+button.signal_connect("clicked") do
+  label.reparent box3
+end
+box3.pack_start button, FALSE, TRUE, 0
+button.show
+box3.pack_start label, FALSE, TRUE, 0
+label.show
+
+frame = Gtk::Frame::new("Frame 2")
+box2.pack_start frame, TRUE, TRUE, 0
+frame.show
+
+box4 = Gtk::VBox::new(FALSE, 5)
+box4.border_width 5
+frame.add box4
+box4.show
+
+button = Gtk::Button::new("switch")
+button.signal_connect("clicked") do
+  label.reparent box4
+end
+box4.pack_start button, FALSE, TRUE, 0
+button.show
+
+separator = Gtk::HSeparator::new()
+box1.pack_start(separator, FALSE, TRUE, 0)
+separator.show
+
+box2 = Gtk::HBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, FALSE, TRUE, 0)
+box2.show
+
+button = Gtk::Button::new("close")
+button.signal_connect("clicked") do
+  window.destroy
+  exit
+end
+box2.pack_start(button, TRUE, TRUE, 0)
+button.set_flags(Gtk::CAN_DEFAULT);
+button.grab_default
+button.show
+
+window.show
+
+Gtk::main()

ext/gtk/testc.rb

@@ -0,0 +1,64 @@
+require 'gtk'
+
+window = Gtk::Window::new(Gtk::WINDOW_TOPLEVEL)
+window.signal_connect("destroy") do
+  exit
+end
+window.signal_connect("delete_event") do
+  exit
+end
+window.set_title("pixmap")
+window.border_width(0)
+window.realize
+
+box1 = Gtk::VBox::new(FALSE, 0)
+window.add box1
+box1.show
+
+box2 = Gtk::HBox::new(FALSE, 10)
+box2.border_width 10
+box1.pack_start box2, TRUE, TRUE, 0
+box2.show
+
+button = Gtk::Button::new()
+box2.pack_start button, FALSE, FALSE, 0
+button.show
+
+style = button.style
+pixmap, mask = Gdk::Pixmap::create_from_xpm(window.window,
+					    nil,
+					    #style.bg[Gtk::STATE_NORMAL],
+					    "test.xpm")
+pixmapwid = Gtk::Pixmap::new(pixmap, mask)
+label = Gtk::Label::new("Pixmap\ntest")
+box3 = Gtk::HBox::new(FALSE, 0)
+box3.border_width 2
+box3.add pixmapwid
+box3.add label
+button.add box3
+pixmapwid.show
+label.show
+box3.show
+
+separator = Gtk::HSeparator::new()
+box1.pack_start(separator, FALSE, TRUE, 0)
+separator.show
+
+box2 = Gtk::HBox::new(FALSE, 10)
+box2.border_width(10)
+box1.pack_start(box2, FALSE, TRUE, 0)
+box2.show
+
+button = Gtk::Button::new("close")
+button.signal_connect("clicked") do
+  window.destroy
+  exit
+end
+box2.pack_start(button, TRUE, TRUE, 0)
+button.set_flags(Gtk::CAN_DEFAULT);
+button.grab_default
+button.show
+
+window.show
+
+Gtk::main()

ext/tcltklib/MANIFEST

@@ -0,0 +1,15 @@
+MANIFEST
+README.euc
+MANUAL.euc
+tcltklib.c
+depend
+extconf.rb
+lib/tcltk.rb
+demo/lines1.rb
+demo/lines0.tcl
+demo/lines2.rb
+sample/sample1.rb
+sample/sample2.rb
+sample/maru.gif
+sample/batsu.gif
+sample/sample0.rb

ext/tcltklib/MANUAL.euc

@@ -0,0 +1,124 @@
+(tof)
+	MANUAL.euc
+		Sep. 19, 1997	Y. Shigehiro
+
+以下, 「tcl/tk」という表記は, tclsh や wish を実現している, 一般でいう
+ところの tcl/tk を指します. 「tcltk ライブラリ」, 「tcltklib ライブラ
+リ」という表記は, 本パッケージに含まれる ruby 用のライブラリを指します.
+
+<< tcltk ライブラリ >>
+
+tcl/tk の C ライブラリを利用するための高(中?)水準インターフェースを提
+供します.
+
+このライブラリは ruby から tcl/tk ライブラリを利用するためのもので, 内
+部で tcltklib ライブラリを利用しています.
+
+[説明]
+
+tcl/tk インタプリタでは, ウィジェットに何か指示を送るには, ウィジェッ
+ト名に続いてパラメータを書きます. したがって, ウィジェットがオブジェク
+トであり, それに対してメソッドを送っている, とみなすことができます. さ
+て, tcl/tk インタプリタでは, 組み込みコマンドも, 前述のウィジェットと
+同じような書式の命令で実行されます. すなわち, コマンドもオブジェクトで
+あると考えることができます.
+
+このような考えに基づき, tcltk ライブラリでは, tcl/tk のコマンドやウィ
+ジェットに対応するオブジェクトを生成します. オブジェクトに対するメソッ
+ド呼び出しは, e() メソッドにより実行されます. 例えば, tcl/tk の info 
+コマンドに対応する ruby のオブジェクトが info という名前であるとすると,
+tcl/tk の
+	info commands
+という命令は tcltk ライブラリでは
+	info.e("commands")
+と記述されます. また, 「.」というウィジェット (wish 実行時に自動的に生
+成されるルートウィジェット) に対応する ruby のオブジェクトが root とい
+う名前であるとすると,
+	. configure -height 300 -width 300
+という tcl/tk の命令は
+	root.e("configure -height 300 -width 300")
+と記述されます. このような記述は, 見ためには美しくありませんが, そして, 
+スクリプトを読む人には見づらいかも知れませんが, 実際にスクリプトを書い
+てみると予想外に手軽です.
+
+[使用法]
+
+1. ライブラリを読み込む.
+     require "tcltk"
+
+2. tcl/tk インタプリタを生成する.
+     ip = TclTkInterpreter.new()
+
+3. tcl/tk のコマンドに対応するオブジェクトを変数に代入しておく.
+     # コマンドに対応するオブジェクトが入った Hash を取り出す.
+     c = ip.commands()
+     # 使いたいコマンドに対応するオブジェクトを個別の変数に代入する.
+     bind, button, info, wm = c.indexes("bind", "button", "info", "wm")
+
+4. 必要な処理を行う.
+     詳しくは, サンプルを参照のこと.
+
+5. 準備ができたら, イベントループに入る.
+     TclTk.mainloop()
+
+(( 以下, モジュール, クラス等の説明を書く予定.))
+
+
+
+<< tcltklib ライブラリ >>
+
+tcl/tk の C ライブラリを利用するための低水準インターフェースを提供しま
+す.
+
+コンパイル/実行には, tcl/tk の C ライブラリが必要です.
+
+[説明]
+
+このライブラリを用いると, ruby から tcl/tk の C ライブラリを利用できま
+す. 具体的には, ruby インタプリタから tcl/tk インタプリタを呼び出すこ
+とができます. さらに, その(ruby インタプリタから呼び出した) tcl/tk イ
+ンタプリタから, 逆に ruby インタプリタを呼び出すこともできます.
+
+[使用法]
+
+require "tcltklib" すると, 以下のモジュール, クラスが利用可能です.
+
+モジュール TclTkLib
+    tcl/tk ライブラリを呼び出すメソッドを集めたモジュールです. ただし,
+    tcl/tk インタプリタ関係のメソッドはクラス TclTkIp にあります.
+
+  モジュールメソッド mainloop()
+      Tk_MainLoop を実行します. 全ての tk のウインドウが無くなると終了
+      します(例えば, tcl/tk で書くところの "destroy ." をした場合等).
+    引数: 無し
+    戻り値: nil
+
+クラス TclTkIp
+    インスタンスが tcl/tk のインタプリタに対応します. tcl/tk のライブ
+    ラリの仕様通り, インスタンスを複数個生成しても正しく動作します(そ
+    んなことをする必要はあまり無いはずですが). インタプリタは wish の
+    tcl/tk コマンドを実行できます. さらに, 以下のコマンドを実行できま
+    す.
+      コマンド ruby
+	引数を ruby で実行します(ruby_eval_string を実行します). 引数
+	は 1 つでなければなりません. 戻り値は ruby の実行結果です.
+	ruby の実行結果は nil か String でなければなりません.
+
+  クラスメソッド new()
+      TclTkIp クラスのインスタンスを生成します
+    引数: 無し
+    戻り値 (TclTkIp): 生成されたインスタンス
+
+  メソッド _eval(script)
+      インタプリタで script を評価します(Tcl_Eval を実行します). 前述
+      のように, ruby コマンドにより script 内から ruby スクリプトを実
+      行できます.
+    引数: script (String) - インタプリタで評価するスクリプト文字列
+    戻り値 (String): 評価結果 ((Tcl_Interp *)->result)
+
+  メソッド _return_value()
+      直前の Tcl_Eval の戻り値を返します. 0(TCL_OK) で正常終了です.
+    引数: 無し
+    戻り値 (Fixnum): 直前の Tcl_Eval() が返した値.
+
+(eof)

ext/tcltklib/README.euc

@@ -0,0 +1,133 @@
+(tof)
+	tcltk ライブラリ
+	tcltklib ライブラリ
+		Sep. 19, 1997	Y. Shigehiro
+
+以下, 「tcl/tk」という表記は, tclsh や wish を実現している, 一般でいう
+ところの tcl/tk を指します. 「tcltk ライブラリ」, 「tcltklib ライブラ
+リ」という表記は, 本パッケージに含まれる ruby 用のライブラリを指します.
+
+[ファイルについて]
+
+README.euc : このファイル(注意, 特徴, インストールの方法).
+MANUAL.euc : マニュアル.
+
+lib/, ext/ : ライブラリの実体.
+
+sample/ : マニュアル代わりのサンプルプログラム.
+sample/sample0.rb : tcltklib ライブラリのテスト.
+sample/sample1.rb : tcltk ライブラリのテスト.
+    tcl/tk (wish) でできそうなことを一通り書いてみました.
+sample/sample2.rb : tcltk ライブラリのサンプル.
+    maeda shugo (shugo@po.aianet.ne.jp) 氏による
+    (`rb.tk' で書かれていた) ruby のサンプルプログラム
+	http://www.aianet.or.jp/~shugo/ruby/othello.rb.gz
+    を tcltk ライブラリを使うように, 機械的に変更してみました.
+
+demo/ : 100 本の線を 100 回描くデモプログラム.
+    最初に空ループの時間を測定し, 続いて実際に線を引く時間を測定します.
+    tcl/tk は(再)描画のときに backing store を使わずに律義に 10000 本(?)
+    線を引くので, (再)描画を始めると, マシンがかなり重くなります.
+demo/lines0.tcl : wish 用のスクリプト.
+demo/lines1.rb : `tk.rb' 用のスクリプト.
+demo/lines2.rb : tcltk ライブラリ用のスクリプト.
+
+[注意]
+
+コンパイル/実行には, tcl/tk の C ライブラリが必要です.
+
+このライブラリは,
+
+	ruby-1.0-970701, ruby-1.0-970911, ruby-1.0-970919
+	FreeBSD 2.2.2-RELEASE
+	およびそのパッケージ jp-tcl-7.6.tgz, jp-tk-4.2.tgz
+
+で作成/動作確認しました. 他の環境では動作するかどうかわかりません.
+
+TclTkLib.mainloop を実行中に Control-C が効かないのは不便なので, ruby 
+のソースを参考に, #include "sig.h" して trap_immediate を操作していま
+すが, ruby の README.EXT にも書いてないのに, こんなことをして良いのか
+どうかわかりません.
+
+-d オプションでデバッグ情報を表示させるために, ruby のソースを参考に,
+debug という大域変数を参照していますが, ruby の README.EXT にも書いて
+ないのに, こんなことをして良いのかどうかわかりません.
+
+extconf.rb は書きましたが, (いろいろな意味で)これで良いのか良く分かり
+ません.
+
+[特徴]
+
+ruby から tcl/tk ライブラリを利用できます.
+
+tcl/tk インタプリタのスクリプトは, 機械的に tcltk ライブラリ用の ruby 
+スクリプトに変換できます.
+
+(`tk.rb' との違い)
+
+1. tcl/tk インタプリタのスクリプトが, どのように, tcltk ライブラリ用の 
+   ruby スクリプトに変換されるかが理解できれば, マニュアル類が無いに等
+   しい `tk.rb' とは異なり
+
+	tcl/tk のマニュアルやオンラインドキュメントを用いて
+
+   効率良くプログラミングを行うことができます.
+   記述方法がわからない, コマンドに与えるパラメータがわからない...
+     - Canvas.new { ... } と, なぜイテレータブロックを書けるの??
+     - Canvas の bbox は数値のリストを返すのに, xview は文字列を返すの??
+   と, いちいち, ライブラリのソースを追いかける必要はありません.
+
+2. 個々の機能(オプション)を個別処理によりサポートしており, そのためサ
+   ポートしていない機能は使うことができない(本当は使えないこともないの
+   ですが) `tk.rb' とは異なり, tcl/tk インタプリタで可能なことは
+
+	ほとんど
+
+   ruby からも実行できます. 現在, ruby から実行できないことが確認され
+   ているのは,
+
+	bind コマンドでスクリプトを追加する構文
+	「bind tag sequence +script」
+                            ^
+
+   のみです.
+     - `. configure -width' をしようとして, `Tk.root.height()' と書い
+      たのに, `undefined method `height'' と怒られてしまった. tk.rb を
+      読んでみて, ガーン. できないのか...
+   ということはありません.
+
+3. wish プロセスを起動しプロセス間通信で wish を利用する `tk.rb' とは
+   異なり, tcl/tk の C ライブラリをリンクし
+
+	より高速に (といっても, 思った程は速くないですが)
+
+   処理を行います.
+
+4. `tk.rb' ほど, 高水準なインターフェースを備えていないため, tcl/tk イ
+   ンタプリタの生成等
+
+	何から何まで自分で記述
+
+   しなければなりません(その代わり, tcl/tk ライブラリの仕様通り,
+   tcl/tk インタプリタを複数生成することもできますが).
+   インターフェースは(おそらく) ruby の思想に沿ったものではありません. 
+   また, スクリプトの記述は
+
+	ダサダサ
+
+   です. スクリプトは, 一見, 読みづらいものとなります. が, 書く人にとっ
+   ては, それほど煩わしいものではないと思います.
+
+[インストールの方法]
+
+0. ruby のソースファイル(ruby-1.0-なんたら.tgz)を展開しておきます.
+
+1. ruby-1.0-なんたら/ext に ext/tcltklib をコピーします.
+	cp -r ext/tcltklib ???/ruby-1.0-なんたら/ext/
+
+2. ruby のインストール法に従い make 等をします.
+
+3. ruby のライブラリ置場に lib/* をコピーします.
+	cp lib/* /usr/local/lib/ruby/
+
+(eof)

ext/tcltklib/demo/lines0.tcl

@@ -0,0 +1,42 @@
+#! /usr/local/bin/wish
+
+proc drawlines {} {
+    puts [clock format [clock seconds]]
+
+    for {set j 0} {$j < 100} {incr j} {
+	puts -nonewline "*"
+	flush stdout
+	if {$j & 1} {
+	    set c "blue"
+	} {
+	    set c "red"
+	}
+	for {set i 0} {$i < 100} {incr i} {
+#	    .a create line $i 0 0 [expr 500 - $i] -fill $c
+	}
+    }
+
+    puts [clock format [clock seconds]]
+
+    for {set j 0} {$j < 100} {incr j} {
+	puts -nonewline "*"
+	flush stdout
+	if {$j & 1} {
+	    set c "blue"
+	} {
+	    set c "red"
+	}
+	for {set i 0} {$i < 100} {incr i} {
+	    .a create line $i 0 0 [expr 500 - $i] -fill $c
+	}
+    }
+
+    puts [clock format [clock seconds]]
+#    destroy .
+}
+
+canvas .a -height 500 -width 500
+button .b -text draw -command drawlines
+pack .a .b -side left
+
+# eof

ext/tcltklib/demo/lines1.rb

@@ -0,0 +1,54 @@
+#! /usr/local/bin/ruby
+
+require "tk"
+
+def drawlines()
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+#      TkcLine.new($a, i, 0, 0, 500 - i, "-fill", col)
+    end
+  end
+
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+      TkcLine.new($a, i, 0, 0, 500 - i, "-fill", col)
+    end
+  end
+
+  print Time.now, "\n"
+#  Tk.root.destroy
+end
+
+$a = TkCanvas.new{
+  height(500)
+  width(500)
+}
+
+$b = TkButton.new{
+  text("draw")
+  command(proc{drawlines()})
+}
+
+TkPack.configure($a, $b, {"side"=>"left"})
+
+Tk.mainloop
+
+# eof

ext/tcltklib/demo/lines2.rb

@@ -0,0 +1,50 @@
+#! /usr/local/bin/ruby
+
+require "tcltk"
+
+def drawlines()
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+#      $a.e("create line", i, 0, 0, 500 - i, "-fill", col)
+    end
+  end
+
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+      $a.e("create line", i, 0, 0, 500 - i, "-fill", col)
+    end
+  end
+
+  print Time.now, "\n"
+#  $ip.commands()["destroy"].e($root)
+end
+
+$ip = TclTkInterpreter.new()
+$root = $ip.rootwidget()
+$a = TclTkWidget.new($ip, $root, "canvas", "-height 500 -width 500")
+$c = TclTkCallback.new($ip, proc{drawlines()})
+$b = TclTkWidget.new($ip, $root, "button", "-text draw -command", $c)
+
+$ip.commands()["pack"].e($a, $b, "-side left")
+
+TclTk.mainloop
+
+# eof

ext/tcltklib/depend

@@ -0,0 +1 @@
+tcltklib.o: tcltklib.c $(hdrdir)/ruby.h $(hdrdir)/config.h $(hdrdir)/defines.h

ext/tcltklib/extconf.rb

@@ -0,0 +1,79 @@
+# extconf.rb for tcltklib
+
+have_library("socket", "socket")
+have_library("nsl", "gethostbyname")
+
+def search_file(var, include, *path)
+  pwd = Dir.getwd
+  begin
+    for i in path.reverse!
+      dir = Dir[i]
+      for path in dir
+	Dir.chdir path
+	files = Dir[include]
+	if files.size > 0
+	  var << path
+	  return files.pop
+	end
+      end
+    end
+  ensure
+    Dir.chdir pwd
+  end
+end
+
+$includes = []
+search_file($includes, 
+	    "tcl.h",
+	    "/usr/include/tcl*",
+	    "/usr/include",
+	    "/usr/local/include/tcl*",
+	    "/usr/local/include")
+search_file($includes, 
+	    "tk.h",
+	    "/usr/include/tk*",
+	    "/usr/include",
+	    "/usr/local/include/tk*",
+	    "/usr/local/include")
+search_file($includes, 
+	    "X11/Xlib.h",
+	    "/usr/include",
+	    "/usr/X11*/include",
+	    "/usr/include",
+	    "/usr/X11*/include")
+
+$CFLAGS = "-Wall " + $includes.collect{|path| "-I" + path}.join(" ")
+
+$libraries = []
+tcllibfile = search_file($libraries,
+			 "libtcl{,7*,8*}.{a,so}",
+			 "/usr/lib",
+			 "/usr/local/lib")
+if tcllibfile
+  tcllibfile.sub!(/^lib/, '')
+  tcllibfile.sub!(/\.(a|so)$/, '')
+end
+tklibfile =  search_file($libraries,
+			 "libtk{,4*,8*}.{a,so}",
+			 "/usr/lib",
+			 "/usr/local/lib")
+if tklibfile
+  tklibfile.sub!(/^lib/, '')
+  tklibfile.sub!(/\.(a|so)$/, '')
+end
+search_file($libraries,
+	    "libX11.{a,so}",
+	    "/usr/lib",
+	    "/usr/X11*/lib")
+
+$LDFLAGS = $libraries.collect{|path| "-L" + path}.join(" ")
+
+have_library("dl", "dlopen")
+if have_header("tcl.h") &&
+    have_header("tk.h") &&
+    have_library("X11", "XOpenDisplay") &&
+    have_library("m", "log") &&
+    have_library(tcllibfile, "Tcl_FindExecutable") &&
+    have_library(tklibfile, "Tk_Init")
+  create_makefile("tcltklib")
+end

ext/tcltklib/lib/tcltk.rb

@@ -0,0 +1,388 @@
+# tof
+
+#### tcltk ライブラリ
+####	Sep. 5, 1997	Y. Shigehiro
+
+require "tcltklib"
+
+################
+
+# module TclTk: tcl/tk のライブラリ全体で必要になるものを集めたもの
+# (主に, 名前空間の点から module にする使う.)
+module TclTk
+
+  # 単にここに書けば最初に 1 度実行されるのか??
+
+  # 生成した一意な名前を保持しておく連想配列を初期化する.
+  @namecnt = {}
+
+  # コールバックを保持しておく連想配列を初期化する.
+  @callback = {}
+end
+
+# TclTk.mainloop(): TclTkLib.mainloop() を呼ぶ.
+def TclTk.mainloop()
+  print("mainloop: start\n") if $DEBUG
+  TclTkLib.mainloop()
+  print("mainloop: end\n") if $DEBUG
+end
+
+# TclTk.deletecallbackkey(ca): コールバックを TclTk module から取り除く.
+#     tcl/tk インタプリタにおいてコールバックが取り消されるわけではない.
+#     これをしないと, 最後に TclTkInterpreter が GC できない.
+#     (GC したくなければ, 別に, これをしなくても良い.)
+#   ca: コールバック(TclTkCallback)
+def TclTk.deletecallbackkey(ca)
+  print("deletecallbackkey: ", ca.to_s(), "\n") if $DEBUG
+  @callback.delete(ca.to_s)
+end
+
+# TclTk.dcb(ca, wid, W): 配列に入っている複数のコールバックに対して
+#     TclTk.deletecallbackkey() を呼ぶ.
+#     トップレベルの <Destroy> イベントのコールバックとして呼ぶためのもの.
+#   ca: コールバック(TclTkCallback) の Array
+#   wid: トップレベルのウィジェット(TclTkWidget)
+#   w: コールバックに %W で与えられる, ウインドウに関するパラメータ(String)
+def TclTk.dcb(ca, wid, w)
+  if wid.to_s() == w
+    ca.each{|i|
+      TclTk.deletecallbackkey(i)
+    }
+  end
+end
+
+# TclTk._addcallback(ca): コールバックを登録する.
+#   ca: コールバック(TclTkCallback)
+def TclTk._addcallback(ca)
+  print("_addcallback: ", ca.to_s(), "\n") if $DEBUG
+  @callback[ca.to_s()] = ca
+end
+
+# TclTk._callcallback(key, arg): 登録したコールバックを呼び出す.
+#   key: コールバックを選択するキー (TclTkCallback が to_s() で返す値)
+#   arg: tcl/tk インタプリタからのパラメータ
+def TclTk._callcallback(key, arg)
+  print("_callcallback: ", @callback[key].inspect, "\n") if $DEBUG
+  @callback[key]._call(arg)
+  # コールバックからの返り値はどうせ捨てられる.
+  # String を返さないと, rb_eval_string() がエラーになる.
+  return ""
+end
+
+# TclTk._newname(prefix): 一意な名前(String)を生成して返す.
+#   prefix: 名前の接頭語
+def TclTk._newname(prefix)
+  # 生成した名前のカウンタは @namecnt に入っているので, 調べる.
+  if !@namecnt.key?(prefix)
+    # 初めて使う接頭語なので初期化する.
+    @namecnt[prefix] = 1
+  else
+    # 使ったことのある接頭語なので, 次の名前にする.
+    @namecnt[prefix] += 1
+  end
+  return "#{prefix}#{@namecnt[prefix]}"
+end
+
+################
+
+# class TclTkInterpreter: tcl/tk のインタプリタ
+class TclTkInterpreter
+
+  # initialize(): 初期化.
+  def initialize()
+    # インタプリタを生成する.
+    @ip = TclTkIp.new()
+
+    # インタプリタに ruby_fmt コマンドを追加する.
+    # ruby_fmt コマンドとは, 後ろの引数を format コマンドで処理して
+    # ruby コマンドに渡すものである.
+    # (なお, ruby コマンドは, 引数を 1 つしかとれない.)
+    if $DEBUG
+      @ip._eval("proc ruby_fmt {fmt args} { puts \"ruby_fmt: $fmt $args\" ; ruby [format $fmt $args] }")
+    else
+      @ip._eval("proc ruby_fmt {fmt args} { ruby [format $fmt $args] }")
+    end
+
+    # @ip._get_eval_string(*args): tcl/tk インタプリタで評価する
+    #     文字列(String)を生成して返す.
+    #   *args: tcl/tk で評価するスクリプト(に対応するオブジェクト列)
+    def @ip._get_eval_string(*args)
+      argstr = ""
+      args.each{|arg|
+	argstr += " " if argstr != ""
+	# もし to_eval() メソッドが
+	if (arg.respond_to?(:to_eval))
+	  # 定義されていればそれを呼ぶ.
+	  argstr += arg.to_eval()
+	else
+	  # 定義されていなければ to_s() を呼ぶ.
+	  argstr += arg.to_s()
+	end
+      }
+      return argstr
+    end
+
+    # @ip._eval_args(*args): tcl/tk インタプリタで評価し,
+    #     その結果(String)を返す.
+    #   *args: tcl/tk で評価するスクリプト(に対応するオブジェクト列)
+    def @ip._eval_args(*args)
+      # インタプリタで評価する文字列を求める.
+      argstr = _get_eval_string(*args)
+
+      # インタプリタで評価する.
+      print("_eval: \"", argstr, "\"") if $DEBUG
+      res = _eval(argstr)
+      if $DEBUG
+	print(" -> \"", res, "\"\n")
+      elsif  _return_value() != 0
+	print(res, "\n")
+      end
+      fail(%Q/can't eval "#{argstr}"/) if _return_value() != 0
+      return res
+    end
+
+    # tcl/tk のコマンドに対応するオブジェクトを生成し, 連想配列に入れておく.
+    @commands = {}
+    # tcl/tk インタプリタに登録されているすべてのコマンドに対して,
+    @ip._eval("info command").split(/ /).each{|comname|
+      if comname =~ /^[.]/
+	# コマンドがウィジェット(のパス名)の場合は
+	# TclTkWidget のインスタンスを作って連想配列に入れる.
+	@commands[comname] = TclTkWidget.new(@ip, comname)
+      else
+	# そうでない場合は
+	# TclTkCommand のインスタンスを作って連想配列に入れる.
+	@commands[comname] = TclTkCommand.new(@ip, comname)
+      end
+    }
+  end
+
+  # commands(): tcl/tk のコマンドに対応するオブジェクトを Hash に
+  #     入れたものを返す.
+  def commands()
+    return @commands
+  end
+
+  # rootwidget(): ルートウィジェット(TclTkWidget)を返す.
+  def rootwidget()
+    return @commands["."]
+  end
+
+  # _tcltkip(): @ip(TclTkIp) を返す.
+  def _tcltkip()
+    return @ip
+  end
+
+  # method_missing(id, *args): 未定義のメソッドは tcl/tk のコマンドとみなして
+  #     実行し, その結果(String)を返す.
+  #   id: メソッドのシンボル
+  #   *args: コマンドの引数
+  def method_missing(id, *args)
+    # もし, メソッドの tcl/tk コマンドが
+    if @commands.key?(id.id2name)
+      # あれば, 実行して結果を返す.
+      return @commands[id.id2name].e(*args)
+    else
+      # 無ければもともとの処理.
+      super
+    end
+  end
+end
+
+# class TclTkObject: tcl/tk のオブジェクト
+# (基底クラスとして使う.
+#  tcltk ライブラリを使う人が TclTkObject.new() することはないはず.)
+class TclTkObject
+
+  # initialize(ip, exp): 初期化.
+  #   ip: インタプリタ(TclTkIp)
+  #   exp: tcl/tk での表現形
+  def initialize(ip, exp)
+    fail("type is not TclTkIp") if !ip.kind_of?(TclTkIp)
+    @ip = ip
+    @exp = exp
+  end
+
+  # to_s(): tcl/tk での表現形(String)を返す.
+  def to_s()
+    return @exp
+  end
+end
+
+# class TclTkCommand: tcl/tk のコマンド
+# (tcltk ライブラリを使う人が TclTkCommand.new() することはないはず.
+#  TclTkInterpreter:initialize() から new() される.)
+class TclTkCommand < TclTkObject
+
+  # e(*args): コマンドを実行し, その結果(String)を返す.
+  #     (e は exec または eval の e.)
+  #   *args: コマンドの引数
+  def e(*args)
+    return @ip._eval_args(to_s(), *args)
+  end
+end
+
+# class TclTkLibCommand: tcl/tk のコマンド
+# (ライブラリにより実現されるコマンドで, tcl/tk インタプリタに最初から
+#  存在しないものは, インタプリタの commands() では生成できない.
+#  そのようなものに対し, コマンドの名前から TclTkCommand オブジェクトを
+#  生成する.
+class TclTkLibCommand < TclTkCommand
+
+  # initialize(ip, name): 初期化
+  #   ip: インタプリタ(TclTkInterpreter)
+  #   name: コマンド名 (String)
+  def initialize(ip, name)
+    super(ip._tcltkip, name)
+  end
+end
+
+# class TclTkVariable: tcl/tk の変数
+class TclTkVariable < TclTkObject
+
+  # initialize(interp, dat): 初期化.
+  #   interp: インタプリタ(TclTkInterpreter)
+  #   dat: 設定する値(String)
+  #       nil なら, 設定しない.
+  def initialize(interp, dat)
+    # tcl/tk での表現形(変数名)を自動生成する.
+    exp = TclTk._newname("v_")
+    # TclTkObject を初期化する.
+    super(interp._tcltkip(), exp)
+    # set コマンドを使うのでとっておく.
+    @set = interp.commands()["set"]
+    # 値を設定する.
+    set(dat) if dat
+  end
+
+  # tcl/tk の set を使えば, 値の設定/参照はできるが,
+  # それだけではなんなので, 一応, メソッドをかぶせたものも用意しておく.
+
+  # set(data): tcl/tk の変数に set を用いて値を設定する.
+  #   data: 設定する値
+  def set(data)
+    @set.e(to_s(), data.to_s())
+  end
+
+  # get(): tcl/tk の変数の値(String)を set を用いて読みだし返す.
+  def get()
+    return @set.e(to_s())
+  end
+end
+
+# class TclTkWidget: tcl/tk のウィジェット
+class TclTkWidget < TclTkCommand
+
+  # initialize(*args): 初期化.
+  #   *args: パラメータ
+  def initialize(*args)
+    if args[0].kind_of?(TclTkIp)
+      # 最初の引数が TclTkIp の場合:
+
+      # 既に tcl/tk に定義されているウィジェットに TclTkWidget の構造を
+      # かぶせる. (TclTkInterpreter:initialize() から使われる.)
+
+      # パラメータ数が 2 でなければエラー.
+      fail("illegal # of parameter") if args.size != 2
+
+      # ip: インタプリタ(TclTkIp)
+      # exp: tcl/tk での表現形
+      ip, exp = args
+
+      # TclTkObject を初期化する.
+      super(ip, exp)
+    elsif args[0].kind_of?(TclTkInterpreter)
+      # 最初の引数が TclTkInterpreter の場合:
+
+      # 親ウィジェットから新たなウィジェトを生成する.
+
+      # interp: インタプリタ(TclTkInterpreter)
+      # parent: 親ウィジェット
+      # command: ウィジェットを生成するコマンド(label 等)
+      # *args: command に渡す引数
+      interp, parent, command, *args = args
+
+      # ウィジェットの名前を作る.
+      exp = parent.to_s()
+      exp += "." if exp !~ /[.]$/
+      exp += TclTk._newname("w_")
+      # TclTkObject を初期化する.
+      super(interp._tcltkip(), exp)
+      # ウィジェットを生成する.
+      res = @ip._eval_args(command, exp, *args)
+#      fail("can't create Widget") if res != exp
+      # tk_optionMenu では, ボタン名を exp で指定すると
+      # res にメニュー名を返すので res != exp となる.
+    else
+      fail("first parameter is not TclTkInterpreter")
+    end
+  end
+end
+
+# class TclTkCallback: tcl/tk のコールバック
+class TclTkCallback < TclTkObject
+
+  # initialize(interp, pr, arg): 初期化.
+  #   interp: インタプリタ(TclTkInterpreter)
+  #   pr: コールバック手続き(Proc)
+  #   arg: pr のイテレータ変数に渡す文字列
+  #       tcl/tk の bind コマンドではパラメータを受け取るために % 置換を
+  #       用いるが, pr の内部で % を書いてもうまくいかない.
+  #       arg に文字列を書いておくと, その置換結果を, pr で
+  #       イテレータ変数を通して受け取ることができる.
+  #       scrollbar コマンドの -command オプションのように
+  #       何も指定しなくてもパラメータが付くコマンドに対しては,
+  #       arg を指定してはならない.
+  def initialize(interp, pr, arg = nil)
+    # tcl/tk での表現形(変数名)を自動生成する.
+    exp = TclTk._newname("c_")
+    # TclTkObject を初期化する.
+    super(interp._tcltkip(), exp)
+    # パラメータをとっておく.
+    @pr = pr
+    @arg = arg
+    # モジュールに登録しておく.
+    TclTk._addcallback(self)
+  end
+
+  # to_eval(): @ip._eval_args で評価するときの表現形(String)を返す.
+  def to_eval()
+    if @arg
+      # %s は ruby_fmt より前に bind により置換されてしまうので
+      # %%s としてある. したがって, これは bind 専用.
+      s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%%s")} #{@arg}}/
+    else
+      s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%s")}}/
+    end
+
+    return s
+  end
+
+  # _call(arg): コールバックを呼び出す.
+  #   arg: コールバックに渡されるパラメータ
+  def _call(arg)
+    @pr.call(arg)
+  end
+end
+
+# class TclTkImage: tcl/tk のイメージ
+class TclTkImage < TclTkCommand
+
+  # initialize(interp, t, *args): 初期化.
+  #     イメージの生成は TclTkImage.new() で行うが,
+  #     破壊は image delete で行う. (いまいちだけど仕方が無い.)
+  #   interp: インタプリタ(TclTkInterpreter)
+  #   t: イメージのタイプ (photo, bitmap, etc.)
+  #   *args: コマンドの引数
+  def initialize(interp, t, *args)
+    # tcl/tk での表現形(変数名)を自動生成する.
+    exp = TclTk._newname("i_")
+    # TclTkObject を初期化する.
+    super(interp._tcltkip(), exp)
+    # イメージを生成する.
+    res = @ip._eval_args("image create", t, exp, *args)
+    fail("can't create Image") if res != exp
+  end
+end
+
+# eof

ext/tcltklib/sample/sample0.rb

@@ -0,0 +1,39 @@
+#! /usr/local/bin/ruby -vd
+
+# tcltklib ライブラリのテスト
+
+require "tcltklib"
+
+def test
+  # インタプリタを生成する
+  ip1 = TclTkIp.new()
+
+  # 評価してみる
+  print ip1._return_value().inspect, "\n"
+  print ip1._eval("puts {abc}").inspect, "\n"
+
+  # ボタンを作ってみる
+  print ip1._return_value().inspect, "\n"
+  print ip1._eval("button .lab -text exit -command \"destroy .\"").inspect,
+    "\n"
+  print ip1._return_value().inspect, "\n"
+  print ip1._eval("pack .lab").inspect, "\n"
+  print ip1._return_value().inspect, "\n"
+
+  # インタプリタから ruby コマンドを評価してみる
+#  print ip1._eval(%q/ruby {print "print by ruby\n"}/).inspect, "\n"
+  print ip1._eval(%q+puts [ruby {print "print by ruby\n"; "puts by tcl/tk"}]+).inspect, "\n"
+  print ip1._return_value().inspect, "\n"
+
+  # もう一つインタプリタを生成してみる
+  ip2 = TclTkIp.new()
+  ip2._eval("button .lab -text test -command \"puts test ; destroy .\"")
+  ip2._eval("pack .lab")
+
+  TclTkLib.mainloop
+end
+
+test
+GC.start
+
+print "exit\n"

ext/tcltklib/sample/sample1.rb

@@ -0,0 +1,634 @@
+#! /usr/local/bin/ruby -d
+#! /usr/local/bin/ruby
+# -d オプションを付けると, デバッグ情報を表示する.
+
+# tcltk ライブラリのサンプル
+
+# まず, ライブラリを require する.
+require "tcltk"
+
+# 以下は, Test1 のインスタンスの initialize() で,
+# tcl/tk に関する処理を行う例である.
+# 必ずしもそのようにする必要は無く,
+# (もし, そうしたければ) class の外で tcl/tk に関する処理を行っても良い.
+
+class Test1
+  # 初期化(インタプリタを生成してウィジェットを生成する).
+  def initialize()
+
+    #### 使う前のおまじない
+
+    # インタプリタの生成.
+    ip = TclTkInterpreter.new()
+    # コマンドに対応するオブジェクトを c に設定しておく.
+    c = ip.commands()
+    # 使用するコマンドに対応するオブジェクトは変数に入れておく.
+    append, bind, button, destroy, incr, info, label, place, set, wm =
+      c.indexes(
+      "append", "bind", "button", "destroy", "incr", "info", "label", "place",
+      "set", "wm")
+
+    #### tcl/tk のコマンドに対応するオブジェクト(TclTkCommand)の操作
+
+    # 実行する時は, e() メソッドを使う.
+    # (以下は, tcl/tk における info command r* を実行.)
+    print info.e("command", "r*"), "\n"
+    # 引数は, まとめた文字列にしても同じ.
+    print info.e("command r*"), "\n"
+    # 変数を用いなくとも実行できるが, 見ためが悪い.
+    print c["info"].e("command", "r*"), "\n"
+    # インタプリタのメソッドとしても実行できるが, 効率が悪い.
+    print ip.info("command", "r*"), "\n"
+
+    ####
+
+    # 以下, 生成したオブジェクトは変数に代入しておかないと
+    # GC の対象になってしまう.
+
+    #### tcl/tk の変数に対応するオブジェクト(TclTkVariable)の操作
+
+    # 生成と同時に値を設定する.
+    v1 = TclTkVariable.new(ip, "20")
+    # 読み出しは get メソッドを使う.
+    print v1.get(), "\n"
+    # 設定は set メソッドを使う.
+    v1.set(40)
+    print v1.get(), "\n"
+    # set コマンドを使って読み出し, 設定は可能だが見ためが悪い.
+    # e() メソッド等の引数に直接 TclTkObject や数値を書いても良い.
+    set.e(v1, 30)
+    print set.e(v1), "\n"
+    # tcl/tk のコマンドで変数を操作できる.
+    incr.e(v1)
+    print v1.get(), "\n"
+    append.e(v1, 10)
+    print v1.get(), "\n"
+
+    #### tcl/tk のウィジェットに対応するオブジェクト(TclTkWidget)の操作
+
+    # ルートウィジェットを取り出す.
+    root = ip.rootwidget()
+    # ウィジェットの操作.
+    root.e("configure -height 300 -width 300")
+    # タイトルを付けるときは wm を使う.
+    wm.e("title", root, $0)
+    # 親ウィジェットとコマンドを指定して, ウィジェットを作る.
+    l1 = TclTkWidget.new(ip, root, label, "-text {type `x' to print}")
+    # place すると表示される.
+    place.e(l1, "-x 0 -rely 0.0 -relwidth 1 -relheight 0.1")
+    # コマンド名は文字列で指定しても良いが, 見ためが悪い.
+    # (コマンド名は独立した引数でなければならない.)
+    l2 = TclTkWidget.new(ip, root, "label")
+    # ウィジェットの操作.
+    l2.e("configure -text {type `q' to exit}")
+    place.e(l2, "-x 0 -rely 0.1 -relwidth 1 -relheight 0.1")
+
+    #### tcl/tk のコールバックに対応するオブジェクト(TclTkCallback)の操作
+
+    # コールバックを生成する.
+    c1 = TclTkCallback.new(ip, proc{sample(ip, root)})
+    # コールバックを持つウィジェットを生成する.
+    b1 = TclTkWidget.new(ip, root, button, "-text sample -command", c1)
+    place.e(b1, "-x 0 -rely 0.2 -relwidth 1 -relheight 0.1")
+    # イベントループを抜けるには destroy.e(root) する.
+    c2 = TclTkCallback.new(ip, proc{destroy.e(root)})
+    b2 = TclTkWidget.new(ip, root, button, "-text exit -command", c2)
+    place.e(b2, "-x 0 -rely 0.3 -relwidth 1 -relheight 0.1")
+
+    #### イベントのバインド
+    # script の追加 (bind tag sequence +script) は今のところできない.
+    # (イテレータ変数の設定がうまくいかない.)
+
+    # 基本的にはウィジェットに対するコールバックと同じ.
+    c3 = TclTkCallback.new(ip, proc{print("q pressed\n"); destroy.e(root)})
+    bind.e(root, "q", c3)
+    # bind コマンドで % 置換によりパラメータを受け取りたいときは,
+    # proc{} の後ろに文字列で指定すると,
+    # 置換結果をイテレータ変数を通して受け取ることができる.
+    # ただし proc{} の後ろの文字列は,
+    # bind コマンドに与えるコールバック以外で指定してはいけない.
+    c4 = TclTkCallback.new(ip, proc{|i| print("#{i} pressed\n")}, "%A")
+    bind.e(root, "x", c4)
+    # TclTkCallback を GC の対象にしたければ,
+    # dcb() (または deletecallbackkeys()) する必要がある.
+    cb = [c1, c2, c3, c4]
+    c5 = TclTkCallback.new(ip, proc{|w| TclTk.dcb(cb, root, w)}, "%W")
+    bind.e(root, "<Destroy>", c5)
+    cb.push(c5)
+
+    #### tcl/tk のイメージに対応するオブジェクト(TclTkImage)の操作
+
+    # データを指定して生成する.
+    i1 = TclTkImage.new(ip, "photo", "-file maru.gif")
+    # ラベルに張り付けてみる.
+    l3 = TclTkWidget.new(ip, root, label, "-relief raised -image", i1)
+    place.e(l3, "-x 0 -rely 0.4 -relwidth 0.2 -relheight 0.2")
+    # 空のイメージを生成して後で操作する.
+    i2 = TclTkImage.new(ip, "photo")
+    # イメージを操作する.
+    i2.e("copy", i1)
+    i2.e("configure -gamma 0.5")
+    l4 = TclTkWidget.new(ip, root, label, "-relief raised -image", i2)
+    place.e(l4, "-relx 0.2 -rely 0.4 -relwidth 0.2 -relheight 0.2")
+
+    ####
+  end
+
+  # サンプルのためのウィジェットを生成する.
+  def sample(ip, parent)
+    bind, button, destroy, grid, toplevel, wm = ip.commands().indexes(
+      "bind", "button", "destroy", "grid", "toplevel", "wm")
+
+    ## toplevel
+
+    # 新しいウインドウを開くには, toplevel を使う.
+    t1 = TclTkWidget.new(ip, parent, toplevel)
+    # タイトルを付けておく
+    wm.e("title", t1, "sample")
+
+    # ウィジェットが破壊されたとき, コールバックが GC の対象になるようにする.
+    cb = []
+    cb.push(c = TclTkCallback.new(ip, proc{|w| TclTk.dcb(cb, t1, w)}, "%W"))
+    bind.e(t1, "<Destroy>", c)
+
+    # ボタンの生成.
+    wid = []
+    # toplevel ウィジェットを破壊するには destroy する.
+    cb.push(c = TclTkCallback.new(ip, proc{destroy.e(t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text close -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_label(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text label -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_button(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text button -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_checkbutton(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text checkbutton -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_radiobutton(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text radiobutton -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_scale(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text scale -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_entry(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text entry -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_text(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text text -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_raise(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text raise/lower -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_modal(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text message/modal -command",
+      c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_menu(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text menu -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_listbox(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text listbox/scrollbar",
+      "-command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_canvas(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text canvas -command", c))
+
+    # grid で表示する.
+    ro = co = 0
+    wid.each{|w|
+      grid.e(w, "-row", ro, "-column", co, "-sticky news")
+      ro += 1
+      if ro == 7
+	ro = 0
+	co += 1
+      end
+    }
+  end
+
+  # inittoplevel(ip, parent, title)
+  #   以下の処理をまとめて行う.
+  #       1. toplevel ウィジェットを作成する.
+  #       2. コールバックを登録する配列を用意し, toplevel ウィジェットの
+  #         <Destroy> イベントにコールバックを削除する手続きを登録する.
+  #       3. クローズボタンを作る.
+  #     作成した toplevel ウィジェット, クローズボタン, コールバック登録用変数
+  #     を返す.
+  #   ip: インタプリタ
+  #   parent: 親ウィジェット
+  #   title: toplevel ウィジェットのウインドウのタイトル
+  def inittoplevel(ip, parent, title)
+    bind, button, destroy, toplevel, wm = ip.commands().indexes(
+      "bind", "button", "destroy", "toplevel", "wm")
+
+    # 新しいウインドウを開くには, toplevel を使う.
+    t1 = TclTkWidget.new(ip, parent, toplevel)
+    # タイトルを付けておく
+    wm.e("title", t1, title)
+
+    # ウィジェットが破壊されたとき, コールバックが GC の対象になるようにする.
+    cb = []
+    cb.push(c = TclTkCallback.new(ip, proc{|w| TclTk.dcb(cb, t1, w)}, "%W"))
+    bind.e(t1, "<Destroy>", c)
+    # close ボタンを作っておく.
+    # toplevel ウィジェットを破壊するには destroy する.
+    cb.push(c = TclTkCallback.new(ip, proc{destroy.e(t1)}))
+    b1 = TclTkWidget.new(ip, t1, button, "-text close -command", c)
+
+    return t1, b1, cb
+  end
+
+  # label のサンプル.
+  def test_label(ip, parent)
+    button, global, label, pack = ip.commands().indexes(
+      "button", "global", "label", "pack")
+    t1, b1, cb = inittoplevel(ip, parent, "label")
+
+    ## label
+
+    # いろいろな形のラベル.
+    l1 = TclTkWidget.new(ip, t1, label, "-text {default(flat)}")
+    l2 = TclTkWidget.new(ip, t1, label, "-text raised -relief raised")
+    l3 = TclTkWidget.new(ip, t1, label, "-text sunken -relief sunken")
+    l4 = TclTkWidget.new(ip, t1, label, "-text groove -relief groove")
+    l5 = TclTkWidget.new(ip, t1, label, "-text ridge -relief ridge")
+    l6 = TclTkWidget.new(ip, t1, label, "-bitmap error")
+    l7 = TclTkWidget.new(ip, t1, label, "-bitmap questhead")
+
+    # pack しても表示される.
+    pack.e(b1, l1, l2, l3, l4, l5, l6, l7, "-pady 3")
+
+    ## -textvariable
+
+    # tcltk ライブラリの実装では, コールバックは tcl/tk の``手続き''を通して
+    # 呼ばれる. したがって, コールバックの中で(大域)変数にアクセスするときは,
+    # global する必要がある.
+    # global する前に変数に値を設定してしまうとエラーになるので,
+    # tcl/tk における表現形だけ生成して, 実際に値を設定しないように,
+    # 2 番目の引数には nil を与える.
+    v1 = TclTkVariable.new(ip, nil)
+    global.e(v1)
+    v1.set(100)
+    # -textvariable で変数を設定する.
+    l6 = TclTkWidget.new(ip, t1, label, "-textvariable", v1)
+    # コールバックの中から変数を操作する.
+    cb.push(c = TclTkCallback.new(ip, proc{
+      global.e(v1); v1.set(v1.get().to_i + 10)}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text +10 -command", c)
+    cb.push(c = TclTkCallback.new(ip, proc{
+      global.e(v1); v1.set(v1.get().to_i - 10)}))
+    b3 = TclTkWidget.new(ip, t1, button, "-text -10 -command", c)
+    pack.e(l6, b2, b3)
+  end
+
+  # button のサンプル.
+  def test_button(ip, parent)
+    button, pack = ip.commands().indexes("button", "pack")
+    t1, b1, cb = inittoplevel(ip, parent, "button")
+
+    ## button
+
+    # コールバック内で参照する変数は先に宣言しておかなければならない.
+    b3 = b4 = nil
+    cb.push(c = TclTkCallback.new(ip, proc{b3.e("flash"); b4.e("flash")}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text flash -command", c)
+    cb.push(c = TclTkCallback.new(ip, proc{b2.e("configure -state normal")}))
+    b3 = TclTkWidget.new(ip, t1, button, "-text normal -command", c)
+    cb.push(c = TclTkCallback.new(ip, proc{b2.e("configure -state disabled")}))
+    b4 = TclTkWidget.new(ip, t1, button, "-text disable -command", c)
+    pack.e(b1, b2, b3, b4)
+  end
+
+  # checkbutton のサンプル.
+  def test_checkbutton(ip, parent)
+    checkbutton, global, pack = ip.commands().indexes(
+      "checkbutton", "global", "pack")
+    t1, b1, cb = inittoplevel(ip, parent, "checkbutton")
+
+    ## checkbutton
+
+    v1 = TclTkVariable.new(ip, nil)
+    global.e(v1)
+    # -variable で変数を設定する.
+    ch1 = TclTkWidget.new(ip, t1, checkbutton, "-onvalue on -offvalue off",
+      "-textvariable", v1, "-variable", v1)
+    pack.e(b1, ch1)
+  end
+
+  # radiobutton のサンプル.
+  def test_radiobutton(ip, parent)
+    global, label, pack, radiobutton = ip.commands().indexes(
+      "global", "label", "pack", "radiobutton")
+    t1, b1, cb = inittoplevel(ip, parent, "radiobutton")
+
+    ## radiobutton
+
+    v1 = TclTkVariable.new(ip, nil)
+    global.e(v1)
+    # ヌルストリングは "{}" で指定する.
+    v1.set("{}")
+    l1 = TclTkWidget.new(ip, t1, label, "-textvariable", v1)
+    # -variable で同じ変数を指定すると同じグループになる.
+    ra1 = TclTkWidget.new(ip, t1, radiobutton,
+      "-text radio1 -value r1 -variable", v1)
+    ra2 = TclTkWidget.new(ip, t1, radiobutton,
+      "-text radio2 -value r2 -variable", v1)
+    cb.push(c = TclTkCallback.new(ip, proc{global.e(v1); v1.set("{}")}))
+    ra3 = TclTkWidget.new(ip, t1, radiobutton,
+      "-text clear -value r3 -variable", v1, "-command", c)
+    pack.e(b1, l1, ra1, ra2, ra3)
+  end
+
+  # scale のサンプル.
+  def test_scale(ip, parent)
+    global, pack, scale = ip.commands().indexes(
+      "global", "pack", "scale")
+    t1, b1, cb = inittoplevel(ip, parent, "scale")
+
+    ## scale
+
+    v1 = TclTkVariable.new(ip, nil)
+    global.e(v1)
+    v1.set(219)
+    # コールバック内で参照する変数は先に宣言しておかなければならない.
+    sca1 = nil
+    cb.push(c = TclTkCallback.new(ip, proc{global.e(v1); v = v1.get();
+      sca1.e("configure -background", format("#%02x%02x%02x", v, v, v))}))
+    sca1 = TclTkWidget.new(ip, t1, scale,
+      "-label scale -orient h -from 0 -to 255 -variable", v1, "-command", c)
+    pack.e(b1, sca1)
+  end
+
+  # entry のサンプル.
+  def test_entry(ip, parent)
+    button, entry, global, pack = ip.commands().indexes(
+      "button", "entry", "global", "pack")
+    t1, b1, cb = inittoplevel(ip, parent, "entry")
+
+    ## entry
+
+    v1 = TclTkVariable.new(ip, nil)
+    global.e(v1)
+    # ヌルストリングは "{}" で指定する.
+    v1.set("{}")
+    en1 = TclTkWidget.new(ip, t1, entry, "-textvariable", v1)
+    cb.push(c = TclTkCallback.new(ip, proc{
+      global.e(v1); print(v1.get(), "\n"); v1.set("{}")}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text print -command", c)
+    pack.e(b1, en1, b2)
+  end
+
+  # text のサンプル.
+  def test_text(ip, parent)
+    button, pack, text = ip.commands().indexes(
+      "button", "pack", "text")
+    t1, b1, cb = inittoplevel(ip, parent, "text")
+
+    ## text
+
+    te1 = TclTkWidget.new(ip, t1, text)
+    cb.push(c = TclTkCallback.new(ip, proc{
+      # 1 行目の 0 文字目から最後までを表示し, 削除する.
+      print(te1.e("get 1.0 end")); te1.e("delete 1.0 end")}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text print -command", c)
+    pack.e(b1, te1, b2)
+  end
+
+  # raise/lower のサンプル.
+  def test_raise(ip, parent)
+    button, frame, lower, pack, raise = ip.commands().indexes(
+      "button", "frame", "lower", "pack", "raise")
+    t1, b1, cb = inittoplevel(ip, parent, "raise/lower")
+
+    ## raise/lower
+
+    # button を隠すテストのために, frame を使う.
+    f1 = TclTkWidget.new(ip, t1, frame)
+    # コールバック内で参照する変数は先に宣言しておかなければならない.
+    b2 = nil
+    cb.push(c = TclTkCallback.new(ip, proc{raise.e(f1, b2)}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text raise -command", c)
+    cb.push(c = TclTkCallback.new(ip, proc{lower.e(f1, b2)}))
+    b3 = TclTkWidget.new(ip, t1, button, "-text lower -command", c)
+    lower.e(f1, b3)
+
+    pack.e(b2, b3, "-in", f1)
+    pack.e(b1, f1)
+  end
+
+  # modal なウィジェットのサンプル.
+  def test_modal(ip, parent)
+    button, frame, message, pack, tk_chooseColor, tk_getOpenFile,
+      tk_messageBox = ip.commands().indexes(
+      "button", "frame", "message", "pack", "tk_chooseColor",
+      "tk_getOpenFile", "tk_messageBox")
+    # 最初に load されていないライブラリは ip.commands() に存在しないので,
+    # TclTkLibCommand を生成する必要がある.
+    tk_dialog = TclTkLibCommand.new(ip, "tk_dialog")
+    t1, b1, cb = inittoplevel(ip, parent, "message/modal")
+
+    ## message
+
+    mes = "これは message ウィジェットのテストです."
+    mes += "以下は modal なウィジェットのテストです."
+    me1 = TclTkWidget.new(ip, t1, message, "-text {#{mes}}")
+
+    ## modal
+
+    # tk_messageBox
+    cb.push(c = TclTkCallback.new(ip, proc{
+      print tk_messageBox.e("-type yesnocancel -message messageBox",
+      "-icon error -default cancel -title messageBox"), "\n"}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text messageBox -command", c)
+    # tk_dialog
+    cb.push(c = TclTkCallback.new(ip, proc{
+      # ウィジェット名を生成するためにダミーの frame を生成.
+      print tk_dialog.e(TclTkWidget.new(ip, t1, frame),
+      "dialog dialog error 2 yes no cancel"), "\n"}))
+    b3 = TclTkWidget.new(ip, t1, button, "-text dialog -command", c)
+    # tk_chooseColor
+    cb.push(c = TclTkCallback.new(ip, proc{
+      print tk_chooseColor.e("-title chooseColor"), "\n"}))
+    b4 = TclTkWidget.new(ip, t1, button, "-text chooseColor -command", c)
+    # tk_getOpenFile
+    cb.push(c = TclTkCallback.new(ip, proc{
+      print tk_getOpenFile.e("-defaultextension .rb",
+      "-filetypes {{{Ruby Script} {.rb}} {{All Files} {*}}}",
+      "-title getOpenFile"), "\n"}))
+    b5 = TclTkWidget.new(ip, t1, button, "-text getOpenFile -command", c)
+
+    pack.e(b1, me1, b2, b3, b4, b5)
+  end
+
+  # menu のサンプル.
+  def test_menu(ip, parent)
+    global, menu, menubutton, pack = ip.commands().indexes(
+      "global", "menu", "menubutton", "pack")
+    tk_optionMenu = TclTkLibCommand.new(ip, "tk_optionMenu")
+    t1, b1, cb = inittoplevel(ip, parent, "menu")
+
+    ## menu
+
+    # menubutton を生成する.
+    mb1 = TclTkWidget.new(ip, t1, menubutton, "-text menu")
+    # menu を生成する.
+    me1 = TclTkWidget.new(ip, mb1, menu)
+    # mb1 から me1 が起動されるようにする.
+    mb1.e("configure -menu", me1)
+
+    # cascade で起動される menu を生成する.
+    me11 = TclTkWidget.new(ip, me1, menu)
+    # radiobutton のサンプル.
+    v1 = TclTkVariable.new(ip, nil); global.e(v1); v1.set("r1")
+    me11.e("add radiobutton -label radio1 -value r1 -variable", v1)
+    me11.e("add radiobutton -label radio2 -value r2 -variable", v1)
+    me11.e("add radiobutton -label radio3 -value r3 -variable", v1)
+    # cascade により mb11 が起動されるようにする.
+    me1.e("add cascade -label cascade -menu", me11)
+
+    # checkbutton のサンプル.
+    v2 = TclTkVariable.new(ip, nil); global.e(v2); v2.set("none")
+    me1.e("add checkbutton -label check -variable", v2)
+    # separator のサンプル.
+    me1.e("add separator")
+    # command のサンプル.
+    v3 = nil
+    cb.push(c = TclTkCallback.new(ip, proc{
+      global.e(v1, v2, v3); print "v1: ", v1.get(), ", v2: ", v2.get(),
+      ", v3: ", v3.get(), "\n"}))
+    me1.e("add command -label print -command", c)
+
+    ## tk_optionMenu
+
+    v3 = TclTkVariable.new(ip, nil); global.e(v3); v3.set("opt2")
+    om1 = TclTkWidget.new(ip, t1, tk_optionMenu, v3, "opt1 opt2 opt3 opt4")
+
+    pack.e(b1, mb1, om1, "-side left")
+  end
+
+  # listbox のサンプル.
+  def test_listbox(ip, parent)
+    clipboard, frame, grid, listbox, lower, menu, menubutton, pack, scrollbar,
+      selection = ip.commands().indexes(
+      "clipboard", "frame", "grid", "listbox", "lower", "menu", "menubutton",
+      "pack", "scrollbar", "selection")
+    t1, b1, cb = inittoplevel(ip, parent, "listbox")
+
+    ## listbox/scrollbar
+
+    f1 = TclTkWidget.new(ip, t1, frame)
+    # コールバック内で参照する変数は先に宣言しておかなければならない.
+    li1 = sc1 = sc2 = nil
+    # 実行時に, 後ろにパラメータがつくコールバックは,
+    # イテレータ変数でそのパラメータを受け取ることができる.
+    # (複数のパラメータはひとつの文字列にまとめられる.)
+    cb.push(c1 = TclTkCallback.new(ip, proc{|i| li1.e("xview", i)}))
+    cb.push(c2 = TclTkCallback.new(ip, proc{|i| li1.e("yview", i)}))
+    cb.push(c3 = TclTkCallback.new(ip, proc{|i| sc1.e("set", i)}))
+    cb.push(c4 = TclTkCallback.new(ip, proc{|i| sc2.e("set", i)}))
+    # listbox
+    li1 = TclTkWidget.new(ip, f1, listbox,
+      "-xscrollcommand", c3, "-yscrollcommand", c4,
+      "-selectmode extended -exportselection true")
+    for i in 1..20
+      li1.e("insert end {line #{i} line #{i} line #{i} line #{i} line #{i}}")
+    end
+    # scrollbar
+    sc1 = TclTkWidget.new(ip, f1, scrollbar, "-orient horizontal -command", c1)
+    sc2 = TclTkWidget.new(ip, f1, scrollbar, "-orient vertical -command", c2)
+
+    ## selection/clipboard
+
+    mb1 = TclTkWidget.new(ip, t1, menubutton, "-text edit")
+    me1 = TclTkWidget.new(ip, mb1, menu)
+    mb1.e("configure -menu", me1)
+    cb.push(c = TclTkCallback.new(ip, proc{
+      # clipboard をクリア.
+      clipboard.e("clear")
+      # selection から文字列を読み込み clipboard に追加する.
+      clipboard.e("append {#{selection.e(\"get\")}}")}))
+    me1.e("add command -label {selection -> clipboard} -command",c)
+    cb.push(c = TclTkCallback.new(ip, proc{
+      # li1 をクリア.
+      li1.e("delete 0 end")
+      # clipboard から文字列を取り出し, 1 行ずつ
+      selection.e("get -selection CLIPBOARD").split(/\n/).each{|line|
+        # li1 に挿入する.
+        li1.e("insert end {#{line}}")}}))
+    me1.e("add command -label {clipboard -> listbox} -command",c)
+
+    grid.e(li1, "-row 0 -column 0 -sticky news")
+    grid.e(sc1, "-row 1 -column 0 -sticky ew")
+    grid.e(sc2, "-row 0 -column 1 -sticky ns")
+    grid.e("rowconfigure", f1, "0 -weight 100")
+    grid.e("columnconfigure", f1, "0 -weight 100")
+    f2 = TclTkWidget.new(ip, t1, frame)
+    lower.e(f2, b1)
+    pack.e(b1, mb1, "-in", f2, "-side left")
+    pack.e(f2, f1)
+  end
+
+  # canvas のサンプル.
+  def test_canvas(ip, parent)
+    canvas, lower, pack = ip.commands().indexes("canvas", "lower", "pack")
+    t1, b1, cb = inittoplevel(ip, parent, "canvas")
+
+    ## canvas
+
+    ca1 = TclTkWidget.new(ip, t1, canvas, "-width 400 -height 300")
+    lower.e(ca1, b1)
+    # rectangle を作る.
+    idr = ca1.e("create rectangle 10 10 20 20")
+    # oval を作る.
+    ca1.e("create oval 60 10 100 50")
+    # polygon を作る.
+    ca1.e("create polygon 110 10 110 30 140 10")
+    # line を作る.
+    ca1.e("create line 150 10 150 30 190 10")
+    # arc を作る.
+    ca1.e("create arc 200 10 250 50 -start 0 -extent 90 -style pieslice")
+    # i1 は本当は, どこかで破壊しなければならないが, 面倒なので放ってある.
+    i1 = TclTkImage.new(ip, "photo", "-file maru.gif")
+    # image を作る.
+    ca1.e("create image 100 100 -image", i1)
+    # bitmap を作る.
+    ca1.e("create bitmap 260 50 -bitmap questhead")
+    # text を作る.
+    ca1.e("create text 320 50 -text {drag rectangle}")
+    # window を作る(クローズボタン).
+    ca1.e("create window 200 200 -window", b1)
+
+    # bind により rectangle を drag できるようにする.
+    cb.push(c = TclTkCallback.new(ip, proc{|i|
+      # i に x と y を受け取るので, 取り出す.
+      x, y = i.split(/ /); x = x.to_f; y = y.to_f
+      # 座標を変更する.
+      ca1.e("coords current #{x - 5} #{y - 5} #{x + 5} #{y + 5}")},
+      # x, y 座標を空白で区切ったものをイテレータ変数へ渡すように指定.
+      "%x %y"))
+    # rectangle に bind する.
+    ca1.e("bind", idr, "<B1-Motion>", c)
+
+    pack.e(ca1)
+  end
+end
+
+# test driver
+
+if ARGV.size == 0
+  print "#{$0} n で, n 個のインタプリタを起動します.\n"
+  n = 1
+else
+  n = ARGV[0].to_i
+end
+
+print "start\n"
+ip = []
+
+# インタプリタ, ウィジェット等の生成.
+for i in 1 .. n
+  ip.push(Test1.new())
+end
+
+# 用意ができたらイベントループに入る.
+TclTk.mainloop()
+print "exit from mainloop\n"
+
+# インタプリタが GC されるかのテスト.
+ip = []
+print "GC.start\n" if $DEBUG
+GC.start() if $DEBUG
+print "end\n"
+
+exit
+
+# end

ext/tcltklib/sample/sample2.rb

@@ -0,0 +1,449 @@
+#!/usr/local/bin/ruby
+#----------------------> pretty simple othello game <-----------------------
+# othello.rb
+#
+# version 0.3
+# maeda shugo (shuto@po.aianet.ne.jp)
+#---------------------------------------------------------------------------
+
+#	Sep. 17, 1997	modified by Y. Shigehiro for tcltk library
+#	   maeda shugo (shugo@po.aianet.ne.jp) 氏による
+#          (ruby/tk で書かれていた) ruby のサンプルプログラム
+#		http://www.aianet.or.jp/~shugo/ruby/othello.rb.gz
+#	   を tcltk ライブラリを使うように, 機械的に変更してみました.
+#
+#	   なるべくオリジナルと同じになるようにしてあります.
+
+require "observer"
+require "tcltk"
+$ip = TclTkInterpreter.new()
+$root = $ip.rootwidget()
+$button, $canvas, $checkbutton, $frame, $label, $pack, $update, $wm =
+   $ip.commands().indexes(
+   "button", "canvas", "checkbutton", "frame", "label", "pack", "update", "wm")
+
+class Othello
+   
+   EMPTY = 0
+   BLACK = 1
+   WHITE = - BLACK
+   
+   attr :in_com_turn
+   attr :game_over
+   
+   class Board
+   
+      include Observable
+      
+      DIRECTIONS = [
+	 [-1, -1], [-1, 0], [-1, 1],
+	 [ 0, -1],          [ 0, 1],
+	 [ 1, -1], [ 1, 0], [ 1, 1]
+      ]
+      
+      attr :com_disk, TRUE
+   
+      def initialize(othello)
+	 @othello = othello
+	 reset
+      end
+   
+      def notify_observers(*arg)
+	 if @observer_peers != nil
+	    super(*arg)
+	 end
+      end
+      
+      def reset
+	 @data = [
+	    [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY],
+	    [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY],
+	    [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY],
+	    [EMPTY, EMPTY, EMPTY, WHITE, BLACK, EMPTY, EMPTY, EMPTY],
+	    [EMPTY, EMPTY, EMPTY, BLACK, WHITE, EMPTY, EMPTY, EMPTY],
+	    [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY],
+	    [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY],
+	    [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY]
+	 ]
+	 changed
+	 notify_observers
+      end
+      
+      def man_disk
+	 return - @com_disk
+      end
+      
+      def other_disk(disk)
+	 return - disk
+      end
+      
+      def get_disk(row, col)
+	 return @data[row][col]
+      end
+      
+      def reverse_to(row, col, my_disk, dir_y, dir_x)
+	 y = row
+	 x = col
+	 begin
+	    y += dir_y
+	    x += dir_x
+	    if y < 0 || x < 0 || y > 7 || x > 7 ||
+		  @data[y][x] == EMPTY
+	       return
+	    end
+	 end until @data[y][x] == my_disk
+	 begin
+	    @data[y][x] = my_disk
+	    changed
+	    notify_observers(y, x)
+	    y -= dir_y
+	    x -= dir_x
+	 end until y == row && x == col
+      end
+      
+      def put_disk(row, col, disk)
+	 @data[row][col] = disk
+	 changed
+	 notify_observers(row, col)
+	 DIRECTIONS.each do |dir|
+	    reverse_to(row, col, disk, *dir)
+	 end
+      end
+      
+      def count_disk(disk)
+	 num = 0
+	 @data.each do |rows|
+	    rows.each do |d|
+	       if d == disk
+		  num += 1
+	       end
+	    end
+	 end
+	 return num
+      end
+      
+      def count_point_to(row, col, my_disk, dir_y, dir_x)
+	 return 0 if @data[row][col] != EMPTY
+	 count = 0
+	 loop do
+	    row += dir_y
+	    col += dir_x
+	    break if row < 0 || col < 0 || row > 7 || col > 7
+	    case @data[row][col]
+	    when my_disk
+	       return count
+	    when other_disk(my_disk)
+	       count += 1
+	    when EMPTY
+	       break
+	    end
+	 end
+	 return 0
+      end
+      
+      def count_point(row, col, my_disk)
+	 count = 0
+	 DIRECTIONS.each do |dir|
+	    count += count_point_to(row, col, my_disk, *dir)
+	 end
+	 return count
+      end
+      
+      def corner?(row, col)
+	 return (row == 0 && col == 0) ||
+	    (row == 0 && col == 7) ||
+	    (row == 7 && col == 0) ||
+	    (row == 7 && col == 7)
+      end
+      
+      def search(my_disk)
+	 max = 0
+	 max_row = nil
+	 max_col = nil
+	 for row in 0 .. 7
+	    for col in 0 .. 7
+	       buf = count_point(row, col, my_disk)
+	       if (corner?(row, col) && buf > 0) || max < buf
+		  max = buf
+		  max_row = row
+		  max_col = col
+	       end
+	    end
+	 end
+	 return max_row, max_col
+      end
+   end #--------------------------> class Board ends here
+   
+   class BoardView < TclTkWidget
+      
+      BACK_GROUND_COLOR = "DarkGreen"
+      HILIT_BG_COLOR = "green"
+      BORDER_COLOR = "black"
+      BLACK_COLOR = "black"
+      WHITE_COLOR = "white"
+      STOP_COLOR = "red"
+      
+      attr :left
+      attr :top
+      attr :right
+      attr :bottom
+      
+      class Square
+	 
+	 attr :oval, TRUE
+	 attr :row
+	 attr :col
+	 
+	 def initialize(view, row, col)
+	    @view = view
+	    @id = @view.e("create rectangle", *view.tk_rect(view.left + col,
+				      view.top + row,
+				      view.left + col + 1,
+				      view.top + row + 1))
+	    @row = row
+	    @col = col
+	    @view.e("itemconfigure", @id,
+	      "-width 0.5m -outline #{BORDER_COLOR}")
+	    @view.e("bind", @id, "<Any-Enter>", TclTkCallback.new($ip, proc{
+	       if @oval == nil
+		  view.e("itemconfigure", @id, "-fill #{HILIT_BG_COLOR}")
+	       end
+	    }))
+	    @view.e("bind", @id, "<Any-Leave>", TclTkCallback.new($ip, proc{
+	       view.e("itemconfigure", @id, "-fill #{BACK_GROUND_COLOR}")
+	    }))
+	    @view.e("bind", @id, "<ButtonRelease-1>", TclTkCallback.new($ip,
+	       proc{
+	       view.click_square(self)
+	    }))
+	 end
+	 
+	 def blink(color)
+	    @view.e("itemconfigure", @id, "-fill #{color}")
+	    $update.e()
+	    sleep(0.1)
+	    @view.e("itemconfigure", @id, "-fill #{BACK_GROUND_COLOR}")
+	 end
+      end #-----------------------> class Square ends here
+   
+      def initialize(othello, board)
+	 super($ip, $root, $canvas)
+	 @othello = othello
+	 @board = board
+	 @board.add_observer(self)
+	 
+	 @squares = Array.new(8)
+	 for i in 0 .. 7
+	    @squares[i] = Array.new(8)
+	 end
+	 @left = 1
+	 @top = 0.5
+	 @right = @left + 8
+	 @bottom = @top + 8
+	 
+	 i = self.e("create rectangle", *tk_rect(@left, @top, @right, @bottom))
+	 self.e("itemconfigure", i,
+	    "-width 1m -outline #{BORDER_COLOR} -fill #{BACK_GROUND_COLOR}")
+
+	 for row in 0 .. 7
+	    for col in 0 .. 7
+	       @squares[row][col] = Square.new(self, row, col)
+	    end
+	 end
+	 
+	 update
+      end
+      
+      def tk_rect(left, top, right, bottom)
+	 return left.to_s + "c", top.to_s + "c",
+	    right.to_s + "c", bottom.to_s + "c"
+      end
+      
+      def clear
+	 each_square do |square|
+	    if square.oval != nil
+	       self.e("delete", square.oval)
+	       square.oval = nil
+	    end
+	 end
+      end
+      
+      def draw_disk(row, col, disk)
+	 if disk == EMPTY
+	    if @squares[row][col].oval != nil
+	       self.e("delete", @squares[row][col].oval)
+	       @squares[row][col].oval = nil
+	    end
+	    return
+	 end
+	    
+	 $update.e()
+	 sleep(0.05)
+	 oval = @squares[row][col].oval
+	 if oval == nil
+	    oval = self.e("create oval", *tk_rect(@left + col + 0.2,
+					   @top + row + 0.2,
+					   @left + col + 0.8,
+					   @top + row + 0.8))
+	    @squares[row][col].oval = oval
+	 end
+	 case disk
+	 when BLACK
+	    color = BLACK_COLOR
+	 when WHITE
+	    color = WHITE_COLOR
+	 else
+	    fail format("Unknown disk type: %d", disk)
+	 end
+	 self.e("itemconfigure", oval, "-outline #{color} -fill #{color}")
+      end
+      
+      def update(row = nil, col = nil)
+	 if row && col
+	    draw_disk(row, col, @board.get_disk(row, col))
+	 else
+	    each_square do |square|
+	       draw_disk(square.row, square.col,
+			 @board.get_disk(square.row, square.col))
+	    end
+	 end
+	 @othello.show_point
+      end
+      
+      def each_square
+	 @squares.each do |rows|
+	    rows.each do |square|
+	       yield(square)
+	    end
+	 end
+      end
+      
+      def click_square(square)
+	 if @othello.in_com_turn || @othello.game_over ||
+	       @board.count_point(square.row,
+				  square.col,
+				  @board.man_disk) == 0
+	    square.blink(STOP_COLOR)
+	    return
+	 end
+	 @board.put_disk(square.row, square.col, @board.man_disk)
+	 @othello.com_turn
+      end
+      
+      private :draw_disk
+      public :update
+   end #----------------------> class BoardView ends here
+   
+   def initialize
+      @msg_label = TclTkWidget.new($ip, $root, $label)
+      $pack.e(@msg_label)
+      
+      @board = Board.new(self)
+      @board_view = BoardView.new(self, @board)
+      #### added by Y. Shigehiro
+      ## board_view の大きさを設定する.
+      x1, y1, x2, y2 = @board_view.e("bbox all").split(/ /).collect{|i| i.to_f}
+      @board_view.e("configure -width", x2 - x1)
+      @board_view.e("configure -height", y2 - y1)
+      ## scrollregion を設定する.
+      @board_view.e("configure -scrollregion {", @board_view.e("bbox all"),
+	 "}")
+      #### ここまで
+      $pack.e(@board_view, "-fill both -expand true")
+      
+      panel = TclTkWidget.new($ip, $root, $frame)
+      
+      @play_black = TclTkWidget.new($ip, panel, $checkbutton,
+        "-text {com is black} -command", TclTkCallback.new($ip, proc{
+	 switch_side
+      }))
+      $pack.e(@play_black, "-side left")
+            
+      quit = TclTkWidget.new($ip, panel, $button, "-text Quit -command",
+	 TclTkCallback.new($ip, proc{
+	 exit
+      }))
+      $pack.e(quit, "-side right -fill x")
+      
+      reset = TclTkWidget.new($ip, panel, $button, "-text Reset -command",
+	 TclTkCallback.new($ip, proc{
+	 reset_game
+      }))
+      $pack.e(reset, "-side right -fill x")
+      
+      $pack.e(panel, "-side bottom -fill x")
+      
+#      root = Tk.root
+      $wm.e("title", $root, "Othello")
+      $wm.e("iconname", $root, "Othello")
+      
+      @board.com_disk = WHITE
+      @game_over = FALSE
+      
+      TclTk.mainloop
+   end
+   
+   def switch_side
+      if @in_com_turn
+	 @play_black.e("toggle")
+      else
+	 @board.com_disk = @board.man_disk
+	 com_turn unless @game_over
+      end
+   end
+   
+   def reset_game
+      if @board.com_disk == BLACK
+	 @board.com_disk = WHITE
+	 @play_black.e("toggle")
+      end
+      @board_view.clear
+      @board.reset
+      $wm.e("title", $root, "Othello")
+      @game_over = FALSE
+   end
+      
+   def com_turn
+      @in_com_turn = TRUE
+      $update.e()
+      sleep(0.5)
+      begin
+	 com_disk = @board.count_disk(@board.com_disk)
+	 man_disk = @board.count_disk(@board.man_disk)
+	 if @board.count_disk(EMPTY) == 0
+	    if man_disk == com_disk
+	       $wm.e("title", $root, "{Othello - Draw!}")
+	    elsif man_disk > com_disk
+	       $wm.e("title", $root, "{Othello - You Win!}")
+	    else
+	       $wm.e("title", $root, "{Othello - You Loose!}")
+	    end
+	    @game_over = TRUE
+	    break
+	 elsif com_disk == 0
+	    $wm.e("title", $root, "{Othello - You Win!}")
+	    @game_over = TRUE
+	    break
+	 elsif man_disk == 0
+	    $wm.e("title", $root, "{Othello - You Loose!}")
+	    @game_over = TRUE
+	    break
+	 end
+	 row, col = @board.search(@board.com_disk)
+	 break if row == nil || col == nil
+	 @board.put_disk(row, col, @board.com_disk)
+      end while @board.search(@board.man_disk) == [nil, nil]
+      @in_com_turn = FALSE
+   end
+
+   def show_point
+      black = @board.count_disk(BLACK)
+      white = @board.count_disk(WHITE)
+      @msg_label.e("configure -text",
+	 %Q/{#{format("BLACK: %.2d    WHITE: %.2d", black, white)}}/)
+   end
+end #----------------------> class Othello ends here
+
+Othello.new
+
+#----------------------------------------------> othello.rb ends here

ext/tcltklib/tcltklib.c

@@ -0,0 +1,216 @@
+/*
+ *	tcltklib.c
+ *		Aug. 27, 1997	Y. Shigehiro
+ *		Oct. 24, 1997	Y. Matsumoto
+ */
+
+#include "ruby.h"
+#include "sig.h"
+#include <stdio.h>
+#include <string.h>
+#include <tcl.h>
+#include <tk.h>
+
+/* for debug */
+
+#define DUMP1(ARG1) if (debug) { fprintf(stderr, "tcltklib: %s\n", ARG1);}
+#define DUMP2(ARG1, ARG2) if (debug) { fprintf(stderr, "tcltklib: ");\
+fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); }
+/*
+#define DUMP1(ARG1)
+#define DUMP2(ARG1, ARG2)
+*/
+
+/* from tkAppInit.c */
+
+/*
+ * The following variable is a special hack that is needed in order for
+ * Sun shared libraries to be used for Tcl.
+ */
+
+extern int matherr();
+int *tclDummyMathPtr = (int *) matherr;
+
+/*---- module TclTkLib ----*/
+
+static VALUE thread_safe = Qnil;
+
+/* execute Tk_MainLoop */
+static VALUE
+lib_mainloop(VALUE self)
+{
+    int old_trapflg;
+    int flags = RTEST(thread_safe)?TCL_DONT_WAIT:0;
+
+    DUMP1("start Tk_Mainloop");
+    while (Tk_GetNumMainWindows() > 0) {
+	old_trapflg = trap_immediate;
+	trap_immediate = 1;
+        Tcl_DoOneEvent(flags);
+	trap_immediate = old_trapflg;
+	CHECK_INTS;
+	flags = (thread_safe == 0 || thread_safe == Qnil)?0:TCL_DONT_WAIT;
+    }
+    DUMP1("stop Tk_Mainloop");
+
+    return Qnil;
+}
+
+/*---- class TclTkIp ----*/
+struct tcltkip {
+    Tcl_Interp *ip;		/* the interpreter */
+    int return_value;		/* return value */
+};
+
+/* Tcl command `ruby' */
+static VALUE
+ip_eval_rescue(VALUE *failed, VALUE einfo)
+{
+    *failed = einfo;
+    return Qnil;
+}
+
+static int
+ip_ruby(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
+{
+    VALUE res;
+    int old_trapflg;
+    VALUE failed = 0;
+
+    /* ruby command has 1 arg. */
+    if (argc != 2) {
+	ArgError("wrong # of arguments (%d for 1)", argc);
+    }
+
+    /* evaluate the argument string by ruby */
+    DUMP2("rb_eval_string(%s)", argv[1]);
+    old_trapflg = trap_immediate;
+    trap_immediate = 0;
+    res = rb_rescue(rb_eval_string, argv[1], ip_eval_rescue, &failed);
+    trap_immediate = old_trapflg;
+
+    if (failed) {
+	Tcl_AppendResult(interp, RSTRING(failed)->ptr, (char*)NULL);
+	return TCL_ERROR;
+    }
+
+    /* result must be string or nil */
+    if (NIL_P(res)) {
+	DUMP1("(rb_eval_string result) nil");
+	return TCL_OK;
+    }
+    Check_Type(res, T_STRING);
+
+    /* copy result to the tcl interpreter */
+    DUMP2("(rb_eval_string result) %s", RSTRING(res)->ptr);
+    DUMP1("Tcl_AppendResult");
+    Tcl_AppendResult(interp, RSTRING(res)->ptr, (char *)NULL);
+
+    return TCL_OK;
+}
+
+/* destroy interpreter */
+static void
+ip_free(struct tcltkip *ptr)
+{
+    DUMP1("Tcl_DeleteInterp");
+    Tcl_DeleteInterp(ptr->ip);
+}
+
+/* create and initialize interpreter */
+static VALUE
+ip_new(VALUE self)
+{
+    struct tcltkip *ptr;	/* tcltkip data struct */
+    VALUE obj;			/* newly created object */
+
+    /* create object */
+    obj = Data_Make_Struct(self, struct tcltkip, 0, ip_free, ptr);
+    ptr->return_value = 0;
+
+    /* from Tk_Main() */
+    DUMP1("Tcl_CreateInterp");
+    ptr->ip = Tcl_CreateInterp();
+
+    /* from Tcl_AppInit() */
+    DUMP1("Tcl_Init");
+    if (Tcl_Init(ptr->ip) == TCL_ERROR) {
+	Fail("Tcl_Init");
+    }
+    DUMP1("Tk_Init");
+    if (Tk_Init(ptr->ip) == TCL_ERROR) {
+	Fail("Tk_Init");
+    }
+    DUMP1("Tcl_StaticPackage(\"Tk\")");
+    Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init,
+		      (Tcl_PackageInitProc *) NULL);
+
+    /* add ruby command to the interpreter */
+    DUMP1("Tcl_CreateCommand(\"ruby\")");
+    Tcl_CreateCommand(ptr->ip, "ruby", ip_ruby, (ClientData *)NULL,
+		      (Tcl_CmdDeleteProc *)NULL);
+
+    return obj;
+}
+
+/* eval string in tcl by Tcl_Eval() */
+static VALUE
+ip_eval(VALUE self, VALUE str)
+{
+    char *buf;			/* Tcl_Eval requires re-writable string region */
+    struct tcltkip *ptr;	/* tcltkip data struct */
+
+    /* get the data struct */
+    Data_Get_Struct(self, struct tcltkip, ptr);
+
+    /* call Tcl_Eval() */
+    Check_Type(str, T_STRING);
+    buf = ALLOCA_N(char,RSTRING(str)->len+1);
+    strcpy(buf, RSTRING(str)->ptr);
+    DUMP2("Tcl_Eval(%s)", buf);
+    ptr->return_value = Tcl_Eval(ptr->ip, buf);
+    if (ptr->return_value == TCL_ERROR) {
+	Fail(ptr->ip->result);
+    }
+    DUMP2("(TCL_Eval result) %d", ptr->return_value);
+
+    /* pass back the result (as string) */
+    return(str_new2(ptr->ip->result));
+}
+
+/* get return code from Tcl_Eval() */
+static VALUE
+ip_retval(VALUE self)
+{
+    struct tcltkip *ptr;	/* tcltkip data struct */
+
+    /* get the data strcut */
+    Data_Get_Struct(self, struct tcltkip, ptr);
+
+    return (INT2FIX(ptr->return_value));
+}
+
+/*---- initialization ----*/
+void Init_tcltklib()
+{
+    extern VALUE rb_argv0;	/* the argv[0] */
+
+    VALUE lib = rb_define_module("TclTkLib");
+    VALUE ip = rb_define_class("TclTkIp", cObject);
+
+    rb_define_module_function(lib, "mainloop", lib_mainloop, 0);
+
+    rb_define_singleton_method(ip, "new", ip_new, 0);
+    rb_define_method(ip, "_eval", ip_eval, 1);
+    rb_define_method(ip, "_return_value", ip_retval, 0);
+    rb_define_method(ip, "mainloop", lib_mainloop, 0);
+
+    /*---- initialize tcl/tk libraries ----*/
+    /* from Tk_Main() */
+    DUMP1("Tcl_FindExecutable");
+    Tcl_FindExecutable(RSTRING(rb_argv0)->ptr);
+
+    rb_define_variable("$tk_thread_safe", &thread_safe);
+}
+
+/* eof */

instruby.rb

@@ -0,0 +1,37 @@
+#!./miniruby
+require "rbconfig.rb"
+include Config
+
+$:.unshift CONFIG["srcdir"]+"/lib"
+require "ftools"
+
+binsuffix = CONFIG["binsuffix"]
+if ENV["prefix"]
+  prefix = ENV["prefix"]
+else
+  prefix = CONFIG["prefix"]
+end
+ruby_install_name = CONFIG["ruby_install_name"]
+bindir = prefix + "/bin"
+libdir = prefix + "/lib/" + ruby_install_name
+archdir = libdir+"/"+CONFIG["arch"]
+mandir = CONFIG["mandir"] + "/man1"
+
+File.install "ruby#{binsuffix}",
+  "#{bindir}/#{ruby_install_name}#{binsuffix}", 0755, TRUE
+File.makedirs libdir, TRUE
+Dir.chdir "ext"
+system "../miniruby#{binsuffix} extmk.rb install"
+Dir.chdir CONFIG["srcdir"]
+IO.foreach 'MANIFEST' do |$_|
+  $_.chop!
+  if /^lib/
+    File.install $_, libdir, 0644, TRUE
+  elsif /^[a-z]+\.h$/
+    File.install $_, archdir, 0644, TRUE
+  end
+  File.install "config.h", archdir, 0644, TRUE
+end
+File.install "rbconfig.rb", archdir, 0644, TRUE
+File.install "ruby.1", mandir, 0644, TRUE
+# vi:set sw=2:

intern.h

@@ -0,0 +1,291 @@
+/* Functions and variables that are used by more than one source file of
+ * the kernel.  Not available to extensions and applications.
+ */
+
+/* array.c */
+void memclear _((register VALUE *, register int));
+VALUE assoc_new _((VALUE, VALUE));
+VALUE ary_new _((void));
+VALUE ary_new2 _((int));
+VALUE ary_new3();
+VALUE ary_new4 _((int, VALUE *));
+VALUE ary_freeze _((VALUE));
+void ary_store _((VALUE, int, VALUE));
+VALUE ary_push _((VALUE, VALUE));
+VALUE ary_pop _((VALUE));
+VALUE ary_shift _((VALUE));
+VALUE ary_unshift _((VALUE, VALUE));
+VALUE ary_entry _((VALUE, int));
+VALUE ary_each _((VALUE));
+VALUE ary_join _((VALUE, VALUE));
+VALUE ary_to_s _((VALUE));
+VALUE ary_print_on _((VALUE, VALUE));
+VALUE ary_reverse _((VALUE));
+VALUE ary_sort_bang _((VALUE));
+VALUE ary_sort _((VALUE));
+VALUE ary_delete _((VALUE, VALUE));
+VALUE ary_delete_at _((VALUE, VALUE));
+VALUE ary_plus _((VALUE, VALUE));
+VALUE ary_concat _((VALUE, VALUE));
+VALUE ary_assoc _((VALUE, VALUE));
+VALUE ary_rassoc _((VALUE, VALUE));
+VALUE ary_includes _((VALUE, VALUE));
+/* bignum.c */
+VALUE big_clone _((VALUE));
+void big_2comp _((VALUE));
+VALUE big_norm _((VALUE));
+VALUE uint2big _((UINT));
+VALUE int2big _((INT));
+VALUE uint2inum _((UINT));
+VALUE int2inum _((INT));
+VALUE str2inum _((UCHAR *, int));
+VALUE big2str _((VALUE, int));
+INT big2int _((VALUE));
+VALUE big_to_i _((VALUE));
+VALUE dbl2big _((double));
+double big2dbl _((VALUE));
+VALUE big_to_f _((VALUE));
+VALUE big_plus _((VALUE, VALUE));
+VALUE big_minus _((VALUE, VALUE));
+VALUE big_mul _((VALUE, VALUE));
+VALUE big_pow _((VALUE, VALUE));
+VALUE big_and _((VALUE, VALUE));
+VALUE big_or _((VALUE, VALUE));
+VALUE big_xor _((VALUE, VALUE));
+VALUE big_lshift _((VALUE, VALUE));
+VALUE big_rand _((VALUE));
+/* class.c */
+VALUE class_new _((VALUE));
+VALUE singleton_class_new _((VALUE));
+VALUE singleton_class_clone _((VALUE));
+void singleton_class_attached _((VALUE,VALUE));
+VALUE rb_define_class_id _((ID, VALUE));
+VALUE module_new _((void));
+VALUE rb_define_module_id _((ID));
+VALUE mod_included_modules _((VALUE));
+VALUE mod_ancestors _((VALUE));
+VALUE class_instance_methods _((int, VALUE *, VALUE));
+VALUE class_private_instance_methods _((int, VALUE *, VALUE));
+VALUE obj_singleton_methods _((VALUE));
+void rb_define_method_id _((VALUE, ID, VALUE (*)(), int));
+void rb_undef_method _((VALUE, char *));
+void rb_define_private_method _((VALUE, char *, VALUE (*)(), int));
+void rb_define_singleton_method _((VALUE,char*,VALUE(*)(),int));
+void rb_define_private_method _((VALUE,char*,VALUE(*)(),int));
+VALUE rb_singleton_class _((VALUE));
+/* enum.c */
+VALUE enum_length _((VALUE));
+/* error.c */
+VALUE exc_new _((VALUE, char *, UINT));
+VALUE exc_new2 _((VALUE, char *));
+VALUE exc_new3 _((VALUE, VALUE));
+#ifdef __GNUC__
+volatile voidfn TypeError;
+volatile voidfn ArgError;
+volatile voidfn NameError;
+volatile voidfn IndexError;
+volatile voidfn LoadError;
+#else
+void TypeError();
+void ArgError();
+void NameError();
+void IndexError();
+void LoadError();
+#endif
+/* eval.c */
+void rb_clear_cache _((void));
+void rb_alias _((VALUE, ID, ID));
+int rb_method_boundp _((VALUE, ID, int));
+VALUE dyna_var_defined _((ID));
+VALUE dyna_var_ref _((ID));
+VALUE dyna_var_asgn _((ID, VALUE));
+void ruby_init _((void));
+void ruby_options _((int, char **));
+void ruby_run _((void));
+void rb_eval_cmd _((VALUE, VALUE));
+void rb_trap_eval _((VALUE, int));
+int rb_respond_to _((VALUE, ID));
+void rb_raise _((VALUE));
+void rb_fatal _((VALUE));
+void rb_interrupt _((void));
+int iterator_p _((void));
+VALUE rb_yield_0 _((VALUE, volatile VALUE));
+VALUE rb_apply _((VALUE, ID, VALUE));
+VALUE rb_funcall2 _((VALUE, ID, int, VALUE *));
+void rb_backtrace _((void));
+ID rb_frame_last_func _((void));
+VALUE f_load _((VALUE, VALUE));
+void rb_provide _((char *));
+VALUE f_require _((VALUE, VALUE));
+VALUE class_new_instance _((int, VALUE *, VALUE));
+VALUE f_lambda _((void));
+void rb_set_end_proc _((void (*)(),VALUE));
+void gc_mark_threads _((void));
+void thread_schedule _((void));
+void thread_wait_fd _((int));
+void thread_fd_writable _((int));
+int thread_alone _((void));
+void thread_sleep _((int));
+void thread_sleep_forever _((void));
+VALUE thread_create _((VALUE (*)(), void *));
+void thread_interrupt _((void));
+/* file.c */
+VALUE file_open _((char *, char *));
+int eaccess _((char *, int));
+VALUE file_s_expand_path _((VALUE, VALUE));
+/* gc.c */
+void rb_global_variable _((VALUE *));
+void gc_mark_locations _((VALUE *, VALUE *));
+void gc_mark_maybe();
+void gc_mark();
+void gc_force_recycle();
+void gc_gc _((void));
+void init_stack _((void));
+void init_heap _((void));
+/* hash.c */
+VALUE hash_freeze _((VALUE));
+VALUE rb_hash _((VALUE));
+VALUE hash_new _((void));
+VALUE hash_aref _((VALUE, VALUE));
+VALUE hash_aset _((VALUE, VALUE, VALUE));
+/* io.c */
+void eof_error _((void));
+VALUE io_write _((VALUE, VALUE));
+VALUE io_gets_method _((int, VALUE*, VALUE));
+VALUE io_gets _((VALUE));
+VALUE io_getc _((VALUE));
+VALUE io_ungetc _((VALUE, VALUE));
+VALUE io_close _((VALUE));
+VALUE io_binmode _((VALUE));
+int io_mode_flags _((char *));
+VALUE io_reopen _((VALUE, VALUE));
+VALUE f_gets _((void));
+void rb_str_setter _((VALUE, ID, VALUE *));
+/* numeric.c */
+void num_zerodiv _((void));
+VALUE num_coerce_bin _((VALUE, VALUE));
+VALUE float_new _((double));
+VALUE flo_pow _((VALUE, VALUE));
+VALUE num2fix _((VALUE));
+VALUE fix2str _((VALUE, int));
+VALUE fix_to_s _((VALUE));
+VALUE num_upto _((VALUE, VALUE));
+VALUE fix_upto _((VALUE, VALUE));
+/* object.c */
+VALUE rb_equal _((VALUE, VALUE));
+int rb_eql _((VALUE, VALUE));
+VALUE obj_equal _((VALUE, VALUE));
+VALUE any_to_s _((VALUE));
+VALUE rb_inspect _((VALUE));
+VALUE obj_is_instance_of _((VALUE, VALUE));
+VALUE obj_is_kind_of _((VALUE, VALUE));
+VALUE obj_alloc _((VALUE));
+VALUE rb_Integer _((VALUE));
+VALUE rb_Float _((VALUE));
+VALUE rb_String _((VALUE));
+VALUE rb_Array _((VALUE));
+double num2dbl _((VALUE));
+/* parse.y */
+int yyparse _((void));
+void pushback _((int));
+ID id_attrset _((ID));
+void yyappend_print _((void));
+void yywhile_loop _((int, int));
+int rb_is_const_id _((ID));
+int rb_is_instance_id _((ID));
+void local_var_append _((ID));
+VALUE backref_get _((void));
+void backref_set _((VALUE));
+VALUE lastline_get _((void));
+void lastline_set _((VALUE));
+/* process.c */
+int rb_proc_exec _((char *));
+void rb_syswait _((int));
+/* range.c */
+VALUE range_new _((VALUE, VALUE));
+VALUE range_beg_end _((VALUE, int *, int *));
+/* re.c */
+VALUE reg_nth_defined _((int, VALUE));
+VALUE reg_nth_match _((int, VALUE));
+VALUE reg_last_match _((VALUE));
+VALUE reg_match_pre _((VALUE));
+VALUE reg_match_post _((VALUE));
+VALUE reg_match_last _((VALUE));
+VALUE reg_new _((char *, int, int));
+VALUE reg_match _((VALUE, VALUE));
+VALUE reg_match2 _((VALUE));
+void rb_set_kcode _((char *));
+/* ruby.c */
+void rb_require_modules _((void));
+void rb_load_file _((char *));
+void ruby_script _((char *));
+void ruby_prog_init _((void));
+void ruby_set_argv _((int, char **));
+void ruby_process_options _((int, char **));
+/* signal.c */
+VALUE f_kill _((int, VALUE *));
+void gc_mark_trap_list _((void));
+void posix_signal _((int, void (*)()));
+void rb_trap_exit _((void));
+void rb_trap_exec _((void));
+/* sprintf.c */
+VALUE f_sprintf _((int, VALUE *));
+/* string.c */
+VALUE str_new _((UCHAR *, UINT));
+VALUE str_new2 _((UCHAR *));
+VALUE str_new3 _((VALUE));
+VALUE str_new4 _((VALUE));
+VALUE obj_as_string _((VALUE));
+VALUE str_dup _((VALUE));
+VALUE str_plus _((VALUE, VALUE));
+VALUE str_times _((VALUE, VALUE));
+VALUE str_substr _((VALUE, int, int));
+void str_modify _((VALUE));
+VALUE str_freeze _((VALUE));
+VALUE str_dup_freezed _((VALUE));
+VALUE str_taint _((VALUE));
+VALUE str_tainted _((VALUE));
+VALUE str_resize _((VALUE, int));
+VALUE str_cat _((VALUE, UCHAR *, UINT));
+int str_hash _((VALUE));
+int str_cmp _((VALUE, VALUE));
+VALUE str_upto _((VALUE, VALUE));
+VALUE str_inspect _((VALUE));
+VALUE str_split _((VALUE, char *));
+/* struct.c */
+VALUE struct_new();
+VALUE struct_define();
+VALUE struct_alloc _((VALUE, VALUE));
+VALUE struct_aref _((VALUE, VALUE));
+VALUE struct_aset _((VALUE, VALUE, VALUE));
+VALUE struct_getmember _((VALUE, ID));
+/* time.c */
+VALUE time_new _((int, int));
+/* util.c */
+void add_suffix _((VALUE, char *));
+unsigned long scan_oct _((char *, int, int *));
+unsigned long scan_hex _((char *, int, int *));
+/* variable.c */
+VALUE mod_name _((VALUE));
+VALUE rb_class_path _((VALUE));
+void rb_set_class_path _((VALUE, VALUE, char *));
+VALUE rb_path2class _((char *));
+void rb_name_class _((VALUE, ID));
+void rb_autoload _((char *, char *));
+VALUE f_autoload _((VALUE, VALUE, VALUE));
+void gc_mark_global_tbl _((void));
+VALUE f_trace_var _((int, VALUE *));
+VALUE f_untrace_var _((int, VALUE *));
+VALUE rb_gvar_set2 _((char *, VALUE));
+VALUE f_global_variables _((void));
+void rb_alias_variable _((ID, ID));
+VALUE rb_ivar_get _((VALUE, ID));
+VALUE rb_ivar_set _((VALUE, ID, VALUE));
+VALUE rb_ivar_defined _((VALUE, ID));
+VALUE obj_instance_variables _((VALUE));
+VALUE mod_const_at _((VALUE, VALUE));
+VALUE mod_constants _((VALUE));
+VALUE mod_const_of _((VALUE, VALUE));
+int rb_const_defined_at _((VALUE, ID));
+int rb_autoload_defined _((ID));
+int rb_const_defined _((VALUE, ID));

keywords

@@ -0,0 +1,40 @@
+struct kwtable {char *name; int id[2]; enum lex_state state;};
+%%
+BEGIN, klBEGIN, klBEGIN, EXPR_END
+END, klEND, klEND, EXPR_END
+alias, kALIAS, kALIAS, EXPR_FNAME
+and, kAND, kAND, EXPR_BEG
+begin, kBEGIN, kBEGIN, EXPR_BEG
+break, kBREAK, kBREAK, EXPR_END
+case, kCASE, kCASE, EXPR_BEG
+class, kCLASS, kCLASS, EXPR_CLASS
+def, kDEF, kDEF, EXPR_FNAME
+defined?, kDEFINED, kDEFINED, EXPR_END
+do, kDO, kDO, EXPR_BEG
+else, kELSE, kELSE, EXPR_BEG
+elsif, kELSIF, kELSIF, EXPR_BEG
+end, kEND, kEND, EXPR_END
+ensure, kENSURE, kENSURE, EXPR_BEG
+false, kFALSE, kFALSE, EXPR_END
+for, kFOR, kFOR, EXPR_BEG
+if, kIF, kIF_MOD, EXPR_BEG
+in, kIN, kIN, EXPR_BEG
+module, kMODULE, kMODULE, EXPR_BEG
+next, kNEXT, kNEXT, EXPR_END
+nil, kNIL, kNIL, EXPR_END
+not, kNOT, kNOT, EXPR_BEG
+or, kOR, kOR, EXPR_BEG
+redo, kREDO, kREDO, EXPR_END
+rescue, kRESCUE, kRESCUE, EXPR_MID
+retry, kRETRY, kRETRY, EXPR_END
+return, kRETURN, kRETURN, EXPR_MID
+self, kSELF, kSELF, EXPR_END
+super, kSUPER, kSUPER, EXPR_END
+then, kTHEN, kTHEN, EXPR_BEG
+true, kTRUE, kTRUE, EXPR_END
+undef, kUNDEF, kUNDEF, EXPR_FNAME
+unless, kUNLESS, kUNLESS_MOD, EXPR_BEG
+until, kUNTIL, kUNTIL_MOD, EXPR_BEG
+when, kWHEN, kWHEN, EXPR_BEG
+while, kWHILE, kWHILE_MOD, EXPR_BEG
+yield, kYIELD, kYIELD, EXPR_END

lex.c

@@ -0,0 +1,117 @@
+/* C code produced by gperf version 2.5 (GNU C++ version) */
+/* Command-line: gperf -p -j1 -i 1 -g -o -t -N rb_reserved_word -k1,3,$ keywords  */
+struct kwtable {char *name; int id[2]; enum lex_state state;};
+
+#define TOTAL_KEYWORDS 38
+#define MIN_WORD_LENGTH 2
+#define MAX_WORD_LENGTH 8
+#define MIN_HASH_VALUE 6
+#define MAX_HASH_VALUE 52
+/* maximum key range = 47, duplicates = 0 */
+
+#ifdef __GNUC__
+inline
+#endif
+static unsigned int
+hash (str, len)
+     register char *str;
+     register int unsigned len;
+{
+  static unsigned char asso_values[] =
+    {
+     53, 53, 53, 53, 53, 53, 53, 53, 53, 53,
+     53, 53, 53, 53, 53, 53, 53, 53, 53, 53,
+     53, 53, 53, 53, 53, 53, 53, 53, 53, 53,
+     53, 53, 53, 53, 53, 53, 53, 53, 53, 53,
+     53, 53, 53, 53, 53, 53, 53, 53, 53, 53,
+     53, 53, 53, 53, 53, 53, 53, 53, 53, 53,
+     53, 53, 53, 11, 53, 53, 34, 53,  1, 35,
+     53,  1, 53, 53, 53, 53, 53, 53,  1, 53,
+     53, 53, 53, 53, 53, 53, 53, 53, 53, 53,
+     53, 53, 53, 53, 53, 53, 53, 29,  1,  2,
+      1,  1,  4, 24, 53, 17, 53, 20,  9,  2,
+      9, 26, 14, 53,  5,  1,  1, 16, 53, 21,
+     24,  9, 53, 53, 53, 53, 53, 53,
+    };
+  register int hval = len;
+
+  switch (hval)
+    {
+      default:
+      case 3:
+        hval += asso_values[str[2]];
+      case 2:
+      case 1:
+        hval += asso_values[str[0]];
+        break;
+    }
+  return hval + asso_values[str[len - 1]];
+}
+
+#ifdef __GNUC__
+inline
+#endif
+struct kwtable *
+rb_reserved_word (str, len)
+     register char *str;
+     register unsigned int len;
+{
+  static struct kwtable wordlist[] =
+    {
+      {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, 
+      {"end",  kEND, kEND, EXPR_END},
+      {"else",  kELSE, kELSE, EXPR_BEG},
+      {"case",  kCASE, kCASE, EXPR_BEG},
+      {"ensure",  kENSURE, kENSURE, EXPR_BEG},
+      {"module",  kMODULE, kMODULE, EXPR_BEG},
+      {"elsif",  kELSIF, kELSIF, EXPR_BEG},
+      {"def",  kDEF, kDEF, EXPR_FNAME},
+      {"rescue",  kRESCUE, kRESCUE, EXPR_MID},
+      {"not",  kNOT, kNOT, EXPR_BEG},
+      {"then",  kTHEN, kTHEN, EXPR_BEG},
+      {"yield",  kYIELD, kYIELD, EXPR_END},
+      {"for",  kFOR, kFOR, EXPR_BEG},
+      {"self",  kSELF, kSELF, EXPR_END},
+      {"false",  kFALSE, kFALSE, EXPR_END},
+      {"retry",  kRETRY, kRETRY, EXPR_END},
+      {"return",  kRETURN, kRETURN, EXPR_MID},
+      {"true",  kTRUE, kTRUE, EXPR_END},
+      {"if",  kIF, kIF_MOD, EXPR_BEG},
+      {"defined?",  kDEFINED, kDEFINED, EXPR_END},
+      {"super",  kSUPER, kSUPER, EXPR_END},
+      {"undef",  kUNDEF, kUNDEF, EXPR_FNAME},
+      {"break",  kBREAK, kBREAK, EXPR_END},
+      {"in",  kIN, kIN, EXPR_BEG},
+      {"do",  kDO, kDO, EXPR_BEG},
+      {"nil",  kNIL, kNIL, EXPR_END},
+      {"until",  kUNTIL, kUNTIL_MOD, EXPR_BEG},
+      {"unless",  kUNLESS, kUNLESS_MOD, EXPR_BEG},
+      {"or",  kOR, kOR, EXPR_BEG},
+      {"and",  kAND, kAND, EXPR_BEG},
+      {"when",  kWHEN, kWHEN, EXPR_BEG},
+      {"redo",  kREDO, kREDO, EXPR_END},
+      {"class",  kCLASS, kCLASS, EXPR_CLASS},
+      {"next",  kNEXT, kNEXT, EXPR_END},
+      {"begin",  kBEGIN, kBEGIN, EXPR_BEG},
+      {"END",  klEND, klEND, EXPR_END},
+      {"BEGIN",  klBEGIN, klBEGIN, EXPR_END},
+      {"",}, {"",}, 
+      {"while",  kWHILE, kWHILE_MOD, EXPR_BEG},
+      {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, 
+      {"alias",  kALIAS, kALIAS, EXPR_FNAME},
+    };
+
+  if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH)
+    {
+      register int key = hash (str, len);
+
+      if (key <= MAX_HASH_VALUE && key >= 0)
+        {
+          register char *s = wordlist[key].name;
+
+          if (*s == *str && !strcmp (str + 1, s + 1))
+            return &wordlist[key];
+        }
+    }
+  return 0;
+}

lib/delegate.rb

@@ -0,0 +1,44 @@
+#  Delegation class that delegates even methods defined in super class,
+# which can not be covered with normal method_missing hack.
+#  
+#  Delegater is the abstract delegation class. Need to redefine
+# `__getobj__' method in the subclass.  SimpleDelegater is the 
+# concrete subclass for simple delegation.
+#
+# Usage:
+#   foo = Object.new
+#   foo = SimpleDelegater.new(foo)
+#   foo.type # => Object
+
+class Delegater
+
+  def initialize(obj)
+    preserved = ["id", "equal?", "__getobj__"]
+    for t in self.type.ancestors
+      preserved |= t.instance_methods
+      break if t == Delegater
+    end
+    for method in obj.methods
+      next if preserved.include? method
+      eval "def self.#{method}(*args); __getobj__.send :#{method}, *args; end"
+    end
+  end
+
+  def __getobj__
+    raise NotImplementError, "need to define `__getobj__'"
+  end
+
+end
+
+class SimpleDelegater<Delegater
+
+  def initialize(obj)
+    super
+    @obj = obj
+  end
+
+  def __getobj__
+    @obj
+  end
+
+end

lib/eregex.rb

@@ -0,0 +1,39 @@
+
+class RegOr
+  def initialize(re1, re2)
+    @re1 = re1
+    @re2 = re2
+  end
+
+  def =~ (str)
+    @re1 =~ str or @re2 =~ str
+  end
+end
+
+class RegAnd
+  def initialize(re1, re2)
+    @re1 = re1
+    @re2 = re2
+  end
+
+  def =~ (str)
+    @re1 =~ str and @re2 =~ str
+  end
+end
+
+class Regexp
+  def |(other)
+    RegOr.new(self, other)
+  end
+  def &(other)
+    RegAnd.new(self, other)
+  end
+end
+
+p "abc" =~ /b/|/c/
+p "abc" =~ /b/&/c/
+
+
+
+
+

lib/ftools.rb

@@ -0,0 +1,163 @@
+class << File
+
+  TOO_BIG = 1024 * 1024 * 2 # 2MB
+
+  def catname from, to
+    if FileTest.directory? to
+      to +
+	if to =~ /\\/
+	  if to[-1,1] != '\\' then '\\' end + basename(from)
+	else
+	  if to[-1,1] != '/' then '/' end + basename(from)
+	end
+    else
+      to
+    end
+  end
+
+# copy file
+
+  def syscopy from, to
+    to = catname(from, to)
+
+    fsize = size(from)
+    fsize = 1024 if fsize < 512
+    fsize = TOO_BIG if fsize > TOO_BIG
+
+    from = open(from, "r")
+    from.binmode
+    to = open(to, "w")
+    to.binmode
+
+    begin
+      while TRUE
+	r = from.sysread(fsize)
+	rsize = r.size
+        w = 0
+	while w < rsize
+	  t = to.syswrite(r[w, rsize - w])
+	  w += t
+	end
+      end
+    rescue EOFError
+      ret = TRUE
+    rescue
+      ret = FALSE
+    ensure
+      to.close
+      from.close
+    end
+    ret
+  end
+
+  def copy from, to, verbose = FALSE
+    $stderr.print from, " -> ", catname(from, to), "\n" if verbose
+    syscopy from, to
+  end
+
+  alias cp copy
+
+# move file
+
+  def move from, to, verbose = FALSE
+    to = catname(from, to)
+    $stderr.print from, " -> ", to, "\n" if verbose
+
+    if PLATFORM =~ /djgpp|cygwin32|mswin32/ and FileTest.file? to
+      unlink to
+    end
+    begin
+      rename from, to
+    rescue
+      syscopy from, to and unlink from
+    end
+  end
+
+  alias mv move
+
+#  compare two files
+#   TRUE:  identical
+#   FALSE: not identical
+
+  def compare from, to, verbose = FALSE
+    $stderr.print from, " <=> ", to, "\n" if verbose
+    fsize = size(from)
+    fsize = 1024 if fsize < 512
+    fsize = TOO_BIG if fsize > TOO_BIG
+
+    from = open(from, "r")
+    from.binmode
+    to = open(to, "r")
+    to.binmode
+
+    ret = FALSE
+    fr = tr = ''
+
+    begin
+      while fr == tr
+	if fr = from.read(fsize)
+	  tr = to.read(fr.size)
+	else
+	  ret = !to.read(fsize)
+	  break
+	end
+      end
+    rescue
+      ret = FALSE
+    ensure
+      to.close
+      from.close
+    end
+    ret
+  end
+
+  alias cmp compare
+
+#  unlink files safely
+
+  def safe_unlink(*files)
+    verbose = if files[-1].is_a? String then FALSE else files.pop end
+    begin
+      $stderr.print files.join(" "), "\n" if verbose
+      chmod 0777, *files
+      unlink *files
+    rescue
+#      STDERR.print "warning: Couldn't unlink #{files.join ' '}\n"
+    end
+  end
+
+  alias rm_f safe_unlink
+
+  def makedirs(*dirs)
+    verbose = if dirs[-1].is_a? String then FALSE else dirs.pop end
+#    mode = if dirs[-1].is_a? Fixnum then dirs.pop else 0755 end
+    mode = 0755
+    for dir in dirs
+      next if FileTest.directory? dir
+      parent = dirname(dir)
+      makedirs parent unless FileTest.directory? parent
+      $stderr.print "mkdir ", dir, "\n" if verbose
+      Dir.mkdir dir, mode
+    end
+  end
+
+  alias mkpath makedirs
+
+  alias o_chmod chmod
+
+  def chmod(mode, *files)
+    verbose = if files[-1].is_a? String then FALSE else files.pop end
+    $stderr.printf "chmod %04o %s\n", mode, files.join(" ") if verbose
+    o_chmod mode, *files
+  end
+
+  def install(from, to, mode, verbose)
+    to = catname(from, to)
+    unless FileTest.exist? to and cmp from, to
+      cp from, to, verbose
+      chmod mode, to, verbose if mode
+    end
+  end
+
+end
+# vi:set sw=2:

lib/importenv.rb

@@ -0,0 +1,29 @@
+# importenv.rb -- imports environment variables as global variables
+#
+# Usage:
+#
+#  require 'importenv'
+#  p $USER
+#  $USER = "matz"
+#  p ENV["USER"]
+
+for k,v in ENV
+  next unless /^[a-zA-Z][_a-zA-Z0-9]*/ =~ k
+  eval <<EOS
+  $#{k} = %q!#{v}!
+  trace_var "$#{k}", proc{|v|
+    ENV[%q!#{k}!] = v; 
+    $#{k} = %q!#{v}!
+    if v == nil
+      untrace_var "$#{k}"
+    end
+  }
+EOS
+end
+
+p $TERM
+$TERM = nil
+p $TERM
+p ENV["TERM"]
+$TERM = "foo"
+p ENV["TERM"]

lib/mkmf.rb

@@ -0,0 +1,343 @@
+# module to create Makefile for extention modules
+# invoke like: ruby -r mkmf extconf.rb
+
+require 'rbconfig'
+
+include Config
+
+$found = false;
+$lib_cache = {}
+$lib_found = {}
+$func_cache = {}
+$func_found = {}
+$hdr_cache = {}
+$hdr_found = {}
+
+$config_cache = CONFIG["compile_dir"]+"/ext/config.cache"
+if File.exist?($config_cache) then
+  f = open($config_cache, "r")
+  while f.gets
+    case $_
+    when /^lib: (.+) (yes|no)/
+      $lib_cache[$1] = $2
+    when /^func: ([\w_]+) (yes|no)/
+      $func_cache[$1] = $2
+    when /^hdr: (.+) (yes|no)/
+      $hdr_cache[$1] = $2
+    end
+  end
+  f.close
+end
+
+$srcdir = CONFIG["srcdir"]
+$libdir = CONFIG["libdir"]+"/"+CONFIG["ruby_install_name"]
+$archdir = $libdir+"/"+CONFIG["arch"]
+$install = CONFIG["INSTALL_PROGRAM"]
+$install_data = CONFIG["INSTALL_DATA"]
+if $install !~ /^\// then
+  $install = CONFIG["srcdir"]+"/"+$install
+end
+
+if File.exist? $archdir + "/ruby.h"
+  $hdrdir = $archdir
+elsif File.exist? $srcdir + "/ruby.h"
+  $hdrdir = $srcdir
+else
+  STDERR.print "can't find header files for ruby.\n"
+  exit 1
+end
+
+nul = "> /dev/null"
+
+CFLAGS = CONFIG["CFLAGS"]
+if PLATFORM == "m68k-human"
+  nul = "> nul"
+  CFLAGS.gsub!(/-c..-stack=[0-9]+ */, '')
+end
+if $DEBUG
+  nul = ""
+end
+LINK = CONFIG["CC"]+" -o conftest -I#{$srcdir} " + CFLAGS + " %s " + CONFIG["LDFLAGS"] + " %s conftest.c " + CONFIG["LIBS"] + "%s " + nul + " 2>&1"
+CPP = CONFIG["CPP"] + " -E  -I#{$srcdir} " + CFLAGS + " %s conftest.c " + nul + " 2>&1"
+
+def try_link(libs)
+  system(format(LINK, $CFLAGS, $LDFLAGS, libs))
+end
+
+def try_cpp
+  system(format(CPP, $CFLAGS))
+end
+
+def have_library(lib, func)
+  printf "checking for %s() in -l%s... ", func, lib
+  STDOUT.flush
+  if $lib_cache[lib]
+    if $lib_cache[lib] == "yes"
+      if $libs
+        $libs = "-l" + lib + " " + $libs 
+      else
+	$libs = "-l" + lib
+      end
+      print "(cached) yes\n"
+      return TRUE
+    else
+      print "(cached) no\n"
+      return FALSE
+    end
+  end
+
+  cfile = open("conftest.c", "w")
+  cfile.printf "\
+int main() { return 0; }
+int t() { %s(); return 0; }
+", func
+  cfile.close
+
+  begin
+    if $libs
+      libs = "-l" + lib + " " + $libs 
+    else
+      libs = "-l" + lib
+    end
+    unless try_link(libs)
+      $lib_found[lib] = 'no'
+      $found = TRUE
+      print "no\n"
+      return FALSE
+    end
+  ensure
+    system "rm -f conftest*"
+  end
+
+  $libs = libs
+  $lib_found[lib] = 'yes'
+  $found = TRUE
+  print "yes\n"
+  return TRUE
+end
+
+def have_func(func)
+  printf "checking for %s()... ", func
+  STDOUT.flush
+  if $func_cache[func]
+    if $func_cache[func] == "yes"
+      $defs.push(format("-DHAVE_%s", func.upcase))
+      print "(cached) yes\n"
+      return TRUE
+    else
+      print "(cached) no\n"
+      return FALSE
+    end
+  end
+
+  cfile = open("conftest.c", "w")
+  cfile.printf "\
+char %s();
+int main() { return 0; }
+int t() { %s(); return 0; }
+", func, func
+  cfile.close
+
+  libs = $libs
+  libs = "" if libs == nil
+
+  begin
+    unless try_link(libs)
+      $func_found[func] = 'no'
+      $found = TRUE
+      print "no\n"
+      return FALSE
+    end
+  ensure
+    system "rm -f conftest*"
+  end
+  $defs.push(format("-DHAVE_%s", func.upcase))
+  $func_found[func] = 'yes'
+  $found = TRUE
+  print "yes\n"
+  return TRUE
+end
+
+def have_header(header)
+  printf "checking for %s... ", header
+  STDOUT.flush
+  if $hdr_cache[header]
+    if $hdr_cache[header] == "yes"
+      header.tr!("a-z./\055", "A-Z___")
+      $defs.push(format("-DHAVE_%s", header))
+      print "(cached) yes\n"
+      return TRUE
+    else
+      print "(cached) no\n"
+      return FALSE
+    end
+  end
+
+  cfile = open("conftest.c", "w")
+  cfile.printf "\
+#include <%s>
+", header
+  cfile.close
+
+  begin
+    unless try_cpp
+      $hdr_found[header] = 'no'
+      $found = TRUE
+      print "no\n"
+      return FALSE
+    end
+  ensure
+    system "rm -f conftest*"
+  end
+  $hdr_found[header] = 'yes'
+  header.tr!("a-z./\055", "A-Z___")
+  $defs.push(format("-DHAVE_%s", header))
+  $found = TRUE
+  print "yes\n"
+  return TRUE
+end
+
+def create_header()
+  print "creating extconf.h\n"
+  STDOUT.flush
+  if $defs.length > 0
+    hfile = open("extconf.h", "w")
+    for line in $defs
+      line =~ /^-D(.*)/
+      hfile.printf "#define %s 1\n", $1
+    end
+    hfile.close
+  end
+end
+
+def create_makefile(target)
+  print "creating Makefile\n"
+  STDOUT.flush
+  if $libs and CONFIG["DLEXT"] == "o"
+    libs = $libs.split
+    for lib in libs
+      lib.sub!(/-l(.*)/, '"lib\1.a"')
+    end
+    $defs.push(format("-DEXTLIB='%s'", libs.join(",")))
+  end
+  $libs = "" unless $libs
+
+  if !$objs then
+    $objs = Dir["*.c"]
+    for f in $objs
+      f.sub!(/\.(c|cc)$/, ".o")
+    end
+  end
+  $objs = $objs.join(" ")
+
+  mfile = open("Makefile", "w")
+  mfile.print  <<EOMF
+SHELL = /bin/sh
+
+#### Start of system configuration section. ####
+
+srcdir = #{$srcdir}
+hdrdir = #{$hdrdir}
+
+CC = gcc
+
+CFLAGS   = #{CONFIG["CCDLFLAGS"]} -I#{$hdrdir} #{CFLAGS} #{$CFLAGS} #{$defs.join(" ")}
+DLDFLAGS = #{CONFIG["DLDFLAGS"]} #{$LDFLAGS}
+LDSHARED = #{CONFIG["LDSHARED"]}
+
+prefix = #{CONFIG["prefix"]}
+exec_prefix = #{CONFIG["exec_prefix"]}
+libdir = #{$archdir}
+
+#### End of system configuration section. ####
+
+LOCAL_LIBS = #{$local_libs}
+LIBS = #{$libs}
+OBJS = #{$objs}
+
+TARGET = #{target}.#{CONFIG["DLEXT"]}
+
+INSTALL = #{$install}
+
+binsuffix = #{CONFIG["binsuffix"]}
+
+all:		$(TARGET)
+
+clean:;		@rm -f *.o *.so *.sl
+		@rm -f Makefile extconf.h conftest.*
+		@rm -f core ruby$(binsuffix) *~
+
+realclean:	clean
+
+install:	$(libdir)/$(TARGET)
+
+$(libdir)/$(TARGET): $(TARGET)
+	@test -d $(libdir) || mkdir $(libdir)
+	$(INSTALL) $(TARGET) $(libdir)/$(TARGET)
+EOMF
+  for rb in Dir["lib/*.rb"]
+    mfile.printf "\t$(INSTALL) %s %s\n", rb, $libdir
+  end
+  mfile.printf "\n"
+
+  if CONFIG["DLEXT"] != "o"
+    mfile.printf <<EOMF
+$(TARGET): $(OBJS)
+	$(LDSHARED) $(DLDFLAGS) -o $(TARGET) $(OBJS) $(LOCAL_LIBS) $(LIBS)
+EOMF
+  elsif not File.exist?(target + ".c") and not File.exist?(target + ".cc") or 
+    mfile.print "$(TARGET): $(OBJS)\n"
+    case PLATFORM
+    when "m68k-human"
+      mfile.printf "ar cru $(TARGET) $(OBJS)\n"
+    when /-nextstep/
+      mfile.printf "cc -r $(CFLAGS) -o $(TARGET) $(OBJS)\n"
+    else
+      mfile.printf "ld $(DLDFLAGS) -r -o $(TARGET) $(OBJS)\n"
+    end
+  end
+
+  if File.exist?("depend")
+    dfile = open("depend", "r")
+    mfile.printf "###\n"
+    while line = dfile.gets()
+      mfile.print line
+    end
+    dfile.close
+  end
+  mfile.close
+
+  if $found
+    begin
+      f = open($config_cache, "w")
+      for k,v in $lib_cache
+	f.printf "lib: %s %s\n", k, v.downcase
+      end
+      for k,v in $lib_found
+	f.printf "lib: %s %s\n", k, v.downcase
+      end
+      for k,v in $func_cache
+	f.printf "func: %s %s\n", k, v.downcase
+      end
+      for k,v in $func_found
+	f.printf "func: %s %s\n", k, v.downcase
+      end
+      for k,v in $hdr_cache
+	f.printf "hdr: %s %s\n", k, v.downcase
+      end
+      for k,v in $hdr_found
+	f.printf "hdr: %s %s\n", k, v.downcase
+      end
+      f.close
+    rescue
+    end
+  end
+end
+
+$local_libs = nil
+$libs = nil
+$objs = nil
+$CFLAGS = nil
+$LDFLAGS = nil
+$defs = []
+

lib/ostruct.rb

@@ -0,0 +1,55 @@
+# ostruct.rb - Python Style Object
+#  just assign to create field
+#
+# s = OpenStruct.new
+# s.foo = 25
+# p s.foo
+# s.bar = 2
+# p s.bar
+# p s
+
+class OpenStruct
+  def initialize(hash=nil)
+    @table = {}
+    if hash
+      for k,v in hash
+	@table[k] = v
+      end
+    end
+  end
+
+  def method_missing(mid, *args)
+    mname = mid.id2name
+    len = args.length
+    if mname =~ /=$/
+      if len != 1
+	raise ArgumentError, "wrong # of arguments (#{len} for 1)", caller(1)
+      end
+      mname.chop!
+      @table[mname] = args[0]
+    elsif args.length == 0
+      @table[mname]
+    else
+      raise NameError, "undefined method `#{mname}'", caller(1)
+    end
+  end
+  
+  def delete_field(name)
+    if name.type == Fixnum
+      name = name.id2name
+    end
+    @table.delete name
+  end
+
+  def inspect
+    str = "<#{self.type}"
+    for k,v in @table
+      str += " "
+      str += k
+      str += "="
+      str += v.inspect
+    end
+    str += ">"
+    str
+  end
+end

lib/pstore.rb

@@ -0,0 +1,121 @@
+#!/usr/local/bin/ruby
+
+# How to use:
+#
+# db = PStore.new("/tmp/foo")
+# db.transaction do
+#   p db.roots
+#   ary = db["root"] = [1,2,3,4]
+#   ary[0] = [1,1.5]
+# end
+
+# db.transaction do
+#   p db["root"]
+# end
+
+require "marshal"
+
+class PStore
+  Exception(:Error)
+
+  def initialize(file)
+    dir = File::dirname(file)
+    unless File::directory? dir
+      raise PStore::Error, format("directory %s does not exist", dir)
+    end
+    unless File::writable? dir
+      raise PStore::Error, format("directory %s not writable", dir)
+    end
+    if File::exist? file and not File::readable? file
+      raise PStore::Error, format("file %s not readable", file)
+    end
+    @transaction = false
+    @filename = file
+    @abort = false
+  end
+
+  def in_transaction
+    raise PStore::Error, "not in transaction" unless @transaction
+  end
+  private :in_transaction
+
+  def [](name)
+    in_transaction
+    value = @table[name]
+    if value == nil
+      raise PStore::Error, format("undefined root name `%s'", name)
+    end
+    value
+  end
+  def []=(name, value)
+    in_transaction
+    @table[name] = value
+  end
+
+  def roots
+    in_transaction
+    @table.keys
+  end
+  def root?(name)
+    in_transaction
+    @table.key? name
+  end
+  def path
+    @filename
+  end
+
+  def commit
+    @abort = false
+    throw :pstore_abort_transaction
+  end
+  def abort
+    @abort = true
+    throw :pstore_abort_transaction
+  end
+
+  def transaction
+    raise PStore::Error, "nested transaction" if @transaction
+    begin
+      @transaction = true
+      value = file = nil
+      begin
+	File::open(@filename, "r") do |file|
+	  @table = Marshal.load(file)
+	end
+      rescue Errno::ENOENT
+	@table = {}
+      end
+      begin
+	catch(:pstore_abort_transaction) do
+	  value = yield(self)
+	end
+      ensure
+	unless @abort
+	  File::rename @filename, @filename+"~"
+	  begin
+	    File::open(@filename, "w") do |file|
+	      Marshal::dump(@table, file)
+	    end
+	  rescue
+	    File::rename @filename+"~", @filename
+	  end
+	end
+	@abort = false
+      end
+    ensure
+      @transaction = false
+    end
+    value
+  end
+end
+
+db = PStore.new("/tmp/foo")
+db.transaction do
+  p db.roots
+  ary = db["root"] = [1,2,3,4]
+  ary[0] = [1,1.5]
+end
+
+db.transaction do
+  p db["root"]
+end

lib/shellwords.rb

@@ -0,0 +1,48 @@
+# shellwords.rb
+# original is shellwords.pl
+#
+# Usage:
+#       require 'shellwords.rb'
+#       words = Shellwords.shellwords(line)
+#
+#	   or
+#
+#       include Shellwords
+#       words = shellwords(line)
+
+module Shellwords
+  def shellwords(line)
+    return '' unless line
+    line.sub! /^\s+/, ''
+    words = []
+    while line != ''
+      field = ''
+      while TRUE
+	if line.sub! /^"(([^"\\]|\\.)*)"/, '' then
+	  snippet = $1
+	  snippet.gsub! /\\(.)/, '\1'
+	elsif line =~ /^"/ then
+	  STDOUT.print "Unmatched double quote: $_\n"
+	  exit
+        elsif line.sub! /^'(([^'\\]|\\.)*)'/, '' then
+	  snippet = $1
+	  snippet.gsub! /\\(.)/, '\1'
+	elsif line =~ /^'/ then
+	  STDOUT.print "Unmatched single quote: $_\n"
+	  exit
+	elsif line.sub! /^\\(.)/, '' then
+	  snippet = $1
+	elsif line.sub! /^([^\s\\'"]+)/, '' then
+	  snippet = $1
+	else
+	  line.sub! /^\s+/, ''
+	  break
+	end
+	field += snippet
+      end
+      words += field
+    end
+    words
+  end
+  module_function :shellwords
+end

lib/tkdialog.rb

@@ -0,0 +1,62 @@
+require "tk"
+
+class TkDialog < TkWindow
+  # initialize tk_dialog
+  def initialize
+    super
+    @var = TkVariable.new
+    id = @var.id
+    INTERP._eval('eval {global '+id+';'+
+		 'set '+id+' [tk_dialog '+ 
+		 @path+" "+title+" \"#{message}\" "+bitmap+" "+
+		 default_button+" "+buttons+']}')
+  end
+  def value
+    return @var.value.to_i
+  end
+  ######################################################
+  #                                                    #
+  # these methods must be overridden for each dialog   #
+  #                                                    #
+  ######################################################
+  def title
+    return "DIALOG"
+  end
+  def message
+    return "MESSAGE"
+  end
+  def bitmap
+    return "info"
+  end
+  def default_button
+    return 0
+  end
+  def buttons
+    return "BUTTON1 BUTTON2"
+  end
+end
+
+#
+# dialog for warning
+#
+class TkWarning < TkDialog
+  def initialize(mes)
+    @mes = mes
+    super()
+  end
+  def message
+    return @mes
+  end
+  def title
+    return "WARNING";
+  end
+  def bitmap
+    return "warning";
+  end
+  def default_button
+    return 0;
+  end
+  def buttons
+    return "OK";
+  end
+end

lib/weakref.rb

@@ -0,0 +1,70 @@
+# Weak Reference class that does not bother GCing.
+#
+# Usage:
+#   foo = Object.new
+#   foo.hash
+#   foo = WeakRef.new(foo)
+#   foo.hash
+#   ObjectSpace.garbage_collect
+#   foo.hash	# => Raises WeakRef::RefError (because original GC'ed)
+
+require "delegate"
+
+class WeakRef<Delegater
+
+  Exception :RefError
+
+  ID_MAP =  {}
+  ID_REV_MAP =  {}
+  ObjectSpace.add_finalizer(lambda{|id|
+			      rid = ID_MAP[id]
+			      if rid
+				ID_REV_MAP[rid] = nil
+				ID_MAP[id] = nil
+			      end
+			      rid = ID_REV_MAP[id]
+			      if rid
+				ID_REV_MAP[id] = nil
+				ID_MAP[rid] = nil
+			      end
+			    })
+			    
+  def initialize(orig)
+    super
+    @id = orig.id
+    ObjectSpace.call_finalizer orig
+    ID_MAP[@id] = self.id
+    ID_REV_MAP[self.id] = @id
+  end
+
+  def __getobj__
+    unless ID_MAP[@id]
+      $@ = caller(1)
+      $! = RefError.new("Illegal Reference - probably recycled")
+      raise
+    end
+    ObjectSpace.id2ref(@id)
+#    ObjectSpace.each_object do |obj|
+#      return obj if obj.id == @id
+#    end
+  end
+
+  def weakref_alive?
+    if ID_MAP[@id]
+      true
+    else
+      false
+    end
+  end
+
+  def []
+    __getobj__
+  end
+end
+
+foo = Object.new
+p foo.hash
+foo = WeakRef.new(foo)
+p foo.hash
+ObjectSpace.garbage_collect
+p foo.hash

marshal.c

@@ -0,0 +1,868 @@
+/************************************************
+
+  marshal.c -
+
+  $Author$
+  $Revision$
+  $Date$
+  created at: Thu Apr 27 16:30:01 JST 1995
+
+************************************************/
+
+#include "ruby.h"
+#include "io.h"
+#include "st.h"
+
+#define MARSHAL_MAJOR   4
+#define MARSHAL_MINOR   0
+
+#define TYPE_NIL	'0'
+#define TYPE_TRUE	'T'
+#define TYPE_FALSE	'F'
+#define TYPE_FIXNUM	'i'
+
+#define TYPE_UCLASS	'C'
+#define TYPE_OBJECT	'o'
+#define TYPE_USERDEF	'u'
+#define TYPE_FLOAT	'f'
+#define TYPE_BIGNUM	'l'
+#define TYPE_STRING	'"'
+#define TYPE_REGEXP	'/'
+#define TYPE_ARRAY	'['
+#define TYPE_HASH	'{'
+#define TYPE_STRUCT	'S'
+#define TYPE_MODULE	'M'
+
+#define TYPE_SYMBOL	':'
+#define TYPE_SYMLINK	';'
+
+#define TYPE_LINK	'@'
+
+extern VALUE cString;
+extern VALUE cRegexp;
+extern VALUE cArray;
+extern VALUE cHash;
+
+VALUE rb_path2class();
+
+static ID s_dump, s_load;
+
+struct dump_arg {
+    VALUE obj;
+    FILE *fp;
+    VALUE str;
+    st_table *symbol;
+    st_table *data;
+};
+
+struct dump_call_arg {
+    VALUE obj;
+    struct dump_arg *arg;
+    int limit;
+};
+
+static void w_long _((long, struct dump_arg*));
+
+static void
+w_byte(c, arg)
+    char c;
+    struct dump_arg *arg;
+{
+    if (arg->fp) putc(c, arg->fp);
+    else str_cat(arg->str, (UCHAR*)&c, 1);
+}
+
+static void
+w_bytes(s, n, arg)
+    char *s;
+    int n;
+    struct dump_arg *arg;
+{
+    w_long(n, arg);
+    if (arg->fp) {
+	fwrite(s, 1, n, arg->fp);
+    }
+    else {
+	str_cat(arg->str, s, n);
+    }
+}
+
+static void
+w_short(x, arg)
+    int x;
+    struct dump_arg *arg;
+{
+    int i;
+
+    for (i=0; i<sizeof(USHORT); i++) {
+	w_byte((x >> (i*8)) & 0xff, arg);
+    }
+}
+
+static void
+w_long(x, arg)
+    long x;
+    struct dump_arg *arg;
+{
+    char buf[sizeof(long)+1];
+    int i, len = 0;
+
+    if (x == 0) {
+	w_byte(0, arg);
+	return;
+    }
+    for (i=1;i<sizeof(long)+1;i++) {
+	buf[i] = x & 0xff;
+	x = RSHIFT(x,8);
+	if (x == 0) {
+	    buf[0] = i;
+	    break;
+	}
+	if (x == -1) {
+	    buf[0] = -i;
+	    break;
+	}
+    }
+    len = i;
+    for (i=0;i<=len;i++) {
+	w_byte(buf[i], arg);
+    }
+}
+
+static void
+w_float(d, arg)
+    double d;
+    struct dump_arg *arg;
+{
+    char buf[100];
+
+    sprintf(buf, "%.12g", d);
+    w_bytes(buf, strlen(buf), arg);
+}
+
+static void
+w_symbol(id, arg)
+    ID id;
+    struct dump_arg *arg;
+{
+    char *sym = rb_id2name(id);
+    int num;
+
+    if (st_lookup(arg->symbol, id, &num)) {
+	w_byte(TYPE_SYMLINK, arg);
+	w_long(num, arg);
+    }
+    else {
+	w_byte(TYPE_SYMBOL, arg);
+	w_bytes(sym, strlen(sym), arg);
+	st_insert(arg->symbol, id, arg->symbol->num_entries);
+    }
+}
+
+static void
+w_unique(s, arg)
+    char *s;
+    struct dump_arg *arg;
+{
+    w_symbol(rb_intern(s), arg);
+}
+
+static void w_object _((VALUE,struct dump_arg*,int));
+extern VALUE cIO, cBignum, cStruct;
+
+static int
+hash_each(key, value, arg)
+    VALUE key, value;
+    struct dump_call_arg *arg;
+{
+    w_object(key, arg->arg, arg->limit);
+    w_object(value, arg->arg, arg->limit);
+    return ST_CONTINUE;
+}
+
+static int
+obj_each(id, value, arg)
+    ID id;
+    VALUE value;
+    struct dump_call_arg *arg;
+{
+    w_symbol(id, arg->arg);
+    w_object(value, arg->arg, arg->limit);
+    return ST_CONTINUE;
+}
+
+static void
+w_uclass(obj, class, arg)
+    VALUE obj, class;
+    struct dump_arg *arg;
+{
+    if (CLASS_OF(obj) != class) {
+	w_byte(TYPE_UCLASS, arg);
+	w_unique(rb_class2name(CLASS_OF(obj)), arg);
+    }
+}
+
+static void
+w_object(obj, arg, limit)
+    VALUE obj;
+    struct dump_arg *arg;
+    int limit;
+{
+    int n;
+    struct dump_call_arg c_arg;
+
+    if (limit == 0) {
+	Fail("exceed depth limit");
+    }
+    limit--;
+    c_arg.limit = limit;
+    c_arg.arg = arg;
+
+    if (obj == Qnil) {
+	w_byte(TYPE_NIL, arg);
+    }
+    else if (obj == TRUE) {
+	w_byte(TYPE_TRUE, arg);
+    }
+    else if (obj == FALSE) {
+	w_byte(TYPE_FALSE, arg);
+    }
+    else if (FIXNUM_P(obj)) {
+#if SIZEOF_LONG <= 4
+	w_byte(TYPE_FIXNUM, arg);
+	w_long(FIX2INT(obj), arg);
+#else
+	if (RSHIFT(obj, 32) == 0 || RSHIFT(obj, 32) == -1) {
+	    w_byte(TYPE_FIXNUM, arg);
+	    w_long(FIX2INT(obj), arg);
+	}
+	else {
+	    obj = int2big(FIX2INT(obj));
+	    goto write_bignum;
+	}
+#endif
+    }
+    else {
+	int num;
+
+	if (st_lookup(arg->data, obj, &num)) {
+	    w_byte(TYPE_LINK, arg);
+	    w_long(num, arg);
+	    return;
+	}
+
+	st_insert(arg->data, obj, arg->data->num_entries);
+	if (rb_respond_to(obj, s_dump)) {
+	    VALUE v;
+
+	    w_byte(TYPE_USERDEF, arg);
+	    w_unique(rb_class2name(CLASS_OF(obj)), arg);
+	    v = rb_funcall(obj, s_dump, 1, limit);
+	    if (TYPE(v) != T_STRING) {
+		TypeError("_dump_to must return String");
+	    }
+	    w_bytes(RSTRING(v)->ptr, RSTRING(v)->len, arg);
+	    return;
+	}
+
+	switch (BUILTIN_TYPE(obj)) {
+	  case T_MODULE:
+	  case T_CLASS:
+	    w_byte(TYPE_MODULE, arg);
+	    {
+		VALUE path = rb_class_path(obj);
+		w_bytes(RSTRING(path)->ptr, RSTRING(path)->len, arg);
+	    }
+	    return;
+
+	  case T_FLOAT:
+	    w_byte(TYPE_FLOAT, arg);
+	    w_float(RFLOAT(obj)->value, arg);
+	    return;
+
+	  case T_BIGNUM:
+	  write_bignum:
+	    w_byte(TYPE_BIGNUM, arg);
+	    {
+		char sign = RBIGNUM(obj)->sign?'+':'-';
+		int len = RBIGNUM(obj)->len;
+		USHORT *d = RBIGNUM(obj)->digits;
+
+		w_byte(sign, arg);
+		w_long(len, arg);
+		while (len--) {
+		    w_short(*d, arg);
+		    d++;
+		}
+	    }
+	    return;
+
+	  case T_STRING:
+	    w_uclass(obj, cString, arg);
+	    w_byte(TYPE_STRING, arg);
+	    w_bytes(RSTRING(obj)->ptr, RSTRING(obj)->len, arg);
+	    return;
+
+	  case T_REGEXP:
+	    w_uclass(obj, cRegexp, arg);
+	    w_byte(TYPE_REGEXP, arg);
+	    w_bytes(RREGEXP(obj)->str, RREGEXP(obj)->len, arg);
+	    w_byte(FL_TEST(obj, FL_USER1), arg);
+	    return;
+
+	  case T_ARRAY:
+	    w_uclass(obj, cArray, arg);
+	    w_byte(TYPE_ARRAY, arg);
+	    {
+		int len = RARRAY(obj)->len;
+		VALUE *ptr = RARRAY(obj)->ptr;
+
+		w_long(len, arg);
+		while (len--) {
+		    w_object(*ptr, arg, limit);
+		    ptr++;
+		}
+	    }
+	    break;
+
+	  case T_HASH:
+	    w_uclass(obj, cHash, arg);
+	    w_byte(TYPE_HASH, arg);
+	    w_long(RHASH(obj)->tbl->num_entries, arg);
+	    st_foreach(RHASH(obj)->tbl, hash_each, &c_arg);
+	    break;
+
+	  case T_STRUCT:
+	    w_byte(TYPE_STRUCT, arg);
+	    {
+		int len = RSTRUCT(obj)->len;
+		char *path = rb_class2name(CLASS_OF(obj));
+		VALUE mem;
+		int i;
+
+		w_unique(path, arg);
+		w_long(len, arg);
+		mem = rb_ivar_get(CLASS_OF(obj), rb_intern("__member__"));
+		if (mem == Qnil) {
+		    Fatal("non-initialized struct");
+		}
+		for (i=0; i<len; i++) {
+		    w_symbol(FIX2INT(RARRAY(mem)->ptr[i]), arg);
+		    w_object(RSTRUCT(obj)->ptr[i], arg, limit);
+		}
+	    }
+	    break;
+
+	  case T_OBJECT:
+	    w_byte(TYPE_OBJECT, arg);
+	    {
+		VALUE class = CLASS_OF(obj);
+		char *path;
+
+		if (FL_TEST(class, FL_SINGLETON)) {
+		    TypeError("singleton can't be dumped");
+		}
+		path = rb_class2name(class);
+		w_unique(path, arg);
+		if (ROBJECT(obj)->iv_tbl) {
+		    w_long(ROBJECT(obj)->iv_tbl->num_entries, arg);
+		    st_foreach(ROBJECT(obj)->iv_tbl, obj_each, &c_arg);
+		}
+		else {
+		    w_long(0, arg);
+		}
+	    }
+	    break;
+
+	  default:
+	    TypeError("can't dump %s", rb_class2name(CLASS_OF(obj)));
+	    break;
+	}
+    }
+}
+
+static VALUE
+dump(arg)
+    struct dump_call_arg *arg;
+{
+    w_object(arg->obj, arg->arg, arg->limit);
+}
+
+static VALUE
+dump_ensure(arg)
+    struct dump_arg *arg;
+{
+    st_free_table(arg->symbol);
+    st_free_table(arg->data);
+}
+
+static VALUE
+marshal_dump(argc, argv)
+    int argc;
+    VALUE* argv;
+{
+    VALUE obj, port, a1, a2;
+    int limit = -1;
+    extern VALUE cIO;
+    struct dump_arg arg;
+    struct dump_call_arg c_arg;
+
+    port = 0;
+    rb_scan_args(argc, argv, "12", &obj, &a1, &a2);
+    if (argc == 3) {
+	limit = NUM2INT(a2);
+	port = a1;
+    }
+    else if (argc == 2) {
+	if (FIXNUM_P(a1)) limit = FIX2INT(a1);
+	else port = a1;
+    }
+    if (port) {
+	if (obj_is_kind_of(port, cIO)) {
+	    OpenFile *fptr;
+
+	    io_binmode(port);
+	    GetOpenFile(port, fptr);
+	    io_writable(fptr);
+	    arg.fp = (fptr->f2) ? fptr->f2 : fptr->f;
+	}
+	else {
+	    TypeError("instance of IO needed");
+	}
+    }
+    else {
+	arg.fp = 0;
+	port = str_new(0, 0);
+	arg.str = port;
+    }
+
+    arg.symbol = st_init_numtable();
+    arg.data   = st_init_numtable();
+    c_arg.obj = obj;
+    c_arg.arg = &arg;
+    c_arg.limit = limit;
+
+    w_byte(MARSHAL_MAJOR, &arg);
+    w_byte(MARSHAL_MINOR, &arg);
+
+    rb_ensure(dump, &c_arg, dump_ensure, &arg);
+
+    return port;
+}
+
+struct load_arg {
+    FILE *fp;
+    UCHAR *ptr, *end;
+    st_table *symbol;
+    st_table *data;
+    VALUE proc;
+};
+
+static int
+r_byte(arg)
+    struct load_arg *arg;
+{
+    if (arg->fp) return getc(arg->fp);
+    if (arg->ptr < arg->end) return *arg->ptr++;
+    return EOF;
+}
+
+static USHORT
+r_short(arg)
+    struct load_arg *arg;
+{
+    USHORT x;
+    int i;
+
+    x = 0;
+    for (i=0; i<sizeof(USHORT); i++) {
+	x |= r_byte(arg)<<(i*8);
+    }
+
+    return x;
+}
+
+static void
+long_toobig(size)
+    int size;
+{
+    TypeError("long too big for this architecture (size %d, given %d)",
+	      sizeof(long), size);
+}
+
+static long
+r_long(arg)
+    struct load_arg *arg;
+{
+    int c = r_byte(arg), i;
+    register long x;
+
+    if (c == 0) return 0;
+    if (c > 0) {
+	if (c > sizeof(long)) long_toobig((int)c);
+	x = 0;
+	for (i=0;i<c;i++) {
+	    x |= (long)r_byte(arg) << (8*i);
+	}
+    }
+    else if (c < 0) {
+	c = -c;
+	if (c > sizeof(long)) long_toobig((int)c);
+	x = -1;
+	for (i=0;i<c;i++) {
+	    x &= ~(0xff << (8*i));
+	    x |= (long)r_byte(arg) << (8*i);
+	}
+    }
+    return x;
+}
+
+#define r_bytes(s, arg) \
+  (s = (char*)r_long(arg), r_bytes0(&s,ALLOCA_N(char,(long)s),(long)s,arg))
+
+static int
+r_bytes0(sp, s, len, arg)
+    char **sp, *s;
+    int len;
+    struct load_arg *arg;
+{
+    if (arg->fp) {
+	len = fread(s, 1, len, arg->fp);
+    }
+    else {
+	if (arg->ptr + len > arg->end) {
+	    len = arg->end - arg->ptr;
+	}
+	memcpy(s, arg->ptr, len);
+	arg->ptr += len;
+    }
+
+    (s)[len] = '\0';
+    *sp = s;
+
+    return len;
+}
+
+static ID
+r_symbol(arg)
+    struct load_arg *arg;
+{
+    char *buf;
+    ID id;
+    char type;
+
+    if (r_byte(arg) == TYPE_SYMLINK) {
+	int num = r_long(arg);
+
+	if (st_lookup(arg->symbol, num, &id)) {
+	    return id;
+	}
+	TypeError("bad symbol");
+    }
+    r_bytes(buf, arg);
+    id = rb_intern(buf);
+    st_insert(arg->symbol, arg->symbol->num_entries, id);
+
+    return id;
+}
+
+static char*
+r_unique(arg)
+    struct load_arg *arg;
+{
+    return rb_id2name(r_symbol(arg));
+}
+
+static VALUE
+r_string(arg)
+    struct load_arg *arg;
+{
+    char *buf;
+    int len = r_bytes(buf, arg);
+
+    return str_taint(str_new(buf, len));
+}
+
+static VALUE
+r_regist(v, arg)
+    VALUE v;
+    struct load_arg *arg;
+{
+    if (arg->proc) {
+	rb_funcall(arg->proc, rb_intern("call"), 1, v);
+    }
+    st_insert(arg->data, arg->data->num_entries, v);
+    return v;
+}
+
+static VALUE
+r_object(arg)
+    struct load_arg *arg;
+{
+    VALUE v;
+    int type = r_byte(arg);
+
+    switch (type) {
+      case EOF:
+	eof_error();
+	return Qnil;
+
+      case TYPE_LINK:
+	if (st_lookup(arg->data, r_long(arg), &v)) {
+	    return v;
+	}
+	ArgError("dump format error (unlinked)");
+	break;
+
+      case TYPE_UCLASS:
+	{
+	    VALUE c = rb_path2class(r_unique(arg));
+	    v = r_object(arg);
+	    if (rb_special_const_p(v)) {
+		ArgError("dump format error (user class)");
+	    }
+	    RBASIC(v)->class = c;
+	    return v;
+	}
+
+      case TYPE_NIL:
+	return Qnil;
+
+      case TYPE_TRUE:
+	return TRUE;
+
+      case TYPE_FALSE:
+	return FALSE;
+
+      case TYPE_FIXNUM:
+	{
+	    int i = r_long(arg);
+	    return INT2FIX(i);
+	}
+
+      case TYPE_FLOAT:
+	{
+#ifndef atof
+	    double atof();
+#endif
+	    char *buf;
+
+	    r_bytes(buf, arg);
+	    v = float_new(atof(buf));
+	    return r_regist(v, arg);
+	}
+
+      case TYPE_BIGNUM:
+	{
+	    int len;
+	    USHORT *digits;
+
+	    NEWOBJ(big, struct RBignum);
+	    OBJSETUP(big, cBignum, T_BIGNUM);
+	    big->sign = (r_byte(arg) == '+');
+	    big->len = len = r_long(arg);
+	    big->digits = digits = ALLOC_N(USHORT, len);
+	    while (len--) {
+		*digits++ = r_short(arg);
+	    }
+	    big = RBIGNUM(big_norm((VALUE)big));
+	    if (TYPE(big) == T_BIGNUM) {
+		r_regist(big, arg);
+	    }
+	    return (VALUE)big;
+	}
+
+      case TYPE_STRING:
+	return r_regist(r_string(arg), arg);
+
+      case TYPE_REGEXP:
+	{
+	    char *buf;
+	    int len = r_bytes(buf, arg);
+	    int ci = r_byte(arg);
+	    return r_regist(reg_new(buf, len, ci), arg);
+	}
+
+      case TYPE_ARRAY:
+	{
+	    volatile int len = r_long(arg);
+	    v = ary_new2(len);
+	    r_regist(v, arg);
+	    while (len--) {
+		ary_push(v, r_object(arg));
+	    }
+	    return v;
+	}
+
+      case TYPE_HASH:
+	{
+	    int len = r_long(arg);
+
+	    v = hash_new();
+	    r_regist(v, arg);
+	    while (len--) {
+		VALUE key = r_object(arg);
+		VALUE value = r_object(arg);
+		hash_aset(v, key, value);
+	    }
+	    return v;
+	}
+
+      case TYPE_STRUCT:
+	{
+	    VALUE class, mem, values;
+	    volatile int i;	/* gcc 2.7.2.3 -O2 bug?? */
+	    int len;
+	    ID slot;
+
+	    class = rb_path2class(r_unique(arg));
+	    mem = rb_ivar_get(class, rb_intern("__member__"));
+	    if (mem == Qnil) {
+		Fatal("non-initialized struct");
+	    }
+	    len = r_long(arg);
+
+	    values = ary_new2(len);
+	    for (i=0; i<len; i++) {
+		ary_push(values, Qnil);
+	    }
+	    v = struct_alloc(class, values);
+	    r_regist(v, arg);
+	    for (i=0; i<len; i++) {
+		slot = r_symbol(arg);
+
+		if (RARRAY(mem)->ptr[i] != INT2FIX(slot)) {
+		    TypeError("struct %s not compatible (:%s for :%s)",
+			      rb_class2name(class),
+			      rb_id2name(slot),
+			      rb_id2name(FIX2INT(RARRAY(mem)->ptr[i])));
+		}
+		struct_aset(v, INT2FIX(i), r_object(arg));
+	    }
+	    return v;
+	}
+	break;
+
+      case TYPE_USERDEF:
+        {
+	    VALUE class;
+	    int len;
+
+	    class = rb_path2class(r_unique(arg));
+	    if (rb_respond_to(class, s_load)) {
+		v = rb_funcall(class, s_load, 1, r_string(arg));
+		return r_regist(v, arg);
+	    }
+	    TypeError("class %s needs to have method `_load_from'",
+		      rb_class2name(class));
+	}
+        break;
+
+      case TYPE_OBJECT:
+	{
+	    VALUE class;
+	    int len;
+
+	    class = rb_path2class(r_unique(arg));
+	    len = r_long(arg);
+	    v = obj_alloc(class);
+	    r_regist(v, arg);
+	    if (len > 0) {
+		while (len--) {
+		    ID id = r_symbol(arg);
+		    VALUE val = r_object(arg);
+		    rb_ivar_set(v, id, val);
+		}
+	    }
+	    return v;
+	}
+	break;
+
+      case TYPE_MODULE:
+        {
+	    char *buf;
+	    r_bytes(buf, arg);
+	    return rb_path2class(buf);
+	}
+
+      default:
+	ArgError("dump format error(0x%x)", type);
+	break;
+    }
+}
+
+static VALUE
+load(arg)
+    struct load_arg *arg;
+{
+    return r_object(arg);
+}
+
+static VALUE
+load_ensure(arg)
+    struct load_arg *arg;
+{
+    st_free_table(arg->symbol);
+    st_free_table(arg->data);
+}
+
+static VALUE
+marshal_load(argc, argv)
+    int argc;
+    VALUE *argv;
+{
+    VALUE port, proc;
+    FILE *fp;
+    int major;
+    VALUE v;
+    OpenFile *fptr;
+    struct load_arg arg;
+
+    rb_scan_args(argc, argv, "11", &port, &proc);
+    if (TYPE(port) == T_STRING) {
+	arg.fp = 0;
+	arg.ptr = RSTRING(port)->ptr;
+	arg.end = arg.ptr + RSTRING(port)->len;
+    }
+    else {
+	if (obj_is_kind_of(port, cIO)) {
+	    io_binmode(port);
+	    GetOpenFile(port, fptr);
+	    io_readable(fptr);
+	    arg.fp = fptr->f;
+	}
+	else {
+	    TypeError("instance of IO needed");
+	}
+    }
+
+    major = r_byte(&arg);
+    if (major == MARSHAL_MAJOR) {
+	if (r_byte(&arg) != MARSHAL_MINOR) {
+	    Warning("Old marshal file format (can be read)");
+	}
+	arg.symbol = st_init_numtable();
+	arg.data   = st_init_numtable();
+	if (NIL_P(proc)) arg.proc = 0;
+	else             arg.proc = proc;
+	v = rb_ensure(load, &arg, load_ensure, &arg);
+    }
+    else {
+	TypeError("Old marshal file format (can't read)");
+    }
+
+    return v;
+}
+
+Init_marshal()
+{
+    VALUE mMarshal = rb_define_module("Marshal");
+
+    s_dump = rb_intern("_dump_to");
+    s_load = rb_intern("_load_from");
+    rb_define_module_function(mMarshal, "dump", marshal_dump, -1);
+    rb_define_module_function(mMarshal, "load", marshal_load, -1);
+    rb_define_module_function(mMarshal, "restore", marshal_load, 1);
+
+    rb_provide("marshal.o");	/* for backward compatibility */
+}

mkconfig.rb

@@ -0,0 +1,77 @@
+#!./miniruby
+
+require File.dirname($0)+"/lib/ftools"
+
+rbconfig_rb = ARGV[0] || 'rbconfig.rb'
+File.makedirs(File.dirname(rbconfig_rb), true)
+
+version = VERSION
+config = open(rbconfig_rb, "w")
+$stdout.reopen(config)
+
+fast = {'prefix'=>TRUE, 'INSTALL'=>TRUE, 'binsuffix'=>TRUE}
+print %[
+module Config
+
+  VERSION == "#{version}" or
+    raise "ruby lib version (#{version}) doesn't match executable version (\#{VERSION})"
+
+# This file was created by configrb when ruby was built. Any changes
+# made to this file will be lost the next time ruby is built.
+]
+
+print "  CONFIG = {}\n"
+v_fast = []
+v_others = []
+File.foreach "config.status" do |$_|
+  next if /^#/
+  if /^s%@program_transform_name@%s,(.*)%g$/
+    ptn = $1.sub(/\$\$/, '$').split(/,/)
+    v_fast << "  CONFIG[\"ruby_install_name\"] = \"" + "ruby".sub(ptn[0],ptn[1]) + "\"\n"
+  elsif /^s%@(\w+)@%(.*)%g/
+    name = $1
+    val = $2 || ""
+    next if name =~ /^(INSTALL|DEFS|configure_input|srcdir|top_srcdir)$/
+    v = "  CONFIG[\"" + name + "\"] = " +
+    val.sub(/^\s*(.*)\s*$/, '"\1"').gsub(/\$\{?([^}]*)\}?/) {
+      "\#{CONFIG[\\\"#{$1}\\\"]}"
+    } + "\n"
+    if fast[name]
+      v_fast << v
+    else
+      v_others << v
+    end
+    if /DEFS/
+      val.split(/\s*-D/).each do |i|
+	if i =~ /(.*)=(\\")?([^\\]*)(\\")?/
+	  key, val = $1, $3
+	  if val == '1'
+	    val = "TRUE"
+	  else
+	    val.sub! /^\s*(.*)\s*$/, '"\1"'
+	  end
+	  print "  CONFIG[\"#{key}\"] = #{val}\n"
+	end
+      end
+    end
+  elsif /^ac_given_srcdir=(.*)/
+    path = $1
+    cwd = Dir.pwd
+    begin
+      Dir.chdir path
+      v_fast << "  CONFIG[\"srcdir\"] = \"" + Dir.pwd + "\"\n"
+    ensure
+      Dir.chdir cwd
+    end
+  elsif /^ac_given_INSTALL=(.*)/
+    v_fast << "  CONFIG[\"INSTALL\"] = " + $1 + "\n"
+  end
+#  break if /^CEOF/
+end
+
+print v_fast, v_others
+Dir.chdir File.dirname($0)
+print "  CONFIG[\"compile_dir\"] = \"#{Dir.pwd}\"\n"
+print "end\n"
+config.close
+# vi:set sw=2:

rubytest.rb

@@ -0,0 +1,14 @@
+require 'rbconfig'
+include Config
+
+$stderr.reopen($stdout)
+error = ''
+`./ruby #{CONFIG["srcdir"]}/sample/test.rb`.each do |line|
+  if line =~ /^end of test/
+    print "test succeeded\n"
+    exit 0
+  end
+  error << line if line =~ %r:^(sample/test.rb|not):
+end
+print error
+print "test failed\n"

sample/cbreak.rb

@@ -0,0 +1,36 @@
+# ioctl example works on Sun
+
+CBREAK = 0x00000002
+ECHO = 0x00000008
+TIOCGETP = 0x40067408
+TIOCSETP = 0x80067409
+
+def cbreak ()
+  set_cbreak(TRUE)
+end
+
+def cooked ()
+  set_cbreak(FALSE)
+end
+
+def set_cbreak (on)
+  tty = "\0" * 256
+  STDIN.ioctl(TIOCGETP, tty)
+  ttys = tty.unpack("C4 S")
+  if on
+    ttys[4] |= CBREAK
+    ttys[4] &= ~ECHO
+  else
+    ttys[4] &= ~CBREAK
+    ttys[4] |= ECHO
+  end
+  tty = ttys.pack("C4 S")
+  STDIN.ioctl(TIOCSETP, tty)
+end
+cbreak();
+
+print("this is no-echo line: ");
+readline().print
+cooked();
+print("this is echo line: ");
+readline()

sample/rbc.rb

@@ -0,0 +1,962 @@
+#!/usr/local/bin/ruby
+#
+#   rbc.rb - 
+#   	$Release Version: 0.6 $
+#   	$Revision: 1.2 $
+#   	$Date: 1997/11/27 13:46:06 $
+#   	by Keiju ISHITSUKA(Nippon Rational Inc.)
+#
+# --
+# Usage:
+#
+#   rbc.rb [options] file_name opts
+#   options:
+#	-d		    デバッグモード(利用しない方が良いでしょう)
+#	-m		    bcモード(分数, 行列の計算ができます)
+#	-r load-module	    ruby -r と同じ
+#	--inspect	    結果出力にinspectを用いる(bcモード以外はデ
+#			    フォルト). 
+#	--noinspect	    結果出力にinspectを用いない.
+#	--noreadline	    readlineライブラリを利用しない(デフォルト
+#			    ではreadlineライブラリを利用しようとする).
+#
+# 追加 private method:
+#   exit, quit		    終了する.
+#   inspect(sw = nil)	    インスペクトモードのトグル
+#   trace_load(sw = nil)    load/require時にrbcのfile読み込み機能を用
+#			    いるモードのスイッチ(デフォルトはトレース
+#			    モード)
+#
+require "e2mmap.rb"
+
+$stdout.sync = TRUE
+
+module BC_APPLICATION__
+  RCS_ID='-$Header: /home/keiju/var/src/var.lib/ruby/ruby/RCS/rbc.rb,v 1.2 1997/11/27 13:46:06 keiju Exp keiju $-'
+  
+  extend Exception2MessageMapper
+  def_exception :UnrecognizedSwitch, "Unrecognized switch: %s"
+  
+  $DEBUG = FALSE
+  $INSPECT = nil
+  
+  CONFIG = {}
+  CONFIG[0] = $0
+  CONFIG[:USE_READLINE] = TRUE
+  CONFIG[:LOAD_MODULES] = []
+  CONFIG[:INSPECT] = nil
+  CONFIG[:TRACE_LOAD] = TRUE
+
+  while opt = ARGV.shift
+    case opt
+    when "-d"
+      $DEBUG = TRUE
+    when "-m"
+      CONFIG[:INSPECT] = FALSE if CONFIG[:INSPECT].nil?
+      require "mathn.rb"
+      include Math
+    when "-r"
+      opt = ARGV.shift
+      CONFIG[:LOAD_MODULES].push opt if opt
+    when "--inspect"
+      CONFIG[:INSPECT] = TRUE
+    when "--noinspect"
+      CONFIG[:INSPECT] = FALSE
+    when "--noreadline"
+      CONFIG[:USE_READLINE] = FALSE
+    when /^-/
+      #	  print UnrecognizedSwitch.inspect, "\n"
+      BC.fail UnrecognizedSwitch, opt
+    else
+      CONFIG[:USE_READLINE] = FALSE
+      $0 = opt
+      break
+    end
+  end
+  CONFIG[:INSPECT] = TRUE if CONFIG[:INSPECT].nil?
+
+  PROMPTi = "rbc%d> "
+  PROMPTs = "rbc%d%s "
+  PROMPTe = "rbc%d* "
+  
+  class BC
+    def initialize
+      lex_init
+    end
+    
+    def eval_input(io, cont, bind)
+      line = ''
+      @io = io
+      @ltype = nil
+      @quoted = nil
+      @indent = 0
+      @lex_state = EXPR_BEG
+      
+      @io.prompt = format(PROMPTi, @indent)
+
+      loop do
+	@continue = FALSE
+	l = @io.gets
+
+	unless l
+	  break if line == ''
+	else
+	  line = line + l
+	  
+	  lex(l) if l != "\n"
+	  print @quoted.inspect, "\n" if $DEBUG
+	  if @ltype
+	    @io.prompt = format(PROMPTs, @indent, @ltype)
+	    next
+	  elsif @continue
+	    @io.prompt = format(PROMPTe, @indent)
+	    next
+	  elsif @indent > 0
+	    @io.prompt = format(PROMPTi, @indent)
+	    next
+	  end
+	end
+	
+	if line != "\n"
+	  begin
+	    if CONFIG[:INSPECT]
+	      print (cont._=eval(line, bind)).inspect, "\n"
+	    else
+	      print (cont._=eval(line, bind)), "\n"
+	    end
+	  rescue
+	    #	$! = 'exception raised' unless $!
+	    #	print "ERR: ", $!, "\n"
+	    $! = RuntimeError.new("exception raised") unless $!
+	    print $!.type, ": ", $!, "\n"
+	  end
+	end
+	break if not l
+	line = ''
+	indent = 0
+	@io.prompt = format(PROMPTi, indent)
+      end
+      print "\n"
+    end
+    
+    EXPR_BEG = :EXPR_BEG
+    EXPR_MID = :EXPR_MID
+    EXPR_END = :EXPR_END
+    EXPR_ARG = :EXPR_ARG
+    EXPR_FNAME = :EXPR_FNAME
+
+    CLAUSE_STATE_TRANS = {
+      "alias"	=>  EXPR_FNAME,
+      "and"	=>  EXPR_BEG,
+      "begin"	=>  EXPR_BEG,
+      "case"	=>  EXPR_BEG,
+      "class"	=>  EXPR_BEG,
+      "def"	=>  EXPR_FNAME,
+      "defined?"	=>  EXPR_END,
+      "do"	=>  EXPR_BEG,
+      "else"	=>  EXPR_BEG,
+      "elsif"	=>  EXPR_BEG,
+      "end"	=>  EXPR_END,
+      "ensure"	=>  EXPR_BEG,
+      "for"	=>  EXPR_BEG,
+      "if"	=>  EXPR_BEG,
+      "in"	=>  EXPR_BEG,
+      "module"	=>  EXPR_BEG,
+      "nil"	=>  EXPR_END,
+      "not"	=>  EXPR_BEG,
+      "or"	=>  EXPR_BEG,
+      "rescue"	=>  EXPR_MID,
+      "return"	=>  EXPR_MID,
+      "self"	=>  EXPR_END,
+      "super"	=>  EXPR_END,
+      "then"	=>  EXPR_BEG,
+      "undef"	=>  EXPR_FNAME,
+      "unless"	=>  EXPR_BEG,
+      "until"	=>  EXPR_BEG,
+      "when"	=>  EXPR_BEG,
+      "while"	=>  EXPR_BEG,
+      "yield"	=>  EXPR_END
+    }
+    
+    ENINDENT_CLAUSE = [
+      "case", "class", "def", "do", "for", "if",
+      "module", "unless", "until", "while", "begin" #, "when"
+    ]
+    DEINDENT_CLAUSE = ["end"]
+
+    PARCENT_LTYPE = {
+      "q" => "\'",
+      "Q" => "\"",
+      "x" => "\`",
+      "r" => "\/"
+    }
+    
+    PARCENT_PAREN = {
+      "{" => "}",
+      "[" => "]",
+      "<" => ">",
+      "(" => ")"
+    }
+    
+    def lex_init()
+      @OP = Trie.new
+      @OP.def_rules("\0", "\004", "\032"){}
+      @OP.def_rules(" ", "\t", "\f", "\r", "\13") do
+	@space_seen = TRUE
+	next
+      end
+      @OP.def_rule("#") do
+	|op, rests|
+	@ltype = "#"
+	identify_comment(rests)
+      end
+      @OP.def_rule("\n") do
+	print "\\n\n" if $DEBUG
+	if @lex_state == EXPR_BEG || @lex_state == EXPR_FNAME
+	  @continue = TRUE
+	else
+	  @lex_state = EXPR_BEG
+	end
+      end
+      @OP.def_rules("*", "*=", "**=", "**") {@lex_state = EXPR_BEG}
+      @OP.def_rules("!", "!=", "!~") {@lex_state = EXPR_BEG}
+      @OP.def_rules("=", "==", "===", "=~", "=>") {@lex_state = EXPR_BEG}
+      @OP.def_rules("<", "<=", "<=>", "<<", "<=") {@lex_state = EXPR_BEG}
+      @OP.def_rules(">", ">=", ">>", ">=") {@lex_state = EXPR_BEG}
+      @OP.def_rules("'", '"') do
+	|op, rests|
+	@ltype = op
+	@quoted = op
+	identify_string(rests)
+      end
+      @OP.def_rules("`") do
+	|op, rests|
+	if @lex_state != EXPR_FNAME
+	  @ltype = op
+	  @quoted = op
+	  identify_string(rests)
+	end
+      end
+      @OP.def_rules('?') do
+	|op, rests|
+	@lex_state = EXPR_END
+	identify_question(rests)
+      end
+      @OP.def_rules("&", "&&", "&=", "|", "||", "|=") do
+	@lex_state = EXPR_BEG
+      end
+      @OP.def_rule("+@", proc{@lex_state == EXPR_FNAME}) {}
+      @OP.def_rule("-@", proc{@lex_state == EXPR_FNAME}) {}
+      @OP.def_rules("+=", "-=") {@lex_state = EXPR_BEG}
+      @OP.def_rules("+", "-") do
+	|op, rests|
+	if @lex_state == EXPR_ARG
+	  if @space_seen and rests[0] =~ /[0-9]/
+	    identify_number(rests)
+	  else
+	    @lex_state = EXPR_BEG
+	  end
+	elsif @lex_state != EXPR_END and rests[0] =~ /[0-9]/
+	  identify_number(rests)
+	else
+	  @lex_state = EXPR_BEG
+	end
+      end
+      @OP.def_rule(".") do
+	|op, rests|
+	@lex_state = EXPR_BEG
+	if rests[0] =~ /[0-9]/
+	  rests.unshift op
+	  identify_number(rests)
+	end
+      end
+      @OP.def_rules("..", "...") {@lex_state = EXPR_BEG}
+      
+      lex_int2
+    end
+    
+    def lex_int2
+      @OP.def_rules("]", "}", ")") do
+	@lex_state = EXPR_END
+	@indent -= 1
+      end
+      @OP.def_rule(":") {}
+      @OP.def_rule("::") {@lex_state = EXPR_BEG}
+      @OP.def_rule("/") do
+	|op, rests|
+	if @lex_state == EXPR_BEG || @lex_state == EXPR_MID
+	  @ltype = op
+	  @quoted = op
+	  identify_string(rests)
+	elsif rests[0] == '='
+	  rests.shift
+	  @lex_state = EXPR_BEG
+	elsif @lex_state == EXPR_ARG and @space_seen and rests[0] =~ /\s/
+	  @ltype = op
+	  @quoted = op
+	  identify_string(rests)
+	else 
+	  @lex_state = EXPR_BEG
+	end
+      end
+      @OP.def_rules("^", "^=") {@lex_state = EXPR_BEG}
+      @OP.def_rules(",", ";") {@lex_state = EXPR_BEG}
+      @OP.def_rule("~") {@lex_state = EXPR_BEG}
+      @OP.def_rule("~@", proc{@lex_state = EXPR_FNAME}) {}
+      @OP.def_rule("(") do
+	@lex_state = EXPR_BEG
+	@indent += 1
+      end
+      @OP.def_rule("[]", proc{@lex_state == EXPR_FNAME}) {}
+      @OP.def_rule("[]=", proc{@lex_state == EXPR_FNAME}) {}
+      @OP.def_rule("[") do
+	@indent += 1
+	if @lex_state != EXPR_FNAME
+	  @lex_state = EXPR_BEG
+	end
+      end
+      @OP.def_rule("{") do
+	@lex_state = EXPR_BEG
+	@indent += 1
+      end
+      @OP.def_rule('\\') {|op, rests| identify_escape(rests)} #')
+      @OP.def_rule('%') do
+	|op, rests|
+	if @lex_state == EXPR_BEG || @lex_state == EXPR_MID
+	  identify_quotation(rests)
+	elsif rests[0] == '='
+	  rests.shift
+	elsif @lex_state == EXPR_ARG and @space_seen and rests[0] =~ /\s/
+	  identify_quotation(rests)
+	else
+	  @lex_state = EXPR_BEG
+	end
+      end
+      @OP.def_rule('$') do
+	|op, rests|
+	identify_gvar(rests)
+      end
+      @OP.def_rule('@') do
+	|op, rests|
+	if rests[0] =~ /[\w_]/
+	  rests.unshift op
+	  identify_identifier(rests)
+	end
+      end
+      @OP.def_rule("") do
+	|op, rests|
+	printf "match: start %s: %s", op, rests.inspect if $DEBUG
+	if rests[0] =~ /[0-9]/
+	  identify_number(rests)
+	elsif rests[0] =~ /[\w_]/
+	  identify_identifier(rests)
+	end
+	printf "match: end %s: %s", op, rests.inspect if $DEBUG
+      end
+    end
+    
+    def lex(l)
+      chrs = l.split(//)
+      tokens = []
+      
+      case @ltype
+      when "'", '"', '`', '/'
+	identify_string(chrs)
+	return if chrs.empty?
+      when "#"
+	identify_comment(chrs)
+	return
+      when "="
+	if l =~ /^=end/
+	  $ltype = nil
+	  return
+	end
+      else
+	if l =~ /^=begin/
+	  $ltype = "="
+	  return
+	end
+      end
+      
+      until chrs.empty?
+	@space_seen = FALSE
+	printf "perse: %s\n", chrs.join("") if $DEBUG
+	@OP.match(chrs)
+	printf "lex_state: %s continue: %s\n", @lex_state.id2name, @continue if $DEBUG
+      end
+    end
+    
+    def identify_gvar(chrs)
+      @lex_state = EXPR_END
+      
+      ch = chrs.shift
+      case ch
+      when /[_~*$?!@/\\;,.=:<>"]/   #"
+	return
+	
+      when "-"
+	ch = chrs.shift
+	return
+	
+      when "&", "`", "'", "+"
+	return
+	
+      when /[1-9]/
+	chrs.unshift ch
+	v = "$"
+	while (ch = chrs.shift) =~ /[0-9]/
+	end
+	chrs.unshift ch
+	return
+	
+      when /\w/
+	chrs.unshift ch
+	chrs.unshift "$"
+	identify_identifier(chrs)
+	return
+	
+      else 
+	chrs.unshift ch
+	return
+      end
+    end
+    
+    def identify_identifier(chrs)
+      token = ""
+      token.concat chrs.shift if chrs[0] =~ /[$@]/
+      while (ch = chrs.shift) =~ /\w|_/
+	print ":", ch, ":" if $DEBUG
+	token.concat ch
+      end
+      chrs.unshift ch
+      
+      if ch == "!" or ch == "?"
+	chrs.shift
+	token.concat ch
+      end
+      # fix token
+      
+      if token =~ /^[$@]/
+	@lex_state = EXPR_END
+	return
+      end
+      
+      print token, "\n" if $DEBUG
+      if state = CLAUSE_STATE_TRANS[token]
+	if @lex_state != EXPR_BEG and token =~ /^(if|unless|while|until)/
+	  # 修飾子
+	else
+	  if ENINDENT_CLAUSE.include?(token)
+	    @indent += 1
+	  elsif DEINDENT_CLAUSE.include?(token)
+	    @indent -= 1
+	  end
+	end
+	@lex_state = state
+	return
+      end
+      if @lex_state == EXPR_FNAME
+	@lex_state = EXPR_END
+	if chrs[0] == '='
+	  chrs.shift
+	end
+      elsif @lex_state == EXPR_BEG
+	@lex_state = EXPR_ARG
+      else
+	@lex_state = EXPR_END
+      end
+    end
+    
+    def identify_quotation(chrs)
+      ch = chrs.shift
+      if lt = PARCENT_LTYPE[ch]
+	ch = chrs.shift
+      else
+	lt = "\""
+      end
+      if ch !~ /\W/
+	chrs.unshift ch
+	next
+      end
+      @ltype = lt
+      unless @quoted = PARCENT_PAREN[ch]
+	@quoted = ch
+      end
+      identify_string(chrs)
+    end
+
+    def identify_number(chrs)
+      @lex_state = EXPR_END
+      
+      ch = chrs.shift
+      case ch
+      when /0/
+	if (ch = chrs[0]) == "x"
+	  chrs.shift
+	  match = /[0-9a-f_]/
+	else
+	  match = /[0-7_]/
+	end
+	while ch = chrs.shift
+	  if ch !~ match
+	    chrs.unshift ch
+	    break
+	  end
+	end
+	return
+      end
+      
+      while ch = chrs.shift
+	case ch
+	when /[0-9]/
+	when "e", "E"
+	  #	type = FLOAT
+	  unless (ch = chrs.shift) == "+" or ch == "-"
+	    chrs.unshift ch
+	  end
+	when "."
+	  #	type = FLOAT
+	when "_"
+	else
+	  chrs.unshift ch
+	  return
+	end
+      end
+    end
+    
+    def identify_question(chrs)
+      @lex_state = EXPR_END
+      
+      if chrs.shift == "\\" #"
+	identify_escape(chrs)
+      end
+    end
+    
+    def identify_string(chrs)
+      while ch = chrs.shift
+	if @quoted == ch
+	  if @ltype == "/"
+	    if chrs[0] =~ /i|o|n|e|s/
+	      chrs.shift
+	    end
+	  end
+	  @ltype = nil
+	  @quoted = nil
+	  @lex_state = EXPR_END
+	  break
+	elsif ch == '\\' #'
+	  identify_escape(chrs)
+	end
+      end
+    end
+    
+    def identify_comment(chrs)
+      while ch = chrs.shift
+	if ch == "\\" #"
+	  identify_escape(chrs)
+	end
+	if ch == "\n"
+	  @ltype = nil
+	  chrs.unshift ch
+	  break
+	end
+      end
+    end
+    
+    def identify_escape(chrs)
+      ch = chrs.shift
+      case ch
+      when "\n", "\r", "\f"
+	@continue = TRUE
+      when "\\", "n", "t", "r", "f", "v", "a", "e", "b" #"
+      when /[0-7]/
+	chrs.unshift ch
+	3.times do
+	  ch = chrs.shift
+	  case ch
+	  when /[0-7]/
+	  when nil
+	    break
+	  else
+	    chrs.unshift ch
+	    break
+	  end
+	end
+      when "x"
+	2.times do
+	  ch = chrs.shift
+	  case ch
+	  when /[0-9a-fA-F]/
+	  when nil
+	    break
+	  else
+	    chrs.unshift ch
+	    break
+	  end
+	end
+      when "M"
+	if (ch = chrs.shift) != '-'
+	  chrs.unshift ch
+	elsif (ch = chrs.shift) == "\\" #"
+	  identify_escape(chrs)
+	end
+	return
+      when "C", "c", "^"
+	if ch == "C" and (ch = chrs.shift) != "-"
+	  chrs.unshift ch
+	elsif (ch = chrs.shift) == "\\" #"
+	  identify_escape(chrs)
+	end
+	return
+      end
+    end
+  end
+  
+  class Trie
+    extend Exception2MessageMapper
+    def_exception :ErrNodeNothing, "node nothing"
+    def_exception :ErrNodeAlreadyExists, "node already exists"
+
+    class Node
+      # postprocがなければ抽象ノード, nilじゃなければ具象ノード
+      def initialize(preproc = nil, postproc = nil)
+	@Tree = {}
+	@preproc = preproc
+	@postproc = postproc
+      end
+      
+      def preproc(p)
+	@preproc = p
+      end
+      
+      def postproc(p)
+	@postproc = p
+      end
+      
+      def search(chrs, opt = nil)
+	return self if chrs.empty?
+	ch = chrs.shift
+	if node = @Tree[ch]
+	  node.search(chrs, opt)
+	else
+	  if opt
+	    chrs.unshift ch
+	    self.create_subnode(chrs)
+	  else
+	    Trie.fail ErrNodeNothing
+	  end
+	end
+      end
+      
+      def create_subnode(chrs, preproc = nil, postproc = nil)
+	ch = chrs.shift
+	if node = @Tree[ch]
+	  if chrs.empty?
+	    Trie.fail ErrNodeAlreadyExists
+	  else
+	    node.create_subnode(chrs, preproc, postproc)
+	  end
+	else
+	  if chrs.empty?
+	    node = Node.new(preproc, postproc)
+	  else
+	    node = Node.new
+	    node.create_subnode(chrs, preproc, postproc)
+	  end
+	  @Tree[ch] = node
+	end
+	node
+      end
+      
+      def match(chrs, op = "")
+	print "match: ", chrs, ":", op, "\n" if $DEBUG
+	if chrs.empty?
+	  if @preproc.nil? || @preproc.call(op, chrs)
+	    printf "op1: %s\n", op if $DEBUG
+	    @postproc.call(op, chrs)
+	    ""
+	  else
+	    nil
+	  end
+	else
+	  ch = chrs.shift
+	  if node = @Tree[ch]
+	    if ret = node.match(chrs, op+ch)
+	      return ch+ret
+	    elsif @postproc and @preproc.nil? || @preproc.call(op, chrs)
+	      chrs.unshift ch
+	      printf "op2: %s\n", op if $DEBUG
+	      @postproc.call(op, chrs)
+	      return ""
+	    else
+	      chrs.unshift ch
+	      return nil
+	    end
+	  else
+	    if @postproc and @preproc.nil? || @preproc.call(op, chrs)
+	      printf "op3: %s\n", op if $DEBUG
+	      chrs.unshift ch
+	      @postproc.call(op, chrs)
+	      return ""
+	    else
+	      chrs.unshift ch
+	      return nil
+	    end
+	  end
+	end
+      end
+    end
+    
+    def initialize
+      @head = Node.new("")
+    end
+    
+    def def_rule(token, preproc = nil, postproc = nil)
+      node = search(token, :CREATE)
+#      print node.inspect, "\n" if $DEBUG
+      node.preproc(preproc)
+      if iterator?
+	node.postproc(proc)
+      elsif postproc
+	node.postproc(postproc)
+      end
+    end
+    
+    def def_rules(*tokens)
+      if iterator?
+	p = proc
+      end
+      for token in tokens
+	def_rule(token, nil, p)
+      end
+    end
+    
+    def preporc(token)
+      node = search(token)
+      node.preproc proc
+    end
+    
+    def postproc(token)
+      node = search(token)
+      node.postproc proc
+    end
+    
+    def search(token, opt = nil)
+      @head.search(token.split(//), opt)
+    end
+    
+    def match(token)
+      token = token.split(//) if token.kind_of?(String)
+      ret = @head.match(token)
+      printf "match end: %s:%s", ret, token.inspect if $DEBUG
+      ret
+    end
+    
+    def inspect
+      format("<Trie: @head = %s>", @head.inspect)
+    end
+  end
+  
+  if /^-tt(.*)$/ =~ ARGV[0]
+#    Tracer.on
+    case $1
+    when "1"
+      tr = Trie.new
+      print "0: ", tr.inspect, "\n"
+      tr.def_rule("=") {print "=\n"}
+      print "1: ", tr.inspect, "\n"
+      tr.def_rule("==") {print "==\n"}
+      print "2: ", tr.inspect, "\n"
+      
+      print "case 1:\n"
+      print tr.match("="), "\n"
+      print "case 2:\n"
+      print tr.match("=="), "\n"
+      print "case 3:\n"
+      print tr.match("=>"), "\n"
+      
+    when "2"
+      tr = Trie.new
+      print "0: ", tr.inspect, "\n"
+      tr.def_rule("=") {print "=\n"}
+      print "1: ", tr.inspect, "\n"
+      tr.def_rule("==", proc{FALSE}) {print "==\n"}
+      print "2: ", tr.inspect, "\n"
+      
+      print "case 1:\n"
+      print tr.match("="), "\n"
+      print "case 2:\n"
+      print tr.match("=="), "\n"
+      print "case 3:\n"
+      print tr.match("=>"), "\n"
+    end
+    exit
+  end
+  
+  module CONTEXT
+    def _=(value)
+      @_ = value
+    end
+    
+    def _
+      @_
+    end
+    
+    def quit
+      exit
+    end
+    
+    def trace_load(opt = nil)
+      if opt
+	@Trace_require = opt
+      else
+	@Trace_require = !@Trace_require
+      end
+      print "Switch to load/require #{unless @Trace_require; ' non';end} trace mode.\n"
+      if @Trace_require
+	eval %{
+	  class << self
+	    alias load rbc_load
+	    alias require rbc_require
+	  end
+	}
+      else
+	eval %{
+	  class << self
+	    alias load rbc_load_org
+	    alias require rbc_require_org
+	  end
+	}
+      end
+      @Trace_require
+    end
+    
+    alias rbc_load_org load
+    def rbc_load(file_name)
+      return true if load_sub(file_name)
+      raise LoadError, "No such file to load -- #{file_name}"
+    end
+
+    alias rbc_require_org require
+    def rbc_require(file_name)
+      rex = Regexp.new("#{Regexp.quote(file_name)}(\.o|\.rb)?")
+      return false if $".find{|f| f =~ rex}
+
+      case file_name
+      when /\.rb$/
+	if load_sub(file_name)
+	  $:.push file_name
+	  return true
+	end
+      when /\.(so|o|sl)$/
+	require_org(file_name)
+      end
+      
+      if load_sub(f = file_name + ".rb")
+	  $:.push f
+      end
+      require(file_name)
+    end
+
+    def load_sub(fn)
+      if fn =~ /^#{Regexp.quote(File::Separator)}/
+	return false unless File.exist?(fn)
+	BC.new.eval_input FileInputMethod.new(fn), self, CONFIG[:BIND]
+	return true
+      end
+      
+      for path in $:
+	if File.exist?(f = File.join(path, fn))
+	  BC.new.eval_input FileInputMethod.new(f), self, CONFIG[:BIND]
+	  return true
+	end
+      end
+      return false
+    end
+
+    def inspect(opt = nil)
+      if opt
+	CONFIG[:INSPECT] = opt
+      else
+	CONFIG[:INSPECT] = !$INSPECT
+      end
+      print "Switch to#{unless $INSPECT; ' non';end} inspect mode.\n"
+      $INSPECT
+    end
+    
+    def run
+      CONFIG[:BIND] = proc
+
+      if CONFIG[:TRACE_LOAD]
+	trace_load true
+      end
+  
+      for m in CONFIG[:LOAD_MODULES]
+	begin
+	  require m
+	rescue
+	  print $@[0], ":", $!.type, ": ", $!, "\n"
+	end
+      end
+  
+      if !$0.equal?(CONFIG[0])
+	io = FileInputMethod.new($0)
+      elsif defined? Readline
+	io = ReadlineInputMethod.new
+      else
+	io = StdioInputMethod.new
+      end
+
+      BC.new.eval_input io, self, CONFIG[:BIND]
+    end
+  end
+  
+  class InputMethod
+    attr :prompt, TRUE
+    
+    def gets
+    end
+    public :gets
+  end
+  
+  class StdioInputMethod < InputMethod
+    def gets
+      print @prompt
+      $stdin.gets
+    end
+  end
+  
+  class FileInputMethod < InputMethod
+    def initialize(file)
+      @io = open(file)
+    end
+
+    def gets
+      l = @io.gets
+      print @prompt, l
+      l
+    end
+  end
+
+  if CONFIG[:USE_READLINE]
+    begin
+      require "readline"
+      print "use readline module\n"
+      class ReadlineInputMethod < InputMethod
+	include Readline 
+	def gets
+	  if l = readline(@prompt, TRUE)
+	    l + "\n"
+	  else
+	    l
+	  end
+	end
+      end
+    rescue
+      CONFIG[:USE_READLINE] = FALSE
+    end
+  end
+end
+
+extend BC_APPLICATION__::CONTEXT
+run{}

win32/sdbm.c

@@ -0,0 +1,981 @@
+/*
+ * sdbm - ndbm work-alike hashed database library
+ * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978).
+ * author: oz@nexus.yorku.ca
+ * status: public domain.
+ *
+ * core routines
+ */
+
+#ifndef lint
+/*char sdbm_rcsid[] = "$Id: sdbm.c,v 1.16 90/12/13 13:01:31 oz Exp $";*/
+#endif
+
+#include "sdbm.h"
+
+/*#include "tune.h"*/
+/*
+ * sdbm - ndbm work-alike hashed database library
+ * tuning and portability constructs [not nearly enough]
+ * author: oz@nexus.yorku.ca
+ */
+
+#define BYTESIZ		8
+
+#ifdef SVID
+#include <unistd.h>
+#endif
+
+#ifdef __GO32__
+#include <unistd.h>
+#endif
+
+#ifdef BSD42
+#define SEEK_SET	L_SET
+#define	memset(s,c,n)	bzero(s, n)		/* only when c is zero */
+#define	memcpy(s1,s2,n)	bcopy(s2, s1, n)
+#define	memcmp(s1,s2,n)	bcmp(s1,s2,n)
+#endif
+
+/*
+ * important tuning parms (hah)
+ */
+
+#define SEEDUPS		/* always detect duplicates */
+#define BADMESS		/* generate a message for worst case:
+			   cannot make room after SPLTMAX splits */
+/*
+ * misc
+ */
+#ifdef DEBUG
+#define debug(x)	printf x
+#else
+#define debug(x)
+#endif
+
+#ifdef BIG_E
+#define GET_SHORT(p, i)	(((unsigned)((unsigned char *)(p))[(i)*2] << 8) + (((unsigned char *)(p))[(i)*2 + 1]))
+#define PUT_SHORT(p, i, s) (((unsigned char *)(p))[(i)*2] = (unsigned char)((s) >> 8), ((unsigned char *)(p))[(i)*2 + 1] = (unsigned char)(s))
+#else
+#define GET_SHORT(p, i)	((p)[i])
+#define PUT_SHORT(p, i, s)	((p)[i] = (s))
+#endif
+
+/*#include "pair.h"*/
+static int   fitpair proto((char *, int));
+static void  putpair proto((char *, datum, datum));
+static datum getpair proto((char *, datum));
+static int   delpair proto((char *, datum));
+static int   chkpage proto((char *));
+static datum getnkey proto((char *, int));
+static void  splpage proto((char *, char *, long));
+#ifdef SEEDUPS
+static int   duppair proto((char *, datum));
+#endif
+
+#ifdef MSDOS
+#include <stdio.h>
+#include <stdlib.h>
+#include <io.h>
+#endif
+#include <sys/types.h>
+#include <sys/stat.h>
+#ifdef BSD42
+#include <sys/file.h>
+#else
+#include <fcntl.h>
+/*#include <memory.h>*/
+#endif
+#ifndef O_BINARY
+#define O_BINARY	0
+#endif
+
+#include <errno.h>
+#ifndef EPERM
+#define EPERM	EACCES
+#endif
+#include <string.h>
+
+#ifdef __STDC__
+#include <stddef.h>
+#endif
+
+#ifndef NULL
+#define NULL	0
+#endif
+
+/*
+ * externals
+ */
+#ifndef sun
+#ifndef MSDOS
+extern int errno;
+#endif
+#endif
+
+/*
+ * forward
+ */
+static int getdbit proto((DBM *, long));
+static int setdbit proto((DBM *, long));
+static int getpage proto((DBM *, long));
+static datum getnext proto((DBM *));
+static int makroom proto((DBM *, long, int));
+
+/*
+ * useful macros
+ */
+#define bad(x)		((x).dptr == NULL || (x).dsize < 0)
+#define exhash(item)	dbm_hash((item).dptr, (item).dsize)
+#define ioerr(db)	((db)->flags |= DBM_IOERR)
+
+#define OFF_PAG(off)	(long) (off) * PBLKSIZ
+#define OFF_DIR(off)	(long) (off) * DBLKSIZ
+
+static long masks[] = {
+	000000000000L, 000000000001L, 000000000003L,
+	000000000007L, 000000000017L, 000000000037L,
+	000000000077L, 000000000177L, 000000000377L,
+	000000000777L, 000000001777L, 000000003777L,
+	000000007777L, 000000017777L, 000000037777L,
+	000000077777L, 000000177777L, 000000377777L,
+	000000777777L, 000001777777L, 000003777777L,
+	000007777777L, 000017777777L, 000037777777L,
+	000077777777L, 000177777777L, 000377777777L,
+	000777777777L, 001777777777L, 003777777777L,
+	007777777777L, 017777777777L
+};
+
+datum nullitem = {NULL, 0};
+
+DBM *
+dbm_open(file, flags, mode)
+register char *file;
+register int flags;
+register int mode;
+{
+	register DBM *db;
+	register char *dirname;
+	register char *pagname;
+	register int n;
+
+	if (file == NULL || !*file)
+		return errno = EINVAL, (DBM *) NULL;
+/*
+ * need space for two seperate filenames
+ */
+	n = strlen(file) * 2 + strlen(DIRFEXT) + strlen(PAGFEXT) + 2;
+
+	if ((dirname = malloc((unsigned) n)) == NULL)
+		return errno = ENOMEM, (DBM *) NULL;
+/*
+ * build the file names
+ */
+	dirname = strcat(strcpy(dirname, file), DIRFEXT);
+	pagname = strcpy(dirname + strlen(dirname) + 1, file);
+	pagname = strcat(pagname, PAGFEXT);
+
+	db = dbm_prep(dirname, pagname, flags, mode);
+	free((char *) dirname);
+	return db;
+}
+
+DBM *
+dbm_prep(dirname, pagname, flags, mode)
+char *dirname;
+char *pagname;
+int flags;
+int mode;
+{
+	register DBM *db;
+	struct stat dstat;
+
+	if ((db = (DBM *) malloc(sizeof(DBM))) == NULL)
+		return errno = ENOMEM, (DBM *) NULL;
+
+        db->flags = 0;
+        db->hmask = 0;
+        db->blkptr = 0;
+        db->keyptr = 0;
+/*
+ * adjust user flags so that WRONLY becomes RDWR, 
+ * as required by this package. Also set our internal
+ * flag for RDONLY.
+ */
+	if (flags & O_WRONLY)
+		flags = (flags & ~O_WRONLY) | O_RDWR;
+	if (flags & O_RDONLY)
+		db->flags = DBM_RDONLY;
+/*
+ * open the files in sequence, and stat the dirfile.
+ * If we fail anywhere, undo everything, return NULL.
+ */
+#ifdef MSDOS
+	flags |= O_BINARY;
+#endif
+	if ((db->pagf = open(pagname, flags, mode)) > -1) {
+		if ((db->dirf = open(dirname, flags, mode)) > -1) {
+/*
+ * need the dirfile size to establish max bit number.
+ */
+			if (fstat(db->dirf, &dstat) == 0) {
+/*
+ * zero size: either a fresh database, or one with a single,
+ * unsplit data page: dirpage is all zeros.
+ */
+				db->dirbno = (!dstat.st_size) ? 0 : -1;
+				db->pagbno = -1;
+				db->maxbno = dstat.st_size * (long) BYTESIZ;
+
+				(void) memset(db->pagbuf, 0, PBLKSIZ);
+				(void) memset(db->dirbuf, 0, DBLKSIZ);
+			/*
+			 * success
+			 */
+				return db;
+			}
+			(void) close(db->dirf);
+		}
+		(void) close(db->pagf);
+	}
+	free((char *) db);
+	return (DBM *) NULL;
+}
+
+void
+dbm_close(db)
+register DBM *db;
+{
+	if (db == NULL)
+		errno = EINVAL;
+	else {
+		(void) close(db->dirf);
+		(void) close(db->pagf);
+		free((char *) db);
+	}
+}
+
+datum
+dbm_fetch(db, key)
+register DBM *db;
+datum key;
+{
+	if (db == NULL || bad(key))
+		return errno = EINVAL, nullitem;
+
+	if (getpage(db, exhash(key)))
+		return getpair(db->pagbuf, key);
+
+	return ioerr(db), nullitem;
+}
+
+int
+dbm_delete(db, key)
+register DBM *db;
+datum key;
+{
+	if (db == NULL || bad(key))
+		return errno = EINVAL, -1;
+	if (dbm_rdonly(db))
+		return errno = EPERM, -1;
+
+	if (getpage(db, exhash(key))) {
+		if (!delpair(db->pagbuf, key))
+			return -1;
+/*
+ * update the page file
+ */
+		if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0
+		    || write(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+			return ioerr(db), -1;
+
+		return 0;
+	}
+
+	return ioerr(db), -1;
+}
+
+int
+dbm_store(db, key, val, flags)
+register DBM *db;
+datum key;
+datum val;
+int flags;
+{
+	int need;
+	register long hash;
+
+	if (db == NULL || bad(key))
+		return errno = EINVAL, -1;
+	if (dbm_rdonly(db))
+		return errno = EPERM, -1;
+
+	need = key.dsize + val.dsize;
+/*
+ * is the pair too big (or too small) for this database ??
+ */
+	if (need < 0 || need > PAIRMAX)
+		return errno = EINVAL, -1;
+
+	if (getpage(db, (hash = exhash(key)))) {
+/*
+ * if we need to replace, delete the key/data pair
+ * first. If it is not there, ignore.
+ */
+		if (flags == DBM_REPLACE)
+			(void) delpair(db->pagbuf, key);
+#ifdef SEEDUPS
+		else if (duppair(db->pagbuf, key))
+			return 1;
+#endif
+/*
+ * if we do not have enough room, we have to split.
+ */
+		if (!fitpair(db->pagbuf, need))
+			if (!makroom(db, hash, need))
+				return ioerr(db), -1;
+/*
+ * we have enough room or split is successful. insert the key,
+ * and update the page file.
+ */
+		(void) putpair(db->pagbuf, key, val);
+
+		if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0
+		    || write(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+			return ioerr(db), -1;
+	/*
+	 * success
+	 */
+		return 0;
+	}
+
+	return ioerr(db), -1;
+}
+
+/*
+ * makroom - make room by splitting the overfull page
+ * this routine will attempt to make room for SPLTMAX times before
+ * giving up.
+ */
+static int
+makroom(db, hash, need)
+register DBM *db;
+long hash;
+int need;
+{
+	long newp;
+	char twin[PBLKSIZ];
+#ifdef MSDOS
+	char zer[PBLKSIZ];
+#endif
+	char *pag = db->pagbuf;
+	char *new = twin;
+	register int smax = SPLTMAX;
+	long oldtail;
+
+	do {
+/*
+ * split the current page
+ */
+		(void) splpage(pag, new, db->hmask + 1);
+/*
+ * address of the new page
+ */
+		newp = (hash & db->hmask) | (db->hmask + 1);
+		debug(("newp: %ld\n", newp));
+/*
+ * write delay, read avoidence/cache shuffle:
+ * select the page for incoming pair: if key is to go to the new page,
+ * write out the previous one, and copy the new one over, thus making
+ * it the current page. If not, simply write the new page, and we are
+ * still looking at the page of interest. current page is not updated
+ * here, as dbm_store will do so, after it inserts the incoming pair.
+ */
+
+#ifdef MSDOS
+	/*
+	 * Fill hole with 0 if made it.
+	 * (hole is NOT read as 0)
+	 */
+	oldtail = lseek(db->pagf, 0L, SEEK_END);
+	memset(zer, 0, PBLKSIZ);
+	while (OFF_PAG(newp) > oldtail) {
+		if (lseek(db->pagf, 0L, SEEK_END) < 0 ||
+		    write(db->pagf, zer, PBLKSIZ) < 0) {
+
+			return 0;
+		}
+		oldtail += PBLKSIZ;
+	}
+#endif
+
+		if (hash & (db->hmask + 1)) {
+			if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0
+			    || write(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+				return 0;
+			db->pagbno = newp;
+			(void) memcpy(pag, new, PBLKSIZ);
+		}
+		else if (lseek(db->pagf, OFF_PAG(newp), SEEK_SET) < 0
+			 || write(db->pagf, new, PBLKSIZ) < 0)
+			return 0;
+
+		if (!setdbit(db, db->curbit))
+			return 0;
+/*
+ * see if we have enough room now
+ */
+		if (fitpair(pag, need))
+			return 1;
+/*
+ * try again... update curbit and hmask as getpage would have
+ * done. because of our update of the current page, we do not
+ * need to read in anything. BUT we have to write the current
+ * [deferred] page out, as the window of failure is too great.
+ */
+		db->curbit = 2 * db->curbit + 
+			((hash & (db->hmask + 1)) ? 2 : 1);
+		db->hmask |= (db->hmask + 1);
+
+		if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0
+		    || write(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+			return 0;
+
+	} while (--smax);
+/*
+ * if we are here, this is real bad news. After SPLTMAX splits,
+ * we still cannot fit the key. say goodnight.
+ */
+#ifdef BADMESS
+	(void) write(2, "sdbm: cannot insert after SPLTMAX attempts.\n", 44);
+#endif
+	return 0;
+
+}
+
+/*
+ * the following two routines will break if
+ * deletions aren't taken into account. (ndbm bug)
+ */
+datum
+dbm_firstkey(db)
+register DBM *db;
+{
+	if (db == NULL)
+		return errno = EINVAL, nullitem;
+/*
+ * start at page 0
+ */
+	(void) memset(db->pagbuf, 0, PBLKSIZ);
+	if (lseek(db->pagf, OFF_PAG(0), SEEK_SET) < 0
+	    || read(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+		return ioerr(db), nullitem;
+	db->pagbno = 0;
+	db->blkptr = 0;
+	db->keyptr = 0;
+
+	return getnext(db);
+}
+
+datum
+dbm_nextkey(db)
+register DBM *db;
+{
+	if (db == NULL)
+		return errno = EINVAL, nullitem;
+	return getnext(db);
+}
+
+/*
+ * all important binary trie traversal
+ */
+static int
+getpage(db, hash)
+register DBM *db;
+register long hash;
+{
+	register int hbit;
+	register long dbit;
+	register long pagb;
+
+	dbit = 0;
+	hbit = 0;
+	while (dbit < db->maxbno && getdbit(db, dbit))
+		dbit = 2 * dbit + ((hash & ((long) 1 << hbit++)) ? 2 : 1);
+
+	debug(("dbit: %d...", dbit));
+
+	db->curbit = dbit;
+	db->hmask = masks[hbit];
+
+	pagb = hash & db->hmask;
+/*
+ * see if the block we need is already in memory.
+ * note: this lookaside cache has about 10% hit rate.
+ */
+	if (pagb != db->pagbno) { 
+/*
+ * note: here, we assume a "hole" is read as 0s.
+ * if not, must zero pagbuf first.
+ */
+		(void) memset(db->pagbuf, 0, PBLKSIZ);
+
+		if (lseek(db->pagf, OFF_PAG(pagb), SEEK_SET) < 0
+		    || read(db->pagf, db->pagbuf, PBLKSIZ) < 0)
+			return 0;
+		if (!chkpage(db->pagbuf)) {
+			return 0;
+		}
+		db->pagbno = pagb;
+
+		debug(("pag read: %d\n", pagb));
+	}
+	return 1;
+}
+
+static int
+getdbit(db, dbit)
+register DBM *db;
+register long dbit;
+{
+	register long c;
+	register long dirb;
+
+	c = dbit / BYTESIZ;
+	dirb = c / DBLKSIZ;
+
+	if (dirb != db->dirbno) {
+		if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
+		    || read(db->dirf, db->dirbuf, DBLKSIZ) < 0)
+			return 0;
+		db->dirbno = dirb;
+
+		debug(("dir read: %d\n", dirb));
+	}
+
+	return db->dirbuf[c % DBLKSIZ] & (1 << (dbit % BYTESIZ));
+}
+
+static int
+setdbit(db, dbit)
+register DBM *db;
+register long dbit;
+{
+	register long c;
+	register long dirb;
+
+	c = dbit / BYTESIZ;
+	dirb = c / DBLKSIZ;
+
+	if (dirb != db->dirbno) {
+		if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
+		    || read(db->dirf, db->dirbuf, DBLKSIZ) < 0)
+			return 0;
+		db->dirbno = dirb;
+
+		debug(("dir read: %d\n", dirb));
+	}
+
+	db->dirbuf[c % DBLKSIZ] |= (1 << (dbit % BYTESIZ));
+
+	if (dbit >= db->maxbno)
+		db->maxbno += (long) DBLKSIZ * BYTESIZ;
+
+	if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
+	    || write(db->dirf, db->dirbuf, DBLKSIZ) < 0)
+		return 0;
+
+	return 1;
+}
+
+/*
+ * getnext - get the next key in the page, and if done with
+ * the page, try the next page in sequence
+ */
+static datum
+getnext(db)
+register DBM *db;
+{
+	datum key;
+
+	for (;;) {
+		db->keyptr++;
+		key = getnkey(db->pagbuf, db->keyptr);
+		if (key.dptr != NULL)
+			return key;
+/*
+ * we either run out, or there is nothing on this page..
+ * try the next one... If we lost our position on the
+ * file, we will have to seek.
+ */
+		db->keyptr = 0;
+		if (db->pagbno != db->blkptr++)
+			if (lseek(db->pagf, OFF_PAG(db->blkptr), SEEK_SET) < 0)
+				break;
+		db->pagbno = db->blkptr;
+		if (read(db->pagf, db->pagbuf, PBLKSIZ) <= 0)
+			break;
+		if (!chkpage(db->pagbuf)) {
+			break;
+		}
+	}
+
+	return ioerr(db), nullitem;
+}
+
+/* pair.c */
+/*
+ * sdbm - ndbm work-alike hashed database library
+ * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978).
+ * author: oz@nexus.yorku.ca
+ * status: public domain.
+ *
+ * page-level routines
+ */
+
+#ifndef lint
+/*char pair_rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $";*/
+#endif
+
+#ifndef BSD42
+/*#include <memory.h>*/
+#endif
+
+#define exhash(item)	dbm_hash((item).dptr, (item).dsize)
+
+/* 
+ * forward 
+ */
+static int seepair proto((char *, int, char *, int));
+
+/*
+ * page format:
+ *	+------------------------------+
+ * ino	| n | keyoff | datoff | keyoff |
+ * 	+------------+--------+--------+
+ *	| datoff | - - - ---->	       |
+ *	+--------+---------------------+
+ *	|	 F R E E A R E A       |
+ *	+--------------+---------------+
+ *	|  <---- - - - | data          |
+ *	+--------+-----+----+----------+
+ *	|  key   | data     | key      |
+ *	+--------+----------+----------+
+ *
+ * calculating the offsets for free area:  if the number
+ * of entries (ino[0]) is zero, the offset to the END of
+ * the free area is the block size. Otherwise, it is the
+ * nth (ino[ino[0]]) entry's offset.
+ */
+
+static int
+fitpair(pag, need)
+char *pag;
+int need;
+{
+	register int n;
+	register int off;
+	register int free;
+	register short *ino = (short *) pag;
+
+	off = ((n = GET_SHORT(ino,0)) > 0) ? GET_SHORT(ino,n) : PBLKSIZ;
+	free = off - (n + 1) * sizeof(short);
+	need += 2 * sizeof(short);
+
+	debug(("free %d need %d\n", free, need));
+
+	return need <= free;
+}
+
+static void
+putpair(pag, key, val)
+char *pag;
+datum key;
+datum val;
+{
+	register int n;
+	register int off;
+	register short *ino = (short *) pag;
+
+	off = ((n = GET_SHORT(ino,0)) > 0) ? GET_SHORT(ino,n) : PBLKSIZ;
+/*
+ * enter the key first
+ */
+	off -= key.dsize;
+	if (key.dsize)
+		(void) memcpy(pag + off, key.dptr, key.dsize);
+	PUT_SHORT(ino,n + 1,off);
+/*
+ * now the data
+ */
+	off -= val.dsize;
+	if (val.dsize)
+		(void) memcpy(pag + off, val.dptr, val.dsize);
+	PUT_SHORT(ino,n + 2,off);
+/*
+ * adjust item count
+ */
+	PUT_SHORT(ino,0,GET_SHORT(ino,0) + 2);
+}
+
+static datum
+getpair(pag, key)
+char *pag;
+datum key;
+{
+	register int i;
+	register int n;
+	datum val;
+	register short *ino = (short *) pag;
+
+	if ((n = GET_SHORT(ino,0)) == 0)
+		return nullitem;
+
+	if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0)
+		return nullitem;
+
+	val.dptr = pag + GET_SHORT(ino,i + 1);
+	val.dsize = GET_SHORT(ino,i) - GET_SHORT(ino,i + 1);
+	return val;
+}
+
+#ifdef SEEDUPS
+static int
+duppair(pag, key)
+char *pag;
+datum key;
+{
+	register short *ino = (short *) pag;
+	return GET_SHORT(ino,0) > 0 &&
+		   seepair(pag, GET_SHORT(ino,0), key.dptr, key.dsize) > 0;
+}
+#endif
+
+static datum
+getnkey(pag, num)
+char *pag;
+int num;
+{
+	datum key;
+	register int off;
+	register short *ino = (short *) pag;
+
+	num = num * 2 - 1;
+	if (GET_SHORT(ino,0) == 0 || num > GET_SHORT(ino,0))
+		return nullitem;
+
+	off = (num > 1) ? GET_SHORT(ino,num - 1) : PBLKSIZ;
+
+	key.dptr = pag + GET_SHORT(ino,num);
+	key.dsize = off - GET_SHORT(ino,num);
+
+	return key;
+}
+
+static int
+delpair(pag, key)
+char *pag;
+datum key;
+{
+	register int n;
+	register int i;
+	register short *ino = (short *) pag;
+
+	if ((n = GET_SHORT(ino,0)) == 0)
+		return 0;
+
+	if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0)
+		return 0;
+/*
+ * found the key. if it is the last entry
+ * [i.e. i == n - 1] we just adjust the entry count.
+ * hard case: move all data down onto the deleted pair,
+ * shift offsets onto deleted offsets, and adjust them.
+ * [note: 0 < i < n]
+ */
+	if (i < n - 1) {
+		register int m;
+		register char *dst = pag + (i == 1 ? PBLKSIZ : GET_SHORT(ino,i - 1));
+		register char *src = pag + GET_SHORT(ino,i + 1);
+		register int   zoo = dst - src;
+
+		debug(("free-up %d ", zoo));
+/*
+ * shift data/keys down
+ */
+		m = GET_SHORT(ino,i + 1) - GET_SHORT(ino,n);
+#ifdef DUFF
+#define MOVB 	*--dst = *--src
+
+		if (m > 0) {
+			register int loop = (m + 8 - 1) >> 3;
+
+			switch (m & (8 - 1)) {
+			case 0:	do {
+				MOVB;	case 7:	MOVB;
+			case 6:	MOVB;	case 5:	MOVB;
+			case 4:	MOVB;	case 3:	MOVB;
+			case 2:	MOVB;	case 1:	MOVB;
+				} while (--loop);
+			}
+		}
+#else
+#ifdef MEMMOVE
+		memmove(dst, src, m);
+#else
+		while (m--)
+			*--dst = *--src;
+#endif
+#endif
+/*
+ * adjust offset index up
+ */
+		while (i < n - 1) {
+			PUT_SHORT(ino,i, GET_SHORT(ino,i + 2) + zoo);
+			i++;
+		}
+	}
+	PUT_SHORT(ino, 0, GET_SHORT(ino, 0) - 2);
+	return 1;
+}
+
+/*
+ * search for the key in the page.
+ * return offset index in the range 0 < i < n.
+ * return 0 if not found.
+ */
+static int
+seepair(pag, n, key, siz)
+char *pag;
+register int n;
+register char *key;
+register int siz;
+{
+	register int i;
+	register int off = PBLKSIZ;
+	register short *ino = (short *) pag;
+
+	for (i = 1; i < n; i += 2) {
+		if (siz == off - GET_SHORT(ino,i) &&
+		    memcmp(key, pag + GET_SHORT(ino,i), siz) == 0)
+			return i;
+		off = GET_SHORT(ino,i + 1);
+	}
+	return 0;
+}
+
+static void
+splpage(pag, new, sbit)
+char *pag;
+char *new;
+long sbit;
+{
+	datum key;
+	datum val;
+
+	register int n;
+	register int off = PBLKSIZ;
+	char cur[PBLKSIZ];
+	register short *ino = (short *) cur;
+
+	(void) memcpy(cur, pag, PBLKSIZ);
+	(void) memset(pag, 0, PBLKSIZ);
+	(void) memset(new, 0, PBLKSIZ);
+
+	n = GET_SHORT(ino,0);
+	for (ino++; n > 0; ino += 2) {
+		key.dptr = cur + GET_SHORT(ino,0); 
+		key.dsize = off - GET_SHORT(ino,0);
+		val.dptr = cur + GET_SHORT(ino,1);
+		val.dsize = GET_SHORT(ino,0) - GET_SHORT(ino,1);
+/*
+ * select the page pointer (by looking at sbit) and insert
+ */
+		(void) putpair((exhash(key) & sbit) ? new : pag, key, val);
+
+		off = GET_SHORT(ino,1);
+		n -= 2;
+	}
+
+	debug(("%d split %d/%d\n", ((short *) cur)[0] / 2, 
+	       ((short *) new)[0] / 2,
+	       ((short *) pag)[0] / 2));
+}
+
+/*
+ * check page sanity: 
+ * number of entries should be something
+ * reasonable, and all offsets in the index should be in order.
+ * this could be made more rigorous.
+ */
+static int
+chkpage(pag)
+char *pag;
+{
+	register int n;
+	register int off;
+	register short *ino = (short *) pag;
+
+	if ((n = GET_SHORT(ino,0)) < 0 || n > PBLKSIZ / sizeof(short))
+		return 0;
+
+	if (n > 0) {
+		off = PBLKSIZ;
+		for (ino++; n > 0; ino += 2) {
+			if (GET_SHORT(ino,0) > off || GET_SHORT(ino,1) > off ||
+			    GET_SHORT(ino,1) > GET_SHORT(ino,0))
+				return 0;
+			off = GET_SHORT(ino,1);
+			n -= 2;
+		}
+	}
+	return 1;
+}
+
+/* hash.c */
+/*
+ * sdbm - ndbm work-alike hashed database library
+ * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978).
+ * author: oz@nexus.yorku.ca
+ * status: public domain. keep it that way.
+ *
+ * hashing routine
+ */
+
+/*
+ * polynomial conversion ignoring overflows
+ * [this seems to work remarkably well, in fact better
+ * then the ndbm hash function. Replace at your own risk]
+ * use: 65599	nice.
+ *      65587   even better. 
+ */
+long
+dbm_hash(str, len)
+register char *str;
+register int len;
+{
+	register unsigned long n = 0;
+
+#ifdef DUFF
+
+#define HASHC	n = *str++ + 65599 * n
+
+	if (len > 0) {
+		register int loop = (len + 8 - 1) >> 3;
+
+		switch(len & (8 - 1)) {
+		case 0:	do {
+			HASHC;	case 7:	HASHC;
+		case 6:	HASHC;	case 5:	HASHC;
+		case 4:	HASHC;	case 3:	HASHC;
+		case 2:	HASHC;	case 1:	HASHC;
+			} while (--loop);
+		}
+
+	}
+#else
+	while (len--)
+		n = ((*str++) & 255) + 65587L * n;
+#endif
+	return n;
+}

win32/sdbm.h

@@ -0,0 +1,84 @@
+/*
+ * sdbm - ndbm work-alike hashed database library
+ * based on Per-Ake Larson's Dynamic Hashing algorithms. BIT 18 (1978).
+ * author: oz@nexus.yorku.ca
+ * status: public domain. 
+ */
+#ifndef	_NDBM_H_
+#define	_NDBM_H_
+
+#define DBLKSIZ 4096
+#define PBLKSIZ 1024
+#define PAIRMAX 1008			/* arbitrary on PBLKSIZ-N */
+#define SPLTMAX	10			/* maximum allowed splits */
+					/* for a single insertion */
+#define DIRFEXT	".dir"
+#define PAGFEXT	".pag"
+
+typedef struct {
+	int dirf;		       /* directory file descriptor */
+	int pagf;		       /* page file descriptor */
+	int flags;		       /* status/error flags, see below */
+	long maxbno;		       /* size of dirfile in bits */
+	long curbit;		       /* current bit number */
+	long hmask;		       /* current hash mask */
+	long blkptr;		       /* current block for nextkey */
+	int keyptr;		       /* current key for nextkey */
+	long blkno;		       /* current page to read/write */
+	long pagbno;		       /* current page in pagbuf */
+	char pagbuf[PBLKSIZ];	       /* page file block buffer */
+	long dirbno;		       /* current block in dirbuf */
+	char dirbuf[DBLKSIZ];	       /* directory file block buffer */
+} DBM;
+
+#define DBM_RDONLY	0x1	       /* data base open read-only */
+#define DBM_IOERR	0x2	       /* data base I/O error */
+
+/*
+ * utility macros
+ */
+#define dbm_rdonly(db)		((db)->flags & DBM_RDONLY)
+#define dbm_error(db)		((db)->flags & DBM_IOERR)
+
+#define dbm_clearerr(db)	((db)->flags &= ~DBM_IOERR)  /* ouch */
+
+#define dbm_dirfno(db)	((db)->dirf)
+#define dbm_pagfno(db)	((db)->pagf)
+
+typedef struct {
+	char *dptr;
+	int dsize;
+} datum;
+
+extern datum nullitem;
+
+#if defined(__STDC__) || defined(MSDOS)
+#define proto(p) p
+#else
+#define proto(p) ()
+#endif
+
+/*
+ * flags to dbm_store
+ */
+#define DBM_INSERT	0
+#define DBM_REPLACE	1
+
+/*
+ * ndbm interface
+ */
+extern DBM *dbm_open proto((char *, int, int));
+extern void dbm_close proto((DBM *));
+extern datum dbm_fetch proto((DBM *, datum));
+extern int dbm_delete proto((DBM *, datum));
+extern int dbm_store proto((DBM *, datum, datum, int));
+extern datum dbm_firstkey proto((DBM *));
+extern datum dbm_nextkey proto((DBM *));
+
+/*
+ * other
+ */
+extern DBM *dbm_prep proto((char *, char *, int, int));
+extern long dbm_hash proto((char *, int));
+
+#endif	/* _NDBM_H_ */