summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authornagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2004-05-01 16:09:54 +0000
committernagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2004-05-01 16:09:54 +0000
commit4c4631c2daaf7b2418c1f0e39292c8ee27a64813 (patch)
treedfeb96c4772df8caba4e01e749c8f3e1262f8fe0 /ext
parentce23680755e4e9ab0eed9dc6adb091ef7f1c58cb (diff)
* renewal Ruby/Tk
git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@6237 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'ext')
-rw-r--r--ext/tcltklib/MANIFEST2
-rw-r--r--ext/tcltklib/MANUAL.eng569
-rw-r--r--ext/tcltklib/MANUAL.euc114
-rw-r--r--ext/tcltklib/README.1st2
-rw-r--r--ext/tcltklib/demo/lines3.rb54
-rw-r--r--ext/tcltklib/demo/lines4.rb54
-rw-r--r--ext/tcltklib/extconf.rb76
-rw-r--r--ext/tcltklib/tcltklib.c3614
-rw-r--r--ext/tk/MANIFEST156
-rw-r--r--ext/tk/README.fork29
-rw-r--r--ext/tk/extconf.rb1
-rw-r--r--ext/tk/lib/multi-tk.rb406
-rw-r--r--ext/tk/lib/tk.rb5472
-rw-r--r--ext/tk/lib/tk/after.rb6
-rw-r--r--ext/tk/lib/tk/autoload.rb181
-rw-r--r--ext/tk/lib/tk/bgerror.rb29
-rw-r--r--ext/tk/lib/tk/bindtag.rb78
-rw-r--r--ext/tk/lib/tk/button.rb27
-rw-r--r--ext/tk/lib/tk/canvas.rb697
-rw-r--r--ext/tk/lib/tk/canvastag.rb337
-rw-r--r--ext/tk/lib/tk/checkbutton.rb25
-rw-r--r--ext/tk/lib/tk/clipboard.rb75
-rw-r--r--ext/tk/lib/tk/clock.rb57
-rw-r--r--ext/tk/lib/tk/composite.rb64
-rw-r--r--ext/tk/lib/tk/console.rb29
-rw-r--r--ext/tk/lib/tk/dialog.rb290
-rw-r--r--ext/tk/lib/tk/encodedstr.rb107
-rw-r--r--ext/tk/lib/tk/entry.rb114
-rw-r--r--ext/tk/lib/tk/event.rb142
-rw-r--r--ext/tk/lib/tk/font.rb1407
-rw-r--r--ext/tk/lib/tk/frame.rb123
-rw-r--r--ext/tk/lib/tk/grid.rb182
-rw-r--r--ext/tk/lib/tk/image.rb185
-rw-r--r--ext/tk/lib/tk/itemfont.rb185
-rw-r--r--ext/tk/lib/tk/kinput.rb71
-rw-r--r--ext/tk/lib/tk/label.rb22
-rw-r--r--ext/tk/lib/tk/labelframe.rb20
-rw-r--r--ext/tk/lib/tk/listbox.rb252
-rw-r--r--ext/tk/lib/tk/macpkg.rb68
-rw-r--r--ext/tk/lib/tk/menu.rb460
-rw-r--r--ext/tk/lib/tk/menubar.rb144
-rw-r--r--ext/tk/lib/tk/message.rb19
-rw-r--r--ext/tk/lib/tk/mngfocus.rb33
-rw-r--r--ext/tk/lib/tk/msgcat.rb268
-rw-r--r--ext/tk/lib/tk/namespace.rb293
-rw-r--r--ext/tk/lib/tk/optiondb.rb297
-rw-r--r--ext/tk/lib/tk/pack.rb89
-rw-r--r--ext/tk/lib/tk/package.rb61
-rw-r--r--ext/tk/lib/tk/palette.rb54
-rw-r--r--ext/tk/lib/tk/panedwindow.rb204
-rw-r--r--ext/tk/lib/tk/place.rb110
-rw-r--r--ext/tk/lib/tk/radiobutton.rb32
-rw-r--r--ext/tk/lib/tk/root.rb65
-rw-r--r--ext/tk/lib/tk/scale.rb78
-rw-r--r--ext/tk/lib/tk/scrollable.rb49
-rw-r--r--ext/tk/lib/tk/scrollbar.rb105
-rw-r--r--ext/tk/lib/tk/scrollbox.rb31
-rw-r--r--ext/tk/lib/tk/selection.rb86
-rw-r--r--ext/tk/lib/tk/spinbox.rb39
-rw-r--r--ext/tk/lib/tk/tagfont.rb43
-rw-r--r--ext/tk/lib/tk/text.rb1179
-rw-r--r--ext/tk/lib/tk/textimage.rb72
-rw-r--r--ext/tk/lib/tk/textmark.rb126
-rw-r--r--ext/tk/lib/tk/texttag.rb239
-rw-r--r--ext/tk/lib/tk/textwindow.rb137
-rw-r--r--ext/tk/lib/tk/timer.rb441
-rw-r--r--ext/tk/lib/tk/toplevel.rb211
-rw-r--r--ext/tk/lib/tk/txtwin_abst.rb38
-rw-r--r--ext/tk/lib/tk/validation.rb166
-rw-r--r--ext/tk/lib/tk/variable.rb847
-rw-r--r--ext/tk/lib/tk/virtevent.rb89
-rw-r--r--ext/tk/lib/tk/winfo.rb384
-rw-r--r--ext/tk/lib/tk/winpkg.rb136
-rw-r--r--ext/tk/lib/tk/wm.rb247
-rw-r--r--ext/tk/lib/tk/xim.rb122
-rw-r--r--ext/tk/lib/tkafter.rb414
-rw-r--r--ext/tk/lib/tkbgerror.rb29
-rw-r--r--ext/tk/lib/tkcanvas.rb1023
-rw-r--r--ext/tk/lib/tkconsole.rb28
-rw-r--r--ext/tk/lib/tkdialog.rb276
-rw-r--r--ext/tk/lib/tkentry.rb294
-rw-r--r--ext/tk/lib/tkfont.rb1390
-rw-r--r--ext/tk/lib/tkmacpkg.rb56
-rw-r--r--ext/tk/lib/tkmenubar.rb143
-rw-r--r--ext/tk/lib/tkmngfocus.rb33
-rw-r--r--ext/tk/lib/tkpalette.rb54
-rw-r--r--ext/tk/lib/tkscrollbox.rb32
-rw-r--r--ext/tk/lib/tktext.rb1358
-rw-r--r--ext/tk/lib/tkvirtevent.rb85
-rw-r--r--ext/tk/lib/tkwinpkg.rb84
-rw-r--r--ext/tk/sample/binding_sample.rb87
-rw-r--r--ext/tk/sample/bindtag_sample.rb127
-rw-r--r--ext/tk/sample/binstr_usage.rb39
-rw-r--r--ext/tk/sample/btn_with_frame.rb20
-rw-r--r--ext/tk/sample/demos-en/README.1st18
-rw-r--r--ext/tk/sample/demos-en/README.tkencoding5
-rw-r--r--ext/tk/sample/demos-en/arrow.rb2
-rw-r--r--ext/tk/sample/demos-en/bind.rb2
-rw-r--r--ext/tk/sample/demos-en/browse28
-rw-r--r--ext/tk/sample/demos-en/check2.rb107
-rw-r--r--ext/tk/sample/demos-en/cscroll.rb2
-rw-r--r--ext/tk/sample/demos-en/dialog1.rb2
-rw-r--r--ext/tk/sample/demos-en/entry3.rb2
-rw-r--r--ext/tk/sample/demos-en/floor2.rb1720
-rw-r--r--ext/tk/sample/demos-en/icon.rb20
-rw-r--r--ext/tk/sample/demos-en/image1.rb4
-rw-r--r--ext/tk/sample/demos-en/image2.rb4
-rw-r--r--ext/tk/sample/demos-en/image3.rb2
-rw-r--r--ext/tk/sample/demos-en/images/earthris.gifbin6343 -> 0 bytes
-rw-r--r--ext/tk/sample/demos-en/items.rb20
-rw-r--r--ext/tk/sample/demos-en/label.rb2
-rw-r--r--ext/tk/sample/demos-en/menu.rb5
-rw-r--r--ext/tk/sample/demos-en/menu84.rb3
-rw-r--r--ext/tk/sample/demos-en/menubu.rb2
-rw-r--r--ext/tk/sample/demos-en/radio2.rb8
-rw-r--r--ext/tk/sample/demos-en/radio3.rb114
-rw-r--r--ext/tk/sample/demos-en/ruler.rb6
-rw-r--r--ext/tk/sample/demos-en/search.rb42
-rw-r--r--ext/tk/sample/demos-en/style.rb2
-rw-r--r--ext/tk/sample/demos-en/tcolor56
-rw-r--r--ext/tk/sample/demos-en/twind2.rb382
-rw-r--r--ext/tk/sample/demos-en/widget345
-rw-r--r--ext/tk/sample/demos-jp/README.1st20
-rw-r--r--ext/tk/sample/demos-jp/arrow.rb5
-rw-r--r--ext/tk/sample/demos-jp/bind.rb3
-rw-r--r--ext/tk/sample/demos-jp/bitmap.rb3
-rw-r--r--ext/tk/sample/demos-jp/browse28
-rw-r--r--ext/tk/sample/demos-jp/button.rb3
-rw-r--r--ext/tk/sample/demos-jp/check.rb7
-rw-r--r--ext/tk/sample/demos-jp/check2.rb107
-rw-r--r--ext/tk/sample/demos-jp/clrpick.rb3
-rw-r--r--ext/tk/sample/demos-jp/colors.rb3
-rw-r--r--ext/tk/sample/demos-jp/cscroll.rb3
-rw-r--r--ext/tk/sample/demos-jp/ctext.rb3
-rw-r--r--ext/tk/sample/demos-jp/dialog1.rb2
-rw-r--r--ext/tk/sample/demos-jp/dialog2.rb2
-rw-r--r--ext/tk/sample/demos-jp/entry1.rb3
-rw-r--r--ext/tk/sample/demos-jp/entry2.rb3
-rw-r--r--ext/tk/sample/demos-jp/entry3.rb4
-rw-r--r--ext/tk/sample/demos-jp/filebox.rb3
-rw-r--r--ext/tk/sample/demos-jp/floor.rb3
-rw-r--r--ext/tk/sample/demos-jp/floor2.rb1716
-rw-r--r--ext/tk/sample/demos-jp/form.rb3
-rw-r--r--ext/tk/sample/demos-jp/hscale.rb3
-rw-r--r--ext/tk/sample/demos-jp/icon.rb25
-rw-r--r--ext/tk/sample/demos-jp/image1.rb7
-rw-r--r--ext/tk/sample/demos-jp/image2.rb5
-rw-r--r--ext/tk/sample/demos-jp/image3.rb21
-rw-r--r--ext/tk/sample/demos-jp/images/earth.gifbin51709 -> 0 bytes
-rw-r--r--ext/tk/sample/demos-jp/images/face.bmp173
-rw-r--r--ext/tk/sample/demos-jp/images/flagdown.bmp27
-rw-r--r--ext/tk/sample/demos-jp/images/flagup.bmp27
-rw-r--r--ext/tk/sample/demos-jp/images/gray25.bmp6
-rw-r--r--ext/tk/sample/demos-jp/images/grey.256
-rw-r--r--ext/tk/sample/demos-jp/images/grey.56
-rw-r--r--ext/tk/sample/demos-jp/images/letters.bmp27
-rw-r--r--ext/tk/sample/demos-jp/images/noletter.bmp27
-rw-r--r--ext/tk/sample/demos-jp/images/pattern.bmp6
-rw-r--r--ext/tk/sample/demos-jp/images/tcllogo.gifbin2341 -> 0 bytes
-rw-r--r--ext/tk/sample/demos-jp/images/teapot.ppm56
-rw-r--r--ext/tk/sample/demos-jp/items.rb41
-rw-r--r--ext/tk/sample/demos-jp/label.rb5
-rw-r--r--ext/tk/sample/demos-jp/labelframe.rb2
-rw-r--r--ext/tk/sample/demos-jp/menu.rb6
-rw-r--r--ext/tk/sample/demos-jp/menu84.rb10
-rw-r--r--ext/tk/sample/demos-jp/menu8x.rb10
-rw-r--r--ext/tk/sample/demos-jp/menubu.rb8
-rw-r--r--ext/tk/sample/demos-jp/msgbox.rb3
-rw-r--r--ext/tk/sample/demos-jp/paned1.rb2
-rw-r--r--ext/tk/sample/demos-jp/paned2.rb2
-rw-r--r--ext/tk/sample/demos-jp/plot.rb3
-rw-r--r--ext/tk/sample/demos-jp/puzzle.rb3
-rw-r--r--ext/tk/sample/demos-jp/radio.rb3
-rw-r--r--ext/tk/sample/demos-jp/radio2.rb13
-rw-r--r--ext/tk/sample/demos-jp/radio3.rb114
-rw-r--r--ext/tk/sample/demos-jp/rolodex-j2
-rw-r--r--ext/tk/sample/demos-jp/ruler.rb9
-rw-r--r--ext/tk/sample/demos-jp/sayings.rb3
-rw-r--r--ext/tk/sample/demos-jp/search.rb43
-rw-r--r--ext/tk/sample/demos-jp/spin.rb2
-rw-r--r--ext/tk/sample/demos-jp/states.rb3
-rw-r--r--ext/tk/sample/demos-jp/style.rb3
-rw-r--r--ext/tk/sample/demos-jp/tcolor23
-rw-r--r--ext/tk/sample/demos-jp/text.rb3
-rw-r--r--ext/tk/sample/demos-jp/twind.rb5
-rw-r--r--ext/tk/sample/demos-jp/twind2.rb381
-rw-r--r--ext/tk/sample/demos-jp/unicodeout.rb2
-rw-r--r--ext/tk/sample/demos-jp/vscale.rb3
-rw-r--r--ext/tk/sample/demos-jp/widget412
-rw-r--r--ext/tk/sample/encstr_usage.rb29
-rw-r--r--ext/tk/sample/images/earth.gif (renamed from ext/tk/sample/demos-en/images/earth.gif)bin51709 -> 51712 bytes
-rw-r--r--ext/tk/sample/images/earthris.gif (renamed from ext/tk/sample/demos-jp/images/earthris.gif)bin6343 -> 6343 bytes
-rw-r--r--ext/tk/sample/images/face.xbm (renamed from ext/tk/sample/demos-en/images/face.xbm)0
-rw-r--r--ext/tk/sample/images/flagdown.xbm (renamed from ext/tk/sample/demos-en/images/flagdown.xbm)0
-rw-r--r--ext/tk/sample/images/flagup.xbm (renamed from ext/tk/sample/demos-en/images/flagup.xbm)0
-rw-r--r--ext/tk/sample/images/gray25.xbm (renamed from ext/tk/sample/demos-en/images/gray25.xbm)0
-rw-r--r--ext/tk/sample/images/grey.25 (renamed from ext/tk/sample/demos-en/images/grey.25)0
-rw-r--r--ext/tk/sample/images/grey.5 (renamed from ext/tk/sample/demos-en/images/grey.5)0
-rw-r--r--ext/tk/sample/images/letters.xbm (renamed from ext/tk/sample/demos-en/images/letters.xbm)0
-rw-r--r--ext/tk/sample/images/noletter.xbm (renamed from ext/tk/sample/demos-en/images/noletter.xbm)0
-rw-r--r--ext/tk/sample/images/pattern.xbm (renamed from ext/tk/sample/demos-en/images/pattern.xbm)0
-rw-r--r--ext/tk/sample/images/tcllogo.gif (renamed from ext/tk/sample/demos-en/images/tcllogo.gif)bin2341 -> 2341 bytes
-rw-r--r--ext/tk/sample/images/teapot.ppm (renamed from ext/tk/sample/demos-en/images/teapot.ppm)0
-rw-r--r--ext/tk/sample/iso2022-kr.txt2
-rw-r--r--ext/tk/sample/msgs_rb/README3
-rw-r--r--ext/tk/sample/msgs_rb/cs.msg84
-rw-r--r--ext/tk/sample/msgs_rb/de.msg88
-rw-r--r--ext/tk/sample/msgs_rb/el.msg98
-rw-r--r--ext/tk/sample/msgs_rb/en.msg83
-rw-r--r--ext/tk/sample/msgs_rb/en_gb.msg7
-rw-r--r--ext/tk/sample/msgs_rb/eo.msg87
-rw-r--r--ext/tk/sample/msgs_rb/es.msg84
-rw-r--r--ext/tk/sample/msgs_rb/fr.msg84
-rw-r--r--ext/tk/sample/msgs_rb/it.msg84
-rw-r--r--ext/tk/sample/msgs_rb/ja.msg13
-rw-r--r--ext/tk/sample/msgs_rb/nl.msg123
-rw-r--r--ext/tk/sample/msgs_rb/pl.msg87
-rw-r--r--ext/tk/sample/msgs_rb/ru.msg87
-rw-r--r--ext/tk/sample/msgs_rb2/README5
-rw-r--r--ext/tk/sample/msgs_rb2/de.msg88
-rw-r--r--ext/tk/sample/msgs_rb2/ja.msg85
-rw-r--r--ext/tk/sample/msgs_tk/README4
-rw-r--r--ext/tk/sample/msgs_tk/cs.msg84
-rw-r--r--ext/tk/sample/msgs_tk/de.msg88
-rw-r--r--ext/tk/sample/msgs_tk/el.msg103
-rw-r--r--ext/tk/sample/msgs_tk/en.msg83
-rw-r--r--ext/tk/sample/msgs_tk/en_gb.msg7
-rw-r--r--ext/tk/sample/msgs_tk/eo.msg87
-rw-r--r--ext/tk/sample/msgs_tk/es.msg84
-rw-r--r--ext/tk/sample/msgs_tk/fr.msg84
-rw-r--r--ext/tk/sample/msgs_tk/it.msg84
-rw-r--r--ext/tk/sample/msgs_tk/ja.msg13
-rw-r--r--ext/tk/sample/msgs_tk/license.terms39
-rw-r--r--ext/tk/sample/msgs_tk/nl.msg123
-rw-r--r--ext/tk/sample/msgs_tk/pl.msg87
-rw-r--r--ext/tk/sample/msgs_tk/ru.msg87
-rw-r--r--ext/tk/sample/propagate.rb30
-rw-r--r--ext/tk/sample/safe-tk.rb1
-rw-r--r--ext/tk/sample/tkballoonhelp.rb2
-rw-r--r--ext/tk/sample/tkline.rb2
-rw-r--r--ext/tk/sample/tkmsgcat-load_rb.rb102
-rw-r--r--ext/tk/sample/tkmsgcat-load_rb2.rb102
-rw-r--r--ext/tk/sample/tkmsgcat-load_tk.rb118
-rw-r--r--ext/tk/sample/tkmultilistbox.rb4
-rw-r--r--ext/tk/sample/tktextframe.rb8
-rw-r--r--ext/tk/tkutil.c1159
246 files changed, 27049 insertions, 10978 deletions
diff --git a/ext/tcltklib/MANIFEST b/ext/tcltklib/MANIFEST
index e06547a6aa..e408dc3ee8 100644
--- a/ext/tcltklib/MANIFEST
+++ b/ext/tcltklib/MANIFEST
@@ -11,6 +11,8 @@ lib/tcltk.rb
demo/lines0.tcl
demo/lines1.rb
demo/lines2.rb
+demo/lines3.rb
+demo/lines4.rb
demo/safeTk.rb
sample/sample0.rb
sample/sample1.rb
diff --git a/ext/tcltklib/MANUAL.eng b/ext/tcltklib/MANUAL.eng
index a037d18d41..20e966d223 100644
--- a/ext/tcltklib/MANUAL.eng
+++ b/ext/tcltklib/MANUAL.eng
@@ -1,5 +1,5 @@
(tof)
- 2003/10/17 Hidetoshi NAGAI
+ 2004/03/28 Hidetoshi NAGAI
This document discribes about the 'tcltklib' library. Although there
is the 'tcltk' library (tcltk.rb) under this directory, no description
@@ -41,224 +41,367 @@ module TclTklib
: a target event. With this flag, doesn't wait and returns
: false if there is no target event for processing.
- [module methods]
- mainloop(check_root = true)
- : Starts the eventloop. If 'check_root' is true, this method
- : doesn't return when a root widget exists.
- : If 'check_root' is false, doen't return by the other
- : reasons than exceptions.
-
- mainloop_watchdog(check_root = true)
- : On the normal eventloop, some kinds of callback operations
- : cause deadlock. To avoid some of such deadlocks, this
- : method starts an eventloop and a watchdog-thread.
-
- do_one_event(flag = TclTkLib::EventFlag::ALL |
- TclTkLib::EventFlag::DONT_WAIT)
- : Do one event for processing. When processed an event,
- : returns true.
- : If NOT set DONT_WAIT flag, this method waits occurrence of
- : a target event.
- : If set DONT_WAIT flag and no event for processing, returns
- : false immediately.
- : If $SAFE >= 4, or $SAFE >= 1 and the flag is tainted,
- : force to set DONT_WAIT flag.
-
- set_eventloop_tick(timer_tick)
- : Define the interval of thread-switching with an integer
- : value of mili-seconds.
- : Default timer_tick is 0. It means that thread-switching
- : is based on the count of processed events.
- : ( see 'set_eventloop_weight' method )
- : However, if the eventloop thread is the only thread,
- : timer_tick cannt be set to 0. If 0, then is set to 100 ms
- : automatically (see NO_THREAD_INTERRUPT_TIME on tcltklib.c).
- : On $SAFE >= 4, cannot call this method.
-
- get_eventloop_tick
- : Get current value of 'timer_tick'
-
- set_no_event_wait(no_event_wait)
- : Define sleeping time of the eventloop when two or more
- : thread are running and there is no event for processing.
- : Default value is 20 (ms).
- : If the eventloop thread is the only thread, this value is
- : invalid.
- : On $SAFE >= 4, cannot call this method.
-
- get_no_event_wait
- : Get current value of 'no_event_wait'.
-
- set_eventloop_weight(loop_max, no_event_tick)
- : Define the weight parameters for the eventloop thread.
- : That is invalid when the eventloop is the only thread.
- : 'loop_max' is the max events for thread-switching.
- : 'no_event_tick' is the increment value of the event count
- : when no event for processing (And then, the eventloop thead
- : sleeps 'no_event_wait' mili-seconds).
- : 'loop_max == 800' and 'no_event_tick == 10' are defalut.
- : On $SAFE >= 4, cannot call this method.
-
- get_eventloop_weight
- : Get current values of 'loop_max' and 'no_event_tick'.
-
- mainloop_abort_on_exception=(bool)
- : Define whether the eventloop stops on exception or not.
- : If true (default value), stops on exception.
- : If false, show a warinig message but ignore the exception.
- : If nil, no warning message and ignore the excepsion.
- : This parameter is sometimes useful when multiple Tk
- : interpreters are working. Because the only one eventloop
- : admins all Tk interpreters, sometimes exception on a
- : interpreter kills the eventloop thread. Even if such
- : situation, when abort_on_exception == false or nil,
- : the eventloop ignores the exception and continue to working.
- : On $SAFE >= 4, cannot call this method.
-
- mainloop_abort_on_exception
- : Get current status of that.
-
- num_of_mainwindows
- : Returns the number of main-windows (root-widget).
- : Because there is only one main-window for one Tk interpreter,
- : the value is same to the number of interpreters which has
- : available Tk functions.
+ module TclTkLib::VarAccessFlag
+ : Defines flags to give '_get_variable' and so on. When to give,
+ : please use bit-operator (e.g. GLOBAL_ONLY | LEAVE_ERR_MSG ).
+ [constants]
+ NONE
+ : Is 0. It means "set no flag".
+
+ GLOBAL_ONLY
+ : (site Tcl/Tk's man page)
+ : Under normal circumstances the procedures look up
+ : variables as follows: If a procedure call is active
+ : in interp, a variable is looked up at the current
+ : level of procedure call. Otherwise, a variable is
+ : looked up first in the current namespace, then in
+ : the global namespace. However, if this bit is set
+ : in flags then the variable is looked up only in the
+ : global namespace even if there is a procedure call
+ : active. If both GLOBAL_ONLY and NAMESPACE_ONLY are
+ : given, GLOBAL_ONLY is ignored.
+ :
+ : *** ATTENTION ***
+ : Tcl7.6 doesn't have namespaces. So NAMESPACE_ONLY
+ : is defined as 0, and then GLOBAL_ONLY is available
+ : even if flag is (GLOBAL_ONLY | NAMESPACE_ONLY).
+
+ NAMESPACE_ONLY
+ : (site Tcl/Tk's man page)
+ : Under normal circumstances the procedures look up
+ : variables as follows: If a procedure call is active
+ : in interp, a variable is looked up at the current
+ : level of procedure call. Otherwise, a variable is
+ : looked up first in the current namespace, then in
+ : the global namespace. However, if this bit is set
+ : in flags then the variable is looked up only in the
+ : current namespace even if there is a procedure call
+ : active.
+ :
+ : *** ATTENTION ***
+ : Tcl7.6 doesn't have namespaces. So NAMESPACE_ONLY
+ : is defined as 0.
+
+ LEAVE_ERR_MSG
+ : (site Tcl/Tk's man page)
+ : If an error is returned and this bit is set in flags,
+ : then an error message will be left in the interpreter's
+ : result, where it can be retrieved with Tcl_GetObjResult
+ : or Tcl_GetStringResult. If this flag bit isn't set then
+ : no error message is left and the interpreter's result
+ : will not be modified.
+
+ APPEND_VALUE
+ : (site Tcl/Tk's man page)
+ : If this bit is set then newValue is appended to the
+ : current value, instead of replacing it. If the variable
+ : is currently undefined, then this bit is ignored.
+
+ LIST_ELEMENT
+ : (site Tcl/Tk's man page)
+ : If this bit is set, then newValue is converted to a
+ : valid Tcl list element before setting (or appending
+ : to) the variable. A separator space is appended before
+ : the new list element unless the list element is going
+ : to be the first element in a list or sublist (i.e. the
+ : variable's current value is empty, or contains the
+ : single character ``{'', or ends in `` }'').
+
+ PARSE_VARNAME
+ : (site Tcl/Tk's man page)
+ : If this bit is set when calling _set_variable and so
+ : on, var_name argument may contain both an array and an
+ : element name: if the name contains an open parenthesis
+ : and ends with a close parenthesis, then the value
+ : between the parentheses is treated as an element name
+ : (which can have any string value) and the characters
+ : before the first open parenthesis are treated as the
+ : name of an array variable. If the flag PARSE_VARNAME
+ : is given, index_name argument should be 'nil' since the
+ : array and element names are taken from var_name.
+ :
+ : *** ATTENTION ***
+ : Tcl7.6 doesn't have this flag. So PARSE_VARNAME is
+ : defined as 0.
+
+ [module methods]
+ mainloop(check_root = true)
+ : Starts the eventloop. If 'check_root' is true, this method
+ : doesn't return when a root widget exists.
+ : If 'check_root' is false, doen't return by the other
+ : reasons than exceptions.
+
+ mainloop_watchdog(check_root = true)
+ : On the normal eventloop, some kinds of callback operations
+ : cause deadlock. To avoid some of such deadlocks, this
+ : method starts an eventloop and a watchdog-thread.
+
+ do_one_event(flag = TclTkLib::EventFlag::ALL |
+ TclTkLib::EventFlag::DONT_WAIT)
+ : Do one event for processing. When processed an event,
+ : returns true.
+ : If NOT set DONT_WAIT flag, this method waits occurrence of
+ : a target event.
+ : If set DONT_WAIT flag and no event for processing, returns
+ : false immediately.
+ : If $SAFE >= 4, or $SAFE >= 1 and the flag is tainted,
+ : force to set DONT_WAIT flag.
+
+ set_eventloop_tick(timer_tick)
+ : Define the interval of thread-switching with an integer
+ : value of mili-seconds.
+ : Default timer_tick is 0. It means that thread-switching
+ : is based on the count of processed events.
+ : ( see 'set_eventloop_weight' method )
+ : However, if the eventloop thread is the only thread,
+ : timer_tick cannt be set to 0. If 0, then is set to 100 ms
+ : automatically (see NO_THREAD_INTERRUPT_TIME on tcltklib.c).
+ : On $SAFE >= 4, cannot call this method.
+
+ get_eventloop_tick
+ : Get current value of 'timer_tick'
+
+ set_no_event_wait(no_event_wait)
+ : Define sleeping time of the eventloop when two or more
+ : thread are running and there is no event for processing.
+ : Default value is 20 (ms).
+ : If the eventloop thread is the only thread, this value is
+ : invalid.
+ : On $SAFE >= 4, cannot call this method.
+
+ get_no_event_wait
+ : Get current value of 'no_event_wait'.
+
+ set_eventloop_weight(loop_max, no_event_tick)
+ : Define the weight parameters for the eventloop thread.
+ : That is invalid when the eventloop is the only thread.
+ : 'loop_max' is the max events for thread-switching.
+ : 'no_event_tick' is the increment value of the event count
+ : when no event for processing (And then, the eventloop thead
+ : sleeps 'no_event_wait' mili-seconds).
+ : 'loop_max == 800' and 'no_event_tick == 10' are defalut.
+ : On $SAFE >= 4, cannot call this method.
+
+ get_eventloop_weight
+ : Get current values of 'loop_max' and 'no_event_tick'.
+
+ mainloop_abort_on_exception=(bool)
+ : Define whether the eventloop stops on exception or not.
+ : If true (default value), stops on exception.
+ : If false, show a warinig message but ignore the exception.
+ : If nil, no warning message and ignore the excepsion.
+ : This parameter is sometimes useful when multiple Tk
+ : interpreters are working. Because the only one eventloop
+ : admins all Tk interpreters, sometimes exception on a
+ : interpreter kills the eventloop thread. Even if such
+ : situation, when abort_on_exception == false or nil,
+ : the eventloop ignores the exception and continue to working.
+ : On $SAFE >= 4, cannot call this method.
+
+ mainloop_abort_on_exception
+ : Get current status of that.
+
+ num_of_mainwindows
+ : Returns the number of main-windows (root-widget).
+ : Because there is only one main-window for one Tk interpreter,
+ : the value is same to the number of interpreters which has
+ : available Tk functions.
+
+ _merge_tklist(str, str, ... )
+ : Get a Tcl's list string from arguments with a Tcl/Tk's
+ : library function. Each arguemnt is converted to a valid
+ : Tcl list element.
+
+ _conv_listelement(str)
+ : Convert the argument to a valid Tcl list element with
+ : Tcl/Tk's library function.
+
+ _toUTF8(str, encoding)
+ _fromUTF8(str, encoding)
+ : Call the function (which is internal function of Tcl/Tk) to
+ : convert to/from a UTF8 string.
+
+ _subst_UTF_backslash(str)
+ _subst_Tcl_backslash(str)
+ : Substitute backslash sequence with Tcl's rule (include \uhhhh;
+ : give a sixteen-bit hexadecimal value for Unicode character).
+ : _subst_Tcl_backslash method parses all backslash sequence.
+ : _subst_UTF_backslash method parses \uhhhh only.
class TclTkIp
[class methods]
- new(ip_name=nil, options='')
- : Generate an instance of TclTkIp class.
- : If 'ip_name' argument is given as a string, it is the name
- : of the Tk interpreter which is shown by 'winfo interps'
- : command.
- : 'options' argument accepts a string which is the command
- : line options of wish; such as '-geometry' or '-use'.
- : The information is used to generate the root widget of the
- : interpreter.
- : ( e.g. TclTkIp.new('FOO', '-geometry 500x200 -use 0x2200009') )
- : If is given nil or falsr for the 'option' argument, generates
- : the Tcl interpreter without Tk library. Then the interpreter
- : doesn't need GUI environment. Therefore, even if a window
- : system doesn't exist or cannot be used, Ruby can control the
- : Tcl interpreter and the extention libraries loaded on the
- : interpreter.
-
- [instance methods]
- create_slave(name, safe=false)
- : Create a slave interpreter.
- : The parent of the interpreter is the receiver of this method.
- : The name of the slave interpreter is given by 'name' argument.
- : The 'safe' argument decides whether the slave interpreter is
- : created as a safe interpreter or not. If true, create a safe
- : interpreter. Default is false. However, if the parent
- : interpreter is a safe interpreter, the created interpreter is
- : a safe interpreter (ignore 'safe' argument value).
- : If $SAFE >= 4, can create a safe interpreter only.
-
- make_safe
- : Make the interpreter to the safe interpreter, and returns
- : self. If fail, raise RuntimeError.
-
- safe?
- : Check whether the interpreter is the safe interpreter.
- : If is the safe interpreter, returns true.
-
- delete
- : Delete the interpreter.
- : The deleted interpreter doesn't accept command and then
- : raise an exception.
-
- deleted?
- : Check whether the interpreter is already deleted.
- : If deleted, returns true.
-
- restart
- : Restart Tk part of the interpreter.
- : Use this when you need Tk functions after destroying the
- : root widget.
- : On $SAFE >= 4, cannot call this method.
-
- _eval(str)
- _invoke(*args)
- : Estimates the arguments as a command on the Tk interpreter.
- : The argument of _eval is a script of Tcl/Tk.
- : Each argument of _invoke is a token of one command line of
- : Tcl/Tk.
- : Because the operation of _invoke doesn't through the
- : command line parser of Tk interpreter, the cost of
- : estimation is smaller than _eval. However, auto_load
- : mechanism of the Tk interpreter doesn't work on _invoke.
- : So _invoke can call only the command which already
- : registered on the interpreter by 'load' command and so on.
- : On _eval command, auto_load mechanism words. So if succeed
- : to _eval and regist the command once, after that, the
- : command can be called by _invoke.
-
- _toUTF8(str, encoding)
- _fromUTF8(str, encoding)
- : Call the function (which is internal function of Tcl/Tk) to
- : convert to/from a UTF8 string.
-
- _thread_vwait(var_name)
- _thread_tkwait(mode, target)
- : 'vwait' or 'tkwait' with thread support.
- : The difference from normal 'vwait' or 'tkwait' command is
- : doing independent wait from the vwait stack when they are
- : called on the other thread than the eventloop thread.
- : In the case of Tcl/Tk's vwait / tkwait, if 2nd vwait /
- : tkwait is called on waiting for 1st vwait / tkwait,
- : returns the order of [2nd]->[1st] regardless of the order
- : of when the wait condition was fulfilled.
- : If _thread_vwait / _thread_tkwait is called on the
- : eventloop thread, there is no difference from vwait /
- : tkwait. But if called on the other thread than the
- : eventloop, stops the thread. And when the wait condition
- : is fulfilled, the thread restarts. The meaning of
- : "independent from the vwait stack" is that the timing of
- : restarting is independent from the waiting status of the
- : other threads. That is, even if the eventloop thread is
- : waiting by vwait and is not fulfilled the condition,
- : _thread_vwait completes the waiting when its waiting
- : condition is fulfilled and the thread which stopped by
- : _thread_vwait can continue the operation.
-
- _return_value
- : Get the last result value on the interpreter.
-
- mainloop
- mainloop_watchdog
- : If on the slave interpreter, never start an eventloop and
- : returns nil.
- : With the exception that, same to the TclTkLib module method
- : with the same name.
-
- do_one_event
- : With the exception that the argument is forced to set
- : DONT_WAIT flag on the slave interpreter, same to
- : TclTkLib#do_one_event.
-
- set_eventloop_tick
- get_eventloop_tick
- set_no_event_wait
- get_no_event_wait
- set_eventloop_weight
- get_eventloop_weight
- mainloop_abort_on_exception
- mainloop_abort_on_exception=
- : With the exception that it is ignored to set value on the
- : slave interpreter, same to the TclTkLib module method with
- : the same name.
+ new(ip_name=nil, options='')
+ : Generate an instance of TclTkIp class.
+ : If 'ip_name' argument is given as a string, it is the name
+ : of the Tk interpreter which is shown by 'winfo interps'
+ : command.
+ : 'options' argument accepts a string which is the command
+ : line options of wish; such as '-geometry' or '-use'.
+ : The information is used to generate the root widget of the
+ : interpreter.
+ : ( e.g. TclTkIp.new('FOO', '-geometry 500x200 -use 0x2200009') )
+ : If is given nil or falsr for the 'option' argument, generates
+ : the Tcl interpreter without Tk library. Then the interpreter
+ : doesn't need GUI environment. Therefore, even if a window
+ : system doesn't exist or cannot be used, Ruby can control the
+ : Tcl interpreter and the extention libraries loaded on the
+ : interpreter.
+
+ [instance methods]
+ create_slave(name, safe=false)
+ : Create a slave interpreter.
+ : The parent of the interpreter is the receiver of this method.
+ : The name of the slave interpreter is given by 'name' argument.
+ : The 'safe' argument decides whether the slave interpreter is
+ : created as a safe interpreter or not. If true, create a safe
+ : interpreter. Default is false. However, if the parent
+ : interpreter is a safe interpreter, the created interpreter is
+ : a safe interpreter (ignore 'safe' argument value).
+ : If $SAFE >= 4, can create a safe interpreter only.
+
+ make_safe
+ : Make the interpreter to the safe interpreter, and returns
+ : self. If fail, raise RuntimeError.
+
+ safe?
+ : Check whether the interpreter is the safe interpreter.
+ : If is the safe interpreter, returns true.
+
+ delete
+ : Delete the interpreter.
+ : The deleted interpreter doesn't accept command and then
+ : raise an exception.
+
+ deleted?
+ : Check whether the interpreter is already deleted.
+ : If deleted, returns true.
+
+ restart
+ : Restart Tk part of the interpreter.
+ : Use this when you need Tk functions after destroying the
+ : root widget.
+ : On $SAFE >= 4, cannot call this method.
+
+ _eval(str)
+ _invoke(*args)
+ : Estimates the arguments as a command on the Tk interpreter.
+ : The argument of _eval is a script of Tcl/Tk.
+ : Each argument of _invoke is a token of one command line of
+ : Tcl/Tk.
+ : Because the operation of _invoke doesn't through the
+ : command line parser of Tk interpreter, the cost of
+ : estimation is smaller than _eval. However, auto_load
+ : mechanism of the Tk interpreter doesn't work on _invoke.
+ : So _invoke can call only the command which already
+ : registered on the interpreter by 'load' command and so on.
+ : On _eval command, auto_load mechanism words. So if succeed
+ : to _eval and regist the command once, after that, the
+ : command can be called by _invoke.
+
+ _toUTF8(str, encoding)
+ _fromUTF8(str, encoding)
+ : Call the function (which is internal function of Tcl/Tk) to
+ : convert to/from a UTF8 string.
+
+ _thread_vwait(var_name)
+ _thread_tkwait(mode, target)
+ : 'vwait' or 'tkwait' with thread support.
+ : The difference from normal 'vwait' or 'tkwait' command is
+ : doing independent wait from the vwait stack when they are
+ : called on the other thread than the eventloop thread.
+ : In the case of Tcl/Tk's vwait / tkwait, if 2nd vwait /
+ : tkwait is called on waiting for 1st vwait / tkwait,
+ : returns the order of [2nd]->[1st] regardless of the order
+ : of when the wait condition was fulfilled.
+ : If _thread_vwait / _thread_tkwait is called on the
+ : eventloop thread, there is no difference from vwait /
+ : tkwait. But if called on the other thread than the
+ : eventloop, stops the thread. And when the wait condition
+ : is fulfilled, the thread restarts. The meaning of
+ : "independent from the vwait stack" is that the timing of
+ : restarting is independent from the waiting status of the
+ : other threads. That is, even if the eventloop thread is
+ : waiting by vwait and is not fulfilled the condition,
+ : _thread_vwait completes the waiting when its waiting
+ : condition is fulfilled and the thread which stopped by
+ : _thread_vwait can continue the operation.
+
+ _return_value
+ : Get the last result value on the interpreter.
+
+ _get_variable(var_name, flag)
+ _get_variable2(var_name, index_name, flag)
+ : Get the current value of a variable. If specified a
+ : index_name (see also the PARSE_VARNAME flag), get the
+ : value of the index_name element.
+
+ _set_variable(var_name, value, flag)
+ _set_variable2(var_name, index_name, value, flag)
+ : Create or modify a variable. If specified a index_name
+ : (see also the PARSE_VARNAME flag), create or modify the
+ : index_name element.
+
+ _unset_variable(var_name)
+ _unset_variable2(var_name, index_name)
+ : Remove a variable. If specified a index_name (see also
+ : the PARSE_VARNAME flag), remove the index_name element.
+
+ _get_global_var(var_name)
+ _get_global_var2(var_name, index_name)
+ _set_global_var(var_name, value)
+ _set_global_var2(var_name, index_name, value)
+ _unset_global_var(var_name)
+ _unset_global_var2(var_name, index_name)
+ : Call the associated method with the flag argument
+ : (GLOBAL_ONLY | LEAVE_ERR_MSG).
+
+ _split_tklist(str)
+ : Split the argument with Tcl/Tk's library function and
+ : get an array as a list of Tcl list elements.
+
+ _merge_tklist(str, str, ... )
+ : Get a Tcl's list string from arguments with a Tcl/Tk's
+ : library function. Each arguemnt is converted to a valid
+ : Tcl list element.
+
+ _conv_listelement(str)
+ : Convert the argument to a valid Tcl list element with
+ : Tcl/Tk's library function.
+
+ mainloop
+ mainloop_watchdog
+ : If on the slave interpreter, never start an eventloop and
+ : returns nil.
+ : With the exception that, same to the TclTkLib module method
+ : with the same name.
+
+ do_one_event
+ : With the exception that the argument is forced to set
+ : DONT_WAIT flag on the slave interpreter, same to
+ : TclTkLib#do_one_event.
+
+ set_eventloop_tick
+ get_eventloop_tick
+ set_no_event_wait
+ get_no_event_wait
+ set_eventloop_weight
+ get_eventloop_weight
+ mainloop_abort_on_exception
+ mainloop_abort_on_exception=
+ : With the exception that it is ignored to set value on the
+ : slave interpreter, same to the TclTkLib module method with
+ : the same name.
class TkCallbackBreak < StandardError
class TkCallbackContinue < StandardError
- : They are exception classes to break or continue the Tk callback
- : operation.
- : If raise TkCallbackBreak on the callback procedure, Ruby returns
- : 'break' code to Tk interpreter (Then the Tk interpreter will
- : break the operation for the current event).
- : If raise TkCallbackContinue, returns 'continue' code (Then the Tk
- : interpreter will break the operateion for the current bindtag and
- : starts the operation for the next buindtag for the current event).
+ : They are exception classes to break or continue the Tk callback
+ : operation.
+ : If raise TkCallbackBreak on the callback procedure, Ruby returns
+ : 'break' code to Tk interpreter (Then the Tk interpreter will
+ : break the operation for the current event).
+ : If raise TkCallbackContinue, returns 'continue' code (Then the Tk
+ : interpreter will break the operateion for the current bindtag and
+ : starts the operation for the next buindtag for the current event).
(eof)
diff --git a/ext/tcltklib/MANUAL.euc b/ext/tcltklib/MANUAL.euc
index 9f9c77da02..baddcaf54b 100644
--- a/ext/tcltklib/MANUAL.euc
+++ b/ext/tcltklib/MANUAL.euc
@@ -1,5 +1,5 @@
(tof)
- 2003/10/17 Hidetoshi NAGAI
+ 2004/03/28 Hidetoshi NAGAI
本ドキュメントには古い tcltk ライブラリ,tcltklib ライブラリの説明
が含まれていますが,その記述内容は古いものとなっています.
@@ -175,6 +175,52 @@ require "tcltklib" すると, 以下のモジュール, クラスが利用可能です.
: 処理対象イベントが存在しない場合に,イベント発生を待たず
: に do_one_event を終了 ( false を返す ) する
+ モジュール TclTkLib::VarAccessFlag
+ : _get_variable などでのフラグを指定するためのもの.フラグに
+ : は以下の定数を OR で連結して与える.
+
+ 定数 NONE
+ : 値は 0 で,何もフラグを指定していないのに等しい.
+
+ 定数 GLOBAL_ONLY
+ : 通常,変数の検索はまず手続き呼び出しを行ったレベルで検
+ : 索し,次に現在の名前空間で検索,最後にグローバル空間で
+ : 検索を行う.しかし,このフラグが指定された場合には,グ
+ : ローバル空間でのみ検索する.
+ : もし GLOBAL_ONLY と NAMESPACE_ONLY とが両方指定された場
+ : 合には,GLOBAL_ONLY の指定は無視される.
+
+ 定数 NAMESPACE_ONLY
+ : このフラグが指定された場合には,現在の名前空間でのみ変
+ : 数の検索を行う.GLOBAL_ONLY の説明も参照すること.
+
+ 定数 LEAVE_ERR_MSG
+ : 変数アクセスにおいてエラーが発生した場合,このフラグが
+ : 指定されていれば,実行結果として Tcl インタープリタにエ
+ : ラーメッセージが残される.このフラグが指定されていなけ
+ : れば,エラーメッセージは一切残されない.
+
+ 定数 APPEND_VALUE
+ : このフラグが指定されていた場合,変数の値を置き換えので
+ : はなく,現在の値に代入値が追加 (append; 文字列連結) さ
+ : れる.変数が未定義あった場合,このフラグは無視される.
+
+ 定数 LIST_ELEMENT
+ : このフラグが指定されていた場合,代入値はまず Tcl のリス
+ : ト要素として適切となるように変換される.代入値がリスト
+ : (またはサブリスト) の最初の要素となるのでない限り,代入
+ : 値の直前には空白文字が追加される.
+
+ 定数 PARSE_VARNAME
+ : _set_variable などの呼び出しにおいてこのフラグが指定さ
+ : れていた場合,var_name 引数が連想配列名と要素名とを両方
+ : 含む可能性がある (開き括弧を含み,閉じ括弧で終わる) こ
+ : とを示す.その場合,括弧の間が要素名指定,最初の開き括
+ : 弧までが連想配列名として扱われる._set_variable2 などで
+ : このフラグを指定する場合,連想配列名と要素名は var_name
+ : から抽出されるはずであるから,index_name 引数は nil と
+ : せねばならない.
+
モジュールメソッド
mainloop(check_root = true)
: イベントループを起動する.check_root が true であれば,
@@ -277,6 +323,26 @@ require "tcltklib" すると, 以下のモジュール, クラスが利用可能です.
: ので,この値は現在 Tk の機能が有効であるインタープリタの総
: 数に等しい.
+ _merge_tklist(str, str, ... )
+ : Tcl/Tk のライブラリ関数を使って,引数の文字列がそれぞれ
+ : 正しく一つのリスト要素となるように連結した文字列を返す.
+
+ _conv_listelement(str)
+ : Tcl/Tk のライブラリ関数を使って,引数の文字列が Tcl の
+ : 一つのリスト要素として適切な表現になるように変換した文
+ : 字列を返す.
+
+ _toUTF8(str, encoding)
+ _fromUTF8(str, encoding)
+ : Tcl/Tk が内蔵している UTF8 変換処理を呼び出す.
+
+ _subst_UTF_backslash(str)
+ _subst_Tcl_backslash(str)
+ : Tcl のルールでバックスラッシュ記法 ( \uhhhh による
+ : Unicode 文字表現を含む ) を解析する.
+ : _subst_Tcl_backslash はすべてのバックスラッシュ記法を
+ : 置き換えるのに対し,_subst_UTF_backslash は \uhhhh
+ : による Unicode 文字表現だけを置き換える.
クラス TclTkIp
クラスメソッド
@@ -373,6 +439,52 @@ require "tcltklib" すると, 以下のモジュール, クラスが利用可能です.
_return_value
: 直前の Tcl/Tk 上での評価の実行結果としての戻り値を返す.
+ _get_variable(var_name, flag)
+ _get_variable2(var_name, index_name, flag)
+ : Tcl/Tk 上の var という変数名の変数の値を返す.
+ : もし index_name が指定 (PARSE_VARNAME フラグの説明も参照)
+ : された場合は連想配列 var_name の index_name の要素を返す.
+ : flag には変数を検索する際の条件を指定する.flag に与える
+ : 値はモジュール TclTkLib::VarAccessFlag を参照すること.
+
+ _set_variable(var_name, value, flag)
+ _set_variable2(var_name, index_name, value, flag)
+ : Tcl/Tk 上の var という変数名の変数に値を設定する.
+ : もし index_name が指定 (PARSE_VARNAME フラグの説明も参照)
+ : された場合は連想配列 var_name の index_name の要素を設定
+ : する.
+ : flag には変数を検索する際の条件を指定する.flag に与える
+ : 値はモジュール TclTkLib::VarAccessFlag を参照すること.
+
+ _unset_variable(var_name)
+ _unset_variable2(var_name, index_name)
+ : Tcl/Tk 上の var_name という変数名の変数を消去する.
+ : もし index_name が指定 (PARSE_VARNAME フラグの説明も参照)
+ : された場合は連想配列 var_name から index_name の要素だけ
+ : を消去する.
+
+ _get_global_var(var_name)
+ _get_global_var2(var_name, index_name)
+ _set_global_var(var_name, value)
+ _set_global_var2(var_name, index_name, value)
+ _unset_global_var(var_name)
+ _unset_global_var2(var_name, index_name)
+ : それぞれ,対応する変数アクセスメソッドの flag に対して
+ : (GLOBAL_ONLY | LEAVE_ERR_MSG) を与えたもの.
+
+ _split_tklist(str)
+ : Tcl/Tk のライブラリ関数を使って,文字列 str をリストに
+ : 分割する (文字列の配列として返す).
+
+ _merge_tklist(str, str, ... )
+ : Tcl/Tk のライブラリ関数を使って,引数の文字列がそれぞれ
+ : 正しく一つのリスト要素となるように連結した文字列を返す.
+
+ _conv_listelement(str)
+ : Tcl/Tk のライブラリ関数を使って,引数の文字列が Tcl の
+ : 一つのリスト要素として適切な表現になるように変換した文
+ : 字列を返す.
+
mainloop
mainloop_watchdog
: スレーブ IP の場合にはイベントループを起動せずに nil を返す.
diff --git a/ext/tcltklib/README.1st b/ext/tcltklib/README.1st
index 510dd1c2cd..48e3a2b668 100644
--- a/ext/tcltklib/README.1st
+++ b/ext/tcltklib/README.1st
@@ -8,7 +8,7 @@ some or all of the following options.
--with-tcllib=<libname> (e.g. libtcl8.3.so ==> --with-tcllib=tcl8.3)
--with-tklib=<libname> (e.g. libtk8.3.so ==> --with-tklib=tk8.3)
- --enable_tcltk_stubs (if you force to enable stubs)
+ --enable-tcltk_stubs (if you force to enable stubs)
--with-tcl-dir=<path>
equal to "--with-tcl-include=<path>/include --with-tcl-lib=<path>/lib"
diff --git a/ext/tcltklib/demo/lines3.rb b/ext/tcltklib/demo/lines3.rb
new file mode 100644
index 0000000000..caa50f92e7
--- /dev/null
+++ b/ext/tcltklib/demo/lines3.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
+# $a.create(TkcLine, 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.create(TkcLine, 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
diff --git a/ext/tcltklib/demo/lines4.rb b/ext/tcltklib/demo/lines4.rb
new file mode 100644
index 0000000000..7a1175bce0
--- /dev/null
+++ b/ext/tcltklib/demo/lines4.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
+# TkCore::INTERP.__invoke($a.path, "create", "line", i.to_s, '0', '0', (500 - i).to_s, "-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
+ TkCore::INTERP.__invoke($a.path, "create", "line", i.to_s, '0', '0', (500 - i).to_s, "-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
diff --git a/ext/tcltklib/extconf.rb b/ext/tcltklib/extconf.rb
index 575bf78034..6b2fcdd4ac 100644
--- a/ext/tcltklib/extconf.rb
+++ b/ext/tcltklib/extconf.rb
@@ -2,7 +2,9 @@
require 'mkmf'
-if RUBY_PLATFORM !~ /mswin32|mingw|cygwin|bccwin32/
+is_win32 = (/mswin32|mingw|cygwin|bccwin32/ =~ RUBY_PLATFORM)
+
+unless is_win32
have_library("nsl", "t_open")
have_library("socket", "socket")
have_library("dl", "dlopen")
@@ -25,7 +27,7 @@ def find_tcl(tcllib, stubs)
elsif find_library("tcl", func, *paths)
true
else
- %w[8.4 8.3 8.2 8.0 7.6].find { |ver|
+ %w[8.5 8.4 8.3 8.2 8.1 8.0 7.6].find { |ver|
find_library("tcl#{ver}", func, *paths) or
find_library("tcl#{ver.delete('.')}", func, *paths)
}
@@ -40,7 +42,7 @@ def find_tk(tklib, stubs)
elsif find_library("tk", func, *paths)
true
else
- %w[8.4 8.3 8.2 8.0 4.2].find { |ver|
+ %w[8.5 8.4 8.3 8.2 8.1 8.0 4.2].find { |ver|
find_library("tk#{ver}", func, *paths) or
find_library("tk#{ver.delete('.')}", func, *paths)
}
@@ -48,11 +50,73 @@ def find_tk(tklib, stubs)
end
if have_header("tcl.h") && have_header("tk.h") &&
- (/mswin32|mingw|cygwin|bccwin32/ =~ RUBY_PLATFORM || find_library("X11", "XOpenDisplay",
- "/usr/X11/lib", "/usr/lib/X11", "/usr/X11R6/lib", "/usr/openwin/lib")) &&
+ (is_win32 || find_library("X11", "XOpenDisplay",
+ "/usr/X11/lib", "/usr/lib/X11", "/usr/X11R6/lib", "/usr/openwin/lib")) &&
find_tcl(tcllib, stubs) &&
find_tk(tklib, stubs)
$CPPFLAGS += ' -DUSE_TCL_STUBS -DUSE_TK_STUBS' if stubs
$CPPFLAGS += ' -D_WIN32' if /cygwin/ =~ RUBY_PLATFORM
- create_makefile("tcltklib")
+
+ pthread_enabled = macro_defined?('HAVE_LIBPTHREAD', '#include "ruby.h"')
+
+ if try_run(<<EOF)
+#include <tcl.h>
+static Tcl_ThreadDataKey dataKey;
+int main() { exit((Tcl_GetThreadData(&dataKey, 1) == dataKey)? 1: 0); }
+EOF
+ tcl_enable_thread = true
+ else
+ tcl_enable_thread = false
+ end
+
+ unless pthread_enabled
+ if tcl_enable_thread
+ # ruby -> disable && tcl -> enable
+ puts(%Q'\
+*****************************************************************************
+**
+** PTHREAD SUPPORT MODE ERRROR:
+**
+** Ruby is not compiled with --enable-pthread, but your Tcl/Tk
+** libararies seems to be compiled with "pthread support". This
+** combination possibly cause "Hang-up" or "Segmentation Fault"
+** frequently when Ruby/Tk is working. We NEVER recommend you to
+** create the library under such combination of pthread support.
+**
+** Please recompile Ruby with "--enable-pthread" configure option
+** or recompile Tcl/Tk with "--disable-threads" configure option.
+**
+*****************************************************************************
+')
+ else
+ # ruby -> disable && tcl -> disable
+ create_makefile("tcltklib")
+ end
+ else
+ unless tcl_enable_thread
+ # ruby -> enable && tcl -> disable
+ puts(%Q'\
+*****************************************************************************
+**
+** PTHREAD SUPPORT MODE WARNING:
+**
+** Ruby is compiled with --enable-pthread, but your Tcl/Tk libraries
+** seems to be compiled without "pthread support". Although You can
+** create tcltklib library, this combination may cause memory trouble
+** (e.g. "Hang-up" or "Segmentation Fault"). If you have no reason you
+** must have to keep current pthread support status, we recommend you
+** to make both or neither libraries to support pthread.
+**
+** If you want change the status of pthread support, please recompile
+** Ruby without "--enable-pthread" configure option or recompile Tcl/Tk
+** with "--enable-threads" configure option (if your Tcl/Tk is later
+** than Tcl/Tk8.1).
+**
+*****************************************************************************
+')
+ end
+ # ruby -> enable && tcl -> enable/disable
+
+ create_makefile("tcltklib")
+ end
end
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index 63dd593605..eea7ace7fa 100644
--- a/ext/tcltklib/tcltklib.c
+++ b/ext/tcltklib/tcltklib.c
@@ -36,28 +36,62 @@
# endif
# endif
# endif
-#else /* TCL_MAJOR_VERSION == 7 */
+#else /* TCL_MAJOR_VERSION < 8 */
# ifdef CONST
# define CONST84 CONST
# else
+# define CONST
# define CONST84
# endif
#endif
-/* for ruby_debug */
+/* copied from eval.c */
+#define TAG_RETURN 0x1
+#define TAG_BREAK 0x2
+#define TAG_NEXT 0x3
+#define TAG_RETRY 0x4
+#define TAG_REDO 0x5
+#define TAG_RAISE 0x6
+#define TAG_FATAL 0x8
-#define DUMP1(ARG1) if (ruby_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1);}
+/* for ruby_debug */
+#define DUMP1(ARG1) if (ruby_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1); fflush(stderr); }
#define DUMP2(ARG1, ARG2) if (ruby_debug) { fprintf(stderr, "tcltklib: ");\
-fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); }
+fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); fflush(stderr); }
/*
#define DUMP1(ARG1)
#define DUMP2(ARG1, ARG2)
*/
+/* finalize_proc_name */
+static char *finalize_hook_name = "INTERP_FINALIZE_HOOK";
+
/* for callback break & continue */
+static VALUE eTkCallbackReturn;
static VALUE eTkCallbackBreak;
static VALUE eTkCallbackContinue;
+static VALUE eLocalJumpError;
+
+static ID ID_at_enc;
+static ID ID_at_interp;
+
+static ID ID_stop_p;
+static ID ID_kill;
+static ID ID_join;
+
+static ID ID_call;
+static ID ID_backtrace;
+static ID ID_message;
+
+static ID ID_at_reason;
+static ID ID_return;
+static ID ID_break;
+static ID ID_next;
+
+static ID ID_to_s;
+static ID ID_inspect;
+
static VALUE ip_invoke_real _((int, VALUE*, VALUE));
static VALUE ip_invoke _((int, VALUE*, VALUE));
@@ -78,23 +112,45 @@ int *tclDummyMathPtr = (int *) matherr;
struct invoke_queue {
Tcl_Event ev;
int argc;
- VALUE *argv;
- VALUE obj;
- int done;
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_Obj **argv;
+#else /* TCL_MAJOR_VERSION < 8 */
+ char **argv;
+#endif
+ VALUE interp;
+ int *done;
int safe_level;
- VALUE *result;
+ VALUE result;
VALUE thread;
};
struct eval_queue {
Tcl_Event ev;
- VALUE str;
- VALUE obj;
- int done;
+ char *str;
+ int len;
+ VALUE interp;
+ int *done;
int safe_level;
- VALUE *result;
+ VALUE result;
VALUE thread;
};
+
+void
+invoke_queue_mark(struct invoke_queue *q)
+{
+ rb_gc_mark(q->interp);
+ rb_gc_mark(q->result);
+ rb_gc_mark(q->thread);
+}
+
+void
+eval_queue_mark(struct eval_queue *q)
+{
+ rb_gc_mark(q->interp);
+ rb_gc_mark(q->result);
+ rb_gc_mark(q->thread);
+}
+
static VALUE eventloop_thread;
static VALUE watchdog_thread;
@@ -128,9 +184,11 @@ static int loop_counter = 0;
static int check_rootwidget_flag = 0;
#if TCL_MAJOR_VERSION >= 8
-static int ip_ruby _((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST*));
-#else
-static int ip_ruby _((ClientData, Tcl_Interp *, int, char **));
+static int ip_ruby_eval _((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST*));
+static int ip_ruby_cmd _((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST*));
+#else /* TCL_MAJOR_VERSION < 8 */
+static int ip_ruby_eval _((ClientData, Tcl_Interp *, int, char **));
+static int ip_ruby_cmd _((ClientData, Tcl_Interp *, int, char **));
#endif
/*---- class TclTkIp ----*/
@@ -161,10 +219,16 @@ static void
_timer_for_tcl(clientData)
ClientData clientData;
{
+ int thr_crit_bup;
+
/* struct invoke_queue *q, *tmp; */
/* VALUE thread; */
DUMP1("called timer_for_tcl");
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
Tk_DeleteTimerHandler(timer_token);
run_timer_flag = 1;
@@ -176,6 +240,8 @@ _timer_for_tcl(clientData)
timer_token = (Tcl_TimerToken)NULL;
}
+ rb_thread_critical = thr_crit_bup;
+
/* rb_thread_schedule(); */
/* tick_counter += event_loop_max; */
}
@@ -186,6 +252,7 @@ set_eventloop_tick(self, tick)
VALUE tick;
{
int ttick = NUM2INT(tick);
+ int thr_crit_bup;
rb_secure(4);
@@ -194,6 +261,9 @@ set_eventloop_tick(self, tick)
"timer-tick parameter must be 0 or positive number");
}
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
/* delete old timer callback */
Tk_DeleteTimerHandler(timer_token);
@@ -206,6 +276,8 @@ set_eventloop_tick(self, tick)
timer_token = (Tcl_TimerToken)NULL;
}
+ rb_thread_critical = thr_crit_bup;
+
return tick;
}
@@ -335,6 +407,39 @@ ip_get_eventloop_weight(self)
}
static VALUE
+set_max_block_time(self, time)
+ VALUE self;
+ VALUE time;
+{
+ struct Tcl_Time tcl_time;
+ VALUE divmod;
+
+ switch(TYPE(time)) {
+ case T_FIXNUM:
+ case T_BIGNUM:
+ /* time is micro-second value */
+ divmod = rb_funcall(time, rb_intern("divmod"), 1, LONG2NUM(1000000));
+ tcl_time.sec = NUM2LONG(RARRAY(divmod)->ptr[0]);
+ tcl_time.usec = NUM2LONG(RARRAY(divmod)->ptr[1]);
+ break;
+
+ case T_FLOAT:
+ /* time is second value */
+ divmod = rb_funcall(time, rb_intern("divmod"), 1, INT2FIX(1));
+ tcl_time.sec = NUM2LONG(RARRAY(divmod)->ptr[0]);
+ tcl_time.usec = (long)(NUM2DBL(RARRAY(divmod)->ptr[1]) * 1000000);
+
+ default:
+ rb_raise(rb_eArgError, "invalid value for time: '%s'",
+ RSTRING(rb_funcall(time, ID_inspect, 0, 0))->ptr);
+ }
+
+ Tcl_SetMaxBlockTime(&tcl_time);
+
+ return Qnil;
+}
+
+static VALUE
lib_evloop_abort_on_exc(self)
VALUE self;
{
@@ -361,7 +466,7 @@ lib_evloop_abort_on_exc_set(self, val)
rb_secure(4);
if (RTEST(val)) {
event_loop_abort_on_exc = 1;
- } else if (val == Qnil) {
+ } else if (NIL_P(val)) {
event_loop_abort_on_exc = -1;
} else {
event_loop_abort_on_exc = 0;
@@ -391,13 +496,19 @@ lib_num_of_mainwindows(self)
}
static int
-lib_eventloop_core(check_root, check_var)
+lib_eventloop_core(check_root, update_flag, check_var)
int check_root;
+ int update_flag;
int *check_var;
{
VALUE current = eventloop_thread;
int found_event = 1;
+ int event_flag;
struct timeval t;
+ int thr_crit_bup;
+
+
+ if (update_flag) DUMP1("update loop start!!");
t.tv_sec = (time_t)0;
t.tv_usec = (time_t)(no_event_wait*1000.0);
@@ -405,8 +516,11 @@ lib_eventloop_core(check_root, check_var)
Tk_DeleteTimerHandler(timer_token);
run_timer_flag = 0;
if (timer_tick > 0) {
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl,
(ClientData)0);
+ rb_thread_critical = thr_crit_bup;
} else {
timer_token = (Tcl_TimerToken)NULL;
}
@@ -416,7 +530,13 @@ lib_eventloop_core(check_root, check_var)
DUMP1("no other thread");
event_loop_wait_event = 0;
- if (timer_tick == 0) {
+ if (update_flag) {
+ event_flag = update_flag | TCL_DONT_WAIT; /* for safety */
+ } else {
+ event_flag = TCL_ALL_EVENTS;
+ }
+
+ if (timer_tick == 0 && update_flag == 0) {
timer_tick = NO_THREAD_INTERRUPT_TIME;
timer_token = Tk_CreateTimerHandler(timer_tick,
_timer_for_tcl,
@@ -429,25 +549,30 @@ lib_eventloop_core(check_root, check_var)
}
}
- found_event = Tcl_DoOneEvent(TCL_ALL_EVENTS);
+ found_event = Tcl_DoOneEvent(event_flag);
- if (loop_counter++ > 30000) {
- loop_counter = 0;
+ if (update_flag != 0) {
+ if (found_event) {
+ DUMP1("next update loop");
+ continue;
+ } else {
+ DUMP1("update complete");
+ return 0;
+ }
}
- if (run_timer_flag) {
- /*
- DUMP1("timer interrupt");
+ DUMP1("check Root Widget");
+ if (check_root && Tk_GetNumMainWindows() == 0) {
run_timer_flag = 0;
- DUMP1("call rb_trap_exec()");
- rb_trap_exec();
- */
- DUMP1("check Root Widget");
- if (check_root && Tk_GetNumMainWindows() == 0) {
- run_timer_flag = 0;
- rb_trap_exec();
- return 1;
+ if (!rb_prohibit_interrupt) {
+ if (rb_trap_pending) rb_trap_exec();
}
+ return 1;
+ }
+
+ if (loop_counter++ > 30000) {
+ /* fprintf(stderr, "loop_counter > 30000\n"); */
+ loop_counter = 0;
}
} else {
@@ -458,6 +583,12 @@ lib_eventloop_core(check_root, check_var)
found_event = 1;
+ if (update_flag) {
+ event_flag = update_flag | TCL_DONT_WAIT; /* for safety */
+ } else {
+ event_flag = TCL_ALL_EVENTS | TCL_DONT_WAIT;
+ }
+
timer_tick = req_timer_tick;
tick_counter = 0;
while(tick_counter < event_loop_max) {
@@ -467,27 +598,40 @@ lib_eventloop_core(check_root, check_var)
}
}
- if (Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT)) {
+ if (Tcl_DoOneEvent(event_flag)) {
tick_counter++;
} else {
+ if (update_flag != 0) {
+ DUMP1("update complete");
+ return 0;
+ }
tick_counter += no_event_tick;
+ rb_thread_wait_for(t);
+ }
+
+ if (watchdog_thread != 0 && eventloop_thread != current) {
+ return 1;
+ }
- DUMP1("check Root Widget");
- if (check_root && Tk_GetNumMainWindows() == 0) {
- return 1;
+ DUMP1("check Root Widget");
+ if (check_root && Tk_GetNumMainWindows() == 0) {
+ run_timer_flag = 0;
+ if (!rb_prohibit_interrupt) {
+ if (rb_trap_pending) rb_trap_exec();
}
+ return 1;
+ }
- rb_thread_wait_for(t);
+ DUMP1("trap check");
+ if (!rb_prohibit_interrupt) {
+ if (rb_trap_pending) rb_trap_exec();
}
if (loop_counter++ > 30000) {
+ /* fprintf(stderr, "loop_counter > 30000\n"); */
loop_counter = 0;
}
- if (watchdog_thread != 0 && eventloop_thread != current) {
- return 1;
- }
-
if (run_timer_flag) {
/*
DUMP1("timer interrupt");
@@ -496,23 +640,11 @@ lib_eventloop_core(check_root, check_var)
break; /* switch to other thread */
}
}
-
- DUMP1("check Root Widget");
- if (check_root && Tk_GetNumMainWindows() == 0) {
- return 1;
- }
}
- /* rb_thread_schedule(); */
- if (run_timer_flag) {
- run_timer_flag = 0;
- rb_trap_exec();
- } else {
- DUMP1("thread scheduling");
- if (is_ruby_native_thread()) {
- rb_thread_schedule();
- }
- }
+ DUMP1("trap check & thread scheduling");
+ if (update_flag == 0) CHECK_INTS;
+
}
return 1;
}
@@ -523,7 +655,7 @@ lib_eventloop_main(check_rootwidget)
{
check_rootwidget_flag = RTEST(check_rootwidget);
- if (lib_eventloop_core(check_rootwidget_flag, (int *)NULL)) {
+ if (lib_eventloop_core(check_rootwidget_flag, 0, (int *)NULL)) {
return Qtrue;
} else {
return Qfalse;
@@ -614,8 +746,8 @@ lib_watchdog_core(check_rootwidget)
/* check other watchdog thread */
if (watchdog_thread != 0) {
- if (RTEST(rb_funcall(watchdog_thread, rb_intern("stop?"), 0))) {
- rb_funcall(watchdog_thread, rb_intern("kill"), 0);
+ if (RTEST(rb_funcall(watchdog_thread, ID_stop_p, 0))) {
+ rb_funcall(watchdog_thread, ID_kill, 0);
} else {
return Qnil;
}
@@ -626,7 +758,7 @@ lib_watchdog_core(check_rootwidget)
do {
if (eventloop_thread == 0
|| (loop_counter == prev_val
- && RTEST(rb_funcall(eventloop_thread, rb_intern("stop?"), 0))
+ && RTEST(rb_funcall(eventloop_thread, ID_stop_p, 0))
&& ++chance >= 3 )
) {
/* start new eventloop thread */
@@ -703,7 +835,7 @@ lib_do_one_event_core(argc, argv, self, is_ip)
VALUE self;
int is_ip;
{
- VALUE vflags;
+ volatile VALUE vflags;
int flags;
int found_event;
@@ -727,7 +859,8 @@ lib_do_one_event_core(argc, argv, self, is_ip)
}
}
- found_event = Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT);
+ /* found_event = Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT); */
+ found_event = Tcl_DoOneEvent(flags);
if (found_event) {
return Qtrue;
@@ -755,13 +888,97 @@ ip_do_one_event(argc, argv, self)
}
-/* Tcl command `ruby' */
+static void
+ip_set_exc_message(interp, exc)
+ Tcl_Interp *interp;
+ VALUE exc;
+{
+ char *buf;
+ Tcl_DString dstr;
+ volatile VALUE msg;
+ int thr_crit_bup;
+
+#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
+ volatile VALUE enc;
+ Tcl_Encoding encoding;
+#endif
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ msg = rb_funcall(exc, ID_message, 0, 0);
+
+#if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
+ enc = rb_ivar_get(exc, ID_at_enc);
+ if (NIL_P(enc)) {
+ enc = rb_ivar_get(msg, ID_at_enc);
+ }
+ if (NIL_P(enc)) {
+ encoding = (Tcl_Encoding)NULL;
+ } else if (TYPE(enc) == T_STRING) {
+ encoding = Tcl_GetEncoding(interp, RSTRING(enc)->ptr);
+ } else {
+ enc = rb_funcall(enc, ID_to_s, 0, 0);
+ encoding = Tcl_GetEncoding(interp, RSTRING(enc)->ptr);
+ }
+
+ /* to avoid a garbled error message dialog */
+ buf = ALLOC_N(char, (RSTRING(msg)->len)+1);
+ strncpy(buf, RSTRING(msg)->ptr, RSTRING(msg)->len);
+ buf[RSTRING(msg)->len] = 0;
+
+ Tcl_DStringInit(&dstr);
+ Tcl_DStringFree(&dstr);
+ Tcl_ExternalToUtfDString(encoding, buf, RSTRING(msg)->len, &dstr);
+
+ Tcl_AppendResult(interp, Tcl_DStringValue(&dstr), (char*)NULL);
+ DUMP2("error message:%s", Tcl_DStringValue(&dstr));
+ free(buf);
+
+#else /* TCL_VERSION <= 8.0 */
+ Tcl_AppendResult(interp, RSTRING(msg)->ptr, (char*)NULL);
+#endif
+
+ rb_thread_critical = thr_crit_bup;
+}
+
+static VALUE
+TkStringValue(obj)
+ VALUE obj;
+{
+ switch(TYPE(obj)) {
+ case T_STRING:
+ return obj;
+
+ case T_NIL:
+ return rb_str_new2("");
+
+ case T_TRUE:
+ return rb_str_new2("1");
+
+ case T_FALSE:
+ return rb_str_new2("0");
+
+ case T_ARRAY:
+ return rb_funcall(obj, ID_join, 1, rb_str_new2(" "));
+
+ default:
+ if (rb_respond_to(obj, ID_to_s)) {
+ return rb_funcall(obj, ID_to_s, 0, 0);
+ }
+ }
+
+ return rb_funcall(obj, ID_inspect, 0, 0);
+}
+
+/* Tcl command `ruby'|`ruby_eval' */
static VALUE
ip_ruby_eval_rescue(failed, einfo)
- VALUE *failed;
+ VALUE failed;
VALUE einfo;
{
- *failed = einfo;
+ DUMP1("call ip_ruby_eval_rescue");
+ RARRAY(failed)->ptr[0] = einfo;
return Qnil;
}
@@ -772,76 +989,265 @@ struct eval_body_arg {
static VALUE
ip_ruby_eval_body(arg)
- struct eval_body_arg *arg;
+ struct eval_body_arg *arg;
{
+ VALUE ret;
+ int status = 0;
+ int thr_crit_bup;
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ DUMP1("call ip_ruby_eval_body");
rb_trap_immediate = 0;
- return rb_rescue2(rb_eval_string, (VALUE)arg->string,
- ip_ruby_eval_rescue, (VALUE)&(arg->failed),
+
+#if 0
+ ret = rb_rescue2(rb_eval_string, (VALUE)arg->string,
+ ip_ruby_eval_rescue, arg->failed,
rb_eStandardError, rb_eScriptError, rb_eSystemExit,
(VALUE)0);
+#else
+
+ ret = rb_eval_string_protect(arg->string, &status);
+ if (status) {
+ char *errtype, *buf;
+ int errtype_len, len;
+ VALUE old_gc;
+
+ old_gc = rb_gc_disable();
+
+ switch(status) {
+ case TAG_RETURN:
+ errtype = "LocalJumpError: ";
+ errtype_len = strlen(errtype);
+ len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
+ buf = ALLOC_N(char, len + 1);
+ strncpy(buf, errtype, errtype_len);
+ strncpy(buf + errtype_len,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->ptr,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+ *(buf + len) = 0;
+
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackReturn, buf);
+ free(buf);
+ break;
+
+ case TAG_BREAK:
+ errtype = "LocalJumpError: ";
+ errtype_len = strlen(errtype);
+ len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
+ buf = ALLOC_N(char, len + 1);
+ strncpy(buf, errtype, errtype_len);
+ strncpy(buf + errtype_len,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->ptr,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+ *(buf + len) = 0;
+
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackBreak, buf);
+ free(buf);
+ break;
+
+ case TAG_NEXT:
+ errtype = "LocalJumpError: ";
+ errtype_len = strlen(errtype);
+ len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
+ buf = ALLOC_N(char, len + 1);
+ strncpy(buf, errtype, errtype_len);
+ strncpy(buf + errtype_len,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->ptr,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+ *(buf + len) = 0;
+
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackContinue,buf);
+ free(buf);
+ break;
+
+ case TAG_RETRY:
+ case TAG_REDO:
+ RARRAY(arg->failed)->ptr[0] = ruby_errinfo;
+ break;
+
+ case TAG_RAISE:
+ case TAG_FATAL:
+ RARRAY(arg->failed)->ptr[0] = ruby_errinfo;
+ break;
+
+ default:
+ buf = ALLOC_N(char, 256);
+ sprintf(buf, "unknown loncaljmp status %d", status);
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(rb_eException, buf);
+ free(buf);
+ break;
+ }
+
+ if (old_gc == Qfalse) rb_gc_enable();
+
+ ret = Qnil;
+ }
+#endif
+
+ rb_thread_critical = thr_crit_bup;
+
+ return ret;
}
static VALUE
ip_ruby_eval_ensure(trapflag)
- VALUE trapflag;
+ VALUE trapflag;
{
rb_trap_immediate = NUM2INT(trapflag);
return Qnil;
}
+
static int
#if TCL_MAJOR_VERSION >= 8
-ip_ruby(clientData, interp, argc, argv)
+ip_ruby_eval(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
Tcl_Obj *CONST argv[];
-#else
-ip_ruby(clientData, interp, argc, argv)
+#else /* TCL_MAJOR_VERSION < 8 */
+ip_ruby_eval(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char *argv[];
#endif
{
- VALUE res;
+ volatile VALUE res;
+ volatile VALUE exception = rb_ary_new2(1);
int old_trapflag;
- struct eval_body_arg arg;
- int dummy;
+ struct eval_body_arg *arg;
+ int thr_crit_bup;
/* ruby command has 1 arg. */
if (argc != 2) {
- rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)", argc);
+ rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
+ argc - 1);
}
+ /* allocate */
+ arg = ALLOC(struct eval_body_arg);
+
/* get C string from Tcl object */
#if TCL_MAJOR_VERSION >= 8
- arg.string = Tcl_GetStringFromObj(argv[1], &dummy);
-#else
- arg.string = argv[1];
+ {
+ char *str;
+ int len;
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ str = Tcl_GetStringFromObj(argv[1], &len);
+ arg->string = ALLOC_N(char, len + 1);
+ strncpy(arg->string, str, len);
+ arg->string[len] = 0;
+
+ rb_thread_critical = thr_crit_bup;
+
+ }
+#else /* TCL_MAJOR_VERSION < 8 */
+ arg->string = argv[1];
#endif
- arg.failed = 0;
+ /* arg.failed = 0; */
+ RARRAY(exception)->ptr[0] = Qnil;
+ arg->failed = exception;
/* evaluate the argument string by ruby */
- DUMP2("rb_eval_string(%s)", arg.string);
+ DUMP2("rb_eval_string(%s)", arg->string);
old_trapflag = rb_trap_immediate;
- res = rb_ensure(ip_ruby_eval_body, (VALUE)&arg,
+#ifdef HAVE_NATIVETHREAD
+ if (!is_ruby_native_thread()) {
+ rb_bug("cross-thread violation on ip_ruby_eval()");
+ }
+#endif
+ res = rb_ensure(ip_ruby_eval_body, (VALUE)arg,
ip_ruby_eval_ensure, INT2FIX(old_trapflag));
+#if TCL_MAJOR_VERSION >= 8
+ free(arg->string);
+#endif
+
+ free(arg);
+
/* status check */
- if (arg.failed) {
- VALUE eclass = rb_obj_class(arg.failed);
+ /* if (arg.failed) { */
+ if (!NIL_P(RARRAY(exception)->ptr[0])) {
+ VALUE eclass;
+ volatile VALUE backtrace;
+
DUMP1("(rb_eval_string result) failed");
+
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, StringValuePtr(arg.failed), (char*)NULL);
- if (eclass == eTkCallbackBreak) {
+
+ res = RARRAY(exception)->ptr[0];
+ eclass = rb_obj_class(res);
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ DUMP1("set backtrace");
+ backtrace = rb_ary_join(rb_funcall(res, ID_backtrace, 0, 0),
+ rb_str_new2("\n"));
+ StringValue(backtrace);
+ Tcl_AddErrorInfo(interp, RSTRING(backtrace)->ptr);
+
+ rb_thread_critical = thr_crit_bup;
+
+ if (eclass == eTkCallbackReturn) {
+ return TCL_RETURN;
+
+ } else if (eclass == eTkCallbackBreak) {
return TCL_BREAK;
+
} else if (eclass == eTkCallbackContinue) {
return TCL_CONTINUE;
+
} else if (eclass == rb_eSystemExit) {
- Tcl_Eval(interp, "destroy .");
- rb_raise(rb_eSystemExit, StringValuePtr(arg.failed));
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ /* Tcl_Eval(interp, "destroy ."); */
+ if (Tk_GetNumMainWindows() > 0) {
+ Tk_Window main_win = Tk_MainWindow(interp);
+ if (main_win != (Tk_Window)NULL) {
+ Tk_DestroyWindow(main_win);
+ }
+ }
+
+ /* StringValue(res); */
+ res = rb_funcall(res, ID_message, 0, 0);
+
+ Tcl_AppendResult(interp, RSTRING(res)->ptr, (char*)NULL);
+
+ rb_thread_critical = thr_crit_bup;
+
+ rb_raise(rb_eSystemExit, RSTRING(res)->ptr);
+
+ } else if (rb_obj_is_kind_of(res, eLocalJumpError)) {
+ VALUE reason = rb_ivar_get(res, ID_at_reason);
+
+ if (TYPE(reason) != T_SYMBOL) {
+ ip_set_exc_message(interp, res);
+ return TCL_ERROR;
+ }
+
+ if (SYM2ID(reason) == ID_return) {
+ return TCL_RETURN;
+
+ } else if (SYM2ID(reason) == ID_break) {
+ return TCL_BREAK;
+
+ } else if (SYM2ID(reason) == ID_next) {
+ return TCL_CONTINUE;
+
+ } else {
+ ip_set_exc_message(interp, res);
+ return TCL_ERROR;
+ }
} else {
+ ip_set_exc_message(interp, res);
return TCL_ERROR;
}
}
@@ -854,11 +1260,390 @@ ip_ruby(clientData, interp, argc, argv)
}
/* copy result to the tcl interpreter */
- DUMP2("(rb_eval_string result) %s", StringValuePtr(res));
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ res = TkStringValue(res);
+ DUMP2("(rb_eval_string result) %s", RSTRING(res)->ptr);
+ DUMP1("Tcl_AppendResult");
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, RSTRING(res)->ptr, (char *)NULL);
+
+ rb_thread_critical = thr_crit_bup;
+
+ return TCL_OK;
+}
+
+
+/* Tcl command `ruby_cmd' */
+struct cmd_body_arg {
+ VALUE receiver;
+ ID method;
+ VALUE args;
+ VALUE failed;
+};
+
+static VALUE
+ip_ruby_cmd_core(arg)
+ struct cmd_body_arg *arg;
+{
+ VALUE ret;
+
+ DUMP1("call ip_ruby_cmd_core");
+ ret = rb_apply(arg->receiver, arg->method, arg->args);
+ DUMP1("finish ip_ruby_cmd_core");
+
+ return ret;
+}
+
+static VALUE
+ip_ruby_cmd_rescue(failed, einfo)
+ VALUE failed;
+ VALUE einfo;
+{
+ DUMP1("call ip_ruby_cmd_rescue");
+ RARRAY(failed)->ptr[0] = einfo;
+ return Qnil;
+}
+
+static VALUE
+ip_ruby_cmd_body(arg)
+ struct cmd_body_arg *arg;
+{
+ VALUE ret;
+ int status = 0;
+ int thr_crit_bup;
+ VALUE old_gc;
+
+ volatile VALUE receiver = arg->receiver;
+ volatile VALUE args = arg->args;
+ volatile VALUE failed = arg->failed;
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ DUMP1("call ip_ruby_cmd_body");
+ rb_trap_immediate = 0;
+
+#if 0
+ ret = rb_rescue2(ip_ruby_cmd_core, (VALUE)arg,
+ ip_ruby_cmd_rescue, arg->failed,
+ rb_eStandardError, rb_eScriptError, rb_eSystemExit,
+ (VALUE)0);
+#else
+ ret = rb_protect(ip_ruby_cmd_core, (VALUE)arg, &status);
+
+ if (status) {
+ char *errtype, *buf;
+ int errtype_len, len;
+
+ old_gc = rb_gc_disable();
+
+ switch(status) {
+ case TAG_RETURN:
+ errtype = "LocalJumpError: ";
+ errtype_len = strlen(errtype);
+ len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
+ buf = ALLOC_N(char, len + 1);
+ strncpy(buf, errtype, errtype_len);
+ strncpy(buf + errtype_len,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->ptr,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+ *(buf + len) = 0;
+
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackReturn, buf);
+ free(buf);
+ break;
+
+ case TAG_BREAK:
+ errtype = "LocalJumpError: ";
+ errtype_len = strlen(errtype);
+ len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
+ buf = ALLOC_N(char, len + 1);
+ strncpy(buf, errtype, errtype_len);
+ strncpy(buf + errtype_len,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->ptr,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+ *(buf + len) = 0;
+
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackBreak, buf);
+ free(buf);
+ break;
+
+ case TAG_NEXT:
+ errtype = "LocalJumpError: ";
+ errtype_len = strlen(errtype);
+ len = errtype_len + RSTRING(rb_obj_as_string(ruby_errinfo))->len;
+ buf = ALLOC_N(char, len + 1);
+ strncpy(buf, errtype, errtype_len);
+ strncpy(buf + errtype_len,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->ptr,
+ RSTRING(rb_obj_as_string(ruby_errinfo))->len);
+ *(buf + len) = 0;
+
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(eTkCallbackContinue,buf);
+ free(buf);
+ break;
+
+ case TAG_RETRY:
+ case TAG_REDO:
+ RARRAY(arg->failed)->ptr[0] = ruby_errinfo;
+ break;
+
+ case TAG_RAISE:
+ case TAG_FATAL:
+ RARRAY(arg->failed)->ptr[0] = ruby_errinfo;
+ break;
+
+ default:
+ buf = ALLOC_N(char, 256);
+ rb_warn(buf, "unknown loncaljmp status %d", status);
+ RARRAY(arg->failed)->ptr[0] = rb_exc_new2(rb_eException, buf);
+ free(buf);
+ break;
+ }
+
+ if (old_gc == Qfalse) rb_gc_enable();
+
+ ret = Qnil;
+ }
+#endif
+
+ rb_thread_critical = thr_crit_bup;
+ DUMP1("finish ip_ruby_cmd_body");
+
+ return ret;
+}
+
+static VALUE
+ip_ruby_cmd_ensure(trapflag)
+ VALUE trapflag;
+{
+ rb_trap_immediate = NUM2INT(trapflag);
+ return Qnil;
+}
+
+/* ruby_cmd receiver method arg ... */
+static int
+#if TCL_MAJOR_VERSION >= 8
+ip_ruby_cmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ Tcl_Obj *CONST argv[];
+#else /* TCL_MAJOR_VERSION < 8 */
+ip_ruby_cmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ char *argv[];
+#endif
+{
+ volatile VALUE res;
+ volatile VALUE receiver;
+ volatile ID method;
+ volatile VALUE args = rb_ary_new2(argc - 2);
+ volatile VALUE exception = rb_ary_new2(1);
+ char *str;
+ int i;
+ int len;
+ int old_trapflag;
+ struct cmd_body_arg *arg;
+ int thr_crit_bup;
+ VALUE old_gc;
+
+ if (argc < 3) {
+ rb_raise(rb_eArgError, "too few arguments");
+ }
+
+ /* allocate */
+ arg = ALLOC(struct cmd_body_arg);
+
+ /* get arguments from Tcl objects */
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+ old_gc = rb_gc_disable();
+
+ /* get receiver */
+#if TCL_MAJOR_VERSION >= 8
+ str = Tcl_GetStringFromObj(argv[1], &len);
+#else /* TCL_MAJOR_VERSION < 8 */
+ str = argv[1];
+#endif
+ DUMP2("receiver:%s",str);
+ if (str[0] == ':' || ('A' <= str[0] && str[0] <= 'Z')) {
+ /* class | module | constant */
+ receiver = rb_const_get(rb_cObject, rb_intern(str));
+ } else if (str[0] == '$') {
+ /* global variable */
+ receiver = rb_gv_get(str);
+ } else {
+ /* global variable omitted '$' */
+ char *buf;
+
+ len = strlen(str);
+ buf = ALLOC_N(char, len + 2);
+ buf[0] = '$';
+ strncpy(buf + 1, str, len);
+ buf[len + 1] = 0;
+ receiver = rb_gv_get(buf);
+ free(buf);
+ }
+ if (NIL_P(receiver)) {
+ rb_raise(rb_eArgError, "unknown class/module/global-variable '%s'",
+ str);
+ }
+
+ /* get metrhod */
+#if TCL_MAJOR_VERSION >= 8
+ str = Tcl_GetStringFromObj(argv[2], &len);
+#else /* TCL_MAJOR_VERSION < 8 */
+ str = argv[2];
+#endif
+ method = rb_intern(str);
+
+ /* get args */
+ RARRAY(args)->len = 0;
+ for(i = 3; i < argc; i++) {
+#if TCL_MAJOR_VERSION >= 8
+ str = Tcl_GetStringFromObj(argv[i], &len);
+ DUMP2("arg:%s",str);
+ RARRAY(args)->ptr[RARRAY(args)->len++] = rb_tainted_str_new(str, len);
+#else /* TCL_MAJOR_VERSION < 8 */
+ DUMP2("arg:%s",argv[i]);
+ RARRAY(args)->ptr[RARRAY(args)->len++] = rb_tainted_str_new2(argv[i]);
+#endif
+ }
+
+ if (old_gc == Qfalse) rb_gc_enable();
+ rb_thread_critical = thr_crit_bup;
+
+ RARRAY(exception)->ptr[0] = Qnil;
+
+ arg->receiver = receiver;
+ arg->method = method;
+ arg->args = args;
+ arg->failed = exception;
+
+ /* evaluate the argument string by ruby */
+ old_trapflag = rb_trap_immediate;
+#ifdef HAVE_NATIVETHREAD
+ if (!is_ruby_native_thread()) {
+ rb_bug("cross-thread violation on ip_ruby_cmd()");
+ }
+#endif
+
+ res = rb_ensure(ip_ruby_cmd_body, (VALUE)arg,
+ ip_ruby_cmd_ensure, INT2FIX(old_trapflag));
+
+ free(arg);
+
+ /* status check */
+ /* if (arg.failed) { */
+ if (!NIL_P(RARRAY(exception)->ptr[0])) {
+ VALUE eclass;
+ volatile VALUE backtrace;
+
+ DUMP1("(rb_eval_cmd result) failed");
+
+ Tcl_ResetResult(interp);
+
+ res = RARRAY(exception)->ptr[0];
+ eclass = rb_obj_class(res);
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ DUMP1("set backtrace");
+ backtrace = rb_ary_join(rb_funcall(res, ID_backtrace, 0, 0),
+ rb_str_new2("\n"));
+ StringValue(backtrace);
+ Tcl_AddErrorInfo(interp, RSTRING(backtrace)->ptr);
+
+ rb_thread_critical = thr_crit_bup;
+
+ if (eclass == eTkCallbackReturn) {
+ return TCL_RETURN;
+
+ } else if (eclass == eTkCallbackBreak) {
+ return TCL_BREAK;
+
+ } else if (eclass == eTkCallbackContinue) {
+ return TCL_CONTINUE;
+
+ } else if (eclass == rb_eSystemExit) {
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ /* Tcl_Eval(interp, "destroy ."); */
+ if (Tk_GetNumMainWindows() > 0) {
+ Tk_Window main_win = Tk_MainWindow(interp);
+ if (main_win != (Tk_Window)NULL) {
+ Tk_DestroyWindow(main_win);
+ }
+ }
+
+ /* StringValue(res); */
+ res = rb_funcall(res, ID_message, 0, 0);
+
+ Tcl_AppendResult(interp, RSTRING(res)->ptr, (char*)NULL);
+
+ rb_thread_critical = thr_crit_bup;
+
+ rb_raise(rb_eSystemExit, RSTRING(res)->ptr);
+ } else if (rb_obj_is_kind_of(res, eLocalJumpError)) {
+ VALUE reason = rb_ivar_get(res, ID_at_reason);
+
+ if (TYPE(reason) != T_SYMBOL) {
+ ip_set_exc_message(interp, res);
+ return TCL_ERROR;
+ }
+
+ if (SYM2ID(reason) == ID_return) {
+ return TCL_RETURN;
+
+ } else if (SYM2ID(reason) == ID_break) {
+ return TCL_BREAK;
+
+ } else if (SYM2ID(reason) == ID_next) {
+ return TCL_CONTINUE;
+
+ } else {
+ ip_set_exc_message(interp, res);
+ return TCL_ERROR;
+ }
+ } else {
+ ip_set_exc_message(interp, res);
+ return TCL_ERROR;
+ }
+ }
+
+ /* result must be string or nil */
+ if (NIL_P(res)) {
+ DUMP1("(rb_eval_cmd result) nil");
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+
+ /* copy result to the tcl interpreter */
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+
+ old_gc = rb_gc_disable();
+
+ res = TkStringValue(res);
+
+ if (old_gc == Qfalse) rb_gc_enable();
+ DUMP2("(rb_eval_cmd result) '%s'", RSTRING(res)->ptr);
DUMP1("Tcl_AppendResult");
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, StringValuePtr(res), (char *)NULL);
+ Tcl_AppendResult(interp, RSTRING(res)->ptr, (char *)NULL);
+
+ rb_thread_critical = thr_crit_bup;
+ DUMP1("end of ip_ruby_cmd");
return TCL_OK;
}
@@ -866,8 +1651,236 @@ ip_ruby(clientData, interp, argc, argv)
/**************************/
/* based on tclEvent.c */
/**************************/
-static char *VwaitVarProc _((ClientData, Tcl_Interp *, CONST84 char *,
- CONST84 char *, int));
+
+#if 0 /*
+ Disable the following "update" and "thread_update". Bcause,
+ they don't work in a callback-proc. After calling update in
+ a callback-proc, the callback proc never be worked.
+ If the problem will be fixed in the future, may enable the
+ functions.
+ */
+/*********************/
+/* replace of update */
+/*********************/
+#if TCL_MAJOR_VERSION >= 8
+static int ip_rbUpdateObjCmd _((ClientData, Tcl_Interp *, int,
+ Tcl_Obj *CONST []));
+static int
+ip_rbUpdateObjCmd(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+#else /* TCL_MAJOR_VERSION < 8 */
+static int ip_rbUpdateCommand _((ClientData, Tcl_Interp *, int, char *[]));
+static int
+ip_rbUpdateCommand(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ char *objv[];
+#endif
+{
+ int optionIndex;
+ int ret, done;
+ int flags = 0;
+ static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
+ enum updateOptions {REGEXP_IDLETASKS};
+ char *nameString;
+ int dummy;
+
+ DUMP1("Ruby's 'update' is called");
+ if (objc == 1) {
+ flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
+
+ } else if (objc == 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions,
+ "option", 0, &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum updateOptions) optionIndex) {
+ case REGEXP_IDLETASKS: {
+ flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+ break;
+ }
+ default: {
+ Tcl_Panic("ip_rbUpdateObjCmd: bad option index to UpdateOptions");
+ }
+ }
+ } else {
+#ifdef Tcl_WrongNumArgs
+ Tcl_WrongNumArgs(interp, 1, objv, "[ idletasks ]");
+#else
+# if TCL_MAJOR_VERSION >= 8
+ Tcl_AppendResult(interp, "wrong number of arguments: should be \"",
+ Tcl_GetStringFromObj(objv[0], &dummy),
+ " [ idletasks ]\"",
+ (char *) NULL);
+# else /* TCL_MAJOR_VERSION < 8 */
+ Tcl_AppendResult(interp, "wrong number of arguments: should be \"",
+ objv[0], " [ idletasks ]\"", (char *) NULL);
+# endif
+#endif
+ return TCL_ERROR;
+ }
+
+ /* call eventloop */
+#if 1
+ ret = lib_eventloop_core(0, flags, (int *)NULL); /* ignore result */
+#else
+ Tcl_UpdateObjCmd(clientData, interp, objc, objv);
+#endif
+
+ /*
+ * Must clear the interpreter's result because event handlers could
+ * have executed commands.
+ */
+
+ DUMP2("last result '%s'", Tcl_GetStringResult(interp));
+ Tcl_ResetResult(interp);
+ DUMP1("finish Ruby's 'update'");
+ return TCL_OK;
+}
+
+
+/**********************/
+/* update with thread */
+/**********************/
+struct th_update_param {
+ VALUE thread;
+ int done;
+};
+
+static void rb_threadUpdateProc _((ClientData));
+static void
+rb_threadUpdateProc(clientData)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+{
+ struct th_update_param *param = (struct th_update_param *) clientData;
+
+ DUMP1("threadUpdateProc is called");
+ param->done = 1;
+ rb_thread_run(param->thread);
+
+ return;
+}
+
+#if TCL_MAJOR_VERSION >= 8
+static int ip_rb_threadUpdateObjCmd _((ClientData, Tcl_Interp *, int,
+ Tcl_Obj *CONST []));
+static int
+ip_rb_threadUpdateObjCmd(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+#else /* TCL_MAJOR_VERSION < 8 */
+static int ip_rb_threadUpdateCommand _((ClientData, Tcl_Interp *, int,
+ char *[]));
+static int
+ip_rb_threadUpdateCommand(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ char *objv[];
+#endif
+{
+ int optionIndex;
+ int ret, done;
+ int flags = 0;
+ int dummy;
+ struct th_update_param *param;
+ static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
+ enum updateOptions {REGEXP_IDLETASKS};
+ volatile VALUE current_thread = rb_thread_current();
+
+ DUMP1("Ruby's 'thread_update' is called");
+
+ if (rb_thread_alone() || eventloop_thread == current_thread) {
+#define USE_TCL_UPDATE 0
+#if TCL_MAJOR_VERSION >= 8
+# if USE_TCL_UPDATE
+ DUMP1("call Tcl_UpdateObjCmd");
+ return Tcl_UpdateObjCmd(clientData, interp, objc, objv);
+# else
+ DUMP1("call ip_rbUpdateObjCmd");
+ return ip_rbUpdateObjCmd(clientData, interp, objc, objv);
+# endif
+#else /* TCL_MAJOR_VERSION < 8 */
+# if USE_TCL_UPDATE
+ DUMP1("call ip_rbUpdateCommand");
+ return Tcl_UpdateCommand(clientData, interp, objc, objv);
+# else
+ DUMP1("call ip_rbUpdateCommand");
+ return ip_rbUpdateCommand(clientData, interp, objc, objv);
+# endif
+#endif
+ }
+
+ DUMP1("start Ruby's 'thread_update' body");
+
+ if (objc == 1) {
+ flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
+
+ } else if (objc == 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions,
+ "option", 0, &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum updateOptions) optionIndex) {
+ case REGEXP_IDLETASKS: {
+ flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+ break;
+ }
+ default: {
+ Tcl_Panic("ip_rb_threadUpdateObjCmd: bad option index to UpdateOptions");
+ }
+ }
+ } else {
+#ifdef Tcl_WrongNumArgs
+ Tcl_WrongNumArgs(interp, 1, objv, "[ idletasks ]");
+#else
+# if TCL_MAJOR_VERSION >= 8
+ Tcl_AppendResult(interp, "wrong number of arguments: should be \"",
+ Tcl_GetStringFromObj(objv[0], &dummy),
+ " [ idletasks ]\"",
+ (char *) NULL);
+# else /* TCL_MAJOR_VERSION < 8 */
+ Tcl_AppendResult(interp, "wrong number of arguments: should be \"",
+ objv[0], " [ idletasks ]\"", (char *) NULL);
+# endif
+#endif
+ return TCL_ERROR;
+ }
+
+ DUMP1("pass argument check");
+
+ param = (struct th_update_param *)Tcl_Alloc(sizeof(struct th_update_param));
+ param->thread = current_thread;
+ param->done = 0;
+
+ DUMP1("set idle proc");
+ Tcl_DoWhenIdle(rb_threadUpdateProc, (ClientData) param);
+
+ while(!param->done) {
+ DUMP1("wait for complete idle proc");
+ rb_thread_stop();
+ }
+
+ Tcl_Free((char *)param);
+
+ DUMP1("finish Ruby's 'thread_update'");
+ return TCL_OK;
+}
+#endif /* update and thread_update don't work internal callback proc */
+
+
+/***************************/
+/* replace of vwait/tkwait */
+/***************************/
+#if TCL_MAJOR_VERSION >= 8
+static char *VwaitVarProc _((ClientData, Tcl_Interp *,
+ CONST84 char *,CONST84 char *, int));
static char *
VwaitVarProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Pointer to integer to set to 1. */
@@ -875,6 +1888,16 @@ VwaitVarProc(clientData, interp, name1, name2, flags)
CONST84 char *name1; /* Name of variable. */
CONST84 char *name2; /* Second part of variable name. */
int flags; /* Information about what happened. */
+#else /* TCL_MAJOR_VERSION < 8 */
+static char *VwaitVarProc _((ClientData, Tcl_Interp *, char *, char *, int));
+static char *
+VwaitVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Name of variable. */
+ char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+#endif
{
int *donePtr = (int *) clientData;
@@ -891,7 +1914,7 @@ ip_rbVwaitObjCmd(clientData, interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
static int ip_rbVwaitCommand _((ClientData, Tcl_Interp *, int, char *[]));
static int
ip_rbVwaitCommand(clientData, interp, objc, objv)
@@ -901,44 +1924,71 @@ ip_rbVwaitCommand(clientData, interp, objc, objv)
char *objv[];
#endif
{
- int done, foundEvent;
+ int ret, done, foundEvent;
char *nameString;
int dummy;
+ int thr_crit_bup;
DUMP1("Ruby's 'vwait' is called");
if (objc != 2) {
#ifdef Tcl_WrongNumArgs
Tcl_WrongNumArgs(interp, 1, objv, "name");
#else
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
#if TCL_MAJOR_VERSION >= 8
/* nameString = Tcl_GetString(objv[0]); */
nameString = Tcl_GetStringFromObj(objv[0], &dummy);
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
nameString = objv[0];
#endif
- Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tcl_AppendResult(interp, "wrong number of arguments: should be \"",
nameString, " name\"", (char *) NULL);
+
+ rb_thread_critical = thr_crit_bup;
#endif
return TCL_ERROR;
}
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
#if TCL_MAJOR_VERSION >= 8
/* nameString = Tcl_GetString(objv[1]); */
nameString = Tcl_GetStringFromObj(objv[1], &dummy);
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
nameString = objv[1];
#endif
+ /*
if (Tcl_TraceVar(interp, nameString,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, (ClientData) &done) != TCL_OK) {
return TCL_ERROR;
- };
+ }
+ */
+ ret = Tcl_TraceVar(interp, nameString,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ VwaitVarProc, (ClientData) &done);
+
+ rb_thread_critical = thr_crit_bup;
+
+ if (ret != TCL_OK) {
+ return TCL_ERROR;
+ }
done = 0;
- foundEvent = lib_eventloop_core(/* not check root-widget */0, &done);
+ foundEvent = lib_eventloop_core(/* not check root-widget */0, 0, &done);
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
Tcl_UntraceVar(interp, nameString,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, (ClientData) &done);
+ rb_thread_critical = thr_crit_bup;
+
/*
* Clear out the interpreter's result, since it may have been set
* by event handlers.
@@ -946,8 +1996,14 @@ ip_rbVwaitCommand(clientData, interp, objc, objv)
Tcl_ResetResult(interp);
if (!foundEvent) {
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
"\": would wait forever", (char *) NULL);
+
+ rb_thread_critical = thr_crit_bup;
+
return TCL_ERROR;
}
return TCL_OK;
@@ -957,8 +2013,9 @@ ip_rbVwaitCommand(clientData, interp, objc, objv)
/**************************/
/* based on tkCmd.c */
/**************************/
-static char *WaitVariableProc _((ClientData, Tcl_Interp *, CONST84 char *,
- CONST84 char *, int));
+#if TCL_MAJOR_VERSION >= 8
+static char *WaitVariableProc _((ClientData, Tcl_Interp *,
+ CONST84 char *,CONST84 char *, int));
static char *
WaitVariableProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Pointer to integer to set to 1. */
@@ -966,6 +2023,17 @@ WaitVariableProc(clientData, interp, name1, name2, flags)
CONST84 char *name1; /* Name of variable. */
CONST84 char *name2; /* Second part of variable name. */
int flags; /* Information about what happened. */
+#else /* TCL_MAJOR_VERSION < 8 */
+static char *WaitVariableProc _((ClientData, Tcl_Interp *,
+ char *, char *, int));
+static char *
+WaitVariableProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Name of variable. */
+ char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+#endif
{
int *donePtr = (int *) clientData;
@@ -1011,7 +2079,7 @@ ip_rbTkWaitObjCmd(clientData, interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
static int ip_rbTkWaitCommand _((ClientData, Tcl_Interp *, int, char *[]));
static int
ip_rbTkWaitCommand(clientData, interp, objc, objv)
@@ -1027,7 +2095,8 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
(char *) NULL };
enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW };
char *nameString;
- int dummy;
+ int ret, dummy;
+ int thr_crit_bup;
DUMP1("Ruby's 'tkwait' is called");
@@ -1035,27 +2104,46 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
#ifdef Tcl_WrongNumArgs
Tcl_WrongNumArgs(interp, 1, objv, "variable|visibility|window name");
#else
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
#if TCL_MAJOR_VERSION >= 8
- Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tcl_AppendResult(interp, "wrong number of arguments: should be \"",
Tcl_GetStringFromObj(objv[0], &dummy),
" variable|visibility|window name\"",
(char *) NULL);
-#else
- Tcl_AppendResult(interp, "wrong # args: should be \"",
+#else /* TCL_MAJOR_VERSION < 8 */
+ Tcl_AppendResult(interp, "wrong number of arguments: should be \"",
objv[0], " variable|visibility|window name\"",
(char *) NULL);
#endif
+
+ rb_thread_critical = thr_crit_bup;
#endif
return TCL_ERROR;
}
#if TCL_MAJOR_VERSION >= 8
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ /*
if (Tcl_GetIndexFromObj(interp, objv[1],
(CONST84 char **)optionStrings,
"option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
-#else
+ */
+ ret = Tcl_GetIndexFromObj(interp, objv[1],
+ (CONST84 char **)optionStrings,
+ "option", 0, &index);
+
+ rb_thread_critical = thr_crit_bup;
+
+ if (ret != TCL_OK) {
+ return TCL_ERROR;
+ }
+#else /* TCL_MAJOR_VERSION < 8 */
{
int c = objv[1][0];
size_t length = strlen(objv[1]);
@@ -1077,69 +2165,122 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
}
#endif
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
#if TCL_MAJOR_VERSION >= 8
/* nameString = Tcl_GetString(objv[2]); */
nameString = Tcl_GetStringFromObj(objv[2], &dummy);
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
nameString = objv[2];
#endif
+ rb_thread_critical = thr_crit_bup;
+
switch ((enum options) index) {
case TKWAIT_VARIABLE: {
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+ /*
if (Tcl_TraceVar(interp, nameString,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
WaitVariableProc, (ClientData) &done) != TCL_OK) {
return TCL_ERROR;
}
+ */
+ ret = Tcl_TraceVar(interp, nameString,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ WaitVariableProc, (ClientData) &done);
+
+ rb_thread_critical = thr_crit_bup;
+
+ if (ret != TCL_OK) {
+ return TCL_ERROR;
+ }
done = 0;
- lib_eventloop_core(check_rootwidget_flag, &done);
+ lib_eventloop_core(check_rootwidget_flag, 0, &done);
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
Tcl_UntraceVar(interp, nameString,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
WaitVariableProc, (ClientData) &done);
+
+ rb_thread_critical = thr_crit_bup;
+
break;
}
case TKWAIT_VISIBILITY: {
Tk_Window window;
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
window = Tk_NameToWindow(interp, nameString, tkwin);
if (window == NULL) {
+ rb_thread_critical = thr_crit_bup;
return TCL_ERROR;
}
+
Tk_CreateEventHandler(window,
VisibilityChangeMask|StructureNotifyMask,
WaitVisibilityProc, (ClientData) &done);
+
+ rb_thread_critical = thr_crit_bup;
+
done = 0;
- lib_eventloop_core(check_rootwidget_flag, &done);
+ lib_eventloop_core(check_rootwidget_flag, 0, &done);
if (done != 1) {
/*
* Note that we do not delete the event handler because it
* was deleted automatically when the window was destroyed.
*/
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "window \"", nameString,
"\" was deleted before its visibility changed",
(char *) NULL);
+
+ rb_thread_critical = thr_crit_bup;
+
return TCL_ERROR;
}
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
Tk_DeleteEventHandler(window,
VisibilityChangeMask|StructureNotifyMask,
WaitVisibilityProc, (ClientData) &done);
+
+ rb_thread_critical = thr_crit_bup;
+
break;
}
case TKWAIT_WINDOW: {
Tk_Window window;
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
window = Tk_NameToWindow(interp, nameString, tkwin);
if (window == NULL) {
+ rb_thread_critical = thr_crit_bup;
return TCL_ERROR;
}
+
Tk_CreateEventHandler(window, StructureNotifyMask,
WaitWindowProc, (ClientData) &done);
+
+ rb_thread_critical = thr_crit_bup;
+
done = 0;
- lib_eventloop_core(check_rootwidget_flag, &done);
+ lib_eventloop_core(check_rootwidget_flag, 0, &done);
/*
* Note: there's no need to delete the event handler. It was
* deleted automatically when the window was destroyed.
@@ -1165,8 +2306,9 @@ struct th_vwait_param {
int done;
};
-static char *rb_threadVwaitProc _((ClientData, Tcl_Interp *, CONST84 char *,
- CONST84 char *, int));
+#if TCL_MAJOR_VERSION >= 8
+static char *rb_threadVwaitProc _((ClientData, Tcl_Interp *,
+ CONST84 char *,CONST84 char *, int));
static char *
rb_threadVwaitProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Pointer to integer to set to 1. */
@@ -1174,6 +2316,17 @@ rb_threadVwaitProc(clientData, interp, name1, name2, flags)
CONST84 char *name1; /* Name of variable. */
CONST84 char *name2; /* Second part of variable name. */
int flags; /* Information about what happened. */
+#else /* TCL_MAJOR_VERSION < 8 */
+static char *rb_threadVwaitProc _((ClientData, Tcl_Interp *,
+ char *, char *, int));
+static char *
+rb_threadVwaitProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Name of variable. */
+ char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+#endif
{
struct th_vwait_param *param = (struct th_vwait_param *) clientData;
@@ -1197,6 +2350,7 @@ rb_threadWaitVisibilityProc(clientData, eventPtr)
if (eventPtr->type == DestroyNotify) {
param->done = 2;
}
+ rb_thread_run(param->thread);
}
static void rb_threadWaitWindowProc _((ClientData, XEvent *));
@@ -1210,6 +2364,7 @@ rb_threadWaitWindowProc(clientData, eventPtr)
if (eventPtr->type == DestroyNotify) {
param->done = 1;
}
+ rb_thread_run(param->thread);
}
#if TCL_MAJOR_VERSION >= 8
@@ -1221,7 +2376,7 @@ ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
static int ip_rb_threadVwaitCommand _((ClientData, Tcl_Interp *, int,
char *[]));
static int
@@ -1234,15 +2389,17 @@ ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
{
struct th_vwait_param *param;
char *nameString;
- int dummy;
+ int ret, dummy;
+ int thr_crit_bup;
+ volatile VALUE current_thread = rb_thread_current();
DUMP1("Ruby's 'thread_vwait' is called");
- if (eventloop_thread == rb_thread_current()) {
+ if (rb_thread_alone() || eventloop_thread == current_thread) {
#if TCL_MAJOR_VERSION >= 8
DUMP1("call ip_rbVwaitObjCmd");
return ip_rbVwaitObjCmd(clientData, interp, objc, objv);
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("call ip_rbVwaitCommand");
return ip_rbVwaitCommand(clientData, interp, objc, objv);
#endif
@@ -1252,44 +2409,69 @@ ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
#ifdef Tcl_WrongNumArgs
Tcl_WrongNumArgs(interp, 1, objv, "name");
#else
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
#if TCL_MAJOR_VERSION >= 8
/* nameString = Tcl_GetString(objv[0]); */
nameString = Tcl_GetStringFromObj(objv[0], &dummy);
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
nameString = objv[0];
#endif
- Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tcl_AppendResult(interp, "wrong number of arguments: should be \"",
nameString, " name\"", (char *) NULL);
+
+ rb_thread_critical = thr_crit_bup;
#endif
return TCL_ERROR;
}
#if TCL_MAJOR_VERSION >= 8
/* nameString = Tcl_GetString(objv[1]); */
nameString = Tcl_GetStringFromObj(objv[1], &dummy);
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
nameString = objv[1];
#endif
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
param = (struct th_vwait_param *)Tcl_Alloc(sizeof(struct th_vwait_param));
- param->thread = rb_thread_current();
+ param->thread = current_thread;
param->done = 0;
+ /*
if (Tcl_TraceVar(interp, nameString,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
rb_threadVwaitProc, (ClientData) param) != TCL_OK) {
return TCL_ERROR;
- };
+ }
+ */
+ ret = Tcl_TraceVar(interp, nameString,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ rb_threadVwaitProc, (ClientData) param);
+
+ rb_thread_critical = thr_crit_bup;
+
+ if (ret != TCL_OK) {
+ return TCL_ERROR;
+ }
- if (!param->done) {
+ /* if (!param->done) { */
+ while(!param->done) {
rb_thread_stop();
}
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
Tcl_UntraceVar(interp, nameString,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
rb_threadVwaitProc, (ClientData) param);
Tcl_Free((char *)param);
+ rb_thread_critical = thr_crit_bup;
+
return TCL_OK;
}
@@ -1302,7 +2484,7 @@ ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
static int ip_rb_threadTkWaitCommand _((ClientData, Tcl_Interp *, int,
char *[]));
static int
@@ -1320,15 +2502,17 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
(char *) NULL };
enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW };
char *nameString;
- int dummy;
+ int ret, dummy;
+ int thr_crit_bup;
+ volatile VALUE current_thread = rb_thread_current();
DUMP1("Ruby's 'thread_tkwait' is called");
- if (eventloop_thread == rb_thread_current()) {
+ if (rb_thread_alone() || eventloop_thread == current_thread) {
#if TCL_MAJOR_VERSION >= 8
DUMP1("call ip_rbTkWaitObjCmd");
return ip_rbTkWaitObjCmd(clientData, interp, objc, objv);
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("call rb_VwaitCommand");
return ip_rbTkWaitCommand(clientData, interp, objc, objv);
#endif
@@ -1338,27 +2522,45 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
#ifdef Tcl_WrongNumArgs
Tcl_WrongNumArgs(interp, 1, objv, "variable|visibility|window name");
#else
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
#if TCL_MAJOR_VERSION >= 8
- Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tcl_AppendResult(interp, "wrong number of arguments: should be \"",
Tcl_GetStringFromObj(objv[0], &dummy),
" variable|visibility|window name\"",
(char *) NULL);
-#else
- Tcl_AppendResult(interp, "wrong # args: should be \"",
+#else /* TCL_MAJOR_VERSION < 8 */
+ Tcl_AppendResult(interp, "wrong number of arguments: should be \"",
objv[0], " variable|visibility|window name\"",
(char *) NULL);
#endif
+
+ rb_thread_critical = thr_crit_bup;
#endif
return TCL_ERROR;
}
#if TCL_MAJOR_VERSION >= 8
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+ /*
if (Tcl_GetIndexFromObj(interp, objv[1],
(CONST84 char **)optionStrings,
"option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
-#else
+ */
+ ret = Tcl_GetIndexFromObj(interp, objv[1],
+ (CONST84 char **)optionStrings,
+ "option", 0, &index);
+
+ rb_thread_critical = thr_crit_bup;
+
+ if (ret != TCL_OK) {
+ return TCL_ERROR;
+ }
+#else /* TCL_MAJOR_VERSION < 8 */
{
int c = objv[1][0];
size_t length = strlen(objv[1]);
@@ -1380,85 +2582,139 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
}
#endif
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
#if TCL_MAJOR_VERSION >= 8
/* nameString = Tcl_GetString(objv[2]); */
nameString = Tcl_GetStringFromObj(objv[2], &dummy);
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
nameString = objv[2];
#endif
param = (struct th_vwait_param *)Tcl_Alloc(sizeof(struct th_vwait_param));
- param->thread = rb_thread_current();
+ param->thread = current_thread;
param->done = 0;
+ rb_thread_critical = thr_crit_bup;
+
switch ((enum options) index) {
case TKWAIT_VARIABLE: {
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+ /*
if (Tcl_TraceVar(interp, nameString,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
rb_threadVwaitProc, (ClientData) param) != TCL_OK) {
return TCL_ERROR;
- };
+ }
+ */
+ ret = Tcl_TraceVar(interp, nameString,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ rb_threadVwaitProc, (ClientData) param);
- if (!param->done) {
+ rb_thread_critical = thr_crit_bup;
+
+ if (ret != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* if (!param->done) { */
+ while(!param->done) {
rb_thread_stop();
}
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
Tcl_UntraceVar(interp, nameString,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
rb_threadVwaitProc, (ClientData) param);
+
+ rb_thread_critical = thr_crit_bup;
+
break;
}
case TKWAIT_VISIBILITY: {
Tk_Window window;
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
window = Tk_NameToWindow(interp, nameString, tkwin);
if (window == NULL) {
+ rb_thread_critical = thr_crit_bup;
return TCL_ERROR;
}
+
Tk_CreateEventHandler(window,
VisibilityChangeMask|StructureNotifyMask,
rb_threadWaitVisibilityProc, (ClientData) param);
- if (!param->done) {
+
+ rb_thread_critical = thr_crit_bup;
+
+ /* if (!param->done) { */
+ while(!param->done) {
rb_thread_stop();
}
- if (param->done != 1) {
- /*
- * Note that we do not delete the event handler because it
- * was deleted automatically when the window was destroyed.
- */
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ Tk_DeleteEventHandler(window,
+ VisibilityChangeMask|StructureNotifyMask,
+ rb_threadWaitVisibilityProc, (ClientData) param);
+
+ if (param->done != 1) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "window \"", nameString,
"\" was deleted before its visibility changed",
(char *) NULL);
+
+ rb_thread_critical = thr_crit_bup;
+
return TCL_ERROR;
}
- Tk_DeleteEventHandler(window,
- VisibilityChangeMask|StructureNotifyMask,
- rb_threadWaitVisibilityProc, (ClientData) param);
+
+ rb_thread_critical = thr_crit_bup;
+
break;
}
case TKWAIT_WINDOW: {
Tk_Window window;
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
window = Tk_NameToWindow(interp, nameString, tkwin);
if (window == NULL) {
+ rb_thread_critical = thr_crit_bup;
return TCL_ERROR;
}
+
Tk_CreateEventHandler(window, StructureNotifyMask,
rb_threadWaitWindowProc, (ClientData) param);
- if (!param->done) {
+
+ rb_thread_critical = thr_crit_bup;
+
+ /* if (!param->done) { */
+ while(!param->done) {
rb_thread_stop();
}
- /*
- * Note: there's no need to delete the event handler. It was
- * deleted automatically when the window was destroyed.
- */
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ Tk_DeleteEventHandler(window, StructureNotifyMask,
+ rb_threadWaitWindowProc, (ClientData) param);
+
+ rb_thread_critical = thr_crit_bup;
+
break;
}
- }
+ } /* end of 'switch' statement */
Tcl_Free((char *)param);
@@ -1499,16 +2755,48 @@ ip_thread_tkwait(self, mode, target)
/* destroy interpreter */
+VALUE del_root(ip)
+ Tcl_Interp *ip;
+{
+ Tcl_Preserve(ip);
+ Tk_DestroyWindow(Tk_MainWindow(ip));
+ Tcl_Release(ip);
+ return Qnil;
+}
+
static void
ip_free(ptr)
struct tcltkip *ptr;
{
- DUMP1("Tcl_DeleteInterp");
+ int try = 3;
+ Tcl_CmdInfo info;
+ int thr_crit_bup;
+
+ DUMP1("free Tcl Interp");
if (ptr) {
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ if (!Tcl_InterpDeleted(ptr->ip)) {
+ Tcl_ResetResult(ptr->ip);
+ Tcl_Preserve(ptr->ip);
+ if (Tcl_GetCommandInfo(ptr->ip, finalize_hook_name, &info)) {
+ DUMP2("call finalize hook proc '%s'", finalize_hook_name);
+ Tcl_Eval(ptr->ip, finalize_hook_name);
+ }
+ for(; try > 0; try--) {
+ if (!Tk_GetNumMainWindows()) break;
+ rb_protect(del_root, (VALUE)(ptr->ip), 0);
+ }
+ Tcl_Release(ptr->ip);
+ Tcl_DeleteInterp(ptr->ip);
+ }
Tcl_Release((ClientData)ptr->ip);
- Tcl_DeleteInterp(ptr->ip);
free(ptr);
+
+ rb_thread_critical = thr_crit_bup;
}
+ DUMP1("complete freeing Tcl Interp");
}
/* create and initialize interpreter */
@@ -1530,6 +2818,7 @@ ip_init(argc, argv, self)
VALUE argv0, opts;
int cnt;
int with_tk = 1;
+ Tk_Window mainWin;
/* create object */
Data_Get_Struct(self, struct tcltkip, ptr);
@@ -1546,7 +2835,11 @@ ip_init(argc, argv, self)
/* from Tcl_AppInit() */
DUMP1("Tcl_Init");
if (Tcl_Init(ptr->ip) == TCL_ERROR) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
/* set variables */
@@ -1554,7 +2847,7 @@ ip_init(argc, argv, self)
switch(cnt) {
case 2:
/* options */
- if (opts == Qnil || opts == Qfalse) {
+ if (NIL_P(opts) || opts == Qfalse) {
/* without Tk */
with_tk = 0;
} else {
@@ -1562,7 +2855,7 @@ ip_init(argc, argv, self)
}
case 1:
/* argv0 */
- if (argv0 != Qnil) {
+ if (!NIL_P(argv0)) {
Tcl_SetVar(ptr->ip, "argv0", StringValuePtr(argv0), 0);
}
case 0:
@@ -1574,70 +2867,119 @@ ip_init(argc, argv, self)
if (with_tk) {
DUMP1("Tk_Init");
if (Tk_Init(ptr->ip) == TCL_ERROR) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
DUMP1("Tcl_StaticPackage(\"Tk\")");
#if TCL_MAJOR_VERSION >= 8
Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, Tk_SafeInit);
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init,
(Tcl_PackageInitProc *) NULL);
#endif
}
+ /* get main window */
+ mainWin = Tk_MainWindow(ptr->ip);
+
/* add ruby command to the interpreter */
#if TCL_MAJOR_VERSION >= 8
DUMP1("Tcl_CreateObjCommand(\"ruby\")");
- Tcl_CreateObjCommand(ptr->ip, "ruby", ip_ruby, (ClientData)NULL,
+ Tcl_CreateObjCommand(ptr->ip, "ruby", ip_ruby_eval, (ClientData)NULL,
(Tcl_CmdDeleteProc *)NULL);
-#else
+ DUMP1("Tcl_CreateObjCommand(\"ruby_eval\")");
+ Tcl_CreateObjCommand(ptr->ip, "ruby_eval", ip_ruby_eval, (ClientData)NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ DUMP1("Tcl_CreateObjCommand(\"ruby_cmd\")");
+ Tcl_CreateObjCommand(ptr->ip, "ruby_cmd", ip_ruby_cmd, (ClientData)NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("Tcl_CreateCommand(\"ruby\")");
- Tcl_CreateCommand(ptr->ip, "ruby", ip_ruby, (ClientData)NULL,
+ Tcl_CreateCommand(ptr->ip, "ruby", ip_ruby_eval, (ClientData)NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+ DUMP1("Tcl_CreateCommand(\"ruby_eval\")");
+ Tcl_CreateCommand(ptr->ip, "ruby_eval", ip_ruby_eval, (ClientData)NULL,
(Tcl_CmdDeleteProc *)NULL);
+ DUMP1("Tcl_CreateCommand(\"ruby_cmd\")");
+ Tcl_CreateCommand(ptr->ip, "ruby_cmd", ip_ruby_cmd, (ClientData)NULL,
+ (Tcl_CmdDeleteProc *)NULL);
+#endif
+
+#if 0 /*
+ Disable the following "update" and "thread_update". Bcause,
+ they don't work in a callback-proc. After calling update in
+ a callback-proc, the callback proc never be worked.
+ If the problem will be fixed in the future, may enable the
+ functions.
+ */
+ /* replace 'update' command */
+# if TCL_MAJOR_VERSION >= 8
+ DUMP1("Tcl_CreateObjCommand(\"update\")");
+ Tcl_CreateObjCommand(ptr->ip, "update", ip_rbUpdateObjCmd,
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+# else /* TCL_MAJOR_VERSION < 8 */
+ DUMP1("Tcl_CreateCommand(\"update\")");
+ Tcl_CreateCommand(ptr->ip, "update", ip_rbUpdateCommand,
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+# endif
+
+ /* add 'thread_update' command */
+# if TCL_MAJOR_VERSION >= 8
+ DUMP1("Tcl_CreateObjCommand(\"thread_update\")");
+ Tcl_CreateObjCommand(ptr->ip, "thread_update", ip_rb_threadUpdateObjCmd,
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+# else /* TCL_MAJOR_VERSION < 8 */
+ DUMP1("Tcl_CreateCommand(\"thread_update\")");
+ Tcl_CreateCommand(ptr->ip, "thread_update", ip_rb_threadUpdateCommand,
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+# endif
#endif
/* replace 'vwait' command */
#if TCL_MAJOR_VERSION >= 8
DUMP1("Tcl_CreateObjCommand(\"vwait\")");
Tcl_CreateObjCommand(ptr->ip, "vwait", ip_rbVwaitObjCmd,
- (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
-#else
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("Tcl_CreateCommand(\"vwait\")");
Tcl_CreateCommand(ptr->ip, "vwait", ip_rbVwaitCommand,
- (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
#endif
/* replace 'tkwait' command */
#if TCL_MAJOR_VERSION >= 8
DUMP1("Tcl_CreateObjCommand(\"tkwait\")");
Tcl_CreateObjCommand(ptr->ip, "tkwait", ip_rbTkWaitObjCmd,
- (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
-#else
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("Tcl_CreateCommand(\"tkwait\")");
Tcl_CreateCommand(ptr->ip, "tkwait", ip_rbTkWaitCommand,
- (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
#endif
/* add 'thread_vwait' command */
#if TCL_MAJOR_VERSION >= 8
DUMP1("Tcl_CreateObjCommand(\"thread_vwait\")");
Tcl_CreateObjCommand(ptr->ip, "thread_vwait", ip_rb_threadVwaitObjCmd,
- (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
-#else
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("Tcl_CreateCommand(\"thread_vwait\")");
Tcl_CreateCommand(ptr->ip, "thread_vwait", ip_rb_threadVwaitCommand,
- (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
#endif
/* add 'thread_tkwait' command */
#if TCL_MAJOR_VERSION >= 8
DUMP1("Tcl_CreateObjCommand(\"thread_tkwait\")");
Tcl_CreateObjCommand(ptr->ip, "thread_tkwait", ip_rb_threadTkWaitObjCmd,
- (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
-#else
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
+#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("Tcl_CreateCommand(\"thread_tkwait\")");
Tcl_CreateCommand(ptr->ip, "thread_tkwait", ip_rb_threadTkWaitCommand,
- (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+ (ClientData)mainWin, (Tcl_CmdDeleteProc *)NULL);
#endif
return self;
@@ -1651,9 +2993,10 @@ ip_create_slave(argc, argv, self)
{
struct tcltkip *master = get_ip(self);
struct tcltkip *slave = ALLOC(struct tcltkip);
- VALUE name;
VALUE safemode;
+ VALUE name;
int safe;
+ int thr_crit_bup;
/* safe-mode check */
if (rb_scan_args(argc, argv, "11", &name, &safemode) == 1) {
@@ -1661,21 +3004,26 @@ ip_create_slave(argc, argv, self)
}
if (Tcl_IsSafe(master->ip) == 1) {
safe = 1;
- } else if (safemode == Qfalse || safemode == Qnil) {
+ } else if (safemode == Qfalse || NIL_P(safemode)) {
safe = 0;
rb_secure(4);
} else {
safe = 1;
}
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
/* create slave-ip */
- if ((slave->ip = Tcl_CreateSlave(master->ip, StringValuePtr(name), safe))
- == NULL) {
+ slave->ip = Tcl_CreateSlave(master->ip, StringValuePtr(name), safe);
+ if (slave->ip == NULL) {
rb_raise(rb_eRuntimeError, "fail to create the new slave interpreter");
}
Tcl_Preserve((ClientData)slave->ip);
slave->return_value = 0;
+ rb_thread_critical = thr_crit_bup;
+
return Data_Wrap_Struct(CLASS_OF(self), 0, ip_free, slave);
}
@@ -1687,7 +3035,11 @@ ip_make_safe(self)
struct tcltkip *ptr = get_ip(self);
if (Tcl_MakeSafe(ptr->ip) == TCL_ERROR) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
}
return self;
@@ -1734,30 +3086,124 @@ ip_is_deleted_p(self)
}
+static VALUE
+#ifdef HAVE_STDARG_PROTOTYPES
+create_ip_exc(VALUE interp, VALUE exc, const char *fmt, ...)
+#else
+create_ip_exc(interp, exc, fmt, va_alist)
+ VALUE interp:
+ VALUE exc;
+ const char *fmt;
+ va_dcl
+#endif
+{
+ va_list args;
+ char buf[BUFSIZ];
+ VALUE einfo;
+
+ va_init_list(args,fmt);
+ vsnprintf(buf, BUFSIZ, fmt, args);
+ buf[BUFSIZ - 1] = '\0';
+ va_end(args);
+ einfo = rb_exc_new2(exc, buf);
+ rb_ivar_set(einfo, ID_at_interp, interp);
+ Tcl_ResetResult(get_ip(interp)->ip);
+
+ return einfo;
+}
+
+static VALUE
+ip_get_result_string_obj(interp)
+ Tcl_Interp *interp;
+{
+#if TCL_MAJOR_VERSION >= 8
+ int len;
+ char *s;
+
+# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ s = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
+ return(rb_tainted_str_new(s, len));
+
+# else /* TCL_VERSION >= 8.1 */
+ volatile VALUE strval;
+ Tcl_Obj *retobj = Tcl_GetObjResult(interp);
+ int thr_crit_bup;
+
+ Tcl_IncrRefCount(retobj);
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ if (Tcl_GetCharLength(retobj) != Tcl_UniCharLen(Tcl_GetUnicode(retobj))) {
+ /* possibly binary string */
+ s = Tcl_GetByteArrayFromObj(retobj, &len);
+ strval = rb_tainted_str_new(s, len);
+ rb_ivar_set(strval, ID_at_enc, rb_str_new2("binary"));
+ } else {
+ /* possibly text string */
+ s = Tcl_GetStringFromObj(retobj, &len);
+ strval = rb_tainted_str_new(s, len);
+ }
+
+ rb_thread_critical = thr_crit_bup;
+
+ Tcl_DecrRefCount(retobj);
+
+ return(strval);
+
+# endif
+#else /* TCL_MAJOR_VERSION < 8 */
+ return(rb_tainted_str_new2(interp->result));
+#endif
+}
+
/* eval string in tcl by Tcl_Eval() */
static VALUE
-ip_eval_real(self, str)
+ip_eval_real(self, cmd_str, cmd_len)
VALUE self;
- VALUE str;
+ char *cmd_str;
+ int cmd_len;
{
char *s;
- char *buf; /* Tcl_Eval requires re-writable string region */
+ int len;
struct tcltkip *ptr = get_ip(self);
+ int thr_crit_bup;
+
+#if TCL_MAJOR_VERSION >= 8
+ /* call Tcl_EvalObj() */
+ {
+ Tcl_Obj *cmd;
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ cmd = Tcl_NewStringObj(cmd_str, cmd_len);
+ Tcl_IncrRefCount(cmd);
+ ptr->return_value = Tcl_EvalObj(ptr->ip, cmd);
+ /* ptr->return_value = Tcl_GlobalEvalObj(ptr->ip, cmd); */
+ Tcl_DecrRefCount(cmd);
+
+ rb_thread_critical = thr_crit_bup;
+ }
+#else /* TCL_MAJOR_VERSION < 8 */
+ DUMP2("Tcl_Eval(%s)", cmd_str);
+ ptr->return_value = Tcl_Eval(ptr->ip, cmd_str);
+ /* ptr->return_value = Tcl_GlobalEval(ptr->ip, cmd_str); */
+#endif
- /* call Tcl_Eval() */
- s = StringValuePtr(str);
- buf = ALLOCA_N(char, strlen(s)+1);
- strcpy(buf, s);
- DUMP2("Tcl_Eval(%s)", buf);
- ptr->return_value = Tcl_Eval(ptr->ip, buf);
if (ptr->return_value == TCL_ERROR) {
- rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#if TCL_MAJOR_VERSION >= 8
+ return create_ip_exc(self, rb_eRuntimeError,
+ "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
+ return create_ip_exc(self, rb_eRuntimeError,
+ "%s", ptr->ip->result);
+#endif
}
DUMP2("(TCL_Eval result) %d", ptr->return_value);
/* pass back the result (as string) */
- /* return(rb_str_new2(ptr->ip->result)); */
- return(rb_tainted_str_new2(ptr->ip->result));
+ return ip_get_result_string_obj(ptr->ip);
}
static VALUE
@@ -1770,7 +3216,7 @@ evq_safelevel_handler(arg, evq)
Data_Get_Struct(evq, struct eval_queue, q);
DUMP2("(safe-level handler) $SAFE = %d", q->safe_level);
rb_set_safe_level(q->safe_level);
- return ip_eval_real(q->obj, q->str);
+ return ip_eval_real(q->interp, q->str, q->len);
}
int eval_queue_handler _((Tcl_Event *, int));
@@ -1780,12 +3226,13 @@ eval_queue_handler(evPtr, flags)
int flags;
{
struct eval_queue *q = (struct eval_queue *)evPtr;
+ volatile VALUE ret;
DUMP2("do_eval_queue_handler : evPtr = %p", evPtr);
DUMP2("eval queue_thread : %lx", rb_thread_current());
DUMP2("added by thread : %lx", q->thread);
- if (q->done) {
+ if (*(q->done)) {
DUMP1("processed by another event-loop");
return 0;
} else {
@@ -1793,20 +3240,31 @@ eval_queue_handler(evPtr, flags)
}
/* process it */
- q->done = 1;
+ *(q->done) = 1;
/* check safe-level */
if (rb_safe_level() != q->safe_level) {
- *(q->result)
- = rb_funcall(rb_proc_new(evq_safelevel_handler,
- Data_Wrap_Struct(rb_cData,0,0,q)),
- rb_intern("call"), 0);
+ volatile VALUE q_dat;
+#ifdef HAVE_NATIVETHREAD
+ if (!is_ruby_native_thread()) {
+ rb_bug("cross-thread violation on eval_queue_handler()");
+ }
+#endif
+ q_dat = Data_Wrap_Struct(rb_cData,eval_queue_mark,0,q);
+ ret = rb_funcall(rb_proc_new(evq_safelevel_handler, q_dat),
+ ID_call, 0);
} else {
- DUMP2("call eval_real (for caller thread:%lx)", q->thread);
- DUMP2("call eval_real (current thread:%lx)", rb_thread_current());
- *(q->result) = ip_eval_real(q->obj, q->str);
+ DUMP2("call eval_real (for caller thread:%lx)", q->thread);
+ DUMP2("call eval_real (current thread:%lx)", rb_thread_current());
+ ret = ip_eval_real(q->interp, q->str, q->len);
}
+ /* set result */
+ RARRAY(q->result)->ptr[0] = ret;
+
+ /* complete */
+ *(q->done) = -1;
+
/* back to caller */
DUMP2("back to caller (caller thread:%lx)", q->thread);
DUMP2(" (current thread:%lx)", rb_thread_current());
@@ -1822,19 +3280,27 @@ ip_eval(self, str)
VALUE self;
VALUE str;
{
- struct eval_queue *tmp;
+ struct eval_queue *evq;
+ char *eval_str;
+ int *alloc_done;
+ int thr_crit_bup;
VALUE current = rb_thread_current();
- VALUE result;
- VALUE *alloc_result;
+ volatile VALUE result = rb_ary_new2(1);
+ volatile VALUE ret;
Tcl_QueuePosition position;
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+ StringValue(str);
+ rb_thread_critical = thr_crit_bup;
+
if (eventloop_thread == 0 || current == eventloop_thread) {
if (eventloop_thread) {
DUMP2("eval from current eventloop %lx", current);
} else {
DUMP2("eval from thread:%lx but no eventloop", current);
}
- result = ip_eval_real(self, str);
+ result = ip_eval_real(self, RSTRING(str)->ptr, RSTRING(str)->len);
if (rb_obj_is_kind_of(result, rb_eException)) {
rb_exc_raise(result);
}
@@ -1843,39 +3309,53 @@ ip_eval(self, str)
DUMP2("eval from thread %lx (NOT current eventloop)", current);
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
/* allocate memory (protected from Tcl_ServiceEvent) */
- alloc_result = ALLOC(VALUE);
+ alloc_done = (int*)ALLOC(int);
+ *alloc_done = 0;
+
+ eval_str = ALLOC_N(char, RSTRING(str)->len + 1);
+ strncpy(eval_str, RSTRING(str)->ptr, RSTRING(str)->len);
+ eval_str[RSTRING(str)->len] = 0;
/* allocate memory (freed by Tcl_ServiceEvent) */
- tmp = (struct eval_queue *)Tcl_Alloc(sizeof(struct eval_queue));
+ evq = (struct eval_queue *)Tcl_Alloc(sizeof(struct eval_queue));
/* construct event data */
- tmp->done = 0;
- tmp->obj = self;
- tmp->str = str;
- tmp->result = alloc_result;
- tmp->thread = current;
- tmp->safe_level = rb_safe_level();
- tmp->ev.proc = eval_queue_handler;
+ evq->done = alloc_done;
+ evq->str = eval_str;
+ evq->len = RSTRING(str)->len;
+ evq->interp = self;
+ evq->result = result;
+ evq->thread = current;
+ evq->safe_level = rb_safe_level();
+ evq->ev.proc = eval_queue_handler;
position = TCL_QUEUE_TAIL;
/* add the handler to Tcl event queue */
DUMP1("add handler");
- Tcl_QueueEvent(&(tmp->ev), position);
+ Tcl_QueueEvent(&(evq->ev), position);
+
+ rb_thread_critical = thr_crit_bup;
/* wait for the handler to be processed */
DUMP2("wait for handler (current thread:%lx)", current);
- rb_thread_stop();
+ while(*alloc_done >= 0) {
+ rb_thread_stop();
+ }
DUMP2("back from handler (current thread:%lx)", current);
/* get result & free allocated memory */
- result = *alloc_result;
- free(alloc_result);
- if (rb_obj_is_kind_of(result, rb_eException)) {
- rb_exc_raise(result);
+ ret = RARRAY(result)->ptr[0];
+ free(alloc_done);
+ free(eval_str);
+ if (rb_obj_is_kind_of(ret, rb_eException)) {
+ rb_exc_raise(ret);
}
- return result;
+ return ret;
}
@@ -1885,12 +3365,27 @@ lib_restart(self)
VALUE self;
{
struct tcltkip *ptr = get_ip(self);
+ int thr_crit_bup;
rb_secure(4);
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
/* destroy the root wdiget */
- /* ptr->return_value = Tcl_Eval(ptr->ip, "destroy ."); */
- ptr->return_value = FIX2INT(ip_eval(self, "destroy ."));
+ ptr->return_value = Tcl_Eval(ptr->ip, "destroy .");
+ /* ignore ERROR */
+ DUMP2("(TCL_Eval result) %d", ptr->return_value);
+ Tcl_ResetResult(ptr->ip);
+
+ /* delete namespace ( tested on tk8.4.5 ) */
+ ptr->return_value = Tcl_Eval(ptr->ip, "namespace delete ::tk::msgcat");
+ /* ignore ERROR */
+ DUMP2("(TCL_Eval result) %d", ptr->return_value);
+ Tcl_ResetResult(ptr->ip);
+
+ /* delete trace proc ( tested on tk8.4.5 ) */
+ ptr->return_value = Tcl_Eval(ptr->ip, "trace vdelete ::tk_strictMotif w ::tk::EventMotifBindings");
/* ignore ERROR */
DUMP2("(TCL_Eval result) %d", ptr->return_value);
Tcl_ResetResult(ptr->ip);
@@ -1900,21 +3395,27 @@ lib_restart(self)
if (Tcl_IsSafe(ptr->ip)) {
DUMP1("Tk_SafeInit");
if (Tk_SafeInit(ptr->ip) == TCL_ERROR) {
- rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ rb_thread_critical = thr_crit_bup;
+ /* rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); */
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
}
} else {
DUMP1("Tk_Init");
if (Tk_Init(ptr->ip) == TCL_ERROR) {
- rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ rb_thread_critical = thr_crit_bup;
+ /* rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); */
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
}
}
-#else
+#else /* TCL_MAJOR_VERSION < 8 */
DUMP1("Tk_Init");
if (Tk_Init(ptr->ip) == TCL_ERROR) {
rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
}
#endif
+ rb_thread_critical = thr_crit_bup;
+
return Qnil;
}
@@ -1934,141 +3435,389 @@ ip_restart(self)
}
static VALUE
-ip_toUTF8(self, str, encodename)
- VALUE self;
- VALUE str;
+lib_toUTF8_core(ip_obj, src, encodename)
+ VALUE ip_obj;
+ VALUE src;
VALUE encodename;
{
+ volatile VALUE str = src;
+
#ifdef TCL_UTF_MAX
Tcl_Interp *interp;
Tcl_Encoding encoding;
Tcl_DString dstr;
+ int taint_flag = OBJ_TAINTED(str);
struct tcltkip *ptr;
char *buf;
+ int thr_crit_bup;
- ptr = get_ip(self);
- interp = ptr->ip;
+ if (NIL_P(ip_obj)) {
+ interp = (Tcl_Interp *)NULL;
+ } else {
+ interp = get_ip(ip_obj)->ip;
+ }
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ if (NIL_P(encodename)) {
+ if (TYPE(str) == T_STRING) {
+ volatile VALUE enc;
+
+ enc = rb_ivar_get(str, ID_at_enc);
+ if (NIL_P(enc)) {
+ if (NIL_P(ip_obj)) {
+ encoding = (Tcl_Encoding)NULL;
+ } else {
+ enc = rb_ivar_get(ip_obj, ID_at_enc);
+ if (NIL_P(enc)) {
+ encoding = (Tcl_Encoding)NULL;
+ } else {
+ StringValue(enc);
+ encoding = Tcl_GetEncoding(interp, RSTRING(enc)->ptr);
+ if (encoding == (Tcl_Encoding)NULL) {
+ rb_warning("Tk-interp has unknown encoding information (@encoding:'%s')", RSTRING(enc)->ptr);
+ }
+ }
+ }
+ } else {
+ StringValue(enc);
+ if (strcmp(RSTRING(enc)->ptr, "binary") == 0) {
+ rb_thread_critical = thr_crit_bup;
+ return str;
+ }
+ encoding = Tcl_GetEncoding(interp, RSTRING(enc)->ptr);
+ if (encoding == (Tcl_Encoding)NULL) {
+ rb_warning("string has unknown encoding information (@encoding:'%s')", RSTRING(enc)->ptr);
+ }
+ }
+ } else {
+ encoding = (Tcl_Encoding)NULL;
+ }
+ } else {
+ StringValue(encodename);
+ encoding = Tcl_GetEncoding(interp, RSTRING(encodename)->ptr);
+ if (encoding == (Tcl_Encoding)NULL) {
+ rb_warning("unknown encoding name '%s'", RSTRING(encodename)->ptr);
+ }
+ }
- StringValue(encodename);
StringValue(str);
- encoding = Tcl_GetEncoding(interp, RSTRING(encodename)->ptr);
- if (!RSTRING(str)->len) return str;
- buf = ALLOCA_N(char,strlen(RSTRING(str)->ptr)+1);
- strcpy(buf, RSTRING(str)->ptr);
+ if (!RSTRING(str)->len) {
+ rb_thread_critical = thr_crit_bup;
+ return str;
+ }
+
+ buf = ALLOC_N(char,(RSTRING(str)->len)+1);
+ strncpy(buf, RSTRING(str)->ptr, RSTRING(str)->len);
+ buf[RSTRING(str)->len] = 0;
Tcl_DStringInit(&dstr);
Tcl_DStringFree(&dstr);
- Tcl_ExternalToUtfDString(encoding,buf,strlen(buf),&dstr);
- /* str = rb_str_new2(Tcl_DStringValue(&dstr)); */
- str = rb_tainted_str_new2(Tcl_DStringValue(&dstr));
+ /* Tcl_ExternalToUtfDString(encoding,buf,strlen(buf),&dstr); */
+ Tcl_ExternalToUtfDString(encoding, buf, RSTRING(str)->len, &dstr);
+
+ /* str = rb_tainted_str_new2(Tcl_DStringValue(&dstr)); */
+ str = rb_str_new2(Tcl_DStringValue(&dstr));
+ rb_ivar_set(str, ID_at_enc, rb_tainted_str_new2("utf-8"));
+ if (taint_flag) OBJ_TAINT(str);
- Tcl_FreeEncoding(encoding);
+ if (encoding != (Tcl_Encoding)NULL) {
+ Tcl_FreeEncoding(encoding);
+ }
Tcl_DStringFree(&dstr);
+
+ free(buf);
+
+ rb_thread_critical = thr_crit_bup;
#endif
+
return str;
}
static VALUE
-ip_fromUTF8(self, str, encodename)
+lib_toUTF8(argc, argv, self)
+ int argc;
+ VALUE *argv;
VALUE self;
- VALUE str;
+{
+ VALUE str, encodename;
+
+ if (rb_scan_args(argc, argv, "11", &str, &encodename) == 1) {
+ encodename = Qnil;
+ }
+ return lib_toUTF8_core(Qnil, str, encodename);
+}
+
+static VALUE
+ip_toUTF8(argc, argv, self)
+ int argc;
+ VALUE *argv;
+ VALUE self;
+{
+ VALUE str, encodename;
+
+ if (rb_scan_args(argc, argv, "11", &str, &encodename) == 1) {
+ encodename = Qnil;
+ }
+ return lib_toUTF8_core(self, str, encodename);
+}
+
+static VALUE
+lib_fromUTF8_core(ip_obj, src, encodename)
+ VALUE ip_obj;
+ VALUE src;
VALUE encodename;
{
+ volatile VALUE str = src;
+
#ifdef TCL_UTF_MAX
Tcl_Interp *interp;
Tcl_Encoding encoding;
Tcl_DString dstr;
- struct tcltkip *ptr;
+ int taint_flag = OBJ_TAINTED(str);
char *buf;
+ int thr_crit_bup;
- ptr = get_ip(self);
- interp = ptr->ip;
+ if (NIL_P(ip_obj)) {
+ interp = (Tcl_Interp *)NULL;
+ } else {
+ interp = get_ip(ip_obj)->ip;
+ }
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ if (NIL_P(encodename)) {
+ volatile VALUE enc;
+
+ if (TYPE(str) == T_STRING) {
+ enc = rb_ivar_get(str, ID_at_enc);
+ if (!NIL_P(enc) && strcmp(StringValuePtr(enc), "binary") == 0) {
+ rb_thread_critical = thr_crit_bup;
+ return str;
+ }
+ }
+
+ if (NIL_P(ip_obj)) {
+ encoding = (Tcl_Encoding)NULL;
+ } else {
+ enc = rb_ivar_get(ip_obj, ID_at_enc);
+ if (NIL_P(enc)) {
+ encoding = (Tcl_Encoding)NULL;
+ } else {
+ StringValue(enc);
+ encoding = Tcl_GetEncoding(interp, RSTRING(enc)->ptr);
+ if (encoding == (Tcl_Encoding)NULL) {
+ rb_warning("Tk-interp has unknown encoding information (@encoding:'%s')", RSTRING(enc)->ptr);
+ } else {
+ encodename = rb_obj_dup(enc);
+ }
+ }
+ }
+
+ } else {
+ StringValue(encodename);
+
+ if (strcmp(RSTRING(encodename)->ptr, "binary") == 0) {
+ char *s;
+ int len;
+
+ s = Tcl_GetByteArrayFromObj(Tcl_NewStringObj(RSTRING(str)->ptr,
+ RSTRING(str)->len),
+ &len);
+ str = rb_tainted_str_new(s, len);
+ rb_ivar_set(str, ID_at_enc, rb_tainted_str_new2("binary"));
+
+ rb_thread_critical = thr_crit_bup;
+ return str;
+ }
+
+ encoding = Tcl_GetEncoding(interp, RSTRING(encodename)->ptr);
+ if (encoding == (Tcl_Encoding)NULL) {
+ rb_warning("unknown encoding name '%s'", RSTRING(encodename)->ptr);
+ encodename = Qnil;
+ }
+ }
- StringValue(encodename);
StringValue(str);
- encoding = Tcl_GetEncoding(interp,RSTRING(encodename)->ptr);
- if (!RSTRING(str)->len) return str;
- buf = ALLOCA_N(char,strlen(RSTRING(str)->ptr)+1);
- strcpy(buf,RSTRING(str)->ptr);
+
+ if (RSTRING(str)->len == 0) {
+ rb_thread_critical = thr_crit_bup;
+ return rb_tainted_str_new2("");
+ }
+
+ buf = ALLOC_N(char,strlen(RSTRING(str)->ptr)+1);
+ strncpy(buf, RSTRING(str)->ptr, RSTRING(str)->len);
+ buf[RSTRING(str)->len] = 0;
Tcl_DStringInit(&dstr);
Tcl_DStringFree(&dstr);
- Tcl_UtfToExternalDString(encoding,buf,strlen(buf),&dstr);
- /* str = rb_str_new2(Tcl_DStringValue(&dstr)); */
- str = rb_tainted_str_new2(Tcl_DStringValue(&dstr));
+ /* Tcl_UtfToExternalDString(encoding,buf,strlen(buf),&dstr); */
+ Tcl_UtfToExternalDString(encoding,buf,RSTRING(str)->len,&dstr);
+
+ /* str = rb_tainted_str_new2(Tcl_DStringValue(&dstr)); */
+ str = rb_str_new2(Tcl_DStringValue(&dstr));
+ rb_ivar_set(str, ID_at_enc, encodename);
+ if (taint_flag) OBJ_TAINT(str);
- Tcl_FreeEncoding(encoding);
+ if (encoding != (Tcl_Encoding)NULL) {
+ Tcl_FreeEncoding(encoding);
+ }
Tcl_DStringFree(&dstr);
+ free(buf);
+
+ rb_thread_critical = thr_crit_bup;
#endif
+
return str;
}
+static VALUE
+lib_fromUTF8(argc, argv, self)
+ int argc;
+ VALUE *argv;
+ VALUE self;
+{
+ VALUE str, encodename;
+
+ if (rb_scan_args(argc, argv, "11", &str, &encodename) == 1) {
+ encodename = Qnil;
+ }
+ return lib_fromUTF8_core(Qnil, str, encodename);
+}
static VALUE
-#ifdef HAVE_STDARG_PROTOTYPES
-create_ip_exc(VALUE interp, VALUE exc, const char *fmt, ...)
-#else
-create_ip_exc(interp, exc, fmt, va_alist)
- VALUE interp:
- VALUE exc;
- const char *fmt;
- va_dcl
-#endif
+ip_fromUTF8(argc, argv, self)
+ int argc;
+ VALUE *argv;
+ VALUE self;
{
- va_list args;
- char buf[BUFSIZ];
- VALUE einfo;
+ VALUE str, encodename;
- va_init_list(args,fmt);
- vsnprintf(buf, BUFSIZ, fmt, args);
- buf[BUFSIZ - 1] = '\0';
- va_end(args);
- einfo = rb_exc_new2(exc, buf);
- rb_iv_set(einfo, "interp", interp);
- Tcl_ResetResult(get_ip(interp)->ip);
- return einfo;
+ if (rb_scan_args(argc, argv, "11", &str, &encodename) == 1) {
+ encodename = Qnil;
+ }
+ return lib_fromUTF8_core(self, str, encodename);
+}
+
+static VALUE
+lib_UTF_backslash_core(self, str, all_bs)
+ VALUE self;
+ VALUE str;
+ int all_bs;
+{
+#ifdef TCL_UTF_MAX
+ char *src_buf, *dst_buf, *ptr;
+ int read_len = 0, dst_len = 0;
+ int taint_flag = OBJ_TAINTED(str);
+ int thr_crit_bup;
+
+ StringValue(str);
+ if (!RSTRING(str)->len) {
+ return str;
+ }
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ src_buf = ALLOC_N(char,(RSTRING(str)->len)+1);
+ strncpy(src_buf, RSTRING(str)->ptr, RSTRING(str)->len);
+ src_buf[RSTRING(str)->len] = 0;
+
+ dst_buf = ALLOC_N(char,(RSTRING(str)->len)+1);
+
+ ptr = src_buf;
+ while(RSTRING(str)->len > ptr - src_buf) {
+ if (*ptr == '\\' && (all_bs || *(ptr + 1) == 'u')) {
+ dst_len += Tcl_UtfBackslash(ptr, &read_len, (dst_buf + dst_len));
+ ptr += read_len;
+ } else {
+ *(dst_buf + (dst_len++)) = *(ptr++);
+ }
+ }
+
+ str = rb_str_new(dst_buf, dst_len);
+ if (taint_flag) OBJ_TAINT(str);
+
+ free(src_buf);
+ free(dst_buf);
+
+ rb_thread_critical = thr_crit_bup;
+#endif
+
+ return str;
+}
+
+static VALUE
+lib_UTF_backslash(self, str)
+ VALUE self;
+ VALUE str;
+{
+ return lib_UTF_backslash_core(self, str, 0);
}
+static VALUE
+lib_Tcl_backslash(self, str)
+ VALUE self;
+ VALUE str;
+{
+ return lib_UTF_backslash_core(self, str, 1);
+}
+#if TCL_MAJOR_VERSION >= 8
+static VALUE
+ip_invoke_core(interp, objc, objv)
+ VALUE interp;
+ int objc;
+ Tcl_Obj **objv;
+#else
static VALUE
-ip_invoke_real(argc, argv, obj)
+ip_invoke_core(interp, argc, argv)
+ VALUE interp;
int argc;
- VALUE *argv;
- VALUE obj;
+ char **argv;
+#endif
{
- VALUE v;
- struct tcltkip *ptr; /* tcltkip data struct */
+ struct tcltkip *ptr;
int i;
Tcl_CmdInfo info;
- char *cmd, *s;
- char **av = (char **)NULL;
+ char *cmd;
+ char *s;
+ int len;
+ int thr_crit_bup;
+
#if TCL_MAJOR_VERSION >= 8
- Tcl_Obj **ov = (Tcl_Obj **)NULL;
+ int argc = objc;
+ char **argv = (char **)NULL;
Tcl_Obj *resultPtr;
#endif
- DUMP2("invoke_real called by thread:%lx", rb_thread_current());
- /* get the command name string */
- v = argv[0];
- cmd = StringValuePtr(v);
-
/* get the data struct */
- ptr = get_ip(obj);
+ ptr = get_ip(interp);
/* ip is deleted? */
if (Tcl_InterpDeleted(ptr->ip)) {
+ DUMP1("ip is deleted");
return rb_tainted_str_new2("");
}
+ /* get the command name string */
+#if TCL_MAJOR_VERSION >= 8
+ cmd = Tcl_GetStringFromObj(objv[0], &len);
+#else /* TCL_MAJOR_VERSION < 8 */
+ cmd = argv[0];
+#endif
+
/* map from the command name to a C procedure */
DUMP2("call Tcl_GetCommandInfo, %s", cmd);
if (!Tcl_GetCommandInfo(ptr->ip, cmd, &info)) {
- DUMP1("error Tcl_GetCommandInfo");
+ DUMP1("error Tcl_GetCommandInfo");
/* if (event_loop_abort_on_exc || cmd[0] != '.') { */
if (event_loop_abort_on_exc > 0) {
/*rb_ip_raise(obj,rb_eNameError,"invalid command name `%s'",cmd);*/
- return create_ip_exc(obj, rb_eNameError,
+ return create_ip_exc(interp, rb_eNameError,
"invalid command name `%s'", cmd);
} else {
if (event_loop_abort_on_exc < 0) {
@@ -2082,74 +3831,75 @@ ip_invoke_real(argc, argv, obj)
}
DUMP1("end Tcl_GetCommandInfo");
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
/* memory allocation for arguments of this command */
#if TCL_MAJOR_VERSION >= 8
- if (info.isNativeObjectProc) {
- /* object interface */
- ov = (Tcl_Obj **)ALLOCA_N(Tcl_Obj *, argc+1);
- for (i = 0; i < argc; ++i) {
- v = argv[i];
- s = StringValuePtr(v);
- ov[i] = Tcl_NewStringObj(s, RSTRING(v)->len);
- Tcl_IncrRefCount(ov[i]);
- }
- ov[argc] = (Tcl_Obj *)NULL;
- }
- else
-#endif
- {
+ if (!info.isNativeObjectProc) {
/* string interface */
- av = (char **)ALLOCA_N(char *, argc+1);
+ argv = (char **)ALLOC_N(char *, argc+1);
for (i = 0; i < argc; ++i) {
- v = argv[i];
- s = StringValuePtr(v);
- av[i] = ALLOCA_N(char, strlen(s)+1);
- strcpy(av[i], s);
+ argv[i] = Tcl_GetStringFromObj(objv[i], &len);
}
- av[argc] = (char *)NULL;
+ argv[argc] = (char *)NULL;
}
+#endif
Tcl_ResetResult(ptr->ip);
/* Invoke the C procedure */
#if TCL_MAJOR_VERSION >= 8
if (info.isNativeObjectProc) {
- int dummy;
- ptr->return_value = (*info.objProc)(info.objClientData,
- ptr->ip, argc, ov);
-
+ ptr->return_value = (*info.objProc)(info.objClientData, ptr->ip,
+ objc, objv);
+#if 0
/* get the string value from the result object */
resultPtr = Tcl_GetObjResult(ptr->ip);
- Tcl_SetResult(ptr->ip, Tcl_GetStringFromObj(resultPtr, &dummy),
+ Tcl_SetResult(ptr->ip, Tcl_GetStringFromObj(resultPtr, &len),
TCL_VOLATILE);
-
- for (i=0; i<argc; i++) {
- Tcl_DecrRefCount(ov[i]);
- }
+#endif
}
else
#endif
{
- TRAP_BEG;
#if TCL_MAJOR_VERSION >= 8
ptr->return_value = (*info.proc)(info.clientData, ptr->ip,
- argc, (CONST84 char **)av);
+ argc, (CONST84 char **)argv);
+
+ free(argv);
+
#else /* TCL_MAJOR_VERSION < 8 */
- ptr->return_value = (*info.proc)(info.clientData, ptr->ip, argc, av);
+ ptr->return_value = (*info.proc)(info.clientData, ptr->ip,
+ argc, argv);
#endif
- TRAP_END;
}
+ rb_thread_critical = thr_crit_bup;
+
/* exception on mainloop */
if (ptr->return_value == TCL_ERROR) {
if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->ip)) {
- /*rb_ip_raise(obj, rb_eRuntimeError, "%s", ptr->ip->result);*/
- return create_ip_exc(obj, rb_eRuntimeError, "%s", ptr->ip->result);
+#if TCL_MAJOR_VERSION >= 8
+ return create_ip_exc(interp, rb_eRuntimeError,
+ "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
+ return create_ip_exc(interp, rb_eRuntimeError,
+ "%s", ptr->ip->result);
+#endif
} else {
if (event_loop_abort_on_exc < 0) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_warning("%s (ignore)", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_warning("%s (ignore)", ptr->ip->result);
+#endif
} else {
+#if TCL_MAJOR_VERSION >= 8
+ rb_warn("%s (ignore)", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
rb_warn("%s (ignore)", ptr->ip->result);
+#endif
}
Tcl_ResetResult(ptr->ip);
return rb_tainted_str_new2("");
@@ -2157,8 +3907,143 @@ ip_invoke_real(argc, argv, obj)
}
/* pass back the result (as string) */
- /* return rb_str_new2(ptr->ip->result); */
- return rb_tainted_str_new2(ptr->ip->result);
+ return ip_get_result_string_obj(ptr->ip);
+}
+
+
+#if TCL_MAJOR_VERSION >= 8
+static Tcl_Obj **
+#else /* TCL_MAJOR_VERSION < 8 */
+static char **
+#endif
+alloc_invoke_arguments(argc, argv)
+ int argc;
+ VALUE *argv;
+{
+ int i;
+ VALUE v;
+ char *s;
+ int thr_crit_bup;
+
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_Obj **av = (Tcl_Obj **)NULL;
+ Tcl_Obj *resultPtr;
+#else /* TCL_MAJOR_VERSION < 8 */
+ char **av = (char **)NULL;
+#endif
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ /* memory allocation */
+#if TCL_MAJOR_VERSION >= 8
+ av = (Tcl_Obj **)ALLOC_N(Tcl_Obj *, argc+1);
+ for (i = 0; i < argc; ++i) {
+ VALUE enc;
+
+ v = argv[i];
+ s = StringValuePtr(v);
+
+# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ av[i] = Tcl_NewStringObj(s, RSTRING(v)->len);
+# else /* TCL_VERSION >= 8.1 */
+ enc = rb_ivar_get(v, ID_at_enc);
+ if (!NIL_P(enc) && strcmp(StringValuePtr(enc), "binary") == 0) {
+ /* binary string */
+ av[i] = Tcl_NewByteArrayObj(s, RSTRING(v)->len);
+ } else if (strlen(s) != RSTRING(v)->len) {
+ /* probably binary string */
+ av[i] = Tcl_NewByteArrayObj(s, RSTRING(v)->len);
+ } else {
+ /* probably text string */
+ av[i] = Tcl_NewStringObj(s, RSTRING(v)->len);
+ }
+# endif
+ Tcl_IncrRefCount(av[i]);
+ }
+ av[argc] = (Tcl_Obj *)NULL;
+
+#else /* TCL_MAJOR_VERSION < 8 */
+ /* string interface */
+ av = (char **)ALLOC_N(char *, argc+1);
+ for (i = 0; i < argc; ++i) {
+ v = argv[i];
+ s = StringValuePtr(v);
+ av[i] = ALLOC_N(char, strlen(s)+1);
+ strcpy(av[i], s);
+ }
+ av[argc] = (char *)NULL;
+#endif
+
+ rb_thread_critical = thr_crit_bup;
+
+ return av;
+}
+
+static void
+free_invoke_arguments(argc, av)
+ int argc;
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_Obj **av;
+#else /* TCL_MAJOR_VERSION < 8 */
+ char **av;
+#endif
+{
+ int i;
+
+ for (i = 0; i < argc; ++i) {
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(av[i]);
+#else /* TCL_MAJOR_VERSION < 8 */
+ free(av[i]);
+#endif
+ }
+ free(av);
+}
+
+static VALUE
+ip_invoke_real(argc, argv, interp)
+ int argc;
+ VALUE *argv;
+ VALUE interp;
+{
+ VALUE v;
+ struct tcltkip *ptr; /* tcltkip data struct */
+ int i;
+ Tcl_CmdInfo info;
+ char *s;
+ int len;
+ int thr_crit_bup;
+
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_Obj **av = (Tcl_Obj **)NULL;
+ Tcl_Obj *resultPtr;
+#else /* TCL_MAJOR_VERSION < 8 */
+ char **av = (char **)NULL;
+#endif
+
+ DUMP2("invoke_real called by thread:%lx", rb_thread_current());
+
+ /* get the data struct */
+ ptr = get_ip(interp);
+
+ /* ip is deleted? */
+ if (Tcl_InterpDeleted(ptr->ip)) {
+ DUMP1("ip is deleted");
+ return rb_tainted_str_new2("");
+ }
+
+ /* allocate memory for arguments */
+ av = alloc_invoke_arguments(argc, argv);
+
+ /* Invoke the C procedure */
+ Tcl_ResetResult(ptr->ip);
+ v = ip_invoke_core(interp, argc, av);
+
+ /* free allocated memory */
+ free_invoke_arguments(argc, av);
+
+ return v;
}
VALUE
@@ -2171,7 +4056,7 @@ ivq_safelevel_handler(arg, ivq)
Data_Get_Struct(ivq, struct invoke_queue, q);
DUMP2("(safe-level handler) $SAFE = %d", q->safe_level);
rb_set_safe_level(q->safe_level);
- return ip_invoke_real(q->argc, q->argv, q->obj);
+ return ip_invoke_core(q->interp, q->argc, q->argv);
}
int invoke_queue_handler _((Tcl_Event *, int));
@@ -2181,12 +4066,13 @@ invoke_queue_handler(evPtr, flags)
int flags;
{
struct invoke_queue *q = (struct invoke_queue *)evPtr;
+ volatile VALUE ret;
DUMP2("do_invoke_queue_handler : evPtr = %p", evPtr);
DUMP2("invoke queue_thread : %lx", rb_thread_current());
DUMP2("added by thread : %lx", q->thread);
- if (q->done) {
+ if (*(q->done)) {
DUMP1("processed by another event-loop");
return 0;
} else {
@@ -2194,20 +4080,26 @@ invoke_queue_handler(evPtr, flags)
}
/* process it */
- q->done = 1;
+ *(q->done) = 1;
/* check safe-level */
if (rb_safe_level() != q->safe_level) {
- *(q->result)
- = rb_funcall(rb_proc_new(ivq_safelevel_handler,
- Data_Wrap_Struct(rb_cData,0,0,q)),
- rb_intern("call"), 0);
+ volatile VALUE q_dat;
+ q_dat = Data_Wrap_Struct(rb_cData,invoke_queue_mark,0,q);
+ ret = rb_funcall(rb_proc_new(evq_safelevel_handler, q_dat),
+ ID_call, 0);
} else {
- DUMP2("call invoke_real (for caller thread:%lx)", q->thread);
- DUMP2("call invoke_real (current thread:%lx)", rb_thread_current());
- *(q->result) = ip_invoke_real(q->argc, q->argv, q->obj);
+ DUMP2("call invoke_real (for caller thread:%lx)", q->thread);
+ DUMP2("call invoke_real (current thread:%lx)", rb_thread_current());
+ ret = ip_invoke_core(q->interp, q->argc, q->argv);
}
+ /* set result */
+ RARRAY(q->result)->ptr[0] = ret;
+
+ /* complete */
+ *(q->done) = -1;
+
/* back to caller */
DUMP2("back to caller (caller thread:%lx)", q->thread);
DUMP2(" (current thread:%lx)", rb_thread_current());
@@ -2219,16 +4111,28 @@ invoke_queue_handler(evPtr, flags)
}
static VALUE
-ip_invoke(argc, argv, obj)
+ip_invoke_with_position(argc, argv, obj, position)
int argc;
VALUE *argv;
VALUE obj;
+ Tcl_QueuePosition position;
{
- struct invoke_queue *tmp;
+ struct invoke_queue *ivq;
+ char *s;
+ int len;
+ int i;
+ int *alloc_done;
+ int thr_crit_bup;
+ VALUE v;
VALUE current = rb_thread_current();
- VALUE result;
- VALUE *alloc_argv, *alloc_result;
- Tcl_QueuePosition position;
+ volatile VALUE result = rb_ary_new2(1);
+ volatile VALUE ret;
+
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_Obj **av = (Tcl_Obj **)NULL;
+#else /* TCL_MAJOR_VERSION < 8 */
+ char **av = (char **)NULL;
+#endif
if (argc < 1) {
rb_raise(rb_eArgError, "command name missing");
@@ -2248,45 +4152,60 @@ ip_invoke(argc, argv, obj)
DUMP2("invoke from thread %lx (NOT current eventloop)", current);
- /* allocate memory (protected from Tcl_ServiceEvent) */
- alloc_argv = ALLOC_N(VALUE,argc);
- MEMCPY(alloc_argv, argv, VALUE, argc);
- alloc_result = ALLOC(VALUE);
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ /* allocate memory (for arguments) */
+ av = alloc_invoke_arguments(argc, argv);
+
+ /* allocate memory (keep result) */
+ alloc_done = (int*)ALLOC(int);
+ *alloc_done = 0;
/* allocate memory (freed by Tcl_ServiceEvent) */
- tmp = (struct invoke_queue *)Tcl_Alloc(sizeof(struct invoke_queue));
+ ivq = (struct invoke_queue *)Tcl_Alloc(sizeof(struct invoke_queue));
/* construct event data */
- tmp->done = 0;
- tmp->obj = obj;
- tmp->argc = argc;
- tmp->argv = alloc_argv;
- tmp->result = alloc_result;
- tmp->thread = current;
- tmp->safe_level = rb_safe_level();
- tmp->ev.proc = invoke_queue_handler;
- position = TCL_QUEUE_TAIL;
+ ivq->done = alloc_done;
+ ivq->argc = argc;
+ ivq->argv = av;
+ ivq->interp = obj;
+ ivq->result = result;
+ ivq->thread = current;
+ ivq->safe_level = rb_safe_level();
+ ivq->ev.proc = invoke_queue_handler;
/* add the handler to Tcl event queue */
DUMP1("add handler");
- Tcl_QueueEvent(&(tmp->ev), position);
+ Tcl_QueueEvent(&(ivq->ev), position);
+
+ rb_thread_critical = thr_crit_bup;
/* wait for the handler to be processed */
DUMP2("wait for handler (current thread:%lx)", current);
- rb_thread_stop();
+ while(*alloc_done >= 0) {
+ rb_thread_stop();
+ }
DUMP2("back from handler (current thread:%lx)", current);
/* get result & free allocated memory */
- result = *alloc_result;
- free(alloc_argv);
- free(alloc_result);
- if (rb_obj_is_kind_of(result, rb_eException)) {
- rb_exc_raise(result);
+ ret = RARRAY(result)->ptr[0];
+ free(alloc_done);
+
+ /* free allocated memory */
+ free_invoke_arguments(argc, av);
+
+ /* exception? */
+ if (rb_obj_is_kind_of(ret, rb_eException)) {
+ DUMP1("raise exception");
+ rb_exc_raise(ret);
}
- return result;
+ DUMP1("exit ip_invoke");
+ return ret;
}
+
/* get return code from Tcl_Eval() */
static VALUE
ip_retval(self)
@@ -2300,6 +4219,864 @@ ip_retval(self)
return (INT2FIX(ptr->return_value));
}
+static VALUE
+ip_invoke(argc, argv, obj)
+ int argc;
+ VALUE *argv;
+ VALUE obj;
+{
+ return ip_invoke_with_position(argc, argv, obj, TCL_QUEUE_TAIL);
+}
+
+static VALUE
+ip_invoke_immediate(argc, argv, obj)
+ int argc;
+ VALUE *argv;
+ VALUE obj;
+{
+ return ip_invoke_with_position(argc, argv, obj, TCL_QUEUE_HEAD);
+}
+
+/* access Tcl variables */
+static VALUE
+ip_get_variable(self, varname_arg, flag_arg)
+ VALUE self;
+ VALUE varname_arg;
+ VALUE flag_arg;
+{
+ struct tcltkip *ptr = get_ip(self);
+ int thr_crit_bup;
+ volatile VALUE varname, flag;
+
+ varname = varname_arg;
+ flag = flag_arg;
+
+ StringValue(varname);
+
+#if TCL_MAJOR_VERSION >= 8
+ {
+ Tcl_Obj *nameobj, *ret;
+ char *s;
+ int len;
+ VALUE strval;
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ nameobj = Tcl_NewStringObj(RSTRING(varname)->ptr,
+ RSTRING(varname)->len);
+ Tcl_IncrRefCount(nameobj);
+
+ ret = Tcl_ObjGetVar2(ptr->ip, nameobj, (Tcl_Obj*)NULL, FIX2INT(flag));
+
+ Tcl_DecrRefCount(nameobj);
+
+ rb_thread_critical = thr_crit_bup;
+
+ if (ret == (Tcl_Obj*)NULL) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
+ }
+
+ Tcl_IncrRefCount(ret);
+
+# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ s = Tcl_GetStringFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+ Tcl_DecrRefCount(ret);
+ return(strval);
+# else /* TCL_VERSION >= 8.1 */
+ {
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ if (Tcl_GetCharLength(ret)
+ != Tcl_UniCharLen(Tcl_GetUnicode(ret))) {
+ /* possibly binary string */
+ s = Tcl_GetByteArrayFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+ rb_ivar_set(strval, ID_at_enc, rb_tainted_str_new2("binary"));
+ } else {
+ /* possibly text string */
+ s = Tcl_GetStringFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+ }
+
+ rb_thread_critical = thr_crit_bup;
+ }
+
+ Tcl_DecrRefCount(ret);
+ return(strval);
+# endif
+ }
+#else /* TCL_MAJOR_VERSION < 8 */
+ {
+ char *ret;
+
+ ret = Tcl_GetVar2(ptr->ip, RSTRING(varname)->ptr,
+ (char*)NULL, FIX2INT(flag));
+ if (ret == (char*)NULL) {
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ }
+ return(rb_tainted_str_new2(ret));
+ }
+#endif
+}
+
+static VALUE
+ip_get_variable2(self, varname_arg, index_arg, flag_arg)
+ VALUE self;
+ VALUE varname_arg;
+ VALUE index_arg;
+ VALUE flag_arg;
+{
+ struct tcltkip *ptr = get_ip(self);
+ int thr_crit_bup;
+ volatile VALUE varname, index, flag;
+
+ if (NIL_P(index_arg)) {
+ return ip_get_variable(self, varname_arg, flag_arg);
+ }
+
+ varname = varname_arg;
+ index = index_arg;
+ flag = flag_arg;
+
+ StringValue(varname);
+ StringValue(index);
+
+#if TCL_MAJOR_VERSION >= 8
+ {
+ Tcl_Obj *nameobj, *idxobj, *ret;
+ char *s;
+ int len;
+ volatile VALUE strval;
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ nameobj = Tcl_NewStringObj(RSTRING(varname)->ptr,
+ RSTRING(varname)->len);
+ Tcl_IncrRefCount(nameobj);
+ idxobj = Tcl_NewStringObj(RSTRING(index)->ptr, RSTRING(index)->len);
+ Tcl_IncrRefCount(idxobj);
+
+ ret = Tcl_ObjGetVar2(ptr->ip, nameobj, idxobj, FIX2INT(flag));
+
+ Tcl_IncrRefCount(ret);
+ Tcl_DecrRefCount(nameobj);
+ Tcl_DecrRefCount(idxobj);
+
+ rb_thread_critical = thr_crit_bup;
+
+ if (ret == (Tcl_Obj*)NULL) {
+ Tcl_DecrRefCount(ret);
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
+ }
+# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ s = Tcl_GetStringFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+ Tcl_DecrRefCount(ret);
+ return(strval);
+# else /* TCL_VERSION >= 8.1 */
+ {
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ if (Tcl_GetCharLength(ret)
+ != Tcl_UniCharLen(Tcl_GetUnicode(ret))) {
+ /* possibly binary string */
+ s = Tcl_GetByteArrayFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+ rb_ivar_set(strval, ID_at_enc, rb_tainted_str_new2("binary"));
+ } else {
+ /* possibly text string */
+ s = Tcl_GetStringFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+ }
+
+ rb_thread_critical = thr_crit_bup;
+ }
+
+ Tcl_DecrRefCount(ret);
+ return(strval);
+# endif
+ }
+#else /* TCL_MAJOR_VERSION < 8 */
+ {
+ char *ret;
+
+ ret = Tcl_GetVar2(ptr->ip, RSTRING(varname)->ptr, RSTRING(index)->ptr,
+ FIX2INT(flag));
+ if (ret == (char*)NULL) {
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ }
+ return(rb_tainted_str_new2(ret));
+ }
+#endif
+}
+
+static VALUE
+ip_set_variable(self, varname_arg, value_arg, flag_arg)
+ VALUE self;
+ VALUE varname_arg;
+ VALUE value_arg;
+ VALUE flag_arg;
+{
+ struct tcltkip *ptr = get_ip(self);
+ int thr_crit_bup;
+ volatile VALUE varname, value, flag;
+
+ varname = varname_arg;
+ value = value_arg;
+ flag = flag_arg;
+
+ StringValue(varname);
+ StringValue(value);
+
+#if TCL_MAJOR_VERSION >= 8
+ {
+ Tcl_Obj *nameobj, *valobj, *ret;
+ char *s;
+ int len;
+ volatile VALUE strval;
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ nameobj = Tcl_NewStringObj(RSTRING(varname)->ptr,
+ RSTRING(varname)->len);
+ Tcl_IncrRefCount(nameobj);
+
+# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ valobj = Tcl_NewStringObj(RSTRING(value)->ptr,
+ RSTRING(value)->len);
+ Tcl_IncrRefCount(valobj);
+# else /* TCL_VERSION >= 8.1 */
+ {
+ VALUE enc = rb_ivar_get(value, ID_at_enc);
+
+ if (!NIL_P(enc) && strcmp(StringValuePtr(enc), "binary") == 0) {
+ /* binary string */
+ valobj = Tcl_NewByteArrayObj(RSTRING(value)->ptr,
+ RSTRING(value)->len);
+ } else if (strlen(RSTRING(value)->ptr) != RSTRING(value)->len) {
+ /* probably binary string */
+ valobj = Tcl_NewByteArrayObj(RSTRING(value)->ptr,
+ RSTRING(value)->len);
+ } else {
+ /* probably text string */
+ valobj = Tcl_NewStringObj(RSTRING(value)->ptr,
+ RSTRING(value)->len);
+ }
+
+ Tcl_IncrRefCount(valobj);
+ }
+# endif
+
+ ret = Tcl_ObjSetVar2(ptr->ip, nameobj, (Tcl_Obj*)NULL, valobj,
+ FIX2INT(flag));
+
+ Tcl_DecrRefCount(nameobj);
+ Tcl_DecrRefCount(valobj);
+
+ if (ret == (Tcl_Obj*)NULL) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
+ }
+
+ Tcl_IncrRefCount(ret);
+
+# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ s = Tcl_GetStringFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+# else /* TCL_VERSION >= 8.1 */
+ if (Tcl_GetCharLength(ret) != Tcl_UniCharLen(Tcl_GetUnicode(ret))) {
+ /* possibly binary string */
+ s = Tcl_GetByteArrayFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+ rb_ivar_set(strval, ID_at_enc, rb_str_new2("binary"));
+ } else {
+ /* possibly text string */
+ s = Tcl_GetStringFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+ }
+# endif
+
+ rb_thread_critical = thr_crit_bup;
+
+ Tcl_DecrRefCount(ret);
+
+ return(strval);
+ }
+#else /* TCL_MAJOR_VERSION < 8 */
+ {
+ CONST char *ret;
+
+ ret = Tcl_SetVar2(ptr->ip, RSTRING(varname)->ptr, (char*)NULL,
+ RSTRING(value)->ptr, (int)FIX2INT(flag));
+ if (ret == NULL) {
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ }
+ return(rb_tainted_str_new2(ret));
+ }
+#endif
+}
+
+static VALUE
+ip_set_variable2(self, varname_arg, index_arg, value_arg, flag_arg)
+ VALUE self;
+ VALUE varname_arg;
+ VALUE index_arg;
+ VALUE value_arg;
+ VALUE flag_arg;
+{
+ struct tcltkip *ptr = get_ip(self);
+ int thr_crit_bup;
+ volatile VALUE varname, index, value, flag;
+
+ if (NIL_P(index_arg)) {
+ return ip_set_variable(self, varname_arg, value_arg, flag_arg);
+ }
+
+ varname = varname_arg;
+ index = index_arg;
+ value = value_arg;
+ flag = flag_arg;
+
+ StringValue(varname);
+ StringValue(index);
+ StringValue(value);
+
+#if TCL_MAJOR_VERSION >= 8
+ {
+ Tcl_Obj *nameobj, *idxobj, *valobj, *ret;
+ char *s;
+ int len;
+ volatile VALUE strval;
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ nameobj = Tcl_NewStringObj(RSTRING(varname)->ptr,
+ RSTRING(varname)->len);
+ Tcl_IncrRefCount(nameobj);
+
+ idxobj = Tcl_NewStringObj(RSTRING(index)->ptr,
+ RSTRING(index)->len);
+ Tcl_IncrRefCount(idxobj);
+
+# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ valobj = Tcl_NewStringObj(RSTRING(value)->ptr,
+ RSTRING(value)->len);
+# else /* TCL_VERSION >= 8.1 */
+ {
+ VALUE enc = rb_ivar_get(value, ID_at_enc);
+
+ if (!NIL_P(enc) && strcmp(StringValuePtr(enc), "binary") == 0) {
+ /* binary string */
+ valobj = Tcl_NewByteArrayObj(RSTRING(value)->ptr,
+ RSTRING(value)->len);
+ } else if (strlen(RSTRING(value)->ptr) != RSTRING(value)->len) {
+ /* probably binary string */
+ valobj = Tcl_NewByteArrayObj(RSTRING(value)->ptr,
+ RSTRING(value)->len);
+ } else {
+ /* probably text string */
+ valobj = Tcl_NewStringObj(RSTRING(value)->ptr,
+ RSTRING(value)->len);
+ }
+ }
+
+# endif
+ Tcl_IncrRefCount(valobj);
+
+ ret = Tcl_ObjSetVar2(ptr->ip, nameobj, idxobj, valobj, FIX2INT(flag));
+
+ Tcl_DecrRefCount(nameobj);
+ Tcl_DecrRefCount(idxobj);
+ Tcl_DecrRefCount(valobj);
+
+ rb_thread_critical = thr_crit_bup;
+
+ if (ret == (Tcl_Obj*)NULL) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
+ }
+
+ Tcl_IncrRefCount(ret);
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ s = Tcl_GetStringFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+# else /* TCL_VERSION >= 8.1 */
+ if (Tcl_GetCharLength(ret) != Tcl_UniCharLen(Tcl_GetUnicode(ret))) {
+ /* possibly binary string */
+ s = Tcl_GetByteArrayFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+ rb_ivar_set(strval, ID_at_enc, rb_str_new2("binary"));
+ } else {
+ /* possibly text string */
+ s = Tcl_GetStringFromObj(ret, &len);
+ strval = rb_tainted_str_new(s, len);
+ }
+# endif
+
+ rb_thread_critical = thr_crit_bup;
+
+ Tcl_DecrRefCount(ret);
+
+ return(strval);
+ }
+#else /* TCL_MAJOR_VERSION < 8 */
+ {
+ CONST char *ret;
+
+ ret = Tcl_SetVar2(ptr->ip, RSTRING(varname)->ptr, RSTRING(index)->ptr,
+ RSTRING(value)->ptr, FIX2INT(flag));
+ if (ret == (char*)NULL) {
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ }
+ return(rb_tainted_str_new2(ret));
+ }
+#endif
+}
+
+static VALUE
+ip_unset_variable(self, varname_arg, flag_arg)
+ VALUE self;
+ VALUE varname_arg;
+ VALUE flag_arg;
+{
+ struct tcltkip *ptr = get_ip(self);
+ volatile VALUE varname, value, flag;
+
+ varname = varname_arg;
+ flag = flag_arg;
+
+ StringValue(varname);
+ ptr->return_value = Tcl_UnsetVar(ptr->ip, RSTRING(varname)->ptr,
+ FIX2INT(flag));
+ if (ptr->return_value == TCL_ERROR) {
+ if (FIX2INT(flag) & TCL_LEAVE_ERR_MSG) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
+ }
+ return Qfalse;
+ }
+ return Qtrue;
+}
+
+static VALUE
+ip_unset_variable2(self, varname_arg, index_arg, flag_arg)
+ VALUE self;
+ VALUE varname_arg;
+ VALUE index_arg;
+ VALUE flag_arg;
+{
+ struct tcltkip *ptr = get_ip(self);
+ volatile VALUE varname, index, value, flag;
+
+ if (NIL_P(index_arg)) {
+ return ip_unset_variable(self, varname_arg, flag_arg);
+ }
+
+ varname = varname_arg;
+ index = index_arg;
+ flag = flag_arg;
+
+ StringValue(varname);
+ StringValue(index);
+
+ ptr->return_value = Tcl_UnsetVar2(ptr->ip, RSTRING(varname)->ptr,
+ RSTRING(index)->ptr, FIX2INT(flag));
+ if (ptr->return_value == TCL_ERROR) {
+ if (FIX2INT(flag) & TCL_LEAVE_ERR_MSG) {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(ptr->ip));
+#else /* TCL_MAJOR_VERSION < 8 */
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+#endif
+ }
+ return Qfalse;
+ }
+ return Qtrue;
+}
+
+static VALUE
+ip_get_global_var(self, varname)
+ VALUE self;
+ VALUE varname;
+{
+ return ip_get_variable(self, varname,
+ INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+}
+
+static VALUE
+ip_get_global_var2(self, varname, index)
+ VALUE self;
+ VALUE varname;
+ VALUE index;
+{
+ return ip_get_variable2(self, varname, index,
+ INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+}
+
+static VALUE
+ip_set_global_var(self, varname, value)
+ VALUE self;
+ VALUE varname;
+ VALUE value;
+{
+ return ip_set_variable(self, varname, value,
+ INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+}
+
+static VALUE
+ip_set_global_var2(self, varname, index, value)
+ VALUE self;
+ VALUE varname;
+ VALUE index;
+ VALUE value;
+{
+ return ip_set_variable2(self, varname, index, value,
+ INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+}
+
+static VALUE
+ip_unset_global_var(self, varname)
+ VALUE self;
+ VALUE varname;
+{
+ return ip_unset_variable(self, varname,
+ INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+}
+
+static VALUE
+ip_unset_global_var2(self, varname, index)
+ VALUE self;
+ VALUE varname;
+ VALUE index;
+{
+ return ip_unset_variable2(self, varname, index,
+ INT2FIX(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+}
+
+
+/* treat Tcl_List */
+static VALUE
+lib_split_tklist_core(ip_obj, list_str)
+ VALUE ip_obj;
+ VALUE list_str;
+{
+ Tcl_Interp *interp;
+ volatile VALUE ary, elem;
+ int idx;
+ int taint_flag = OBJ_TAINTED(list_str);
+ int result;
+ VALUE old_gc;
+
+ if (NIL_P(ip_obj)) {
+ interp = (Tcl_Interp *)NULL;
+ } else {
+ interp = get_ip(ip_obj)->ip;
+ }
+
+ StringValue(list_str);
+
+ {
+#if TCL_MAJOR_VERSION >= 8
+ /* object style interface */
+ Tcl_Obj *listobj;
+ int objc;
+ Tcl_Obj **objv;
+ int thr_crit_bup;
+
+# if 1
+# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ listobj = Tcl_NewStringObj(RSTRING(list_str)->ptr,
+ RSTRING(list_str)->len);
+# else /* TCL_VERSION >= 8.1 */
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ {
+ VALUE enc = rb_ivar_get(list_str, ID_at_enc);
+
+ if (!NIL_P(enc) && strcmp(StringValuePtr(enc), "binary") == 0) {
+ /* binary string */
+ listobj = Tcl_NewByteArrayObj(RSTRING(list_str)->ptr,
+ RSTRING(list_str)->len);
+ } else if (strlen(RSTRING(list_str)->ptr)
+ != RSTRING(list_str)->len) {
+ /* probably binary string */
+ listobj = Tcl_NewByteArrayObj(RSTRING(list_str)->ptr,
+ RSTRING(list_str)->len);
+ } else {
+ /* probably text string */
+ listobj = Tcl_NewStringObj(RSTRING(list_str)->ptr,
+ RSTRING(list_str)->len);
+ }
+ }
+
+ rb_thread_critical = thr_crit_bup;
+# endif
+# else
+ listobj = Tcl_NewStringObj(RSTRING(list_str)->ptr,
+ RSTRING(list_str)->len);
+# endif
+
+ Tcl_IncrRefCount(listobj);
+
+ result = Tcl_ListObjGetElements(interp, listobj, &objc, &objv);
+
+ if (result == TCL_ERROR) {
+ Tcl_DecrRefCount(listobj);
+ if (interp == (Tcl_Interp*)NULL) {
+ rb_raise(rb_eRuntimeError, "cannot get elements from list");
+ } else {
+#if TCL_MAJOR_VERSION >= 8
+ rb_raise(rb_eRuntimeError, "%s", Tcl_GetStringResult(interp));
+#else /* TCL_MAJOR_VERSION < 8 */
+ rb_raise(rb_eRuntimeError, "%s", interp->result);
+#endif
+ }
+ }
+
+ for(idx = 0; idx < objc; idx++) {
+ Tcl_IncrRefCount(objv[idx]);
+ }
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ ary = rb_ary_new2(objc);
+ if (taint_flag) OBJ_TAINT(ary);
+
+ old_gc = rb_gc_disable();
+
+ for(idx = 0; idx < objc; idx++) {
+ char *str;
+ int len;
+
+# if 1
+# if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ str = Tcl_GetStringFromObj(objv[idx], &len);
+ elem = rb_str_new(str, len);
+# else /* TCL_VERSION >= 8.1 */
+ if (Tcl_GetCharLength(objv[idx])
+ != Tcl_UniCharLen(Tcl_GetUnicode(objv[idx]))) {
+ /* possibly binary string */
+ str = Tcl_GetByteArrayFromObj(objv[idx], &len);
+ elem = rb_str_new(str, len);
+ rb_ivar_set(elem, ID_at_enc, rb_tainted_str_new2("binary"));
+ } else {
+ /* possibly text string */
+ str = Tcl_GetStringFromObj(objv[idx], &len);
+ elem = rb_str_new(str, len);
+ }
+# endif
+# else
+ str = Tcl_GetStringFromObj(objv[idx], &len);
+ elem = rb_str_new(str, len);
+# endif
+
+ if (taint_flag) OBJ_TAINT(elem);
+ RARRAY(ary)->ptr[idx] = elem;
+ }
+
+ RARRAY(ary)->len = objc;
+
+ if (old_gc == Qfalse) rb_gc_enable();
+
+ rb_thread_critical = thr_crit_bup;
+
+ for(idx = 0; idx < objc; idx++) {
+ Tcl_DecrRefCount(objv[idx]);
+ }
+
+ Tcl_DecrRefCount(listobj);
+
+#else /* TCL_MAJOR_VERSION < 8 */
+ /* string style interface */
+ int argc;
+ char **argv;
+
+ if (Tcl_SplitList(interp, RSTRING(list_str)->ptr,
+ &argc, &argv) == TCL_ERROR) {
+ if (interp == (Tcl_Interp*)NULL) {
+ rb_raise(rb_eRuntimeError, "cannot get elements from list");
+ } else {
+ rb_raise(rb_eRuntimeError, "%s", interp->result);
+ }
+ }
+
+ ary = rb_ary_new2(argc);
+ if (taint_flag) OBJ_TAINT(ary);
+
+ old_gc = rb_gc_disable();
+
+ for(idx = 0; idx < argc; idx++) {
+ if (taint_flag) {
+ elem = rb_tainted_str_new2(argv[idx]);
+ } else {
+ elem = rb_str_new2(argv[idx]);
+ }
+ /* rb_ivar_set(elem, ID_at_enc, rb_str_new2("binary")); */
+ RARRAY(ary)->ptr[idx] = elem;
+ }
+ RARRAY(ary)->len = argc;
+
+ if (old_gc == Qfalse) rb_gc_enable();
+#endif
+ }
+
+ return ary;
+}
+
+static VALUE
+lib_split_tklist(self, list_str)
+ VALUE self;
+ VALUE list_str;
+{
+ return lib_split_tklist_core(Qnil, list_str);
+}
+
+
+static VALUE
+ip_split_tklist(self, list_str)
+ VALUE self;
+ VALUE list_str;
+{
+ return lib_split_tklist_core(self, list_str);
+}
+
+static VALUE
+lib_merge_tklist(argc, argv, obj)
+ int argc;
+ VALUE *argv;
+ VALUE obj;
+{
+ int num, len;
+ int *flagPtr;
+ char *dst, *result;
+ volatile VALUE str;
+ int taint_flag = 0;
+ int thr_crit_bup;
+ VALUE old_gc;
+
+ if (argc == 0) return rb_str_new2("");
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+ old_gc = rb_gc_disable();
+
+ /* based on Tcl/Tk's Tcl_Merge() */
+ flagPtr = ALLOC_N(unsigned, argc);
+
+ /* pass 1 */
+ len = 1;
+ for(num = 0; num < argc; num++) {
+ if (OBJ_TAINTED(argv[num])) taint_flag = 1;
+ dst = StringValuePtr(argv[num]);
+#if TCL_MAJOR_VERSION >= 8
+ len += Tcl_ScanCountedElement(dst, RSTRING(argv[num])->len,
+ &flagPtr[num]) + 1;
+#else /* TCL_MAJOR_VERSION < 8 */
+ len += Tcl_ScanElement(dst, &flagPtr[num]) + 1;
+#endif
+ }
+
+ /* pass 2 */
+ result = (char *)Tcl_Alloc(len);
+ dst = result;
+ for(num = 0; num < argc; num++) {
+#if TCL_MAJOR_VERSION >= 8
+ len = Tcl_ConvertCountedElement(RSTRING(argv[num])->ptr,
+ RSTRING(argv[num])->len,
+ dst, flagPtr[num]);
+#else /* TCL_MAJOR_VERSION < 8 */
+ len = Tcl_ConvertElement(RSTRING(argv[num])->ptr, dst, flagPtr[num]);
+#endif
+ dst += len;
+ *dst = ' ';
+ dst++;
+ }
+ if (dst == result) {
+ *dst = 0;
+ } else {
+ dst[-1] = 0;
+ }
+
+ free(flagPtr);
+
+ /* create object */
+ str = rb_str_new(result, dst - result - 1);
+ if (taint_flag) OBJ_TAINT(str);
+ Tcl_Free(result);
+
+ if (old_gc == Qfalse) rb_gc_enable();
+ rb_thread_critical = thr_crit_bup;
+
+ return str;
+}
+
+static VALUE
+lib_conv_listelement(self, src)
+ VALUE self;
+ VALUE src;
+{
+ int len, scan_flag;
+ volatile VALUE dst;
+ int taint_flag = OBJ_TAINTED(src);
+ int thr_crit_bup;
+
+ thr_crit_bup = rb_thread_critical;
+ rb_thread_critical = Qtrue;
+
+ StringValue(src);
+
+#if TCL_MAJOR_VERSION >= 8
+ len = Tcl_ScanCountedElement(RSTRING(src)->ptr, RSTRING(src)->len,
+ &scan_flag);
+ dst = rb_str_new(0, len + 1);
+ len = Tcl_ConvertCountedElement(RSTRING(src)->ptr, RSTRING(src)->len,
+ RSTRING(dst)->ptr, scan_flag);
+#else /* TCL_MAJOR_VERSION < 8 */
+ len = Tcl_ScanElement(RSTRING(src)->ptr, &scan_flag);
+ dst = rb_str_new(0, len + 1);
+ len = Tcl_ConvertElement(RSTRING(src)->ptr, RSTRING(dst)->ptr, scan_flag);
+#endif
+
+ RSTRING(dst)->len = len;
+ RSTRING(dst)->ptr[len] = '\0';
+ if (taint_flag) OBJ_TAINT(dst);
+
+ rb_thread_critical = thr_crit_bup;
+
+ return dst;
+}
+
+
#ifdef __MACOS__
static void
_macinit()
@@ -2313,18 +5090,40 @@ _macinit()
void
Init_tcltklib()
{
+ int thr_crit_bup;
+
VALUE lib = rb_define_module("TclTkLib");
VALUE ip = rb_define_class("TclTkIp", rb_cObject);
VALUE ev_flag = rb_define_module_under(lib, "EventFlag");
+ VALUE var_flag = rb_define_module_under(lib, "VarAccessFlag");
+
+ /* --------------------------------------------------------------- */
#if defined USE_TCL_STUBS && defined USE_TK_STUBS
extern int ruby_tcltk_stubs();
int ret = ruby_tcltk_stubs();
+
if (ret)
rb_raise(rb_eLoadError, "tcltklib: tcltk_stubs init error(%d)", ret);
#endif
+ /* --------------------------------------------------------------- */
+
+ rb_global_variable(&eTkCallbackReturn);
+ rb_global_variable(&eTkCallbackBreak);
+ rb_global_variable(&eTkCallbackContinue);
+
+ rb_global_variable(&eventloop_thread);
+ rb_global_variable(&watchdog_thread);
+
+ /* --------------------------------------------------------------- */
+
+ rb_define_const(lib, "FINALIZE_PROC_NAME",
+ rb_str_new2(finalize_hook_name));
+
+ /* --------------------------------------------------------------- */
+
rb_define_const(ev_flag, "NONE", INT2FIX(0));
rb_define_const(ev_flag, "WINDOW", INT2FIX(TCL_WINDOW_EVENTS));
rb_define_const(ev_flag, "FILE", INT2FIX(TCL_FILE_EVENTS));
@@ -2333,10 +5132,56 @@ Init_tcltklib()
rb_define_const(ev_flag, "ALL", INT2FIX(TCL_ALL_EVENTS));
rb_define_const(ev_flag, "DONT_WAIT", INT2FIX(TCL_DONT_WAIT));
+ /* --------------------------------------------------------------- */
+
+ rb_define_const(var_flag, "NONE", INT2FIX(0));
+ rb_define_const(var_flag, "GLOBAL_ONLY", INT2FIX(TCL_GLOBAL_ONLY));
+#ifdef TCL_NAMESPACE_ONLY
+ rb_define_const(var_flag, "NAMESPACE_ONLY", INT2FIX(TCL_NAMESPACE_ONLY));
+#else /* probably Tcl7.6 */
+ rb_define_const(var_flag, "NAMESPACE_ONLY", INT2FIX(0));
+#endif
+ rb_define_const(var_flag, "LEAVE_ERR_MSG", INT2FIX(TCL_LEAVE_ERR_MSG));
+ rb_define_const(var_flag, "APPEND_VALUE", INT2FIX(TCL_APPEND_VALUE));
+ rb_define_const(var_flag, "LIST_ELEMENT", INT2FIX(TCL_LIST_ELEMENT));
+#ifdef TCL_PARSE_PART1
+ rb_define_const(var_flag, "PARSE_VARNAME", INT2FIX(TCL_PARSE_PART1));
+#else /* probably Tcl7.6 */
+ rb_define_const(var_flag, "PARSE_VARNAME", INT2FIX(0));
+#endif
+
+ /* --------------------------------------------------------------- */
+
+ eTkCallbackBreak = rb_define_class("TkCallbackReturn", rb_eStandardError);
eTkCallbackBreak = rb_define_class("TkCallbackBreak", rb_eStandardError);
eTkCallbackContinue = rb_define_class("TkCallbackContinue",
rb_eStandardError);
+ /* --------------------------------------------------------------- */
+
+ eLocalJumpError = rb_const_get(rb_cObject, rb_intern("LocalJumpError"));
+
+ ID_at_enc = rb_intern("@encoding");
+ ID_at_interp = rb_intern("@interp");
+
+ ID_stop_p = rb_intern("stop?");
+ ID_kill = rb_intern("kill");
+ ID_join = rb_intern("join");
+
+ ID_call = rb_intern("call");
+ ID_backtrace = rb_intern("backtrace");
+ ID_message = rb_intern("message");
+
+ ID_at_reason = rb_intern("@reason");
+ ID_return = rb_intern("return");
+ ID_break = rb_intern("break");
+ ID_next = rb_intern("next");
+
+ ID_to_s = rb_intern("to_s");
+ ID_inspect = rb_intern("inspect");
+
+ /* --------------------------------------------------------------- */
+
rb_define_module_function(lib, "mainloop", lib_mainloop, -1);
rb_define_module_function(lib, "mainloop_watchdog",
lib_mainloop_watchdog, -1);
@@ -2351,11 +5196,27 @@ Init_tcltklib()
rb_define_module_function(lib, "get_no_event_wait", get_no_event_wait, 0);
rb_define_module_function(lib, "set_eventloop_weight",
set_eventloop_weight, 2);
+ rb_define_module_function(lib, "set_max_block_time", set_max_block_time,1);
rb_define_module_function(lib, "get_eventloop_weight",
get_eventloop_weight, 0);
rb_define_module_function(lib, "num_of_mainwindows",
lib_num_of_mainwindows, 0);
+ /* --------------------------------------------------------------- */
+
+ rb_define_module_function(lib, "_split_tklist", lib_split_tklist, 1);
+ rb_define_module_function(lib, "_merge_tklist", lib_merge_tklist, -1);
+ rb_define_module_function(lib, "_conv_listelement",
+ lib_conv_listelement, 1);
+ rb_define_module_function(lib, "_toUTF8", lib_toUTF8, -1);
+ rb_define_module_function(lib, "_fromUTF8", lib_fromUTF8, -1);
+ rb_define_module_function(lib, "_subst_UTF_backslash",
+ lib_UTF_backslash, 1);
+ rb_define_module_function(lib, "_subst_Tcl_backslash",
+ lib_Tcl_backslash, 1);
+
+ /* --------------------------------------------------------------- */
+
rb_define_alloc_func(ip, ip_alloc);
rb_define_method(ip, "initialize", ip_init, -1);
rb_define_method(ip, "create_slave", ip_create_slave, -1);
@@ -2364,13 +5225,36 @@ Init_tcltklib()
rb_define_method(ip, "delete", ip_delete, 0);
rb_define_method(ip, "deleted?", ip_is_deleted_p, 0);
rb_define_method(ip, "_eval", ip_eval, 1);
- rb_define_method(ip, "_toUTF8",ip_toUTF8, 2);
- rb_define_method(ip, "_fromUTF8",ip_fromUTF8, 2);
+ rb_define_method(ip, "_toUTF8", ip_toUTF8, -1);
+ rb_define_method(ip, "_fromUTF8", ip_fromUTF8, -1);
rb_define_method(ip, "_thread_vwait", ip_thread_vwait, 1);
rb_define_method(ip, "_thread_tkwait", ip_thread_tkwait, 2);
rb_define_method(ip, "_invoke", ip_invoke, -1);
rb_define_method(ip, "_return_value", ip_retval, 0);
+ /* --------------------------------------------------------------- */
+
+ rb_define_method(ip, "_get_variable", ip_get_variable, 2);
+ rb_define_method(ip, "_get_variable2", ip_get_variable2, 3);
+ rb_define_method(ip, "_set_variable", ip_set_variable, 3);
+ rb_define_method(ip, "_set_variable2", ip_set_variable2, 4);
+ rb_define_method(ip, "_unset_variable", ip_unset_variable, 2);
+ rb_define_method(ip, "_unset_variable2", ip_unset_variable2, 3);
+ rb_define_method(ip, "_get_global_var", ip_get_global_var, 1);
+ rb_define_method(ip, "_get_global_var2", ip_get_global_var2, 2);
+ rb_define_method(ip, "_set_global_var", ip_set_global_var, 2);
+ rb_define_method(ip, "_set_global_var2", ip_set_global_var2, 3);
+ rb_define_method(ip, "_unset_global_var", ip_unset_global_var, 1);
+ rb_define_method(ip, "_unset_global_var2", ip_unset_global_var2, 2);
+
+ /* --------------------------------------------------------------- */
+
+ rb_define_method(ip, "_split_tklist", ip_split_tklist, 1);
+ rb_define_method(ip, "_merge_tklist", lib_merge_tklist, -1);
+ rb_define_method(ip, "_conv_listelement", lib_conv_listelement, 1);
+
+ /* --------------------------------------------------------------- */
+
rb_define_method(ip, "mainloop", ip_mainloop, -1);
rb_define_method(ip, "mainloop_watchdog", ip_mainloop_watchdog, -1);
rb_define_method(ip, "do_one_event", ip_do_one_event, -1);
@@ -2384,19 +5268,25 @@ Init_tcltklib()
rb_define_method(ip, "get_no_event_wait", ip_get_no_event_wait, 0);
rb_define_method(ip, "set_eventloop_weight", ip_set_eventloop_weight, 2);
rb_define_method(ip, "get_eventloop_weight", ip_get_eventloop_weight, 0);
+ rb_define_method(ip, "set_max_block_time", set_max_block_time, 1);
rb_define_method(ip, "restart", ip_restart, 0);
+ /* --------------------------------------------------------------- */
+
eventloop_thread = 0;
watchdog_thread = 0;
+ /* --------------------------------------------------------------- */
+
#ifdef __MACOS__
_macinit();
#endif
- /*---- initialize tcl/tk libraries ----*/
/* from Tk_Main() */
DUMP1("Tcl_FindExecutable");
Tcl_FindExecutable(RSTRING(rb_argv0)->ptr);
+
+ /* --------------------------------------------------------------- */
}
/* eof */
diff --git a/ext/tk/MANIFEST b/ext/tk/MANIFEST
index 503adaabb7..32d8029de1 100644
--- a/ext/tk/MANIFEST
+++ b/ext/tk/MANIFEST
@@ -1,5 +1,6 @@
MANIFEST
README.1st
+README.fork
extconf.rb
depend
tkutil.c
@@ -22,6 +23,77 @@ lib/tkscrollbox.rb
lib/tktext.rb
lib/tkvirtevent.rb
lib/tkwinpkg.rb
+lib/tk/after.rb
+lib/tk/autoload.rb
+lib/tk/bgerror.rb
+lib/tk/bindtag.rb
+lib/tk/button.rb
+lib/tk/canvas.rb
+lib/tk/canvastag.rb
+lib/tk/checkbutton.rb
+lib/tk/clipboard.rb
+lib/tk/clock.rb
+lib/tk/composite.rb
+lib/tk/console.rb
+lib/tk/dialog.rb
+lib/tk/encodedstr.rb
+lib/tk/entry.rb
+lib/tk/event.rb
+lib/tk/font.rb
+lib/tk/frame.rb
+lib/tk/grid.rb
+lib/tk/image.rb
+lib/tk/itemfont.rb
+lib/tk/kinput.rb
+lib/tk/label.rb
+lib/tk/labelframe.rb
+lib/tk/listbox.rb
+lib/tk/macpkg.rb
+lib/tk/menu.rb
+lib/tk/menubar.rb
+lib/tk/message.rb
+lib/tk/mngfocus.rb
+lib/tk/msgcat.rb
+lib/tk/namespace.rb
+lib/tk/optiondb.rb
+lib/tk/pack.rb
+lib/tk/package.rb
+lib/tk/palette.rb
+lib/tk/panedwindow.rb
+lib/tk/place.rb
+lib/tk/radiobutton.rb
+lib/tk/root.rb
+lib/tk/scale.rb
+lib/tk/scrollable.rb
+lib/tk/scrollbar.rb
+lib/tk/scrollbox.rb
+lib/tk/selection.rb
+lib/tk/spinbox.rb
+lib/tk/tagfont.rb
+lib/tk/text.rb
+lib/tk/textimage.rb
+lib/tk/textmark.rb
+lib/tk/texttag.rb
+lib/tk/textwindow.rb
+lib/tk/timer.rb
+lib/tk/toplevel.rb
+lib/tk/txtwin_abst.rb
+lib/tk/validation.rb
+lib/tk/variable.rb
+lib/tk/virtevent.rb
+lib/tk/winfo.rb
+lib/tk/winpkg.rb
+lib/tk/wm.rb
+lib/tk/xim.rb
+sample/binding_sample.rb
+sample/bindtag_sample.rb
+sample/binstr_usage.rb
+sample/btn_with_frame.rb
+sample/encstr_usage.rb
+sample/iso2022-kr.txt
+sample/propagate.rb
+sample/resource.en
+sample/resource.ja
sample/safe-tk.rb
sample/tkalignbox.rb
sample/tkballoonhelp.rb
@@ -33,20 +105,22 @@ sample/tkfrom.rb
sample/tkhello.rb
sample/tkline.rb
sample/tkmenubutton.rb
+sample/tkmsgcat-load_rb.rb
+sample/tkmsgcat-load_rb2.rb
+sample/tkmsgcat-load_tk.rb
sample/tkmulticolumnlist.rb
sample/tkmultilistbox.rb
sample/tkmultilistframe.rb
sample/tkoptdb-safeTk.rb
sample/tkoptdb.rb
sample/tktextframe.rb
-sample/resource.ja
-sample/resource.en
sample/tktimer.rb
sample/tktimer2.rb
sample/tktimer3.rb
sample/demos-en/ChangeLog
sample/demos-en/ChangeLog.prev
sample/demos-en/README
+sample/demos-en/README.1st
sample/demos-en/README.tkencoding
sample/demos-en/arrow.rb
sample/demos-en/bind.rb
@@ -55,6 +129,7 @@ sample/demos-en/browse1
sample/demos-en/browse2
sample/demos-en/button.rb
sample/demos-en/check.rb
+sample/demos-en/check2.rb
sample/demos-en/clrpick.rb
sample/demos-en/colors.rb
sample/demos-en/cscroll.rb
@@ -71,6 +146,7 @@ sample/demos-en/entry2.rb
sample/demos-en/entry3.rb
sample/demos-en/filebox.rb
sample/demos-en/floor.rb
+sample/demos-en/floor2.rb
sample/demos-en/form.rb
sample/demos-en/hello
sample/demos-en/hscale.rb
@@ -78,19 +154,6 @@ sample/demos-en/icon.rb
sample/demos-en/image1.rb
sample/demos-en/image2.rb
sample/demos-en/image3.rb
-sample/demos-en/images/earth.gif
-sample/demos-en/images/earthris.gif
-sample/demos-en/images/face.xbm
-sample/demos-en/images/flagdown.xbm
-sample/demos-en/images/flagup.xbm
-sample/demos-en/images/gray25.xbm
-sample/demos-en/images/grey.25
-sample/demos-en/images/grey.5
-sample/demos-en/images/letters.xbm
-sample/demos-en/images/noletter.xbm
-sample/demos-en/images/pattern.xbm
-sample/demos-en/images/tcllogo.gif
-sample/demos-en/images/teapot.ppm
sample/demos-en/items.rb
sample/demos-en/ixset
sample/demos-en/ixset2
@@ -107,6 +170,7 @@ sample/demos-en/plot.rb
sample/demos-en/puzzle.rb
sample/demos-en/radio.rb
sample/demos-en/radio2.rb
+sample/demos-en/radio3.rb
sample/demos-en/rmt
sample/demos-en/rolodex
sample/demos-en/rolodex-j
@@ -123,6 +187,7 @@ sample/demos-en/text.rb
sample/demos-en/timer
sample/demos-en/tkencoding.rb
sample/demos-en/twind.rb
+sample/demos-en/twind2.rb
sample/demos-en/unicodeout.rb
sample/demos-en/vscale.rb
sample/demos-en/widget
@@ -134,6 +199,7 @@ sample/demos-jp/browse1
sample/demos-jp/browse2
sample/demos-jp/button.rb
sample/demos-jp/check.rb
+sample/demos-jp/check2.rb
sample/demos-jp/clrpick.rb
sample/demos-jp/colors.rb
sample/demos-jp/cscroll.rb
@@ -150,6 +216,7 @@ sample/demos-jp/entry2.rb
sample/demos-jp/entry3.rb
sample/demos-jp/filebox.rb
sample/demos-jp/floor.rb
+sample/demos-jp/floor2.rb
sample/demos-jp/form.rb
sample/demos-jp/hello
sample/demos-jp/hscale.rb
@@ -157,19 +224,6 @@ sample/demos-jp/icon.rb
sample/demos-jp/image1.rb
sample/demos-jp/image2.rb
sample/demos-jp/image3.rb
-sample/demos-jp/images/earth.gif
-sample/demos-jp/images/earthris.gif
-sample/demos-jp/images/face.bmp
-sample/demos-jp/images/flagdown.bmp
-sample/demos-jp/images/flagup.bmp
-sample/demos-jp/images/gray25.bmp
-sample/demos-jp/images/grey.25
-sample/demos-jp/images/grey.5
-sample/demos-jp/images/letters.bmp
-sample/demos-jp/images/noletter.bmp
-sample/demos-jp/images/pattern.bmp
-sample/demos-jp/images/tcllogo.gif
-sample/demos-jp/images/teapot.ppm
sample/demos-jp/items.rb
sample/demos-jp/ixset
sample/demos-jp/ixset2
@@ -186,6 +240,7 @@ sample/demos-jp/plot.rb
sample/demos-jp/puzzle.rb
sample/demos-jp/radio.rb
sample/demos-jp/radio2.rb
+sample/demos-jp/radio3.rb
sample/demos-jp/rmt
sample/demos-jp/rolodex
sample/demos-jp/rolodex-j
@@ -200,6 +255,51 @@ sample/demos-jp/tcolor
sample/demos-jp/text.rb
sample/demos-jp/timer
sample/demos-jp/twind.rb
+sample/demos-jp/twind2.rb
sample/demos-jp/unicodeout.rb
sample/demos-jp/vscale.rb
sample/demos-jp/widget
+sample/images/earth.gif
+sample/images/earthris.gif
+sample/images/face.xbm
+sample/images/flagdown.xbm
+sample/images/flagup.xbm
+sample/images/gray25.xbm
+sample/images/grey.25
+sample/images/grey.5
+sample/images/letters.xbm
+sample/images/noletter.xbm
+sample/images/pattern.xbm
+sample/images/tcllogo.gif
+sample/images/teapot.ppm
+sample/msgs_rb/README
+sample/msgs_rb/cs.msg
+sample/msgs_rb/de.msg
+sample/msgs_rb/el.msg
+sample/msgs_rb/en.msg
+sample/msgs_rb/en_gb.msg
+sample/msgs_rb/eo.msg
+sample/msgs_rb/es.msg
+sample/msgs_rb/fr.msg
+sample/msgs_rb/it.msg
+sample/msgs_rb/ja.msg
+sample/msgs_rb/nl.msg
+sample/msgs_rb/pl.msg
+sample/msgs_rb/ru.msg
+sample/msgs_rb2/README
+sample/msgs_rb2/de.msg
+sample/msgs_rb2/ja.msg
+sample/msgs_tk/README
+sample/msgs_tk/cs.msg
+sample/msgs_tk/de.msg
+sample/msgs_tk/el.msg
+sample/msgs_tk/en.msg
+sample/msgs_tk/en_gb.msg
+sample/msgs_tk/eo.msg
+sample/msgs_tk/es.msg
+sample/msgs_tk/fr.msg
+sample/msgs_tk/it.msg
+sample/msgs_tk/ja.msg
+sample/msgs_tk/nl.msg
+sample/msgs_tk/pl.msg
+sample/msgs_tk/ru.msg
diff --git a/ext/tk/README.fork b/ext/tk/README.fork
new file mode 100644
index 0000000000..cda89b003c
--- /dev/null
+++ b/ext/tk/README.fork
@@ -0,0 +1,29 @@
+Ruby/Tk does NOT support forking the process on which Tk interpreter
+is running (unless NEVER control Tk interpreter under the forked child
+process). In the library 'tk.rb', a Tk interpreter is initialized.
+Therefore, if you want running Tk under a child process, please call
+"require 'tk'" in the child process.
+
+For example, the following sample1 will NOT work, and sample2 will
+work properly.
+
+---<sample1: NOT work>---------------------------------------
+require 'tk' ## init Tk interpreter under parent process
+
+exit! if fork ## exit parent process
+
+## child process
+TkButton.new(:text=>'QUIT', :command=>proc{exit}).pack
+Tk.mainloop
+-------------------------------------------------------------
+
+---<sample2: will work>--------------------------------------
+exit! if fork ## exit main process
+
+## child process
+require 'tk' ## init Tk interpreter under child process
+TkButton.new(:text=>'QUIT', :command=>proc{exit}).pack
+Tk.mainloop
+-------------------------------------------------------------
+
+ 2004/04/20 Hidetoshi NAGAI
diff --git a/ext/tk/extconf.rb b/ext/tk/extconf.rb
index f769b06e30..4f87d527ae 100644
--- a/ext/tk/extconf.rb
+++ b/ext/tk/extconf.rb
@@ -1,2 +1,3 @@
require 'mkmf'
+$preload = ["tcltklib"]
create_makefile("tkutil")
diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb
index c2dcb4f971..a3cd3857a0 100644
--- a/ext/tk/lib/multi-tk.rb
+++ b/ext/tk/lib/multi-tk.rb
@@ -3,6 +3,7 @@
# by Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp>
require 'tcltklib'
+require 'tkutil'
require 'thread'
################################################
@@ -13,7 +14,6 @@ TclTkLib.mainloop_abort_on_exception = true
# TclTkLib.mainloop_abort_on_exception = nil
-
################################################
# exceptiopn to treat the return value from IP
class MultiTkIp_OK < Exception
@@ -48,12 +48,15 @@ class MultiTkIp
######################################
- @@CB_ENTRY_CLASS = Class.new{|c|
+ @@CB_ENTRY_CLASS = Class.new(TkCallbackEntry){|c|
def initialize(ip, cmd)
@ip = ip
@cmd = cmd
end
attr_reader :ip, :cmd
+ def inspect
+ cmd.inspect
+ end
def call(*args)
begin
unless @ip.deleted?
@@ -68,8 +71,11 @@ class MultiTkIp
######################################
- def _keys2opts(keys)
- keys.collect{|k,v| "-#{k} #{v}"}.join(' ')
+ def _keys2opts(src_keys)
+ return nil if src_keys == nil
+ keys = {}; src_keys.each{|k, v| keys[k.to_s] = v}
+ #keys.collect{|k,v| "-#{k} #{v}"}.join(' ')
+ keys.collect{|k,v| "-#{k} #{TclTkLib._conv_listelement(TkComm::_get_eval_string(v))}"}.join(' ')
end
private :_keys2opts
@@ -136,10 +142,11 @@ class MultiTkIp
rescue SystemExit
# delete IP
unless @interp.deleted?
- if @interp._invoke('info', 'command', '.') != ""
- @interp._invoke('destroy', '.')
- end
- @interp.delete
+ # if @interp._invoke('info', 'command', '.') != ""
+ # @interp._invoke('destroy', '.')
+ # end
+ # @interp.delete
+ @interp._eval_without_enc('exit')
end
_check_and_return(thread, MultiTkIp_OK.new(nil))
break
@@ -200,14 +207,14 @@ class MultiTkIp
@@DEFAULT_MASTER = self.allocate
@@DEFAULT_MASTER.instance_eval{
- @encoding = [].taint
-
@tk_windows = {}.taint
@tk_table_list = [].taint
@slave_ip_tbl = {}.taint
+ @slave_ip_top = {}.taint
+
unless keys.kind_of? Hash
fail ArgumentError, "expecting a Hash object for the 2nd argument"
end
@@ -274,23 +281,28 @@ class MultiTkIp
tk_opts = {}
keys.each{|k,v|
- if k.to_s == 'name'
+ k_str = k.to_s
+ if k_str == 'name'
name = v
- elsif k.to_s == 'safe'
+ elsif k_str == 'safe'
safe = v
- elsif SAFE_OPT_LIST.member?(k.to_s)
- safe_opts[k] = v
+ elsif SAFE_OPT_LIST.member?(k_str)
+ safe_opts[k_str] = v
else
- tk_opts[k] = v
+ tk_opts[k_str] = v
end
}
- [name, safe, safe_opts, tk_opts]
+ if keys['without_tk'] || keys[:without_tk]
+ [name, safe, safe_opts, nil]
+ else
+ [name, safe, safe_opts, tk_opts]
+ end
end
private :_parse_slaveopts
def _create_slave_ip_name
- name = SLAVE_IP_ID.join
+ name = SLAVE_IP_ID.join('')
SLAVE_IP_ID[1].succ!
name
end
@@ -388,14 +400,18 @@ class MultiTkIp
# procedure to delete slave interpreter
slave_delete_proc = proc{
unless slave_ip.deleted?
- if slave_ip._invoke('info', 'command', '.') != ""
- slave_ip._invoke('destroy', '.')
- end
- slave_ip.delete
+ #if slave_ip._invoke('info', 'command', '.') != ""
+ # slave_ip._invoke('destroy', '.')
+ #end
+ #slave_ip.delete
+ slave_ip._eval_without_enc('exit')
end
+ top.destroy if top.winfo_exist?
}
tag = TkBindTag.new.bind('Destroy', slave_delete_proc)
+ top.bindtags = top.bindtags.unshift(tag)
+
# create control frame
TkFrame.new(top, :bg=>'red', :borderwidth=>3, :relief=>'ridge') {|fc|
fc.bindtags = fc.bindtags.unshift(tag)
@@ -421,23 +437,45 @@ class MultiTkIp
# return keys
loadTk_keys['use'] = TkWinfo.id(c)
- loadTk_keys
+ [loadTk_keys, top.path]
end
private :__create_safetk_frame
def __create_safe_slave_obj(safe_opts, app_name, tk_opts)
# safe interpreter
- # at present, not enough support for '-deleteHook' option
ip_name = _create_slave_ip_name
slave_ip = @interp.create_slave(ip_name, true)
- @interp._eval("::safe::interpInit #{ip_name} "+_keys2opts(safe_opts))
- tk_opts = __check_safetk_optkeys(tk_opts)
- unless tk_opts.key?('use')
- tk_opts = __create_safetk_frame(slave_ip, ip_name, app_name, tk_opts)
- end
- slave_ip._invoke('set', 'argv0', app_name) if app_name.kind_of?(String)
- @interp._eval("::safe::loadTk #{ip_name} #{_keys2opts(tk_opts)}")
@slave_ip_tbl[ip_name] = slave_ip
+
+ @interp._eval("::safe::interpInit #{ip_name}")
+
+ slave_ip._invoke('set', 'argv0', app_name) if app_name.kind_of?(String)
+
+ if tk_opts
+ tk_opts = __check_safetk_optkeys(tk_opts)
+ if tk_opts.key?('use')
+ @slave_ip_top[ip_name] = ''
+ else
+ tk_opts, top_path = __create_safetk_frame(slave_ip, ip_name, app_name,
+ tk_opts)
+ @slave_ip_top[ip_name] = top_path
+ end
+ @interp._eval("::safe::loadTk #{ip_name} #{_keys2opts(tk_opts)}")
+ else
+ @slave_ip_top[ip_name] = nil
+ end
+
+ if safe_opts.key?('deleteHook') || safe_opts.key?(:deleteHook)
+ @interp._eval("::safe::interpConfigure #{ip_name} " +
+ _keys2opts(safe_opts))
+ else
+ @interp._eval("::safe::interpConfigure #{ip_name} " +
+ _keys2opts(safe_opts) + '-deleteHook {' +
+ TkComm._get_eval_string(proc{|slave|
+ self._default_delete_hook(slave)
+ }) + '}')
+ end
+
[slave_ip, ip_name]
end
@@ -481,15 +519,15 @@ class MultiTkIp
fail ArgumentError, "expecting a Hash object for the 2nd argument"
end
- @encoding = []
@tk_windows = {}
@tk_table_list = []
@slave_ip_tbl = {}
+ @slave_ip_top = {}
- @encoding.taint unless @encoding.tainted?
@tk_windows.taint unless @tk_windows.tainted?
@tk_table_list.taint unless @tk_table_list.tainted?
@slave_ip_tbl.taint unless @slave_ip_tbl.tainted?
+ @slave_ip_top.taint unless @slave_ip_top.tainted?
name, safe, safe_opts, tk_opts = _parse_slaveopts(keys)
@@ -532,6 +570,34 @@ class MultiTkIp
self.freeze # defend against modification
end
+
+ ######################################
+
+ def _default_delete_hook(slave)
+ if @slave_ip_top[slave].kind_of?(String)
+ # call default hook of safetk.tcl (ignore exceptions)
+ if @slave_ip_top[slave] == ''
+ begin
+ @interp._eval("::safe::disallowTk #{slave}")
+ rescue
+ warn("Waring: fail to call '::safe::disallowTk'") if $DEBUG
+ end
+ else # toplevel path
+ begin
+ @interp._eval("::safe::tkDelete {} #{@slave_ip_top[slave]} #{slave}")
+ rescue
+ warn("Waring: fail to call '::safe::tkDelete'") if $DEBUG
+ begin
+ @interp._eval("destroy #{@slave_ip_top[slave]}")
+ rescue
+ warn("Waring: fail to destroy toplevel") if $DEBUG
+ end
+ end
+ end
+ end
+ @slave_ip_tbl.delete(slave)
+ @slave_ip_top.delete(slave)
+ end
end
@@ -796,6 +862,10 @@ class MultiTkIp
rescue SystemExit
# exit IP
warn("Warning: "+ $! + " on " + self.inspect) if $DEBUG
+ begin
+ self._eval_without_enc('exit')
+ rescue Exception
+ end
self.delete
ret = nil
rescue Exception => e
@@ -823,6 +893,10 @@ class MultiTkIp
rescue SystemExit
# exit IP
warn("Warning: " + $! + " on " + self.inspect) if $DEBUG
+ begin
+ self._eval_without_enc('exit')
+ rescue Exception
+ end
self.delete
rescue Exception => e
# others --> warning
@@ -868,10 +942,12 @@ class << MultiTkIp
__getip.do_one_event(flag)
end
def mainloop_abort_on_exception
- __getip.mainloop_abort_on_exception
+ # __getip.mainloop_abort_on_exception
+ TclTkLib.mainloop_abort_on_exception
end
def mainloop_abort_on_exception=(mode)
- __getip.mainloop_abort_on_exception=(mode)
+ # __getip.mainloop_abort_on_exception=(mode)
+ TclTkLib.mainloop_abort_on_exception=(mode)
end
def set_eventloop_tick(tick)
__getip.set_eventloop_tick(tick)
@@ -919,6 +995,22 @@ class << MultiTkIp
__getip._invoke(*args)
end
+ def _eval_without_enc(str)
+ __getip._eval_without_enc(str)
+ end
+
+ def _invoke_without_enc(*args)
+ __getip._invoke_without_enc(*args)
+ end
+
+ def _eval_with_enc(str)
+ __getip._eval_with_enc(str)
+ end
+
+ def _invoke_with_enc(*args)
+ __getip._invoke_with_enc(*args)
+ end
+
def _toUTF8(str, encoding)
__getip._toUTF8(str, encoding)
end
@@ -938,6 +1030,54 @@ class << MultiTkIp
def _return_value
__getip._return_value
end
+
+ def _get_variable(var, flag)
+ __getip._get_variable(var, flag)
+ end
+ def _get_variable2(var, idx, flag)
+ __getip._get_variable2(var, idx, flag)
+ end
+ def _set_variable(var, value, flag)
+ __getip._set_variable(var, value, flag)
+ end
+ def _set_variable2(var, idx, value, flag)
+ __getip._set_variable2(var, idx, value, flag)
+ end
+ def _unset_variable(var, flag)
+ __getip._unset_variable(var, flag)
+ end
+ def _unset_variable2(var, idx, flag)
+ __getip._unset_variable2(var, idx, flag)
+ end
+
+ def _get_global_var(var)
+ __getip._get_global_var(var)
+ end
+ def _get_global_var2(var, idx)
+ __getip._get_global_var2(var, idx)
+ end
+ def _set_global_var(var, value)
+ __getip._set_global_var(var, value)
+ end
+ def _set_global_var2(var, idx, value)
+ __getip._set_global_var2(var, idx, value)
+ end
+ def _unset_global_var(var)
+ __getip._unset_global_var(var)
+ end
+ def _unset_global_var2(var, idx)
+ __getip._unset_global_var2(var, idx)
+ end
+
+ def _split_tklist(str)
+ __getip._split_tklist(str)
+ end
+ def _merge_tklist(*args)
+ __getip._merge_tklist(*args)
+ end
+ def _conv_listelement(arg)
+ __getip._conv_listelement(arg)
+ end
end
@@ -952,12 +1092,12 @@ class << TclTkLib
def do_one_event(flag = TclTkLib::EventFlag::ALL)
MultiTkIp.do_one_event(flag)
end
- def mainloop_abort_on_exception
- MultiTkIp.mainloop_abort_on_exception
- end
- def mainloop_abort_on_exception=(mode)
- MultiTkIp.mainloop_abort_on_exception=(mode)
- end
+ #def mainloop_abort_on_exception
+ # MultiTkIp.mainloop_abort_on_exception
+ #end
+ #def mainloop_abort_on_exception=(mode)
+ # MultiTkIp.mainloop_abort_on_exception=(mode)
+ #end
def set_eventloop_tick(tick)
MultiTkIp.set_eventloop_tick(tick)
end
@@ -979,12 +1119,19 @@ class << TclTkLib
def restart
MultiTkIp.restart
end
+
+ def _merge_tklist(*args)
+ MultiTkIp._merge_tklist(*args)
+ end
+ def _conv_listelement(arg)
+ MultiTkIp._conv_listelement(arg)
+ end
end
# depend on TclTkIp
class MultiTkIp
- def mainloop(check_root = true, restart_on_dead = true)
+ def mainloop(check_root = true, restart_on_dead = false)
return self if self.slave?
unless restart_on_dead
@interp.mainloop(check_root)
@@ -1022,6 +1169,10 @@ class MultiTkIp
end
def delete
+ if safe?
+ # do 'exit' to call the delete_hook procedure
+ @interp._eval_without_enc('exit')
+ end
@interp.delete
end
@@ -1041,6 +1192,22 @@ class MultiTkIp
@interp._invoke(*args)
end
+ def _eval_without_enc(str)
+ @interp._eval_without_enc(str)
+ end
+
+ def _invoke_without_enc(*args)
+ @interp._invoke_without_enc(*args)
+ end
+
+ def _eval_with_enc(str)
+ @interp._eval_with_enc(str)
+ end
+
+ def _invoke_with_enc(*args)
+ @interp._invoke_with_enc(*args)
+ end
+
def _toUTF8(str, encoding)
@interp._toUTF8(str, encoding)
end
@@ -1060,6 +1227,54 @@ class MultiTkIp
def _return_value
@interp._return_value
end
+
+ def _get_variable(var, flag)
+ @interp._get_variable(var, flag)
+ end
+ def _get_variable2(var, idx, flag)
+ @interp._get_variable2(var, idx, flag)
+ end
+ def _set_variable(var, value, flag)
+ @interp._set_variable(var, value, flag)
+ end
+ def _set_variable2(var, idx, value, flag)
+ @interp._set_variable2(var, idx, value, flag)
+ end
+ def _unset_variable(var, flag)
+ @interp._unset_variable(var, flag)
+ end
+ def _unset_variable2(var, idx, flag)
+ @interp._unset_variable2(var, idx, flag)
+ end
+
+ def _get_global_var(var)
+ @interp._get_global_var(var)
+ end
+ def _get_global_var2(var, idx)
+ @interp._get_global_var2(var, idx)
+ end
+ def _set_global_var(var, value)
+ @interp._set_global_var(var, value)
+ end
+ def _set_global_var2(var, idx, value)
+ @interp._set_global_var2(var, idx, value)
+ end
+ def _unset_global_var(var)
+ @interp._unset_global_var(var)
+ end
+ def _unset_global_var2(var, idx)
+ @interp._unset_global_var2(var, idx)
+ end
+
+ def _split_tklist(str)
+ @interp._split_tklist(str)
+ end
+ def _merge_tklist(*args)
+ @interp._merge_tklist(*args)
+ end
+ def _conv_listelement(arg)
+ @interp._conv_listelement(arg)
+ end
end
@@ -1090,7 +1305,7 @@ class MultiTkIp
else
list.push str[0..i-1]
end
- list += tk_split_simplelist(str[i+1..-1])
+ list += _lst2ary(str[i+1..-1])
list
end
private :_lst2ary
@@ -1224,6 +1439,14 @@ class MultiTkIp
self
end
+ def recursion_limit(slave = '', limit = None)
+ number(@interp._invoke('interp', 'recursionlimit',
+ _slavearg(slave), limit))
+ end
+ def self.recursion_limit(slave = '', limit = None)
+ __getip.recursion_limit(slave)
+ end
+
def alias_target(aliascmd, slave = '')
@interp._invoke('interp', 'target', _slavearg(slave), aliascmd)
end
@@ -1309,35 +1532,94 @@ class MultiTkIp
end
-# encoding convert
+# Safe Base :: manipulating safe interpreter
class MultiTkIp
- # from tkencoding.rb by ttate@jaist.ac.jp
- alias __eval _eval
- alias __invoke _invoke
+ def safeip_configure(slave, slot, value=None)
+ # use for '-noStatics' option ==> {statics=>false}
+ # for '-nestedLoadOk' option ==> {nested=>true}
+ if slot.kind_of?(Hash)
+ ip = MultiTkIp.__getip
+ ip._eval('::safe::interpConfigure ' + @ip_name + ' ' +
+ hash_kv(slot).join(' '))
+ else
+ ip._eval('::safe::interpConfigure ' + @ip_name + ' ' +
+ "-#{slot} #{_get_eval_string(value)}")
+ end
+ self
+ end
+
+ def safeip_configinfo(slot = nil)
+ ip = MultiTkIp.__getip
+ ret = {}
+ if slot
+ conf = _lst2ary(ip._eval("::safe::interpConfigure " +
+ @ip_name + " -#{slot}"))
+ if conf[0] == '-deleteHook'
+ if conf[1] =~ /^rb_out (c\d+)/
+ ret[conf[0][1..-1]] = MultiTkIp._tk_cmd_tbl[$1]
+ else
+ ret[conf[0][1..-1]] = conf[1]
+ end
+ else
+ ret[conf[0][1..-1]] = conf[1]
+ end
+ else
+ Hash[*_lst2ary(ip._eval("::safe::interpConfigure " +
+ @ip_name))].each{|k, v|
+ if k == '-deleteHook'
+ if v =~ /^rb_out (c\d+)/
+ ret[k[1..-1]] = MultiTkIp._tk_cmd_tbl[$1]
+ else
+ ret[k[1..-1]] = v
+ end
+ else
+ ret[k[1..-1]] = v
+ end
+ }
+ end
+ ret
+ end
+ def safeip_delete(slave)
+ ip = MultiTkIp.__getip
+ ip._eval("::safe::interpDelete " + @ip_name)
+ end
+
+ def safeip_add_to_access_path(slave, dir)
+ ip = MultiTkIp.__getip
+ ip._eval("::safe::interpAddToAccessPath #{@ip_name} #{dir}")
+ end
+
+ def safeip_find_in_access_path(slave, dir)
+ ip = MultiTkIp.__getip
+ ip._eval("::safe::interpFindInAccessPath #{@ip_name} #{dir}")
+ end
+
+ def safeip_set_log_cmd(slave, cmd = Proc.new)
+ ip = MultiTkIp.__getip
+ ip._eval("::safe::setLogCmd #{@ip_name} #{_get_eval_string(cmd)}")
+ end
+end
+
+
+# encoding convert
+class MultiTkIp
def encoding
- @encoding[0]
+ @interp.encoding
end
def encoding=(enc)
- @encoding[0] = enc
+ @interp.encoding = enc
end
-
- def _eval(cmd)
- if @encoding[0] != nil
- _fromUTF8(__eval(_toUTF8(cmd, @encoding[0])), @encoding[0])
- else
- __eval(cmd)
- end
+
+ def encoding_convertfrom(str, enc=None)
+ @interp.encoding_convertfrom(str, enc)
end
+ alias encoding_convert_from encoding_convertfrom
- def _invoke(*cmds)
- if defined?(@encoding[0]) && @encoding[0] != nil
- cmds = cmds.collect{|cmd| _toUTF8(cmd, @encoding[0])}
- _fromUTF8(__invoke(*cmds), @encoding[0])
- else
- __invoke(*cmds)
- end
+ def encoding_convertto(str, enc=None)
+ @interp.encoding_convertto(str, enc)
end
+ alias encoding_convert_to encoding_convertto
end
diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index f098772a28..36a9e54f2e 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -4,17 +4,30 @@
# by Yukihiro Matsumoto <matz@netlab.jp>
# use Shigehiro's tcltklib
-require "tcltklib"
-require "tkutil"
+require 'tcltklib'
+require 'tkutil'
+# autoload
+require 'tk/autoload'
+
+class TclTkIp
+ # backup original (without encoding) _eval and _invoke
+ alias _eval_without_enc _eval
+ alias _invoke_without_enc _invoke
+end
+
+# define TkComm module (step 1: basic functions)
module TkComm
+ include TkUtil
+ extend TkUtil
+
WidgetClassNames = {}.taint
- None = Object.new
- def None.to_s
- 'None'
- end
- None.freeze
+ # None = Object.new ### --> definition is moved to TkUtil module
+ # def None.to_s
+ # 'None'
+ # end
+ # None.freeze
#Tk_CMDTBL = {}
#Tk_WINDOWS = {}
@@ -36,6 +49,21 @@ module TkComm
@cmdtbl = [].taint
}
+ unless const_defined?(:GET_CONFIGINFO_AS_ARRAY)
+ # GET_CONFIGINFO_AS_ARRAY = false => returns a Hash { opt =>val, ... }
+ # true => returns an Array [[opt,val], ... ]
+ # val is a list which includes resource info.
+ GET_CONFIGINFO_AS_ARRAY = true
+ end
+ unless const_defined?(:GET_CONFIGINFOwoRES_AS_ARRAY)
+ # for configinfo without resource info; list of [opt, value] pair
+ # false => returns a Hash { opt=>val, ... }
+ # true => returns an Array [[opt,val], ... ]
+ GET_CONFIGINFOwoRES_AS_ARRAY = true
+ end
+ # *** ATTENTION ***
+ # 'current_configinfo' method always returns a Hash under all cases of above.
+
def error_at
frames = caller()
frames.delete_if do |c|
@@ -50,7 +78,7 @@ module TkComm
begin
#tk_class = TkCore::INTERP._invoke('winfo', 'class', path)
- tk_class = Tk.ip_invoke('winfo', 'class', path)
+ tk_class = Tk.ip_invoke_without_enc('winfo', 'class', path)
rescue
return path
end
@@ -82,10 +110,16 @@ module TkComm
private :_genobj_for_tkwidget
module_function :_genobj_for_tkwidget
- def tk_tcl2ruby(val)
+ def tk_tcl2ruby(val, enc_mode = nil)
if val =~ /^rb_out (c\d+)/
#return Tk_CMDTBL[$1]
return TkCore::INTERP.tk_cmd_tbl[$1]
+ #cmd_obj = TkCore::INTERP.tk_cmd_tbl[$1]
+ #if cmd_obj.kind_of?(Proc) || cmd_obj.kind_of?(Method)
+ # cmd_obj
+ #else
+ # cmd_obj.cmd
+ #end
end
#if val.include? ?\s
# return val.split.collect{|v| tk_tcl2ruby(v)}
@@ -110,10 +144,76 @@ module TkComm
when /\\ /
val.gsub(/\\ /, ' ')
else
- val
+ if enc_mode
+ _fromUTF8(val)
+ else
+ val
+ end
end
end
+ private :tk_tcl2ruby
+
+unless const_defined?(:USE_TCLs_LIST_FUNCTIONS)
+ USE_TCLs_LIST_FUNCTIONS = true
+end
+
+if USE_TCLs_LIST_FUNCTIONS
+ ###########################################################################
+ # use Tcl function version of split_list
+ ###########################################################################
+
+ def tk_split_escstr(str)
+ TkCore::INTERP._split_tklist(str)
+ end
+
+ def tk_split_sublist(str)
+ return [] if str == ""
+ list = TkCore::INTERP._split_tklist(str)
+ if list.size == 1
+ tk_tcl2ruby(list[0])
+ else
+ list.collect{|token| tk_split_sublist(token)}
+ end
+ end
+
+ def tk_split_list(str)
+ return [] if str == ""
+ TkCore::INTERP._split_tklist(str).collect{|token| tk_split_sublist(token)}
+ end
+
+ def tk_split_simplelist(str)
+ #lst = TkCore::INTERP._split_tklist(str)
+ #if (lst.size == 1 && lst =~ /^\{.*\}$/)
+ # TkCore::INTERP._split_tklist(str[1..-2])
+ #else
+ # lst
+ #end
+ TkCore::INTERP._split_tklist(str)
+ end
+
+ def array2tk_list(ary)
+ return "" if ary.size == 0
+
+ dst = ary.collect{|e|
+ if e.kind_of? Array
+ array2tk_list(e)
+ elsif e.kind_of? Hash
+ tmp_ary = []
+ e.each{|k,v| tmp_ary << k << v }
+ array2tk_list(tmp_ary)
+ else
+ _get_eval_string(e)
+ end
+ }
+ TkCore::INTERP._merge_tklist(*dst)
+ end
+
+else
+ ###########################################################################
+ # use Ruby script version of split_list (traditional methods)
+ ###########################################################################
+
def tk_split_escstr(str)
return [] if str == ""
list = []
@@ -201,7 +301,7 @@ module TkComm
if c == '\\' && !escape
escape = true
token = (token || "") << c if brace > 0
- next
+ next
end
brace += 1 if c == '{' && !escape
brace -= 1 if c == '}' && !escape
@@ -216,78 +316,74 @@ module TkComm
list << token.gsub(/^\{(.*)\}$/, '\1') if token
list
end
-=begin
- def tk_split_simplelist(str)
- return [] if str == ""
- idx = str.index('{')
- while idx and idx > 0 and str[idx-1] == ?\\
- idx = str.index('{', idx+1)
- end
- return str.split unless idx
- list = str[0,idx].split
- str = str[idx+1..-1]
- i = -1
- escape = false
- brace = 1
- str.each_byte {|c|
- i += 1
- brace += 1 if c == ?{ && !escape
- brace -= 1 if c == ?} && !escape
- escape = (c == ?\\)
- break if brace == 0
- }
- if i == 0
- list.push ''
- elsif str[0, i] == ' '
- list.push ' '
- else
- #list.push str[0..i-1]
- list.push(str[0..i-1].gsub(/\\(\{|\})/, '\1'))
- end
- list += tk_split_simplelist(str[i+1..-1])
- list
+ def array2tk_list(ary)
+ ary.collect{|e|
+ if e.kind_of? Array
+ "{#{array2tk_list(e)}}"
+ elsif e.kind_of? Hash
+ "{#{e.to_a.collect{|ee| array2tk_list(ee)}.join(' ')}}"
+ else
+ s = _get_eval_string(e)
+ (s.index(/\s/) || s.size == 0)? "{#{s}}": s
+ end
+ }.join(" ")
end
-=end
+end
+
+ private :tk_split_escstr, :tk_split_sublist
+ private :tk_split_list, :tk_split_simplelist
+ private :array2tk_list
- private :tk_tcl2ruby, :tk_split_escstr,
- :tk_split_sublist, :tk_split_list, :tk_split_simplelist
+ module_function :tk_split_escstr, :tk_split_sublist
+ module_function :tk_split_list, :tk_split_simplelist
+ module_function :array2tk_list
+
+ private_class_method :tk_split_escstr, :tk_split_sublist
+ private_class_method :tk_split_list, :tk_split_simplelist
+ private_class_method :array2tk_list
+=begin
+ ### --> definition is moved to TkUtil module
def _symbolkey2str(keys)
h = {}
keys.each{|key,value| h[key.to_s] = value}
h
end
private :_symbolkey2str
+ module_function :_symbolkey2str
+=end
- def hash_kv(keys)
- conf = []
+=begin
+ ### --> definition is moved to TkUtil module
+ # def hash_kv(keys, enc_mode = nil, conf = [], flat = false)
+ def hash_kv(keys, enc_mode = nil, conf = nil)
+ # Hash {key=>val, key=>val, ... } or Array [ [key, val], [key, val], ... ]
+ # ==> Array ['-key', val, '-key', val, ... ]
+ dst = []
if keys and keys != None
- for k, v in keys
- conf.push("-#{k}")
- conf.push(v)
- end
+ keys.each{|k, v|
+ #dst.push("-#{k}")
+ dst.push('-' + k.to_s)
+ if v != None
+ # v = _get_eval_string(v, enc_mode) if (enc_mode || flat)
+ v = _get_eval_string(v, enc_mode) if enc_mode
+ dst.push(v)
+ end
+ }
+ end
+ if conf
+ conf + dst
+ else
+ dst
end
- conf
end
private :hash_kv
module_function :hash_kv
+=end
- def array2tk_list(ary)
- ary.collect{|e|
- if e.kind_of? Array
- "{#{array2tk_list(e)}}"
- elsif e.kind_of? Hash
- "{#{e.to_a.collect{|ee| array2tk_list(ee)}.join(' ')}}"
- else
- s = _get_eval_string(e)
- (s.index(/\s/) || s.size == 0)? "{#{s}}": s
- end
- }.join(" ")
- end
- private :array2tk_list
- module_function :array2tk_list
-
+=begin
+ ### --> definition is moved to TkUtil module
def bool(val)
case val
when "1", 1, 'yes', 'true'
@@ -296,6 +392,7 @@ module TkComm
false
end
end
+
def number(val)
case val
when /^-?\d+$/
@@ -303,8 +400,7 @@ module TkComm
when /^-?\d+\.?\d*(e[-+]?\d+)?$/
val.to_f
else
- fail(ArgumentError,
- Kernel.format('invalid value for Number:"%s"', val.to_s))
+ fail(ArgumentError, "invalid value for Number:'#{val}'")
end
end
def string(val)
@@ -316,6 +412,15 @@ module TkComm
val
end
end
+ def num_or_str(val)
+ begin
+ number(val)
+ rescue ArgumentError
+ string(val)
+ end
+ end
+=end
+
def list(val)
tk_split_list(val)
end
@@ -331,6 +436,13 @@ module TkComm
nil
end
end
+ def image_obj(val)
+ if val =~ /^i\d+$/
+ TkImage::Tk_IMGTBL[val]? TkImage::Tk_IMGTBL[val] : val
+ else
+ val
+ end
+ end
def procedure(val)
if val =~ /^rb_out (c\d+)/
#Tk_CMDTBL[$1]
@@ -342,19 +454,34 @@ module TkComm
end
end
private :bool, :number, :string, :list, :simplelist, :window, :procedure
- module_function :bool, :number, :string, :list, :simplelist
- module_function :window, :procedure
+ module_function :bool, :number, :num_or_str, :string, :list, :simplelist
+ module_function :window, :image_obj, :procedure
+
+ def _toUTF8(str, encoding = nil)
+ TkCore::INTERP._toUTF8(str, encoding)
+ end
+ def _fromUTF8(str, encoding = nil)
+ TkCore::INTERP._fromUTF8(str, encoding)
+ end
+ private :_toUTF8, :_fromUTF8
+ module_function :_toUTF8, :_fromUTF8
- def _get_eval_string(str)
+=begin
+ ### --> definition is moved to TkUtil module
+ def _get_eval_string(str, enc_mode = nil)
return nil if str == None
- if str.kind_of?(String)
- # do nothing
+ if str.kind_of?(TkObject)
+ str = str.path
+ elsif str.kind_of?(String)
+ str = _toUTF8(str) if enc_mode
elsif str.kind_of?(Symbol)
str = str.id2name
+ str = _toUTF8(str) if enc_mode
elsif str.kind_of?(Hash)
- str = hash_kv(str).join(" ")
+ str = hash_kv(str, enc_mode).join(" ")
elsif str.kind_of?(Array)
str = array2tk_list(str)
+ str = _toUTF8(str) if enc_mode
elsif str.kind_of?(Proc)
str = install_cmd(str)
elsif str == nil
@@ -365,28 +492,102 @@ module TkComm
str = "1"
elsif (str.respond_to?(:to_eval))
str = str.to_eval()
+ str = _toUTF8(str) if enc_mode
else
str = str.to_s() || ''
unless str.kind_of? String
fail RuntimeError, "fail to convert the object to a string"
end
- str
+ str = _toUTF8(str) if enc_mode
end
return str
end
+=end
+=begin
+ def _get_eval_string(obj, enc_mode = nil)
+ case obj
+ when Numeric
+ obj.to_s
+ when String
+ (enc_mode)? _toUTF8(obj): obj
+ when Symbol
+ (enc_mode)? _toUTF8(obj.id2name): obj.id2name
+ when TkObject
+ obj.path
+ when Hash
+ hash_kv(obj, enc_mode).join(' ')
+ when Array
+ (enc_mode)? _toUTF8(array2tk_list(obj)): array2tk_list(obj)
+ when Proc, Method, TkCallbackEntry
+ install_cmd(obj)
+ when false
+ '0'
+ when true
+ '1'
+ when nil
+ ''
+ when None
+ nil
+ else
+ if (obj.respond_to?(:to_eval))
+ (enc_mode)? _toUTF8(obj.to_eval): obj.to_eval
+ else
+ begin
+ obj = obj.to_s || ''
+ rescue
+ fail RuntimeError, "fail to convert object '#{obj}' to string"
+ end
+ (enc_mode)? _toUTF8(obj): obj
+ end
+ end
+ end
private :_get_eval_string
module_function :_get_eval_string
+=end
- def ruby2tcl(v)
+=begin
+ ### --> definition is moved to TkUtil module
+ def _get_eval_enc_str(obj)
+ return obj if obj == None
+ _get_eval_string(obj, true)
+ end
+ private :_get_eval_enc_str
+ module_function :_get_eval_enc_str
+=end
+
+=begin
+ ### --> obsolete
+ def ruby2tcl(v, enc_mode = nil)
if v.kind_of?(Hash)
v = hash_kv(v)
v.flatten!
- v.collect{|e|ruby2tcl(e)}
+ v.collect{|e|ruby2tcl(e, enc_mode)}
else
- _get_eval_string(v)
+ _get_eval_string(v, enc_mode)
end
end
private :ruby2tcl
+=end
+
+=begin
+ ### --> definition is moved to TkUtil module
+ def _conv_args(args, enc_mode, *src_args)
+ conv_args = []
+ src_args.each{|arg|
+ conv_args << _get_eval_string(arg, enc_mode) unless arg == None
+ # if arg.kind_of?(Hash)
+ # arg.each{|k, v|
+ # args << '-' + k.to_s
+ # args << _get_eval_string(v, enc_mode)
+ # }
+ # elsif arg != None
+ # args << _get_eval_string(arg, enc_mode)
+ # end
+ }
+ args + conv_args
+ end
+ private :_conv_args
+=end
def _curr_cmd_id
#id = format("c%.4d", Tk_IDs[0])
@@ -405,20 +606,26 @@ module TkComm
return '' if cmd == ''
id = _next_cmd_id
#Tk_CMDTBL[id] = cmd
- TkCore::INTERP.tk_cmd_tbl[id] = TkCore::INTERP.get_cb_entry(cmd)
+ if cmd.kind_of?(TkCallbackEntry)
+ TkCore::INTERP.tk_cmd_tbl[id] = cmd
+ else
+ TkCore::INTERP.tk_cmd_tbl[id] = TkCore::INTERP.get_cb_entry(cmd)
+ end
@cmdtbl = [] unless defined? @cmdtbl
@cmdtbl.taint unless @cmdtbl.tainted?
@cmdtbl.push id
- return Kernel.format("rb_out %s", id);
+ #return Kernel.format("rb_out %s", id);
+ return 'rb_out ' + id
end
def uninstall_cmd(id)
id = $1 if /rb_out (c\d+)/ =~ id
#Tk_CMDTBL.delete(id)
TkCore::INTERP.tk_cmd_tbl.delete(id)
end
- private :install_cmd, :uninstall_cmd
- module_function :install_cmd
+ # private :install_cmd, :uninstall_cmd
+ module_function :install_cmd, :uninstall_cmd
+=begin
def install_win(ppath,name=nil)
if !name or name == ''
#name = format("w%.4d", Tk_IDs[1])
@@ -436,6 +643,29 @@ module TkComm
#Tk_WINDOWS[@path] = self
TkCore::INTERP.tk_windows[@path] = self
end
+=end
+ def install_win(ppath,name=nil)
+ if name
+ if name == ''
+ raise ArgumentError, "invalid wiget-name '#{name}'"
+ end
+ if name[0] == ?.
+ @path = '' + name
+ @path.freeze
+ return TkCore::INTERP.tk_windows[@path] = self
+ end
+ else
+ name = "w" + Tk_IDs[1]
+ Tk_IDs[1].succ!
+ end
+ if !ppath or ppath == '.'
+ @path = '.' + name
+ else
+ @path = ppath + '.' + name
+ end
+ @path.freeze
+ TkCore::INTERP.tk_windows[@path] = self
+ end
def uninstall_win()
#Tk_WINDOWS.delete(@path)
@@ -443,163 +673,22 @@ module TkComm
end
private :install_win, :uninstall_win
- class Event
- module TypeNum
- KeyPress = 2
- KeyRelease = 3
- ButtonPress = 4
- ButtonRelease = 5
- MotionNotify = 6
- EnterNotify = 7
- LeaveNotify = 8
- FocusIn = 9
- FocusOut = 10
- KeymapNotify = 11
- Expose = 12
- GraphicsExpose = 13
- NoExpose = 14
- VisibilityNotify = 15
- CreateNotify = 16
- DestroyNotify = 17
- UnmapNotify = 18
- MapNotify = 19
- MapRequest = 20
- ReparentNotify = 21
- ConfigureNotify = 22
- ConfigureRequest = 23
- GravityNotify = 24
- ResizeRequest = 25
- CirculateNotify = 26
- CirculateRequest = 27
- PropertyNotify = 28
- SelectionClear = 29
- SelectionRequest = 30
- SelectionNotify = 31
- ColormapNotify = 32
- ClientMessage = 33
- MappingNotify = 34
- end
-
- EV_KEY = '#abcdfhikmopstwxyABDEKNRSTWXY'
- EV_TYPE = 'nsnnsbnsnsbsxnnnnsnnbsnssnwnn'
-
- def self.scan_args(arg_str, arg_val)
- arg_cnv = []
- arg_str.strip.split(/\s+/).each_with_index{|kwd,idx|
- if kwd =~ /^%(.)$/
- if num = EV_KEY.index($1)
- case EV_TYPE[num]
- when ?n
- begin
- val = TkComm::number(arg_val[idx])
- rescue ArgumentError
- # ignore --> no convert
- val = TkComm::string(arg_val[idx])
- end
- arg_cnv << val
- when ?s
- arg_cnv << TkComm::string(arg_val[idx])
- when ?b
- arg_cnv << TkComm::bool(arg_val[idx])
- when ?w
- arg_cnv << TkComm::window(arg_val[idx])
- when ?x
- begin
- arg_cnv << TkComm::number(arg_val[idx])
- rescue ArgumentError
- arg_cnv << arg_val[idx]
- end
- else
- arg_cnv << arg_val[idx]
- end
- else
- arg_cnv << arg_val[idx]
- end
- else
- arg_cnv << arg_val[idx]
- end
- }
- arg_cnv
- end
-
- def initialize(seq,a,b,c,d,f,h,i,k,m,o,p,s,t,w,x,y,
- aa,bb,dd,ee,kk,nn,rr,ss,tt,ww,xx,yy)
- @serial = seq
- @above = a
- @num = b
- @count = c
- @detail = d
- @focus = f
- @height = h
- @win_hex = i
- @keycode = k
- @mode = m
- @override = o
- @place = p
- @state = s
- @time = t
- @width = w
- @x = x
- @y = y
- @char = aa
- @borderwidth = bb
- @wheel_delta = dd
- @send_event = ee
- @keysym = kk
- @keysym_num = nn
- @rootwin_id = rr
- @subwindow = ss
- @type = tt
- @widget = ww
- @x_root = xx
- @y_root = yy
- end
- attr :serial
- attr :above
- attr :num
- attr :count
- attr :detail
- attr :focus
- attr :height
- attr :win_hex
- attr :keycode
- attr :mode
- attr :override
- attr :place
- attr :state
- attr :time
- attr :width
- attr :x
- attr :y
- attr :char
- attr :borderwidth
- attr :wheel_delta
- attr :send_event
- attr :keysym
- attr :keysym_num
- attr :rootwin_id
- attr :subwindow
- attr :type
- attr :widget
- attr :x_root
- attr :y_root
- end
-
- def install_bind(cmd, args=nil)
- if args
- id = install_cmd(proc{|*arg|
- TkUtil.eval_cmd(cmd, *Event.scan_args(args, arg))
- })
- id + " " + args
+ def _epath(win)
+ if win.kind_of?(TkObject)
+ win.epath
+ elsif win.respond_to?(:epath)
+ win.epath
else
- args = ' %# %a %b %c %d %f %h %i %k %m %o %p %s %t %w %x %y' +
- ' %A %B %D %E %K %N %R %S %T %W %X %Y'
- id = install_cmd(proc{|*arg|
- TkUtil.eval_cmd(cmd, Event.new(*Event.scan_args(args, arg)))
- })
- id + args
+ win
end
end
+ private :_epath
+end
+
+# define TkComm module (step 2: event binding)
+module TkComm
+ include TkEvent
+ extend TkEvent
def tk_event_sequence(context)
if context.kind_of? TkVirtualEvent
@@ -624,7 +713,8 @@ module TkComm
def _bind_core(mode, what, context, cmd, args=nil)
id = install_bind(cmd, args) if cmd
begin
- tk_call(*(what + ["<#{tk_event_sequence(context)}>", mode + id]))
+ tk_call_without_enc(*(what + ["<#{tk_event_sequence(context)}>",
+ mode + id]))
rescue
uninstall_cmd(id) if cmd
fail
@@ -640,12 +730,12 @@ module TkComm
end
def _bind_remove(what, context)
- tk_call(*(what + ["<#{tk_event_sequence(context)}>", '']))
+ tk_call_without_enc(*(what + ["<#{tk_event_sequence(context)}>", '']))
end
def _bindinfo(what, context=nil)
if context
- tk_call(*what+["<#{tk_event_sequence(context)}>"]).collect {|cmdline|
+ tk_call_without_enc(*what+["<#{tk_event_sequence(context)}>"]) .collect {|cmdline|
if cmdline =~ /^rb_out (c\d+)\s+(.*)$/
#[Tk_CMDTBL[$1], $2]
[TkCore::INTERP.tk_cmd_tbl[$1], $2]
@@ -654,7 +744,7 @@ module TkComm
end
}
else
- tk_split_simplelist(tk_call(*what)).collect!{|seq|
+ tk_split_simplelist(tk_call_without_enc(*what)).collect!{|seq|
l = seq.scan(/<*[^<>]+>*/).collect!{|subseq|
case (subseq)
when /^<<[^<>]+>>$/
@@ -709,25 +799,9 @@ module TkComm
def bindinfo_all(context=nil)
_bindinfo(['bind', 'all'], context)
end
-
- def pack(*args)
- TkPack.configure(*args)
- end
-
- def grid(*args)
- TkGrid.configure(*args)
- end
-
- def update(idle=nil)
- if idle
- tk_call 'update', 'idletasks'
- else
- tk_call 'update'
- end
- end
-
end
+
module TkCore
include TkComm
extend TkComm
@@ -764,7 +838,14 @@ module TkCore
@init_ip_env = [].taint # table of Procs
@add_tk_procs = [].taint # table of [name, args, body]
- @cb_entry_class = Class.new{|c|
+ @cb_entry_class = Class.new(TkCallbackEntry){|c|
+ class << c
+ def inspect
+ sprintf("#<Class(TkCallbackEntry):%0x>", self.__id__)
+ end
+ alias to_s inspect
+ end
+
def initialize(ip, cmd)
@ip = ip
@cmd = cmd
@@ -773,9 +854,16 @@ module TkCore
def call(*args)
@ip.cb_eval(@cmd, *args)
end
- }
+ def inspect
+ sprintf("#<cb_entry:%0x>", self.__id__)
+ end
+ alias to_s inspect
+ }.freeze
}
+ def INTERP.cb_entry_class
+ @cb_entry_class
+ end
def INTERP.tk_cmd_tbl
@tk_cmd_tbl
end
@@ -783,6 +871,15 @@ module TkCore
@tk_windows
end
+ class Tk_OBJECT_TABLE
+ def initialize(id)
+ @id = id
+ end
+ def method_missing(m, *args, &b)
+ TkCore::INTERP.tk_object_table(@id).send(m, *args, &b)
+ end
+ end
+
def INTERP.tk_object_table(id)
@tk_table_list[id]
end
@@ -790,20 +887,21 @@ module TkCore
id = @tk_table_list.size
(tbl = {}).tainted? || tbl.taint
@tk_table_list << tbl
- obj = Object.new
- obj.instance_eval <<-EOD
- def self.method_missing(m, *args)
- TkCore::INTERP.tk_object_table(#{id}).send(m, *args)
- end
- EOD
- return obj
+# obj = Object.new
+# obj.instance_eval <<-EOD
+# def self.method_missing(m, *args)
+# TkCore::INTERP.tk_object_table(#{id}).send(m, *args)
+# end
+# EOD
+# return obj
+ Tk_OBJECT_TABLE.new(id)
end
def INTERP.get_cb_entry(cmd)
@cb_entry_class.new(__getip, cmd).freeze
end
def INTERP.cb_eval(cmd, *args)
- TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args))
+ TkUtil._get_eval_string(TkUtil.eval_cmd(cmd, *args))
end
def INTERP.init_ip_env(script = Proc.new)
@@ -821,16 +919,64 @@ module TkCore
end
end
+ WIDGET_DESTROY_HOOK = '<WIDGET_DESTROY_HOOK>'
+ INTERP._invoke_without_enc('event', 'add',
+ "<#{WIDGET_DESTROY_HOOK}>", 'Destroy')
+ INTERP._invoke_without_enc('bind', 'all', "<#{WIDGET_DESTROY_HOOK}>",
+ install_bind(proc{|xpath|
+ path = xpath[1..-1]
+ unless TkCore::INTERP.deleted?
+ if (widget = TkCore::INTERP.tk_windows[path])
+ if widget.respond_to?(:__destroy_hook__)
+ begin
+ widget.__destroy_hook__
+ rescue Exception
+ end
+ end
+ end
+ end
+ }, 'x%W'))
+ INTERP.add_tk_procs(TclTkLib::FINALIZE_PROC_NAME, '',
+ "bind all <#{WIDGET_DESTROY_HOOK}> {}")
+
+ INTERP.add_tk_procs('rb_out', 'args', <<-'EOL')
+ if {[set st [catch {eval {ruby_cmd TkCore callback} $args} ret]] != 0} {
+ #return -code $st $ret
+ set idx [string first "\n\n" $ret]
+ if {$idx > 0} {
+ return -code $st \
+ -errorinfo [string range $ret [expr $idx + 2] \
+ [string length $ret]] \
+ [string range $ret 0 [expr $idx - 1]]
+ } else {
+ return -code $st $ret
+ }
+ } else {
+ return $ret
+ }
+ EOL
+=begin
INTERP.add_tk_procs('rb_out', 'args', <<-'EOL')
- regsub -all {\\} $args {\\\\} args
- regsub -all {!} $args {\\!} args
- regsub -all "{" $args "\\{" args
+ #regsub -all {\\} $args {\\\\} args
+ #regsub -all {!} $args {\\!} args
+ #regsub -all "{" $args "\\{" args
+ regsub -all {(\\|!|\{|\})} $args {\\\1} args
if {[set st [catch {ruby [format "TkCore.callback %%Q!%s!" $args]} ret]] != 0} {
- return -code $st $ret
- } {
+ #return -code $st $ret
+ set idx [string first "\n\n" $ret]
+ if {$idx > 0} {
+ return -code $st \
+ -errorinfo [string range $ret [expr $idx + 2] \
+ [string length $ret]] \
+ [string range $ret 0 [expr $idx - 1]]
+ } else {
+ return -code $st $ret
+ }
+ } else {
return $ret
}
EOL
+=end
EventFlag = TclTkLib::EventFlag
@@ -842,31 +988,64 @@ module TkCore
fail TkCallbackContinue, "Tk callback returns 'continue' status"
end
- def TkCore.callback(arg)
- # arg = tk_split_list(arg)
- arg = tk_split_simplelist(arg)
- #_get_eval_string(TkUtil.eval_cmd(Tk_CMDTBL[arg.shift], *arg))
- #_get_eval_string(TkUtil.eval_cmd(TkCore::INTERP.tk_cmd_tbl[arg.shift],
- # *arg))
- cb_obj = TkCore::INTERP.tk_cmd_tbl[arg.shift]
- unless $DEBUG
- cb_obj.call(*arg)
- else
- begin
- raise 'check backtrace'
- rescue
- # ignore backtrace before 'callback'
- pos = -($!.backtrace.size)
- end
+ def TkCore.callback(*arg)
+ begin
+ TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg)
+ rescue Exception => e
begin
- cb_obj.call(*arg)
- rescue
- trace = $!.backtrace
- raise $!, "\n#{trace[0]}: #{$!.message} (#{$!.class})\n" +
- "\tfrom #{trace[1..pos].join("\n\tfrom ")}"
+ msg = _toUTF8(e.class.inspect) + ': ' +
+ _toUTF8(e.message) + "\n" +
+ "\n---< backtrace of Ruby side >-----\n" +
+ _toUTF8(e.backtrace.join("\n")) +
+ "\n---< backtrace of Tk side >-------"
+ msg.instance_variable_set(:@encoding, 'utf-8')
+ rescue Exception
+ msg = e.class.inspect + ': ' + e.message + "\n" +
+ "\n---< backtrace of Ruby side >-----\n" +
+ e.backtrace.join("\n") +
+ "\n---< backtrace of Tk side >-------"
end
+ fail(e, msg)
end
end
+=begin
+ def TkCore.callback(arg_str)
+ # arg = tk_split_list(arg_str)
+ arg = tk_split_simplelist(arg_str)
+ #_get_eval_string(TkUtil.eval_cmd(Tk_CMDTBL[arg.shift], *arg))
+ #_get_eval_string(TkUtil.eval_cmd(TkCore::INTERP.tk_cmd_tbl[arg.shift],
+ # *arg))
+ # TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg)
+ begin
+ TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg)
+ rescue Exception => e
+ raise(e, e.class.inspect + ': ' + e.message + "\n" +
+ "\n---< backtrace of Ruby side >-----\n" +
+ e.backtrace.join("\n") +
+ "\n---< backtrace of Tk side >-------")
+ end
+#=begin
+# cb_obj = TkCore::INTERP.tk_cmd_tbl[arg.shift]
+# unless $DEBUG
+# cb_obj.call(*arg)
+# else
+# begin
+# raise 'check backtrace'
+# rescue
+# # ignore backtrace before 'callback'
+# pos = -($!.backtrace.size)
+# end
+# begin
+# cb_obj.call(*arg)
+# rescue
+# trace = $!.backtrace
+# raise $!, "\n#{trace[0]}: #{$!.message} (#{$!.class})\n" +
+# "\tfrom #{trace[1..pos].join("\n\tfrom ")}"
+# end
+# end
+#=end
+ end
+=end
def load_cmd_on_ip(tk_cmd)
bool(tk_call('auto_load', tk_cmd))
@@ -875,7 +1054,7 @@ module TkCore
def after(ms, cmd=Proc.new)
myid = _curr_cmd_id
cmdid = install_cmd(cmd)
- tk_call("after",ms,cmdid)
+ tk_call_without_enc("after",ms,cmdid) # return id
# return
# if false #defined? Thread
# Thread.start do
@@ -893,69 +1072,25 @@ module TkCore
def after_idle(cmd=Proc.new)
myid = _curr_cmd_id
cmdid = install_cmd(cmd)
- tk_call('after','idle',cmdid)
- end
-
- def clock_clicks(ms=nil)
- if ms
- tk_call('clock','clicks','-milliseconds').to_i
- else
- tk_call('clock','clicks').to_i
- end
- end
-
- def clock_format(clk, form=nil)
- if form
- tk_call('clock','format',clk,'-format',form).to_i
- else
- tk_call('clock','format',clk).to_i
- end
- end
-
- def clock_formatGMT(clk, form=nil)
- if form
- tk_call('clock','format',clk,'-format',form,'-gmt','1').to_i
- else
- tk_call('clock','format',clk,'-gmt','1').to_i
- end
- end
-
- def clock_scan(str, base=nil)
- if base
- tk_call('clock','scan',str,'-base',base).to_i
- else
- tk_call('clock','scan',str).to_i
- end
- end
-
- def clock_scanGMT(str, base=nil)
- if base
- tk_call('clock','scan',str,'-base',base,'-gmt','1').to_i
- else
- tk_call('clock','scan',str,'-gmt','1').to_i
- end
- end
-
- def clock_seconds
- tk_call('clock','seconds').to_i
+ tk_call_without_enc('after','idle',cmdid)
end
def windowingsystem
- tk_call('tk', 'windowingsystem')
+ tk_call_without_enc('tk', 'windowingsystem')
end
def scaling(scale=nil)
if scale
- tk_call('tk', 'scaling', scale)
+ tk_call_without_enc('tk', 'scaling', scale)
else
- Float(number(tk_call('tk', 'scaling')))
+ Float(number(tk_call_without_enc('tk', 'scaling')))
end
end
def scaling_displayof(win, scale=nil)
if scale
- tk_call('tk', 'scaling', '-displayof', win, scale)
+ tk_call_without_enc('tk', 'scaling', '-displayof', win, scale)
else
- Float(number(tk_call('tk', '-displayof', win, 'scaling')))
+ Float(number(tk_call_without_enc('tk', '-displayof', win, 'scaling')))
end
end
@@ -1049,147 +1184,154 @@ module TkCore
end
def event_generate(window, context, keys=nil)
- window = window.path if window.kind_of? TkObject
+ #window = window.path if window.kind_of?(TkObject)
if keys
- tk_call('event', 'generate', window,
- "<#{tk_event_sequence(context)}>", *hash_kv(keys))
+ tk_call_without_enc('event', 'generate', window,
+ "<#{tk_event_sequence(context)}>",
+ *hash_kv(keys, true))
else
- tk_call('event', 'generate', window, "<#{tk_event_sequence(context)}>")
+ tk_call_without_enc('event', 'generate', window,
+ "<#{tk_event_sequence(context)}>")
end
+ nil
end
def messageBox(keys)
- tk_call 'tk_messageBox', *hash_kv(keys)
+ tk_call('tk_messageBox', *hash_kv(keys))
end
def getOpenFile(keys = nil)
- tk_call 'tk_getOpenFile', *hash_kv(keys)
+ tk_call('tk_getOpenFile', *hash_kv(keys))
end
def getSaveFile(keys = nil)
- tk_call 'tk_getSaveFile', *hash_kv(keys)
+ tk_call('tk_getSaveFile', *hash_kv(keys))
end
def chooseColor(keys = nil)
- tk_call 'tk_chooseColor', *hash_kv(keys)
+ tk_call('tk_chooseColor', *hash_kv(keys))
end
def chooseDirectory(keys = nil)
- tk_call 'tk_chooseDirectory', *hash_kv(keys)
+ tk_call('tk_chooseDirectory', *hash_kv(keys))
end
- def ip_eval(cmd_string)
- res = INTERP._eval(cmd_string)
+ def _ip_eval_core(enc_mode, cmd_string)
+ case enc_mode
+ when nil
+ res = INTERP._eval(cmd_string)
+ when false
+ res = INTERP._eval_without_enc(cmd_string)
+ when true
+ res = INTERP._eval_with_enc(cmd_string)
+ end
if INTERP._return_value() != 0
fail RuntimeError, res, error_at
end
return res
end
+ private :_ip_eval_core
- def ip_invoke(*args)
- res = INTERP._invoke(*args)
+ def ip_eval(cmd_string)
+ _ip_eval_core(nil, cmd_string)
+ end
+
+ def ip_eval_without_enc(cmd_string)
+ _ip_eval_core(false, cmd_string)
+ end
+
+ def ip_eval_with_enc(cmd_string)
+ _ip_eval_core(true, cmd_string)
+ end
+
+ def _ip_invoke_core(enc_mode, *args)
+ case enc_mode
+ when false
+ res = INTERP._invoke_without_enc(*args)
+ when nil
+ res = INTERP._invoke(*args)
+ when true
+ res = INTERP._invoke_with_enc(*args)
+ end
if INTERP._return_value() != 0
fail RuntimeError, res, error_at
end
return res
end
+ private :_ip_invoke_core
- def tk_call(*args)
- puts args.inspect if $DEBUG
- args.collect! {|x|ruby2tcl(x)}
- args.compact!
- args.flatten!
- print "=> ", args.join(" ").inspect, "\n" if $DEBUG
+ def ip_invoke(*args)
+ _ip_invoke_core(nil, *args)
+ end
+
+ def ip_invoke_without_enc(*args)
+ _ip_invoke_core(false, *args)
+ end
+
+ def ip_invoke_with_enc(*args)
+ _ip_invoke_core(true, *args)
+ end
+
+ def _tk_call_core(enc_mode, *args)
+ ### puts args.inspect if $DEBUG
+ #args.collect! {|x|ruby2tcl(x, enc_mode)}
+ #args.compact!
+ #args.flatten!
+ args = _conv_args([], enc_mode, *args)
+ puts 'invoke args => ' + args.inspect if $DEBUG
+ ### print "=> ", args.join(" ").inspect, "\n" if $DEBUG
begin
# res = INTERP._invoke(*args).taint
- res = INTERP._invoke(*args) # _invoke returns a TAINTED string
+ # res = INTERP._invoke(enc_mode, *args)
+ res = _ip_invoke_core(enc_mode, *args)
+ # >>>>> _invoke returns a TAINTED string <<<<<
rescue NameError => err
-# err = $!
+ # err = $!
begin
args.unshift "unknown"
#res = INTERP._invoke(*args).taint
- res = INTERP._invoke(*args) # _invoke returns a TAINTED string
+ #res = INTERP._invoke(enc_mode, *args)
+ res = _ip_invoke_core(enc_mode, *args)
+ # >>>>> _invoke returns a TAINTED string <<<<<
rescue StandardError => err2
- fail err2 unless /^invalid command/ =~ err2
+ fail err2 unless /^invalid command/ =~ err2.message
fail err
end
end
if INTERP._return_value() != 0
fail RuntimeError, res, error_at
end
- print "==> ", res.inspect, "\n" if $DEBUG
+ ### print "==> ", res.inspect, "\n" if $DEBUG
return res
end
-end
-
-module TkPackage
- include TkCore
- extend TkPackage
-
- TkCommandNames = ['package'.freeze].freeze
-
- def add_path(path)
- Tk::AUTO_PATH.value = Tk::AUTO_PATH.to_a << path
- end
+ private :_tk_call_core
- def forget(package)
- tk_call('package', 'forget', package)
- nil
- end
-
- def names
- tk_split_simplelist(tk_call('package', 'names'))
- end
-
- def provide(package, version=nil)
- if version
- tk_call('package', 'provide', package, version)
- nil
- else
- tk_call('package', 'provide', package)
- end
- end
-
- def present(package, version=None)
- tk_call('package', 'present', package, version)
- end
-
- def present_exact(package, version)
- tk_call('package', 'present', '-exact', package, version)
- end
-
- def require(package, version=None)
- tk_call('package', 'require', package, version)
- end
-
- def require_exact(package, version)
- tk_call('package', 'require', '-exact', package, version)
- end
-
- def versions(package)
- tk_split_simplelist(tk_call('package', 'versions', package))
+ def tk_call(*args)
+ _tk_call_core(nil, *args)
end
- def vcompare(version1, version2)
- Integer(tk_call('package', 'vcompare', version1, version2))
+ def tk_call_without_enc(*args)
+ _tk_call_core(false, *args)
end
- def vsatisfies(version1, version2)
- bool(tk_call('package', 'vsatisfies', version1, version2))
+ def tk_call_with_enc(*args)
+ _tk_call_core(true, *args)
end
end
+
module Tk
include TkCore
extend Tk
- TCL_VERSION = INTERP._invoke("info", "tclversion").freeze
- TCL_PATCHLEVEL = INTERP._invoke("info", "patchlevel").freeze
+ TCL_VERSION = INTERP._invoke_without_enc("info", "tclversion").freeze
+ TCL_PATCHLEVEL = INTERP._invoke_without_enc("info", "patchlevel").freeze
- TK_VERSION = INTERP._invoke("set", "tk_version").freeze
- TK_PATCHLEVEL = INTERP._invoke("set", "tk_patchLevel").freeze
+ TK_VERSION = INTERP._invoke_without_enc("set", "tk_version").freeze
+ TK_PATCHLEVEL = INTERP._invoke_without_enc("set", "tk_patchLevel").freeze
- JAPANIZED_TK = (INTERP._invoke("info", "commands", "kanji") != "").freeze
+ JAPANIZED_TK = (INTERP._invoke_without_enc("info", "commands",
+ "kanji") != "").freeze
def Tk.const_missing(sym)
case(sym)
@@ -1209,8 +1351,11 @@ module Tk
# tk_split_simplelist(INTERP._invoke('set', 'tcl_libPath'))
when :PLATFORM, :TCL_PLATFORM
- Hash[*tk_split_simplelist(INTERP._invoke('array', 'get',
- 'tcl_platform'))]
+ if $SAFE >= 4
+ fail SecurityError, "can't get #{sym} when $SAFE >= 4"
+ end
+ Hash[*tk_split_simplelist(INTERP._invoke_without_enc('array', 'get',
+ 'tcl_platform'))]
when :ENV
Hash[*tk_split_simplelist(INTERP._invoke('array', 'get', 'env'))]
@@ -1226,7 +1371,7 @@ module Tk
when :PRIV, :PRIVATE, :TK_PRIV
priv = {}
- if INTERP._invoke('info', 'vars', 'tk::Priv') != ""
+ if INTERP._invoke_without_enc('info', 'vars', 'tk::Priv') != ""
var_nam = 'tk::Priv'
else
var_nam = 'tkPriv'
@@ -1254,44 +1399,116 @@ module Tk
TkRoot.new
end
+ def Tk.load_tclscript(file, enc=nil)
+ if enc
+ # TCL_VERSION >= 8.5
+ tk_call('source', '-encoding', enc, file)
+ else
+ tk_call('source', file)
+ end
+ end
+
+ def Tk.load_tcllibrary(file, pkg_name=None, interp=None)
+ tk_call('load', file, pkg_name, interp)
+ end
+
+ def Tk.unload_tcllibrary(*args)
+ if args[-1].kind_of?(Hash)
+ keys = _symbolkey2str(args.pop)
+ nocomp = (keys['nocomplain'])? '-nocomplain': None
+ keeplib = (keys['keeplibrary'])? '-keeplibrary': None
+ tk_call('unload', nocomp, keeplib, '--', *args)
+ else
+ tk_call('unload', *args)
+ end
+ end
+
def Tk.bell(nice = false)
if nice
- tk_call 'bell', '-nice'
+ tk_call_without_enc('bell', '-nice')
else
- tk_call 'bell'
+ tk_call_without_enc('bell')
end
+ nil
end
def Tk.bell_on_display(win, nice = false)
if nice
- tk_call('bell', '-displayof', win, '-nice')
+ tk_call_without_enc('bell', '-displayof', win, '-nice')
else
- tk_call('bell', '-displayof', win)
+ tk_call_without_enc('bell', '-displayof', win)
end
+ nil
end
def Tk.destroy(*wins)
- tk_call('destroy', *wins)
+ tk_call_without_enc('destroy', *wins)
end
def Tk.exit
- tk_call('destroy', '.')
+ tk_call_without_enc('destroy', '.')
+ end
+
+ def Tk.pack(*args)
+ #TkPack.configure(*args)
+ TkPack(*args)
end
- def Tk.current_grabs
- tk_split_list(tk_call('grab', 'current'))
+ def Tk.grid(*args)
+ TkGrid.configure(*args)
+ end
+
+ def Tk.update(idle=nil)
+ if idle
+ tk_call_without_enc('update', 'idletasks')
+ else
+ tk_call_without_enc('update')
+ end
+ end
+ def Tk.update_idletasks
+ update(true)
+ end
+
+=begin
+ # See tcltklib.c for the reason of why the following methods are disabled.
+ def Tk.thread_update(idle=nil)
+ if idle
+ tk_call_without_enc('thread_update', 'idletasks')
+ else
+ tk_call_without_enc('thread_update')
+ end
+ end
+ def Tk.thread_update_idletasks
+ thread_update(true)
+ end
+=end
+
+ def Tk.current_grabs(win = nil)
+ if win
+ window(tk_call_without_enc('grab', 'current', win))
+ else
+ tk_split_list(tk_call_without_enc('grab', 'current'))
+ end
end
def Tk.focus(display=nil)
if display == nil
- window(tk_call('focus'))
+ window(tk_call_without_enc('focus'))
+ else
+ window(tk_call_without_enc('focus', '-displayof', display))
+ end
+ end
+
+ def Tk.focus_to(win, force=false)
+ if force
+ tk_call_without_enc('focus', '-force', win)
else
- window(tk_call('focus', '-displayof', display))
+ tk_call_without_enc('focus', win)
end
end
def Tk.focus_lastfor(win)
- window(tk_call('focus', '-lastfor', win))
+ window(tk_call_without_enc('focus', '-lastfor', win))
end
def Tk.focus_next(win)
@@ -1303,7 +1520,7 @@ module Tk
end
def Tk.strictMotif(bool=None)
- bool(tk_call('set', 'tk_strictMotif', bool))
+ bool(tk_call_without_enc('set', 'tk_strictMotif', bool))
end
def Tk.show_kinsoku(mode='both')
@@ -1336,286 +1553,12 @@ module Tk
end
end
- def Tk.toUTF8(str,encoding)
- INTERP._toUTF8(str,encoding)
+ def Tk.toUTF8(str, encoding = nil)
+ _toUTF8(str, encoding)
end
- def Tk.fromUTF8(str,encoding)
- INTERP._fromUTF8(str,encoding)
- end
-
- module Scrollable
- def xscrollcommand(cmd=Proc.new)
- configure_cmd 'xscrollcommand', cmd
- end
- def yscrollcommand(cmd=Proc.new)
- configure_cmd 'yscrollcommand', cmd
- end
- def xview(*index)
- v = tk_send('xview', *index)
- list(v) if index.size == 0
- end
- def yview(*index)
- v = tk_send('yview', *index)
- list(v) if index.size == 0
- end
- def xscrollbar(bar=nil)
- if bar
- @xscrollbar = bar
- @xscrollbar.orient 'horizontal'
- self.xscrollcommand {|*arg| @xscrollbar.set(*arg)}
- @xscrollbar.command {|*arg| self.xview(*arg)}
- end
- @xscrollbar
- end
- def yscrollbar(bar=nil)
- if bar
- @yscrollbar = bar
- @yscrollbar.orient 'vertical'
- self.yscrollcommand {|*arg| @yscrollbar.set(*arg)}
- @yscrollbar.command {|*arg| self.yview(*arg)}
- end
- @yscrollbar
- end
- end
-
- module Wm
- include TkComm
-
- TkCommandNames = ['wm'.freeze].freeze
-
- def aspect(*args)
- w = tk_call('wm', 'aspect', path, *args)
- if args.length == 0
- list(w)
- else
- self
- end
- end
- def attributes(slot=nil,value=None)
- if slot == nil
- lst = tk_split_list(tk_call('wm', 'attributes', path))
- info = {}
- while key = lst.shift
- info[key[1..-1]] = lst.shift
- end
- info
- elsif slot.kind_of? Hash
- tk_call('wm', 'attributes', path, *hash_kv(slot))
- self
- elsif value == None
- tk_call('wm', 'attributes', path, "-#{slot}")
- else
- tk_call('wm', 'attributes', path, "-#{slot}", value)
- self
- end
- end
- def client(name=None)
- if name == None
- tk_call 'wm', 'client', path
- else
- name = '' if name == nil
- tk_call 'wm', 'client', path, name
- self
- end
- end
- def colormapwindows(*args)
- r = tk_call('wm', 'colormapwindows', path, *args)
- if args.size == 0
- list(r)
- else
- self
- end
- end
- def wm_command(value=nil)
- if value
- tk_call('wm', 'command', path, value)
- self
- else
- procedure(tk_call('wm', 'command', path))
- end
- end
- def deiconify(ex = true)
- tk_call('wm', 'deiconify', path) if ex
- self
- end
- def focusmodel(mode = nil)
- if mode
- tk_call 'wm', 'focusmodel', path, mode
- self
- else
- tk_call 'wm', 'focusmodel', path
- end
- end
- def frame
- tk_call('wm', 'frame', path)
- end
- def geometry(geom=nil)
- if geom
- tk_call('wm', 'geometry', path, geom)
- self
- else
- tk_call('wm', 'geometry', path)
- end
- end
- def grid(*args)
- w = tk_call('wm', 'grid', path, *args)
- if args.size == 0
- list(w)
- else
- self
- end
- end
- def group(*args)
- w = tk_call('wm', 'group', path, *args)
- if args.size == 0
- window(w)
- else
- self
- end
- end
- def iconbitmap(bmp=nil)
- if bmp
- tk_call 'wm', 'iconbitmap', path, bmp
- self
- else
- tk_call 'wm', 'iconbitmap', path
- end
- end
- def iconify(ex = true)
- tk_call('wm', 'iconify', path) if ex
- self
- end
- def iconmask(bmp=nil)
- if bmp
- tk_call 'wm', 'iconmask', path, bmp
- self
- else
- tk_call 'wm', 'iconmask', path
- end
- end
- def iconname(name=nil)
- if name
- tk_call 'wm', 'iconname', path, name
- self
- else
- tk_call 'wm', 'iconname', path
- end
- end
- def iconposition(*args)
- w = tk_call('wm', 'iconposition', path, *args)
- if args.size == 0
- list(w)
- else
- self
- end
- end
- def iconwindow(*args)
- w = tk_call('wm', 'iconwindow', path, *args)
- if args.size == 0
- window(w)
- else
- self
- end
- end
- def maxsize(*args)
- w = tk_call('wm', 'maxsize', path, *args)
- if args.size == 0
- list(w)
- else
- self
- end
- end
- def minsize(*args)
- w = tk_call('wm', 'minsize', path, *args)
- if args.size == 0
- list(w)
- else
- self
- end
- end
- def overrideredirect(bool=None)
- if bool == None
- bool(tk_call('wm', 'overrideredirect', path))
- else
- tk_call 'wm', 'overrideredirect', path, bool
- self
- end
- end
- def positionfrom(who=None)
- if who == None
- r = tk_call('wm', 'positionfrom', path)
- (r == "")? nil: r
- else
- tk_call('wm', 'positionfrom', path, who)
- self
- end
- end
- def protocol(name=nil, cmd=nil)
- if cmd
- tk_call('wm', 'protocol', path, name, cmd)
- self
- elsif name
- result = tk_call('wm', 'protocol', path, name)
- (result == "")? nil : tk_tcl2ruby(result)
- else
- tk_split_simplelist(tk_call('wm', 'protocol', path))
- end
- end
- def resizable(*args)
- w = tk_call('wm', 'resizable', path, *args)
- if args.length == 0
- list(w).collect{|e| bool(e)}
- else
- self
- end
- end
- def sizefrom(who=None)
- if who == None
- r = tk_call('wm', 'sizefrom', path)
- (r == "")? nil: r
- else
- tk_call('wm', 'sizefrom', path, who)
- self
- end
- end
- def stackorder
- list(tk_call('wm', 'stackorder', path))
- end
- def stackorder_isabove(win)
- bool(tk_call('wm', 'stackorder', path, 'isabove', win))
- end
- def stackorder_isbelow(win)
- bool(tk_call('wm', 'stackorder', path, 'isbelow', win))
- end
- def state(state=nil)
- if state
- tk_call 'wm', 'state', path, state
- self
- else
- tk_call 'wm', 'state', path
- end
- end
- def title(str=nil)
- if str
- tk_call('wm', 'title', path, str)
- self
- else
- tk_call('wm', 'title', path)
- end
- end
- def transient(master=nil)
- if master
- tk_call('wm', 'transient', path, master)
- self
- else
- window(tk_call('wm', 'transient', path, master))
- end
- end
- def withdraw(ex = true)
- tk_call('wm', 'withdraw', path) if ex
- self
- end
+ def Tk.fromUTF8(str, encoding = nil)
+ _fromUTF8(str, encoding)
end
end
@@ -1623,46 +1566,20 @@ end
# string with Tcl's encoding
###########################################
module Tk
- class EncodedString < String
- @@enc_buf = '__rb_encoding_buffer__'
-
- def self.tk_escape(str)
- s = '"' + str.gsub(/[\[\]$"]/, '\\\\\&') + '"'
- #s = '"' + str.gsub(/[\[\]$"\\]/, '\\\\\&') + '"'
- TkCore::INTERP.__eval(Kernel.format('global %s; set %s %s',
- @@enc_buf, @@enc_buf, s))
- end
-
- def self.new(str, enc = Tk.encoding_system)
- obj = super(self.tk_escape(str))
- obj.instance_eval{@enc = enc}
- obj
- end
-
- def self.new_without_escape(str, enc = Tk.encoding_system)
- obj = super(str)
- obj.instance_eval{@enc = enc}
- obj
- end
-
- def encoding
- @enc
- end
+ def Tk.subst_utf_backslash(str)
+ Tk::EncodedString.subst_utf_backslash(str)
end
- def Tk.EncodedString(str, enc = Tk.encoding_system)
- Tk::EncodedString.new(str, enc)
+ def Tk.subst_tk_backslash(str)
+ Tk::EncodedString.subst_tk_backslash(str)
end
-
- class UTF8_String < EncodedString
- def self.new(str)
- super(str, 'utf-8')
- end
- def self.new_without_escape(str)
- super(str, 'utf-8')
- end
+ def Tk.utf_to_backslash_sequence(str)
+ Tk::EncodedString.utf_to_backslash_sequence(str)
end
- def Tk.UTF8_String(str)
- Tk::UTF8_String.new(str)
+ def Tk.utf_to_backslash(str)
+ Tk::EncodedString.utf_to_backslash_sequence(str)
+ end
+ def Tk.to_backslash_sequence(str)
+ Tk::EncodedString.to_backslash_sequence(str)
end
end
@@ -1670,20 +1587,96 @@ end
###########################################
# convert kanji string to/from utf-8
###########################################
-if /^8\.[1-9]/ =~ Tk::TCL_VERSION && !Tk::JAPANIZED_TK
+if (/^(8\.[1-9]|9\.|[1-9][0-9])/ =~ Tk::TCL_VERSION && !Tk::JAPANIZED_TK)
class TclTkIp
# from tkencoding.rb by ttate@jaist.ac.jp
+ attr_accessor :encoding
+
alias __eval _eval
alias __invoke _invoke
-
- attr_accessor :encoding
-
+
+ alias __toUTF8 _toUTF8
+ alias __fromUTF8 _fromUTF8
+
+=begin
+ #### --> definition is moved to TclTkIp module
+
+ def _toUTF8(str, encoding = nil)
+ # decide encoding
+ if encoding
+ encoding = encoding.to_s
+ elsif str.kind_of?(Tk::EncodedString) && str.encoding != nil
+ encoding = str.encoding.to_s
+ elsif str.instance_variable_get(:@encoding)
+ encoding = str.instance_variable_get(:@encoding).to_s
+ elsif defined?(@encoding) && @encoding != nil
+ encoding = @encoding.to_s
+ else
+ encoding = __invoke('encoding', 'system')
+ end
+
+ # convert
+ case encoding
+ when 'utf-8', 'binary'
+ str
+ else
+ __toUTF8(str, encoding)
+ end
+ end
+
+ def _fromUTF8(str, encoding = nil)
+ unless encoding
+ if defined?(@encoding) && @encoding != nil
+ encoding = @encoding.to_s
+ else
+ encoding = __invoke('encoding', 'system')
+ end
+ end
+
+ if str.kind_of?(Tk::EncodedString)
+ if str.encoding == 'binary'
+ str
+ else
+ __fromUTF8(str, encoding)
+ end
+ elsif str.instance_variable_get(:@encoding).to_s == 'binary'
+ str
+ else
+ __fromUTF8(str, encoding)
+ end
+ end
+=end
+
+ def _eval(cmd)
+ _fromUTF8(__eval(_toUTF8(cmd)))
+ end
+
+ def _invoke(*cmds)
+ _fromUTF8(__invoke(*(cmds.collect{|cmd| _toUTF8(cmd)})))
+ end
+
+ alias _eval_with_enc _eval
+ alias _invoke_with_enc _invoke
+
+=begin
def _eval(cmd)
- if defined? @encoding
- if cmd.kind_of?(Tk::EncodedString)
- _fromUTF8(__eval(_toUTF8(cmd, cmd.encoding)), @encoding)
+ if defined?(@encoding) && @encoding != 'utf-8'
+ ret = if cmd.kind_of?(Tk::EncodedString)
+ case cmd.encoding
+ when 'utf-8', 'binary'
+ __eval(cmd)
+ else
+ __eval(_toUTF8(cmd, cmd.encoding))
+ end
+ elsif cmd.instance_variable_get(:@encoding) == 'binary'
+ __eval(cmd)
+ else
+ __eval(_toUTF8(cmd, @encoding))
+ end
+ if ret.kind_of?(String) && ret.instance_variable_get(:@encoding) == 'binary'
+ ret
else
- _fromUTF8(__eval(_toUTF8(cmd, @encoding)), @encoding)
+ _fromUTF8(ret, @encoding)
end
else
__eval(cmd)
@@ -1691,19 +1684,32 @@ if /^8\.[1-9]/ =~ Tk::TCL_VERSION && !Tk::JAPANIZED_TK
end
def _invoke(*cmds)
- if defined? @encoding
+ if defined?(@encoding) && @encoding != 'utf-8'
cmds = cmds.collect{|cmd|
if cmd.kind_of?(Tk::EncodedString)
- _toUTF8(cmd, cmd.encoding)
+ case cmd.encoding
+ when 'utf-8', 'binary'
+ cmd
+ else
+ _toUTF8(cmd, cmd.encoding)
+ end
+ elsif cmd.instance_variable_get(:@encoding) == 'binary'
+ cmd
else
_toUTF8(cmd, @encoding)
end
}
- _fromUTF8(__invoke(*cmds), @encoding)
+ ret = __invoke(*cmds)
+ if ret.kind_of?(String) && ret.instance_variable_get(:@encoding) == 'binary'
+ ret
+ else
+ _fromUTF8(ret, @encoding)
+ end
else
__invoke(*cmds)
end
end
+=end
end
module Tk
@@ -1767,6 +1773,9 @@ else
class TclTkIp
alias __eval _eval
alias __invoke _invoke
+
+ alias _eval_with_enc _eval
+ alias _invoke_with_enc _invoke
end
module Tk
@@ -1799,1723 +1808,9 @@ else
end
alias encoding_convert_to encoding_convertto
end
-
- extend Encoding
- end
-end
-
-module TkBindCore
- def bind(context, cmd=Proc.new, args=nil)
- Tk.bind(self, context, cmd, args)
- end
-
- def bind_append(context, cmd=Proc.new, args=nil)
- Tk.bind_append(self, context, cmd, args)
- end
-
- def bind_remove(context)
- Tk.bind_remove(self, context)
- end
-
- def bindinfo(context=nil)
- Tk.bindinfo(self, context)
- end
-end
-
-class TkBindTag
- include TkBindCore
-
- #BTagID_TBL = {}
- BTagID_TBL = TkCore::INTERP.create_table
- Tk_BINDTAG_ID = ["btag".freeze, "00000".taint].freeze
-
- TkCore::INTERP.init_ip_env{ BTagID_TBL.clear }
-
- def TkBindTag.id2obj(id)
- BTagID_TBL[id]? BTagID_TBL[id]: id
- end
-
- def TkBindTag.new_by_name(name, *args, &b)
- return BTagID_TBL[name] if BTagID_TBL[name]
- self.new(*args, &b).instance_eval{
- BTagID_TBL.delete @id
- @id = name
- BTagID_TBL[@id] = self
- }
- end
-
- def initialize(*args, &b)
- @id = Tk_BINDTAG_ID.join
- Tk_BINDTAG_ID[1].succ!
- BTagID_TBL[@id] = self
- bind(*args, &b) if args != []
- end
-
- ALL = self.new_by_name('all')
-
- def name
- @id
- end
-
- def to_eval
- @id
- end
-
- def inspect
- Kernel.format "#<TkBindTag: %s>", @id
- end
-end
-
-class TkBindTagAll<TkBindTag
- def TkBindTagAll.new(*args, &b)
- $stderr.puts "Warning: TkBindTagALL is obsolete. Use TkBindTag::ALL\n"
-
- TkBindTag::ALL.bind(*args, &b) if args != []
- TkBindTag::ALL
- end
-end
-
-class TkDatabaseClass<TkBindTag
- def self.new(name, *args, &b)
- return BTagID_TBL[name] if BTagID_TBL[name]
- super(name, *args, &b)
- end
-
- def initialize(name, *args, &b)
- @id = name
- BTagID_TBL[@id] = self
- bind(*args, &b) if args != []
- end
-
- def inspect
- Kernel.format "#<TkDatabaseClass: %s>", @id
- end
-end
-
-class TkVariable
- include Tk
- extend TkCore
-
- include Comparable
-
- #TkCommandNames = ['tkwait'.freeze].freeze
- TkCommandNames = ['vwait'.freeze].freeze
-
- #TkVar_CB_TBL = {}
- #TkVar_ID_TBL = {}
- TkVar_CB_TBL = TkCore::INTERP.create_table
- TkVar_ID_TBL = TkCore::INTERP.create_table
- Tk_VARIABLE_ID = ["v".freeze, "00000".taint].freeze
-
- TkCore::INTERP.add_tk_procs('rb_var', 'args',
- "ruby [format \"TkVariable.callback %%Q!%s!\" $args]")
-
- def TkVariable.callback(args)
- #name1,name2,op = tk_split_list(args)
- name1,name2,op = tk_split_simplelist(args)
- if TkVar_CB_TBL[name1]
- _get_eval_string(TkVar_CB_TBL[name1].trace_callback(name2,op))
- else
- ''
- end
- end
-
- def initialize(val="")
- @id = Tk_VARIABLE_ID.join
- Tk_VARIABLE_ID[1].succ!
- TkVar_ID_TBL[@id] = self
-
- @trace_var = nil
- @trace_elem = nil
- @trace_opts = nil
-
-=begin
- if val == []
- # INTERP._eval(format('global %s; set %s(0) 0; unset %s(0)',
- # @id, @id, @id))
- elsif val.kind_of?(Array)
- a = []
- # val.each_with_index{|e,i| a.push(i); a.push(array2tk_list(e))}
- # s = '"' + a.join(" ").gsub(/[\[\]$"]/, '\\\\\&') + '"'
- val.each_with_index{|e,i| a.push(i); a.push(e)}
- #s = '"' + array2tk_list(a).gsub(/[\[\]$"]/, '\\\\\&') + '"'
- s = '"' + array2tk_list(a).gsub(/[\[\]$"\\]/, '\\\\\&') + '"'
- INTERP._eval(format('global %s; array set %s %s', @id, @id, s))
- elsif val.kind_of?(Hash)
- #s = '"' + val.to_a.collect{|e| array2tk_list(e)}.join(" ")\
- # .gsub(/[\[\]$"]/, '\\\\\&') + '"'
- s = '"' + val.to_a.collect{|e| array2tk_list(e)}.join(" ")\
- .gsub(/[\[\]$"\\]/, '\\\\\&') + '"'
- INTERP._eval(format('global %s; array set %s %s', @id, @id, s))
- else
- #s = '"' + _get_eval_string(val).gsub(/[\[\]$"]/, '\\\\\&') + '"'
- s = '"' + _get_eval_string(val).gsub(/[\[\]$"\\]/, '\\\\\&') + '"'
- INTERP._eval(format('global %s; set %s %s', @id, @id, s))
- end
-=end
- if val.kind_of?(Hash)
- #s = '"' + val.to_a.collect{|e| array2tk_list(e)}.join(" ")\
- # .gsub(/[\[\]$"]/, '\\\\\&') + '"'
- s = '"' + val.to_a.collect{|e| array2tk_list(e)}.join(" ")\
- .gsub(/[\[\]$"\\]/, '\\\\\&') + '"'
- INTERP._eval(Kernel.format('global %s; array set %s %s', @id, @id, s))
- else
- #s = '"' + _get_eval_string(val).gsub(/[\[\]$"]/, '\\\\\&') + '"'
- s = '"' + _get_eval_string(val).gsub(/[\[\]$"\\]/, '\\\\\&') + '"'
- INTERP._eval(Kernel.format('global %s; set %s %s', @id, @id, s))
- end
- end
-
- def wait(on_thread = false, check_root = false)
- if $SAFE >= 4
- fail SecurityError, "can't wait variable at $SAFE >= 4"
- end
- if on_thread
- if check_root
- INTERP._thread_tkwait('variable', @id)
- else
- INTERP._thread_vwait(@id)
- end
- else
- if check_root
- INTERP._invoke('tkwait', 'variable', @id)
- else
- INTERP._invoke('vwait', @id)
- end
- end
- end
- def eventloop_wait(check_root = false)
- wait(false, check_root)
- end
- def thread_wait(check_root = false)
- wait(true, check_root)
- end
- def tkwait(on_thread = true)
- wait(on_thread, true)
- end
- def eventloop_tkwait
- wait(false, true)
- end
- def thread_tkwait
- wait(true, true)
- end
-
- def id
- @id
- end
-
- def value
- begin
- INTERP._eval(Kernel.format('global %s; set %s', @id, @id))
- rescue
- if INTERP._eval(Kernel.format('global %s; array exists %s',
- @id, @id)) != "1"
- fail
- else
- Hash[*tk_split_simplelist(INTERP._eval(Kernel.format('global %s; array get %s', @id, @id)))]
- end
- end
- end
-
- def value=(val)
- begin
- #s = '"' + _get_eval_string(val).gsub(/[\[\]$"]/, '\\\\\&') + '"'
- s = '"' + _get_eval_string(val).gsub(/[\[\]$"\\]/, '\\\\\&') + '"'
- INTERP._eval(Kernel.format('global %s; set %s %s', @id, @id, s))
- rescue
- if INTERP._eval(Kernel.format('global %s; array exists %s',
- @id, @id)) != "1"
- fail
- else
- if val == []
- INTERP._eval(Kernel.format('global %s; unset %s; set %s(0) 0; unset %s(0)', @id, @id, @id, @id))
- elsif val.kind_of?(Array)
- a = []
- val.each_with_index{|e,i| a.push(i); a.push(array2tk_list(e))}
- #s = '"' + a.join(" ").gsub(/[\[\]$"]/, '\\\\\&') + '"'
- s = '"' + a.join(" ").gsub(/[\[\]$"\\]/, '\\\\\&') + '"'
- INTERP._eval(Kernel.format('global %s; unset %s; array set %s %s',
- @id, @id, @id, s))
- elsif val.kind_of?(Hash)
- #s = '"' + val.to_a.collect{|e| array2tk_list(e)}.join(" ")\
- # .gsub(/[\[\]$"]/, '\\\\\&') + '"'
- s = '"' + val.to_a.collect{|e| array2tk_list(e)}.join(" ")\
- .gsub(/[\[\]$\\"]/, '\\\\\&') + '"'
- INTERP._eval(Kernel.format('global %s; unset %s; array set %s %s',
- @id, @id, @id, s))
- else
- fail
- end
- end
- end
- end
-
- def [](index)
- INTERP._eval(Kernel.format('global %s; set %s(%s)',
- @id, @id, _get_eval_string(index)))
- end
-
- def []=(index,val)
- INTERP._eval(Kernel.format('global %s; set %s(%s) %s', @id, @id,
- _get_eval_string(index), _get_eval_string(val)))
- end
-
- def numeric
- number(value)
- end
- def numeric=(val)
- case val
- when Numeric
- self.value=(val)
- when TkVariable
- self.value=(val.numeric)
- else
- raise ArgumentError, "Numeric is expected"
- end
- end
-
- def to_i
- number(value).to_i
- end
-
- def to_f
- number(value).to_f
- end
-
- def to_s
- #string(value).to_s
- value
- end
-
- def to_sym
- value.intern
- end
-
- def list
- tk_split_list(value)
- end
- alias to_a list
-
- def list=(val)
- case val
- when Array
- self.value=(val)
- when TkVariable
- self.value=(val.list)
- else
- raise ArgumentError, "Array is expected"
- end
- end
-
- def inspect
- Kernel.format "#<TkVariable: %s>", @id
- end
-
- def coerce(other)
- case other
- when TkVariable
- [other.value, self.value]
- when String
- [other, self.to_s]
- when Symbol
- [other, self.to_sym]
- when Integer
- [other, self.to_i]
- when Float
- [other, self.to_f]
- when Array
- [other, self.to_a]
- else
- [other, self.value]
- end
- end
-
- def &(other)
- if other.kind_of?(Array)
- self.to_a & other.to_a
- else
- self.to_i & other.to_i
- end
- end
- def |(other)
- if other.kind_of?(Array)
- self.to_a | other.to_a
- else
- self.to_i | other.to_i
- end
- end
- def +(other)
- case other
- when Array
- self.to_a + other
- when String
- self.value + other
- else
- begin
- number(self.value) + other
- rescue
- self.value + other.to_s
- end
- end
- end
- def -(other)
- if other.kind_of?(Array)
- self.to_a - other
- else
- number(self.value) - other
- end
- end
- def *(other)
- begin
- number(self.value) * other
- rescue
- self.value * other
- end
- end
- def /(other)
- number(self.value) / other
- end
- def %(other)
- begin
- number(self.value) % other
- rescue
- self.value % other
- end
- end
- def **(other)
- number(self.value) ** other
- end
- def =~(other)
- self.value =~ other
- end
-
- def ==(other)
- case other
- when TkVariable
- self.equal?(other)
- when String
- self.to_s == other
- when Symbol
- self.to_sym == other
- when Integer
- self.to_i == other
- when Float
- self.to_f == other
- when Array
- self.to_a == other
- when Hash
- self.value == other
- else
- false
- end
- end
-
- def zero?
- numeric.zero?
- end
- def nonzero?
- !(numeric.zero?)
- end
-
- def <=>(other)
- if other.kind_of?(TkVariable)
- begin
- val = other.numeric
- other = val
- rescue
- other = other.value
- end
- end
- if other.kind_of?(Numeric)
- begin
- return self.numeric <=> other
- rescue
- return self.value <=> other.to_s
- end
- else
- return self.value <=> other
- end
- end
-
- def to_eval
- @id
- end
-
- def unset(elem=nil)
- if elem
- INTERP._eval(Kernel.format('global %s; unset %s(%s)',
- @id, @id, tk_tcl2ruby(elem)))
- else
- INTERP._eval(Kernel.format('global %s; unset %s', @id, @id))
- end
- end
- alias remove unset
-
- def trace_callback(elem, op)
- if @trace_var.kind_of? Array
- @trace_var.each{|m,e| e.call(self,elem,op) if m.index(op)}
- end
- if elem.kind_of? String
- if @trace_elem[elem].kind_of? Array
- @trace_elem[elem].each{|m,e| e.call(self,elem,op) if m.index(op)}
- end
- end
- end
-
- def trace(opts, cmd)
- @trace_var = [] if @trace_var == nil
- opts = ['r','w','u'].find_all{|c| opts.index(c)}.join('')
- @trace_var.unshift([opts,cmd])
- if @trace_opts == nil
- TkVar_CB_TBL[@id] = self
- @trace_opts = opts
- Tk.tk_call('trace', 'variable', @id, @trace_opts, 'rb_var')
- else
- newopts = @trace_opts.dup
- opts.each_byte{|c| newopts += c.chr unless newopts.index(c)}
- if newopts != @trace_opts
- Tk.tk_call('trace', 'vdelete', @id, @trace_opts, 'rb_var')
- @trace_opts.replace(newopts)
- Tk.tk_call('trace', 'variable', @id, @trace_opts, 'rb_var')
- end
- end
- end
-
- def trace_element(elem, opts, cmd)
- @trace_elem = {} if @trace_elem == nil
- @trace_elem[elem] = [] if @trace_elem[elem] == nil
- opts = ['r','w','u'].find_all{|c| opts.index(c)}.join('')
- @trace_elem[elem].unshift([opts,cmd])
- if @trace_opts == nil
- TkVar_CB_TBL[@id] = self
- @trace_opts = opts
- Tk.tk_call('trace', 'variable', @id, @trace_opts, 'rb_var')
- else
- newopts = @trace_opts.dup
- opts.each_byte{|c| newopts += c.chr unless newopts.index(c)}
- if newopts != @trace_opts
- Tk.tk_call('trace', 'vdelete', @id, @trace_opts, 'rb_var')
- @trace_opts.replace(newopts)
- Tk.tk_call('trace', 'variable', @id, @trace_opts, 'rb_var')
- end
- end
- end
-
- def trace_vinfo
- return [] unless @trace_var
- @trace_var.dup
- end
- def trace_vinfo_for_element(elem)
- return [] unless @trace_elem
- return [] unless @trace_elem[elem]
- @trace_elem[elem].dup
- end
-
- def trace_vdelete(opts,cmd)
- return unless @trace_var.kind_of? Array
- opts = ['r','w','u'].find_all{|c| opts.index(c)}.join('')
- idx = -1
- newopts = ''
- @trace_var.each_with_index{|e,i|
- if idx < 0 && e[0] == opts && e[1] == cmd
- idx = i
- next
- end
- e[0].each_byte{|c| newopts += c.chr unless newopts.index(c)}
- }
- if idx >= 0
- @trace_var.delete_at(idx)
- else
- return
- end
-
- @trace_elem.each{|elem|
- @trace_elem[elem].each{|e|
- e[0].each_byte{|c| newopts += c.chr unless newopts.index(c)}
- }
- }
-
- newopts = ['r','w','u'].find_all{|c| newopts.index(c)}.join('')
- if newopts != @trace_opts
- Tk.tk_call('trace', 'vdelete', @id, @trace_opts, 'rb_var')
- @trace_opts.replace(newopts)
- if @trace_opts != ''
- Tk.tk_call('trace', 'variable', @id, @trace_opts, 'rb_var')
- end
- end
- end
-
- def trace_vdelete_for_element(elem,opts,cmd)
- return unless @trace_elem.kind_of? Hash
- return unless @trace_elem[elem].kind_of? Array
- opts = ['r','w','u'].find_all{|c| opts.index(c)}.join('')
- idx = -1
- @trace_elem[elem].each_with_index{|e,i|
- if idx < 0 && e[0] == opts && e[1] == cmd
- idx = i
- next
- end
- }
- if idx >= 0
- @trace_elem[elem].delete_at(idx)
- else
- return
- end
-
- newopts = ''
- @trace_var.each{|e|
- e[0].each_byte{|c| newopts += c.chr unless newopts.index(c)}
- }
- @trace_elem.each{|elem|
- @trace_elem[elem].each{|e|
- e[0].each_byte{|c| newopts += c.chr unless newopts.index(c)}
- }
- }
-
- newopts = ['r','w','u'].find_all{|c| newopts.index(c)}.join('')
- if newopts != @trace_opts
- Tk.tk_call('trace', 'vdelete', @id, @trace_opts, 'rb_var')
- @trace_opts.replace(newopts)
- if @trace_opts != ''
- Tk.tk_call('trace', 'variable', @id, @trace_opts, 'rb_var')
- end
- end
- end
-end
-
-class TkVarAccess<TkVariable
- def self.new(name, *args)
- return TkVar_ID_TBL[name] if TkVar_ID_TBL[name]
- super(name, *args)
- end
-
- def initialize(varname, val=nil)
- @id = varname
- TkVar_ID_TBL[@id] = self
- if val
- #s = '"' + _get_eval_string(val).gsub(/[\[\]$"]/, '\\\\\&') + '"' #"
- s = '"' + _get_eval_string(val).gsub(/[\[\]$"\\]/, '\\\\\&') + '"' #"
- INTERP._eval(Kernel.format('global %s; set %s %s', @id, @id, s))
- end
- end
-end
-
-module Tk
- begin
- auto_path = INTERP._invoke('set', 'auto_path')
- rescue
- begin
- auto_path = INTERP._invoke('set', 'env(TCLLIBPATH)')
- rescue
- auto_path = Tk::LIBRARY
- end
- end
-
- AUTO_PATH = TkVarAccess.new('auto_path', auto_path)
-
-=begin
- AUTO_OLDPATH = tk_split_simplelist(INTERP._invoke('set', 'auto_oldpath'))
- AUTO_OLDPATH.each{|s| s.freeze}
- AUTO_OLDPATH.freeze
-=end
-
- TCL_PACKAGE_PATH = TkVarAccess.new('tcl_pkgPath')
- PACKAGE_PATH = TCL_PACKAGE_PATH
-
- TCL_LIBRARY_PATH = TkVarAccess.new('tcl_libPath')
- LIBRARY_PATH = TCL_LIBRARY_PATH
-
- TCL_PRECISION = TkVarAccess.new('tcl_precision')
-end
-
-module TkSelection
- include Tk
- extend Tk
-
- TkCommandNames = ['selection'.freeze].freeze
-
- def self.clear(sel=nil)
- if sel
- tk_call 'selection', 'clear', '-selection', sel
- else
- tk_call 'selection', 'clear'
- end
- end
- def self.clear_on_display(win, sel=nil)
- if sel
- tk_call 'selection', 'clear', '-displayof', win, '-selection', sel
- else
- tk_call 'selection', 'clear', '-displayof', win
- end
- end
- def clear(sel=nil)
- TkSelection.clear_on_display(self, sel)
- self
- end
-
- def self.get(keys=nil)
- tk_call 'selection', 'get', *hash_kv(keys)
- end
- def self.get_on_display(win, keys=nil)
- tk_call 'selection', 'get', '-displayof', win, *hash_kv(keys)
- end
- def get(keys=nil)
- TkSelection.get_on_display(self, sel)
- end
-
- def self.handle(win, func=Proc.new, keys=nil, &b)
- if func.kind_of?(Hash) && keys == nil
- keys = func
- func = Proc.new(&b)
- end
- args = ['selection', 'handle']
- args += hash_kv(keys)
- args += [win, func]
- tk_call(*args)
- end
- def handle(func=Proc.new, keys=nil, &b)
- TkSelection.handle(self, func, keys, &b)
- end
-
- def self.get_owner(sel=nil)
- if sel
- window(tk_call('selection', 'own', '-selection', sel))
- else
- window(tk_call('selection', 'own'))
- end
- end
- def self.get_owner_on_display(win, sel=nil)
- if sel
- window(tk_call('selection', 'own', '-displayof', win, '-selection', sel))
- else
- window(tk_call('selection', 'own', '-displayof', win))
- end
- end
- def get_owner(sel=nil)
- TkSelection.get_owner_on_display(self, sel)
- self
- end
-
- def self.set_owner(win, keys=nil)
- tk_call('selection', 'own', *(hash_kv(keys) << win))
- end
- def set_owner(keys=nil)
- TkSelection.set_owner(self, keys)
- self
- end
-end
-
-module TkKinput
- include Tk
- extend Tk
-
- TkCommandNames = [
- 'kinput_start'.freeze,
- 'kinput_send_spot'.freeze,
- 'kanjiInput'.freeze
- ].freeze
-
- def TkKinput.start(window, style=None)
- tk_call 'kinput_start', window.path, style
- end
- def kinput_start(style=None)
- TkKinput.start(self, style)
- end
-
- def TkKinput.send_spot(window)
- tk_call 'kinput_send_spot', window.path
- end
- def kinput_send_spot
- TkKinput.send_spot(self)
- end
-
- def TkKinput.input_start(window, keys=nil)
- tk_call 'kanjiInput', 'start', window.path, *hash_kv(keys)
- end
- def kanji_input_start(keys=nil)
- TkKinput.input_start(self, keys)
- end
-
- def TkKinput.attribute_config(window, slot, value=None)
- if slot.kind_of? Hash
- tk_call 'kanjiInput', 'attribute', window.path, *hash_kv(slot)
- else
- tk_call 'kanjiInput', 'attribute', window.path, "-#{slot}", value
- end
- end
- def kinput_attribute_config(slot, value=None)
- TkKinput.attribute_config(self, slot, value)
- end
-
- def TkKinput.attribute_info(window, slot=nil)
- if slot
- conf = tk_split_list(tk_call('kanjiInput', 'attribute',
- window.path, "-#{slot}"))
- conf[0] = conf[0][1..-1]
- conf
- else
- tk_split_list(tk_call('kanjiInput', 'attribute',
- window.path)).collect{|conf|
- conf[0] = conf[0][1..-1]
- conf
- }
- end
- end
- def kinput_attribute_info(slot=nil)
- TkKinput.attribute_info(self, slot)
- end
-
- def TkKinput.input_end(window)
- tk_call 'kanjiInput', 'end', window.path
- end
- def kanji_input_end
- TkKinput.input_end(self)
- end
-end
-
-module TkXIM
- include Tk
- extend Tk
-
- TkCommandNames = ['imconfigure'.freeze].freeze
-
- def TkXIM.useinputmethods(window=nil, value=nil)
- if window
- if value
- tk_call 'tk', 'useinputmethods', '-displayof', window.path, value
- else
- tk_call 'tk', 'useinputmethods', '-displayof', window.path
- end
- else
- if value
- tk_call 'tk', 'useinputmethods', value
- else
- tk_call 'tk', 'useinputmethods'
- end
- end
- end
-
- def TkXIM.caret(window, keys=nil)
- if keys
- tk_call('tk', 'caret', window, *hash_kv(keys))
- self
- else
- lst = tk_split_list(tk_call('tk', 'caret', window))
- info = {}
- while key = lst.shift
- info[key[1..-1]] = lst.shift
- end
- info
- end
- end
-
- def TkXIM.configure(window, slot, value=None)
- begin
- if /^8\.*/ === Tk::TK_VERSION && JAPANIZED_TK
- if slot.kind_of? Hash
- tk_call 'imconfigure', window.path, *hash_kv(slot)
- else
- tk_call 'imconfigure', window.path, "-#{slot}", value
- end
- end
- rescue
- end
- end
-
- def TkXIM.configinfo(window, slot=nil)
- begin
- if /^8\.*/ === Tk::TK_VERSION && JAPANIZED_TK
- if slot
- conf = tk_split_list(tk_call('imconfigure', window.path, "-#{slot}"))
- conf[0] = conf[0][1..-1]
- conf
- else
- tk_split_list(tk_call('imconfigure', window.path)).collect{|conf|
- conf[0] = conf[0][1..-1]
- conf
- }
- end
- else
- []
- end
- rescue
- []
- end
- end
-
- def useinputmethods(value=nil)
- TkXIM.useinputmethods(self, value)
- end
-
- def caret(keys=nil)
- TkXIM.caret(self, keys=nil)
- end
-
- def imconfigure(slot, value=None)
- TkXIM.configinfo(self, slot, value)
- end
-
- def imconfiginfo(slot=nil)
- TkXIM.configinfo(self, slot)
- end
-end
-
-module TkWinfo
- include Tk
- extend Tk
-
- TkCommandNames = ['winfo'.freeze].freeze
-
- def TkWinfo.atom(name, win=nil)
- if win
- number(tk_call('winfo', 'atom', '-displayof', win, name))
- else
- number(tk_call('winfo', 'atom', name))
- end
- end
- def winfo_atom(name)
- TkWinfo.atom(name, self)
- end
-
- def TkWinfo.atomname(id, win=nil)
- if win
- tk_call('winfo', 'atomname', '-displayof', win, id)
- else
- tk_call('winfo', 'atomname', id)
- end
- end
- def winfo_atomname(id)
- TkWinfo.atomname(id, self)
- end
-
- def TkWinfo.cells(window)
- number(tk_call('winfo', 'cells', window.path))
- end
- def winfo_cells
- TkWinfo.cells self
- end
-
- def TkWinfo.children(window)
- c = tk_call('winfo', 'children', window.path)
- list(c)
- end
- def winfo_children
- TkWinfo.children self
- end
-
- def TkWinfo.classname(window)
- tk_call 'winfo', 'class', window.path
- end
- def winfo_classname
- TkWinfo.classname self
- end
- alias winfo_class winfo_classname
-
- def TkWinfo.colormapfull(window)
- bool(tk_call('winfo', 'colormapfull', window.path))
- end
- def winfo_colormapfull
- TkWinfo.colormapfull self
- end
-
- def TkWinfo.containing(rootX, rootY, win=nil)
- if win
- window(tk_call('winfo', 'containing', '-displayof', win, rootX, rootY))
- else
- window(tk_call('winfo', 'containing', rootX, rootY))
- end
- end
- def winfo_containing(x, y)
- TkWinfo.containing(x, y, self)
- end
-
- def TkWinfo.depth(window)
- number(tk_call('winfo', 'depth', window.path))
- end
- def winfo_depth
- TkWinfo.depth self
- end
-
- def TkWinfo.exist?(window)
- bool(tk_call('winfo', 'exists', window.path))
- end
- def winfo_exist?
- TkWinfo.exist? self
- end
-
- def TkWinfo.fpixels(window, dist)
- number(tk_call('winfo', 'fpixels', window.path, dist))
- end
- def winfo_fpixels(dist)
- TkWinfo.fpixels self, dist
- end
-
- def TkWinfo.geometry(window)
- tk_call('winfo', 'geometry', window.path)
- end
- def winfo_geometry
- TkWinfo.geometry self
- end
-
- def TkWinfo.height(window)
- number(tk_call('winfo', 'height', window.path))
- end
- def winfo_height
- TkWinfo.height self
- end
-
- def TkWinfo.id(window)
- tk_call('winfo', 'id', window.path)
- end
- def winfo_id
- TkWinfo.id self
- end
-
- def TkWinfo.interps(window=nil)
- if window
- tk_split_simplelist(tk_call('winfo', 'interps',
- '-displayof', window.path))
- else
- tk_split_simplelist(tk_call('winfo', 'interps'))
- end
- end
- def winfo_interps
- TkWinfo.interps self
- end
-
- def TkWinfo.mapped?(window)
- bool(tk_call('winfo', 'ismapped', window.path))
- end
- def winfo_mapped?
- TkWinfo.mapped? self
- end
-
- def TkWinfo.manager(window)
- tk_call('winfo', 'manager', window.path)
- end
- def winfo_manager
- TkWinfo.manager self
- end
-
- def TkWinfo.appname(window)
- tk_call('winfo', 'name', window.path)
- end
- def winfo_appname
- TkWinfo.appname self
- end
-
- def TkWinfo.parent(window)
- window(tk_call('winfo', 'parent', window.path))
- end
- def winfo_parent
- TkWinfo.parent self
- end
-
- def TkWinfo.widget(id, win=nil)
- if win
- window(tk_call('winfo', 'pathname', '-displayof', win, id))
- else
- window(tk_call('winfo', 'pathname', id))
- end
- end
- def winfo_widget(id)
- TkWinfo.widget id, self
- end
-
- def TkWinfo.pixels(window, dist)
- number(tk_call('winfo', 'pixels', window.path, dist))
- end
- def winfo_pixels(dist)
- TkWinfo.pixels self, dist
- end
-
- def TkWinfo.reqheight(window)
- number(tk_call('winfo', 'reqheight', window.path))
- end
- def winfo_reqheight
- TkWinfo.reqheight self
- end
-
- def TkWinfo.reqwidth(window)
- number(tk_call('winfo', 'reqwidth', window.path))
- end
- def winfo_reqwidth
- TkWinfo.reqwidth self
- end
-
- def TkWinfo.rgb(window, color)
- list(tk_call('winfo', 'rgb', window.path, color))
- end
- def winfo_rgb(color)
- TkWinfo.rgb self, color
- end
-
- def TkWinfo.rootx(window)
- number(tk_call('winfo', 'rootx', window.path))
- end
- def winfo_rootx
- TkWinfo.rootx self
- end
-
- def TkWinfo.rooty(window)
- number(tk_call('winfo', 'rooty', window.path))
- end
- def winfo_rooty
- TkWinfo.rooty self
- end
-
- def TkWinfo.screen(window)
- tk_call 'winfo', 'screen', window.path
- end
- def winfo_screen
- TkWinfo.screen self
- end
-
- def TkWinfo.screencells(window)
- number(tk_call('winfo', 'screencells', window.path))
- end
- def winfo_screencells
- TkWinfo.screencells self
- end
-
- def TkWinfo.screendepth(window)
- number(tk_call('winfo', 'screendepth', window.path))
- end
- def winfo_screendepth
- TkWinfo.screendepth self
- end
-
- def TkWinfo.screenheight (window)
- number(tk_call('winfo', 'screenheight', window.path))
- end
- def winfo_screenheight
- TkWinfo.screenheight self
- end
-
- def TkWinfo.screenmmheight(window)
- number(tk_call('winfo', 'screenmmheight', window.path))
- end
- def winfo_screenmmheight
- TkWinfo.screenmmheight self
- end
-
- def TkWinfo.screenmmwidth(window)
- number(tk_call('winfo', 'screenmmwidth', window.path))
- end
- def winfo_screenmmwidth
- TkWinfo.screenmmwidth self
- end
-
- def TkWinfo.screenvisual(window)
- tk_call('winfo', 'screenvisual', window.path)
- end
- def winfo_screenvisual
- TkWinfo.screenvisual self
- end
-
- def TkWinfo.screenwidth(window)
- number(tk_call('winfo', 'screenwidth', window.path))
- end
- def winfo_screenwidth
- TkWinfo.screenwidth self
- end
-
- def TkWinfo.server(window)
- tk_call 'winfo', 'server', window.path
- end
- def winfo_server
- TkWinfo.server self
- end
-
- def TkWinfo.toplevel(window)
- window(tk_call('winfo', 'toplevel', window.path))
- end
- def winfo_toplevel
- TkWinfo.toplevel self
- end
-
- def TkWinfo.visual(window)
- tk_call('winfo', 'visual', window.path)
- end
- def winfo_visual
- TkWinfo.visual self
- end
-
- def TkWinfo.visualid(window)
- tk_call('winfo', 'visualid', window.path)
- end
- def winfo_visualid
- TkWinfo.visualid self
- end
-
- def TkWinfo.visualsavailable(window, includeids=false)
- if includeids
- list(tk_call('winfo', 'visualsavailable', window.path, "includeids"))
- else
- list(tk_call('winfo', 'visualsavailable', window.path))
- end
- end
- def winfo_visualsavailable(includeids=false)
- TkWinfo.visualsavailable self, includeids
- end
-
- def TkWinfo.vrootheight(window)
- number(tk_call('winfo', 'vrootheight', window.path))
- end
- def winfo_vrootheight
- TkWinfo.vrootheight self
- end
-
- def TkWinfo.vrootwidth(window)
- number(tk_call('winfo', 'vrootwidth', window.path))
- end
- def winfo_vrootwidth
- TkWinfo.vrootwidth self
- end
-
- def TkWinfo.vrootx(window)
- number(tk_call('winfo', 'vrootx', window.path))
- end
- def winfo_vrootx
- TkWinfo.vrootx self
- end
-
- def TkWinfo.vrooty(window)
- number(tk_call('winfo', 'vrooty', window.path))
- end
- def winfo_vrooty
- TkWinfo.vrooty self
- end
-
- def TkWinfo.width(window)
- number(tk_call('winfo', 'width', window.path))
- end
- def winfo_width
- TkWinfo.width self
- end
-
- def TkWinfo.x(window)
- number(tk_call('winfo', 'x', window.path))
- end
- def winfo_x
- TkWinfo.x self
- end
-
- def TkWinfo.y(window)
- number(tk_call('winfo', 'y', window.path))
- end
- def winfo_y
- TkWinfo.y self
- end
-
- def TkWinfo.viewable(window)
- bool(tk_call('winfo', 'viewable', window.path))
- end
- def winfo_viewable
- TkWinfo.viewable self
- end
-
- def TkWinfo.pointerx(window)
- number(tk_call('winfo', 'pointerx', window.path))
- end
- def winfo_pointerx
- TkWinfo.pointerx self
- end
-
- def TkWinfo.pointery(window)
- number(tk_call('winfo', 'pointery', window.path))
- end
- def winfo_pointery
- TkWinfo.pointery self
- end
-
- def TkWinfo.pointerxy(window)
- list(tk_call('winfo', 'pointerxy', window.path))
- end
- def winfo_pointerxy
- TkWinfo.pointerxy self
- end
-end
-
-module TkPack
- include Tk
- extend Tk
-
- TkCommandNames = ['pack'.freeze].freeze
-
- def configure(win, *args)
- if args[-1].kind_of?(Hash)
- keys = args.pop
- end
- wins = [win.epath]
- for i in args
- wins.push i.epath
- end
- tk_call "pack", 'configure', *(wins+hash_kv(keys))
end
-
- def forget(*args)
- tk_call 'pack', 'forget' *args
- end
-
- def info(slave)
- ilist = list(tk_call('pack', 'info', slave.epath))
- info = {}
- while key = ilist.shift
- info[key[1..-1]] = ilist.shift
- end
- return info
- end
-
- def propagate(master, bool=None)
- if bool == None
- bool(tk_call('pack', 'propagate', master.epath))
- else
- tk_call('pack', 'propagate', master.epath, bool)
- end
- end
-
- def slaves(master)
- list(tk_call('pack', 'slaves', master.epath))
- end
-
- module_function :configure, :forget, :info, :propagate, :slaves
end
-module TkGrid
- include Tk
- extend Tk
-
- TkCommandNames = ['grid'.freeze].freeze
-
- def bbox(*args)
- list(tk_call('grid', 'bbox', *args))
- end
-
- def configure(widget, *args)
- if args[-1].kind_of?(Hash)
- keys = args.pop
- end
- wins = []
- args.unshift(widget)
- for i in args
- case i
- when '-', 'x', '^' # RELATIVE PLACEMENT
- wins.push(i)
- else
- wins.push(i.epath)
- end
- end
- tk_call "grid", 'configure', *(wins+hash_kv(keys))
- end
-
- def columnconfigure(master, index, args)
- tk_call "grid", 'columnconfigure', master, index, *hash_kv(args)
- end
-
- def rowconfigure(master, index, args)
- tk_call "grid", 'rowconfigure', master, index, *hash_kv(args)
- end
-
- def columnconfiginfo(master, index, slot=nil)
- if slot
- tk_call('grid', 'columnconfigure', master, index, "-#{slot}").to_i
- else
- ilist = list(tk_call('grid', 'columnconfigure', master, index))
- info = {}
- while key = ilist.shift
- info[key[1..-1]] = ilist.shift
- end
- info
- end
- end
-
- def rowconfiginfo(master, index, slot=nil)
- if slot
- tk_call('grid', 'rowconfigure', master, index, "-#{slot}").to_i
- else
- ilist = list(tk_call('grid', 'rowconfigure', master, index))
- info = {}
- while key = ilist.shift
- info[key[1..-1]] = ilist.shift
- end
- info
- end
- end
-
- def add(widget, *args)
- configure(widget, *args)
- end
-
- def forget(*args)
- tk_call 'grid', 'forget', *args
- end
-
- def info(slave)
- list(tk_call('grid', 'info', slave))
- end
-
- def location(master, x, y)
- list(tk_call('grid', 'location', master, x, y))
- end
-
- def propagate(master, bool=None)
- if bool == None
- bool(tk_call('grid', 'propagate', master.epath))
- else
- tk_call('grid', 'propagate', master.epath, bool)
- end
- end
-
- def remove(*args)
- tk_call 'grid', 'remove', *args
- end
-
- def size(master)
- list(tk_call('grid', 'size', master))
- end
-
- def slaves(master, args)
- list(tk_call('grid', 'slaves', master, *hash_kv(args)))
- end
-
- module_function :bbox, :forget, :propagate, :info
- module_function :remove, :size, :slaves, :location
- module_function :configure, :columnconfigure, :rowconfigure
- module_function :columnconfiginfo, :rowconfiginfo
-end
-
-module TkPlace
- include Tk
- extend Tk
-
- TkCommandNames = ['place'.freeze].freeze
-
- def configure(win, slot, value=None)
- if slot.kind_of? Hash
- tk_call 'place', 'configure', win.epath, *hash_kv(slot)
- else
- tk_call 'place', 'configure', win.epath, "-#{slot}", value
- end
- end
-
- def configinfo(win, slot = nil)
- # for >= Tk8.4a2 ?
- if slot
- conf = tk_split_list(tk_call('place', 'configure',
- win.epath, "-#{slot}") )
- conf[0] = conf[0][1..-1]
- conf
- else
- tk_split_simplelist(tk_call('place', 'configure',
- win.epath)).collect{|conflist|
- conf = tk_split_simplelist(conflist)
- conf[0] = conf[0][1..-1]
- conf
- }
- end
- end
-
- def forget(win)
- tk_call 'place', 'forget', win
- end
-
- def info(win)
- ilist = list(tk_call('place', 'info', win.epath))
- info = {}
- while key = ilist.shift
- info[key[1..-1]] = ilist.shift
- end
- return info
- end
-
- def slaves(master)
- list(tk_call('place', 'slaves', master.epath))
- end
-
- module_function :configure, :configinfo, :forget, :info, :slaves
-end
-
-module TkOptionDB
- include Tk
- extend Tk
-
- TkCommandNames = ['option'.freeze].freeze
-
- module Priority
- WidgetDefault = 20
- StartupFile = 40
- UserDefault = 60
- Interactive = 80
- end
-
- def add(pat, value, pri=None)
- if $SAFE >= 4
- fail SecurityError, "can't call 'TkOptionDB.add' at $SAFE >= 4"
- end
- tk_call 'option', 'add', pat, value, pri
- end
- def clear
- if $SAFE >= 4
- fail SecurityError, "can't call 'TkOptionDB.crear' at $SAFE >= 4"
- end
- tk_call 'option', 'clear'
- end
- def get(win, name, klass)
- tk_call('option', 'get', win ,name, klass)
- end
- def readfile(file, pri=None)
- tk_call 'option', 'readfile', file, pri
- end
- module_function :add, :clear, :get, :readfile
-
- def read_entries(file, f_enc=nil)
- if TkCore::INTERP.safe?
- fail SecurityError,
- "can't call 'TkOptionDB.read_entries' on a safe interpreter"
- end
-
- i_enc = Tk.encoding()
-
- unless f_enc
- f_enc = i_enc
- end
-
- ent = []
- cline = ''
- open(file, 'r') {|f|
- while line = f.gets
- cline += line.chomp!
- case cline
- when /\\$/ # continue
- cline.chop!
- next
- when /^!/ # coment
- cline = ''
- next
- when /^([^:]+):\s(.*)$/
- pat = $1
- val = $2
- p "ResourceDB: #{[pat, val].inspect}" if $DEBUG
- pat = TkCore::INTERP._toUTF8(pat, f_enc)
- pat = TkCore::INTERP._fromUTF8(pat, i_enc)
- val = TkCore::INTERP._toUTF8(val, f_enc)
- val = TkCore::INTERP._fromUTF8(val, i_enc)
- ent << [pat, val]
- cline = ''
- else # unknown --> ignore
- cline = ''
- next
- end
- end
- }
- ent
- end
- module_function :read_entries
-
- def read_with_encoding(file, f_enc=nil, pri=None)
- # try to read the file as an OptionDB file
- readfile(file, pri).each{|pat, val|
- add(pat, val, pri)
- }
-
-=begin
- i_enc = Tk.encoding()
-
- unless f_enc
- f_enc = i_enc
- end
-
- cline = ''
- open(file, 'r') {|f|
- while line = f.gets
- cline += line.chomp!
- case cline
- when /\\$/ # continue
- cline.chop!
- next
- when /^!/ # coment
- cline = ''
- next
- when /^([^:]+):\s(.*)$/
- pat = $1
- val = $2
- p "ResourceDB: #{[pat, val].inspect}" if $DEBUG
- pat = TkCore::INTERP._toUTF8(pat, f_enc)
- pat = TkCore::INTERP._fromUTF8(pat, i_enc)
- val = TkCore::INTERP._toUTF8(val, f_enc)
- val = TkCore::INTERP._fromUTF8(val, i_enc)
- add(pat, val, pri)
- cline = ''
- else # unknown --> ignore
- cline = ''
- next
- end
- end
- }
-=end
- end
- module_function :read_with_encoding
-
- # support procs on the resource database
- @@resource_proc_class = Class.new
- class << @@resource_proc_class
- private :new
-
- CARRIER = '.'.freeze
- METHOD_TBL = TkCore::INTERP.create_table
- ADD_METHOD = false
- SAFE_MODE = 4
-
- def __closed_block_check__(str)
- depth = 0
- str.scan(/[{}]/){|x|
- if x == "{"
- depth += 1
- elsif x == "}"
- depth -= 1
- end
- if depth <= 0 && !($' =~ /\A\s*\Z/)
- fail RuntimeError, "bad string for procedure : #{str.inspect}"
- end
- }
- str
- end
-
- def __check_proc_string__(str)
- # If you want to check the proc_string, do it in this method.
- # Please define this in the block given to 'new_proc_class' method.
- str
- end
-
- def method_missing(id, *args)
- res_proc = self::METHOD_TBL[id]
- unless res_proc.kind_of? Proc
- if id == :new || !(self::METHOD_TBL.has_key?(id) || self::ADD_METHOD)
- raise NoMethodError,
- "not support resource-proc '#{id.id2name}' for #{self.name}"
- end
- proc_str = TkOptionDB.get(self::CARRIER, id.id2name, '').strip
- proc_str = '{' + proc_str + '}' unless /\A\{.*\}\Z/ =~ proc_str
- proc_str = __closed_block_check__(proc_str)
- proc_str = __check_proc_string__(proc_str)
- res_proc = eval('Proc.new' + proc_str)
- self::METHOD_TBL[id] = res_proc
- end
- proc{
- $SAFE = self::SAFE_MODE
- res_proc.call(*args)
- }.call
- end
-
- private :__closed_block_check__, :__check_proc_string__, :method_missing
- end
- @@resource_proc_class.freeze
-
- def __create_new_class(klass, func, safe = 4, add = false, parent = nil)
- klass = klass.to_s if klass.kind_of? Symbol
- unless (?A..?Z) === klass[0]
- fail ArgumentError, "bad string '#{klass}' for class name"
- end
- unless func.kind_of? Array
- fail ArgumentError, "method-list must be Array"
- end
- func_str = func.join(' ')
- if parent == nil
- install_win(parent)
- elsif parent <= @@resource_proc_class
- install_win(parent::CARRIER)
- else
- fail ArgumentError, "parent must be Resource-Proc class"
- end
- carrier = Tk.tk_call('frame', @path, '-class', klass)
-
- body = <<-"EOD"
- class #{klass} < TkOptionDB.module_eval('@@resource_proc_class')
- CARRIER = '#{carrier}'.freeze
- METHOD_TBL = TkCore::INTERP.create_table
- ADD_METHOD = #{add}
- SAFE_MODE = #{safe}
- %w(#{func_str}).each{|f| METHOD_TBL[f.intern] = nil }
- end
- EOD
-
- if parent.kind_of?(Class) && parent <= @@resource_proc_class
- parent.class_eval(body)
- eval(parent.name + '::' + klass)
- else
- eval(body)
- eval('TkOptionDB::' + klass)
- end
- end
- module_function :__create_new_class
- private_class_method :__create_new_class
-
- def __remove_methods_of_proc_class(klass)
- # for security, make these methods invalid
- class << klass
- attr_reader :class_eval, :name, :superclass,
- :ancestors, :const_defined?, :const_get, :const_set,
- :constants, :included_modules, :instance_methods,
- :method_defined?, :module_eval, :private_instance_methods,
- :protected_instance_methods, :public_instance_methods,
- :remove_const, :remove_method, :undef_method,
- :to_s, :inspect, :display, :method, :methods,
- :instance_eval, :instance_variables, :kind_of?, :is_a?,
- :private_methods, :protected_methods, :public_methods
- end
- end
- module_function :__remove_methods_of_proc_class
- private_class_method :__remove_methods_of_proc_class
-
- RAND_BASE_CNT = [0]
- RAND_BASE_HEAD = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
- RAND_BASE_CHAR = RAND_BASE_HEAD + 'abcdefghijklmnopqrstuvwxyz0123456789_'
- def __get_random_basename
- name = '%s%03d' % [RAND_BASE_HEAD[rand(RAND_BASE_HEAD.size),1],
- RAND_BASE_CNT[0]]
- len = RAND_BASE_CHAR.size
- (6+rand(10)).times{
- name << RAND_BASE_CHAR[rand(len),1]
- }
- RAND_BASE_CNT[0] = RAND_BASE_CNT[0] + 1
- name
- end
- module_function :__get_random_basename
- private_class_method :__get_random_basename
-
- # define new proc class :
- # If you want to modify the new class or create a new subclass,
- # you must do such operation in the block parameter.
- # Because the created class is flozen after evaluating the block.
- def new_proc_class(klass, func, safe = 4, add = false, parent = nil, &b)
- new_klass = __create_new_class(klass, func, safe, add, parent)
- new_klass.class_eval(&b) if block_given?
- __remove_methods_of_proc_class(new_klass)
- new_klass.freeze
- new_klass
- end
- module_function :new_proc_class
-
- def eval_under_random_base(parent = nil, &b)
- new_klass = __create_new_class(__get_random_basename(),
- [], 4, false, parent)
- ret = new_klass.class_eval(&b) if block_given?
- __remove_methods_of_proc_class(new_klass)
- new_klass.freeze
- ret
- end
- module_function :eval_under_random_base
-
- def new_proc_class_random(klass, func, safe = 4, add = false, &b)
- eval_under_random_base(){
- TkOption.new_proc_class(klass, func, safe, add, self, &b)
- }
- end
- module_function :new_proc_class_random
-end
-TkOption = TkOptionDB
-TkResourceDB = TkOptionDB
module TkTreatFont
def font_configinfo(name = nil)
@@ -3666,198 +1961,37 @@ module TkTreatFont
end
end
-module TkTreatItemFont
- def __conf_cmd(idx)
- raise NotImplementedError, "need to define `__conf_cmd'"
- end
- def __item_pathname(tagOrId)
- raise NotImplementedError, "need to define `__item_pathname'"
- end
- private :__conf_cmd, :__item_pathname
-
- def tagfont_configinfo(tagOrId, name = nil)
- pathname = __item_pathname(tagOrId)
- ret = TkFont.used_on(pathname)
- if ret == nil
-=begin
- if name
- ret = name
- else
- ret = TkFont.init_widget_font(pathname, self.path,
- __conf_cmd(0), __conf_cmd(1), tagOrId)
- end
-=end
- ret = TkFont.init_widget_font(pathname, self.path,
- __conf_cmd(0), __conf_cmd(1), tagOrId)
- end
- ret
- end
- alias tagfontobj tagfont_configinfo
-
- def tagfont_configure(tagOrId, slot)
- pathname = __item_pathname(tagOrId)
- slot = _symbolkey2str(slot)
- if slot.key?('font')
- fnt = slot.delete('font')
- if fnt.kind_of? TkFont
- return fnt.call_font_configure(pathname, self.path,
- __conf_cmd(0), __conf_cmd(1),
- tagOrId, slot)
- else
- if fnt
- if (slot.key?('kanjifont') ||
- slot.key?('latinfont') ||
- slot.key?('asciifont'))
- fnt = TkFont.new(fnt)
-
- lfnt = slot.delete('latinfont')
- lfnt = slot.delete('asciifont') if slot.key?('asciifont')
- kfnt = slot.delete('kanjifont')
-
- fnt.latin_replace(lfnt) if lfnt
- fnt.kanji_replace(kfnt) if kfnt
- end
-
- slot['font'] = fnt
- tk_call(self.path, __conf_cmd(0), __conf_cmd(1),
- tagOrId, *hash_kv(slot))
- end
- return self
- end
- end
-
- lfnt = slot.delete('latinfont')
- lfnt = slot.delete('asciifont') if slot.key?('asciifont')
- kfnt = slot.delete('kanjifont')
-
- if lfnt && kfnt
- return TkFont.new(lfnt, kfnt).call_font_configure(pathname, self.path,
- __conf_cmd(0),
- __conf_cmd(1),
- tagOrId, slot)
- end
-
- latintagfont_configure(tagOrId, lfnt) if lfnt
- kanjitagfont_configure(tagOrId, kfnt) if kfnt
-
- tk_call(self.path, __conf_cmd(0), __conf_cmd(1),
- tagOrId, *hash_kv(slot)) if slot != {}
- self
- end
-
- def latintagfont_configure(tagOrId, ltn, keys=nil)
- pathname = __item_pathname(tagOrId)
- if (fobj = TkFont.used_on(pathname))
- fobj = TkFont.new(fobj) # create a new TkFont object
- elsif Tk::JAPANIZED_TK
- fobj = tagfontobj(tagOrId) # create a new TkFont object
- else
- tk_call(self.path, __conf_cmd(0), __conf_cmd(1), tagOrId, '-font', ltn)
- return self
- end
-
- if fobj.kind_of?(TkFont)
- if ltn.kind_of? TkFont
- conf = {}
- ltn.latin_configinfo.each{|key,val| conf[key] = val}
- if keys
- fobj.latin_configure(conf.update(keys))
- else
- fobj.latin_configure(conf)
- end
- else
- fobj.latin_replace(ltn)
- end
- end
-
- return fobj.call_font_configure(pathname, self.path,
- __conf_cmd(0), __conf_cmd(1), tagOrId, {})
+module TkBindCore
+ def bind(context, cmd=Proc.new, args=nil)
+ Tk.bind(self, context, cmd, args)
end
- alias asciitagfont_configure latintagfont_configure
-
- def kanjitagfont_configure(tagOrId, knj, keys=nil)
- pathname = __item_pathname(tagOrId)
- if (fobj = TkFont.used_on(pathname))
- fobj = TkFont.new(fobj) # create a new TkFont object
- elsif Tk::JAPANIZED_TK
- fobj = tagfontobj(tagOrId) # create a new TkFont object
- else
- tk_call(self.path, __conf_cmd(0), __conf_cmd(1), tagOrId, '-font', knj)
- return self
- end
- if fobj.kind_of?(TkFont)
- if knj.kind_of? TkFont
- conf = {}
- knj.kanji_configinfo.each{|key,val| conf[key] = val}
- if keys
- fobj.kanji_configure(conf.update(keys))
- else
- fobj.kanji_configure(conf)
- end
- else
- fobj.kanji_replace(knj)
- end
- end
-
- return fobj.call_font_configure(pathname, self.path,
- __conf_cmd(0), __conf_cmd(1), tagOrId, {})
+ def bind_append(context, cmd=Proc.new, args=nil)
+ Tk.bind_append(self, context, cmd, args)
end
- def tagfont_copy(tagOrId, window, wintag=nil)
- pathname = __item_pathname(tagOrId)
- if wintag
- fnt = window.tagfontobj(wintag).dup
- else
- fnt = window.fontobj.dup
- end
- fnt.call_font_configure(pathname, self.path,
- __conf_cmd(0), __conf_cmd(1), tagOrId, {})
- return self
- end
-
- def latintagfont_copy(tagOrId, window, wintag=nil)
- pathname = __item_pathname(tagOrId)
- tagfontobj(tagOrId).dup.call_font_configure(pathname, self.path,
- __conf_cmd(0), __conf_cmd(1),
- tagOrId, {})
- if wintag
- tagfontobj(tagOrId).
- latin_replace(window.tagfontobj(wintag).latin_font_id)
- else
- tagfontobj(tagOrId).latin_replace(window.fontobj.latin_font_id)
- end
- self
+ def bind_remove(context)
+ Tk.bind_remove(self, context)
end
- alias asciitagfont_copy latintagfont_copy
- def kanjitagfont_copy(tagOrId, window, wintag=nil)
- pathname = __item_pathname(tagOrId)
- tagfontobj(tagOrId).dup.call_font_configure(pathname, self.path,
- __conf_cmd(0), __conf_cmd(1),
- tagOrId, {})
- if wintag
- tagfontobj(tagOrId).
- kanji_replace(window.tagfontobj(wintag).kanji_font_id)
- else
- tagfontobj(tagOrId).kanji_replace(window.fontobj.kanji_font_id)
- end
- self
+ def bindinfo(context=nil)
+ Tk.bindinfo(self, context)
end
end
+
class TkObject<TkKernel
include Tk
include TkTreatFont
include TkBindCore
def path
- return @path
+ @path
end
def epath
- return @path
+ @path
end
def to_eval
@@ -3865,18 +1999,28 @@ class TkObject<TkKernel
end
def tk_send(cmd, *rest)
- tk_call path, cmd, *rest
+ tk_call(path, cmd, *rest)
+ end
+ def tk_send_without_enc(cmd, *rest)
+ tk_call_without_enc(path, cmd, *rest)
end
- private :tk_send
+ def tk_send_with_enc(cmd, *rest)
+ tk_call_with_enc(path, cmd, *rest)
+ end
+ private :tk_send, :tk_send_without_enc, :tk_send_with_enc
def method_missing(id, *args)
name = id.id2name
case args.length
when 1
- configure name, args[0]
+ if name[-1] == ?=
+ configure name[0..-2], args[0]
+ else
+ configure name, args[0]
+ end
when 0
begin
- cget name
+ cget(name)
rescue
fail NameError,
"undefined local variable or method `#{name}' for #{self.to_s}",
@@ -3888,20 +2032,23 @@ class TkObject<TkKernel
end
def [](id)
- cget id
+ cget(id)
end
def []=(id, val)
- configure id, val
+ configure(id, val)
+ val
end
def cget(slot)
case slot.to_s
when 'text', 'label', 'show', 'data', 'file'
- tk_call path, 'cget', "-#{slot}"
+ #tk_call(path, 'cget', "-#{slot}")
+ _fromUTF8(tk_call_without_enc(path, 'cget', "-#{slot}"))
when 'font', 'kanjifont'
#fnt = tk_tcl2ruby(tk_call(path, 'cget', "-#{slot}"))
- fnt = tk_tcl2ruby(tk_call(path, 'cget', "-font"))
+ #fnt = tk_tcl2ruby(tk_call(path, 'cget', "-font"))
+ fnt = tk_tcl2ruby(tk_call_without_enc(path, 'cget', "-font"), true)
unless fnt.kind_of?(TkFont)
fnt = fontobj(fnt)
end
@@ -3912,7 +2059,7 @@ class TkObject<TkKernel
fnt
end
else
- tk_tcl2ruby tk_call(path, 'cget', "-#{slot}")
+ tk_tcl2ruby(tk_call_without_enc(path, 'cget', "-#{slot}"), true)
end
end
@@ -3924,7 +2071,7 @@ class TkObject<TkKernel
slot['asciifont'] || slot[:asciifont] )
font_configure(slot)
elsif slot.size > 0
- tk_call path, 'configure', *hash_kv(slot)
+ tk_call(path, 'configure', *hash_kv(slot))
end
else
@@ -3938,93 +2085,177 @@ class TkObject<TkKernel
font_configure({slot=>value})
end
else
- tk_call path, 'configure', "-#{slot}", value
+ tk_call(path, 'configure', "-#{slot}", value)
end
end
self
end
def configure_cmd(slot, value)
- configure slot, install_cmd(value)
+ configure(slot, install_cmd(value))
end
def configinfo(slot = nil)
- if slot == 'font' || slot == :font ||
- slot == 'kanjifont' || slot == :kanjifont
- conf = tk_split_simplelist(tk_send('configure', "-#{slot}") )
- conf[0] = conf[0][1..-1]
- conf[4] = fontobj(conf[4])
- conf
- else
- if slot
- case slot.to_s
- when 'text', 'label', 'show', 'data', 'file'
- conf = tk_split_simplelist(tk_send('configure', "-#{slot}") )
- else
- conf = tk_split_list(tk_send('configure', "-#{slot}") )
- end
+ if TkComm::GET_CONFIGINFO_AS_ARRAY
+ if slot == 'font' || slot == :font ||
+ slot == 'kanjifont' || slot == :kanjifont
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('configure', "-#{slot}")))
conf[0] = conf[0][1..-1]
+ conf[4] = fontobj(conf[4])
conf
else
- ret = tk_split_simplelist(tk_send('configure') ).collect{|conflist|
- conf = tk_split_simplelist(conflist)
- conf[0] = conf[0][1..-1]
- case conf[0]
+ if slot
+ case slot.to_s
when 'text', 'label', 'show', 'data', 'file'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('configure', "-#{slot}")))
else
- if conf[3]
- if conf[3].index('{')
- conf[3] = tk_split_list(conf[3])
- else
- conf[3] = tk_tcl2ruby(conf[3])
+ conf = tk_split_list(_fromUTF8(tk_send_without_enc('configure', "-#{slot}")))
+ end
+ conf[0] = conf[0][1..-1]
+ conf
+ else
+ ret = tk_split_simplelist(_fromUTF8(tk_send_without_enc('configure'))).collect{|conflist|
+ conf = tk_split_simplelist(conflist)
+ conf[0] = conf[0][1..-1]
+ case conf[0]
+ when 'text', 'label', 'show', 'data', 'file'
+ else
+ if conf[3]
+ if conf[3].index('{')
+ conf[3] = tk_split_list(conf[3])
+ else
+ conf[3] = tk_tcl2ruby(conf[3])
+ end
end
- end
- if conf[4]
- if conf[4].index('{')
- conf[4] = tk_split_list(conf[4])
- else
- conf[4] = tk_tcl2ruby(conf[4])
+ if conf[4]
+ if conf[4].index('{')
+ conf[4] = tk_split_list(conf[4])
+ else
+ conf[4] = tk_tcl2ruby(conf[4])
+ end
end
end
+ conf[1] = conf[1][1..-1] if conf.size == 2 # alias info
+ conf
+ }
+ fontconf = ret.assoc('font')
+ if fontconf
+ ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
+ fontconf[4] = fontobj(fontconf[4])
+ ret.push(fontconf)
+ else
+ ret
end
- conf
- }
- fontconf = ret.assoc('font')
- if fontconf
- ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
- fontconf[4] = fontobj(fontconf[4])
- ret.push(fontconf)
+ end
+ end
+ else # ! TkComm::GET_CONFIGINFO_AS_ARRAY
+ if slot == 'font' || slot == :font ||
+ slot == 'kanjifont' || slot == :kanjifont
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('configure', "-#{slot}")))
+ key = conf.shift[1..-1]
+ conf[3] = fontobj(conf[3])
+ { key => conf }
+ else
+ if slot
+ case slot.to_s
+ when 'text', 'label', 'show', 'data', 'file'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('configure', "-#{slot}")))
+ else
+ conf = tk_split_list(_fromUTF8(tk_send_without_enc('configure', "-#{slot}")))
+ end
+ key = conf.shift[1..-1]
+ { key => conf }
else
+ ret = {}
+ tk_split_simplelist(_fromUTF8(tk_send_without_enc('configure'))).each{|conflist|
+ conf = tk_split_simplelist(conflist)
+ key = conf.shift[1..-1]
+ case key
+ when 'text', 'label', 'show', 'data', 'file'
+ else
+ if conf[2]
+ if conf[2].index('{')
+ conf[2] = tk_split_list(conf[2])
+ else
+ conf[2] = tk_tcl2ruby(conf[2])
+ end
+ end
+ if conf[3]
+ if conf[3].index('{')
+ conf[3] = tk_split_list(conf[3])
+ else
+ conf[3] = tk_tcl2ruby(conf[3])
+ end
+ end
+ end
+ if conf.size == 1
+ ret[key] = conf[0][1..-1] # alias info
+ else
+ ret[key] = conf
+ end
+ }
+ fontconf = ret['font']
+ if fontconf
+ ret.delete('font')
+ ret.delete('kanjifont')
+ fontconf[3] = fontobj(fontconf[3])
+ ret['font'] = fontconf
+ end
ret
end
end
end
end
+ def current_configinfo(slot = nil)
+ if TkComm::GET_CONFIGINFO_AS_ARRAY
+ if slot
+ conf = configinfo(slot)
+ {conf[0] => conf[4]}
+ else
+ ret = {}
+ configinfo().each{|conf|
+ ret[conf[0]] = conf[4] if conf.size > 2
+ }
+ ret
+ end
+ else # ! TkComm::GET_CONFIGINFO_AS_ARRAY
+ ret = {}
+ configinfo(slot).each{|key, conf|
+ ret[key] = conf[-1] if conf.kind_of?(Array)
+ }
+ ret
+ end
+ end
+
def event_generate(context, keys=nil)
if keys
- tk_call('event', 'generate', path,
- "<#{tk_event_sequence(context)}>", *hash_kv(keys))
+ #tk_call('event', 'generate', path,
+ # "<#{tk_event_sequence(context)}>", *hash_kv(keys))
+ tk_call_without_enc('event', 'generate', path,
+ "<#{tk_event_sequence(context)}>",
+ *hash_kv(keys, true))
else
- tk_call('event', 'generate', path, "<#{tk_event_sequence(context)}>")
+ #tk_call('event', 'generate', path, "<#{tk_event_sequence(context)}>")
+ tk_call_without_enc('event', 'generate', path,
+ "<#{tk_event_sequence(context)}>")
end
end
def tk_trace_variable(v)
unless v.kind_of?(TkVariable)
- fail(ArgumentError,
- Kernel.format("type error (%s); must be TkVariable object",
- v.class))
+ fail(ArgumentError, "type error (#{v.class}); must be TkVariable object")
end
v
end
private :tk_trace_variable
def destroy
- # tk_call 'trace', 'vdelete', @tk_vn, 'w', @var_id if @var_id
+ tk_call 'trace', 'vdelete', @tk_vn, 'w', @var_id if @var_id
end
end
+
class TkWindow<TkObject
include TkWinfo
extend TkBindCore
@@ -4086,6 +2317,10 @@ class TkWindow<TkObject
end
private :create_self
+ def exist?
+ TkWinfo.exist?(self)
+ end
+
def bind_class
@db_class || self.class()
end
@@ -4109,7 +2344,12 @@ class TkWindow<TkObject
end
def pack(keys = nil)
- tk_call 'pack', epath, *hash_kv(keys)
+ #tk_call_without_enc('pack', epath, *hash_kv(keys, true))
+ if keys
+ TkPack.configure(self, keys)
+ else
+ TkPack.configure(self)
+ end
self
end
@@ -4120,48 +2360,68 @@ class TkWindow<TkObject
else
keys = {'in'=>target}
end
- tk_call 'pack', epath, *hash_kv(keys)
+ #tk_call 'pack', epath, *hash_kv(keys)
+ TkPack.configure(self, keys)
self
end
- def unpack
- tk_call 'pack', 'forget', epath
+ def pack_forget
+ #tk_call_without_enc('pack', 'forget', epath)
+ TkPack.forget(self)
self
end
- alias pack_forget unpack
+ alias unpack pack_forget
def pack_config(slot, value=None)
+ #if slot.kind_of? Hash
+ # tk_call 'pack', 'configure', epath, *hash_kv(slot)
+ #else
+ # tk_call 'pack', 'configure', epath, "-#{slot}", value
+ #end
if slot.kind_of? Hash
- tk_call 'pack', 'configure', epath, *hash_kv(slot)
+ TkPack.configure(self, slot)
else
- tk_call 'pack', 'configure', epath, "-#{slot}", value
+ TkPack.configure(self, slot=>value)
end
end
def pack_info()
- ilist = list(tk_call('pack', 'info', epath))
- info = {}
- while key = ilist.shift
- info[key[1..-1]] = ilist.shift
- end
- return info
+ #ilist = list(tk_call('pack', 'info', epath))
+ #info = {}
+ #while key = ilist.shift
+ # info[key[1..-1]] = ilist.shift
+ #end
+ #return info
+ TkPack.info(self)
end
def pack_propagate(mode=None)
+ #if mode == None
+ # bool(tk_call('pack', 'propagate', epath))
+ #else
+ # tk_call('pack', 'propagate', epath, mode)
+ # self
+ #end
if mode == None
- bool(tk_call('pack', 'propagate', epath))
+ TkPack.propagate(self)
else
- tk_call('pack', 'propagate', epath, mode)
+ TkPack.propagate(self, mode)
self
end
end
def pack_slaves()
- list(tk_call('pack', 'slaves', epath))
+ #list(tk_call('pack', 'slaves', epath))
+ TkPack.slaves(self)
end
def grid(keys = nil)
- tk_call 'grid', epath, *hash_kv(keys)
+ #tk_call 'grid', epath, *hash_kv(keys)
+ if keys
+ TkGrid.configure(self, keys)
+ else
+ TkGrid.configure(self)
+ end
self
end
@@ -4172,94 +2432,120 @@ class TkWindow<TkObject
else
keys = {'in'=>target}
end
- tk_call 'grid', epath, *hash_kv(keys)
+ #tk_call 'grid', epath, *hash_kv(keys)
+ TkGrid.configure(self, keys)
self
end
- def ungrid
- tk_call 'grid', 'forget', epath
+ def grid_forget
+ #tk_call('grid', 'forget', epath)
+ TkGrid.forget(self)
self
end
- alias grid_forget ungrid
+ alias ungrid grid_forget
def grid_bbox(*args)
- list(tk_call('grid', 'bbox', epath, *args))
+ #list(tk_call('grid', 'bbox', epath, *args))
+ TkGrid.bbox(self, *args)
end
def grid_config(slot, value=None)
+ #if slot.kind_of? Hash
+ # tk_call 'grid', 'configure', epath, *hash_kv(slot)
+ #else
+ # tk_call 'grid', 'configure', epath, "-#{slot}", value
+ #end
if slot.kind_of? Hash
- tk_call 'grid', 'configure', epath, *hash_kv(slot)
+ TkGrid.configure(self, slot)
else
- tk_call 'grid', 'configure', epath, "-#{slot}", value
+ TkGrid.configure(self, slot=>value)
end
end
def grid_columnconfig(index, keys)
- tk_call('grid', 'columnconfigure', epath, index, *hash_kv(keys))
+ #tk_call('grid', 'columnconfigure', epath, index, *hash_kv(keys))
+ TkGrid.columnconfigure(self, index, keys)
end
+ alias grid_columnconfigure grid_columnconfig
def grid_rowconfig(index, keys)
- tk_call('grid', 'rowconfigure', epath, index, *hash_kv(keys))
+ #tk_call('grid', 'rowconfigure', epath, index, *hash_kv(keys))
+ TkGrid.rowconfigure(self, index, keys)
end
+ alias grid_rowconfigure grid_rowconfig
def grid_columnconfiginfo(index, slot=nil)
- if slot
- tk_call('grid', 'columnconfigure', epath, index, "-#{slot}").to_i
- else
- ilist = list(tk_call('grid', 'columnconfigure', epath, index))
- info = {}
- while key = ilist.shift
- info[key[1..-1]] = ilist.shift
- end
- info
- end
+ #if slot
+ # tk_call('grid', 'columnconfigure', epath, index, "-#{slot}").to_i
+ #else
+ # ilist = list(tk_call('grid', 'columnconfigure', epath, index))
+ # info = {}
+ # while key = ilist.shift
+ # info[key[1..-1]] = ilist.shift
+ # end
+ # info
+ #end
+ TkGrid.columnconfiginfo(self, index, slot)
end
def grid_rowconfiginfo(index, slot=nil)
- if slot
- tk_call('grid', 'rowconfigure', epath, index, "-#{slot}").to_i
- else
- ilist = list(tk_call('grid', 'rowconfigure', epath, index))
- info = {}
- while key = ilist.shift
- info[key[1..-1]] = ilist.shift
- end
- info
- end
+ #if slot
+ # tk_call('grid', 'rowconfigure', epath, index, "-#{slot}").to_i
+ #else
+ # ilist = list(tk_call('grid', 'rowconfigure', epath, index))
+ # info = {}
+ # while key = ilist.shift
+ # info[key[1..-1]] = ilist.shift
+ # end
+ # info
+ #end
+ TkGrid.rowconfiginfo(self, index, slot)
end
def grid_info()
- list(tk_call('grid', 'info', epath))
+ #list(tk_call('grid', 'info', epath))
+ TkGrid.info(self)
end
def grid_location(x, y)
- list(tk_call('grid', 'location', epath, x, y))
+ #list(tk_call('grid', 'location', epath, x, y))
+ TkGrid.location(self, x, y)
end
def grid_propagate(mode=None)
+ #if mode == None
+ # bool(tk_call('grid', 'propagate', epath))
+ #else
+ # tk_call('grid', 'propagate', epath, mode)
+ # self
+ #end
if mode == None
- bool(tk_call('grid', 'propagate', epath))
+ TkGrid.propagete(self)
else
- tk_call('grid', 'propagate', epath, mode)
+ TkGrid.propagete(self, mode)
self
end
end
def grid_remove()
- tk_call 'grid', 'remove', epath
+ #tk_call 'grid', 'remove', epath
+ TkGrid.remove(self)
self
end
def grid_size()
- list(tk_call('grid', 'size', epath))
+ #list(tk_call('grid', 'size', epath))
+ TkGrid.size(self)
end
def grid_slaves(args)
- list(tk_call('grid', 'slaves', epath, *hash_kv(args)))
+ #list(tk_call('grid', 'slaves', epath, *hash_kv(args)))
+ TkGrid.slaves(self, args)
end
- def place(keys = nil)
- tk_call 'place', epath, *hash_kv(keys)
+ def place(keys)
+ #tk_call 'place', epath, *hash_kv(keys)
+ TkPlace.configure(self, keys)
self
end
@@ -4270,88 +2556,90 @@ class TkWindow<TkObject
else
keys = {'in'=>target}
end
- tk_call 'place', epath, *hash_kv(keys)
+ #tk_call 'place', epath, *hash_kv(keys)
+ TkPlace.configure(self, keys)
self
end
- def unplace
- tk_call 'place', 'forget', epath
+ def place_forget
+ #tk_call 'place', 'forget', epath
+ TkPlace.forget(self)
self
end
- alias place_forget unplace
+ alias unplace place_forget
def place_config(slot, value=None)
- if slot.kind_of? Hash
- tk_call 'place', 'configure', epath, *hash_kv(slot)
- else
- tk_call 'place', 'configure', epath, "-#{slot}", value
- end
+ #if slot.kind_of? Hash
+ # tk_call 'place', 'configure', epath, *hash_kv(slot)
+ #else
+ # tk_call 'place', 'configure', epath, "-#{slot}", value
+ #end
+ TkPlace.configure(self, slot, value)
end
def place_configinfo(slot = nil)
# for >= Tk8.4a2 ?
- if slot
- conf = tk_split_list(tk_call('place', 'configure', epath, "-#{slot}") )
- conf[0] = conf[0][1..-1]
- conf
- else
- tk_split_simplelist(tk_call('place',
- 'configure', epath)).collect{|conflist|
- conf = tk_split_simplelist(conflist)
- conf[0] = conf[0][1..-1]
- conf
- }
- end
+ #if slot
+ # conf = tk_split_list(tk_call('place', 'configure', epath, "-#{slot}") )
+ # conf[0] = conf[0][1..-1]
+ # conf
+ #else
+ # tk_split_simplelist(tk_call('place',
+ # 'configure', epath)).collect{|conflist|
+ # conf = tk_split_simplelist(conflist)
+ # conf[0] = conf[0][1..-1]
+ # conf
+ # }
+ #end
+ TkPlace.configinfo(slot)
end
def place_info()
- ilist = list(tk_call('place', 'info', epath))
- info = {}
- while key = ilist.shift
- info[key[1..-1]] = ilist.shift
- end
- return info
+ #ilist = list(tk_call('place', 'info', epath))
+ #info = {}
+ #while key = ilist.shift
+ # info[key[1..-1]] = ilist.shift
+ #end
+ #return info
+ TkPlace.info(self)
end
def place_slaves()
- list(tk_call('place', 'slaves', epath))
+ #list(tk_call('place', 'slaves', epath))
+ TkPlace.slaves(self)
end
- def focus(force=false)
+ def set_focus(force=false)
if force
- tk_call 'focus', '-force', path
+ tk_call_without_enc('focus', '-force', path)
else
- tk_call 'focus', path
+ tk_call_without_enc('focus', path)
end
self
end
+ alias focus set_focus
- def grab(*args)
- if !args or args.length == 0
- tk_call 'grab', 'set', path
- self
- elsif args.length == 1
- case args[0]
- when 'global', :global
- #return(tk_call('grab', 'set', '-global', path))
- tk_call('grab', 'set', '-global', path)
- return self
- when 'release', :release
- #return tk_call('grab', 'release', path)
- tk_call('grab', 'release', path)
- return self
- else
- val = tk_call('grab', args[0], path)
- end
- case args[0]
- when 'current', :current
- return window(val)
- when 'status', :status
- return val
- end
- self
+ def grab(opt = nil)
+ unless opt
+ tk_call_without_enc('grab', 'set', path)
+ return self
+ end
+
+ case opt
+ when 'global', :global
+ #return(tk_call('grab', 'set', '-global', path))
+ tk_call_without_enc('grab', 'set', '-global', path)
+ return self
+ when 'release', :release
+ #return tk_call('grab', 'release', path)
+ tk_call_without_enc('grab', 'release', path)
+ return self
+ when 'current', :current
+ return window(tk_call_without_enc('grab', 'current', path))
+ when 'status', :status
+ return tk_call_without_enc('grab', 'status', path)
else
- fail ArgumentError, 'wrong # of args'
+ return tk_call_without_enc('grab', args[0], path)
end
end
@@ -4372,20 +2660,30 @@ class TkWindow<TkObject
end
def lower(below=None)
+ # below = below.epath if below.kind_of?(TkObject)
+ below = _epath(below)
tk_call 'lower', epath, below
self
end
def raise(above=None)
+ #above = above.epath if above.kind_of?(TkObject)
+ above = _epath(above)
tk_call 'raise', epath, above
self
end
- def command(cmd=Proc.new)
- configure_cmd 'command', cmd
+ def command(cmd=nil, &b)
+ if cmd
+ configure_cmd('command', cmd)
+ elsif b
+ configure_cmd('command', Proc.new(&b))
+ else
+ cget('command')
+ end
end
- def colormodel model=None
- tk_call 'tk', 'colormodel', path, model
+ def colormodel(model=None)
+ tk_call('tk', 'colormodel', path, model)
self
end
@@ -4416,7 +2714,7 @@ class TkWindow<TkObject
}
begin
- tk_call 'destroy', epath
+ tk_call_without_enc('destroy', epath)
rescue
end
uninstall_win
@@ -4426,6 +2724,7 @@ class TkWindow<TkObject
if $SAFE >= 4
fail SecurityError, "can't wait visibility at $SAFE >= 4"
end
+ on_thread &= (Thread.list.size != 1)
if on_thread
INTERP._thread_tkwait('visibility', path)
else
@@ -4451,6 +2750,7 @@ class TkWindow<TkObject
if $SAFE >= 4
fail SecurityError, "can't wait destroy at $SAFE >= 4"
end
+ on_thread &= (Thread.list.size != 1)
if on_thread
INTERP._thread_tkwait('window', epath)
else
@@ -4491,6 +2791,7 @@ class TkWindow<TkObject
def bindtags=(taglist)
bindtags(taglist)
+ taglist
end
def bindtags_shift
@@ -4505,1499 +2806,6 @@ class TkWindow<TkObject
end
end
-class TkRoot<TkWindow
- include Wm
-
-=begin
- ROOT = []
- def TkRoot.new(keys=nil)
- if ROOT[0]
- Tk_WINDOWS["."] = ROOT[0]
- return ROOT[0]
- end
- new = super(:without_creating=>true, :widgetname=>'.')
- if keys # wm commands
- keys.each{|k,v|
- if v.kind_of? Array
- new.send(k,*v)
- else
- new.send(k,v)
- end
- }
- end
- ROOT[0] = new
- Tk_WINDOWS["."] = new
- end
-=end
- def TkRoot.new(keys=nil, &b)
- unless TkCore::INTERP.tk_windows['.']
- TkCore::INTERP.tk_windows['.'] =
- super(:without_creating=>true, :widgetname=>'.')
- end
- root = TkCore::INTERP.tk_windows['.']
- if keys # wm commands
- keys.each{|k,v|
- if v.kind_of? Array
- root.send(k,*v)
- else
- root.send(k,v)
- end
- }
- end
- root.instance_eval(&b) if block_given?
- root
- end
-
- WidgetClassName = 'Tk'.freeze
- WidgetClassNames[WidgetClassName] = self
-
- def create_self
- @path = '.'
- end
- private :create_self
-
- def path
- "."
- end
-
- def TkRoot.destroy
- TkCore::INTERP._invoke('destroy', '.')
- end
-end
-
-class TkToplevel<TkWindow
- include Wm
-
- TkCommandNames = ['toplevel'.freeze].freeze
- WidgetClassName = 'Toplevel'.freeze
- WidgetClassNames[WidgetClassName] = self
-
-################# old version
-# def initialize(parent=nil, screen=nil, classname=nil, keys=nil)
-# if screen.kind_of? Hash
-# keys = screen.dup
-# else
-# @screen = screen
-# end
-# @classname = classname
-# if keys.kind_of? Hash
-# keys = keys.dup
-# @classname = keys.delete('classname') if keys.key?('classname')
-# @colormap = keys.delete('colormap') if keys.key?('colormap')
-# @container = keys.delete('container') if keys.key?('container')
-# @screen = keys.delete('screen') if keys.key?('screen')
-# @use = keys.delete('use') if keys.key?('use')
-# @visual = keys.delete('visual') if keys.key?('visual')
-# end
-# super(parent, keys)
-# end
-#
-# def create_self
-# s = []
-# s << "-class" << @classname if @classname
-# s << "-colormap" << @colormap if @colormap
-# s << "-container" << @container if @container
-# s << "-screen" << @screen if @screen
-# s << "-use" << @use if @use
-# s << "-visual" << @visual if @visual
-# tk_call 'toplevel', @path, *s
-# end
-#################
-
- def _wm_command_option_chk(keys)
- keys = {} unless keys
- new_keys = {}
- wm_cmds = {}
- keys.each{|k,v|
- if Wm.method_defined?(k)
- case k
- when 'screen','class','colormap','container','use','visual'
- new_keys[k] = v
- else
- case self.method(k).arity
- when -1,1
- wm_cmds[k] = v
- else
- new_keys[k] = v
- end
- end
- else
- new_keys[k] = v
- end
- }
- [new_keys, wm_cmds]
- end
- private :_wm_command_option_chk
-
- def initialize(parent=nil, screen=nil, classname=nil, keys=nil)
- my_class_name = nil
- if self.class < WidgetClassNames[WidgetClassName]
- my_class_name = self.class.name
- my_class_name = nil if my_class_name == ''
- end
- if parent.kind_of? Hash
- keys = _symbolkey2str(parent)
- if keys.key?('classname')
- keys['class'] = keys.delete('classname')
- end
- @classname = keys['class']
- @colormap = keys['colormap']
- @container = keys['container']
- @screen = keys['screen']
- @use = keys['use']
- @visual = keys['visual']
- if !@classname && my_class_name
- keys['class'] = @classname = my_class_name
- end
- if @classname.kind_of? TkBindTag
- @db_class = @classname
- @classname = @classname.id
- elsif @classname
- @db_class = TkDatabaseClass.new(@classname)
- else
- @db_class = self.class
- @classname = @db_class::WidgetClassName
- end
- keys, cmds = _wm_command_option_chk(keys)
- super(keys)
- cmds.each{|k,v|
- if v.kind_of? Array
- self.send(k,*v)
- else
- self.send(k,v)
- end
- }
- return
- end
-
- if screen.kind_of? Hash
- keys = screen
- else
- @screen = screen
- if classname.kind_of? Hash
- keys = classname
- else
- @classname = classname
- end
- end
- if keys.kind_of? Hash
- keys = _symbolkey2str(keys)
- if keys.key?('classname')
- keys['class'] = keys.delete('classname')
- end
- @classname = keys['class'] unless @classname
- @colormap = keys['colormap']
- @container = keys['container']
- @screen = keys['screen'] unless @screen
- @use = keys['use']
- @visual = keys['visual']
- else
- keys = {}
- end
- if !@classname && my_class_name
- keys['class'] = @classname = my_class_name
- end
- if @classname.kind_of? TkBindTag
- @db_class = @classname
- @classname = @classname.id
- elsif @classname
- @db_class = TkDatabaseClass.new(@classname)
- else
- @db_class = self.class
- @classname = @db_class::WidgetClassName
- end
- keys, cmds = _wm_command_option_chk(keys)
- super(parent, keys)
- cmds.each{|k,v|
- if v.kind_of? Array
- self.send(k,*v)
- else
- self.send(k,v)
- end
- }
- end
-
- def create_self(keys)
- if keys and keys != None
- tk_call 'toplevel', @path, *hash_kv(keys)
- else
- tk_call 'toplevel', @path
- end
- end
- private :create_self
-
- def specific_class
- @classname
- end
-
- def self.database_class
- if self == WidgetClassNames[WidgetClassName] || self.name == ''
- self
- else
- TkDatabaseClass.new(self.name)
- end
- end
- def self.database_classname
- self.database_class.name
- end
-
- def self.bind(*args)
- if self == WidgetClassNames[WidgetClassName] || self.name == ''
- super(*args)
- else
- TkDatabaseClass.new(self.name).bind(*args)
- end
- end
- def self.bind_append(*args)
- if self == WidgetClassNames[WidgetClassName] || self.name == ''
- super(*args)
- else
- TkDatabaseClass.new(self.name).bind_append(*args)
- end
- end
- def self.bind_remove(*args)
- if self == WidgetClassNames[WidgetClassName] || self.name == ''
- super(*args)
- else
- TkDatabaseClass.new(self.name).bind_remove(*args)
- end
- end
- def self.bindinfo(*args)
- if self == WidgetClassNames[WidgetClassName] || self.name == ''
- super(*args)
- else
- TkDatabaseClass.new(self.name).bindinfo(*args)
- end
- end
-end
-
-class TkFrame<TkWindow
- TkCommandNames = ['frame'.freeze].freeze
- WidgetClassName = 'Frame'.freeze
- WidgetClassNames[WidgetClassName] = self
-
-################# old version
-# def initialize(parent=nil, keys=nil)
-# if keys.kind_of? Hash
-# keys = keys.dup
-# @classname = keys.delete('classname') if keys.key?('classname')
-# @colormap = keys.delete('colormap') if keys.key?('colormap')
-# @container = keys.delete('container') if keys.key?('container')
-# @visual = keys.delete('visual') if keys.key?('visual')
-# end
-# super(parent, keys)
-# end
-#
-# def create_self
-# s = []
-# s << "-class" << @classname if @classname
-# s << "-colormap" << @colormap if @colormap
-# s << "-container" << @container if @container
-# s << "-visual" << @visual if @visual
-# tk_call 'frame', @path, *s
-# end
-#################
-
- def initialize(parent=nil, keys=nil)
- my_class_name = nil
- if self.class < WidgetClassNames[WidgetClassName]
- my_class_name = self.class.name
- my_class_name = nil if my_class_name == ''
- end
- if parent.kind_of? Hash
- keys = _symbolkey2str(parent)
- else
- if keys
- keys = _symbolkey2str(keys)
- keys['parent'] = parent
- else
- keys = {'parent'=>parent}
- end
- end
- if keys.key?('classname')
- keys['class'] = keys.delete('classname')
- end
- @classname = keys['class']
- @colormap = keys['colormap']
- @container = keys['container']
- @visual = keys['visual']
- if !@classname && my_class_name
- keys['class'] = @classname = my_class_name
- end
- if @classname.kind_of? TkBindTag
- @db_class = @classname
- @classname = @classname.id
- elsif @classname
- @db_class = TkDatabaseClass.new(@classname)
- else
- @db_class = self.class
- @classname = @db_class::WidgetClassName
- end
- super(keys)
- end
-
- def create_self(keys)
- if keys and keys != None
- tk_call 'frame', @path, *hash_kv(keys)
- else
- tk_call 'frame', @path
- end
- end
- private :create_self
-
- def database_classname
- @classname
- end
-
- def self.database_class
- if self == WidgetClassNames[WidgetClassName] || self.name == ''
- self
- else
- TkDatabaseClass.new(self.name)
- end
- end
- def self.database_classname
- self.database_class.name
- end
-
- def self.bind(*args)
- if self == WidgetClassNames[WidgetClassName] || self.name == ''
- super(*args)
- else
- TkDatabaseClass.new(self.name).bind(*args)
- end
- end
- def self.bind_append(*args)
- if self == WidgetClassNames[WidgetClassName] || self.name == ''
- super(*args)
- else
- TkDatabaseClass.new(self.name).bind_append(*args)
- end
- end
- def self.bind_remove(*args)
- if self == WidgetClassNames[WidgetClassName] || self.name == ''
- super(*args)
- else
- TkDatabaseClass.new(self.name).bind_remove(*args)
- end
- end
- def self.bindinfo(*args)
- if self == WidgetClassNames[WidgetClassName] || self.name == ''
- super(*args)
- else
- TkDatabaseClass.new(self.name).bindinfo(*args)
- end
- end
-end
-
-class TkLabelFrame<TkFrame
- TkCommandNames = ['labelframe'.freeze].freeze
- WidgetClassName = 'Labelframe'.freeze
- WidgetClassNames[WidgetClassName] = self
- def create_self(keys)
- if keys and keys != None
- tk_call 'labelframe', @path, *hash_kv(keys)
- else
- tk_call 'labelframe', @path
- end
- end
- private :create_self
-end
-TkLabelframe = TkLabelFrame
-
-class TkPanedWindow<TkWindow
- TkCommandNames = ['panedwindow'.freeze].freeze
- WidgetClassName = 'Panedwindow'.freeze
- WidgetClassNames[WidgetClassName] = self
- def create_self(keys)
- if keys and keys != None
- tk_call 'panedwindow', @path, *hash_kv(keys)
- else
- tk_call 'panedwindow', @path
- end
- end
- private :create_self
-
- def add(*args)
- keys = args.pop
- fail ArgumentError, "no window in arguments" unless keys
- if keys && keys.kind_of?(Hash)
- fail ArgumentError, "no window in arguments" if args == []
- args = args.collect{|w| w.epath}
- args.push(hash_kv(keys))
- else
- args.push(keys) if keys
- args = args.collect{|w| w.epath}
- end
- tk_send('add', *args)
- self
- end
-
- def forget(win, *wins)
- tk_send('forget', win.epath, *(wins.collect{|w| w.epath}))
- self
- end
- alias del forget
- alias delete forget
- alias remove forget
-
- def identify(x, y)
- list(tk_send('identify', x, y))
- end
-
- def proxy_coord
- list(tk_send('proxy', 'coord'))
- end
- def proxy_forget
- tk_send('proxy', 'forget')
- self
- end
- def proxy_place(x, y)
- tk_send('proxy', 'place', x, y)
- self
- end
-
- def sash_coord(index)
- list(tk_send('sash', 'coord', index))
- end
- def sash_dragto(index)
- tk_send('sash', 'dragto', index, x, y)
- self
- end
- def sash_mark(index, x, y)
- tk_send('sash', 'mark', index, x, y)
- self
- end
- def sash_place(index, x, y)
- tk_send('sash', 'place', index, x, y)
- self
- end
-
- def panecget(win, key)
- tk_tcl2ruby(tk_send('panecget', win.epath, "-#{key}"))
- end
-
- def paneconfigure(win, key, value=nil)
- if key.kind_of? Hash
- tk_send('paneconfigure', win.epath, *hash_kv(key))
- else
- tk_send('paneconfigure', win.epath, "-#{key}", value)
- end
- self
- end
- alias pane_config paneconfigure
-
- def paneconfiginfo(win, key=nil)
- if key
- conf = tk_split_list(tk_send('paneconfigure', win.epath, "-#{key}"))
- conf[0] = conf[0][1..-1]
- conf
- else
- tk_split_simplelist(tk_send('paneconfigure',
- win.epath)).collect{|conflist|
- conf = tk_split_simplelist(conflist)
- conf[0] = conf[0][1..-1]
- if conf[3]
- if conf[3].index('{')
- conf[3] = tk_split_list(conf[3])
- else
- conf[3] = tk_tcl2ruby(conf[3])
- end
- end
- if conf[4]
- if conf[4].index('{')
- conf[4] = tk_split_list(conf[4])
- else
- conf[4] = tk_tcl2ruby(conf[4])
- end
- end
- conf
- }
- end
- end
- alias pane_configinfo paneconfiginfo
-
- def panes
- list(tk_send('panes'))
- end
-end
-TkPanedwindow = TkPanedWindow
-
-class TkLabel<TkWindow
- TkCommandNames = ['label'.freeze].freeze
- WidgetClassName = 'Label'.freeze
- WidgetClassNames[WidgetClassName] = self
- def create_self(keys)
- if keys and keys != None
- tk_call 'label', @path, *hash_kv(keys)
- else
- tk_call 'label', @path
- end
- end
- private :create_self
-
- def textvariable(v)
- configure 'textvariable', tk_trace_variable(v)
- end
-end
-
-class TkButton<TkLabel
- TkCommandNames = ['button'.freeze].freeze
- WidgetClassName = 'Button'.freeze
- WidgetClassNames[WidgetClassName] = self
- def create_self(keys)
- if keys and keys != None
- tk_call 'button', @path, *hash_kv(keys)
- else
- tk_call 'button', @path
- end
- end
- private :create_self
-
- def invoke
- tk_send 'invoke'
- end
- def flash
- tk_send 'flash'
- self
- end
-end
-
-class TkRadioButton<TkButton
- TkCommandNames = ['radiobutton'.freeze].freeze
- WidgetClassName = 'Radiobutton'.freeze
- WidgetClassNames[WidgetClassName] = self
- def create_self(keys)
- if keys and keys != None
- tk_call 'radiobutton', @path, *hash_kv(keys)
- else
- tk_call 'radiobutton', @path
- end
- end
- private :create_self
-
- def deselect
- tk_send 'deselect'
- self
- end
- def select
- tk_send 'select'
- self
- end
- def variable(v)
- configure 'variable', tk_trace_variable(v)
- end
-end
-TkRadiobutton = TkRadioButton
-
-class TkCheckButton<TkRadioButton
- TkCommandNames = ['checkbutton'.freeze].freeze
- WidgetClassName = 'Checkbutton'.freeze
- WidgetClassNames[WidgetClassName] = self
- def create_self(keys)
- if keys and keys != None
- tk_call 'checkbutton', @path, *hash_kv(keys)
- else
- tk_call 'checkbutton', @path
- end
- end
- private :create_self
-
- def toggle
- tk_send 'toggle'
- self
- end
-end
-TkCheckbutton = TkCheckButton
-
-class TkMessage<TkLabel
- TkCommandNames = ['message'.freeze].freeze
- WidgetClassName = 'Message'.freeze
- WidgetClassNames[WidgetClassName] = self
- def create_self(keys)
- if keys and keys != None
- tk_call 'message', @path, *hash_kv(keys)
- else
- tk_call 'message', @path
- end
- end
- private :create_self
-end
-
-class TkScale<TkWindow
- TkCommandNames = ['scale'.freeze].freeze
- WidgetClassName = 'Scale'.freeze
- WidgetClassNames[WidgetClassName] = self
-
- def create_self(keys)
- if keys and keys != None
- if keys.key?('command')
- cmd = keys.delete('command')
- keys['command'] = proc{|val| cmd.call(val.to_f)}
- end
- tk_call 'scale', @path, *hash_kv(keys)
- else
- tk_call 'scale', @path
- end
- end
- private :create_self
-
- def _wrap_command_arg(cmd)
- proc{|val|
- if val.kind_of?(String)
- cmd.call(number(val))
- else
- cmd.call(val)
- end
- }
- end
- private :_wrap_command_arg
-
- def configure_cmd(slot, value)
- configure(slot=>value)
- end
-
- def configure(slot, value=None)
- if (slot == 'command' || slot == :command)
- configure('command'=>value)
- elsif slot.kind_of?(Hash) &&
- (slot.key?('command') || slot.key?(:command))
- slot = _symbolkey2str(slot)
- slot['command'] = _wrap_command_arg(slot.delete('command'))
- end
- super(slot, value)
- end
-
- def command(cmd=Proc.new)
- configure('command'=>cmd)
- end
-
- def get(x=None, y=None)
- number(tk_send('get', x, y))
- end
-
- def coords(val=None)
- tk_split_list(tk_send('coords', val))
- end
-
- def identify(x, y)
- tk_send('identify', x, y)
- end
-
- def set(val)
- tk_send("set", val)
- end
-
- def value
- get
- end
-
- def value= (val)
- set(val)
- end
-end
-
-class TkScrollbar<TkWindow
- TkCommandNames = ['scrollbar'.freeze].freeze
- WidgetClassName = 'Scrollbar'.freeze
- WidgetClassNames[WidgetClassName] = self
-
- def create_self(keys)
- @assigned = []
- @scroll_proc = proc{|*args|
- if self.orient == 'horizontal'
- @assigned.each{|w| w.xview(*args)}
- else # 'vertical'
- @assigned.each{|w| w.yview(*args)}
- end
- }
-
- if keys and keys != None
- tk_call 'scrollbar', @path, *hash_kv(keys)
- else
- tk_call 'scrollbar', @path
- end
- end
- private :create_self
-
- def assign(*wins)
- begin
- self.command(@scroll_proc) if self.cget('command').cmd != @scroll_proc
- rescue Exception
- self.command(@scroll_proc)
- end
- orient = self.orient
- wins.each{|w|
- @assigned << w unless @assigned.index(w)
- if orient == 'horizontal'
- w.xscrollcommand proc{|first, last| self.set(first, last)}
- else # 'vertical'
- w.yscrollcommand proc{|first, last| self.set(first, last)}
- end
- }
- self
- end
-
- def assigned_list
- begin
- return @assigned.dup if self.cget('command').cmd == @scroll_proc
- rescue Exception
- end
- fail RuntimeError, "not depend on the assigned_list"
- end
-
- def delta(deltax=None, deltay=None)
- number(tk_send('delta', deltax, deltay))
- end
-
- def fraction(x=None, y=None)
- number(tk_send('fraction', x, y))
- end
-
- def identify(x, y)
- tk_send('identify', x, y)
- end
-
- def get
- ary1 = tk_send('get').split
- ary2 = []
- for i in ary1
- ary2.push number(i)
- end
- ary2
- end
-
- def set(first, last)
- tk_send "set", first, last
- self
- end
-
- def activate(element=None)
- tk_send('activate', element)
- end
-end
-
-class TkXScrollbar<TkScrollbar
- def create_self(keys)
- keys = {} unless keys
- keys['orient'] = 'horizontal'
- super(keys)
- end
- private :create_self
-end
-
-class TkYScrollbar<TkScrollbar
- def create_self(keys)
- keys = {} unless keys
- keys['orient'] = 'vertical'
- super(keys)
- end
- private :create_self
-end
-
-class TkTextWin<TkWindow
- def create_self
- fail RuntimeError, "TkTextWin is an abstract class"
- end
- private :create_self
-
- def bbox(index)
- list(tk_send('bbox', index))
- end
- def delete(first, last=None)
- tk_send 'delete', first, last
- self
- end
- def get(*index)
- tk_send 'get', *index
- end
- def insert(index, *args)
- tk_send 'insert', index, *args
- self
- end
- def scan_mark(x, y)
- tk_send 'scan', 'mark', x, y
- self
- end
- def scan_dragto(x, y)
- tk_send 'scan', 'dragto', x, y
- self
- end
- def see(index)
- tk_send 'see', index
- self
- end
-end
-
-module TkTreatListItemFont
- include TkTreatItemFont
-
- ItemCMD = ['itemconfigure'.freeze, TkComm::None].freeze
- def __conf_cmd(idx)
- ItemCMD[idx]
- end
-
- def __item_pathname(tagOrId)
- self.path + ';' + tagOrId.to_s
- end
-
- private :__conf_cmd, :__item_pathname
-end
-
-class TkListbox<TkTextWin
- include TkTreatListItemFont
- include Scrollable
-
- TkCommandNames = ['listbox'.freeze].freeze
- WidgetClassName = 'Listbox'.freeze
- WidgetClassNames[WidgetClassName] = self
-
- def create_self(keys)
- if keys and keys != None
- tk_call 'listbox', @path, *hash_kv(keys)
- else
- tk_call 'listbox', @path
- end
- end
- private :create_self
-
- def activate(y)
- tk_send 'activate', y
- self
- end
- def curselection
- list(tk_send('curselection'))
- end
- def get(*index)
- v = tk_send('get', *index)
- if index.size == 1
- v
- else
- tk_split_simplelist(v)
- end
- end
- def nearest(y)
- tk_send('nearest', y).to_i
- end
- def size
- tk_send('size').to_i
- end
- def selection_anchor(index)
- tk_send 'selection', 'anchor', index
- self
- end
- def selection_clear(first, last=None)
- tk_send 'selection', 'clear', first, last
- self
- end
- def selection_includes(index)
- bool(tk_send('selection', 'includes', index))
- end
- def selection_set(first, last=None)
- tk_send 'selection', 'set', first, last
- self
- end
-
- def index(index)
- tk_send('index', index).to_i
- end
-
- def itemcget(index, key)
- case key.to_s
- when 'text', 'label', 'show'
- tk_send('itemcget', index, "-#{key}")
- when 'font', 'kanjifont'
- #fnt = tk_tcl2ruby(tk_send('itemcget', index, "-#{key}"))
- fnt = tk_tcl2ruby(tk_send('itemcget', index, '-font'))
- unless fnt.kind_of?(TkFont)
- fnt = tagfontobj(index, fnt)
- end
- if key.to_s == 'kanjifont' && JAPANIZED_TK && TK_VERSION =~ /^4\.*/
- # obsolete; just for compatibility
- fnt.kanji_font
- else
- fnt
- end
- else
- tk_tcl2ruby(tk_send('itemcget', index, "-#{key}"))
- end
- end
- def itemconfigure(index, key, val=None)
- if key.kind_of? Hash
- if (key['font'] || key[:font] ||
- key['kanjifont'] || key[:kanjifont] ||
- key['latinfont'] || key[:latinfont] ||
- key['asciifont'] || key[:asciifont] )
- tagfont_configure(index, _symbolkey2str(key))
- else
- tk_send 'itemconfigure', index, *hash_kv(key)
- end
-
- else
- if (key == 'font' || key == :font ||
- key == 'kanjifont' || key == :kanjifont ||
- key == 'latinfont' || key == :latinfont ||
- key == 'asciifont' || key == :asciifont )
- if val == None
- tagfontobj(index)
- else
- tagfont_configure(index, {key=>val})
- end
- else
- tk_call 'itemconfigure', index, "-#{key}", val
- end
- end
- self
- end
-
- def itemconfiginfo(index, key=nil)
- if key
- case key.to_s
- when 'text', 'label', 'show'
- conf = tk_split_simplelist(tk_send('itemconfigure',index,"-#{key}"))
- when 'font', 'kanjifont'
- conf = tk_split_simplelist(tk_send('itemconfigure',index,"-#{key}") )
- conf[4] = tagfont_configinfo(index, conf[4])
- else
- conf = tk_split_list(tk_send('itemconfigure',index,"-#{key}"))
- end
- conf[0] = conf[0][1..-1]
- conf
- else
- ret = tk_split_simplelist(tk_send('itemconfigure',
- index)).collect{|conflist|
- conf = tk_split_simplelist(conflist)
- conf[0] = conf[0][1..-1]
- case conf[0]
- when 'text', 'label', 'show'
- else
- if conf[3]
- if conf[3].index('{')
- conf[3] = tk_split_list(conf[3])
- else
- conf[3] = tk_tcl2ruby(conf[3])
- end
- end
- if conf[4]
- if conf[4].index('{')
- conf[4] = tk_split_list(conf[4])
- else
- conf[4] = tk_tcl2ruby(conf[4])
- end
- end
- end
- conf
- }
- fontconf = ret.assoc('font')
- if fontconf
- ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
- fontconf[4] = tagfont_configinfo(index, fontconf[4])
- ret.push(fontconf)
- else
- ret
- end
- end
- end
-end
-
-module TkTreatMenuEntryFont
- include TkTreatItemFont
-
- ItemCMD = ['entryconfigure'.freeze, TkComm::None].freeze
- def __conf_cmd(idx)
- ItemCMD[idx]
- end
-
- def __item_pathname(tagOrId)
- self.path + ';' + tagOrId.to_s
- end
-
- private :__conf_cmd, :__item_pathname
-end
-
-class TkMenu<TkWindow
- include TkTreatMenuEntryFont
-
- TkCommandNames = ['menu'.freeze].freeze
- WidgetClassName = 'Menu'.freeze
- WidgetClassNames[WidgetClassName] = self
-
- def create_self(keys)
- if keys and keys != None
- tk_call 'menu', @path, *hash_kv(keys)
- else
- tk_call 'menu', @path
- end
- end
- private :create_self
-
- def activate(index)
- tk_send 'activate', index
- self
- end
- def add(type, keys=nil)
- tk_send 'add', type, *hash_kv(keys)
- self
- end
- def add_cascade(keys=nil)
- add('cascade', keys)
- end
- def add_checkbutton(keys=nil)
- add('checkbutton', keys)
- end
- def add_command(keys=nil)
- add('command', keys)
- end
- def add_radiobutton(keys=nil)
- add('radiobutton', keys)
- end
- def add_separator(keys=nil)
- add('separator', keys)
- end
- def index(index)
- ret = tk_send('index', index)
- (ret == 'none')? nil: number(ret)
- end
- def invoke(index)
- tk_send 'invoke', index
- end
- def insert(index, type, keys=nil)
- tk_send 'insert', index, type, *hash_kv(keys)
- self
- end
- def delete(index, last=None)
- tk_send 'delete', index, last
- self
- end
- def popup(x, y, index=None)
- tk_call('tk_popup', path, x, y, index)
- self
- end
- def post(x, y)
- tk_send 'post', x, y
- self
- end
- def postcascade(index)
- tk_send 'postcascade', index
- self
- end
- def postcommand(cmd=Proc.new)
- configure_cmd 'postcommand', cmd
- self
- end
- def set_focus
- tk_call('tk_menuSetFocus', path)
- end
- def tearoffcommand(cmd=Proc.new)
- configure_cmd 'tearoffcommand', cmd
- self
- end
- def menutype(index)
- tk_send 'type', index
- end
- def unpost
- tk_send 'unpost'
- end
- def yposition(index)
- number(tk_send('yposition', index))
- end
- def entrycget(index, key)
- case key.to_s
- when 'text', 'label', 'show'
- tk_send 'entrycget', index, "-#{key}"
- when 'font', 'kanjifont'
- #fnt = tk_tcl2ruby(tk_send('entrycget', index, "-#{key}"))
- fnt = tk_tcl2ruby(tk_send('entrycget', index, '-font'))
- unless fnt.kind_of?(TkFont)
- fnt = tagfontobj(index, fnt)
- end
- if key.to_s == 'kanjifont' && JAPANIZED_TK && TK_VERSION =~ /^4\.*/
- # obsolete; just for compatibility
- fnt.kanji_font
- else
- fnt
- end
- else
- tk_tcl2ruby(tk_send('entrycget', index, "-#{key}"))
- end
- end
- def entryconfigure(index, key, val=None)
- if key.kind_of? Hash
- if (key['font'] || key[:font] ||
- key['kanjifont'] || key[:kanjifont] ||
- key['latinfont'] || key[:latinfont] ||
- key['asciifont'] || key[:asciifont])
- tagfont_configure(index, _symbolkey2str(key))
- else
- tk_send 'entryconfigure', index, *hash_kv(key)
- end
-
- else
- if (key == 'font' || key == :font ||
- key == 'kanjifont' || key == :kanjifont ||
- key == 'latinfont' || key == :latinfont ||
- key == 'asciifont' || key == :asciifont )
- if val == None
- tagfontobj(index)
- else
- tagfont_configure(index, {key=>val})
- end
- else
- tk_call 'entryconfigure', index, "-#{key}", val
- end
- end
- self
- end
-
- def entryconfiginfo(index, key=nil)
- if key
- case key.to_s
- when 'text', 'label', 'show'
- conf = tk_split_simplelist(tk_send('entryconfigure',index,"-#{key}"))
- when 'font', 'kanjifont'
- conf = tk_split_simplelist(tk_send('entryconfigure',index,"-#{key}"))
- conf[4] = tagfont_configinfo(index, conf[4])
- else
- conf = tk_split_list(tk_send('entryconfigure',index,"-#{key}"))
- end
- conf[0] = conf[0][1..-1]
- conf
- else
- ret = tk_split_simplelist(tk_send('entryconfigure',
- index)).collect{|conflist|
- conf = tk_split_simplelist(conflist)
- conf[0] = conf[0][1..-1]
- case conf[0]
- when 'text', 'label', 'show'
- else
- if conf[3]
- if conf[3].index('{')
- conf[3] = tk_split_list(conf[3])
- else
- conf[3] = tk_tcl2ruby(conf[3])
- end
- end
- if conf[4]
- if conf[4].index('{')
- conf[4] = tk_split_list(conf[4])
- else
- conf[4] = tk_tcl2ruby(conf[4])
- end
- end
- end
- conf
- }
- if fontconf
- ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
- fontconf[4] = tagfont_configinfo(index, fontconf[4])
- ret.push(fontconf)
- else
- ret
- end
- end
- end
-end
-
-class TkMenuClone<TkMenu
- def initialize(parent, type=None)
- widgetname = nil
- if parent.kind_of? Hash
- keys = _symbolkey2str(parent)
- parent = keys.delete('parent')
- widgetname = keys.delete('widgetname')
- type = keys.delete('type'); type = None unless type
- end
- unless parent.kind_of?(TkMenu)
- fail ArgumentError, "parent must be TkMenu"
- end
- @parent = parent
- install_win(@parent.path, widgetname)
- tk_call @parent.path, 'clone', @path, type
- end
-end
-
-module TkSystemMenu
- def initialize(parent, keys=nil)
- if parent.kind_of? Hash
- keys = _symbolkey2str(parent)
- parent = keys.delete('parent')
- end
- unless parent.kind_of? TkMenu
- fail ArgumentError, "parent must be a TkMenu object"
- end
- @path = Kernel.format("%s.%s", parent.path, self.class::SYSMENU_NAME)
- #TkComm::Tk_WINDOWS[@path] = self
- TkCore::INTERP.tk_windows[@path] = self
- if self.method(:create_self).arity == 0
- p 'create_self has no arg' if $DEBUG
- create_self
- configure(keys) if keys
- else
- p 'create_self has an arg' if $DEBUG
- create_self(keys)
- end
- end
-end
-
-class TkSysMenu_Help<TkMenu
- # for all platform
- include TkSystemMenu
- SYSMENU_NAME = 'help'
-end
-
-class TkSysMenu_System<TkMenu
- # for Windows
- include TkSystemMenu
- SYSMENU_NAME = 'system'
-end
-
-class TkSysMenu_Apple<TkMenu
- # for Machintosh
- include TkSystemMenu
- SYSMENU_NAME = 'apple'
-end
-
-class TkMenubutton<TkLabel
- TkCommandNames = ['menubutton'.freeze].freeze
- WidgetClassName = 'Menubutton'.freeze
- WidgetClassNames[WidgetClassName] = self
- def create_self(keys)
- if keys and keys != None
- tk_call 'menubutton', @path, *hash_kv(keys)
- else
- tk_call 'menubutton', @path
- end
- end
- private :create_self
-end
-
-class TkOptionMenubutton<TkMenubutton
- TkCommandNames = ['tk_optionMenu'.freeze].freeze
-
- class OptionMenu<TkMenu
- def initialize(path) #==> return value of tk_optionMenu
- @path = path
- #TkComm::Tk_WINDOWS[@path] = self
- TkCore::INTERP.tk_windows[@path] = self
- end
- end
-
- def initialize(parent=nil, var=TkVariable.new, firstval=nil, *vals)
- if parent.kind_of? Hash
- keys = _symbolkey2str(parent)
- parent = keys['parent']
- var = keys['variable'] if keys['variable']
- firstval, *vals = keys['values']
- end
- fail 'variable option must be TkVariable' unless var.kind_of? TkVariable
- @variable = var
- firstval = @variable.value unless firstval
- @variable.value = firstval
- install_win(if parent then parent.path end)
- @menu = OptionMenu.new(tk_call('tk_optionMenu', @path, @variable.id,
- firstval, *vals))
- end
-
- def value
- @variable.value
- end
-
- def activate(index)
- @menu.activate(index)
- self
- end
- def add(value)
- @menu.add('radiobutton', 'variable'=>@variable,
- 'label'=>value, 'value'=>value)
- self
- end
- def index(index)
- @menu.index(index)
- end
- def invoke(index)
- @menu.invoke(index)
- end
- def insert(index, value)
- @menu.add(index, 'radiobutton', 'variable'=>@variable,
- 'label'=>value, 'value'=>value)
- self
- end
- def delete(index, last=None)
- @menu.delete(index, last)
- self
- end
- def yposition(index)
- @menu.yposition(index)
- end
- def menu
- @menu
- end
- def menucget(key)
- @menu.cget(key)
- end
- def menuconfigure(key, val=None)
- @menu.configure(key, val)
- self
- end
- def menuconfiginfo(key=nil)
- @menu.configinfo(key)
- end
- def entrycget(index, key)
- @menu.entrycget(index, key)
- end
- def entryconfigure(index, key, val=None)
- @menu.entryconfigure(index, key, val)
- self
- end
- def entryconfiginfo(index, key=nil)
- @menu.entryconfiginfo(index, key)
- end
-end
-
-module TkComposite
- include Tk
- extend Tk
-
- def initialize(parent=nil, *args)
- @delegates = {}
-
- if parent.kind_of? Hash
- keys = _symbolkey2str(parent)
- parent = keys.delete('parent')
- @frame = TkFrame.new(parent)
- @delegates['DEFAULT'] = @frame
- @path = @epath = @frame.path
- initialize_composite(keys)
- else
- @frame = TkFrame.new(parent)
- @delegates['DEFAULT'] = @frame
- @path = @epath = @frame.path
- initialize_composite(*args)
- end
- end
-
- def epath
- @epath
- end
-
- def initialize_composite(*args) end
- private :initialize_composite
-
- def delegate(option, *wins)
- if @delegates[option].kind_of?(Array)
- for i in wins
- @delegates[option].push(i)
- end
- else
- @delegates[option] = wins
- end
- end
-
- def configure(slot, value=None)
- if slot.kind_of? Hash
- slot.each{|slot,value| configure slot, value}
- else
- if @delegates and @delegates[slot]
- for i in @delegates[slot]
- if not i
- i = @delegates['DEFALUT']
- redo
- else
- last = i.configure(slot, value)
- end
- end
- last
- else
- super
- end
- end
- end
-end
-
-module TkClipboard
- include Tk
- extend Tk
-
- TkCommandNames = ['clipboard'.freeze].freeze
-
- def self.clear(win=nil)
- if win
- tk_call 'clipboard', 'clear', '-displayof', win
- else
- tk_call 'clipboard', 'clear'
- end
- end
- def self.clear_on_display(win)
- tk_call 'clipboard', 'clear', '-displayof', win
- end
-
- def self.get(type=nil)
- if type
- tk_call 'clipboard', 'get', '-type', type
- else
- tk_call 'clipboard', 'get'
- end
- end
- def self.get_on_display(win, type=nil)
- if type
- tk_call 'clipboard', 'get', '-displayof', win, '-type', type
- else
- tk_call 'clipboard', 'get', '-displayof', win
- end
- end
-
- def self.set(data, keys=nil)
- clear
- append(data, keys)
- end
- def self.set_on_display(win, data, keys=nil)
- clear(win)
- append_on_display(win, data, keys)
- end
-
- def self.append(data, keys=nil)
- args = ['clipboard', 'append']
- args += hash_kv(keys)
- args += ['--', data]
- tk_call(*args)
- end
- def self.append_on_display(win, data, keys=nil)
- args = ['clipboard', 'append', '-displayof', win]
- args += hash_kv(keys)
- args += ['--', data]
- tk_call(*args)
- end
-
- def clear
- TkClipboard.clear_on_display(self)
- self
- end
- def get(type=nil)
- TkClipboard.get_on_display(self, type)
- end
- def set(data, keys=nil)
- TkClipboard.set_on_display(self, data, keys)
- self
- end
- def append(data, keys=nil)
- TkClipboard.append_on_display(self, data, keys)
- self
- end
-end
-
-# widget_destroy_hook
-require 'tkvirtevent'
-TkBindTag::ALL.bind(TkVirtualEvent.new('Destroy'), proc{|xpath|
- path = xpath[1..-1]
- if (widget = TkCore::INTERP.tk_windows[path])
- if widget.respond_to?(:__destroy_hook__)
- begin
- widget.__destroy_hook__
- rescue Exception
- end
- end
- end
- }, 'x%W')
# freeze core modules
#TclTkLib.freeze
@@ -6009,27 +2817,11 @@ TkBindTag::ALL.bind(TkVirtualEvent.new('Destroy'), proc{|xpath|
#TkCore.freeze
#Tk.freeze
-# autoload
-autoload :TkCanvas, 'tkcanvas'
-autoload :TkImage, 'tkcanvas'
-autoload :TkBitmapImage, 'tkcanvas'
-autoload :TkPhotoImage, 'tkcanvas'
-autoload :TkEntry, 'tkentry'
-autoload :TkSpinbox, 'tkentry'
-autoload :TkText, 'tktext'
-autoload :TkDialog, 'tkdialog'
-autoload :TkDialog2, 'tkdialog'
-autoload :TkWarning, 'tkdialog'
-autoload :TkWarning2, 'tkdialog'
-autoload :TkMenubar, 'tkmenubar'
-autoload :TkAfter, 'tkafter'
-autoload :TkTimer, 'tkafter'
-autoload :TkPalette, 'tkpalette'
-autoload :TkFont, 'tkfont'
-autoload :TkBgError, 'tkbgerror'
-autoload :TkManageFocus, 'tkmngfocus'
-autoload :TkPalette, 'tkpalette'
-autoload :TkWinDDE, 'tkwinpkg'
-autoload :TkWinRegistry, 'tkwinpkg'
-autoload :TkMacResource, 'tkmacpkg'
-autoload :TkConsole, 'tkconsole'
+module Tk
+ autoload :AUTO_PATH, 'tk/variable'
+ autoload :TCL_PACKAGE_PATH, 'tk/variable'
+ autoload :PACKAGE_PATH, 'tk/variable'
+ autoload :TCL_LIBRARY_PATH, 'tk/variable'
+ autoload :LIBRARY_PATH, 'tk/variable'
+ autoload :TCL_PRECISION, 'tk/variable'
+end
diff --git a/ext/tk/lib/tk/after.rb b/ext/tk/lib/tk/after.rb
new file mode 100644
index 0000000000..8c58210331
--- /dev/null
+++ b/ext/tk/lib/tk/after.rb
@@ -0,0 +1,6 @@
+#
+# tk/after.rb : methods for Tcl/Tk after command
+#
+# $Id$
+#
+require 'tk/timer'
diff --git a/ext/tk/lib/tk/autoload.rb b/ext/tk/lib/tk/autoload.rb
new file mode 100644
index 0000000000..0a8251af8b
--- /dev/null
+++ b/ext/tk/lib/tk/autoload.rb
@@ -0,0 +1,181 @@
+#
+# autoload
+#
+
+#######################
+# geometry manager
+autoload :TkGrid, 'tk/grid'
+def TkGrid(*args); TkGrid.configure(*args); end
+
+autoload :TkPack, 'tk/pack'
+def TkPack(*args); TkPack.configure(*args); end
+
+autoload :TkPlace, 'tk/place'
+def TkPlace(*args); TkPlace.configure(*args); end
+
+
+#######################
+# others
+autoload :TkBgError, 'tk/bgerror'
+
+autoload :TkBindTag, 'tk/bindtag'
+autoload :TkBindTagAll, 'tk/bindtag'
+autoload :TkDatabaseClass, 'tk/bindtag'
+
+autoload :TkButton, 'tk/button'
+
+autoload :TkConsole, 'tk/console'
+
+autoload :TkCanvas, 'tk/canvas'
+
+autoload :TkcTagAccess, 'tk/canvastag'
+autoload :TkcTag, 'tk/canvastag'
+autoload :TkcTagString, 'tk/canvastag'
+autoload :TkcNamedTag, 'tk/canvastag'
+autoload :TkcTagAll, 'tk/canvastag'
+autoload :TkcTagCurrent, 'tk/canvastag'
+autoload :TkcTagGroup, 'tk/canvastag'
+
+autoload :TkCheckButton, 'tk/checkbutton'
+autoload :TkCheckbutton, 'tk/checkbutton'
+
+autoload :TkClipboard, 'tk/clipboard'
+
+autoload :TkComposite, 'tk/composite'
+
+autoload :TkConsole, 'tk/console'
+
+autoload :TkDialog, 'tk/dialog'
+autoload :TkDialog2, 'tk/dialog'
+autoload :TkWarning, 'tk/dialog'
+autoload :TkWarning2, 'tk/dialog'
+
+autoload :TkEntry, 'tk/entry'
+
+autoload :TkEvent, 'tk/event'
+
+autoload :TkFont, 'tk/font'
+autoload :TkTreatTagFont, 'tk/font'
+
+autoload :TkFrame, 'tk/frame'
+
+autoload :TkImage, 'tk/image'
+autoload :TkBitmapImage, 'tk/image'
+autoload :TkPhotoImage, 'tk/image'
+
+autoload :TkTreatItemFont, 'tk/itemfont'
+
+autoload :TkKinput, 'tk/kinput'
+
+autoload :TkLabel, 'tk/label'
+
+autoload :TkLabelFrame, 'tk/labelframe'
+autoload :TkLabelframe, 'tk/labelframe'
+
+autoload :TkListbox, 'tk/listbox'
+
+autoload :TkMacResource, 'tk/macpkg'
+
+autoload :TkMenu, 'tk/menu'
+autoload :TkMenuClone, 'tk/menu'
+autoload :TkSystemMenu, 'tk/menu'
+autoload :TkSysMenu_Help, 'tk/menu'
+autoload :TkSysMenu_System, 'tk/menu'
+autoload :TkSysMenu_Apple, 'tk/menu'
+autoload :TkMenubutton, 'tk/menu'
+autoload :TkOptionMenubutton, 'tk/menu'
+
+autoload :TkMenubar, 'tk/menubar'
+
+autoload :TkMessage, 'tk/message'
+
+autoload :TkManageFocus, 'tk/mngfocus'
+
+autoload :TkMsgCatalog, 'tk/msgcat'
+autoload :TkMsgCat, 'tk/msgcat'
+
+autoload :TkNamespace, 'tk/namespace'
+
+autoload :TkOptionDB, 'tk/optiondb'
+autoload :TkOption, 'tk/optiondb'
+autoload :TkResourceDB, 'tk/optiondb'
+
+autoload :TkPackage, 'tk/package'
+
+autoload :TkPalette, 'tk/palette'
+
+autoload :TkPanedWindow, 'tk/panedwindow'
+autoload :TkPanedwindow, 'tk/panedwindow'
+
+autoload :TkRadioButton, 'tk/radiobutton'
+autoload :TkRadiobutton, 'tk/radiobutton'
+
+autoload :TkRoot, 'tk/root'
+
+autoload :TkScale, 'tk/scale'
+
+autoload :TkScrollbar, 'tk/scrollbar'
+autoload :TkXScrollbar, 'tk/scrollbar'
+autoload :TkYScrollbar, 'tk/scrollbar'
+
+autoload :TkScrollbox, 'tk/scrollbox'
+
+autoload :TkSelection, 'tk/selection'
+
+autoload :TkSpinbox, 'tk/spinbox'
+
+autoload :TkTreatTagFont, 'tk/tagfont'
+
+autoload :TkText, 'tk/text'
+
+autoload :TkTextImage, 'tk/textimage'
+
+autoload :TkTextMark, 'tk/textmark'
+autoload :TkTextNamedMark, 'tk/textmark'
+autoload :TkTextMarkInsert, 'tk/textmark'
+autoload :TkTextMarkCurrent, 'tk/textmark'
+autoload :TkTextMarkAnchor, 'tk/textmark'
+
+autoload :TkTextTag, 'tk/texttag'
+autoload :TkTextNamedTag, 'tk/texttag'
+autoload :TkTextTagSel, 'tk/texttag'
+
+autoload :TkTextWindow, 'tk/textwindow'
+
+autoload :TkAfter, 'tk/timer'
+autoload :TkTimer, 'tk/timer'
+
+autoload :TkToplevel, 'tk/toplevel'
+
+autoload :TkTextWin, 'tk/txtwin_abst'
+
+autoload :TkValidation, 'tk/validation'
+autoload :TkVariable, 'tk/variable'
+autoload :TkVarAccess, 'tk/variable'
+
+autoload :TkVirtualEvent, 'tk/virtevent'
+
+autoload :TkWinfo, 'tk/winfo'
+
+autoload :TkWinDDE, 'tk/winpkg'
+autoload :TkWinRegistry, 'tk/winpkg'
+
+autoload :TkXIM, 'tk/xim'
+
+
+#######################
+# sub-module of Tk
+module Tk
+ autoload :Clock, 'tk/clock'
+ autoload :Scrollable, 'tk/scrollable'
+ autoload :Wm, 'tk/wm'
+
+ autoload :EncodedString, 'tk/encodedstr'
+ def Tk.EncodedString(str, enc = nil); Tk::EncodedString.new(str, enc); end
+
+ autoload :BinaryString, 'tk/encodedstr'
+ def Tk.BinaryString(str); Tk::BinaryString.new(str); end
+
+ autoload :UTF8_String, 'tk/encodedstr'
+ def Tk.UTF8_String(str); Tk::UTF8_String.new(str); end
+end
diff --git a/ext/tk/lib/tk/bgerror.rb b/ext/tk/lib/tk/bgerror.rb
new file mode 100644
index 0000000000..c82a8e046b
--- /dev/null
+++ b/ext/tk/lib/tk/bgerror.rb
@@ -0,0 +1,29 @@
+#
+# tkbgerror -- bgerror ( tkerror ) module
+# 1998/07/16 by Hidetoshi Nagai <nagai@ai.kyutech.ac.jp>
+#
+require 'tk'
+
+module TkBgError
+ extend Tk
+
+ TkCommandNames = ['bgerror'.freeze].freeze
+
+ def bgerror(message)
+ tk_call('bgerror', message)
+ end
+ alias tkerror bgerror
+ alias show bgerror
+ module_function :bgerror, :tkerror, :show
+
+ def set_handler(hdlr = Proc.new) #==> handler :: proc{|msg| ...body... }
+ tk_call('proc', 'bgerror', 'msg', install_cmd(hdlr) + ' $msg')
+ end
+ def set_default
+ begin
+ tk_call('rename', 'bgerror', '')
+ rescue RuntimeError
+ end
+ end
+ module_function :set_handler, :set_default
+end
diff --git a/ext/tk/lib/tk/bindtag.rb b/ext/tk/lib/tk/bindtag.rb
new file mode 100644
index 0000000000..d309ea6423
--- /dev/null
+++ b/ext/tk/lib/tk/bindtag.rb
@@ -0,0 +1,78 @@
+#
+# tk/bind.rb : control event binding
+#
+require 'tk'
+
+class TkBindTag
+ include TkBindCore
+
+ #BTagID_TBL = {}
+ BTagID_TBL = TkCore::INTERP.create_table
+ Tk_BINDTAG_ID = ["btag".freeze, "00000".taint].freeze
+
+ TkCore::INTERP.init_ip_env{ BTagID_TBL.clear }
+
+ def TkBindTag.id2obj(id)
+ BTagID_TBL[id]? BTagID_TBL[id]: id
+ end
+
+ def TkBindTag.new_by_name(name, *args, &b)
+ return BTagID_TBL[name] if BTagID_TBL[name]
+ self.new(*args, &b).instance_eval{
+ BTagID_TBL.delete @id
+ @id = name
+ BTagID_TBL[@id] = self
+ }
+ end
+
+ def initialize(*args, &b)
+ @id = Tk_BINDTAG_ID.join('')
+ Tk_BINDTAG_ID[1].succ!
+ BTagID_TBL[@id] = self
+ bind(*args, &b) if args != []
+ end
+
+ ALL = self.new_by_name('all')
+
+ def name
+ @id
+ end
+
+ def to_eval
+ @id
+ end
+
+ def inspect
+ #Kernel.format "#<TkBindTag: %s>", @id
+ '#<TkBindTag: ' + @id + '>'
+ end
+end
+
+
+class TkBindTagAll<TkBindTag
+ def TkBindTagAll.new(*args, &b)
+ $stderr.puts "Warning: TkBindTagALL is obsolete. Use TkBindTag::ALL\n"
+
+ TkBindTag::ALL.bind(*args, &b) if args != []
+ TkBindTag::ALL
+ end
+end
+
+
+class TkDatabaseClass<TkBindTag
+ def self.new(name, *args, &b)
+ return BTagID_TBL[name] if BTagID_TBL[name]
+ super(name, *args, &b)
+ end
+
+ def initialize(name, *args, &b)
+ @id = name
+ BTagID_TBL[@id] = self
+ bind(*args, &b) if args != []
+ end
+
+ def inspect
+ #Kernel.format "#<TkDatabaseClass: %s>", @id
+ '#<TkDatabaseClass: ' + @id + '>'
+ end
+end
diff --git a/ext/tk/lib/tk/button.rb b/ext/tk/lib/tk/button.rb
new file mode 100644
index 0000000000..15e87c300d
--- /dev/null
+++ b/ext/tk/lib/tk/button.rb
@@ -0,0 +1,27 @@
+#
+# tk/button.rb : treat button widget
+#
+require 'tk'
+require 'tk/label'
+
+class TkButton<TkLabel
+ TkCommandNames = ['button'.freeze].freeze
+ WidgetClassName = 'Button'.freeze
+ WidgetClassNames[WidgetClassName] = self
+ def create_self(keys)
+ if keys and keys != None
+ tk_call_without_enc('button', @path, *hash_kv(keys, true))
+ else
+ tk_call_without_enc('button', @path)
+ end
+ end
+ private :create_self
+
+ def invoke
+ _fromUTF8(tk_send_without_enc('invoke'))
+ end
+ def flash
+ tk_send_without_enc('flash')
+ self
+ end
+end
diff --git a/ext/tk/lib/tk/canvas.rb b/ext/tk/lib/tk/canvas.rb
new file mode 100644
index 0000000000..7defecdfe4
--- /dev/null
+++ b/ext/tk/lib/tk/canvas.rb
@@ -0,0 +1,697 @@
+#
+# tk/canvas.rb - Tk canvas classes
+# $Date$
+# by Yukihiro Matsumoto <matz@caelum.co.jp>
+# $Date$
+# by Hidetoshi Nagai <nagai@ai.kyutech.ac.jp>
+#
+require 'tk'
+require 'tk/canvastag'
+require 'tk/itemfont'
+require 'tk/scrollable'
+
+module TkTreatCItemFont
+ include TkTreatItemFont
+
+ ItemCMD = ['itemconfigure'.freeze, TkComm::None].freeze
+ def __conf_cmd(idx)
+ ItemCMD[idx]
+ end
+
+ def __item_pathname(tagOrId)
+ if tagOrId.kind_of?(TkcItem) || tagOrId.kind_of?(TkcTag)
+ self.path + ';' + tagOrId.id.to_s
+ else
+ self.path + ';' + tagOrId.to_s
+ end
+ end
+
+ private :__conf_cmd, :__item_pathname
+end
+
+class TkCanvas<TkWindow
+ include TkTreatCItemFont
+ include Scrollable
+
+ TkCommandNames = ['canvas'.freeze].freeze
+ WidgetClassName = 'Canvas'.freeze
+ WidgetClassNames[WidgetClassName] = self
+
+ def __destroy_hook__
+ TkcItem::CItemID_TBL.delete(@path)
+ end
+
+ def create_self(keys)
+ if keys and keys != None
+ tk_call_without_enc('canvas', @path, *hash_kv(keys, true))
+ else
+ tk_call_without_enc('canvas', @path)
+ end
+ end
+ private :create_self
+
+ def tagid(tag)
+ if tag.kind_of?(TkcItem) || tag.kind_of?(TkcTag)
+ tag.id
+ else
+ tag
+ end
+ end
+ private :tagid
+
+
+ def create(type, *args)
+ # create a canvas item without creating a TkcItem object
+ if type.kind_of?(TkcItem)
+ fail ArgumentError, 'TkcItem class expected for 1st argument'
+ end
+ type.create(@path, *args)
+ end
+
+
+ def addtag(tag, mode, *args)
+ tk_send_without_enc('addtag', tagid(tag), mode, *args)
+ self
+ end
+ def addtag_above(tagOrId, target)
+ addtag(tagOrId, 'above', tagid(target))
+ end
+ def addtag_all(tagOrId)
+ addtag(tagOrId, 'all')
+ end
+ def addtag_below(tagOrId, target)
+ addtag(tagOrId, 'below', tagid(target))
+ end
+ def addtag_closest(tagOrId, x, y, halo=None, start=None)
+ addtag(tagOrId, 'closest', x, y, halo, start)
+ end
+ def addtag_enclosed(tagOrId, x1, y1, x2, y2)
+ addtag(tagOrId, 'enclosed', x1, y1, x2, y2)
+ end
+ def addtag_overlapping(tagOrId, x1, y1, x2, y2)
+ addtag(tagOrId, 'overlapping', x1, y1, x2, y2)
+ end
+ def addtag_withtag(tagOrId, tag)
+ addtag(tagOrId, 'withtag', tagid(tag))
+ end
+
+ def bbox(tagOrId, *tags)
+ list(tk_send_without_enc('bbox', tagid(tagOrId),
+ *tags.collect{|t| tagid(t)}))
+ end
+
+ def itembind(tag, context, cmd=Proc.new, args=nil)
+ _bind([path, "bind", tagid(tag)], context, cmd, args)
+ self
+ end
+
+ def itembind_append(tag, context, cmd=Proc.new, args=nil)
+ _bind_append([path, "bind", tagid(tag)], context, cmd, args)
+ self
+ end
+
+ def itembind_remove(tag, context)
+ _bind_remove([path, "bind", tagid(tag)], context)
+ self
+ end
+
+ def itembindinfo(tag, context=nil)
+ _bindinfo([path, "bind", tagid(tag)], context)
+ end
+
+ def canvasx(screen_x, *args)
+ #tk_tcl2ruby(tk_send_without_enc('canvasx', screen_x, *args))
+ number(tk_send_without_enc('canvasx', screen_x, *args))
+ end
+ def canvasy(screen_y, *args)
+ #tk_tcl2ruby(tk_send_without_enc('canvasy', screen_y, *args))
+ number(tk_send_without_enc('canvasy', screen_y, *args))
+ end
+
+ def coords(tag, *args)
+ if args == []
+ tk_split_list(tk_send_without_enc('coords', tagid(tag)))
+ else
+ tk_send_without_enc('coords', tagid(tag), *(args.flatten))
+ end
+ end
+
+ def dchars(tag, first, last=None)
+ tk_send_without_enc('dchars', tagid(tag),
+ _get_eval_enc_str(first), _get_eval_enc_str(last))
+ self
+ end
+
+ def delete(*args)
+ if TkcItem::CItemID_TBL[self.path]
+ find('withtag', *args).each{|item|
+ TkcItem::CItemID_TBL[self.path].delete(item.id)
+ }
+ end
+ tk_send_without_enc('delete', *args.collect{|t| tagid(t)})
+ self
+ end
+ alias remove delete
+
+ def dtag(tag, tag_to_del=None)
+ tk_send_without_enc('dtag', tagid(tag), tag_to_del)
+ self
+ end
+
+ def find(mode, *args)
+ list(tk_send_without_enc('find', mode, *args)).collect!{|id|
+ TkcItem.id2obj(self, id)
+ }
+ end
+ def find_above(target)
+ find('above', tagid(target))
+ end
+ def find_all
+ find('all')
+ end
+ def find_below(target)
+ find('below', tagid(target))
+ end
+ def find_closest(x, y, halo=None, start=None)
+ find('closest', x, y, halo, start)
+ end
+ def find_enclosed(x1, y1, x2, y2)
+ find('enclosed', x1, y1, x2, y2)
+ end
+ def find_overlapping(x1, y1, x2, y2)
+ find('overlapping', x1, y1, x2, y2)
+ end
+ def find_withtag(tag)
+ find('withtag', tag)
+ end
+
+ def itemfocus(tagOrId=nil)
+ if tagOrId
+ tk_send_without_enc('focus', tagid(tagOrId))
+ self
+ else
+ ret = tk_send_without_enc('focus')
+ if ret == ""
+ nil
+ else
+ TkcItem.id2obj(self, ret)
+ end
+ end
+ end
+
+ def gettags(tagOrId)
+ list(tk_send_without_enc('gettags', tagid(tagOrId))).collect{|tag|
+ TkcTag.id2obj(self, tag)
+ }
+ end
+
+ def icursor(tagOrId, index)
+ tk_send_without_enc('icursor', tagid(tagOrId), index)
+ self
+ end
+
+ def index(tagOrId, index)
+ number(tk_send_without_enc('index', tagid(tagOrId), index))
+ end
+
+ def insert(tagOrId, index, string)
+ tk_send_without_enc('insert', tagid(tagOrId), index,
+ _get_eval_enc_str(string))
+ self
+ end
+
+ def itemcget(tagOrId, option)
+ case option.to_s
+ when 'dash', 'activedash', 'disableddash'
+ conf = tk_send_without_enc('itemcget', tagid(tagOrId), "-#{option}")
+ if conf =~ /^[0-9]/
+ list(conf)
+ else
+ conf
+ end
+ when 'text', 'label', 'show', 'data', 'file', 'maskdata', 'maskfile'
+ _fromUTF8(tk_send_without_enc('itemcget', tagid(tagOrId), "-#{option}"))
+ when 'font', 'kanjifont'
+ #fnt = tk_tcl2ruby(tk_send('itemcget', tagid(tagOrId), "-#{option}"))
+ fnt = tk_tcl2ruby(_fromUTF8(tk_send_with_enc('itemcget', tagid(tagOrId), '-font')))
+ unless fnt.kind_of?(TkFont)
+ fnt = tagfontobj(tagid(tagOrId), fnt)
+ end
+ if option.to_s == 'kanjifont' && JAPANIZED_TK && TK_VERSION =~ /^4\.*/
+ # obsolete; just for compatibility
+ fnt.kanji_font
+ else
+ fnt
+ end
+ else
+ tk_tcl2ruby(_fromUTF8(tk_send_without_enc('itemcget', tagid(tagOrId),
+ "-#{option}")))
+ end
+ end
+
+ def itemconfigure(tagOrId, key, value=None)
+ if key.kind_of? Hash
+ key = _symbolkey2str(key)
+ if ( key['font'] || key['kanjifont'] \
+ || key['latinfont'] || key['asciifont'] )
+ tagfont_configure(tagid(tagOrId), key.dup)
+ else
+ _fromUTF8(tk_send_without_enc('itemconfigure', tagid(tagOrId),
+ *hash_kv(key, true)))
+ end
+
+ else
+ if ( key == 'font' || key == :font ||
+ key == 'kanjifont' || key == :kanjifont ||
+ key == 'latinfont' || key == :latinfont ||
+ key == 'asciifont' || key == :asciifont )
+ if value == None
+ tagfontobj(tagid(tagOrId))
+ else
+ tagfont_configure(tagid(tagOrId), {key=>value})
+ end
+ else
+ _fromUTF8(tk_send_without_enc('itemconfigure', tagid(tagOrId),
+ "-#{key}", _get_eval_enc_str(value)))
+ end
+ end
+ self
+ end
+# def itemconfigure(tagOrId, key, value=None)
+# if key.kind_of? Hash
+# tk_send 'itemconfigure', tagid(tagOrId), *hash_kv(key)
+# else
+# tk_send 'itemconfigure', tagid(tagOrId), "-#{key}", value
+# end
+# end
+# def itemconfigure(tagOrId, keys)
+# tk_send 'itemconfigure', tagid(tagOrId), *hash_kv(keys)
+# end
+
+ def itemconfiginfo(tagOrId, key=nil)
+ if TkComm::GET_CONFIGINFO_AS_ARRAY
+ if key
+ case key.to_s
+ when 'dash', 'activedash', 'disableddash'
+ conf = tk_split_simplelist(tk_send_without_enc('itemconfigure', tagid(tagOrId), "-#{key}"))
+ if conf[3] && conf[3] =~ /^[0-9]/
+ conf[3] = list(conf[3])
+ end
+ if conf[4] && conf[4] =~ /^[0-9]/
+ conf[4] = list(conf[4])
+ end
+ when 'text', 'label', 'show', 'data', 'file', 'maskdata', 'maskfile'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure', tagid(tagOrId), "-#{key}")))
+ when 'font', 'kanjifont'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure', tagid(tagOrId),"-#{key}")))
+ conf[4] = tagfont_configinfo(tagid(tagOrId), conf[4])
+ else
+ conf = tk_split_list(_fromUTF8(tk_send_without_enc('itemconfigure', tagid(tagOrId), "-#{key}")))
+ end
+ conf[0] = conf[0][1..-1]
+ conf
+ else
+ ret = tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure', tagid(tagOrId)))).collect{|conflist|
+ conf = tk_split_simplelist(conflist)
+ conf[0] = conf[0][1..-1]
+ case conf[0]
+ when 'text', 'label', 'show', 'data', 'file', 'maskdata', 'maskfile'
+ when 'dash', 'activedash', 'disableddash'
+ if conf[3] && conf[3] =~ /^[0-9]/
+ conf[3] = list(conf[3])
+ end
+ if conf[4] && conf[4] =~ /^[0-9]/
+ conf[4] = list(conf[4])
+ end
+ else
+ if conf[3]
+ if conf[3].index('{')
+ conf[3] = tk_split_list(conf[3])
+ else
+ conf[3] = tk_tcl2ruby(conf[3])
+ end
+ end
+ if conf[4]
+ if conf[4].index('{')
+ conf[4] = tk_split_list(conf[4])
+ else
+ conf[4] = tk_tcl2ruby(conf[4])
+ end
+ end
+ end
+ conf[1] = conf[1][1..-1] if conf.size == 2 # alias info
+ conf
+ }
+ fontconf = ret.assoc('font')
+ if fontconf
+ ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
+ fontconf[4] = tagfont_configinfo(tagid(tagOrId), fontconf[4])
+ ret.push(fontconf)
+ else
+ ret
+ end
+ end
+ else # ! TkComm::GET_CONFIGINFO_AS_ARRAY
+ if key
+ case key.to_s
+ when 'dash', 'activedash', 'disableddash'
+ conf = tk_split_simplelist(tk_send_without_enc('itemconfigure',
+ tagid(tagOrId),
+ "-#{key}"))
+ if conf[3] && conf[3] =~ /^[0-9]/
+ conf[3] = list(conf[3])
+ end
+ if conf[4] && conf[4] =~ /^[0-9]/
+ conf[4] = list(conf[4])
+ end
+ when 'text', 'label', 'show', 'data', 'file', 'maskdata', 'maskfile'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure', tagid(tagOrId), "-#{key}")))
+ when 'font', 'kanjifont'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure', tagid(tagOrId),"-#{key}")))
+ conf[4] = tagfont_configinfo(tagid(tagOrId), conf[4])
+ else
+ conf = tk_split_list(_fromUTF8(tk_send_without_enc('itemconfigure', tagid(tagOrId), "-#{key}")))
+ end
+ key = conf.shift[1..-1]
+ { key => conf }
+ else
+ ret = {}
+ tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure', tagid(tagOrId)))).each{|conflist|
+ conf = tk_split_simplelist(conflist)
+ key = conf.shift[1..-1]
+ case key
+ when 'text', 'label', 'show', 'data', 'file', 'maskdata', 'maskfile'
+ when 'dash', 'activedash', 'disableddash'
+ if conf[2] && conf[2] =~ /^[0-9]/
+ conf[2] = list(conf[2])
+ end
+ if conf[3] && conf[3] =~ /^[0-9]/
+ conf[3] = list(conf[3])
+ end
+ else
+ if conf[2]
+ if conf[2].index('{')
+ conf[2] = tk_split_list(conf[2])
+ else
+ conf[2] = tk_tcl2ruby(conf[2])
+ end
+ end
+ if conf[3]
+ if conf[3].index('{')
+ conf[3] = tk_split_list(conf[3])
+ else
+ conf[3] = tk_tcl2ruby(conf[3])
+ end
+ end
+ end
+ if conf.size == 1
+ ret[key] = conf[0][1..-1] # alias info
+ else
+ ret[key] = conf
+ end
+ }
+ fontconf = ret['font']
+ if fontconf
+ ret.delete('font')
+ ret.delete('kanjifont')
+ fontconf[3] = tagfont_configinfo(tagid(tagOrId), fontconf[3])
+ ret['font'] = fontconf
+ end
+ ret
+ end
+ end
+ end
+
+ def current_itemconfiginfo(tagOrId, key=nil)
+ if TkComm::GET_CONFIGINFO_AS_ARRAY
+ if key
+ conf = itemconfiginfo(tagOrId, key)
+ {conf[0] => conf[4]}
+ else
+ ret = {}
+ itemconfiginfo(tagOrId).each{|conf|
+ ret[conf[0]] = conf[4] if conf.size > 2
+ }
+ ret
+ end
+ else # ! TkComm::GET_CONFIGINFO_AS_ARRAY
+ ret = {}
+ itemconfiginfo(tagOrId, key).each{|k, conf|
+ ret[k] = conf[-1] if conf.kind_of?(Array)
+ }
+ ret
+ end
+ end
+
+ def lower(tag, below=nil)
+ if below
+ tk_send_without_enc('lower', tagid(tag), tagid(below))
+ else
+ tk_send_without_enc('lower', tagid(tag))
+ end
+ self
+ end
+
+ def move(tag, x, y)
+ tk_send_without_enc('move', tagid(tag), x, y)
+ self
+ end
+
+ def postscript(keys)
+ tk_send("postscript", *hash_kv(keys))
+ end
+
+ def raise(tag, above=nil)
+ if above
+ tk_send_without_enc('raise', tagid(tag), tagid(above))
+ else
+ tk_send_without_enc('raise', tagid(tag))
+ end
+ self
+ end
+
+ def scale(tag, x, y, xs, ys)
+ tk_send_without_enc('scale', tagid(tag), x, y, xs, ys)
+ self
+ end
+
+ def scan_mark(x, y)
+ tk_send_without_enc('scan', 'mark', x, y)
+ self
+ end
+ def scan_dragto(x, y)
+ tk_send_without_enc('scan', 'dragto', x, y)
+ self
+ end
+
+ def select(mode, *args)
+ r = tk_send_without_enc('select', mode, *args)
+ (mode == 'item')? TkcItem.id2obj(self, r): self
+ end
+ def select_adjust(tagOrId, index)
+ select('adjust', tagid(tagOrId), index)
+ end
+ def select_clear
+ select('clear')
+ end
+ def select_from(tagOrId, index)
+ select('from', tagid(tagOrId), index)
+ end
+ def select_item
+ select('item')
+ end
+ def select_to(tagOrId, index)
+ select('to', tagid(tagOrId), index)
+ end
+
+ def itemtype(tag)
+ TkcItem.type2class(tk_send('type', tagid(tag)))
+ end
+end
+
+class TkcItem<TkObject
+ extend Tk
+ include TkcTagAccess
+
+ CItemTypeToClass = {}
+ CItemID_TBL = TkCore::INTERP.create_table
+
+ TkCore::INTERP.init_ip_env{ CItemID_TBL.clear }
+
+ def TkcItem.type2class(type)
+ CItemTypeToClass[type]
+ end
+
+ def TkcItem.id2obj(canvas, id)
+ cpath = canvas.path
+ return id unless CItemID_TBL[cpath]
+ CItemID_TBL[cpath][id]? CItemID_TBL[cpath][id]: id
+ end
+
+ ########################################
+ def self.create(canvas, *args)
+ fail RuntimeError, "TkcItem is an abstract class"
+ end
+ ########################################
+
+ def initialize(parent, *args)
+ unless parent.kind_of?(TkCanvas)
+ fail ArguemntError, "expect TkCanvas for 1st argument"
+ end
+ @parent = @c = parent
+ @path = parent.path
+ fontkeys = {}
+ if args.size == 1 && args[0].kind_of?(Hash)
+ args[0] = _symbolkey2str(args[0])
+ coords = args[0].delete('coords')
+ unless coords.kind_of?(Array)
+ fail "coords parameter must be given by an Array"
+ end
+ args[0,0] = coords.flatten
+ end
+ if args[-1].kind_of? Hash
+ keys = _symbolkey2str(args.pop)
+ ['font', 'kanjifont', 'latinfont', 'asciifont'].each{|key|
+ fontkeys[key] = keys.delete(key) if keys.key?(key)
+ }
+ args.concat(hash_kv(keys))
+ end
+ @id = create_self(*args).to_i ;# 'canvas item id' is integer number
+ CItemID_TBL[@path] = {} unless CItemID_TBL[@path]
+ CItemID_TBL[@path][@id] = self
+ configure(fontkeys) unless fontkeys.empty?
+
+######## old version
+# if args[-1].kind_of? Hash
+# keys = args.pop
+# end
+# @id = create_self(*args).to_i ;# 'canvas item id' is integer number
+# CItemID_TBL[@path] = {} unless CItemID_TBL[@path]
+# CItemID_TBL[@path][@id] = self
+# if keys
+# # tk_call @path, 'itemconfigure', @id, *hash_kv(keys)
+# configure(keys) if keys
+# end
+########
+ end
+ def create_self(*args)
+ self.class.create(@path, *args)
+ end
+ private :create_self
+
+ def id
+ @id
+ end
+
+ def delete
+ @c.delete @id
+ CItemID_TBL[@path].delete(@id) if CItemID_TBL[@path]
+ self
+ end
+ alias remove delete
+ alias destroy delete
+end
+
+class TkcArc<TkcItem
+ CItemTypeToClass['arc'] = self
+ def self.create(path, *args)
+ if args[-1].kind_of?(Hash)
+ keys = args.pop
+ args.concat(hash_kv(keys))
+ end
+ tk_call_without_enc(path, 'create', 'arc', *args)
+ end
+end
+
+class TkcBitmap<TkcItem
+ CItemTypeToClass['bitmap'] = self
+ def self.create(path, *args)
+ if args[-1].kind_of?(Hash)
+ keys = args.pop
+ args.concat(hash_kv(keys))
+ end
+ tk_call_without_enc(path, 'create', 'bitmap', *args)
+ end
+end
+
+class TkcImage<TkcItem
+ CItemTypeToClass['image'] = self
+ def self.create(path, *args)
+ if args[-1].kind_of?(Hash)
+ keys = args.pop
+ args.concat(hash_kv(keys))
+ end
+ tk_call_without_enc(path, 'create', 'image', *args)
+ end
+end
+
+class TkcLine<TkcItem
+ CItemTypeToClass['line'] = self
+ def self.create(path, *args)
+ if args[-1].kind_of?(Hash)
+ keys = args.pop
+ args.concat(hash_kv(keys))
+ end
+ tk_call_without_enc(path, 'create', 'line', *args)
+ end
+end
+
+class TkcOval<TkcItem
+ CItemTypeToClass['oval'] = self
+ def self.create(path, *args)
+ if args[-1].kind_of?(Hash)
+ keys = args.pop
+ args.concat(hash_kv(keys))
+ end
+ tk_call_without_enc(path, 'create', 'oval', *args)
+ end
+end
+
+class TkcPolygon<TkcItem
+ CItemTypeToClass['polygon'] = self
+ def self.create(path, *args)
+ if args[-1].kind_of?(Hash)
+ keys = args.pop
+ args.concat(hash_kv(keys))
+ end
+ tk_call_without_enc(path, 'create', 'polygon', *args)
+ end
+end
+
+class TkcRectangle<TkcItem
+ CItemTypeToClass['rectangle'] = self
+ def self.create(path, *args)
+ if args[-1].kind_of?(Hash)
+ keys = args.pop
+ args.concat(hash_kv(keys))
+ end
+ tk_call_without_enc(path, 'create', 'rectangle', *args)
+ end
+end
+
+class TkcText<TkcItem
+ CItemTypeToClass['text'] = self
+ def self.create(path, *args)
+ if args[-1].kind_of?(Hash)
+ keys = args.pop
+ args.concat(hash_kv(keys))
+ end
+ #tk_call_without_enc(path, 'create', 'text',
+ # *(args.each{|arg| _get_eval_enc_str(arg)}))
+ tk_call(path, 'create', 'text', *args)
+ end
+end
+
+class TkcWindow<TkcItem
+ CItemTypeToClass['window'] = self
+ def self.create(path, *args)
+ if args[-1].kind_of?(Hash)
+ keys = _symbolkey2str(args.pop)
+ win = keys['window']
+ # keys['window'] = win.epath if win.kind_of?(TkWindow)
+ keys['window'] = _epath(win) if win
+ args.concat(hash_kv(keys))
+ end
+ tk_call_without_enc(path, 'create', 'window', *args)
+ end
+end
diff --git a/ext/tk/lib/tk/canvastag.rb b/ext/tk/lib/tk/canvastag.rb
new file mode 100644
index 0000000000..962e08b6e0
--- /dev/null
+++ b/ext/tk/lib/tk/canvastag.rb
@@ -0,0 +1,337 @@
+#
+# tk/canvastag.rb - methods for treating canvas tags
+#
+require 'tk'
+require 'tk/canvas'
+require 'tk/tagfont'
+
+module TkcTagAccess
+ include TkComm
+ include TkTreatTagFont
+
+ def addtag(tag)
+ @c.addtag(tag, 'with', @id)
+ self
+ end
+
+ def bbox
+ @c.bbox(@id)
+ end
+
+ def bind(seq, cmd=Proc.new, args=nil)
+ @c.itembind @id, seq, cmd, args
+ self
+ end
+
+ def bind_append(seq, cmd=Proc.new, args=nil)
+ @c.itembind_append @id, seq, cmd, args
+ self
+ end
+
+ def bind_remove(seq)
+ @c.itembind_remove @id, seq
+ self
+ end
+
+ def bindinfo(seq=nil)
+ @c.itembindinfo @id, seq
+ end
+
+ def cget(option)
+ @c.itemcget @id, option
+ end
+
+ def configure(key, value=None)
+ @c.itemconfigure @id, key, value
+ self
+ end
+# def configure(keys)
+# @c.itemconfigure @id, keys
+# end
+
+ def configinfo(key=nil)
+ @c.itemconfiginfo @id, key
+ end
+
+ def current_configinfo(key=nil)
+ @c.current_itemconfiginfo @id, key
+ end
+
+ def coords(*args)
+ @c.coords @id, *args
+ end
+
+ def dchars(first, last=None)
+ @c.dchars @id, first, last
+ self
+ end
+
+ def dtag(tag_to_del=None)
+ @c.dtag @id, tag_to_del
+ self
+ end
+
+ def find
+ @c.find 'withtag', @id
+ end
+ alias list find
+
+ def focus
+ @c.itemfocus @id
+ end
+
+ def gettags
+ @c.gettags @id
+ end
+
+ def icursor(index)
+ @c.icursor @id, index
+ self
+ end
+
+ def index(index)
+ @c.index @id, index
+ end
+
+ def insert(beforethis, string)
+ @c.insert @id, beforethis, string
+ self
+ end
+
+ def lower(belowthis=None)
+ @c.lower @id, belowthis
+ self
+ end
+
+ def move(xamount, yamount)
+ @c.move @id, xamount, yamount
+ self
+ end
+
+ def raise(abovethis=None)
+ @c.raise @id, abovethis
+ self
+ end
+
+ def scale(xorigin, yorigin, xscale, yscale)
+ @c.scale @id, xorigin, yorigin, xscale, yscale
+ self
+ end
+
+ def select_adjust(index)
+ @c.select('adjust', @id, index)
+ self
+ end
+ def select_from(index)
+ @c.select('from', @id, index)
+ self
+ end
+ def select_to(index)
+ @c.select('to', @id, index)
+ self
+ end
+
+ def itemtype
+ @c.itemtype @id
+ end
+
+ # Following operators support logical expressions of canvas tags
+ # (for Tk8.3+).
+ # If tag1.path is 't1' and tag2.path is 't2', then
+ # ltag = tag1 & tag2; ltag.path => "(t1)&&(t2)"
+ # ltag = tag1 | tag2; ltag.path => "(t1)||(t2)"
+ # ltag = tag1 ^ tag2; ltag.path => "(t1)^(t2)"
+ # ltag = - tag1; ltag.path => "!(t1)"
+ def & (tag)
+ if tag.kind_of? TkObject
+ TkcTagString.new(@c, '(' + @id + ')&&(' + tag.path + ')')
+ else
+ TkcTagString.new(@c, '(' + @id + ')&&(' + tag.to_s + ')')
+ end
+ end
+
+ def | (tag)
+ if tag.kind_of? TkObject
+ TkcTagString.new(@c, '(' + @id + ')||(' + tag.path + ')')
+ else
+ TkcTagString.new(@c, '(' + @id + ')||(' + tag.to_s + ')')
+ end
+ end
+
+ def ^ (tag)
+ if tag.kind_of? TkObject
+ TkcTagString.new(@c, '(' + @id + ')^(' + tag.path + ')')
+ else
+ TkcTagString.new(@c, '(' + @id + ')^(' + tag.to_s + ')')
+ end
+ end
+
+ def -@
+ TkcTagString.new(@c, '!(' + @id + ')')
+ end
+end
+
+class TkcTag<TkObject
+ include TkcTagAccess
+
+ CTagID_TBL = TkCore::INTERP.create_table
+ Tk_CanvasTag_ID = ['ctag'.freeze, '00000'.taint].freeze
+
+ TkCore::INTERP.init_ip_env{ CTagID_TBL.clear }
+
+ def TkcTag.id2obj(canvas, id)
+ cpath = canvas.path
+ return id unless CTagID_TBL[cpath]
+ CTagID_TBL[cpath][id]? CTagID_TBL[cpath][id]: id
+ end
+
+ def initialize(parent, mode=nil, *args)
+ unless parent.kind_of?(TkCanvas)
+ fail ArguemntError, "expect TkCanvas for 1st argument"
+ end
+ @c = parent
+ @cpath = parent.path
+ @path = @id = Tk_CanvasTag_ID.join('')
+ CTagID_TBL[@cpath] = {} unless CTagID_TBL[@cpath]
+ CTagID_TBL[@cpath][@id] = self
+ Tk_CanvasTag_ID[1].succ!
+ if mode
+ tk_call_without_enc(@c.path, "addtag", @id, mode, *args)
+ end
+ end
+ def id
+ @id
+ end
+
+ def delete
+ @c.delete @id
+ CTagID_TBL[@cpath].delete(@id) if CTagID_TBL[@cpath]
+ self
+ end
+ alias remove delete
+ alias destroy delete
+
+ def set_to_above(target)
+ @c.addtag_above(@id, target)
+ self
+ end
+ alias above set_to_above
+
+ def set_to_all
+ @c.addtag_all(@id)
+ self
+ end
+ alias all set_to_all
+
+ def set_to_below(target)
+ @c.addtag_below(@id, target)
+ self
+ end
+ alias below set_to_below
+
+ def set_to_closest(x, y, halo=None, start=None)
+ @c.addtag_closest(@id, x, y, halo, start)
+ self
+ end
+ alias closest set_to_closest
+
+ def set_to_enclosed(x1, y1, x2, y2)
+ @c.addtag_enclosed(@id, x1, y1, x2, y2)
+ self
+ end
+ alias enclosed set_to_enclosed
+
+ def set_to_overlapping(x1, y1, x2, y2)
+ @c.addtag_overlapping(@id, x1, y1, x2, y2)
+ self
+ end
+ alias overlapping set_to_overlapping
+
+ def set_to_withtag(target)
+ @c.addtag_withtag(@id, target)
+ self
+ end
+ alias withtag set_to_withtag
+end
+
+class TkcTagString<TkcTag
+ def self.new(parent, name, *args)
+ if CTagID_TBL[parent.path] && CTagID_TBL[parent.path][name]
+ return CTagID_TBL[parent.path][name]
+ else
+ super(parent, name, *args)
+ end
+ end
+
+ def initialize(parent, name, mode=nil, *args)
+ unless parent.kind_of?(TkCanvas)
+ fail ArguemntError, "expect TkCanvas for 1st argument"
+ end
+ @c = parent
+ @cpath = parent.path
+ @path = @id = name
+ CTagID_TBL[@cpath] = {} unless CTagID_TBL[@cpath]
+ CTagID_TBL[@cpath][@id] = self
+ if mode
+ tk_call_without_enc(@c.path, "addtag", @id, mode, *args)
+ end
+ end
+end
+TkcNamedTag = TkcTagString
+
+class TkcTagAll<TkcTag
+ def initialize(parent)
+ unless parent.kind_of?(TkCanvas)
+ fail ArguemntError, "expect TkCanvas for 1st argument"
+ end
+ @c = parent
+ @cpath = parent.path
+ @path = @id = 'all'
+ CTagID_TBL[@cpath] = {} unless CTagID_TBL[@cpath]
+ CTagID_TBL[@cpath][@id] = self
+ end
+end
+
+class TkcTagCurrent<TkcTag
+ def initialize(parent)
+ unless parent.kind_of?(TkCanvas)
+ fail ArguemntError, "expect TkCanvas for 1st argument"
+ end
+ @c = parent
+ @cpath = parent.path
+ @path = @id = 'current'
+ CTagID_TBL[@cpath] = {} unless CTagID_TBL[@cpath]
+ CTagID_TBL[@cpath][@id] = self
+ end
+end
+
+class TkcGroup<TkcTag
+ Tk_cGroup_ID = ['tkcg'.freeze, '00000'.taint].freeze
+ def create_self(parent, *args)
+ unless parent.kind_of?(TkCanvas)
+ fail ArguemntError, "expect TkCanvas for 1st argument"
+ end
+ @c = parent
+ @cpath = parent.path
+ @path = @id = Tk_cGroup_ID.join('')
+ CTagID_TBL[@cpath] = {} unless CTagID_TBL[@cpath]
+ CTagID_TBL[@cpath][@id] = self
+ Tk_cGroup_ID[1].succ!
+ add(*args) if args != []
+ end
+ private :create_self
+
+ def include(*tags)
+ for i in tags
+ i.addtag @id
+ end
+ self
+ end
+
+ def exclude(*tags)
+ for i in tags
+ i.delete @id
+ end
+ self
+ end
+end
diff --git a/ext/tk/lib/tk/checkbutton.rb b/ext/tk/lib/tk/checkbutton.rb
new file mode 100644
index 0000000000..a1ee5e8764
--- /dev/null
+++ b/ext/tk/lib/tk/checkbutton.rb
@@ -0,0 +1,25 @@
+#
+# tk/checkbutton.rb : treat checkbutton widget
+#
+require 'tk'
+require 'tk/radiobutton'
+
+class TkCheckButton<TkRadioButton
+ TkCommandNames = ['checkbutton'.freeze].freeze
+ WidgetClassName = 'Checkbutton'.freeze
+ WidgetClassNames[WidgetClassName] = self
+ def create_self(keys)
+ if keys and keys != None
+ tk_call_without_enc('checkbutton', @path, *hash_kv(keys, true))
+ else
+ tk_call_without_enc('checkbutton', @path)
+ end
+ end
+ private :create_self
+
+ def toggle
+ tk_send_without_enc('toggle')
+ self
+ end
+end
+TkCheckbutton = TkCheckButton
diff --git a/ext/tk/lib/tk/clipboard.rb b/ext/tk/lib/tk/clipboard.rb
new file mode 100644
index 0000000000..d4205a5c28
--- /dev/null
+++ b/ext/tk/lib/tk/clipboard.rb
@@ -0,0 +1,75 @@
+#
+# tk/clipboard.rb : methods to treat clipboard
+#
+require 'tk'
+
+module TkClipboard
+ include Tk
+ extend Tk
+
+ TkCommandNames = ['clipboard'.freeze].freeze
+
+ def self.clear(win=nil)
+ if win
+ tk_call_without_enc('clipboard', 'clear', '-displayof', win)
+ else
+ tk_call_without_enc('clipboard', 'clear')
+ end
+ end
+ def self.clear_on_display(win)
+ tk_call_without_enc('clipboard', 'clear', '-displayof', win)
+ end
+
+ def self.get(type=nil)
+ if type
+ tk_call_without_enc('clipboard', 'get', '-type', type)
+ else
+ tk_call_without_enc('clipboard', 'get')
+ end
+ end
+ def self.get_on_display(win, type=nil)
+ if type
+ tk_call_without_enc('clipboard', 'get', '-displayof', win, '-type', type)
+ else
+ tk_call_without_enc('clipboard', 'get', '-displayof', win)
+ end
+ end
+
+ def self.set(data, keys=nil)
+ clear
+ append(data, keys)
+ end
+ def self.set_on_display(win, data, keys=nil)
+ clear(win)
+ append_on_display(win, data, keys)
+ end
+
+ def self.append(data, keys=nil)
+ args = ['clipboard', 'append']
+ args.concat(hash_kv(keys))
+ args.concat(['--', data])
+ tk_call(*args)
+ end
+ def self.append_on_display(win, data, keys=nil)
+ args = ['clipboard', 'append', '-displayof', win]
+ args.concat(hash_kv(keys))
+ args.concat(['--', data])
+ tk_call(*args)
+ end
+
+ def clear
+ TkClipboard.clear_on_display(self)
+ self
+ end
+ def get(type=nil)
+ TkClipboard.get_on_display(self, type)
+ end
+ def set(data, keys=nil)
+ TkClipboard.set_on_display(self, data, keys)
+ self
+ end
+ def append(data, keys=nil)
+ TkClipboard.append_on_display(self, data, keys)
+ self
+ end
+end
diff --git a/ext/tk/lib/tk/clock.rb b/ext/tk/lib/tk/clock.rb
new file mode 100644
index 0000000000..88b66129ea
--- /dev/null
+++ b/ext/tk/lib/tk/clock.rb
@@ -0,0 +1,57 @@
+#
+# tk/clock.rb : methods for clock command
+#
+require 'tk'
+
+module Tk
+ module Clock
+ def self.clicks(ms=nil)
+ case ms
+ when nil
+ tk_call_without_enc('clock','clicks').to_i
+ when /^mic/
+ tk_call_without_enc('clock','clicks','-microseconds').to_i
+ when /^mil/
+ tk_call_without_enc('clock','clicks','-milliseconds').to_i
+ else
+ tk_call_without_enc('clock','clicks','-milliseconds').to_i
+ end
+ end
+
+ def self.format(clk, form=nil)
+ if form
+ tk_call('clock','format',clk,'-format',form)
+ else
+ tk_call('clock','format',clk)
+ end
+ end
+
+ def self.formatGMT(clk, form=nil)
+ if form
+ tk_call('clock','format',clk,'-format',form,'-gmt','1')
+ else
+ tk_call('clock','format',clk,'-gmt','1')
+ end
+ end
+
+ def self.scan(str, base=nil)
+ if base
+ tk_call('clock','scan',str,'-base',base).to_i
+ else
+ tk_call('clock','scan',str).to_i
+ end
+ end
+
+ def self.scanGMT(str, base=nil)
+ if base
+ tk_call('clock','scan',str,'-base',base,'-gmt','1').to_i
+ else
+ tk_call('clock','scan',str,'-gmt','1').to_i
+ end
+ end
+
+ def self.seconds
+ tk_call_without_enc('clock','seconds').to_i
+ end
+ end
+end
diff --git a/ext/tk/lib/tk/composite.rb b/ext/tk/lib/tk/composite.rb
new file mode 100644
index 0000000000..ed7796aafb
--- /dev/null
+++ b/ext/tk/lib/tk/composite.rb
@@ -0,0 +1,64 @@
+#
+# tk/composite.rb :
+#
+require 'tk'
+
+module TkComposite
+ include Tk
+ extend Tk
+
+ def initialize(parent=nil, *args)
+ @delegates = {}
+
+ if parent.kind_of? Hash
+ keys = _symbolkey2str(parent)
+ parent = keys.delete('parent')
+ @frame = TkFrame.new(parent)
+ @delegates['DEFAULT'] = @frame
+ @path = @epath = @frame.path
+ initialize_composite(keys)
+ else
+ @frame = TkFrame.new(parent)
+ @delegates['DEFAULT'] = @frame
+ @path = @epath = @frame.path
+ initialize_composite(*args)
+ end
+ end
+
+ def epath
+ @epath
+ end
+
+ def initialize_composite(*args) end
+ private :initialize_composite
+
+ def delegate(option, *wins)
+ if @delegates[option].kind_of?(Array)
+ for i in wins
+ @delegates[option].push(i)
+ end
+ else
+ @delegates[option] = wins
+ end
+ end
+
+ def configure(slot, value=None)
+ if slot.kind_of? Hash
+ slot.each{|slot,value| configure slot, value}
+ else
+ if @delegates and @delegates[slot]
+ for i in @delegates[slot]
+ if not i
+ i = @delegates['DEFALUT']
+ redo
+ else
+ last = i.configure(slot, value)
+ end
+ end
+ last
+ else
+ super
+ end
+ end
+ end
+end
diff --git a/ext/tk/lib/tk/console.rb b/ext/tk/lib/tk/console.rb
new file mode 100644
index 0000000000..855ee6a94f
--- /dev/null
+++ b/ext/tk/lib/tk/console.rb
@@ -0,0 +1,29 @@
+#
+# tk/console.rb : control the console on system without a real console
+#
+require 'tk'
+
+module TkConsole
+ include Tk
+ extend Tk
+
+ TkCommandNames = ['console'.freeze].freeze
+
+ def self.title(str=None)
+ tk_call 'console', str
+ end
+ def self.hide
+ tk_call_without_enc('console', 'hide')
+ end
+ def self.show
+ tk_call_without_enc('console', 'show')
+ end
+ def self.eval(tcl_script)
+ #
+ # supports a Tcl script only
+ # I have no idea to support a Ruby script seamlessly.
+ #
+ _fromUTF8(tk_call_without_enc('console', 'eval',
+ _get_eval_enc_str(tcl_script)))
+ end
+end
diff --git a/ext/tk/lib/tk/dialog.rb b/ext/tk/lib/tk/dialog.rb
new file mode 100644
index 0000000000..30521e126a
--- /dev/null
+++ b/ext/tk/lib/tk/dialog.rb
@@ -0,0 +1,290 @@
+#
+# tk/dialog.rb : create dialog boxes
+#
+require 'tk'
+
+class TkDialog2 < TkWindow
+ extend Tk
+
+ TkCommandNames = ['tk_dialog'.freeze].freeze
+
+ def self.show(*args)
+ dlog = self.new(*args)
+ dlog.show
+ dlog
+ end
+
+ def _set_button_config(configs)
+ set_config = proc{|c,i|
+ if $VERBOSE && (c.has_key?('command') || c.has_key?(:command))
+ STDERR.print("Warning: cannot give a command option " +
+ "to the dialog button#{i}. It was removed.\n")
+ end
+ c.delete('command'); c.delete(:command)
+ # @config << Kernel.format("%s.button%s configure %s; ",
+ # @path, i, hash_kv(c).join(' '))
+ @config << @path+'.button'+i.to_s+'configure '+hash_kv(c).join(' ')+'; '
+ }
+ case configs
+ when Proc
+ @buttons.each_index{|i|
+ if (c = configs.call(i)).kind_of? Hash
+ set_config.call(c,i)
+ end
+ }
+
+ when Array
+ @buttons.each_index{|i|
+ if (c = configs[i]).kind_of? Hash
+ set_config.call(c,i)
+ end
+ }
+
+ when Hash
+ @buttons.each_with_index{|s,i|
+ if (c = configs[s]).kind_of? Hash
+ set_config.call(c,i)
+ end
+ }
+ end
+ @config = 'after idle {' + @config + '};' if @config != ""
+ end
+ private :_set_button_config
+
+ # initialize tk_dialog
+ def create_self(keys)
+ #@var = TkVariable.new
+ @val = nil
+
+ @title = title
+
+ @message = message
+ @message_config = message_config
+ @msgframe_config = msgframe_config
+
+ @bitmap = bitmap
+ @bitmap_config = message_config
+
+ @default_button = default_button
+
+ @buttons = buttons
+ @button_configs = proc{|num| button_configs(num)}
+ @btnframe_config = btnframe_config
+
+ #@config = "puts [winfo children .w0000];"
+ @config = ""
+
+ @command = nil
+
+ if keys.kind_of? Hash
+ @title = keys['title'] if keys.key? 'title'
+ @message = keys['message'] if keys.key? 'message'
+ @bitmap = keys['bitmap'] if keys.key? 'bitmap'
+ @bitmap = '{}' if @bitmap == nil || @bitmap == ""
+ @default_button = keys['default'] if keys.key? 'default'
+ @buttons = keys['buttons'] if keys.key? 'buttons'
+
+ @command = keys['prev_command']
+
+ @message_config = keys['message_config'] if keys.key? 'message_config'
+ @msgframe_config = keys['msgframe_config'] if keys.key? 'msgframe_config'
+ @bitmap_config = keys['bitmap_config'] if keys.key? 'bitmap_config'
+ @button_configs = keys['button_configs'] if keys.key? 'button_configs'
+ @btnframe_config = keys['btnframe_config'] if keys.key? 'btnframe_config'
+ end
+
+ if @title.include? ?\s
+ @title = '{' + @title + '}'
+ end
+
+ if @buttons.kind_of? Array
+ _set_button_config(@buttons.collect{|cfg|
+ (cfg.kind_of? Array)? cfg[1]: nil})
+ @buttons = @buttons.collect{|cfg| (cfg.kind_of? Array)? cfg[0]: cfg}
+ end
+ if @buttons.kind_of? Hash
+ _set_button_config(@buttons)
+ @buttons = @buttons.keys
+ end
+ @buttons = tk_split_simplelist(@buttons) if @buttons.kind_of? String
+ @buttons = @buttons.collect{|s|
+ if s.kind_of? Array
+ s = s.join(' ')
+ end
+ if s.include? ?\s
+ '{' + s + '}'
+ else
+ s
+ end
+ }
+
+ if @message_config.kind_of? Hash
+ # @config << Kernel.format("%s.msg configure %s;",
+ # @path, hash_kv(@message_config).join(' '))
+ @config << @path+'.msg configure '+hash_kv(@message_config).join(' ')+';'
+ end
+
+ if @msgframe_config.kind_of? Hash
+ # @config << Kernel.format("%s.top configure %s;",
+ # @path, hash_kv(@msgframe_config).join(' '))
+ @config << @path+'.top configure '+hash_kv(@msgframe_config).join(' ')+';'
+ end
+
+ if @btnframe_config.kind_of? Hash
+ # @config << Kernel.format("%s.bot configure %s;",
+ # @path, hash_kv(@btnframe_config).join(' '))
+ @config << @path+'.bot configure '+hash_kv(@btnframe_config).join(' ')+';'
+ end
+
+ if @bitmap_config.kind_of? Hash
+ # @config << Kernel.format("%s.bitmap configure %s;",
+ # @path, hash_kv(@bitmap_config).join(' '))
+ @config << @path+'.bitmap configure '+hash_kv(@bitmap_config).join(' ')+';'
+ end
+
+ _set_button_config(@button_configs) if @button_configs
+
+ if @command.kind_of? Proc
+ @command.call(self)
+ end
+ end
+ private :create_self
+
+ def show
+ if @default_button.kind_of? String
+ default_button = @buttons.index(@default_button)
+ else
+ default_button = @default_button
+ end
+ default_button = '{}' if default_button == nil
+ #Tk.ip_eval('eval {global '+@var.id+';'+@config+
+ # 'set '+@var.id+' [tk_dialog '+
+ # @path+" "+@title+" {#{@message}} "+@bitmap+" "+
+ # String(default_button)+" "+@buttons.join(' ')+']}')
+ Tk.ip_eval(@config)
+ @val = Tk.ip_eval('tk_dialog ' + @path + ' ' + @title +
+ ' {' + @message + '} ' + @bitmap + ' ' +
+ String(default_button) + ' ' + @buttons.join(' ')).to_i
+ end
+
+ def value
+ # @var.value.to_i
+ @val
+ end
+ ######################################################
+ # #
+ # these methods must be overridden for each dialog #
+ # #
+ ######################################################
+ private
+
+ def title
+ # returns a title string of the dialog window
+ return "DIALOG"
+ end
+ def message
+ # returns a message text to display on the dialog
+ return "MESSAGE"
+ end
+ def message_config
+ # returns a Hash {option=>value, ...} for the message text
+ return nil
+ end
+ def msgframe_config
+ # returns a Hash {option=>value, ...} for the message text frame
+ return nil
+ end
+ def bitmap
+ # returns a bitmap name or a bitmap file path
+ # (@ + path ; e.g. '@/usr/share/bitmap/sample.xbm')
+ return "info"
+ end
+ def bitmap_config
+ # returns nil or a Hash {option=>value, ...} for the bitmap
+ return nil
+ end
+ def default_button
+ # returns a default button's number or name
+ # if nil or null string, set no-default
+ return 0
+ end
+ def buttons
+ #return "BUTTON1 BUTTON2"
+ return ["BUTTON1", "BUTTON2"]
+ end
+ def button_configs(num)
+ # returns nil / Proc / Array or Hash (see _set_button_config)
+ return nil
+ end
+ def btnframe_config
+ # returns nil or a Hash {option=>value, ...} for the button frame
+ return nil
+ end
+end
+
+
+#
+# TkDialog : with showing at initialize
+#
+class TkDialog < TkDialog2
+ def self.show(*args)
+ self.new(*args)
+ end
+
+ def initialize(*args)
+ super(*args)
+ show
+ end
+end
+
+
+#
+# dialog for warning
+#
+class TkWarning2 < TkDialog2
+ def initialize(parent = nil, mes = nil)
+ if !mes
+ if parent.kind_of? TkWindow
+ mes = ""
+ else
+ mes = parent.to_s
+ parent = nil
+ end
+ end
+ super(parent, :message=>mes)
+ end
+
+ def show(mes = nil)
+ mes_bup = @message
+ @message = mes if mes
+ ret = super()
+ @message = mes_bup
+ ret
+ end
+
+ #######
+ private
+
+ def title
+ return "WARNING";
+ end
+ def bitmap
+ return "warning";
+ end
+ def default_button
+ return 0;
+ end
+ def buttons
+ return "OK";
+ end
+end
+
+class TkWarning < TkWarning2
+ def self.show(*args)
+ self.new(*args)
+ end
+ def initialize(*args)
+ super(*args)
+ show
+ end
+end
diff --git a/ext/tk/lib/tk/encodedstr.rb b/ext/tk/lib/tk/encodedstr.rb
new file mode 100644
index 0000000000..5eb989f420
--- /dev/null
+++ b/ext/tk/lib/tk/encodedstr.rb
@@ -0,0 +1,107 @@
+#
+# tk/encodedstr.rb : Tk::EncodedString class
+#
+require 'tk'
+
+###########################################
+# string with Tcl's encoding
+###########################################
+module Tk
+ class EncodedString < String
+ Encoding = nil
+
+ def self.subst_utf_backslash(str)
+ # str.gsub(/\\u([0-9A-Fa-f]{1,4})/){[$1.hex].pack('U')}
+ TclTkLib._subst_UTF_backslash(str)
+ end
+ def self.utf_backslash(str)
+ self.subst_utf_backslash(str)
+ end
+
+ def self.subst_tk_backslash(str)
+ TclTkLib._subst_Tcl_backslash(str)
+ end
+
+ def self.utf_to_backslash_sequence(str)
+ str.unpack('U*').collect{|c|
+ if c <= 0xFF # ascii character
+ c.chr
+ else
+ format('\u%X', c)
+ end
+ }.join('')
+ end
+ def self.utf_to_backslash(str)
+ self.utf_to_backslash_sequence(str)
+ end
+
+ def self.to_backslash_sequence(str)
+ str.unpack('U*').collect{|c|
+ if c <= 0x1F # control character
+ case c
+ when 0x07; '\a'
+ when 0x08; '\b'
+ when 0x09; '\t'
+ when 0x0a; '\n'
+ when 0x0b; '\v'
+ when 0x0c; '\f'
+ when 0x0d; '\r'
+ else
+ format('\x%02X', c)
+ end
+ elsif c <= 0xFF # ascii character
+ c.chr
+ else
+ format('\u%X', c)
+ end
+ }.join('')
+ end
+
+ def self.new_with_utf_backslash(str, enc = nil)
+ self.new('', enc).replace(self.subst_utf_backslash(str))
+ end
+
+ def self.new_without_utf_backslash(str, enc = nil)
+ self.new('', enc).replace(str)
+ end
+
+ def initialize(str, enc = nil)
+ super(str)
+ @encoding = ( enc ||
+ ((self.class::Encoding)?
+ self.class::Encoding : Tk.encoding_system) )
+ end
+
+ attr_reader :encoding
+ end
+ # def Tk.EncodedString(str, enc = nil)
+ # Tk::EncodedString.new(str, enc)
+ # end
+
+ ##################################
+
+ class BinaryString < EncodedString
+ Encoding = 'binary'.freeze
+ end
+ # def Tk.BinaryString(str)
+ # Tk::BinaryString.new(str)
+ # end
+
+ ##################################
+
+ class UTF8_String < EncodedString
+ Encoding = 'utf-8'.freeze
+ def self.new(str)
+ super(self.subst_utf_backslash(str))
+ end
+
+ def to_backslash_sequence
+ Tk::EncodedString.utf_to_backslash_sequence(self)
+ end
+ alias to_backslash to_backslash_sequence
+ end
+ # def Tk.UTF8_String(str)
+ # Tk::UTF8_String.new(str)
+ # end
+
+end
diff --git a/ext/tk/lib/tk/entry.rb b/ext/tk/lib/tk/entry.rb
new file mode 100644
index 0000000000..2077c1e9e4
--- /dev/null
+++ b/ext/tk/lib/tk/entry.rb
@@ -0,0 +1,114 @@
+#
+# tk/entry.rb - Tk entry classes
+# $Date$
+# by Yukihiro Matsumoto <matz@caelum.co.jp>
+
+require 'tk'
+require 'tk/label'
+require 'tk/scrollable'
+require 'tk/validation'
+
+class TkEntry<TkLabel
+ include Scrollable
+ include TkValidation
+
+ TkCommandNames = ['entry'.freeze].freeze
+ WidgetClassName = 'Entry'.freeze
+ WidgetClassNames[WidgetClassName] = self
+
+
+ def create_self(keys)
+ tk_call_without_enc('entry', @path)
+ if keys and keys != None
+ configure(keys)
+ end
+ end
+ private :create_self
+
+ def bbox(index)
+ list(tk_send_without_enc('bbox', index))
+ end
+ def cursor
+ number(tk_send_without_enc('index', 'insert'))
+ end
+ def cursor=(index)
+ tk_send_without_enc('icursor', index)
+ #self
+ index
+ end
+ def index(index)
+ number(tk_send_without_enc('index', index))
+ end
+ def insert(pos,text)
+ tk_send_without_enc('insert', pos, _get_eval_enc_str(text))
+ self
+ end
+ def delete(first, last=None)
+ tk_send_without_enc('delete', first, last)
+ self
+ end
+ def mark(pos)
+ tk_send_without_enc('scan', 'mark', pos)
+ self
+ end
+ def dragto(pos)
+ tk_send_without_enc('scan', 'dragto', pos)
+ self
+ end
+ def selection_adjust(index)
+ tk_send_without_enc('selection', 'adjust', index)
+ self
+ end
+ def selection_clear
+ tk_send_without_enc('selection', 'clear')
+ self
+ end
+ def selection_from(index)
+ tk_send_without_enc('selection', 'from', index)
+ self
+ end
+ def selection_present()
+ bool(tk_send_without_enc('selection', 'present'))
+ end
+ def selection_range(s, e)
+ tk_send_without_enc('selection', 'range', s, e)
+ self
+ end
+ def selection_to(index)
+ tk_send_without_enc('selection', 'to', index)
+ self
+ end
+
+ def invoke_validate
+ bool(tk_send_without_enc('validate'))
+ end
+ def validate(mode = nil)
+ if mode
+ configure 'validate', mode
+ else
+ invoke_validate
+ end
+ end
+
+ def value
+ _fromUTF8(tk_send_without_enc('get'))
+ end
+ def value= (val)
+ tk_send_without_enc('delete', 0, 'end')
+ tk_send_without_enc('insert', 0, _get_eval_enc_str(val))
+ val
+ end
+ alias get value
+ alias set value=
+
+ def [](*args)
+ self.value[*args]
+ end
+ def []=(*args)
+ val = args.pop
+ str = self.value
+ str[*args] = val
+ self.value = str
+ val
+ end
+end
diff --git a/ext/tk/lib/tk/event.rb b/ext/tk/lib/tk/event.rb
new file mode 100644
index 0000000000..b85c456d41
--- /dev/null
+++ b/ext/tk/lib/tk/event.rb
@@ -0,0 +1,142 @@
+#
+# tk/event.rb - module for event
+#
+require 'tk'
+
+module TkEvent
+ class Event < TkUtil::CallbackSubst
+ module TypeNum
+ KeyPress = 2
+ KeyRelease = 3
+ ButtonPress = 4
+ ButtonRelease = 5
+ MotionNotify = 6
+ EnterNotify = 7
+ LeaveNotify = 8
+ FocusIn = 9
+ FocusOut = 10
+ KeymapNotify = 11
+ Expose = 12
+ GraphicsExpose = 13
+ NoExpose = 14
+ VisibilityNotify = 15
+ CreateNotify = 16
+ DestroyNotify = 17
+ UnmapNotify = 18
+ MapNotify = 19
+ MapRequest = 20
+ ReparentNotify = 21
+ ConfigureNotify = 22
+ ConfigureRequest = 23
+ GravityNotify = 24
+ ResizeRequest = 25
+ CirculateNotify = 26
+ CirculateRequest = 27
+ PropertyNotify = 28
+ SelectionClear = 29
+ SelectionRequest = 30
+ SelectionNotify = 31
+ ColormapNotify = 32
+ ClientMessage = 33
+ MappingNotify = 34
+ end
+
+ # [ <'%' subst-key char>, <proc type char>, <instance var (accessor) name>]
+ key_tbl = [
+ [ ?#, ?n, :serial ],
+ [ ?a, ?s, :above ],
+ [ ?b, ?n, :num ],
+ [ ?c, ?n, :count ],
+ [ ?d, ?s, :detail ],
+ [ ?f, ?b, :focus ],
+ [ ?h, ?n, :height ],
+ [ ?i, ?s, :win_hex ],
+ [ ?k, ?n, :keycode ],
+ [ ?m, ?s, :mode ],
+ [ ?o, ?b, :override ],
+ [ ?p, ?s, :place ],
+ [ ?s, ?x, :state ],
+ [ ?t, ?n, :time ],
+ [ ?w, ?n, :width ],
+ [ ?x, ?n, :x ],
+ [ ?y, ?n, :y ],
+ [ ?A, ?s, :char ],
+ [ ?B, ?n, :borderwidth ],
+ [ ?D, ?n, :wheel_delta ],
+ [ ?E, ?b, :send_event ],
+ [ ?K, ?s, :keysym ],
+ [ ?N, ?n, :keysym_num ],
+ [ ?R, ?s, :rootwin_id ],
+ [ ?S, ?s, :subwindow ],
+ [ ?T, ?n, :type ],
+ [ ?W, ?w, :widget ],
+ [ ?X, ?n, :x_root ],
+ [ ?Y, ?n, :y_root ],
+ nil
+ ]
+
+ # [ <proc type char>, <proc/method to convert tcl-str to ruby-obj>]
+ proc_tbl = [
+ [ ?n, TkComm.method(:num_or_str) ],
+ [ ?s, TkComm.method(:string) ],
+ [ ?b, TkComm.method(:bool) ],
+ [ ?w, TkComm.method(:window) ],
+
+ [ ?x, proc{|val|
+ begin
+ TkComm::number(val)
+ rescue ArgumentError
+ val
+ end
+ }
+ ],
+
+ nil
+ ]
+
+ # setup tables to be used by scan_args, _get_subst_key, _get_all_subst_keys
+ #
+ # _get_subst_key() and _get_all_subst_keys() generates key-string
+ # which describe how to convert callback arguments to ruby objects.
+ # When binding parameters are given, use _get_subst_key().
+ # But when no parameters are given, use _get_all_subst_keys() to
+ # create a Event class object as a callback parameter.
+ #
+ # scan_args() is used when doing callback. It convert arguments
+ # ( which are Tcl strings ) to ruby objects based on the key string
+ # that is generated by _get_subst_key() or _get_all_subst_keys().
+ #
+ _setup_subst_table(key_tbl, proc_tbl);
+ end
+
+ def install_bind(cmd, *args)
+ if args.compact.size > 0
+ args = args.join(' ')
+ keys = Event._get_subst_key(args)
+
+ if cmd.kind_of?(String)
+ id = cmd
+ elsif cmd.kind_of?(TkCallbackEntry)
+ id = install_cmd(cmd)
+ else
+ id = install_cmd(proc{|*arg|
+ TkUtil.eval_cmd(cmd, *Event.scan_args(keys, arg))
+ })
+ end
+ id + ' ' + args
+ else
+ keys, args = Event._get_all_subst_keys
+
+ if cmd.kind_of?(String)
+ id = cmd
+ elsif cmd.kind_of?(TkCallbackEntry)
+ id = install_cmd(cmd)
+ else
+ id = install_cmd(proc{|*arg|
+ TkUtil.eval_cmd(cmd, Event.new(*Event.scan_args(keys, arg)))
+ })
+ end
+ id + ' ' + args
+ end
+ end
+end
diff --git a/ext/tk/lib/tk/font.rb b/ext/tk/lib/tk/font.rb
new file mode 100644
index 0000000000..b8f7f1b991
--- /dev/null
+++ b/ext/tk/lib/tk/font.rb
@@ -0,0 +1,1407 @@
+#
+# tk/font.rb - the class to treat fonts on Ruby/Tk
+#
+# by Hidetoshi NAGAI (nagai@ai.kyutech.ac.jp)
+#
+require 'tk'
+
+class TkFont
+ include Tk
+ extend TkCore
+
+ TkCommandNames = ['font'.freeze].freeze
+
+ Tk_FontID = ["@font".freeze, "00000".taint].freeze
+ Tk_FontNameTBL = TkCore::INTERP.create_table
+ Tk_FontUseTBL = TkCore::INTERP.create_table
+
+ TkCore::INTERP.init_ip_env{
+ Tk_FontNameTBL.clear
+ Tk_FontUseTBL.clear
+ }
+
+ # set default font
+ case Tk::TK_VERSION
+ when /^4\.*/
+ DEFAULT_LATIN_FONT_NAME = 'a14'.freeze
+ DEFAULT_KANJI_FONT_NAME = 'k14'.freeze
+
+ when /^8\.*/
+ if JAPANIZED_TK
+ begin
+ fontnames = tk_call('font', 'names')
+ case fontnames
+ when /defaultgui/
+ # Tcl/Tk-JP for Windows
+ ltn = 'defaultgui'
+ knj = 'defaultgui'
+ when /Mincho:Helvetica-Bold-12/
+ # Tcl/Tk-JP for UNIX/X
+ ltn, knj = tk_split_simplelist(tk_call('font', 'configure',
+ 'Mincho:Helvetica-Bold-12',
+ '-compound'))
+ else
+ # unknown Tcl/Tk-JP
+ platform = tk_call('set', 'tcl_platform(platform)')
+ case platform
+ when 'unix'
+ ltn = {'family'=>'Helvetica'.freeze,
+ 'size'=>-12, 'weight'=>'bold'.freeze}
+ #knj = 'k14'
+ #knj = '-misc-fixed-medium-r-normal--14-*-*-*-c-*-jisx0208.1983-0'
+ knj = '-*-fixed-bold-r-normal--12-*-*-*-c-*-jisx0208.1983-0'
+ when 'windows'
+ ltn = {'family'=>'MS Sans Serif'.freeze, 'size'=>8}
+ knj = 'mincho'
+ when 'macintosh'
+ ltn = 'system'
+ knj = 'mincho'
+ else # unknown
+ ltn = 'Helvetica'
+ knj = 'mincho'
+ end
+ end
+ rescue
+ ltn = 'Helvetica'
+ knj = 'mincho'
+ end
+
+ else # not JAPANIZED_TK
+ begin
+ platform = tk_call('set', 'tcl_platform(platform)')
+ case platform
+ when 'unix'
+ ltn = {'family'=>'Helvetica'.freeze,
+ 'size'=>-12, 'weight'=>'bold'.freeze}
+ #knj = 'k14'
+ #knj = '-misc-fixed-medium-r-normal--14-*-*-*-c-*-jisx0208.1983-0'
+ knj = '-*-fixed-bold-r-normal--12-*-*-*-c-*-jisx0208.1983-0'
+ when 'windows'
+ ltn = {'family'=>'MS Sans Serif'.freeze, 'size'=>8}
+ knj = 'mincho'
+ when 'macintosh'
+ ltn = 'system'
+ knj = 'mincho'
+ else # unknown
+ ltn = 'Helvetica'
+ knj = 'mincho'
+ end
+ rescue
+ ltn = 'Helvetica'
+ knj = 'mincho'
+ end
+
+ knj = ltn
+ end
+
+ DEFAULT_LATIN_FONT_NAME = ltn.freeze
+ DEFAULT_KANJI_FONT_NAME = knj.freeze
+
+ else # unknown version
+ DEFAULT_LATIN_FONT_NAME = 'Helvetica'.freeze
+ DEFAULT_KANJI_FONT_NAME = 'mincho'.freeze
+
+ end
+
+ if $DEBUG
+ print "default latin font = "; p DEFAULT_LATIN_FONT_NAME
+ print "default kanji font = "; p DEFAULT_KANJI_FONT_NAME
+ end
+
+
+ ###################################
+ class DescendantFont
+ def initialize(compound, type)
+ unless compound.kind_of?(TkFont)
+ fail ArgumentError, "a TkFont object is expected for the 1st argument"
+ end
+ @compound = compound
+ case type
+ when 'kanji', 'latin', 'ascii'
+ @type = type
+ else
+ fail ArgumentError, "unknown type '#{type}'"
+ end
+ end
+
+ def dup
+ fail RuntimeError, "cannot dupulicate a descendant font"
+ end
+ def clone
+ fail RuntimeError, "cannot clone a descendant font"
+ end
+
+ def to_eval
+ @compound.__send__(@type + '_font_id')
+ end
+ def font
+ @compound.__send__(@type + '_font_id')
+ end
+
+ def [](slot)
+ @compound.__send__(@type + '_configinfo', slot)
+ end
+ def []=(slot, value)
+ @compound.__send__(@type + '_configure', slot, value)
+ value
+ end
+
+ def method_missing(id, *args)
+ @compound.__send__(@type + '_' + id.id2name, *args)
+ end
+ end
+
+
+ ###################################
+ # class methods
+ ###################################
+ def TkFont.families(window=nil)
+ case (Tk::TK_VERSION)
+ when /^4\.*/
+ ['fixed']
+
+ when /^8\.*/
+ if window
+ tk_split_simplelist(tk_call('font', 'families', '-displayof', window))
+ else
+ tk_split_simplelist(tk_call('font', 'families'))
+ end
+ end
+ end
+
+ def TkFont.names
+ case (Tk::TK_VERSION)
+ when /^4\.*/
+ r = ['fixed']
+ r += ['a14', 'k14'] if JAPANIZED_TK
+ Tk_FontNameTBL.each_value{|obj| r.push(obj)}
+ r | []
+
+ when /^8\.*/
+ tk_split_simplelist(tk_call('font', 'names'))
+
+ end
+ end
+
+ def TkFont.create_copy(font)
+ fail 'source-font must be a TkFont object' unless font.kind_of? TkFont
+ if TkComm::GET_CONFIGINFOwoRES_AS_ARRAY
+ keys = {}
+ font.configinfo.each{|key,value| keys[key] = value }
+ TkFont.new(font.latin_font_id, font.kanji_font_id, keys)
+ else # ! TkComm::GET_CONFIGINFOwoRES_AS_ARRAY
+ TkFont.new(font.latin_font_id, font.kanji_font_id, font.configinfo)
+ end
+ end
+
+ def TkFont.get_obj(name)
+ if name =~ /^(@font[0-9]+)(|c|l|k)$/
+ Tk_FontNameTBL[$1]
+ else
+ nil
+ end
+ end
+
+ def TkFont.init_widget_font(path, *args)
+ case (Tk::TK_VERSION)
+ when /^4\.*/
+ conf = tk_split_simplelist(tk_call(*args)).
+ find_all{|prop| prop[0..5]=='-font ' || prop[0..10]=='-kanjifont '}.
+ collect{|prop| tk_split_simplelist(prop)}
+ if font_inf = conf.assoc('-font')
+ ltn = font_inf[4]
+ ltn = nil if ltn == []
+ else
+ #ltn = nil
+ raise RuntimeError, "unknown option '-font'"
+ end
+ if font_inf = conf.assoc('-kanjifont')
+ knj = font_inf[4]
+ knj = nil if knj == []
+ else
+ knj = nil
+ end
+ TkFont.new(ltn, knj).call_font_configure(path, *(args + [{}]))
+
+ when /^8\.*/
+ font_prop = tk_split_simplelist(tk_call(*args)).find{|prop|
+ prop[0..5] == '-font '
+ }
+ unless font_prop
+ raise RuntimeError, "unknown option '-font'"
+ end
+ fnt = tk_split_simplelist(font_prop)[4]
+ if fnt == ""
+ TkFont.new(nil, nil).call_font_configure(path, *(args + [{}]))
+ else
+ begin
+ compound = tk_split_simplelist(
+ Hash[*tk_split_simplelist(tk_call('font', 'configure',
+ fnt))].collect{|key,value|
+ [key[1..-1], value]
+ }.assoc('compound')[1])
+ rescue
+ compound = []
+ end
+ if compound == []
+ #TkFont.new(fnt, DEFAULT_KANJI_FONT_NAME) \
+ #.call_font_configure(path, *(args + [{}]))
+ TkFont.new(fnt).call_font_configure(path, *(args + [{}]))
+ else
+ TkFont.new(compound[0], compound[1]) \
+ .call_font_configure(path, *(args + [{}]))
+ end
+ end
+ end
+ end
+
+ def TkFont.used_on(path=nil)
+ if path
+ Tk_FontUseTBL[path]
+ else
+ Tk_FontUseTBL.values | []
+ end
+ end
+
+ def TkFont.failsafe(font)
+ begin
+ if /^8\.*/ === Tk::TK_VERSION && JAPANIZED_TK
+ tk_call('font', 'failsafe', font)
+ end
+ rescue
+ end
+ end
+
+ ###################################
+ # instance methods
+ ###################################
+ private
+ ###################################
+ def initialize(ltn=nil, knj=nil, keys=nil)
+ @id = Tk_FontID.join('')
+ Tk_FontID[1].succ!
+ Tk_FontNameTBL[@id] = self
+
+ @latin_desscendant = nil
+ @kanji_desscendant = nil
+
+ if knj.kind_of?(Hash) && !keys
+ keys = knj
+ knj = nil
+ end
+
+ # compound font check
+ if Tk::TK_VERSION == '8.0' && JAPANIZED_TK
+ begin
+ compound = tk_split_simplelist(tk_call('font', 'configure',
+ ltn, '-compound'))
+ if knj == nil
+ if compound != []
+ ltn, knj = compound
+ end
+ else
+ if compound != []
+ ltn = compound[0]
+ end
+ compound = tk_split_simplelist(tk_call('font', 'configure',
+ knj, '-compound'))
+ if compound != []
+ knj = compound[1]
+ end
+ end
+ rescue
+ end
+ end
+
+ if ltn
+ if JAPANIZED_TK && !knj
+ if Tk::TK_VERSION =~ /^4.*/
+ knj = DEFAULT_KANJI_FONT_NAME
+ else
+ knj = ltn
+ end
+ end
+ else
+ ltn = DEFAULT_LATIN_FONT_NAME
+ knj = DEFAULT_KANJI_FONT_NAME if JAPANIZED_TK && !knj
+ end
+
+ create_compoundfont(ltn, knj, keys)
+ end
+
+ def _get_font_info_from_hash(font)
+ font = _symbolkey2str(font)
+ foundry = (info = font['foundry'] .to_s)? info: '*'
+ family = (info = font['family'] .to_s)? info: '*'
+ weight = (info = font['weight'] .to_s)? info: '*'
+ slant = (info = font['slant'] .to_s)? info: '*'
+ swidth = (info = font['swidth'] .to_s)? info: '*'
+ adstyle = (info = font['adstyle'] .to_s)? info: '*'
+ pixels = (info = font['pixels'] .to_s)? info: '*'
+ points = (info = font['points'] .to_s)? info: '*'
+ resx = (info = font['resx'] .to_s)? info: '*'
+ resy = (info = font['resy'] .to_s)? info: '*'
+ space = (info = font['space'] .to_s)? info: '*'
+ avgWidth = (info = font['avgWidth'].to_s)? info: '*'
+ charset = (info = font['charset'] .to_s)? info: '*'
+ encoding = (info = font['encoding'].to_s)? info: '*'
+
+ [foundry, family, weight, slant, swidth, adstyle,
+ pixels, points, resx, resy, space, avgWidth, charset, encoding]
+ end
+
+ def create_latinfont_tk4x(font)
+ if font.kind_of? Hash
+ @latinfont = '-' + _get_font_info_from_hash(font).join('-') + '-'
+
+ elsif font.kind_of? Array
+ finfo = {}
+ finfo['family'] = font[0].to_s
+ if font[1]
+ fsize = font[1].to_s
+ if fsize != '0' && fsize =~ /^(|\+|-)([0-9]+)$/
+ if $1 == '-'
+ finfo['pixels'] = $2
+ else
+ finfo['points'] = $2
+ end
+ else
+ finfo['points'] = '13'
+ end
+ end
+ font[2..-1].each{|style|
+ case (style)
+ when 'normal'
+ finfo['weight'] = style
+ when 'bold'
+ finfo['weight'] = style
+ when 'roman'
+ finfo['slant'] = 'r'
+ when 'italic'
+ finfo['slant'] = 'i'
+ end
+ }
+
+ @latinfont = '-' + _get_font_info_from_hash(finfo).join('-') + '-'
+
+ elsif font.kind_of? TkFont
+ @latinfont = font.latin_font
+
+ else
+ if font
+ @latinfont = font
+ else
+ @latinfont = DEFAULT_LATIN_FONT_NAME
+ end
+
+ end
+ end
+
+ def create_kanjifont_tk4x(font)
+ unless JAPANIZED_TK
+ @kanjifont = ""
+ return
+ end
+
+ if font.kind_of? Hash
+ @kanjifont = '-' + _get_font_info_from_hash(font).join('-') + '-'
+
+ elsif font.kind_of? Array
+ finfo = {}
+ finfo['family'] = font[0].to_s
+ if font[1]
+ fsize = font[1].to_s
+ if fsize != '0' && fsize =~ /^(|\+|-)([0-9]+)$/
+ if $1 == '-'
+ finfo['pixels'] = $2
+ else
+ finfo['points'] = $2
+ end
+ else
+ finfo['points'] = '13'
+ end
+ end
+ font[2..-1].each{|style|
+ case (style)
+ when 'normal'
+ finfo['weight'] = style
+ when 'bold'
+ finfo['weight'] = style
+ when 'roman'
+ finfo['slant'] = 'r'
+ when 'italic'
+ finfo['slant'] = 'i'
+ end
+ }
+
+ @kanjifont = '-' + _get_font_info_from_hash(finfo).join('-') + '-'
+ elsif font.kind_of? TkFont
+ @kanjifont = font.kanji_font_id
+ else
+ if font
+ @kanjifont = font
+ else
+ @kanjifont = DEFAULT_KANJI_FONT_NAME
+ end
+ end
+ end
+
+ def create_compoundfont_tk4x(ltn, knj, keys)
+ create_latinfont(ltn)
+ create_kanjifont(knj)
+
+ if JAPANIZED_TK
+ @compoundfont = [[@latinfont], [@kanjifont]]
+ @fontslot = {'font'=>@latinfont, 'kanjifont'=>@kanjifont}
+ else
+ @compoundfont = @latinfont
+ @fontslot = {'font'=>@latinfont}
+ end
+ end
+
+ def create_latinfont_tk8x(font)
+ @latinfont = @id + 'l'
+
+ if JAPANIZED_TK
+ if font.kind_of? Hash
+ if font[:charset] || font['charset']
+ tk_call('font', 'create', @latinfont, *hash_kv(font))
+ else
+ tk_call('font', 'create', @latinfont,
+ '-charset', 'iso8859', *hash_kv(font))
+ end
+ elsif font.kind_of? Array
+ tk_call('font', 'create', @latinfont, '-copy', array2tk_list(font))
+ tk_call('font', 'configure', @latinfont, '-charset', 'iso8859')
+ elsif font.kind_of? TkFont
+ tk_call('font', 'create', @latinfont, '-copy', font.latin_font)
+ elsif font
+ tk_call('font', 'create', @latinfont, '-copy', font,
+ '-charset', 'iso8859')
+ else
+ tk_call('font', 'create', @latinfont, '-charset', 'iso8859')
+ end
+ else
+ if font.kind_of? Hash
+ tk_call('font', 'create', @latinfont, *hash_kv(font))
+ else
+ keys = {}
+ if font.kind_of? Array
+ actual_core(array2tk_list(font)).each{|key,val| keys[key] = val}
+ elsif font.kind_of? TkFont
+ actual_core(font.latin_font).each{|key,val| keys[key] = val}
+ elsif font
+ actual_core(font).each{|key,val| keys[key] = val}
+ end
+ tk_call('font', 'create', @latinfont, *hash_kv(keys))
+ end
+
+ if font && @compoundfont
+ keys = {}
+ actual_core(@latinfont).each{|key,val| keys[key] = val}
+ tk_call('font', 'configure', @compoundfont, *hash_kv(keys))
+ end
+ end
+ end
+
+ def create_kanjifont_tk8x(font)
+ @kanjifont = @id + 'k'
+
+ if JAPANIZED_TK
+ if font.kind_of? Hash
+ if font[:charset] || font['charset']
+ tk_call('font', 'create', @kanjifont, *hash_kv(font))
+ else
+ tk_call('font', 'create', @kanjifont,
+ '-charset', 'jisx0208.1983', *hash_kv(font))
+ end
+ elsif font.kind_of? Array
+ tk_call('font', 'create', @kanjifont, '-copy', array2tk_list(font))
+ tk_call('font', 'configure', @kanjifont, '-charset', 'jisx0208.1983')
+ elsif font.kind_of? TkFont
+ tk_call('font', 'create', @kanjifont, '-copy', font.kanji_font_id)
+ elsif font
+ tk_call('font', 'create', @kanjifont, '-copy', font,
+ '-charset', 'jisx0208.1983')
+ else
+ tk_call('font', 'create', @kanjifont, '-charset', 'jisx0208.1983')
+ end
+ # end of JAPANIZED_TK
+
+ else
+ if font.kind_of? Hash
+ tk_call('font', 'create', @kanjifont, *hash_kv(font))
+ else
+ keys = {}
+ if font.kind_of? Array
+ actual_core(array2tk_list(font)).each{|key,val| keys[key] = val}
+ elsif font.kind_of? TkFont
+ actual_core(font.kanji_font_id).each{|key,val| keys[key] = val}
+ elsif font
+ actual_core(font).each{|key,val| keys[key] = val}
+ end
+ tk_call('font', 'create', @kanjifont, *hash_kv(keys))
+ end
+
+ if font && @compoundfont
+ keys = {}
+ actual_core(@kanjifont).each{|key,val| keys[key] = val}
+ tk_call('font', 'configure', @compoundfont, *hash_kv(keys))
+ end
+ end
+ end
+
+ def create_compoundfont_tk8x(ltn, knj, keys)
+ create_latinfont(ltn)
+ create_kanjifont(knj)
+
+ @compoundfont = @id + 'c'
+ if JAPANIZED_TK
+ unless keys
+ keys = {}
+ else
+ keys = keys.dup
+ end
+ if (tk_call('font', 'configure', @latinfont, '-underline') == '1' &&
+ tk_call('font', 'configure', @kanjifont, '-underline') == '1' &&
+ !keys.key?('underline'))
+ keys['underline'] = true
+ end
+ if (tk_call('font', 'configure', @latinfont, '-overstrike') == '1' &&
+ tk_call('font', 'configure', @kanjifont, '-overstrike') == '1' &&
+ !keys.key?('overstrike'))
+ keys['overstrike'] = true
+ end
+
+ @fontslot = {'font'=>@compoundfont}
+ begin
+ tk_call('font', 'create', @compoundfont,
+ '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+ rescue RuntimeError => e
+ if ltn == knj
+ if e.message =~ /kanji font .* specified/
+ tk_call('font', 'delete', @latinfont)
+ create_latinfont(DEFAULT_LATIN_FONT_NAME)
+ opts = []
+ Hash[*(tk_split_simplelist(tk_call('font', 'configure',
+ @kanjifont)))].each{|k,v|
+ case k
+ when '-size', '-weight', '-slant', '-underline', '-overstrike'
+ opts << k << v
+ end
+ }
+ tk_call('font', 'configure', @latinfont, *opts)
+ tk_call('font', 'create', @compoundfont,
+ '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+
+ elsif e.message =~ /ascii font .* specified/
+ tk_call('font', 'delete', @kanjifont)
+ create_kanjifont(DEFAULT_KANJI_FONT_NAME)
+ opts = []
+ Hash[*(tk_split_simplelist(tk_call('font', 'configure',
+ @latinfont)))].each{|k,v|
+ case k
+ when '-size', '-weight', '-slant', '-underline', '-overstrike'
+ opts << k << v
+ end
+ }
+ tk_call('font', 'configure', @kanjifont, *opts)
+ tk_call('font', 'create', @compoundfont,
+ '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+
+ else
+ raise e
+ end
+ else
+ raise e
+ end
+ end
+ else
+ tk_call('font', 'create', @compoundfont)
+
+ latinkeys = {}
+ begin
+ actual_core(@latinfont).each{|key,val| latinkeys[key] = val}
+ rescue
+ latinkeys {}
+ end
+ if latinkeys != {}
+ tk_call('font', 'configure', @compoundfont, *hash_kv(latinkeys))
+ end
+
+ if knj
+ kanjikeys = {}
+ begin
+ actual_core(@kanjifont).each{|key,val| kanjikeys[key] = val}
+ rescue
+ kanjikeys {}
+ end
+ if kanjikeys != {}
+ tk_call('font', 'configure', @compoundfont, *hash_kv(kanjikeys))
+ end
+ end
+
+ @fontslot = {'font'=>@compoundfont}
+ tk_call('font', 'configure', @compoundfont, *hash_kv(keys))
+ end
+ end
+
+ def actual_core_tk4x(font, window=nil, option=nil)
+ # dummy
+ if option
+ ""
+ else
+ [['family',[]], ['size',[]], ['weight',[]], ['slant',[]],
+ ['underline',[]], ['overstrike',[]], ['charset',[]],
+ ['pointadjust',[]]]
+ end
+ end
+
+ def actual_core_tk8x(font, window=nil, option=nil)
+ if option == 'compound'
+ ""
+ elsif option
+ if window
+ tk_call('font', 'actual', font, "-displayof", window, "-#{option}")
+ else
+ tk_call('font', 'actual', font, "-#{option}")
+ end
+ else
+ l = tk_split_simplelist(if window
+ tk_call('font', 'actual', font,
+ "-displayof", window)
+ else
+ tk_call('font', 'actual', font)
+ end)
+ r = []
+ while key=l.shift
+ if key == '-compound'
+ l.shift
+ else
+ r.push [key[1..-1], l.shift]
+ end
+ end
+ r
+ end
+ end
+
+ def configure_core_tk4x(font, slot, value=None)
+ #""
+ self
+ end
+
+ def configinfo_core_tk4x(font, option=nil)
+ # dummy
+ if TkComm::GET_CONFIGINFOwoRES_AS_ARRAY
+ if option
+ ""
+ else
+ [['family',[]], ['size',[]], ['weight',[]], ['slant',[]],
+ ['underline',[]], ['overstrike',[]], ['charset',[]],
+ ['pointadjust',[]]]
+ end
+ else # ! TkComm::GET_CONFIGINFOwoRES_AS_ARRAY
+ current_configinfo_core_tk4x(font, option)
+ end
+ end
+
+ def current_configinfo_core_tk4x(font, option=nil)
+ if option
+ ""
+ else
+ {'family'=>'', 'size'=>'', 'weight'=>'', 'slant'=>'',
+ 'underline'=>'', 'overstrike'=>'', 'charset'=>'', 'pointadjust'=>''}
+ end
+ end
+
+ def configure_core_tk8x(font, slot, value=None)
+ if JAPANIZED_TK
+ begin
+ padjust = tk_call('font', 'configure', font, '-pointadjust')
+ rescue
+ padjust = nil
+ end
+ else
+ padjust = nil
+ end
+ if slot.kind_of? Hash
+ if JAPANIZED_TK && (slot.key?('family') || slot.key?(:family))
+ slot = _symbolkey2str(slot)
+ configure_core_tk8x(font, 'family', slot.delete('family'))
+ end
+
+ if ((slot.key?('size') || slot.key?(:size)) &&
+ padjust && !slot.key?('pointadjust') && !slot.key?(:pointadjust))
+ tk_call('font', 'configure', font,
+ '-pointadjust', padjust, *hash_kv(slot))
+ else
+ tk_call('font', 'configure', font, *hash_kv(slot))
+ end
+ elsif (slot == 'size' || slot == :size) && padjust != nil
+ tk_call('font', 'configure', font,
+ "-#{slot}", value, '-pointadjust', padjust)
+ elsif JAPANIZED_TK && (slot == 'family' || slot == :family)
+ # coumpund font?
+ begin
+ compound = tk_split_simplelist(tk_call('font', 'configure',
+ font, '-compound'))
+ rescue
+ tk_call('font', 'configure', font, '-family', value)
+ return self
+ end
+ if compound == []
+ tk_call('font', 'configure', font, '-family', value)
+ return self
+ end
+ ltn, knj = compound
+
+ lfnt = tk_call('font', 'create', '-copy', ltn)
+ begin
+ tk_call('font', 'configure', lfnt, '-family', value)
+ latin_replace_core_tk8x(lfnt)
+ rescue RuntimeError => e
+ fail e if $DEBUG
+ ensure
+ tk_call('font', 'delete', lfnt) if lfnt != ''
+ end
+
+ kfnt = tk_call('font', 'create', '-copy', knj)
+ begin
+ tk_call('font', 'configure', kfnt, '-family', value)
+ kanji_replace_core_tk8x(lfnt)
+ rescue RuntimeError => e
+ fail e if $DEBUG
+ ensure
+ tk_call('font', 'delete', kfnt) if kfnt != ''
+ end
+
+ else
+ tk_call('font', 'configure', font, "-#{slot}", value)
+ end
+ self
+ end
+
+ def configinfo_core_tk8x(font, option=nil)
+ if TkComm::GET_CONFIGINFOwoRES_AS_ARRAY
+ if option == 'compound'
+ ""
+ elsif option
+ tk_call('font', 'configure', font, "-#{option}")
+ else
+ l = tk_split_simplelist(tk_call('font', 'configure', font))
+ r = []
+ while key=l.shift
+ if key == '-compound'
+ l.shift
+ else
+ r.push [key[1..-1], l.shift]
+ end
+ end
+ r
+ end
+ else # ! TkComm::GET_CONFIGINFOwoRES_AS_ARRAY
+ current_configinfo_core_tk8x(font, option)
+ end
+ end
+
+ def current_configinfo_core_tk8x(font, option=nil)
+ if option == 'compound'
+ ""
+ elsif option
+ tk_call('font', 'configure', font, "-#{option}")
+ else
+ l = tk_split_simplelist(tk_call('font', 'configure', font))
+ r = {}
+ while key=l.shift
+ if key == '-compound'
+ l.shift
+ else
+ r[key[1..-1]] = l.shift
+ end
+ end
+ r
+ end
+ end
+
+ def delete_core_tk4x
+ Tk_FontNameTBL.delete(@id)
+ Tk_FontUseTBL.delete_if{|key,value| value == self}
+ end
+
+ def delete_core_tk8x
+ begin
+ tk_call('font', 'delete', @latinfont)
+ rescue
+ end
+ begin
+ tk_call('font', 'delete', @kanjifont)
+ rescue
+ end
+ begin
+ tk_call('font', 'delete', @compoundfont)
+ rescue
+ end
+ Tk_FontNameTBL.delete(@id)
+ Tk_FontUseTBL.delete_if{|key,value| value == self}
+ end
+
+ def latin_replace_core_tk4x(ltn)
+ create_latinfont_tk4x(ltn)
+ @compoundfont[0] = [@latinfont] if JAPANIZED_TK
+ @fontslot['font'] = @latinfont
+ Tk_FontUseTBL.dup.each{|w, fobj|
+ if self == fobj
+ begin
+ if w.include?(';')
+ win, tag = w.split(';')
+ winobj = tk_tcl2ruby(win)
+# winobj.tagfont_configure(tag, {'font'=>@latinfont})
+ if winobj.kind_of? TkText
+ tk_call(win, 'tag', 'configure', tag, '-font', @latinfont)
+ elsif winobj.kind_of? TkCanvas
+ tk_call(win, 'itemconfigure', tag, '-font', @latinfont)
+ elsif winobj.kind_of? TkMenu
+ tk_call(win, 'entryconfigure', tag, '-font', @latinfont)
+ else
+ raise RuntimeError, "unknown widget type"
+ end
+ else
+# tk_tcl2ruby(w).font_configure('font'=>@latinfont)
+ tk_call(w, 'configure', '-font', @latinfont)
+ end
+ rescue
+ Tk_FontUseTBL.delete(w)
+ end
+ end
+ }
+ self
+ end
+
+ def kanji_replace_core_tk4x(knj)
+ return self unless JAPANIZED_TK
+
+ create_kanjifont_tk4x(knj)
+ @compoundfont[1] = [@kanjifont]
+ @fontslot['kanjifont'] = @kanjifont
+ Tk_FontUseTBL.dup.each{|w, fobj|
+ if self == fobj
+ begin
+ if w.include?(';')
+ win, tag = w.split(';')
+ winobj = tk_tcl2ruby(win)
+# winobj.tagfont_configure(tag, {'kanjifont'=>@kanjifont})
+ if winobj.kind_of? TkText
+ tk_call(win, 'tag', 'configure', tag, '-kanjifont', @kanjifont)
+ elsif winobj.kind_of? TkCanvas
+ tk_call(win, 'itemconfigure', tag, '-kanjifont', @kanjifont)
+ elsif winobj.kind_of? TkMenu
+ tk_call(win, 'entryconfigure', tag, '-kanjifont', @latinfont)
+ else
+ raise RuntimeError, "unknown widget type"
+ end
+ else
+# tk_tcl2ruby(w).font_configure('kanjifont'=>@kanjifont)
+ tk_call(w, 'configure', '-kanjifont', @kanjifont)
+ end
+ rescue
+ Tk_FontUseTBL.delete(w)
+ end
+ end
+ }
+ self
+ end
+
+ def latin_replace_core_tk8x(ltn)
+ if JAPANIZED_TK
+ begin
+ tk_call('font', 'delete', '@font_tmp')
+ rescue
+ end
+ begin
+ fnt_bup = tk_call('font', 'create', '@font_tmp', '-copy', @latinfont)
+ rescue
+ #fnt_bup = ''
+ fnt_bup = DEFAULT_LATIN_FONT_NAME
+ end
+ end
+
+ begin
+ tk_call('font', 'delete', @latinfont)
+ rescue
+ end
+ create_latinfont(ltn)
+
+ if JAPANIZED_TK
+ keys = self.configinfo
+ tk_call('font', 'delete', @compoundfont)
+ begin
+ tk_call('font', 'create', @compoundfont,
+ '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+=begin
+ latinkeys = {}
+ begin
+ actual_core(@latinfont).each{|key,val| latinkeys[key] = val}
+ rescue
+ latinkeys {}
+ end
+ if latinkeys != {}
+ tk_call('font', 'configure', @compoundfont, *hash_kv(latinkeys))
+ end
+=end
+ rescue RuntimeError => e
+ tk_call('font', 'delete', @latinfont)
+ if fnt_bup && fnt_bup != ''
+ tk_call('font', 'create', @latinfont, '-copy', fnt_bup)
+ tk_call('font', 'create', @compoundfont,
+ '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+ tk_call('font', 'delete', fnt_bup)
+ else
+ fail e
+ end
+ end
+
+ else
+ latinkeys = {}
+ begin
+ actual_core(@latinfont).each{|key,val| latinkeys[key] = val}
+ rescue
+ latinkeys {}
+ end
+ if latinkeys != {}
+ tk_call('font', 'configure', @compoundfont, *hash_kv(latinkeys))
+ end
+ end
+ self
+ end
+
+ def kanji_replace_core_tk8x(knj)
+ if JAPANIZED_TK
+ begin
+ tk_call('font', 'delete', '@font_tmp')
+ rescue
+ end
+ begin
+ fnt_bup = tk_call('font', 'create', '@font_tmp', '-copy', @kanjifont)
+ rescue
+ #fnt_bup = ''
+ fnt_bup = DEFAULT_KANJI_FONT_NAME
+ end
+ end
+
+ begin
+ tk_call('font', 'delete', @kanjifont)
+ rescue
+ end
+ create_kanjifont(knj)
+
+ if JAPANIZED_TK
+ keys = self.configinfo
+ tk_call('font', 'delete', @compoundfont)
+ begin
+ tk_call('font', 'create', @compoundfont,
+ '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+ rescue RuntimeError => e
+ tk_call('font', 'delete', @kanjifont)
+ if fnt_bup && fnt_bup != ''
+ tk_call('font', 'create', @kanjifont, '-copy', fnt_bup)
+ tk_call('font', 'create', @compoundfont,
+ '-compound', [@latinfont, @kanjifont], *hash_kv(keys))
+ tk_call('font', 'delete', fnt_bup)
+ else
+ fail e
+ end
+ end
+ end
+ self
+ end
+
+ def measure_core_tk4x(window, text)
+ 0
+ end
+
+ def measure_core_tk8x(window, text)
+ if window
+ number(tk_call('font', 'measure', @compoundfont,
+ '-displayof', window, text))
+ else
+ number(tk_call('font', 'measure', @compoundfont, text))
+ end
+ end
+
+ def metrics_core_tk4x(font, window, option=nil)
+ # dummy
+ if option
+ ""
+ else
+ [['ascent',[]], ['descent',[]], ['linespace',[]], ['fixed',[]]]
+ end
+ end
+
+ def metrics_core_tk8x(font, window, option=nil)
+ if option
+ if window
+ number(tk_call('font', 'metrics', font,
+ "-displayof", window, "-#{option}"))
+ else
+ number(tk_call('font', 'metrics', font, "-#{option}"))
+ end
+ else
+ l = tk_split_list(if window
+ tk_call('font','metrics',font,"-displayof",window)
+ else
+ tk_call('font','metrics',font)
+ end)
+ r = []
+ while key=l.shift
+ r.push [key[1..-1], l.shift.to_i]
+ end
+ r
+ end
+ end
+
+ ###################################
+ # private alias
+ ###################################
+ case (Tk::TK_VERSION)
+ when /^4\.*/
+ alias create_latinfont create_latinfont_tk4x
+ alias create_kanjifont create_kanjifont_tk4x
+ alias create_compoundfont create_compoundfont_tk4x
+ alias actual_core actual_core_tk4x
+ alias configure_core configure_core_tk4x
+ alias configinfo_core configinfo_core_tk4x
+ alias current_configinfo_core current_configinfo_core_tk4x
+ alias delete_core delete_core_tk4x
+ alias latin_replace_core latin_replace_core_tk4x
+ alias kanji_replace_core kanji_replace_core_tk4x
+ alias measure_core measure_core_tk4x
+ alias metrics_core metrics_core_tk4x
+
+ when /^8\.[0-5]/
+ alias create_latinfont create_latinfont_tk8x
+ alias create_kanjifont create_kanjifont_tk8x
+ alias create_compoundfont create_compoundfont_tk8x
+ alias actual_core actual_core_tk8x
+ alias configure_core configure_core_tk8x
+ alias configinfo_core configinfo_core_tk8x
+ alias current_configinfo_core current_configinfo_core_tk8x
+ alias delete_core delete_core_tk8x
+ alias latin_replace_core latin_replace_core_tk8x
+ alias kanji_replace_core kanji_replace_core_tk8x
+ alias measure_core measure_core_tk8x
+ alias metrics_core metrics_core_tk8x
+
+ else
+ alias create_latinfont create_latinfont_tk8x
+ alias create_kanjifont create_kanjifont_tk8x
+ alias create_compoundfont create_compoundfont_tk8x
+ alias actual_core actual_core_tk8x
+ alias configure_core configure_core_tk8x
+ alias configinfo_core configinfo_core_tk8x
+ alias current_configinfo_core current_configinfo_core_tk8x
+ alias delete_core delete_core_tk8x
+ alias latin_replace_core latin_replace_core_tk8x
+ alias kanji_replace_core kanji_replace_core_tk8x
+ alias measure_core measure_core_tk8x
+ alias metrics_core metrics_core_tk8x
+
+ end
+
+ ###################################
+ public
+ ###################################
+ def method_missing(id, *args)
+ name = id.id2name
+ case args.length
+ when 1
+ configure name, args[0]
+ when 0
+ begin
+ configinfo name
+ rescue
+ fail NameError, "undefined local variable or method `#{name}' for #{self.to_s}", error_at
+ end
+ else
+ fail NameError, "undefined method `#{name}' for #{self.to_s}", error_at
+ end
+ end
+
+ def call_font_configure(path, *args)
+ keys = args.pop.update(@fontslot)
+ args.concat(hash_kv(keys))
+ tk_call(*args)
+ Tk_FontUseTBL[path] = self
+ self
+ end
+
+ def used
+ ret = []
+ Tk_FontUseTBL.each{|key,value|
+ if key.include?(';')
+ win, tag = key.split(';')
+ winobj = tk_tcl2ruby(win)
+ if winobj.kind_of? TkText
+ ret.push([winobj, winobj.tagid2obj(tag)])
+ elsif winobj.kind_of? TkCanvas
+ if (tagobj = TkcTag.id2obj(winobj, tag)).kind_of? TkcTag
+ ret.push([winobj, tagobj])
+ elsif (tagobj = TkcItem.id2obj(tag)).kind_of? TkcItem
+ ret.push([winobj, tagobj])
+ else
+ ret.push([winobj, tag])
+ end
+ elsif winobj.kind_of? TkMenu
+ ret.push([winobj, tag])
+ else
+ ret.push([win, tag])
+ end
+ else
+ ret.push(tk_tcl2ruby(key)) if value == self
+ end
+ }
+ ret
+ end
+
+ def id
+ @id
+ end
+
+ def to_eval
+ font
+ end
+
+ def font
+ @compoundfont
+ end
+ alias font_id font
+
+ def latin_font_id
+ @latinfont
+ end
+
+ def latin_font
+ # @latinfont
+ if @latin_descendant
+ @latin_descendant
+ else
+ @latin_descendant = DescendantFont.new(self, 'latin')
+ end
+ end
+ alias latinfont latin_font
+
+ def kanji_font_id
+ @kanjifont
+ end
+
+ def kanji_font
+ # @kanjifont
+ if @kanji_descendant
+ @kanji_descendant
+ else
+ @kanji_descendant = DescendantFont.new(self, 'kanji')
+ end
+ end
+ alias kanjifont kanji_font
+
+ def actual(option=nil)
+ actual_core(@compoundfont, nil, option)
+ end
+
+ def actual_displayof(window, option=nil)
+ window = '.' unless window
+ actual_core(@compoundfont, window, option)
+ end
+
+ def latin_actual(option=nil)
+ actual_core(@latinfont, nil, option)
+ end
+
+ def latin_actual_displayof(window, option=nil)
+ window = '.' unless window
+ actual_core(@latinfont, window, option)
+ end
+
+ def kanji_actual(option=nil)
+ #if JAPANIZED_TK
+ if @kanjifont != ""
+ actual_core(@kanjifont, nil, option)
+ else
+ actual_core_tk4x(nil, nil, option)
+ end
+ end
+
+ def kanji_actual_displayof(window, option=nil)
+ #if JAPANIZED_TK
+ if @kanjifont != ""
+ window = '.' unless window
+ actual_core(@kanjifont, window, option)
+ else
+ actual_core_tk4x(nil, window, option)
+ end
+ end
+
+ def [](slot)
+ configinfo slot
+ end
+
+ def []=(slot, val)
+ configure slot, val
+ val
+ end
+
+ def configure(slot, value=None)
+ configure_core(@compoundfont, slot, value)
+ self
+ end
+
+ def configinfo(slot=nil)
+ configinfo_core(@compoundfont, slot)
+ end
+
+ def current_configinfo(slot=nil)
+ current_configinfo_core(@compoundfont, slot)
+ end
+
+ def delete
+ delete_core
+ end
+
+ def latin_configure(slot, value=None)
+ if JAPANIZED_TK
+ configure_core(@latinfont, slot, value)
+ else
+ configure(slot, value)
+ end
+ self
+ end
+
+ def latin_configinfo(slot=nil)
+ if JAPANIZED_TK
+ configinfo_core(@latinfont, slot)
+ else
+ configinfo(slot)
+ end
+ end
+
+ def kanji_configure(slot, value=None)
+ #if JAPANIZED_TK
+ if @kanjifont != ""
+ configure_core(@kanjifont, slot, value)
+ configure('size'=>configinfo('size')) # to reflect new configuration
+ else
+ #""
+ configure(slot, value)
+ end
+ self
+ end
+
+ def kanji_configinfo(slot=nil)
+ #if JAPANIZED_TK
+ if @kanjifont != ""
+ configinfo_core(@kanjifont, slot)
+ else
+ #[]
+ configinfo(slot)
+ end
+ end
+
+ def replace(ltn, knj)
+ latin_replace(ltn)
+ kanji_replace(knj)
+ self
+ end
+
+ def latin_replace(ltn)
+ latin_replace_core(ltn)
+ reset_pointadjust
+ self
+ end
+
+ def kanji_replace(knj)
+ kanji_replace_core(knj)
+ reset_pointadjust
+ self
+ end
+
+ def measure(text)
+ measure_core(nil, text)
+ end
+
+ def measure_displayof(window, text)
+ window = '.' unless window
+ measure_core(window, text)
+ end
+
+ def metrics(option=nil)
+ metrics_core(@compoundfont, nil, option)
+ end
+
+ def metrics_displayof(window, option=nil)
+ window = '.' unless window
+ metrics_core(@compoundfont, window, option)
+ end
+
+ def latin_metrics(option=nil)
+ metrics_core(@latinfont, nil, option)
+ end
+
+ def latin_metrics_displayof(window, option=nil)
+ window = '.' unless window
+ metrics_core(@latinfont, window, option)
+ end
+
+ def kanji_metrics(option=nil)
+ if JAPANIZED_TK
+ metrics_core(@kanjifont, nil, option)
+ else
+ metrics_core_tk4x(nil, nil, option)
+ end
+ end
+
+ def kanji_metrics_displayof(window, option=nil)
+ if JAPANIZED_TK
+ window = '.' unless window
+ metrics_core(@kanjifont, window, option)
+ else
+ metrics_core_tk4x(nil, window, option)
+ end
+ end
+
+ def reset_pointadjust
+ begin
+ if /^8\.*/ === Tk::TK_VERSION && JAPANIZED_TK
+ configure('pointadjust' => latin_actual.assoc('size')[1].to_f /
+ kanji_actual.assoc('size')[1].to_f )
+ end
+ rescue
+ end
+ self
+ end
+
+ ###################################
+ # public alias
+ ###################################
+ alias ascii_font latin_font
+ alias asciifont latinfont
+ alias create_asciifont create_latinfont
+ alias ascii_actual latin_actual
+ alias ascii_actual_displayof latin_actual_displayof
+ alias ascii_configure latin_configure
+ alias ascii_configinfo latin_configinfo
+ alias ascii_replace latin_replace
+ alias ascii_metrics latin_metrics
+
+ ###################################
+ def dup
+ src = self
+ obj = super()
+ obj.instance_eval{ initialize(src) }
+ obj
+ end
+ def clone
+ src = self
+ obj = super()
+ obj.instance_eval{ initialize(src) }
+ obj
+ end
+end
diff --git a/ext/tk/lib/tk/frame.rb b/ext/tk/lib/tk/frame.rb
new file mode 100644
index 0000000000..6598ceb55c
--- /dev/null
+++ b/ext/tk/lib/tk/frame.rb
@@ -0,0 +1,123 @@
+#
+# tk/frame.rb : treat frame widget
+#
+require 'tk'
+
+class TkFrame<TkWindow
+ TkCommandNames = ['frame'.freeze].freeze
+ WidgetClassName = 'Frame'.freeze
+ WidgetClassNames[WidgetClassName] = self
+
+################# old version
+# def initialize(parent=nil, keys=nil)
+# if keys.kind_of? Hash
+# keys = keys.dup
+# @classname = keys.delete('classname') if keys.key?('classname')
+# @colormap = keys.delete('colormap') if keys.key?('colormap')
+# @container = keys.delete('container') if keys.key?('container')
+# @visual = keys.delete('visual') if keys.key?('visual')
+# end
+# super(parent, keys)
+# end
+#
+# def create_self
+# s = []
+# s << "-class" << @classname if @classname
+# s << "-colormap" << @colormap if @colormap
+# s << "-container" << @container if @container
+# s << "-visual" << @visual if @visual
+# tk_call 'frame', @path, *s
+# end
+#################
+
+ def initialize(parent=nil, keys=nil)
+ my_class_name = nil
+ if self.class < WidgetClassNames[WidgetClassName]
+ my_class_name = self.class.name
+ my_class_name = nil if my_class_name == ''
+ end
+ if parent.kind_of? Hash
+ keys = _symbolkey2str(parent)
+ else
+ if keys
+ keys = _symbolkey2str(keys)
+ keys['parent'] = parent
+ else
+ keys = {'parent'=>parent}
+ end
+ end
+ if keys.key?('classname')
+ keys['class'] = keys.delete('classname')
+ end
+ @classname = keys['class']
+ @colormap = keys['colormap']
+ @container = keys['container']
+ @visual = keys['visual']
+ if !@classname && my_class_name
+ keys['class'] = @classname = my_class_name
+ end
+ if @classname.kind_of? TkBindTag
+ @db_class = @classname
+ @classname = @classname.id
+ elsif @classname
+ @db_class = TkDatabaseClass.new(@classname)
+ else
+ @db_class = self.class
+ @classname = @db_class::WidgetClassName
+ end
+ super(keys)
+ end
+
+ def create_self(keys)
+ if keys and keys != None
+ tk_call_without_enc('frame', @path, *hash_kv(keys))
+ else
+ tk_call_without_enc( 'frame', @path)
+ end
+ end
+ private :create_self
+
+ def database_classname
+ @classname
+ end
+
+ def self.database_class
+ if self == WidgetClassNames[WidgetClassName] || self.name == ''
+ self
+ else
+ TkDatabaseClass.new(self.name)
+ end
+ end
+ def self.database_classname
+ self.database_class.name
+ end
+
+ def self.bind(*args)
+ if self == WidgetClassNames[WidgetClassName] || self.name == ''
+ super(*args)
+ else
+ TkDatabaseClass.new(self.name).bind(*args)
+ end
+ end
+ def self.bind_append(*args)
+ if self == WidgetClassNames[WidgetClassName] || self.name == ''
+ super(*args)
+ else
+ TkDatabaseClass.new(self.name).bind_append(*args)
+ end
+ end
+ def self.bind_remove(*args)
+ if self == WidgetClassNames[WidgetClassName] || self.name == ''
+ super(*args)
+ else
+ TkDatabaseClass.new(self.name).bind_remove(*args)
+ end
+ end
+ def self.bindinfo(*args)
+ if self == WidgetClassNames[WidgetClassName] || self.name == ''
+ super(*args)
+ else
+ TkDatabaseClass.new(self.name).bindinfo(*args)
+ end
+ end
+end
diff --git a/ext/tk/lib/tk/grid.rb b/ext/tk/lib/tk/grid.rb
new file mode 100644
index 0000000000..1516aef4bf
--- /dev/null
+++ b/ext/tk/lib/tk/grid.rb
@@ -0,0 +1,182 @@
+#
+# tk/grid.rb : control grid geometry manager
+#
+require 'tk'
+
+module TkGrid
+ include Tk
+ extend Tk
+
+ TkCommandNames = ['grid'.freeze].freeze
+
+ def anchor(master, anchor=None)
+ # master = master.epath if master.kind_of?(TkObject)
+ master = _epath(master)
+ tk_call_without_enc('grid', 'anchor', master, anchor)
+ end
+
+ def bbox(master, *args)
+ # master = master.epath if master.kind_of?(TkObject)
+ master = _epath(master)
+ args.unshift(master)
+ list(tk_call_without_enc('grid', 'bbox', *args))
+ end
+
+ def configure(win, *args)
+ if args[-1].kind_of?(Hash)
+ opts = args.pop
+ else
+ opts = {}
+ end
+ params = []
+ params.push(_epath(win))
+ args.each{|win|
+ case win
+ when '-', 'x', '^' # RELATIVE PLACEMENT
+ params.push(win)
+ else
+ params.push(_epath(win))
+ end
+ }
+ opts.each{|k, v|
+ params.push("-#{k}")
+ params.push((v.kind_of?(TkObject))? v.epath: v)
+ }
+ tk_call_without_enc("grid", 'configure', *params)
+ end
+
+ def columnconfigure(master, index, args)
+ # master = master.epath if master.kind_of?(TkObject)
+ master = _epath(master)
+ tk_call_without_enc("grid", 'columnconfigure',
+ master, index, *hash_kv(args))
+ end
+
+ def rowconfigure(master, index, args)
+ # master = master.epath if master.kind_of?(TkObject)
+ master = _epath(master)
+ tk_call_without_enc("grid", 'rowconfigure', master, index, *hash_kv(args))
+ end
+
+ def columnconfiginfo(master, index, slot=nil)
+ # master = master.epath if master.kind_of?(TkObject)
+ master = _epath(master)
+ if slot
+ num_or_str(tk_call_without_enc('grid', 'columnconfigure',
+ master, index, "-#{slot}"))
+ else
+ ilist = list(tk_call_without_enc('grid','columnconfigure',master,index))
+ info = {}
+ while key = ilist.shift
+ info[key[1..-1]] = ilist.shift
+ end
+ info
+ end
+ end
+
+ def rowconfiginfo(master, index, slot=nil)
+ # master = master.epath if master.kind_of?(TkObject)
+ master = _epath(master)
+ if slot
+ num_or_str(tk_call_without_enc('grid', 'rowconfigure',
+ master, index, "-#{slot}"))
+ else
+ ilist = list(tk_call_without_enc('grid', 'rowconfigure', master, index))
+ info = {}
+ while key = ilist.shift
+ info[key[1..-1]] = ilist.shift
+ end
+ info
+ end
+ end
+
+ def add(widget, *args)
+ configure(widget, *args)
+ end
+
+ def forget(*args)
+ return '' if args.size == 0
+ wins = args.collect{|win|
+ # (win.kind_of?(TkObject))? win.epath: win
+ _epath(win)
+ }
+ tk_call_without_enc('grid', 'forget', *wins)
+ end
+
+ def info(slave)
+ # slave = slave.epath if slave.kind_of?(TkObject)
+ slave = _epath(slave)
+ ilist = list(tk_call_without_enc('grid', 'info', slave))
+ info = {}
+ while key = ilist.shift
+ info[key[1..-1]] = ilist.shift
+ end
+ return info
+ end
+
+ def location(master, x, y)
+ # master = master.epath if master.kind_of?(TkObject)
+ master = _epath(master)
+ list(tk_call_without_enc('grid', 'location', master, x, y))
+ end
+
+ def propagate(master, bool=None)
+ # master = master.epath if master.kind_of?(TkObject)
+ master = _epath(master)
+ if bool == None
+ bool(tk_call_without_enc('grid', 'propagate', master))
+ else
+ tk_call_without_enc('grid', 'propagate', master, bool)
+ end
+ end
+
+ def remove(*args)
+ return '' if args.size == 0
+ wins = args.collect{|win|
+ # (win.kind_of?(TkObject))? win.epath: win
+ _epath(win)
+ }
+ tk_call_without_enc('grid', 'remove', *wins)
+ end
+
+ def size(master)
+ # master = master.epath if master.kind_of?(TkObject)
+ master = _epath(master)
+ list(tk_call_without_enc('grid', 'size', master))
+ end
+
+ def slaves(master, args)
+ # master = master.epath if master.kind_of?(TkObject)
+ master = _epath(master)
+ list(tk_call_without_enc('grid', 'slaves', master, *hash_kv(args)))
+ end
+
+ module_function :bbox, :forget, :propagate, :info
+ module_function :remove, :size, :slaves, :location
+ module_function :configure, :columnconfigure, :rowconfigure
+ module_function :columnconfiginfo, :rowconfiginfo
+end
+=begin
+def TkGrid(win, *args)
+ if args[-1].kind_of?(Hash)
+ opts = args.pop
+ else
+ opts = {}
+ end
+ params = []
+ params.push((win.kind_of?(TkObject))? win.epath: win)
+ args.each{|win|
+ case win
+ when '-', 'x', '^' # RELATIVE PLACEMENT
+ params.push(win)
+ else
+ params.push((win.kind_of?(TkObject))? win.epath: win)
+ end
+ }
+ opts.each{|k, v|
+ params.push("-#{k}")
+ params.push((v.kind_of?(TkObject))? v.epath: v)
+ }
+ tk_call_without_enc("grid", *params)
+end
+=end
diff --git a/ext/tk/lib/tk/image.rb b/ext/tk/lib/tk/image.rb
new file mode 100644
index 0000000000..70dd096434
--- /dev/null
+++ b/ext/tk/lib/tk/image.rb
@@ -0,0 +1,185 @@
+#
+# tk/image.rb : treat Tk image objects
+#
+
+require 'tk'
+
+class TkImage<TkObject
+ include Tk
+
+ TkCommandNames = ['image'.freeze].freeze
+
+ Tk_IMGTBL = TkCore::INTERP.create_table
+ Tk_Image_ID = ['i'.freeze, '00000'.taint].freeze
+
+ TkCore::INTERP.init_ip_env{ Tk_IMGTBL.clear }
+
+ def initialize(keys=nil)
+ @path = Tk_Image_ID.join('')
+ Tk_Image_ID[1].succ!
+ tk_call_without_enc('image', 'create', @type, @path, *hash_kv(keys, true))
+ Tk_IMGTBL[@path] = self
+ end
+
+ def delete
+ Tk_IMGTBL.delete(@id) if @id
+ tk_call_without_enc('image', 'delete', @path)
+ self
+ end
+ def height
+ number(tk_call_without_enc('image', 'height', @path))
+ end
+ def inuse
+ bool(tk_call_without_enc('image', 'inuse', @path))
+ end
+ def itemtype
+ tk_call_without_enc('image', 'type', @path)
+ end
+ def width
+ number(tk_call_without_enc('image', 'width', @path))
+ end
+
+ def TkImage.names
+ Tk.tk_call_without_enc('image', 'names').split.collect!{|id|
+ (Tk_IMGTBL[id])? Tk_IMGTBL[id] : id
+ }
+ end
+
+ def TkImage.types
+ Tk.tk_call_without_enc('image', 'types').split
+ end
+end
+
+class TkBitmapImage<TkImage
+ def initialize(*args)
+ @type = 'bitmap'
+ super
+ end
+end
+
+class TkPhotoImage<TkImage
+ NullArgOptionKeys = [ "shrink", "grayscale" ]
+
+ def _photo_hash_kv(keys)
+ keys = _symbolkey2str(keys)
+ NullArgOptionKeys.collect{|opt|
+ if keys[opt]
+ keys[opt] = None
+ else
+ keys.delete(opt)
+ end
+ }
+ hash_kv(keys).flatten
+ end
+ private :_photo_hash_kv
+
+ def initialize(*args)
+ @type = 'photo'
+ super
+ end
+
+ def blank
+ tk_send_without_enc('blank')
+ self
+ end
+
+ def cget(option)
+ case option.to_s
+ when 'data', 'file'
+ tk_send 'cget', option
+ else
+ tk_tcl2ruby(tk_send('cget', option))
+ end
+ end
+
+ def copy(src, *opts)
+ if opts.size == 0
+ tk_send('copy', src)
+ elsif opts.size == 1 && opts[0].kind_of?(Hash)
+ tk_send('copy', src, *_photo_hash_kv(opts[0]))
+ else
+ # for backward compatibility
+ args = opts.collect{|term|
+ if term.kind_of?(String) && term.include?(?\s)
+ term.split
+ else
+ term
+ end
+ }.flatten
+ tk_send('copy', source, *args)
+ end
+ self
+ end
+
+ def data(keys={})
+ #tk_send('data', *_photo_hash_kv(keys))
+ tk_split_list(tk_send('data', *_photo_hash_kv(keys)))
+ end
+
+ def get(x, y)
+ tk_send('get', x, y).split.collect{|n| n.to_i}
+ end
+
+ def put(data, *opts)
+ if opts == []
+ tk_send('put', data)
+ elsif opts.size == 1 && opts[0].kind_of?(Hash)
+ tk_send('put', data, *_photo_hash_kv(opts[0]))
+ else
+ # for backward compatibility
+ tk_send('put', data, '-to', *opts)
+ end
+ self
+ end
+
+ def read(file, *opts)
+ if opts.size == 0
+ tk_send('read', file)
+ elsif opts.size == 1 && opts[0].kind_of?(Hash)
+ tk_send('read', file, *_photo_hash_kv(opts[0]))
+ else
+ # for backward compatibility
+ args = opts.collect{|term|
+ if term.kind_of?(String) && term.include?(?\s)
+ term.split
+ else
+ term
+ end
+ }.flatten
+ tk_send('read', file, *args)
+ end
+ self
+ end
+
+ def redither
+ tk_send 'redither'
+ self
+ end
+
+ def get_transparency(x, y)
+ bool(tk_send('transparency', 'get', x, y))
+ end
+ def set_transparency(x, y, st)
+ tk_send('transparency', 'set', x, y, st)
+ self
+ end
+
+ def write(file, *opts)
+ if opts.size == 0
+ tk_send('write', file)
+ elsif opts.size == 1 && opts[0].kind_of?(Hash)
+ tk_send('write', file, *_photo_hash_kv(opts[0]))
+ else
+ # for backward compatibility
+ args = opts.collect{|term|
+ if term.kind_of?(String) && term.include?(?\s)
+ term.split
+ else
+ term
+ end
+ }.flatten
+ tk_send('write', file, *args)
+ end
+ self
+ end
+end
diff --git a/ext/tk/lib/tk/itemfont.rb b/ext/tk/lib/tk/itemfont.rb
new file mode 100644
index 0000000000..6e92fc001c
--- /dev/null
+++ b/ext/tk/lib/tk/itemfont.rb
@@ -0,0 +1,185 @@
+#
+# tk/itemfont.rb : control font of widget items
+#
+require 'tk'
+
+module TkTreatItemFont
+ def __conf_cmd(idx)
+ raise NotImplementedError, "need to define `__conf_cmd'"
+ end
+ def __item_pathname(tagOrId)
+ raise NotImplementedError, "need to define `__item_pathname'"
+ end
+ private :__conf_cmd, :__item_pathname
+
+ def tagfont_configinfo(tagOrId, name = nil)
+ pathname = __item_pathname(tagOrId)
+ ret = TkFont.used_on(pathname)
+ if ret == nil
+=begin
+ if name
+ ret = name
+ else
+ ret = TkFont.init_widget_font(pathname, self.path,
+ __conf_cmd(0), __conf_cmd(1), tagOrId)
+ end
+=end
+ ret = TkFont.init_widget_font(pathname, self.path,
+ __conf_cmd(0), __conf_cmd(1), tagOrId)
+ end
+ ret
+ end
+ alias tagfontobj tagfont_configinfo
+
+ def tagfont_configure(tagOrId, slot)
+ pathname = __item_pathname(tagOrId)
+ slot = _symbolkey2str(slot)
+
+ if slot.key?('font')
+ fnt = slot.delete('font')
+ if fnt.kind_of? TkFont
+ return fnt.call_font_configure(pathname, self.path,
+ __conf_cmd(0), __conf_cmd(1),
+ tagOrId, slot)
+ else
+ if fnt
+ if (slot.key?('kanjifont') ||
+ slot.key?('latinfont') ||
+ slot.key?('asciifont'))
+ fnt = TkFont.new(fnt)
+
+ lfnt = slot.delete('latinfont')
+ lfnt = slot.delete('asciifont') if slot.key?('asciifont')
+ kfnt = slot.delete('kanjifont')
+
+ fnt.latin_replace(lfnt) if lfnt
+ fnt.kanji_replace(kfnt) if kfnt
+ end
+
+ slot['font'] = fnt
+ tk_call(self.path, __conf_cmd(0), __conf_cmd(1),
+ tagOrId, *hash_kv(slot))
+ end
+ return self
+ end
+ end
+
+ lfnt = slot.delete('latinfont')
+ lfnt = slot.delete('asciifont') if slot.key?('asciifont')
+ kfnt = slot.delete('kanjifont')
+
+ if lfnt && kfnt
+ return TkFont.new(lfnt, kfnt).call_font_configure(pathname, self.path,
+ __conf_cmd(0),
+ __conf_cmd(1),
+ tagOrId, slot)
+ end
+
+ latintagfont_configure(tagOrId, lfnt) if lfnt
+ kanjitagfont_configure(tagOrId, kfnt) if kfnt
+
+ tk_call(self.path, __conf_cmd(0), __conf_cmd(1),
+ tagOrId, *hash_kv(slot)) if slot != {}
+ self
+ end
+
+ def latintagfont_configure(tagOrId, ltn, keys=nil)
+ pathname = __item_pathname(tagOrId)
+ if (fobj = TkFont.used_on(pathname))
+ fobj = TkFont.new(fobj) # create a new TkFont object
+ elsif Tk::JAPANIZED_TK
+ fobj = tagfontobj(tagOrId) # create a new TkFont object
+ else
+ tk_call(self.path, __conf_cmd(0), __conf_cmd(1), tagOrId, '-font', ltn)
+ return self
+ end
+
+ if fobj.kind_of?(TkFont)
+ if ltn.kind_of? TkFont
+ conf = {}
+ ltn.latin_configinfo.each{|key,val| conf[key] = val}
+ if keys
+ fobj.latin_configure(conf.update(keys))
+ else
+ fobj.latin_configure(conf)
+ end
+ else
+ fobj.latin_replace(ltn)
+ end
+ end
+
+ return fobj.call_font_configure(pathname, self.path,
+ __conf_cmd(0), __conf_cmd(1), tagOrId, {})
+ end
+ alias asciitagfont_configure latintagfont_configure
+
+ def kanjitagfont_configure(tagOrId, knj, keys=nil)
+ pathname = __item_pathname(tagOrId)
+ if (fobj = TkFont.used_on(pathname))
+ fobj = TkFont.new(fobj) # create a new TkFont object
+ elsif Tk::JAPANIZED_TK
+ fobj = tagfontobj(tagOrId) # create a new TkFont object
+ else
+ tk_call(self.path, __conf_cmd(0), __conf_cmd(1), tagOrId, '-font', knj)
+ return self
+ end
+
+ if fobj.kind_of?(TkFont)
+ if knj.kind_of? TkFont
+ conf = {}
+ knj.kanji_configinfo.each{|key,val| conf[key] = val}
+ if keys
+ fobj.kanji_configure(conf.update(keys))
+ else
+ fobj.kanji_configure(conf)
+ end
+ else
+ fobj.kanji_replace(knj)
+ end
+ end
+
+ return fobj.call_font_configure(pathname, self.path,
+ __conf_cmd(0), __conf_cmd(1), tagOrId, {})
+ end
+
+ def tagfont_copy(tagOrId, window, wintag=nil)
+ pathname = __item_pathname(tagOrId)
+ if wintag
+ fnt = window.tagfontobj(wintag).dup
+ else
+ fnt = window.fontobj.dup
+ end
+ fnt.call_font_configure(pathname, self.path,
+ __conf_cmd(0), __conf_cmd(1), tagOrId, {})
+ return self
+ end
+
+ def latintagfont_copy(tagOrId, window, wintag=nil)
+ pathname = __item_pathname(tagOrId)
+ tagfontobj(tagOrId).dup.call_font_configure(pathname, self.path,
+ __conf_cmd(0), __conf_cmd(1),
+ tagOrId, {})
+ if wintag
+ tagfontobj(tagOrId).
+ latin_replace(window.tagfontobj(wintag).latin_font_id)
+ else
+ tagfontobj(tagOrId).latin_replace(window.fontobj.latin_font_id)
+ end
+ self
+ end
+ alias asciitagfont_copy latintagfont_copy
+
+ def kanjitagfont_copy(tagOrId, window, wintag=nil)
+ pathname = __item_pathname(tagOrId)
+ tagfontobj(tagOrId).dup.call_font_configure(pathname, self.path,
+ __conf_cmd(0), __conf_cmd(1),
+ tagOrId, {})
+ if wintag
+ tagfontobj(tagOrId).
+ kanji_replace(window.tagfontobj(wintag).kanji_font_id)
+ else
+ tagfontobj(tagOrId).kanji_replace(window.fontobj.kanji_font_id)
+ end
+ self
+ end
+end
diff --git a/ext/tk/lib/tk/kinput.rb b/ext/tk/lib/tk/kinput.rb
new file mode 100644
index 0000000000..418b3aec47
--- /dev/null
+++ b/ext/tk/lib/tk/kinput.rb
@@ -0,0 +1,71 @@
+#
+# tk/kinput.rb : control kinput
+#
+require 'tk'
+
+module TkKinput
+ include Tk
+ extend Tk
+
+ TkCommandNames = [
+ 'kinput_start'.freeze,
+ 'kinput_send_spot'.freeze,
+ 'kanjiInput'.freeze
+ ].freeze
+
+ def TkKinput.start(window, style=None)
+ tk_call('kinput_start', window, style)
+ end
+ def kinput_start(style=None)
+ TkKinput.start(self, style)
+ end
+
+ def TkKinput.send_spot(window)
+ tk_call('kinput_send_spot', window)
+ end
+ def kinput_send_spot
+ TkKinput.send_spot(self)
+ end
+
+ def TkKinput.input_start(window, keys=nil)
+ tk_call('kanjiInput', 'start', window, *hash_kv(keys))
+ end
+ def kanji_input_start(keys=nil)
+ TkKinput.input_start(self, keys)
+ end
+
+ def TkKinput.attribute_config(window, slot, value=None)
+ if slot.kind_of? Hash
+ tk_call('kanjiInput', 'attribute', window, *hash_kv(slot))
+ else
+ tk_call('kanjiInput', 'attribute', window, "-#{slot}", value)
+ end
+ end
+ def kinput_attribute_config(slot, value=None)
+ TkKinput.attribute_config(self, slot, value)
+ end
+
+ def TkKinput.attribute_info(window, slot=nil)
+ if slot
+ conf = tk_split_list(tk_call('kanjiInput', 'attribute',
+ window, "-#{slot}"))
+ conf[0] = conf[0][1..-1]
+ conf
+ else
+ tk_split_list(tk_call('kanjiInput', 'attribute', window)).collect{|conf|
+ conf[0] = conf[0][1..-1]
+ conf
+ }
+ end
+ end
+ def kinput_attribute_info(slot=nil)
+ TkKinput.attribute_info(self, slot)
+ end
+
+ def TkKinput.input_end(window)
+ tk_call('kanjiInput', 'end', window)
+ end
+ def kanji_input_end
+ TkKinput.input_end(self)
+ end
+end
diff --git a/ext/tk/lib/tk/label.rb b/ext/tk/lib/tk/label.rb
new file mode 100644
index 0000000000..fe2640958d
--- /dev/null
+++ b/ext/tk/lib/tk/label.rb
@@ -0,0 +1,22 @@
+#
+# tk/label.rb : treat label widget
+#
+require 'tk'
+
+class TkLabel<TkWindow
+ TkCommandNames = ['label'.freeze].freeze
+ WidgetClassName = 'Label'.freeze
+ WidgetClassNames[WidgetClassName] = self
+ def create_self(keys)
+ if keys and keys != None
+ tk_call_without_enc('label', @path, *hash_kv(keys, true))
+ else
+ tk_call_without_enc('label', @path)
+ end
+ end
+ private :create_self
+
+ def textvariable(v)
+ configure 'textvariable', tk_trace_variable(v)
+ end
+end
diff --git a/ext/tk/lib/tk/labelframe.rb b/ext/tk/lib/tk/labelframe.rb
new file mode 100644
index 0000000000..fa658848c8
--- /dev/null
+++ b/ext/tk/lib/tk/labelframe.rb
@@ -0,0 +1,20 @@
+#
+# tk/labelframe.rb : treat labelframe widget
+#
+require 'tk'
+require 'tk/frame'
+
+class TkLabelFrame<TkFrame
+ TkCommandNames = ['labelframe'.freeze].freeze
+ WidgetClassName = 'Labelframe'.freeze
+ WidgetClassNames[WidgetClassName] = self
+ def create_self(keys)
+ if keys and keys != None
+ tk_call_without_enc('labelframe', @path, *hash_kv(keys, true))
+ else
+ tk_call_without_enc('labelframe', @path)
+ end
+ end
+ private :create_self
+end
+TkLabelframe = TkLabelFrame
diff --git a/ext/tk/lib/tk/listbox.rb b/ext/tk/lib/tk/listbox.rb
new file mode 100644
index 0000000000..611226682a
--- /dev/null
+++ b/ext/tk/lib/tk/listbox.rb
@@ -0,0 +1,252 @@
+#
+# tk/listbox.rb : treat listbox widget
+#
+require 'tk'
+require 'tk/scrollable'
+require 'tk/txtwin_abst'
+
+module TkTreatListItemFont
+ include TkTreatItemFont
+
+ ItemCMD = ['itemconfigure'.freeze, TkComm::None].freeze
+ def __conf_cmd(idx)
+ ItemCMD[idx]
+ end
+
+ def __item_pathname(tagOrId)
+ self.path + ';' + tagOrId.to_s
+ end
+
+ private :__conf_cmd, :__item_pathname
+end
+
+
+class TkListbox<TkTextWin
+ include TkTreatListItemFont
+ include Scrollable
+
+ TkCommandNames = ['listbox'.freeze].freeze
+ WidgetClassName = 'Listbox'.freeze
+ WidgetClassNames[WidgetClassName] = self
+
+ def create_self(keys)
+ if keys and keys != None
+ tk_call_without_enc('listbox', @path, *hash_kv(keys, true))
+ else
+ tk_call_without_enc('listbox', @path)
+ end
+ end
+ private :create_self
+
+ def activate(y)
+ tk_send_without_enc('activate', y)
+ self
+ end
+ def curselection
+ list(tk_send_without_enc('curselection'))
+ end
+ def get(first, last=nil)
+ if last
+ tk_split_simplelist(_fromUTF8(tk_send_without_enc('get', first, last)))
+ else
+ _fromUTF8(tk_send_without_enc('get', first))
+ end
+ end
+ def nearest(y)
+ tk_send_without_enc('nearest', y).to_i
+ end
+ def size
+ tk_send_without_enc('size').to_i
+ end
+ def selection_anchor(index)
+ tk_send_without_enc('selection', 'anchor', index)
+ self
+ end
+ def selection_clear(first, last=None)
+ tk_send_without_enc('selection', 'clear', first, last)
+ self
+ end
+ def selection_includes(index)
+ bool(tk_send_without_enc('selection', 'includes', index))
+ end
+ def selection_set(first, last=None)
+ tk_send_without_enc('selection', 'set', first, last)
+ self
+ end
+
+ def index(index)
+ tk_send_without_enc('index', index).to_i
+ end
+
+ def itemcget(index, key)
+ case key.to_s
+ when 'text', 'label', 'show'
+ _fromUTF8(tk_send_without_enc('itemcget', index, "-#{key}"))
+ when 'font', 'kanjifont'
+ #fnt = tk_tcl2ruby(tk_send('itemcget', index, "-#{key}"))
+ fnt = tk_tcl2ruby(_fromUTF8(tk_send_without_enc('itemcget', index,
+ '-font')))
+ unless fnt.kind_of?(TkFont)
+ fnt = tagfontobj(index, fnt)
+ end
+ if key.to_s == 'kanjifont' && JAPANIZED_TK && TK_VERSION =~ /^4\.*/
+ # obsolete; just for compatibility
+ fnt.kanji_font
+ else
+ fnt
+ end
+ else
+ tk_tcl2ruby(_fromUTF8(tk_send_without_enc('itemcget', index, "-#{key}")))
+ end
+ end
+ def itemconfigure(index, key, val=None)
+ if key.kind_of? Hash
+ if (key['font'] || key[:font] ||
+ key['kanjifont'] || key[:kanjifont] ||
+ key['latinfont'] || key[:latinfont] ||
+ key['asciifont'] || key[:asciifont] )
+ tagfont_configure(index, _symbolkey2str(key))
+ else
+ tk_send_without_enc('itemconfigure', index, *hash_kv(key, true))
+ end
+
+ else
+ if (key == 'font' || key == :font ||
+ key == 'kanjifont' || key == :kanjifont ||
+ key == 'latinfont' || key == :latinfont ||
+ key == 'asciifont' || key == :asciifont )
+ if val == None
+ tagfontobj(index)
+ else
+ tagfont_configure(index, {key=>val})
+ end
+ else
+ tk_call('itemconfigure', index, "-#{key}", val)
+ end
+ end
+ self
+ end
+
+ def itemconfiginfo(index, key=nil)
+ if TkComm::GET_CONFIGINFO_AS_ARRAY
+ if key
+ case key.to_s
+ when 'text', 'label', 'show'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure',index,"-#{key}")))
+ when 'font', 'kanjifont'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure',index,"-#{key}")))
+ conf[4] = tagfont_configinfo(index, conf[4])
+ else
+ conf = tk_split_list(_fromUTF8(tk_send_without_enc('itemconfigure',index,"-#{key}")))
+ end
+ conf[0] = conf[0][1..-1]
+ conf
+ else
+ ret = tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure', index))).collect{|conflist|
+ conf = tk_split_simplelist(conflist)
+ conf[0] = conf[0][1..-1]
+ case conf[0]
+ when 'text', 'label', 'show'
+ else
+ if conf[3]
+ if conf[3].index('{')
+ conf[3] = tk_split_list(conf[3])
+ else
+ conf[3] = tk_tcl2ruby(conf[3])
+ end
+ end
+ if conf[4]
+ if conf[4].index('{')
+ conf[4] = tk_split_list(conf[4])
+ else
+ conf[4] = tk_tcl2ruby(conf[4])
+ end
+ end
+ end
+ conf[1] = conf[1][1..-1] if conf.size == 2 # alias info
+ conf
+ }
+ fontconf = ret.assoc('font')
+ if fontconf
+ ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
+ fontconf[4] = tagfont_configinfo(index, fontconf[4])
+ ret.push(fontconf)
+ else
+ ret
+ end
+ end
+ else # ! TkComm::GET_CONFIGINFO_AS_ARRAY
+ if key
+ case key.to_s
+ when 'text', 'label', 'show'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure',index,"-#{key}")))
+ when 'font', 'kanjifont'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure',index,"-#{key}")))
+ conf[4] = tagfont_configinfo(index, conf[4])
+ else
+ conf = tk_split_list(_fromUTF8(tk_send_without_enc('itemconfigure',index,"-#{key}")))
+ end
+ key = conf.shift[1..-1]
+ { key => conf }
+ else
+ ret = {}
+ tk_split_simplelist(_fromUTF8(tk_send_without_enc('itemconfigure', index))).each{|conflist|
+ conf = tk_split_simplelist(conflist)
+ key = conf.shift[1..-1]
+ case key
+ when 'text', 'label', 'show'
+ else
+ if conf[2]
+ if conf[2].index('{')
+ conf[2] = tk_split_list(conf[2])
+ else
+ conf[2] = tk_tcl2ruby(conf[2])
+ end
+ end
+ if conf[3]
+ if conf[3].index('{')
+ conf[3] = tk_split_list(conf[3])
+ else
+ conf[3] = tk_tcl2ruby(conf[3])
+ end
+ end
+ end
+ if conf.size == 1
+ ret[key] = conf[0][1..-1] # alias info
+ else
+ ret[key] = conf
+ end
+ }
+ fontconf = ret['font']
+ if fontconf
+ ret.delete('font')
+ ret.delete('kanjifont')
+ fontconf[3] = tagfont_configinfo(index, fontconf[3])
+ ret['font'] = fontconf
+ end
+ ret
+ end
+ end
+ end
+
+ def current_itemconfiginfo(index, key=nil)
+ if TkComm::GET_CONFIGINFO_AS_ARRAY
+ if key
+ conf = itemconfiginfo(index, key)
+ {conf[0] => conf[4]}
+ else
+ ret = {}
+ itemconfiginfo(index).each{|conf|
+ ret[conf[0]] = conf[4] if conf.size > 2
+ }
+ ret
+ end
+ else # ! TkComm::GET_CONFIGINFO_AS_ARRAY
+ ret = {}
+ itemconfiginfo(index, key).each{|k, conf|
+ ret[k] = conf[-1] if conf.kind_of?(Array)
+ }
+ ret
+ end
+ end
+end
diff --git a/ext/tk/lib/tk/macpkg.rb b/ext/tk/lib/tk/macpkg.rb
new file mode 100644
index 0000000000..d67a19745b
--- /dev/null
+++ b/ext/tk/lib/tk/macpkg.rb
@@ -0,0 +1,68 @@
+#
+# tk/macpkg.rb : methods for Tcl/Tk packages for Macintosh
+# 2000/11/22 by Hidetoshi Nagai <nagai@ai.kyutech.ac.jp>
+#
+# ATTENTION !!
+# This is NOT TESTED. Because I have no test-environment.
+#
+#
+require 'tk'
+
+module Tk
+ def Tk.load_tclscript_rsrc(resource_name, file=None)
+ # Mac only
+ tk_call('source', '-rsrc', resource_name, file)
+ end
+
+ def Tk.load_tclscript_rsrcid(resource_id, file=None)
+ # Mac only
+ tk_call('source', '-rsrcid', resource_id, file)
+ end
+end
+
+module TkMacResource
+ extend Tk
+ extend TkMacResource
+
+ TkCommandNames = ['resource'.freeze].freeze
+
+ tk_call_without_enc('package', 'require', 'resource')
+
+ def close(rsrcRef)
+ tk_call('resource', 'close', rsrcRef)
+ end
+
+ def delete(rsrcType, opts=nil)
+ tk_call('resource', 'delete', *(hash_kv(opts) << rsrcType))
+ end
+
+ def files(rsrcRef=nil)
+ if rsrcRef
+ tk_call('resource', 'files', rsrcRef)
+ else
+ tk_split_simplelist(tk_call('resource', 'files'))
+ end
+ end
+
+ def list(rsrcType, rsrcRef=nil)
+ tk_split_simplelist(tk_call('resource', 'list', rsrcType, rsrcRef))
+ end
+
+ def open(fname, access=nil)
+ tk_call('resource', 'open', fname, access)
+ end
+
+ def read(rsrcType, rsrcID, rsrcRef=nil)
+ tk_call('resource', 'read', rsrcType, rsrcID, rsrcRef)
+ end
+
+ def types(rsrcRef=nil)
+ tk_split_simplelist(tk_call('resource', 'types', rsrcRef))
+ end
+
+ def write(rsrcType, data, opts=nil)
+ tk_call('resource', 'write', *(hash_kv(opts) << rsrcType << data))
+ end
+
+ module_function :close, :delete, :files, :list, :open, :read, :types, :write
+end
diff --git a/ext/tk/lib/tk/menu.rb b/ext/tk/lib/tk/menu.rb
new file mode 100644
index 0000000000..9c34741b1b
--- /dev/null
+++ b/ext/tk/lib/tk/menu.rb
@@ -0,0 +1,460 @@
+#
+# tk/menu.rb : treat menu and menubutton
+#
+require 'tk'
+
+module TkTreatMenuEntryFont
+ include TkTreatItemFont
+
+ ItemCMD = ['entryconfigure'.freeze, TkComm::None].freeze
+ def __conf_cmd(idx)
+ ItemCMD[idx]
+ end
+
+ def __item_pathname(tagOrId)
+ self.path + ';' + tagOrId.to_s
+ end
+
+ private :__conf_cmd, :__item_pathname
+end
+
+class TkMenu<TkWindow
+ include TkTreatMenuEntryFont
+
+ TkCommandNames = ['menu'.freeze].freeze
+ WidgetClassName = 'Menu'.freeze
+ WidgetClassNames[WidgetClassName] = self
+
+ def create_self(keys)
+ if keys and keys != None
+ tk_call_without_enc('menu', @path, *hash_kv(keys, true))
+ else
+ tk_call_without_enc('menu', @path)
+ end
+ end
+ private :create_self
+
+ def activate(index)
+ tk_send_without_enc('activate', _get_eval_enc_str(index))
+ self
+ end
+ def add(type, keys=nil)
+ tk_send_without_enc('add', type, *hash_kv(keys, true))
+ self
+ end
+ def add_cascade(keys=nil)
+ add('cascade', keys)
+ end
+ def add_checkbutton(keys=nil)
+ add('checkbutton', keys)
+ end
+ def add_command(keys=nil)
+ add('command', keys)
+ end
+ def add_radiobutton(keys=nil)
+ add('radiobutton', keys)
+ end
+ def add_separator(keys=nil)
+ add('separator', keys)
+ end
+ def index(index)
+ ret = tk_send_without_enc('index', _get_eval_enc_str(index))
+ (ret == 'none')? nil: number(ret)
+ end
+ def invoke(index)
+ _fromUTF8(tk_send_without_enc('invoke', _get_eval_enc_str(index)))
+ end
+ def insert(index, type, keys=nil)
+ tk_send_without_enc('insert', _get_eval_enc_str(index),
+ type, *hash_kv(keys, true))
+ self
+ end
+ def delete(first, last=nil)
+ if last
+ tk_send_without_enc('delete', _get_eval_enc_str(first),
+ _get_eval_enc_str(last))
+ else
+ tk_send_without_enc('delete', _get_eval_enc_str(first))
+ end
+ self
+ end
+ def popup(x, y, index=nil)
+ if index
+ tk_call_without_enc('tk_popup', path, x, y,
+ _get_eval_enc_str(index))
+ else
+ tk_call_without_enc('tk_popup', path, x, y)
+ end
+ self
+ end
+ def post(x, y)
+ _fromUTF8(tk_send_without_enc('post', x, y))
+ end
+ def postcascade(index)
+ tk_send_without_enc('postcascade', _get_eval_enc_str(index))
+ self
+ end
+ def postcommand(cmd=Proc.new)
+ configure_cmd 'postcommand', cmd
+ self
+ end
+ def set_focus
+ tk_call_without_enc('tk_menuSetFocus', path)
+ self
+ end
+ def tearoffcommand(cmd=Proc.new)
+ configure_cmd 'tearoffcommand', cmd
+ self
+ end
+ def menutype(index)
+ tk_send_without_enc('type', _get_eval_enc_str(index))
+ end
+ def unpost
+ tk_send_without_enc('unpost')
+ self
+ end
+ def yposition(index)
+ number(tk_send_without_enc('yposition', _get_eval_enc_str(index)))
+ end
+ def entrycget(index, key)
+ case key.to_s
+ when 'text', 'label', 'show'
+ _fromUTF8(tk_send_without_enc('entrycget',
+ _get_eval_enc_str(index), "-#{key}"))
+ when 'font', 'kanjifont'
+ #fnt = tk_tcl2ruby(tk_send('entrycget', index, "-#{key}"))
+ fnt = tk_tcl2ruby(_fromUTF8(tk_send_without_enc('entrycget', _get_eval_enc_str(index), '-font')))
+ unless fnt.kind_of?(TkFont)
+ fnt = tagfontobj(index, fnt)
+ end
+ if key.to_s == 'kanjifont' && JAPANIZED_TK && TK_VERSION =~ /^4\.*/
+ # obsolete; just for compatibility
+ fnt.kanji_font
+ else
+ fnt
+ end
+ else
+ tk_tcl2ruby(_fromUTF8(tk_send_without_enc('entrycget', _get_eval_enc_str(index), "-#{key}")))
+ end
+ end
+ def entryconfigure(index, key, val=None)
+ if key.kind_of? Hash
+ if (key['font'] || key[:font] ||
+ key['kanjifont'] || key[:kanjifont] ||
+ key['latinfont'] || key[:latinfont] ||
+ key['asciifont'] || key[:asciifont])
+ tagfont_configure(index, _symbolkey2str(key))
+ else
+ tk_send_without_enc('entryconfigure', _get_eval_enc_str(index),
+ *hash_kv(key, true))
+ end
+
+ else
+ if (key == 'font' || key == :font ||
+ key == 'kanjifont' || key == :kanjifont ||
+ key == 'latinfont' || key == :latinfont ||
+ key == 'asciifont' || key == :asciifont )
+ if val == None
+ tagfontobj(index)
+ else
+ tagfont_configure(index, {key=>val})
+ end
+ else
+ tk_call('entryconfigure', index, "-#{key}", val)
+ end
+ end
+ self
+ end
+
+ def entryconfiginfo(index, key=nil)
+ if TkComm::GET_CONFIGINFO_AS_ARRAY
+ if key
+ case key.to_s
+ when 'text', 'label', 'show'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('entryconfigure',_get_eval_enc_str(index),"-#{key}")))
+ when 'font', 'kanjifont'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('entryconfigure',_get_eval_enc_str(index),"-#{key}")))
+ conf[4] = tagfont_configinfo(index, conf[4])
+ else
+ conf = tk_split_list(_fromUTF8(tk_send_without_enc('entryconfigure',_get_eval_enc_str(index),"-#{key}")))
+ end
+ conf[0] = conf[0][1..-1]
+ conf
+ else
+ ret = tk_split_simplelist(_fromUTF8(tk_send_without_enc('entryconfigure', _get_eval_enc_str(index)))).collect{|conflist|
+ conf = tk_split_simplelist(conflist)
+ conf[0] = conf[0][1..-1]
+ case conf[0]
+ when 'text', 'label', 'show'
+ else
+ if conf[3]
+ if conf[3].index('{')
+ conf[3] = tk_split_list(conf[3])
+ else
+ conf[3] = tk_tcl2ruby(conf[3])
+ end
+ end
+ if conf[4]
+ if conf[4].index('{')
+ conf[4] = tk_split_list(conf[4])
+ else
+ conf[4] = tk_tcl2ruby(conf[4])
+ end
+ end
+ end
+ conf[1] = conf[1][1..-1] if conf.size == 2 # alias info
+ conf
+ }
+ if fontconf
+ ret.delete_if{|item| item[0] == 'font' || item[0] == 'kanjifont'}
+ fontconf[4] = tagfont_configinfo(index, fontconf[4])
+ ret.push(fontconf)
+ else
+ ret
+ end
+ end
+ else # ! TkComm::GET_CONFIGINFO_AS_ARRAY
+ if key
+ case key.to_s
+ when 'text', 'label', 'show'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('entryconfigure',_get_eval_enc_str(index),"-#{key}")))
+ when 'font', 'kanjifont'
+ conf = tk_split_simplelist(_fromUTF8(tk_send_without_enc('entryconfigure',_get_eval_enc_str(index),"-#{key}")))
+ conf[4] = tagfont_configinfo(index, conf[4])
+ else
+ conf = tk_split_list(_fromUTF8(tk_send_without_enc('entryconfigure',_get_eval_enc_str(index),"-#{key}")))
+ end
+ key = conf.shift[1..-1]
+ { key => conf }
+ else
+ ret = {}
+ tk_split_simplelist(_fromUTF8(tk_send_without_enc('entryconfigure', _get_eval_enc_str(index)))).each{|conflist|
+ conf = tk_split_simplelist(conflist)
+ key = conf.shift[1..-1]
+ case key
+ when 'text', 'label', 'show'
+ else
+ if conf[2]
+ if conf[2].index('{')
+ conf[2] = tk_split_list(conf[2])
+ else
+ conf[2] = tk_tcl2ruby(conf[2])
+ end
+ end
+ if conf[3]
+ if conf[3].index('{')
+ conf[3] = tk_split_list(conf[3])
+ else
+ conf[3] = tk_tcl2ruby(conf[3])
+ end
+ end
+ end
+ if conf.size == 1
+ ret[key] = conf[0][1..-1] # alias info
+ else
+ ret[key] = conf
+ end
+ }
+ fontconf = ret['font']
+ if fontconf
+ ret.delete('font')
+ ret.delete('kanjifont')
+ fontconf[3] = tagfont_configinfo(index, fontconf[3])
+ ret['font'] = fontconf
+ end
+ ret
+ end
+ end
+ end
+
+ def current_entryconfiginfo(index, key=nil)
+ if TkComm::GET_CONFIGINFO_AS_ARRAY
+ if key
+ conf = entryconfiginfo(index, key)
+ {conf[0] => conf[4]}
+ else
+ ret = {}
+ entryconfiginfo(index).each{|conf|
+ ret[conf[0]] = conf[4] if conf.size > 2
+ }
+ ret
+ end
+ else # ! TkComm::GET_CONFIGINFO_AS_ARRAY
+ ret = {}
+ entryconfiginfo(index, key).each{|k, conf|
+ ret[k] = conf[-1] if conf.kind_of?(Array)
+ }
+ ret
+ end
+ end
+end
+
+
+class TkMenuClone<TkMenu
+ def initialize(parent, type=None)
+ widgetname = nil
+ if parent.kind_of? Hash
+ keys = _symbolkey2str(parent)
+ parent = keys.delete('parent')
+ widgetname = keys.delete('widgetname')
+ type = keys.delete('type'); type = None unless type
+ end
+ unless parent.kind_of?(TkMenu)
+ fail ArgumentError, "parent must be TkMenu"
+ end
+ @parent = parent
+ install_win(@parent.path, widgetname)
+ tk_call_without_enc(@parent.path, 'clone', @path, type)
+ end
+end
+
+
+module TkSystemMenu
+ def initialize(parent, keys=nil)
+ if parent.kind_of? Hash
+ keys = _symbolkey2str(parent)
+ parent = keys.delete('parent')
+ end
+ unless parent.kind_of? TkMenu
+ fail ArgumentError, "parent must be a TkMenu object"
+ end
+ # @path = Kernel.format("%s.%s", parent.path, self.class::SYSMENU_NAME)
+ @path = parent_path + '.' + self.class::SYSMENU_NAME
+ #TkComm::Tk_WINDOWS[@path] = self
+ TkCore::INTERP.tk_windows[@path] = self
+ if self.method(:create_self).arity == 0
+ p 'create_self has no arg' if $DEBUG
+ create_self
+ configure(keys) if keys
+ else
+ p 'create_self has an arg' if $DEBUG
+ create_self(keys)
+ end
+ end
+end
+
+
+class TkSysMenu_Help<TkMenu
+ # for all platform
+ include TkSystemMenu
+ SYSMENU_NAME = 'help'
+end
+
+
+class TkSysMenu_System<TkMenu
+ # for Windows
+ include TkSystemMenu
+ SYSMENU_NAME = 'system'
+end
+
+
+class TkSysMenu_Apple<TkMenu
+ # for Machintosh
+ include TkSystemMenu
+ SYSMENU_NAME = 'apple'
+end
+
+
+class TkMenubutton<TkLabel
+ TkCommandNames = ['menubutton'.freeze].freeze
+ WidgetClassName = 'Menubutton'.freeze
+ WidgetClassNames[WidgetClassName] = self
+ def create_self(keys)
+ if keys and keys != None
+ tk_call_without_enc('menubutton', @path, *hash_kv(keys, true))
+ else
+ tk_call_without_enc('menubutton', @path)
+ end
+ end
+ private :create_self
+end
+
+
+class TkOptionMenubutton<TkMenubutton
+ TkCommandNames = ['tk_optionMenu'.freeze].freeze
+
+ class OptionMenu<TkMenu
+ def initialize(path) #==> return value of tk_optionMenu
+ @path = path
+ #TkComm::Tk_WINDOWS[@path] = self
+ TkCore::INTERP.tk_windows[@path] = self
+ end
+ end
+
+ def initialize(parent=nil, var=TkVariable.new, firstval=nil, *vals)
+ if parent.kind_of? Hash
+ keys = _symbolkey2str(parent)
+ parent = keys['parent']
+ var = keys['variable'] if keys['variable']
+ firstval, *vals = keys['values']
+ end
+ fail 'variable option must be TkVariable' unless var.kind_of? TkVariable
+ @variable = var
+ firstval = @variable.value unless firstval
+ @variable.value = firstval
+ install_win(if parent then parent.path end)
+ @menu = OptionMenu.new(tk_call('tk_optionMenu', @path, @variable.id,
+ firstval, *vals))
+ end
+
+ def value
+ @variable.value
+ end
+
+ def activate(index)
+ @menu.activate(index)
+ self
+ end
+ def add(value)
+ @menu.add('radiobutton', 'variable'=>@variable,
+ 'label'=>value, 'value'=>value)
+ self
+ end
+ def index(index)
+ @menu.index(index)
+ end
+ def invoke(index)
+ @menu.invoke(index)
+ end
+ def insert(index, value)
+ @menu.add(index, 'radiobutton', 'variable'=>@variable,
+ 'label'=>value, 'value'=>value)
+ self
+ end
+ def delete(index, last=None)
+ @menu.delete(index, last)
+ self
+ end
+ def yposition(index)
+ @menu.yposition(index)
+ end
+ def menu
+ @menu
+ end
+ def menucget(key)
+ @menu.cget(key)
+ end
+ def menuconfigure(key, val=None)
+ @menu.configure(key, val)
+ self
+ end
+ def menuconfiginfo(key=nil)
+ @menu.configinfo(key)
+ end
+ def current_menuconfiginfo(key=nil)
+ @menu.current_configinfo(key)
+ end
+ def entrycget(index, key)
+ @menu.entrycget(index, key)
+ end
+ def entryconfigure(index, key, val=None)
+ @menu.entryconfigure(index, key, val)
+ self
+ end
+ def entryconfiginfo(index, key=nil)
+ @menu.entryconfiginfo(index, key)
+ end
+ def current_entryconfiginfo(index, key=nil)
+ @menu.current_entryconfiginfo(index, key)
+ end
+end
diff --git a/ext/tk/lib/tk/menubar.rb b/ext/tk/lib/tk/menubar.rb
new file mode 100644
index 0000000000..2c2846e9b6
--- /dev/null
+++ b/ext/tk/lib/tk/menubar.rb
@@ -0,0 +1,144 @@
+#
+# tk/menubar.rb
+#
+# Copyright (C) 1998 maeda shugo. All rights reserved.
+# This file can be distributed under the terms of the Ruby.
+
+# Usage:
+#
+# menu_spec = [
+# [['File', 0],
+# ['Open', proc{puts('Open clicked')}, 0],
+# '---',
+# ['Quit', proc{exit}, 0]],
+# [['Edit', 0],
+# ['Cut', proc{puts('Cut clicked')}, 2],
+# ['Copy', proc{puts('Copy clicked')}, 0],
+# ['Paste', proc{puts('Paste clicked')}, 0]]
+# ]
+# menubar = TkMenubar.new(nil, menu_spec,
+# 'tearoff'=>false,
+# 'foreground'=>'grey40',
+# 'activeforeground'=>'red',
+# 'font'=>'-adobe-helvetica-bold-r-*--12-*-iso8859-1')
+# menubar.pack('side'=>'top', 'fill'=>'x')
+#
+#
+# OR
+#
+#
+# menubar = TkMenubar.new
+# menubar.add_menu([['File', 0],
+# ['Open', proc{puts('Open clicked')}, 0],
+# '---',
+# ['Quit', proc{exit}, 0]])
+# menubar.add_menu([['Edit', 0],
+# ['Cut', proc{puts('Cut clicked')}, 2],
+# ['Copy', proc{puts('Copy clicked')}, 0],
+# ['Paste', proc{puts('Paste clicked')}, 0]])
+# menubar.configure('tearoff', false)
+# menubar.configure('foreground', 'grey40')
+# menubar.configure('activeforeground', 'red')
+# menubar.configure('font', '-adobe-helvetica-bold-r-*--12-*-iso8859-1')
+# menubar.pack('side'=>'top', 'fill'=>'x')
+
+# The format of the menu_spec is:
+# [
+# [
+# [button text, underline, accelerator],
+# [menu label, command, underline, accelerator],
+# '---', # separator
+# ...
+# ],
+# ...
+# ]
+
+# underline and accelerator are optional parameters.
+# Hashes are OK instead of Arrays.
+
+# To use add_menu, configuration must be done by calling configure after
+# adding all menus by add_menu, not by the constructor arguments.
+
+require 'tk'
+require 'tk/frame'
+
+class TkMenubar<TkFrame
+
+ include TkComposite
+
+ def initialize(parent = nil, spec = nil, options = nil)
+ if parent.kind_of? Hash
+ options = _symbolkey2str(parent)
+ spec = options.delete('spec')
+ super(options)
+ else
+ super(parent, options)
+ end
+
+ @menus = []
+
+ if spec
+ for menu_info in spec
+ add_menu(menu_info)
+ end
+ end
+
+ if options
+ for key, value in options
+ configure(key, value)
+ end
+ end
+ end
+
+ def add_menu(menu_info)
+ btn_info = menu_info.shift
+ mbtn = TkMenubutton.new(@frame)
+
+ if btn_info.kind_of?(Hash)
+ for key, value in btn_info
+ mbtn.configure(key, value)
+ end
+ elsif btn_info.kind_of?(Array)
+ mbtn.configure('text', btn_info[0]) if btn_info[0]
+ mbtn.configure('underline', btn_info[1]) if btn_info[1]
+ mbtn.configure('accelerator', btn_info[2]) if btn_info[2]
+ else
+ mbtn.configure('text', btn_info)
+ end
+
+ menu = TkMenu.new(mbtn)
+
+ for item_info in menu_info
+ if item_info.kind_of?(Hash)
+ menu.add('command', item_info)
+ elsif item_info.kind_of?(Array)
+ options = {}
+ options['label'] = item_info[0] if item_info[0]
+ options['command'] = item_info[1] if item_info[1]
+ options['underline'] = item_info[2] if item_info[2]
+ options['accelerator'] = item_info[3] if item_info[3]
+ menu.add('command', options)
+ elsif /^-+$/ =~ item_info
+ menu.add('sep')
+ else
+ menu.add('command', 'label' => item_info)
+ end
+ end
+
+ mbtn.menu(menu)
+ @menus.push([mbtn, menu])
+ delegate('tearoff', menu)
+ delegate('foreground', mbtn, menu)
+ delegate('background', mbtn, menu)
+ delegate('disabledforeground', mbtn, menu)
+ delegate('activeforeground', mbtn, menu)
+ delegate('activebackground', mbtn, menu)
+ delegate('font', mbtn, menu)
+ delegate('kanjifont', mbtn, menu)
+ mbtn.pack('side' => 'left')
+ end
+
+ def [](index)
+ return @menus[index]
+ end
+end
diff --git a/ext/tk/lib/tk/message.rb b/ext/tk/lib/tk/message.rb
new file mode 100644
index 0000000000..b359800142
--- /dev/null
+++ b/ext/tk/lib/tk/message.rb
@@ -0,0 +1,19 @@
+#
+# tk/message.rb : treat message widget
+#
+require 'tk'
+require 'tk/label'
+
+class TkMessage<TkLabel
+ TkCommandNames = ['message'.freeze].freeze
+ WidgetClassName = 'Message'.freeze
+ WidgetClassNames[WidgetClassName] = self
+ def create_self(keys)
+ if keys and keys != None
+ tk_call_without_enc('message', @path, *hash_kv(keys, true))
+ else
+ tk_call_without_enc('message', @path)
+ end
+ end
+ private :create_self
+end
diff --git a/ext/tk/lib/tk/mngfocus.rb b/ext/tk/lib/tk/mngfocus.rb
new file mode 100644
index 0000000000..a0f18233be
--- /dev/null
+++ b/ext/tk/lib/tk/mngfocus.rb
@@ -0,0 +1,33 @@
+#
+# tk/mngfocus.rb : methods for Tcl/Tk standard library 'focus.tcl'
+# by Hidetoshi Nagai <nagai@ai.kyutech.ac.jp>
+#
+require 'tk'
+
+module TkManageFocus
+ extend Tk
+
+ TkCommandNames = [
+ 'tk_focusFollowMouse'.freeze,
+ 'tk_focusNext'.freeze,
+ 'tk_focusPrev'.freeze
+ ].freeze
+
+ def TkManageFocus.followsMouse
+ tk_call_without_enc('tk_focusFollowsMouse')
+ end
+
+ def TkManageFocus.next(window)
+ tk_tcl2ruby(tk_call('tk_focusNext', window))
+ end
+ def focusNext
+ TkManageFocus.next(self)
+ end
+
+ def TkManageFocus.prev(window)
+ tk_tcl2ruby(tk_call('tk_focusPrev', window))
+ end
+ def focusPrev
+ TkManageFocus.prev(self)
+ end
+end
diff --git a/ext/tk/lib/tk/msgcat.rb b/ext/tk/lib/tk/msgcat.rb
new file mode 100644
index 0000000000..6c46542faf
--- /dev/null
+++ b/ext/tk/lib/tk/msgcat.rb
@@ -0,0 +1,268 @@
+#
+# tk/msgcat.rb : methods for Tcl message catalog
+# by Hidetoshi Nagai <nagai@ai.kyutech.ac.jp>
+#
+require 'tk'
+
+#class TkMsgCatalog
+class TkMsgCatalog < TkObject
+ include TkCore
+ extend Tk
+ #extend TkMsgCatalog
+
+ TkCommandNames = [
+ '::msgcat::mc'.freeze,
+ '::msgcat::mcmax'.freeze,
+ '::msgcat::mclocale'.freeze,
+ '::msgcat::mcpreferences'.freeze,
+ '::msgcat::mcload'.freeze,
+ '::msgcat::mcset'.freeze,
+ '::msgcat::mcmset'.freeze,
+ '::msgcat::mcunknown'.freeze
+ ].freeze
+
+ tk_call_without_enc('package', 'require', 'Tcl', '8.2')
+
+ if self.const_defined? :FORCE_VERSION
+ tk_call_without_enc('package', 'require', 'msgcat', FORCE_VERSION)
+ else
+ tk_call_without_enc('package', 'require', 'msgcat')
+ end
+
+ MSGCAT_EXT = '.msg'
+
+ UNKNOWN_CBTBL = Hash.new{|hash,key| hash[key] = {}}.taint
+
+ TkCore::INTERP.add_tk_procs('::msgcat::mcunknown', 'args', <<-'EOL')
+ if {[set st [catch {eval {ruby_cmd TkMsgCatalog callback} [namespace current] $args} ret]] != 0} {
+ #return -code $st $ret
+ set idx [string first "\n\n" $ret]
+ if {$idx > 0} {
+ return -code $st \
+ -errorinfo [string range $ret [expr $idx + 2] \
+ [string length $ret]] \
+ [string range $ret 0 [expr $idx - 1]]
+ } else {
+ return -code $st $ret
+ }
+ } else {
+ return $ret
+ }
+ EOL
+
+ def self.callback(namespace, locale, src_str)
+ cmd_tbl = TkMsgCatalog::UNKNOWN_CBTBL[TkCore::INTERP.__getip]
+ cmd = cmd_tbl[namespace]
+ cmd = cmd_tbl['::'] unless cmd # use global scope as interp default
+ return src_str unless cmd # no cmd -> return src-str (default action)
+ begin
+ cmd.call(locale, src_str)
+ rescue Exception => e
+ begin
+ msg = _toUTF8(e.class.inspect) + ': ' +
+ _toUTF8(e.message) + "\n" +
+ "\n---< backtrace of Ruby side >-----\n" +
+ _toUTF8(e.backtrace.join("\n")) +
+ "\n---< backtrace of Tk side >-------"
+ msg.instance_variable_set(:@encoding, 'utf-8')
+ rescue Exception
+ msg = e.class.inspect + ': ' + e.message + "\n" +
+ "\n---< backtrace of Ruby side >-----\n" +
+ e.backtrace.join("\n") +
+ "\n---< backtrace of Tk side >-------"
+ end
+ fail(e, msg)
+ end
+ end
+
+ def initialize(namespace = nil)
+ if namespace.kind_of?(TkNamespace)
+ @namespace = namespace
+ elsif namespace == nil
+ @namespace = TkNamespace.new('::') # global namespace
+ else
+ @namespace = TkNamespace.new(namespace)
+ end
+ @path = @namespace.path
+
+ @msgcat_ext = '.msg'
+ end
+ attr_accessor :msgcat_ext
+
+ def method_missing(id, *args)
+ # locale(src, trans) ==> set_translation(locale, src, trans)
+ loc = id.id2name
+ case args.length
+ when 0 # set locale
+ self.locale=(loc)
+
+ when 1 # src only, or trans_list
+ if args[0].kind_of?(Array)
+ # trans_list
+ #list = args[0].collect{|src, trans|
+ # [ Tk::UTF8_String.new(src), Tk::UTF8_String.new(trans) ]
+ #}
+ self.set_translation_list(loc, args[0])
+ else
+ # src
+ #self.set_translation(loc, Tk::UTF8_String.new(args[0]))
+ self.set_translation(loc, args[0])
+ end
+
+ when 2 # src and trans, or, trans_list and enc
+ if args[0].kind_of?(Array)
+ else
+ #self.set_translation(loc, args[0], Tk::UTF8_String.new(args[1]))
+ self.set_translation(loc, *args)
+ end
+
+ when 3 # src and trans and enc
+ self.set_translation(loc, *args)
+
+ else
+ fail NameError, "undefined method `#{name}' for #{self.to_s}", error_at
+
+ end
+ end
+
+ # *args ::= form, arg, arg, ...
+ def self.translate(*args)
+ dst = args.collect{|src|
+ tk_call_without_enc('::msgcat::mc', _get_eval_string(src, true))
+ }
+ Tk.UTF8_String(sprintf(*dst))
+ end
+ class << self
+ alias mc translate
+ alias [] translate
+ end
+ def translate(*args)
+ dst = args.collect{|src|
+ @namespace.eval{tk_call_without_enc('::msgcat::mc',
+ _get_eval_string(src, true))}
+ }
+ Tk.UTF8_String(sprintf(*dst))
+ end
+ alias mc translate
+ alias [] translate
+
+ def self.maxlen(*src_strings)
+ tk_call('::msgcat::mcmax', *src_strings).to_i
+ end
+ def maxlen(*src_strings)
+ @namespace.eval{tk_call('::msgcat::mcmax', *src_strings).to_i}
+ end
+
+ def self.locale
+ tk_call('::msgcat::mclocale')
+ end
+ def locale
+ @namespace.eval{tk_call('::msgcat::mclocale')}
+ end
+
+ def self.locale=(locale)
+ tk_call('::msgcat::mclocale', locale)
+ end
+ def locale=(locale)
+ @namespace.eval{tk_call('::msgcat::mclocale', locale)}
+ end
+
+ def self.preferences
+ tk_split_simplelist(tk_call('::msgcat::mcpreferences'))
+ end
+ def preferences
+ tk_split_simplelist(@namespace.eval{tk_call('::msgcat::mcpreferences')})
+ end
+
+ def self.load_tk(dir)
+ number(tk_call('::msgcat::mcload', dir))
+ end
+
+ def self.load_rb(dir)
+ count = 0
+ preferences().each{|loc|
+ file = File.join(dir, loc + self::MSGCAT_EXT)
+ if File.readable?(file)
+ count += 1
+ eval(open(file){|f| f.read})
+ end
+ }
+ count
+ end
+
+ def load_tk(dir)
+ number(@namespace.eval{tk_call('::msgcat::mcload', dir)})
+ end
+
+ def load_rb(dir)
+ count = 0
+ preferences().each{|loc|
+ file = File.join(dir, loc + @msgcat_ext)
+ if File.readable?(file)
+ count += 1
+ @namespace.eval(open(file){|f| f.read})
+ end
+ }
+ count
+ end
+
+ def self.load(dir)
+ self.load_rb(dir)
+ end
+ alias load load_rb
+
+ def self.set_translation(locale, src_str, trans_str=None, enc='utf-8')
+ trans_str = Tk.UTF8_String(_toUTF8(trans_str, enc)) if trans_str != None
+ Tk.UTF8_String(tk_call_without_enc('::msgcat::mcset',
+ locale,
+ _get_eval_string(src_str, true),
+ trans_str))
+ end
+ def set_translation(locale, src_str, trans_str=None, enc='utf-8')
+ trans_str = Tk.UTF8_String(_toUTF8(trans_str, enc)) if trans_str != None
+ Tk.UTF8_String(@namespace.eval{
+ tk_call_without_enc('::msgcat::mcset',
+ locale,
+ _get_eval_string(src_str, true),
+ trans_str)
+ })
+ end
+
+ def self.set_translation_list(locale, trans_list, enc='utf-8')
+ # trans_list ::= [ [src, trans], [src, trans], ... ]
+ list = []
+ trans_list.each{|src, trans|
+ if trans && trans != None
+ list << _get_eval_string(src, true)
+ list << Tk.UTF8_Stirng(_toUTF8(trans, enc))
+ else
+ list << _get_eval_string(src, true) << ''
+ end
+ }
+ number(tk_call_without_enc('::msgcat::mcmset', locale, list))
+ end
+ def set_translation_list(locale, trans_list, enc='utf-8')
+ # trans_list ::= [ [src, trans], [src, trans], ... ]
+ list = []
+ trans_list.each{|src, trans|
+ if trans && trans != None
+ list << _get_eval_string(src, true)
+ list << Tk.UTF8_String(_toUTF8(trans, enc))
+ else
+ list << _get_eval_string(src, true) << ''
+ end
+ }
+ number(@namespace.eval{
+ tk_call_without_enc('::msgcat::mcmset', locale, list)
+ })
+ end
+
+ def self.def_unknown_proc(cmd=Proc.new)
+ TkMsgCatalog::UNKNOWN_CBTBL[TkCore::INTERP.__getip]['::'] = cmd
+ end
+ def def_unknown_proc(cmd=Proc.new)
+ TkMsgCatalog::UNKNOWN_CBTBL[TkCore::INTERP.__getip][@namespace.path] = cmd
+ end
+end
+
+TkMsgCat = TkMsgCatalog
diff --git a/ext/tk/lib/tk/namespace.rb b/ext/tk/lib/tk/namespace.rb
new file mode 100644
index 0000000000..72e9500a49
--- /dev/null
+++ b/ext/tk/lib/tk/namespace.rb
@@ -0,0 +1,293 @@
+#
+# tk/namespace.rb : methods to manipulate Tcl/Tk namespace
+# by Hidetoshi Nagai <nagai@ai.kyutech.ac.jp>
+#
+require 'tk'
+
+class TkNamespace < TkObject
+ extend Tk
+
+ TkCommandNames = [
+ 'namespace'.freeze,
+ ].freeze
+
+ Tk_Namespace_ID_TBL = TkCore::INTERP.create_table
+ Tk_Namespace_ID = ["ns".freeze, "00000".taint].freeze
+
+ class ScopeArgs < Array
+ include Tk
+
+ # alias __tk_call tk_call
+ # alias __tk_call_without_enc tk_call_without_enc
+ # alias __tk_call_with_enc tk_call_with_enc
+ def tk_call(*args)
+ #super('namespace', 'eval', @namespace, *args)
+ args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+ super('namespace', 'eval', @namespace,
+ TkCore::INTERP._merge_tklist(*args))
+ end
+ def tk_call_without_enc(*args)
+ #super('namespace', 'eval', @namespace, *args)
+ args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+ super('namespace', 'eval', @namespace,
+ TkCore::INTERP._merge_tklist(*args))
+ end
+ def tk_call_with_enc(*args)
+ #super('namespace', 'eval', @namespace, *args)
+ args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+ super('namespace', 'eval', @namespace,
+ TkCore::INTERP._merge_tklist(*args))
+ end
+
+ def initialize(namespace, *args)
+ @namespace = namespace
+ super(args.size)
+ self.replace(args)
+ end
+ end
+
+ class NsCode < TkObject
+ def initialize(scope)
+ @scope = scope + ' '
+ end
+ def path
+ @scope
+ end
+ def to_eval
+ @scope
+ end
+ def call(*args)
+ TkCore::INTERP._eval_without_enc(@scope + array2tk_list(args))
+ end
+ end
+
+ alias __tk_call tk_call
+ alias __tk_call_without_enc tk_call_without_enc
+ alias __tk_call_with_enc tk_call_with_enc
+ def tk_call(*args)
+ #super('namespace', 'eval', @fullname, *args)
+ args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+ super('namespace', 'eval', @fullname,
+ TkCore::INTERP._merge_tklist(*args))
+ end
+ def tk_call_without_enc(*args)
+ #super('namespace', 'eval', @fullname, *args)
+ args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+ super('namespace', 'eval', @fullname,
+ TkCore::INTERP._merge_tklist(*args))
+ end
+ def tk_call_with_enc(*args)
+ #super('namespace', 'eval', @fullname, *args)
+ args = args.collect{|arg| (s = _get_eval_string(arg))? s: ''}
+ super('namespace', 'eval', @fullname,
+ TkCore::INTERP._merge_tklist(*args))
+ end
+ alias ns_tk_call tk_call
+ alias ns_tk_call_without_enc tk_call_without_enc
+ alias ns_tk_call_with_enc tk_call_with_enc
+
+ def initialize(name = nil, parent = nil)
+ unless name
+ name = Tk_Namespace_ID.join('')
+ Tk_Namespace_ID[1].succ!
+ end
+ name = __tk_call('namespace', 'current') if name == ''
+ if parent
+ if parent =~ /^::/
+ if name =~ /^::/
+ @fullname = parent + name
+ else
+ @fullname = parent +'::'+ name
+ end
+ else
+ ancestor = __tk_call('namespace', 'current')
+ ancestor = '' if ancestor == '::'
+ if name =~ /^::/
+ @fullname = ancestor + '::' + parent + name
+ else
+ @fullname = ancestor + '::'+ parent +'::'+ name
+ end
+ end
+ else # parent == nil
+ ancestor = __tk_call('namespace', 'current')
+ ancestor = '' if ancestor == '::'
+ if name =~ /^::/
+ @fullname = name
+ else
+ @fullname = ancestor + '::' + name
+ end
+ end
+ @path = @fullname
+ @parent = __tk_call('namespace', 'qualifiers', @fullname)
+ @name = __tk_call('namespace', 'tail', @fullname)
+
+ # create namespace
+ __tk_call('namespace', 'eval', @fullname, '')
+
+ Tk_Namespace_ID_TBL[@fullname] = self
+ end
+
+ def self.children(*args)
+ # args ::= [<namespace>] [<pattern>]
+ # <pattern> must be glob-style pattern
+ tk_split_simplelist(tk_call('namespace', 'children', *args)).collect{|ns|
+ # ns is fullname
+ if Tk_Namesapce_ID.key?(ns)
+ Tk_Namesapce_ID[ns]
+ else
+ ns
+ end
+ }
+ end
+ def children(pattern=None)
+ TkNamespace.children(@fullname, pattern)
+ end
+
+ def self.code(script = Proc.new)
+ TkNamespace.new('').code(script)
+ end
+ def code(script = Proc.new)
+ if script.kind_of?(String)
+ cmd = proc{|*args| ScopeArgs.new(@fullname,*args).instance_eval(script)}
+ elsif script.kind_of?(Proc)
+ cmd = proc{|*args| ScopeArgs.new(@fullname,*args).instance_eval(&script)}
+ else
+ fail ArgumentError, "String or Proc is expected"
+ end
+ TkNamespace::NsCode.new(tk_call_without_enc('namespace', 'code',
+ _get_eval_string(cmd, false)))
+ end
+
+ def self.current
+ tk_call('namespace', 'current')
+ end
+ def current_namespace
+ # ns_tk_call('namespace', 'current')
+ @fullname
+ end
+ alias current current_namespace
+
+ def self.delete(*ns_list)
+ tk_call('namespace', 'delete', *ns_list)
+ end
+ def delete
+ TkNamespece.delete(@fullname)
+ end
+
+ def self.ensemble_create(*keys)
+ tk_call('namespace', 'ensemble', 'create', *hash_kv(keys))
+ end
+ def self.ensemble_configure(cmd, slot, value=None)
+ if slot.kind_of?(Hash)
+ tk_call('namespace', 'ensemble', 'configure', cmd, *hash_kv(slot))
+ else
+ tk_call('namespace', 'ensemble', 'configure', cmd, '-'+slot.to_s, value)
+ end
+ end
+ def self.ensemble_configinfo(cmd, slot = nil)
+ if slot
+ tk_call('namespace', 'ensemble', 'configure', cmd, '-' + slot.to_s)
+ else
+ inf = {}
+ Hash(*tk_split_simplelist(tk_call('namespace', 'ensemble', 'configure', cmd))).each{|k, v| inf[k[1..-1]] = v}
+ inf
+ end
+ end
+ def self.ensemble_exist?(cmd)
+ bool(tk_call('namespace', 'ensemble', 'exists', cmd))
+ end
+
+ def self.eval(namespace, cmd = Proc.new, *args)
+ #tk_call('namespace', 'eval', namespace, cmd, *args)
+ TkNamespace.new(namespece).eval(cmd, *args)
+ end
+ def eval(cmd = Proc.new, *args)
+ #TkNamespace.eval(@fullname, cmd, *args)
+ #ns_tk_call(cmd, *args)
+