diff options
1060 files changed, 10 insertions, 156757 deletions
diff --git a/.gitignore b/.gitignore index ab21f6c223..9757768786 100644 --- a/.gitignore +++ b/.gitignore @@ -167,9 +167,6 @@ y.tab.c /ext/socket/constdefs.h /ext/socket/constdefs.c -# /ext/tk/ -/ext/tk/config_list - # /gems /gems/*.gem @@ -1,3 +1,8 @@ +Tue Aug 9 15:41:24 2016 NARUSE, Yui <naruse@ruby-lang.org> + + * ext/tk: Tk is removed from stdlib. [Feature #8539] + https://github.com/ruby/tk is the new upstream. + Tue Aug 9 00:12:31 2016 Kazuhiro NISHIYAMA <zn@mbf.nifty.com> * doc/maintainers.rdoc: Remove moved file section. @@ -168,6 +168,10 @@ with all sufficient information, see the ChangeLog file or Redmine "thread.rb", which has precedence over "thread.so", and has been provided in $LOADED_FEATURES since 2.1. +* Tk + * Tk is removed from stdlib. [Feature #8539] + https://github.com/ruby/tk is the new upstream. + === C API updates * ruby_show_version() will no longer exits the process, if diff --git a/appveyor.yml b/appveyor.yml index e08314003d..0f05183a98 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -28,7 +28,7 @@ install: - copy zlib.h \usr\local\include build_script: - cd %APPVEYOR_BUILD_FOLDER% - - win32\configure.bat --without-ext=+,dbm,gdbm,readline,tk* --with-opt-dir=/usr/local + - win32\configure.bat --without-ext=+,dbm,gdbm,readline --with-opt-dir=/usr/local - nmake -l up - nmake -l - nmake install-nodoc diff --git a/doc/maintainers.rdoc b/doc/maintainers.rdoc index 2ae1a2e675..d22d09f7a4 100644 --- a/doc/maintainers.rdoc +++ b/doc/maintainers.rdoc @@ -244,8 +244,6 @@ Zachary Scott (zzak) _unmaintained_ [ext/syslog] Akinori MUSHA (knu) -[ext/tk] - Hidetoshi NAGAI (nagai) [ext/win32] NAKAMURA Usaku (usa) [ext/win32ole] @@ -40,8 +40,6 @@ #stringio #strscan #syslog -#tk -#tk/tkutil #win32 #win32ole #zlib diff --git a/ext/Setup.atheos b/ext/Setup.atheos index 5e39de8e15..90a7d01348 100644 --- a/ext/Setup.atheos +++ b/ext/Setup.atheos @@ -25,6 +25,5 @@ socket stringio strscan syslog -#tk #win32ole zlib diff --git a/ext/Setup.nacl b/ext/Setup.nacl index f205e367c6..eb8a1a70cd 100644 --- a/ext/Setup.nacl +++ b/ext/Setup.nacl @@ -41,6 +41,4 @@ # stringio # strscan # #syslog -# #tk -# #tk/tkutil # #zlib diff --git a/ext/Setup.nt b/ext/Setup.nt index 4812893eef..fb5989b87f 100644 --- a/ext/Setup.nt +++ b/ext/Setup.nt @@ -26,6 +26,5 @@ socket stringio strscan #syslog -#tk win32ole #zlib diff --git a/ext/tk/ChangeLog.tkextlib b/ext/tk/ChangeLog.tkextlib deleted file mode 100644 index 52a0b7ea3a..0000000000 --- a/ext/tk/ChangeLog.tkextlib +++ /dev/null @@ -1,949 +0,0 @@ -2009-07-12 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * ext/tk/lib/tkextlib/*: update release. - Tcllib 1.8/Tklib 0.4.1 ==> Tcllib 1.11.1/Tklib 0.5 - BWidgets 1.7 ==> BWidgets 1.8 - TkTable 2.9 ==> TkTable 2.10 - TkTreeCtrl 2005-12-02 ==> TkTreeCtrl 2.2.9 - Tile 0.8.0/8.5.1 ==> Tile 0.8.3/8.6b1 - IncrTcl 2005-02-14 ==> IncrTcl 2008-12-15 - TclX 2005-02-07 ==> TclX 2008-12-15 - Trofs 0.4.3 ==> Trofs 0.4.4 - ---------------< ... some bug fixes ... >------------------ - -Tue Nov 25 03:37:42 2008 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * ext/tk/lib/tkextlib/blt/tabset.rb, - ext/tk/lib/tkextlib/blt/tabnotebook.rb: - fix many bugs. Now, those work properly. - -Sat Nov 22 10:31:25 2008 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * ext/tk/lib/tkextlib/blt.rb, ext/tk/lib/tkextlib/blt/vector.rb: - fix NameError bug. - -2008-05-12 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * ext/tk/lib/tkextlib/tkDND/shape.rb: wrong package name. - ---------------< ... some changes ... >------------------ - -2007-05-26 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * ext/tk/lib/tkextlib/tcllib/tablelist.rb: fix typo. - - * ext/tk/lib/tkextlib/tile/dialog.rb: forget to give an argument. - - * ext/tk/lib/tkextlib/version.rb: update RELEASE_DATE. - -2007-01-26 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * ext/tk/lib/tkextlib/iwidgets/checkbox.rb: wrong number of arguments - [ruby-Bugs-7776]. - - * ext/tk/lib/tkextlib/iwidgets/radiobox.rb: ditto. - - * ext/tk/lib/tkextlib/blt/tile/checkbutton.rb: change primary name - of class [ruby-dev:30080]. - - * ext/tk/lib/tkextlib/blt/tile/radiobutton.rb: ditto. - -2006-11-07 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tile/treeview.rb : minor bug fix. - - * lib/tkextlib/blt/table.rb: fix bugs which forbade use of - '::blt::table' command. Now, probably, it'll works properly. - -2006-11-06 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/version.rb: keep release date of tkextlib on - "Tk::Tkextlib_RELEASE_DATE". - - * lib/tkextlib/tile/treeview.rb : support Tile 0.7.8. - Now, you can handle tree items as objects. - -2006-10-04 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tile.rb, lib/tkextlib/tile/* : support Tile 0.7.6. - -2006-10-03 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/SUPPORT_STATUS: [ruby-talk:211939] check links - of extensions. - - * lib/tkextlib/blt/container.rb: define instance methods properly. - - * lib/tkextlib/tile/tcombobox.rb: bug fix [ruby-talk:213003]. - - * lib/tkextlib/tile/tnotebook.rb: ditto. - - * lib/tkextlib/tile/treeview.rb: ditto. - - * lib/tkextlib/tile/sizegrip.rb: [new] add 'ttk::sizegrip' widget. - -2006-08-31 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/blt.rb: double dashes (--) option doesn't work - properly on some versions of BLT (wrong description on the - manual of `blt::bgexec'?). - -2005-12-11 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/SUPPORT_STATUS: update to support libraries in - ActiveTcl8.4.12.0. - - * lib/tkextlib/tile/tnotebook.rb: add Tk::Tile::TNotebook#insert. - - * sample/tkextlib/tile/demo.rb: improve the look of a part of the demo. - -2005-11-25 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * sample/tkextlib/tile/demo.rb: bug fix - - * sample/tkextlib/tile/themes/*: add some themes (blue, - keramik, and plastik; require Tile-0.5 or later). - -2005-11-22 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tile.rb: bug fix (Tk::Tile::USE_TTK_NAMESPACE - is not defined). - -2005-11-19 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * sample/tkextlib/treectrl/demo.rb: remove dependency on Ruby's - version (1.8 or 1.9). - -2005-10-23 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/*: update to support ActiveTcl8.4.11.2 - - * lib/tkextlib/trofs/*: support Trofs 0.4.3 - - * lib/tkextlib/tile/*: support Tile 0.7.2 - - * lib/tkextlib/vu/*: support vu 2.3.0 - - * lib/tkextlib/tcllib/*: support Tcllib 1.8 (Tklib 0.3 part only) - - * lib/tkextlib/*: improve conversion of option values - -2005-10-04 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tktable/tktable.rb: border_* instance methods - don't call 'border' subcommands. - -2005-08-10 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/blt/component.rb: didn't check - __item_ruby2val_optkeys(). - -2005-08-09 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/blt/barchart.rb: support to treat tkvariable-type - configure options. - - * lib/tkextlib/blt/component.rb: ditto. - - * lib/tkextlib/blt/dragdrop.rb: ditto. - - * lib/tkextlib/blt/treeview.rb: ditto. - - * lib/tkextlib/bwidget/button.rb: ditto. - - * lib/tkextlib/bwidget/entry.rb: ditto. - - * lib/tkextlib/bwidget/label.rb: ditto. - - * lib/tkextlib/bwidget/labelentry.rb: ditto. - - * lib/tkextlib/bwidget/labelframe.rb: ditto. - - * lib/tkextlib/bwidget/mainframe.rb: ditto. - - * lib/tkextlib/bwidget/passwddlg.rb: ditto. - - * lib/tkextlib/bwidget/spinbox.rb: ditto. - - * lib/tkextlib/bwidget/tree.rb: ditto. - - * lib/tkextlib/iwidgets/calendar.rb: ditto. - - * lib/tkextlib/iwidgets/entryfield.rb: ditto. - - * lib/tkextlib/iwidgets/hierarchy.rb: ditto. - - * lib/tkextlib/iwidgets/labeledframe.rb: ditto. - - * lib/tkextlib/iwidgets/labeledwidget.rb: ditto. - - * lib/tkextlib/iwidgets/menubar.rb: ditto. - - * lib/tkextlib/iwidgets/scrolledlistbox.rb: ditto. - - * lib/tkextlib/iwidgets/spinner.rb: ditto. - - * lib/tkextlib/iwidgets/toolbar.rb: ditto. - - * lib/tkextlib/tkimg/pixmap.rb: ditto. - - * lib/tkextlib/tktable/tktable.rb: ditto. - -2005-08-06 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/tile/demo.rb: use Tk::Tile::Scale#variable. - -2005-08-04 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/tile/demo.rb: followed previous changes. - -2005-08-04 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tile/t*.rb: aliased class names starting with 'T' - to non 'T' ones. (ie. Tk::Tile::TButton -> Tk::Tile::Button) - [ruby-dev:26724] - - * lib/tkextlib/tile.rb: ditto. (autoload support) - -2005-08-04 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/tile/demo.rb: fixed: Tk::Tile::TProgressbar is - supported on tile 0.6 or later, not tile 0.5. - - * sample/tkextlib/tile/demo.rb: updated scales demo to use - Tk::Tile::TProgressbar for tile 0.6 or later. - - * sample/tkextlib/tile/demo.rb: set some TkVariable default values. - -2005-08-03 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tile/treeview.rb: Tk::Tile::Treeview#headingconfigure - is now working and more. [ruby-dev:26716] - - * sample/tkextlib/tile/demo.rb: use Tk::Tile::Treeview#headingconfigure instead of direct Tk.tk_call. - -2005-08-02 ocean <ocean@ruby-lang.org> - - * lib/tkextlib/tile/tprogressbar.rb: Tk::Tile::TProgressbar#start - takes optional argument `interval'. - - * sample/tkextlib/tile/demo.rb: emulate Tk::Tile::TProgressbar - with Tk::Tile::TProgress in tile 0.4. (repeating buttons demo) - -2005-08-02 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/tile/demo.rb: added repeating buttons demo. - - * sample/tkextlib/tile/repeater.tcl: ditto. (new file) - -2005-08-01 ocean <ocean@ruby-lang.org> - - * lib/tkextlib/tile.rb: fixed autoload for Treeview. - - * lib/tkextlib/tile/treeview.rb: replaced `ary2tk_list(items)' with - `*items'. - - * sample/tkextlib/tile/demo.rb: added treeview demo. (tile 0.5 or - later is required) [ruby-dev:26668] - -2005-08-01 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/tile/demo.rb: added combobox demo. - -2005-07-27 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/tile/demo.rb: fixed typo. - -2005-06-16 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/SUPPOPRT_STATUS: add RELEASE_DATE information. - - * lib/tkextlib/tile/style.rb: add "style element options <elem>" - command support. - -2005-06-08 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/ICONS/icons.rb: fail to create instances of - Tk::ICONS [ruby-dev:26305]. - -2005-06-07 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/tile/themes/kroc.{rb,tcl}: also support tile 0.4. - -2005-06-07 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/tile/themes/kroc.{rb,tcl}: support tile 0.5 or later. - ("pixmap" element constructor replaced by "image") - -2005-06-05 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * sample/tkextlib/tile/demo.rb: fix TypeError & create Console - -2005-05-30 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/blt.rb: add PACKAGE_NAME information of Tcl/Tk - Extension. - - * lib/tkextlib/bwidget.rb: ditto. - - * lib/tkextlib/iwidgets.rb: ditto. - - * lib/tkextlib/tile.rb: ditto. - - * lib/tkextlib/tkimg.rb: ditto. - - * lib/tkextlib/vu.rb: ditto. - - * lib/tkextlib/ICONS/icons.rb: ditto. - - * lib/tkextlib/itcl/incr_tcl.rb: ditto. - - * lib/tkextlib/itk/incr_tk.rb: ditto. - - * lib/tkextlib/tcllib/autoscroll.rb: ditto. - - * lib/tkextlib/tcllib/ctext.rb: ditto. - - * lib/tkextlib/tcllib/cursor.rb: ditto. - - * lib/tkextlib/tcllib/datefield.rb: ditto. - - * lib/tkextlib/tcllib/ico.rb: ditto. - - * lib/tkextlib/tcllib/ip_entry.rb: ditto. - - * lib/tkextlib/tcllib/plotchart.rb: ditto. - - * lib/tkextlib/tcllib/style.rb: ditto. - - * lib/tkextlib/tcllib/tkpiechart.rb: ditto. - - * lib/tkextlib/tclx/tclx.rb: ditto. - - * lib/tkextlib/tkDND/shape.rb: ditto. - - * lib/tkextlib/tkDND/tkdnd.rb: ditto. - - * lib/tkextlib/tkHTML/htmlwidget.rb: ditto. - - * lib/tkextlib/tkimg/bmp.rb: ditto. - - * lib/tkextlib/tkimg/gif.rb: ditto. - - * lib/tkextlib/tkimg/ico.rb: ditto. - - * lib/tkextlib/tkimg/jpeg.rb: ditto. - - * lib/tkextlib/tkimg/pcx.rb: ditto. - - * lib/tkextlib/tkimg/pixmap.rb: ditto. - - * lib/tkextlib/tkimg/png.rb: ditto. - - * lib/tkextlib/tkimg/ppm.rb: ditto. - - * lib/tkextlib/tkimg/ps.rb: ditto. - - * lib/tkextlib/tkimg/sgi.rb: ditto. - - * lib/tkextlib/tkimg/sun.rb: ditto. - - * lib/tkextlib/tkimg/tga.rb: ditto. - - * lib/tkextlib/tkimg/tiff.rb: ditto. - - * lib/tkextlib/tkimg/window.rb: ditto. - - * lib/tkextlib/tkimg/xbm.rb: ditto. - - * lib/tkextlib/tkimg/xpm.rb: ditto. - - * lib/tkextlib/tktable/tktable.rb: ditto. - - * lib/tkextlib/tktrans/tktrans.rb: ditto. - - * lib/tkextlib/treectrl/tktreectrl.rb: ditto. - - * lib/tkextlib/winico/winico.rb: ditto. - -2005-05-25 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/iwidgets/scrolledlistbox.rb: follow the change - of tk.rb. modify to attend encoding. - - * lib/tkextlib/iwidgets/scrolledtext.rb: ditto. - - * lib/tkextlib/iwidgets/scrolledcanvas.rb: bug fix on - TkCanvas#delete when given non-TkcItem arguments. - -2005-05-10 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/blt/winop.rb: fix typo - -2005-05-08 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/vu/pie.rb: fix typo - -2005-04-10 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/treectrl/mailwasher.rb: fixed typo. [ruby-dev:26008] - -2005-04-09 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * sample/tkextlib/tile/demo.rb: new demo of Tile extension. - - * sample/tkextlib/tile/iconlib.tcl: part of the demo. - - * sample/tkextlib/tile/toolbutton.tcl: ditto. - - * sample/tkextlib/tile/readme.txt: document of the demo. - - * sample/tkextlib/tile/Orig_LICENSE.txt: ditto. - - * sample/tkextlib/tile/themes/kroc.tcl: sample theme written with Tcl. - - * sample/tkextlib/tile/themes/pkgIndex.tcl: pkgIndex of kroc.tcl. - - * sample/tkextlib/tile/themes/kroc.rb: Kroc theme written with Ruby. - - * sample/tkextlib/tile/themes/kroc/button-h.gif: images for Kroc theme. - - * sample/tkextlib/tile/themes/kroc/button-n.gif: ditto. - - * sample/tkextlib/tile/themes/kroc/button-p.gif: ditto. - - * sample/tkextlib/tile/themes/kroc/check-hc.gif: ditto. - - * sample/tkextlib/tile/themes/kroc/check-hu.gif: ditto. - - * sample/tkextlib/tile/themes/kroc/check-nc.gif: ditto. - - * sample/tkextlib/tile/themes/kroc/check-nu.gif: ditto. - - * sample/tkextlib/tile/themes/kroc/radio-hc.gif: ditto. - - * sample/tkextlib/tile/themes/kroc/radio-hu.gif: ditto. - - * sample/tkextlib/tile/themes/kroc/radio-nc.gif: ditto. - - * sample/tkextlib/tile/themes/kroc/radio-nu.gif: ditto. - - * lib/tkextlib/tile.rb: bug fix (tested on the new demo). - - * lib/tkextlib/tile/style.rb: ditto. - - * lib/tkextlib/tile/tbutton.rb: ditto. - - * lib/tkextlib/tile/tcheckbutton.rb: ditto. - - * lib/tkextlib/tile/tcombobox.rb: ditto. - - * lib/tkextlib/tile/tentry.rb: ditto. - - * lib/tkextlib/tile/tframe.rb: ditto. - - * lib/tkextlib/tile/tlabel.rb: ditto. - - * lib/tkextlib/tile/tlabelframe.rb: ditto. - - * lib/tkextlib/tile/tmenubutton.rb: ditto. - - * lib/tkextlib/tile/tnotebook.rb: ditto. - - * lib/tkextlib/tile/tprogressbar.rb: ditto. - - * lib/tkextlib/tile/tradiobutton.rb: ditto. - - * lib/tkextlib/tile/treeview.rb: ditto. - - * lib/tkextlib/tile/tscrollbar.rb: ditto. - - * lib/tkextlib/tile/tseparator.rb: ditto. - - * lib/tkextlib/tile/tsquare.rb: ditto. - - * lib/tkextlib/tile/tpaned.rb: new library - - * lib/tkextlib/tile/tscale.rb: ditto. - - * lib/tkextlib/SUPPORT_STATUS: update support status of Tile extension. - - * lib/tkextlib/tcllib/ctext.rb: use TkCommandNames on create_self(). - - * lib/tkextlib/tcllib/datefield.rb: ditto. - - * lib/tkextlib/tcllib/ip_entry.rb: ditto. - - * lib/tkextlib/tkHTML/htmlwidget.rb: ditto. - - * lib/tkextlib/treectrl/tktreectrl.rb: ditto. - -2005-04-09 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/treectrl/explorer.rb: File.executable? returns true - even if it's plain text file. (this function only checks access right) - -2005-04-09 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/treectrl/{help,www-options}.rb: fixed typo. - (click or resize column header) - -2005-04-09 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/treectrl/imovie.rb: fixed typo. (click on clip title) - -2005-04-08 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/treectrl/random.rb: fixed typo. (drop node outside of - widget, or reenter widget while dragging) - -2005-04-08 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/treectrl/outlook-newgrounp.rb: image had disappered when - node was selected. - -2005-04-08 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/treectrl/{random,outlook-newgroup}.rb: - tk::treectrl uses 'afterId' not 'afterID'. - - * sample/tkextlib/treectrl/{random,outlook-newgroup}.rb: - item_firstchild can return empty string. (drop node to leaf node) - - * sample/tkextlib/treectrl/random.rb: Enumerable#find didn't work properly - because tried to compare String with Integer. (drag node and leave widget) - - * sample/tkextlib/treectrl/random.rb: and some fixes. - -2005-04-08 ocean <ocean@ruby-lang.org> - - * lib/tkextlib/treectrl/tktreectrl.rb (selection_clear): fixed typo. - - * sample/tkextlib/treectrl/random.rb: node deselection now works. - - * sample/tkextlib/treectrl/demo.rb: fixed typo. (popup menu on column header) - -2005-04-08 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/treectrl/help.rb: fixed typo. (wrong color) - -2005-04-08 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/treectrl/random.rb: fixed typo. (wrong itemheight) - - * sample/tkextlib/treectrl/outlook-newgroup.rb: ditto. - - * sample/tkextlib/treectrl/explorer.rb: ditto. - - * sample/tkextlib/treectrl/help.rb: ditto. - -2005-04-07 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/treectrl/*.rb: some speed up... cache the result of - version checking. - -2005-04-07 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/treectrl/tktreectrl.rb: performance tuning by calling - tk_send_without_enc. [ruby-dev:25997] - -2005-04-04 ocean <ocean@ruby-lang.org> - - * lib/tkextlib/tktable/tktable.rb: added Tk::TkTable#selection_present. - -2005-04-02 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/treectrl/tktreectrl.rb: support TreeCtrl's cvs head. - -2005-04-02 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/blt/component.rb: add TreeCtrl#legend_window_create(). - - * sample/tkextlib/blt/graph6.rb: use legend_window_create(). - - * lib/tkextlib/blt/tree.rb: forget to call tagid(). - - * lib/tkextlib/blt/treeview.rb: ditto. - -2005-04-01 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * sample/tkextlib/treectrl/demo.rb: bridge the gap of - Hash#index or Hash#key between ruby 1.8 and 1.9 - -2005-04-01 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/blt/component.rb: bug fix on treatment of - component objects. - - * sample/tkextlib/blt/graph6.rb: a new sample script. - -2005-03-31 ocean <ocean@ruby-lang.org> - - * sample/tkextlib/treectrl/demo.rb: should use Hash#index. - - * sample/tkextlib/treectrl/demo.rb: TkImage was not - cached properly. - - * sample/tkextlib/treectrl/random.rb: fixed typo. - -2005-03-31 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * sample/tkextlib/iwidgets/sample/hierarchy.rb: show basename - only [ruby-dev:25970] - - * sample/tkextlib/treectrl/demo.rb: add check for existence of - 'backgroundimage' option. - - * sample/tkextlib/treectrl/bitmaps.rb: ditto. - - * sample/tkextlib/treectrl/outlook-newgroup.rb: lack of '%I' - event callback argument. - -2005-03-31 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * sample/tkextlib/iwidgets/sample/hierarchy.rb: fail to treat - Japanese (i18n?) filenames. - -2005-03-30 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * sample/tkextlib/bwidget/tree.rb: use 'return' in the Proc object. - - * sample/tkextlib/tkHTML/hv.rb: ditto. - - * sample/tkextlib/tkHTML/ss.rb: ditto. - - * sample/tkextlib/tktable/basic.rb: ditto. - - * sample/tkextlib/tktable/command.rb: ditto. - - * sample/tkextlib/tktable/debug.rb: ditto. - - * sample/tkextlib/tktable/maxsize.rb: ditto. - - * sample/tkextlib/treectrl/demo.rb: ditto. - -2005-03-29 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/blt/component.rb: cannot create elements except - default type of element. - - * lib/tkextlib/blt/barchart.rb: ditto. - - * lib/tkextlib/blt/graph.rb: ditto. - - * lib/tkextlib/blt/stripchart.rb: ditto. - - * lib/tkextlib/blt/component.rb: axis command option gets - proper object type of arguments. - - * sample/tkextlib/blt/calendar.rb: new sample. - - * sample/tkextlib/blt/pareto.rb: ditto. - -2005-03-28 ocean <ocean@ruby-lang.org> - - * lib/tkextlib/iwidgets/notebook.rb: fixed typo. - -2005-03-26 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/blt.rb: add commands for zooming. - - * lib/tkextlib/blt/bitmap.rb (new_with_name): add for using - given name. - - * lib/tkextlib/blt/busy.rb: bug fix on Tk::BLT::Busy::Shild class. - - * lib/tkextlib/blt/component.rb: typo fix. - - * lib/tkextlib/blt/component.rb: fix lack of *_create methods - - * lib/tkextlib/blt/component.rb: proper call on xaxis_* and so on. - - * lib/tkextlib/blt/htext.rb: add TkVariable object to access - special Tcl variables. - - * lib/tkextlib/treectrl/tktreectrl.rb: typo fix. - - * lib/tkextlib/treectrl/tktreectrl.rb: proper treatment - of 'font' option of element_configure. - - * lib/tkextlib/treectrl/tktreectrl.rb: bug fix on item_sort. - - * lib/tkextlib/treectrl/tktreectrl.rb: add methods to - call TreeCtrl commands for bindings. - - * sample/tkextlib/blt/*: add some sample scripts. - - * sample/tkextlib/treectrl/*: add some sample scripts. - -2005-03-18 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/treectrl/tktreectrl.rb: bug fix and define some - classes for components of Tk::TreeCtrl - -2005-03-17 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/treectrl/tktreectrl.rb: call wrong method in - Tk::TreeCtrl#*_configinfo and current_*_configinfo method - -2005-03-16 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/SUPPORT_STATUS: change the status of TkImg - - * lib/tkextlib/treectrl/tktreectrl.rb: bug fix and support - TkTreeCtrl-1.1 - - * lib/tkextlib/SUPPORT_STATUS: change the supported version of - TkTreeCtrl - -2005-03-15 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * sample/tkextlib/tkimg: add sample - -2005-03-06 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/SUPPORT_STATUS: add version info of each extension - -2005-03-05 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tile.rb: lack of "autoload TProgressbar" - -2005-03-05 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tile.rb: support tile-0.6 - - * lib/tkextlib/tile/tbutton.rb: ditto - - * lib/tkextlib/tile/tcheckbutton.rb: ditto - - * lib/tkextlib/tile/tlabel.rb: ditto - - * lib/tkextlib/tile/tmenubutton.rb: ditto - - * lib/tkextlib/tile/tnotebook.rb: ditto - - * lib/tkextlib/tile/tradiobutton.rb: ditto - - * lib/tkextlib/tile/tcombobox.rb: [new] ditto - - * lib/tkextlib/tile/tentry.rb: [new] ditto - - * lib/tkextlib/tile/tframe.rb: [new] ditto - - * lib/tkextlib/tile/tlabelframe.rb: [new] ditto - - * lib/tkextlib/tile/tprogressbar.rb: [new] ditto - - * lib/tkextlib/tile/treeview.rb: [new] ditto - - * lib/tkextlib/tile/tscrollbar.rb: [new] ditto - - * lib/tkextlib/tile/tseparator.rb: [new] ditto - - * lib/tkextlib/tile/tsquare.rb: [new] ditto - -2005-02-20 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tclx/tclx.rb: warning TclX's 'signal' command. - -2005-01-25 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/blt/component.rb: bug fix. cannot accept - a callback ID string for a command argument. [ruby-dev:25479] - - * lib/tkextlib/blt/tabset.rb: ditto - - * lib/tkextlib/blt/treeview.rb: ditto - - * lib/tkextlib/bwidget/labelentry.rb: ditto - - * lib/tkextlib/bwidget/listbox.rb: ditto - - * lib/tkextlib/bwidget/notebook.rb: ditto - - * lib/tkextlib/bwidget/spinbox.rb: ditto - - * lib/tkextlib/bwidget/tree.rb: ditto - - * lib/tkextlib/itk/incr_tk.rb: ditto - - * lib/tkextlib/iwidgets/scrolledcanvas.rb: ditto - - * lib/tkextlib/tkDND/tkdnd.rb: ditto - - * lib/tkextlib/treectrl/tktreectrl.rb: ditto - - * sample/tkextlib/tkHTML/ss.rb: local variable scope bug fix - [ruby-dev:25479] - - * sample/tkextlib/vu/vu_demo.rb: rename from vu.rb; avoid the bug on - Windows version of Tcl/Tk. The trouble based on the bug occurs when - the script name (without extension) is a same name as a Tcl/Tk's - library file name (without extension) required in the script. - -2004-12-24 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/blt: add BLT extension support - -2004-12-16 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/bwidget/labelentry.rb: use TkCore.callback_obj?() - - * lib/tkextlib/bwidget/listbox.rb: ditto - - * lib/tkextlib/bwidget/notebook.rb: ditto - - * lib/tkextlib/bwidget/spinbox.rb: ditto - - * lib/tkextlib/itk/incr_tk.rb: ditto - - * lib/tkextlib/iwidgets/scrolledcanvas.rb: ditto - - * lib/tkextlib/tkDND/tkdnd.rb: ditto - - * lib/tkextlib/treectrl/tktreectrl.rb: ditto - - * lib/tkextlib/winico/winico.rb: ditto - -2004-12-10 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tile/style.rb: 'theme_use' method bug fix - -2004-12-08 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/bwidget/notebook.rb: raise method cannot return - the raised page. - - * lib/tkextlib/bwidget/labelentry.rb: bind methods accept - subst_args + block - - * lib/tkextlib/bwidget/listbox.rb: ditto - - * lib/tkextlib/bwidget/notebook.rb: ditto - - * lib/tkextlib/bwidget/spinbox.rb: ditto - - * lib/tkextlib/bwidget/tree.rb: ditto - - * lib/tkextlib/itk/incr_tk.rb: ditto - - * lib/tkextlib/iwidgets/scrolledcanvas.rb: ditto - - * lib/tkextlib/tkDND/tkdnd.rb: ditto - - * lib/tkextlib/treectrl/tktreectrl.rb: ditto - -2004-11-26 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/bwidget/notebook.rb: uses epath - - * lib/tkextlib/bwidget/widget.rb: ditto - - * lib/tkextlib/tktable/tktable.rb: ditto - - * lib/tkextlib/tcllib/cursor.rb: ditto, and bug fix - -2004-11-10 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tile/style.rb: bug fix - -2004-11-07 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/iwidgets/scrolledcanvas.rb: bind-event methods - accept multi substitution arguments. - - * lib/tkextlib/tktable/tktable.rb: ditto. - - * lib/tkextlib/treectrl/tktreectrl.rb: ditto - -2004-11-03 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/SUPPORT_STATUS: BLT moves to 'plan to support' - from 'not determined' - - * lib/tkextlib/itk/incr_tk.rb: __cget_cmd and __config_cmd are - private methods - - * lib/tkextlib/tcllib/autoscroll.rb: extend TkCore - - * lib/tkextlib/tcllib/cursor.rb: ditto. - - * lib/tkextlib/tcllib/plotchart.rb: ditto. - - * lib/tkextlib/tcllib/style.rb: ditto. - - * lib/tkextlib/tile/style.rb: ditto. - - * lib/tkextlib/tkDND/shape.rb: ditto. - -2004-10-24 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/bwidget/tree.rb: bug fix on Windows - -2004-10-16 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/tcllib/ico.rb: new library (Tk::Tcllib:ICO) - - * lib/tkextlib/tcllib.rb: add Tk::Tcllib::ICO (based on tcllib 1.7) - -2004-10-06 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/bwidget.rb (BWidget.grab): bug fix - - * lib/tkextlib/tcllib.rb: typo fix - -2004-07-28 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/add winico support - -2004-07-23 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * lib/tkextlib/add TclX support (partially; infox command and - XPG/3 MsgCat only) - -2004-07-15 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * bug fix - - * support TkTable extension - -2004-07-12 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * bug fix - - * support Iwidgets extension - -2004-07-10 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * bug fix - - * add more part of [incr Widget] support (about 65%? are complete) - - * use Tk::ValidateConfigure.__def_validcmd() method - (new function to define validatecommand methods easier) - - * tcllib.rb : avoid the loading trouble that almost all part of - the extension is not available when some libraries are invalid. - -2004-07-09 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * add some part of [incr Widget] support (about 50%? are complete) - -2004-07-07 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * add [incr Tck], [incr Tk] support - -2004-07-06 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * support BWidget extension - - * add BWidget extension demo - - * add ICONS extension demo - - * many bug fix - -2004-07-01 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - - * 1st release of tkextlib ( to support Tcl/Tk extensions ) diff --git a/ext/tk/MANUAL_tcltklib.eng b/ext/tk/MANUAL_tcltklib.eng deleted file mode 100644 index 7d4804ef8a..0000000000 --- a/ext/tk/MANUAL_tcltklib.eng +++ /dev/null @@ -1,467 +0,0 @@ -(tof) - 2005/07/05 Hidetoshi NAGAI - -This document describes about the 'tcltklib' library. Although there -is the 'tcltk' library (tcltk.rb) under this directory, no description -in this document (because it is not maintained recently). - -============================================================== -module TclTklib - : Defines methods to do operations which are independed on - : Tcl/Tk interpreters - - module TclTkLib::EventFlag - : Defines flags to define target events on 'do_one_event' methods. - : When to give, please use bit-operator (e.g. WINDOW | DONT_WAIT). - - [constants] - NONE - : Is 0. It means "there is no target". But on the real - : operation, it is same to ALL. - - WINDOW - : 'window' event is processed. - - FILE - : 'file' event is processed. - - TIMER - : 'timer' event is processed. - - IDLE - : 'idle' operation (e.g. 're-draw'; the operations when the - : other kinds of events doesn't occur) is processed. - - ALL - : All kinds of events are processed. - : Same to 'WINDOW | FILE | TIMER | IDLE'. - - DONT_WAIT - : Without this flag, 'do_one_event' waits the occurrence of - : a target event. With this flag, doesn't wait and returns - : false if there is no target event for processing. - - 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 TclTkLib::RELEASE_TYPE - : Defines release type number of Tcl/Tk - - ALPHA - : ALPHA release - - BETA - : BETA release - - FINAL - : FINAL release - - [module methods] - get_version() - : return an array of major, minor, release-type number, - : and patchlevel of current Tcl/Tk library. - - 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, doesn't return by the other - : reasons than exceptions. - - mainloop_thread? - : Returns whether the current thread executes the eventloop. - : If true, the eventloop is working on the current thread. - : If no eventloop is working, this method returns nil. - : And if the other thread executes the eventloop, returns false. - : - : *** ATTENTION *** - : When this methods returns false, it is dangerous to call a Tk - : interpreter directly. - - 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 >= 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 cannot be set to 0. If 0, then is set to 100 ms - : automatically (see NO_THREAD_INTERRUPT_TIME on tcltklib.c). - - 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. - - 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 thread - : sleeps 'no_event_wait' mili-seconds). - : 'loop_max == 800' and 'no_event_tick == 10' are default. - - 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 warning message but ignore the exception. - : If nil, no warning message and ignore the exception. - : 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. - - 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 argument 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=nil) - _fromUTF8(str, encoding=nil) - : 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. - - encoding_system - encoding_system=(encoding) - : Get and set Tcl's system encoding. - - encoding - encoding=(encoding) - : alias of encoding_system / encoding_system= - : ( probably, Ruby/Tk's tk.rb will override them ) - - -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 false 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 extension 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). - - 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. - - allow_ruby_exit? - : Return the mode whether 'exit' function of ruby or 'exit' - : command of Tcl/Tk can quit the ruby process or not on the - : interpreter. If false, such a command quit the interpreter - : only. - : The default value for a master interpreter is true, and - : for a slave interpreter is false. - - allow_ruby_exit=(mode) - : Change the mode of 'allow_ruby_exit?'. - : If the interpreter is a "safe" interpreter, - : this is not permitted (raise an exception). - - 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. - - has_mainwindow? - : Check whether the interpreter has a MainWindow (root widget). - : If has, returns true. If doesn't, returns false. - : If IP is already deleted, returns nil. - - restart - : Restart Tk part of the interpreter. - : Use this when you need Tk functions after destroying the - : root widget. - - _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 register the command once, after that, the - : command can be called by _invoke. - - _cancel_eval(str) - _cancel_eval_unwind(str) - : (Tcl/Tk8.6 or later) - : Call Tcl_CancelEval() function, and cancel evaluation. - - _toUTF8(str, encoding=nil) - _fromUTF8(str, encoding=nil) - : 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 argument 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. - - encoding_table - : For Ruby m17n. Return encoding relation table between Ruby's - : Encoding object and Tcl's encoding 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 operation for the current bindtag and - : starts the operation for the next bindtag for the current event). - : However, current tcltklib supports Ruby's 'break' and 'next' to - : get the same effect. That is, those classes are obsolete. Those - : exist for backward compatibility. - -(eof) diff --git a/ext/tk/MANUAL_tcltklib.ja b/ext/tk/MANUAL_tcltklib.ja deleted file mode 100644 index 8641909517..0000000000 --- a/ext/tk/MANUAL_tcltklib.ja +++ /dev/null @@ -1,578 +0,0 @@ -(tof) - 2005/07/05 Hidetoshi NAGAI - -本ドキュメントには古い tcltk ライブラリ，tcltklib ライブラリの説明 -が含まれていますが，その記述内容は古いものとなっています． - -tcltk ライブラリ（tcltk.rb）は現在ではメンテナンスが事実上行われて -いないため，古いドキュメントの説明がそのまま有効です．それに対し， -tcltklib ライブラリについては，現在の Ruby/Tk（tk.rb 以下のライブラ -リ群）を稼働させるための中心としてメンテナンスされているため，少々 -違いが生じています． - -そこで，まず古い説明文書を示した後，現在の tcltklib ライブラリにつ -いての説明を加えます． - -以下がライブラリの古い説明文書です． -============================================================== - MANUAL.euc - Sep. 19, 1997 Y. Shigehiro - -以下, 「tcl/tk」という表記は, tclsh や wish を実現している, 一般でいう -ところの tcl/tk を指します. 「tcltk ライブラリ」, 「tcltklib ライブラ -リ」という表記は, 本パッケージに含まれる ruby 用のライブラリを指します. - -<< tcltk ライブラリ >> - -tcl/tk の C ライブラリを利用するための高(中?)水準インターフェースを提 -供します. - -このライブラリは ruby から tcl/tk ライブラリを利用するためのもので, 内 -部で tcltklib ライブラリを利用しています. - -[説明] - -tcl/tk インタプリタでは, ウィジェットに何か指示を送るには, ウィジェッ -ト名に続いてパラメータを書きます. したがって, ウィジェットがオブジェク -トであり, それに対してメソッドを送っている, とみなすことができます. さ -て, tcl/tk インタプリタでは, 組み込みコマンドも, 前述のウィジェットと -同じような書式の命令で実行されます. すなわち, コマンドもオブジェクトで -あると考えることができます. - -このような考えに基づき, tcltk ライブラリでは, tcl/tk のコマンドやウィ -ジェットに対応するオブジェクトを生成します. オブジェクトに対するメソッ -ド呼び出しは, e() メソッドにより実行されます. 例えば, tcl/tk の info -コマンドに対応する ruby のオブジェクトが info という名前であるとすると, -tcl/tk の - info commands -という命令は tcltk ライブラリでは - info.e("commands") -と記述されます. また, 「.」というウィジェット (wish 実行時に自動的に生 -成されるルートウィジェット) に対応する ruby のオブジェクトが root とい -う名前であるとすると, - . configure -height 300 -width 300 -という tcl/tk の命令は - root.e("configure -height 300 -width 300") -と記述されます. このような記述は, 見ためには美しくありませんが, そして, -スクリプトを読む人には見づらいかも知れませんが, 実際にスクリプトを書い -てみると予想外に手軽です. - -[使用法] - -1. ライブラリを読み込む. - require "tcltk" - -2. tcl/tk インタプリタを生成する. - ip = TclTkInterpreter.new() - -3. tcl/tk のコマンドに対応するオブジェクトを変数に代入しておく. - # コマンドに対応するオブジェクトが入った Hash を取り出す. - c = ip.commands() - # 使いたいコマンドに対応するオブジェクトを個別の変数に代入する. - bind, button, info, wm = c.indexes("bind", "button", "info", "wm") - -4. 必要な処理を行う. - 詳しくは, サンプルを参照のこと. - -5. 準備ができたら, イベントループに入る. - TclTk.mainloop() - -(( 以下, モジュール, クラス等の説明を書く予定.)) - - - -<< tcltklib ライブラリ >> - -tcl/tk の C ライブラリを利用するための低水準インターフェースを提供しま -す. - -コンパイル/実行には, tcl/tk の C ライブラリが必要です. - -[説明] - -このライブラリを用いると, ruby から tcl/tk の C ライブラリを利用できま -す. 具体的には, ruby インタプリタから tcl/tk インタプリタを呼び出すこ -とができます. さらに, その(ruby インタプリタから呼び出した) tcl/tk イ -ンタプリタから, 逆に ruby インタプリタを呼び出すこともできます. - -[使用法] - -require "tcltklib" すると, 以下のモジュール, クラスが利用可能です. - -モジュール TclTkLib - tcl/tk ライブラリを呼び出すメソッドを集めたモジュールです. ただし, - tcl/tk インタプリタ関係のメソッドはクラス TclTkIp にあります. - - モジュールメソッド mainloop() - Tk_MainLoop を実行します. 全ての tk のウインドウが無くなると終了 - します(例えば, tcl/tk で書くところの "destroy ." をした場合等). - 引数: 無し - 戻り値: nil - -クラス TclTkIp - インスタンスが tcl/tk のインタプリタに対応します. tcl/tk のライブ - ラリの仕様通り, インスタンスを複数個生成しても正しく動作します(そ - んなことをする必要はあまり無いはずですが). インタプリタは wish の - tcl/tk コマンドを実行できます. さらに, 以下のコマンドを実行できま - す. - コマンド ruby - 引数を ruby で実行します(ruby_eval_string を実行します). 引数 - は 1 つでなければなりません. 戻り値は ruby の実行結果です. - ruby の実行結果は nil か String でなければなりません. - - クラスメソッド new() - TclTkIp クラスのインスタンスを生成します - 引数: 無し - 戻り値 (TclTkIp): 生成されたインスタンス - - メソッド _eval(script) - インタプリタで script を評価します(Tcl_Eval を実行します). 前述 - のように, ruby コマンドにより script 内から ruby スクリプトを実 - 行できます. - 引数: script (String) - インタプリタで評価するスクリプト文字列 - 戻り値 (String): 評価結果 ((Tcl_Interp *)->result) - - メソッド _return_value() - 直前の Tcl_Eval の戻り値を返します. 0(TCL_OK) で正常終了です. - 引数: 無し - 戻り値 (Fixnum): 直前の Tcl_Eval() が返した値. - -============================================================== - -以下が本ドキュメント作成時点での tcltklib ライブラリの説明です． -============================================================== -モジュール TclTkLib - : 個々の Tcl/Tk インタープリタに依存しない処理 ( == イベントルー - : プに関する処理 ) を呼び出すメソッドを定義したモジュール． - - モジュール TclTkLib::EventFlag - : do_one_event を呼び出す際の処理対象イベントを指定するための - : フラグ ( WINDOW|DONT_WAIT というようにビット演算子で連結して - : 指定 ) を定数として定義したモジュール．以下の定数が含まれる． - - 定数 NONE - : 値は 0 で，値としてはいかなる種類のイベントも指定していない - : ことになるが，実際の処理上は ALL と同じとして扱われる． - - 定数 WINDOW - : window イベントを処理対象とする - - 定数 FILE - : file イベントを処理対象とする - - 定数 TIMER - : timer イベントを処理対象とする - - 定数 IDLE - : アイドルループ処理 ( 再描画など，他の種類のイベントが発生 - : していないときに行われる処理 ) を処理対象とする - - 定数 ALL - : すべての種類のイベントを処理対象とする - : WINDOW|FILE|TIMER|IDLE と同じ - - 定数 DONT_WAIT - : 処理対象イベントが存在しない場合に，イベント発生を待たず - : に 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 と - : せねばならない． - - モジュール TclTkLib::RELEASE_TYPE - : Tcl/Tk のリリースタイプ番号の定義 - - 定数 ALPHA - : ALPHA リリース - - 定数 BETA - : BETA リリース - - 定数 FINAL - : FINAL リリース - - モジュールメソッド - get_version() - : Tcl/Tk の major, minor, release-type 番号, patchlevel を - : 配列にして返す． - - mainloop(check_root = true) - : イベントループを起動する．check_root が true であれば， - : root widget が存在する限り，このメソッドは終了しない． - : check_root が false の場合は，root widget が消滅しても - : このメソッドは終了しない ( root widget が消滅しても， - : WINDOW 以外のイベントは発生しうるため )．終了には，外部 - : からの働き掛け ( スレッドを活用するなど ) が必要． - - mainloop_thread? - : カレントスレッドがイベントループを実行しているスレッド - : かどうかを返す． - : イベントループを実行しているスレッドであれば true を， - : どのスレッドでもイベントループが実行されていない場合は - : nil を，他のスレッドでイベントループが実行されている場 - : 合は false を返す． - : false の際に Tk インタープリタを直接呼ぶのは危険である． - - mainloop_watchdog(check_root = true) - : 通常のイベントループでは，イベント処理の内容によっては - : デッドロックを引き起こす可能性がある (例えばイベントに - : 対するコールバック処理中で widget 操作をし，その終了を - : 待つなど)．このメソッドは，そうしたデッドロックを回避す - : るための監視スレッド付きでイベントループを起動する - : ( 監視スレッドを生成した後にイベントループを実行する )． - : 引数の意味は mainloop と同じである． - - do_one_event(flag = TclTkLib::EventFlag::ALL | - TclTkLib::EventFlag::DONT_WAIT) - : 処理待ちのイベント 1 個を実行する． - : イベントを処理した場合は true を返す． - : フラグで DONT_WAIT を指定していない場合，フラグで処理対 - : 象となっている種類のイベントが発生するまで待ち続ける． - : DONT_WAIT を指定していた場合，処理対象イベントがなくても - : すぐに終了し false を返す． - : $SAFE >= 1 かつ flag が汚染されているならば - : flag には DONT_WAIT が強制的に付けられる． - - set_eventloop_tick(timer_tick) - : イベントループと同時に別スレッドが稼働している場合に，時 - : 間に基づいた強制的なスレッドスイッチングをどの程度の頻度 - : ( 時間間隔 ) で発生させるかをミリ秒単位の整数値で指定する． - : 0 を指定すると，この強制的なスイッチングは行われない． - : 標準では 0 に設定されており，イベント処理数に基づくスイッ - : チングだけが行われる ( see set_eventloop_weight )． - : ただし，稼働しているスレッドがイベントループだけの場合， - : timer_tick を 0 に設定することはできない．もし設定されて - : いたら，100 ms ( see NO_THREAD_INTERRUPT_TIME ) に自動設 - : 定される． - : 詳細な説明は略すが，これは CPU パワーを節約しつつ安全で - : 安定した動作を実現するために実装した仕様である． - - get_eventloop_tick - : timer_tick の現在値を返す． - - set_no_event_wait(no_event_wait) - : 複数のスレッドが稼働している場合で，処理待ちイベントが全 - : く存在しなかった際に sleep 状態に入る時間長を指定する． - : 稼働スレッドがイベントループだけの場合には意味をなさない． - : デフォルトの値は 20 (ms) - - get_no_event_wait - : no_event_wait の現在値を返す． - - set_eventloop_weight(loop_max, no_event_tick) - : 複数のスレッドが稼働している際に Ruby/Tk のイベントルー - : プに割り当てる比重を定めるためのパラメータを設定する． - : 稼働スレッドがイベントループだけの場合には意味をなさない． - : 一度のスレッド切り替えの間に処理するイベントの最大数と， - : 処理待ちのイベントが存在しない際の加算数とを設定する． - : 処理待ちイベントが存在しない場合は no_event_wait ( see - : set_no_event_wait ) だけの間 sleep 状態に入る． - : デフォルトではそれぞれ 800 回と 10 回，つまり，800 個のイ - : ベント (アイドルイベントを含む) を処理するとか，イベント - : が全く発生しないままに 80 回の処理待ちイベント検査が完了 - : するとかでカウントが 800 以上になるとスレッドスイッチング - : が発生することになる． - - get_eventloop_weight - : 現在の loop_max と no_event_tick との値を返す． - : ( see set_eventloop_wait ) - - mainloop_abort_on_exception=(bool) - : Tk インタープリタ上で例外を発生した際に，イベントループを - : エラー停止させるかどうかを指定する．true を指定した場合は - : エラー停止するが，false の場合は例外を無視してイベントルー - : プを継続する．さらに nil の場合は警告モードでない限りはエ - : ラーメッセージの出力すら省略して，例外を無視する． - : デフォルトでは true に設定されている． - : １個のインタープリタだけを使っている場合にはエラー時にその - : まま停止しても通常は問題ないが，複数のインタープリタが同時 - : に動作している場合には，それらを管理するイベントループは１ - : 個だけであるため，いずれかのインタープリタのエラーが原因で， - : 他のインタープリタの処理継続が不可能になることがある．その - : ような場合でもエラーを無視してイベントループが稼働を続ける - : ことで，他のインタープリタが正常に動作し続けることができる． - - mainloop_abort_on_exception - : Tk インタープリタ上で例外を発生した際に，イベントループをエ - : ラー停止させるかどうかの設定状態を true/false で得る． - - num_of_mainwindows - : 現在のメインウィンドウ (ルートウィジェット) の数を返す． - : メインウィンドウは一つのインタープリタに付き最大一つである - : ので，この値は現在 Tk の機能が有効であるインタープリタの総 - : 数に等しい． - - _merge_tklist(str, str, ... ) - : Tcl/Tk のライブラリ関数を使って，引数の文字列がそれぞれ - : 正しく一つのリスト要素となるように連結した文字列を返す． - - _conv_listelement(str) - : Tcl/Tk のライブラリ関数を使って，引数の文字列が Tcl の - : 一つのリスト要素として適切な表現になるように変換した文 - : 字列を返す． - - _toUTF8(str, encoding=nil) - _fromUTF8(str, encoding=nil) - : Tcl/Tk が内蔵している UTF8 変換処理を呼び出す． - - _subst_UTF_backslash(str) - _subst_Tcl_backslash(str) - : Tcl のルールでバックスラッシュ記法 ( \uhhhh による - : Unicode 文字表現を含む ) を解析する． - : _subst_Tcl_backslash はすべてのバックスラッシュ記法を - : 置き換えるのに対し，_subst_UTF_backslash は \uhhhh - : による Unicode 文字表現だけを置き換える． - - encoding_system - encoding_system=(encoding) - : Tcl の system encoding の獲得および設定 - - encoding - encoding=(encoding) - : encoding_system / encoding_system= の alias - : ( Ruby/Tk の tk.rb では置き換えられる予定のもの．) - - -クラス TclTkIp - クラスメソッド - new(ip_name=nil, options='') - : TclTkIp クラスのインスタンスを生成する． - : ip_name に文字列を与えた場合は，それが winfo interps などで - : 表示される名前になる． - : options には，-geometry や -use など，wish のコマンドライン - : 引数として与えるオプションと同様の情報を文字列として与える． - : 与えられた情報は，root widget 生成の際に用いられる． - : ( e.g. TclTkIp.new('FOO', '-geometry 500x200 -use 0x2200009') ) - : もし options に敢えて nil または false を与えた場合，Tk ライ - : ブラリが導入されていない (つまりは Tcl のみの) インタープリ - : タを生成する．この場合は GUI 環境は必要ないため，ウインドウ - : システムが存在しない，または使用できない環境でも Tcl インター - : プリタを生成し，Tcl やその拡張ライブラリを活用することができる． - - インスタンスメソッド - create_slave(name, safe=false) - : レシーバを親とする name という名前のスレーブインタープリタを - : 生成する． - : safe には生成するインタープリタを safe インタープリタとする - : かを指定する．デフォルトは false ということになっているが， - : たとえ明確に false を指定していたとしても，親となるインター - : プリタが safe インタープリタであれば，その設定を引き継いで - : safe インタープリタとして生成される． - - make_safe - : Tcl/Tk インタープリタを safe インタープリタに変更する． - : 戻り値はレシーバであるインタープリタ自身である． - : 失敗した場合は RuntimeError の例外を発生する． - - safe? - : Tcl/Tk インタープリタが safe インタープリタであるかを調べる． - : safe インタープリタであれば true を返す． - - allow_ruby_exit? - : 対象となるインタープリタ上の評価で，ruby の exit 関数または - : Tcl/Tk 上の exit コマンドによって ruby 自体を終了させること - : を許すかどうかを返す． - : 許さない場合は対象のインタープリタだけが終了する． - : マスターインタープリタのデフォルト値は true，スレーブインター - : プリタのデフォルト値は false である． - - allow_ruby_exit=(mode) - : 対象となるインタープリタの allow_ruby_exit? の状態を変更する． - : インタープリタが safe インタープリタの場合は変更が許されない - : (例外を発生)． - - delete - : Tcl/Tk インタープリタを delete する． - : delete されたインタープリタは，以後一切の操作ができなくなり， - : コマンドを送っても例外を発生するようになる． - - deleted? - : Tcl/Tk インタープリタがすでに delete されているかを調べる． - : delete 済みでコマンドを受け付けない状態になっているならば - : true を返す． - - has_mainwindow? - : Tcl/Tk インタープリタにメインウィンドウ (root widget) が - : 存在すれば true を，存在しなければ false を返す． - : インタープリタが既に delete 済みであれば nil を返す． - - restart - : Tcl/Tk インタープリタの Tk 部分の初期化，再起動を行う． - : 一旦 root widget を破壊した後に再度 Tk の機能が必要と - : なった場合に用いる． - - _eval(str) - _invoke(*args) - : Tcl/Tk インタープリタ上で評価を行う． - : _eval は評価スクリプトが一つの文字列であることに対し， - : _invoke は評価スクリプトの token ごとに一つの引数とな - : るように与える． - : _invoke の方は Tcl/Tk インタープリタの字句解析器を用い - : ないため，評価の負荷がより少なくてすむ．ただし，その代 - : わりに auto_load のような機構は働かず，load 等によって - : Tcl/Tk インタープリタ上に既に登録済みのコマンドしか呼 - : び出すことができない． - : _eval では auto_load 機構が働くため，一度 _eval を実行 - : して登録に成功しさえすれば，以降は _invoke でも利用で - : きるようになる． - - _cancel_eval(str) - _cancel_eval_unwind(str) - : (Tcl/Tk8.6 or later) - : Tcl_CancelEval() 関数を呼び出し，eval の実行を打ち切る． - - _toUTF8(str, encoding=nil) - _fromUTF8(str, encoding=nil) - : Tcl/Tk が内蔵している UTF8 変換処理を呼び出す． - - _thread_vwait(var_name) - _thread_tkwait(mode, target) - : スレッド対応の vwait あるいは tkwait 相当のメソッド． - : 通常の vwait あるいは tkwait コマンドと異なるのは，イベン - : トループとは異なるスレッドから呼び出した場合に vwait 等の - : スタックとは独立に条件の成立待ちがなされることである． - : 通常の vwait / tkwait では，vwait / tkwait (1) の待ちの途 - : 中でさらに vwait / tkwait (2) が呼ばれた場合，待ちの対象 - : となっている条件の成立順序がどうあれ，(2)->(1) の順で待ち - : を終了して戻ってくる． - : _thread_vwait / _thread_tkwait は，イベントループのスレッ - : ドで呼ばれた場合は通常の vwait / tkwait と同様に動作する - : が，イベントループ以外のスレッドで呼ばれた場合にはそのス - : レッドを停止させて待ちに入り，条件が成立した時にスレッド - : の実行を再開する．「vwait 等の待ちスタックとは独立」とい - : う意味は，この再開のタイミングが他のスレッドでの待ち状況 - : とは無関係ということである．つまり，イベントループ等の他 - : のスレッドで vwait 等で待ちの状態にあったとしてもその完了 - : を待つことなく，自らの待ち条件が成立次第，処理を継続する - : ことになる． - - _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 を返す． - : それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ． - - do_one_event - : スレーブ IP の場合には引数のイベントフラグに DONT_WAIT が - : 強制的に追加される (イベント待ちでスリープすることは禁止)． - : それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ． - - 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= - : スレーブ IP の場合には値の設定が許されない (無視される)． - : それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ． - - encoding_table - : Ruby m17n 用に Ruby と Tk との間の encoding 対応表を返す． - -クラス TkCallbackBreak < StandardError -クラス TkCallbackContinue < StandardError - : これらはイベントコールバックにおいて，コールバック処理を適切に中 - : 断したり，次のバインドタグのバインディング処理に進めたりすること - : を可能にするための例外クラスである． - : コールバックで break や continue を実現するためには，コールバック - : である Ruby 手続きが Tcl/Tk インタープリタ側に適切なリターンコー - : ドを返す必要がある．Ruby の手続きが普通に値を返すのでは，それが普 - : 通の戻り値であるのか否かを区別ができないため，例外発生を利用した - : 実装を行っている． - : ただし現在では，コールバック手続きを Ruby の break, next で終了す - : ることで同等の結果を得ることができるようになっている．それゆえ， - : これらは必要ないものではあるが，互換性のために残してある． - -(eof) diff --git a/ext/tk/README.1st b/ext/tk/README.1st deleted file mode 100644 index 4ffef34f1d..0000000000 --- a/ext/tk/README.1st +++ /dev/null @@ -1,19 +0,0 @@ -If you want to use Ruby/Tk (tk.rb and so on), you must have tcltklib.so -which is working correctly. When you have some troubles on compiling, -please read README.tcltklib and README.ActiveTcl. -Even if there is a tcltklib.so on your Ruby library directory, it will not -work without Tcl/Tk libraries (e.g. libtcl8.4.so) on your environment. -You must also check that your Tcl/Tk is installed properly. - --------------------------------------------- - ( the following is written in UTF-8 ) - -Ruby/Tk (tk.rb など) を使いたい場合には，tcltklib.so が正しく動いていな -ければなりません．コンパイル時に何か問題が生じた場合は，README.tcltklib -や README.ActiveTcl を見てください． -たとえ Ruby のライブラリディレクトリに tcltklib.so が存在していたとして -も，実行環境に Tcl/Tk ライブラリ (libtcl8.4.so など) がなければ機能しま -せん．Tcl/Tk が正しくインストールされているかもチェックしてください． - -========================================================== - Hidetoshi NAGAI (nagai@ai.kyutech.ac.jp) diff --git a/ext/tk/README.ActiveTcl b/ext/tk/README.ActiveTcl deleted file mode 100644 index 990f612648..0000000000 --- a/ext/tk/README.ActiveTcl +++ /dev/null @@ -1,62 +0,0 @@ -ActiveTcl is ActiveState's quality-assured distribution of Tcl. - -# see <http://www.activestate.com/Products/ActiveTcl/> -# <http://www.tcl.tk/> - -First of all, please try to configure without any options. -"extconf.rb" searches ActiveTcl as default action. -If you have ActiveTcl and standard (or your own) Tcl/Tk on your -environment and don't want to use ActiveTcl on your Ruby/Tk, please -use --without-ActiveTcl option. - -When "extconf.rb" fails to find your ActiveTcl libraries, please try -the followings. - -If you want to use ActiveTcl binary package as the Tcl/Tk libraries, -please use the following configure options. - - --with-ActiveTcl=<ActiveTcl_root> - ( When without argument; no <ActiveTcl_root>; only '--with-ActiveTcl', - it same to '--with-ActiveTcl=/opt/ActiveTcl*/lib' ) - - --with-tcl-dir=<ActiveTcl_root> - --with-tk-dir=<ActiveTcl_root> - -And use the followings if you need. - - --with-tcllib=<libname> - --with-tklib=<libname> - --enable-tcltk-stubs - -For example, when you install ActiveTcl-8.4.x to '/usr/local/ActiveTcl', - - configure --with-tcl-dir=/usr/local/ActiveTcl/ \ - --with-tk-dir=/usr/local/ActiveTcl/ \ - --with-tcllib=tclstub8.4 \ - --with-tklib=tkstub8.4 \ - --enable-tcltk-stubs - -It depends on your environment that you have to add the directory of -ActiveTcl's libraries to your library path when execute Ruby/Tk. -One of the way is to add entries to TCLLIBPATH environment variable, -and one of the others add to LD_LIBRARY_PATH environment variable - -Probably, using TCLLIBPATH is better. The value is appended at the -head of Tcl's 'auto_path' variable. You can see the value of the -variable by using 'Tk::AUTO_PATH.value' or 'Tk::AUTO_PATH.list'. - -For example, on Linux, one of the ways is to use LD_LIBRARY_PATH -environment variable. -------------------------------------------------------------------------- - [bash]$ LD_LIBRARY_PATH=/usr/local/ActiveTcl/lib:$LD_LIBRARY_PATH \ - ruby your-Ruby/Tk-script - - [bash]$ LD_LIBRARY_PATH=/usr/local/ActiveTcl/lib:$LD_LIBRARY_PATH irb -------------------------------------------------------------------------- -Based on it, the Tcl interpreter changes auto_path variable's value. - -Then, you'll be able to use Tcl/Tk extension libraries included in the -ActiveTcl package (e.g. call TkPackage.require('BWidget'), and then, -use functions/widgets of BWidget extension). - - Hidetoshi NAGAI (nagai@ai.kyutech.ac.jp) diff --git a/ext/tk/README.fork b/ext/tk/README.fork deleted file mode 100644 index c58d75883b..0000000000 --- a/ext/tk/README.fork +++ /dev/null @@ -1,34 +0,0 @@ -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. - -# If do fork and exec(<new Ruby/Tk>) on the child process, you can -# control Ruby/Tk interpreter on the child process by 'send' command -# of Tcl/Tk. About this, please see Tk.appsend and Tk.rb_appsend, or -# 'remote-tk.rb' and the sample 'sample/remote-ip_sample.rb'. - -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/05/22 Hidetoshi NAGAI diff --git a/ext/tk/README.macosx-aqua b/ext/tk/README.macosx-aqua deleted file mode 100644 index d727c01a19..0000000000 --- a/ext/tk/README.macosx-aqua +++ /dev/null @@ -1,67 +0,0 @@ - - *** for MacOS X Aqua (Tcl/Tk Aqua) users *** - -First of all, please read README.tcltklib to use Tcl/Tk Aqua Framework. - -With Tcl/Tk Aqua libraries, current tcltklib sometimes freezes when -using Aqua specific dialogs (e.g. Tk.messageBox). -This is a known bug of Ruby-1.8.4 release. - -When you meet the trouble on your GUI, you'll be able to avoid the trouble -by Tcl/Tk's traditional dialogs. -If you want to do that, please call some of the following bits of script -after "require 'tk'". - -================================================================= -# use a traditional dialog for Tk.chooseColor() -Tk.ip_eval(<<'EOS') - proc ::tk_chooseColor {args} { - return [eval tk::dialog::color:: $args] - } -EOS - -# use a traditional dialog for Tk.getOpenFile() and Tk.getMultipleOpenFile() -Tk.ip_eval(<<'EOS') - proc ::tk_getOpenFile {args} { - if {$::tk_strictMotif} { - return [eval tk::MotifFDialog open $args] - } else { - return [eval ::tk::dialog::file:: open $args] - } - } -EOS - -# use a traditional dialog for Tk.getSaveFile() and Tk.getMultipleSaveFile() -Tk.ip_eval(<<'EOS') - proc ::tk_getSaveFile {args} { - if {$::tk_strictMotif} { - return [eval tk::MotifFDialog save $args] - } else { - return [eval ::tk::dialog::file:: save $args] - } - } -EOS - -# use a traditional dialog for Tk.messageBox() -Tk.ip_eval(<<'EOS') - proc ::tk_messageBox {args} { - return [eval tk::MessageBox $args] - } -EOS - -# use a traditional dialog for Tk.chooseDirectory() -Tk.ip_eval(<<'EOS') - proc ::tk_chooseDirectory {args} { - return [eval ::tk::dialog::file::chooseDir:: $args] - } -EOS -================================================================= - -Each of them replaces the platform specific dialog command to the -traditional one. - -If you use some MultiTkIp objects, probably, you'll have to call the -bits of script for each MultiTkIp object. - --- -Hidetoshi NAGAI (nagai@ai.kyutech.ac.jp) diff --git a/ext/tk/README.tcltklib b/ext/tk/README.tcltklib deleted file mode 100644 index da343a4f3e..0000000000 --- a/ext/tk/README.tcltklib +++ /dev/null @@ -1,152 +0,0 @@ -To compile 'tcltklib', you must have Tcl/Tk libraries on your environment. -Although 'extconf.rb' script searches Tcl/Tk libraries and header files -(as default, searches tclConfig.sh/tkConfig.sh and use the defintions on -those; ActiveTcl has high priority on searching unless --without-ActiveTcl), -sometimes fails to find them. And then, 'tcltklib' cannot be compiled. If -Tcl/Tk libraries or header files are installed but are not found, you can -give the information by arguments of the 'configure' script. Please give -some or all of the following options. - - --with-tk-old-extconf use old "extconf.rb" (default: false). - If current extconf.rb doesn't work properly - (or your install process is based on old - documant about Ruby/Tk install), please try - this option. - - --with-ActiveTcl / --without-ActiveTcl - --with-ActiveTcl=<dir> search ActiveTcl libraries (default: true). - When true, try to find installed ActiveTcl. - When <dir> is given, use it as the ActiveTcl's - top directory (use <dir>/lib, and so on). - Old "extconf.rb" doesn't support this option. - - --with-tk-shlib-search-path=<paths> - teach the paths for loading shared-libraries - to linker. - <paths> is a path list with the same format - as PATH environment variable. - This option may be experimental. - Old "extconf.rb" doesn't support this option. - - --with-tcltkversion=<version> - --with-tcltkversion=<tclversion>,<tkversion> - force version of Tcl/Tk library - (e.g. libtcl8.4g.so & libtk8.4g.so ==> --with-tcltkversion=8.4g - libtcl8.4.so & libtk8.4g.so ==> --with-tcltkversion=8.4,8.4g) - - --enable-tcl-h-ver-check/--disable-tcl-h-ver-check - --enable-tk-h-ver-check/--disable-tk-h-ver-check - enable or disable for checking MAJOR_VERSION and - MINOR_VERSION on tcl.h/tk.h whether match with - Tcl/Tk libraries' version or not. - - --with-tcl-build-dir=<dir> - --with-tk-build-dir=<dir> If you want to compile with libraries on Tcl/Tk - build dir (still NOT installed), you must use - these options. - (e.g. --with-tcl-build-dir=./build/tcl8.5.9/unix) - When use these options, --with-tclConfig-dir and - --with-tkConfig-dir options are ignored (however, - --with-tclConfig-file and --with-tkConfig-file - options are still available). - - --with-tclConfig-file=<file>/--without-tclConfig-file - --with-tkConfig-file=<file>/--without-tkConfig-file - file path of tclConfig.sh/tkConfig.sh, or don't - refer those. - If you want use non-standard filenames of config - files (e.g. tclConfig-static.sh), you must use - these options. - - --with-tclConfig-dir=<dir> - --with-tkConfig-dir=<dir> the directory contains 'tclConfig.sh' and - 'tkConfig.sh'. - Current "extconf.rb" uses the information - on tclConfig.sh/tkConfig.rb, if possible. - Old "extconf.rb" doesn't support this option. - - --with-tcllib=<libname> (e.g. libtcl8.4.so ==> --with-tcllib=tcl8.4) - --with-tklib=<libname> (e.g. libtk8.4.so ==> --with-tklib=tk8.4) - - --enable-tcltk-stubs (if you force to enable stubs) - On old "extconf.rb", default is false. - On current "extconf.rb", default is true when - tclConfig.sh/tkConfig.sh have TCL_STUB_LIB_SPEC - /TK_STUB_LIB_SPEC, else default is false. - - --with-tcl-dir=<path> - equal to "--with-tcl-include=<path>/include --with-tcl-lib=<path>/lib" - - --with-tk-dir=<path> - equal to "--with-tk-include=<path>/include --with-tk-lib=<path>/lib" - - --with-tcl-include=<dir> the directory contains 'tcl.h' - --with-tk-include=<dir> the directory contains 'tk.h' - - --with-tcl-lib=<dir> the directory contains 'libtcl<version>.so' - --with-tk-lib=<dir> the directory contains 'libtk<version>.so' - - --enable-mac-tcltk-framework (MacOS X) use Tcl/Tk framework - (Obsolete. Please use '--enable-tcltk-framework'.) - - --enable-tcltk-framework use Tcl/Tk framework - - --with-tcltk-framework=<dir> the directory contains Tcl/Tk framework; - "<dir>/Tcl.framework" and "<dir>/Tk.framework". - When this option is given, it is assumed that - --enable-tcltk-framework option is given also. - - --with-tcl-framework-dir=<dir> - Tcl framework directory (e.g. "/Library/Frameworks/Tcl.framework") - - --with-tk-framework-dir=<dir> - Tk framework directory (e.g. "/Library/Frameworks/Tk.framework") - - --with-tcl-framework-header=<dir> - Tcl framework headers directory - (e.g. "/Library/Frameworks/Tcl.framework/Headers") - - --with-tk-framework-header=<dir> - Tk framework headers directory - (e.g. "/Library/Frameworks/Tk.framework/Headers") - - - --with-X11 / --without-X11 use / not use the X Window System - - --with-X11-dir=<path> - equal to "--with-X11-include=<path>/include --with-X11-lib=<path>/lib" - - --with-X11-include=<dir> the directory contais X11 header files - --with-X11-lib=<dir> the directory contais X11 libraries - - -If you forgot to give the options when do 'configure' on toplevel -directory of Ruby sources, please try something like as the followings. - - $ cd ext/tcltklib - $ rm Makefile - $ CONFIGURE_ARGS='--with-tcl-include=/usr/local/include/tcl8.4/ --with-tcllib=tcl8.4 --with-tklib=tk8.4' ruby extconf.rb - - - *** ATTENTION *** -When your Tcl/Tk libraries are compiled with "pthread support", -Ruby/Tk may cause "Hang-up" or "Segmentation Fault" frequently. -If you have such a trouble, please try to use the '--enable-pthread' -option of the 'configure' command and re-compile Ruby sources. -It may help you to avoid this trouble. The following configure -options may be useful. - - --enable-tcl-thread/--disable-tcl-thread - --with-tclConfig-file=<path of 'tclConfig.sh'> - --with-tkConfig-file=<path of 'tkConfig.sh'> - -It is not need that 'tclConfig.sh' is a normal Tcl/Tk's tclConfig.sh. -But the file is expected to include the line "TCL_THREADS=0" or "...=1". -When no "TCL_THREADS=?" line, if Tcl version is 7.x or 8.0 which is -given by "TCL_MAJOR_VERSION=?" line and "TCL_MINOR_VERSION=?" line, -then --disable-tcl-thread is expected. Else, ignore the 'tclConfig.sh'. -If --enable-tcl-thread or --disable-tcl-thread option is given, then ---with-tclConfig-file option is ignored. - -========================================================== - Hidetoshi NAGAI (nagai@ai.kyutech.ac.jp) diff --git a/ext/tk/config_list.in b/ext/tk/config_list.in deleted file mode 100644 index 143a7b5df6..0000000000 --- a/ext/tk/config_list.in +++ /dev/null @@ -1,41 +0,0 @@ -############################################## -# configure options for Ruby/Tk -# release date: 2011-06-05 -############################################## -with tk-old-extconf -with ActiveTcl -with tk-shlib-search-path -enable tcltk-stubs -with tcltkversion -enable tcl-h-ver-check -enable tk-h-ver-check -with tcl-build-dir -with tk-build-dir -with tcl-config -with tk-config -with tclConfig-dir -with tkConfig-dir -with tclConfig-file -with tkConfig-file -with tcllib -with tklib -with tcl-dir -with tk-dir -with tcl-include -with tk-include -with tcl-lib -with tk-lib -enable mac-tcltk-framework -enable tcltk-framework -with tcltk-framework -with tcl-framework-dir -with tk-framework-dir -with tcl-framework-header -with tk-framework-header -with X11 -with X11-dir -with X11-include -with X11-lib -enable pthread -enable tcl-thread -enable space-on-tk-libpath diff --git a/ext/tk/depend b/ext/tk/depend deleted file mode 100644 index ddbd46ae27..0000000000 --- a/ext/tk/depend +++ /dev/null @@ -1,28 +0,0 @@ -# AUTOGENERATED DEPENDENCIES START -stubs.o: $(RUBY_EXTCONF_H) -stubs.o: $(arch_hdrdir)/ruby/config.h -stubs.o: $(hdrdir)/ruby/backward.h -stubs.o: $(hdrdir)/ruby/defines.h -stubs.o: $(hdrdir)/ruby/intern.h -stubs.o: $(hdrdir)/ruby/missing.h -stubs.o: $(hdrdir)/ruby/ruby.h -stubs.o: $(hdrdir)/ruby/st.h -stubs.o: $(hdrdir)/ruby/subst.h -stubs.o: $(top_srcdir)/include/ruby.h -stubs.o: stubs.c -stubs.o: stubs.h -tcltklib.o: $(RUBY_EXTCONF_H) -tcltklib.o: $(arch_hdrdir)/ruby/config.h -tcltklib.o: $(hdrdir)/ruby/backward.h -tcltklib.o: $(hdrdir)/ruby/defines.h -tcltklib.o: $(hdrdir)/ruby/encoding.h -tcltklib.o: $(hdrdir)/ruby/intern.h -tcltklib.o: $(hdrdir)/ruby/missing.h -tcltklib.o: $(hdrdir)/ruby/oniguruma.h -tcltklib.o: $(hdrdir)/ruby/ruby.h -tcltklib.o: $(hdrdir)/ruby/st.h -tcltklib.o: $(hdrdir)/ruby/subst.h -tcltklib.o: $(top_srcdir)/include/ruby.h -tcltklib.o: stubs.h -tcltklib.o: tcltklib.c -# AUTOGENERATED DEPENDENCIES END diff --git a/ext/tk/extconf.rb b/ext/tk/extconf.rb deleted file mode 100644 index cb131f07b1..0000000000 --- a/ext/tk/extconf.rb +++ /dev/null @@ -1,2098 +0,0 @@ -# frozen_string_literal: false -############################################################## -# extconf.rb for tcltklib -# release date: 2010-07-30 -############################################################## -require 'mkmf' - -TkLib_Config = {} -TkLib_Config['search_versions'] = - # %w[8.9 8.8 8.7 8.6 8.5 8.4 8.3 8.2 8.1 8.0 7.6 4.2] - # %w[8.7 8.6 8.5 8.4 8.3 8.2 8.1 8.0] - # %w[8.7 8.6 8.5 8.4 8.0] # to shorten search steps - %w[8.6 8.5 8.4] - -TkLib_Config['unsupported_versions'] = - %w[8.8 8.7] - -TkLib_Config['major_nums'] = '87' - - -############################################################## - -TkLib_Config['enable-shared'] = enable_config("shared") - - -############################################################## -# use old extconf.rb ? -############################################################## -if with_config('tk-old-extconf') - require File.join(File.dirname(__FILE__), 'old-extconf.rb') - exit -end - - -############################################################## -# check configs -############################################################## -($cleanfiles ||= "") << 'config_list' -config_list_file = 'config_list' -config_list_file_source = File.join(File.dirname(__FILE__),'config_list.in') -if !File.exist?(config_list_file) || - File.ctime(config_list_file_source) > File.ctime(config_list_file) - old_config_list_file = config_list_file_source -else - old_config_list_file = config_list_file -end - -current_configs = {'with'=>{}, 'enable'=>{}} - -# setup keys by config_list.in -IO.foreach(config_list_file_source){|line| - line.chomp! - line.lstrip! - next if line.empty? || line =~ /^\#/ # - mode, key, value = line.split(/\s+/, 3) - value ||= "" - current_configs[mode][key] = value rescue nil -} - -# define current value of keys -IO.foreach(old_config_list_file){|line| - line.chomp! - line.lstrip! - next if line.empty? || line =~ /^\#/ # - mode, key, value = line.split(/\s+/, 3) - value ||= "" - if current_configs[mode] && current_configs[mode].has_key?(key) - current_configs[mode][key] = value - end -} - -update_flag = false -current_configs['with'].each_key{|key| - if (value = with_config(key).to_s) != current_configs['with'][key] - update_flag = true - current_configs['with'][key] = value - end -} -current_configs['enable'].each_key{|key| - if (value = enable_config(key).to_s) != current_configs['enable'][key] - update_flag = true - current_configs['enable'][key] = value - end -} - -# update current_configs -if update_flag || !File.exist?(config_list_file) - open(config_list_file, 'w'){|fobj| - fobj.print("# values of current configure options (generated by extconf.rb)\n"); - ['with', 'enable'].each{|mode| - current_configs[mode].each_key{|key| - fobj.print("#{mode} #{key} #{current_configs[mode][key]}\n") - } - } - } -end - -if update_flag - puts "Configure options for Ruby/Tk may be updated." - puts "So, delete files which depend on old configs." - File.delete(*Dir.glob("*.#{CONFIG['DLEXT']}", File::FNM_CASEFOLD)) - File.delete(*Dir.glob("*.#{$OBJEXT}", File::FNM_CASEFOLD)) - File.delete('Makefile') rescue nil - -else - makefile = 'Makefile' - if File.exist?(makefile) && - File.ctime(config_list_file) > File.ctime(makefile) - # no need to update Makefile - exit - end -end - - -############################################################## -# functions -############################################################## -def is_win32? - /mswin|mingw|cygwin|bccwin/ =~ RUBY_PLATFORM -end - -def is_macosx? - /darwin/ =~ RUBY_PLATFORM -end - -def maybe_64bit? - /64|universal|s390x/ =~ RUBY_PLATFORM -end - -if defined?(Logging.quiet) and Logging.quiet and /--jobserver-fds=/ !~ ENV["MAKEFLAGS"] - def progress(s) - print(s) - end - def newline - end -else - def progress(s) - end - def newline - puts - end -end - -def check_tcltk_version(version) - return [nil, nil] unless version.kind_of? String - - tclver, tkver = version.split(',') - tclver = tclver.strip - return [tclver, tkver.strip] if tkver - - dot = major = minor_dot = minor = plvl_dot = plvl = ext = nil - if tclver =~ /^(\d)(\.?)(\d)(\.?)(\d*)(.*)$/ - major = $1; minor_dot = $2; minor = $3; plvl_dot = $4; plvl = $5; ext = $6 - dot = ! minor_dot.empty? - if plvl_dot.empty? && ! plvl.empty? - minor << plvl - end - elsif tclver =~ /^(\d)(\.?)(\d?)(.*)$/ - major = $1; minor_dot = $2; minor = $3; ext = $4 - dot = ! minor_dot.empty? - else # unknown -> believe user - return [tclver, tkver] - end - - # check Tcl7.6 / Tk4.2 ? - if major == "7" # Tcl7.6 ( not support Tclversion < 7.6 ) - # Tk4.2 - tkver = "4" + ((dot)? ".": "") + ((minor.empty)? "": "2") + ext - elsif major == "4" # Tk4.2 ( not support Tkversion < 4.2 ) - # Tcl7.6 - tkver = tclver - tclver = "7" + ((dot)? ".": "") + ((minor.empty)? "": "6") + ext - end - - tkver = tclver unless tkver - - [tclver, tkver] -end - -def get_shlib_versions(major = 8, minor_max = 9, minor_min = 0, ext = "") - if tclcfg = TkLib_Config["tclConfig_info"] - major = tclcfg['TCL_MAJOR_VERSION'].to_i - minor_min = tclcfg['TCL_MINOR_VERSION'].to_i - - elsif TkLib_Config["tcltkversion"] - tclver, tkver = TkLib_Config["tcltkversion"] - if tclver =~ /8\.?(\d)(.*)/ - minor_min = $1.to_i - ext = $2 - else - # unsupported version - return [""] - end - end - - # if disable-stubs, version is fixed. - minor_max = minor_min unless TkLib_Config["tcltk-stubs"] - - vers = [] - minor_max.downto(minor_min){|minor| - vers << "#{major}.#{minor}#{ext}" unless ext.empty? - vers << "#{major}.#{minor}" - } - - vers << "" -end - -def get_shlib_path_head - path_head = [] - path_dirs = [] - - if TkLib_Config["ActiveTcl"].kind_of?(String) # glob path - # path_head << TkLib_Config["ActiveTcl"] - path_head.concat Dir.glob(TkLib_Config["ActiveTcl"], File::FNM_CASEFOLD).sort.reverse - # path_dirs.concat Dir.glob(File.join(TkLib_Config["ActiveTcl"], 'lib'), File::FNM_CASEFOLD).sort.reverse - end - - if CROSS_COMPILING - elsif is_win32? - if TkLib_Config["ActiveTcl"] - path_head.concat ["c:/ActiveTcl", "c:/Program Files/ActiveTcl", - "c:/Program Files (x86)/ActiveTcl"] - end - path_head.concat [ - "c:/Tcl", "c:/Program Files/Tcl", "c:/Program Files (x86)/Tcl", - "/Tcl", "/Program Files/Tcl", "/Program Files (x86)/Tcl" - ] - path_head.uniq! - #path_head.each{|dir| path_dirs << dir.dup if File.directory? dir} - path_head.each{|dir| path_dirs << File.expand_path(dir) if File.directory? dir} - - # for MinGW - ["/usr/local/lib64", "/usr/lib64", "/usr/local/lib", "/usr/lib"].each{|dir| - #path_dirs << dir if File.directory? dir - path_dirs << File.expand_path(dir) if File.directory? dir - } - path_dirs |= ENV['LIBRARY_PATH'].split(';').find_all{|dir| File.directory? dir}.map{|dir| File.expand_path(dir)} if ENV['LIBRARY_PATH'] - path_dirs |= ENV['PATH'].split(';').find_all{|dir| File.directory? dir}.map{|dir| File.expand_path(dir)} if ENV['PATH'] - - else - [ - '/opt', '/pkg', '/share', - '/usr/local/opt', '/usr/local/pkg', '/usr/local/share', '/usr/local', - '/usr/opt', '/usr/pkg', '/usr/share', '/usr/contrib', '/usr' - ].each{|dir| - next unless File.directory?(dir) - - path_dirs << "#{dir}/lib64" if maybe_64bit? - path_dirs << "#{dir}/lib" - path_dirs << "#{dir}" unless Dir.glob("#{dir}/lib*.*", File::FNM_CASEFOLD).empty? - - dirnames = [] - if TkLib_Config["ActiveTcl"] - dirnames.concat ["ActiveTcl"] - end - dirnames.concat ["TclTk","Tcl_Tk","Tcl-Tk"] - - dirnames.each{|name| - path_dirs << "#{dir}/#{name}" if File.directory?("#{dir}/#{name}") - path_head << "#{dir}/#{name}" unless Dir.glob("#{dir}/#{name}[-89_]*", File::FNM_CASEFOLD).empty? - } - } - end - - unless TkLib_Config["space-on-tk-libpath"] - path_head.delete_if{|path| path =~ / /} - path_dirs.delete_if{|path| path =~ / /} - end - - [path_head, path_dirs] -end - -def find_macosx_framework - use_framework = is_macosx? && TkLib_Config["ActiveTcl"] - - use_framework ||= (tcl_hdr = with_config("tcl-framework-header")) - use_framework ||= (tk_hdr = with_config("tk-framework-header")) - tcl_hdr = nil unless tcl_hdr.kind_of? String - tk_hdr = nil unless tk_hdr.kind_of? String - TkLib_Config["tcl-framework-header"] = tcl_hdr - TkLib_Config["tk-framework-header"] = tk_hdr - - use_framework ||= (tcl_dir = with_config("tcl-framework-dir")) - tcl_dir = nil unless tcl_dir.kind_of? String - if !tcl_dir && tcl_hdr - # e.g. /Library/Frameworks/Tcl.framework/Headers - # ==> /Library/Frameworks/Tcl.framework - tcl_dir = File.dirname(tcl_hdr.strip.chomp('/')) - end - TkLib_Config["tcl-framework-dir"] = tcl_dir - - use_framework ||= (tk_dir = with_config("tk-framework-dir")) - tk_dir = nil unless tk_dir.kind_of? String - if !tk_dir && tk_hdr - # e.g. /Library/Frameworks/Tk.framework/Headers - # ==> /Library/Frameworks/Tk.framework - tk_dir = File.dirname(tk_hdr.strip.chomp('/')) - end - TkLib_Config["tk-framework-dir"] = tk_dir - - if tcl_dir && !tk_dir - tk_dir = File.join(File.dirname(tcl_dir), 'Tk.framework') - TkLib_Config["tk-framework-dir"] = tk_dir - elsif !tcl_dir && tk_dir - tcl_dir = File.join(File.dirname(tk_dir), 'Tcl.framework') - TkLib_Config["tcl-framework-dir"] = tcl_dir - end - if tcl_dir && tk_dir - TkLib_Config["tcltk-framework"] = File.dirname(tcl_dir) unless TkLib_Config["tcltk-framework"] - return [tcl_dir, tk_dir] - end - - # framework is disabled? - if with_config("tcltk-framework") == false || - enable_config("tcltk-framework") == false - return false - end - - use_framework ||= (framework_dir = with_config("tcltk-framework")) - if framework_dir.kind_of? String - TkLib_Config["tcltk-framework"] = framework_dir.strip.chomp('/') - return [File.join(TkLib_Config["tcltk-framework"], 'Tcl.framework'), - File.join(TkLib_Config["tcltk-framework"], 'Tk.framework')] - end - - unless enable_config("tcltk-framework", use_framework) || - enable_config("mac-tcltk-framework", use_framework) - TkLib_Config["tcltk-framework"] = false - return false - end - - paths = [ - #"~/Library/Frameworks", - "/Library/Frameworks", - "/Network/Library/Frameworks", "/System/Library/Frameworks" - ] - paths.reverse! unless TkLib_Config["ActiveTcl"] # system has higher priority - - paths.map{|dir| dir.strip.chomp('/')}.each{|dir| - next unless File.exist?(File.join(dir, "Tcl.framework", "Headers")) - next unless File.directory?(tcldir = File.join(dir, "Tcl.framework")) - next unless File.exist?(File.join(dir, "Tk.framework", "Headers")) - next unless File.directory?(tkdir = File.join(dir, "Tk.framework")) - TkLib_Config["tcltk-framework"] = dir - return [tcldir, tkdir] - } - - nil -end - -def collect_tcltk_defs(tcl_defs_str, tk_defs_str) - conflicts = [ - 'PACKAGE_NAME', 'PACKAGE_TARNAME', 'PACKAGE_VERSION', - 'PACKAGE_STRING', 'PACKAGE_BUGREPORT' - ] - - begin - # Ruby 1.9.x or later - arch_config_h = RbConfig.expand($arch_hdrdir + "/ruby/config.h") - if File.exist?(arch_config_h) - keys = [] - IO.foreach(arch_config_h){|line| - if line =~ /^#define +([^ ]+)/ - keys << $1 - end - } - conflicts = keys - end - rescue - # ignore, use default - end - - if tcl_defs_str - tcl_defs = tcl_defs_str.split(/(?:\A|\s)\s*-D/).map{|s| - s =~ /^([^=]+)(.*)$/ - [$1, $2] - } - else - tcl_defs = [] - end - - if tk_defs_str - tk_defs = tk_defs_str.split(/(?:\A|\s)\s*-D/).map{|s| - s =~ /^([^=]+)(.*)$/ - [$1, $2] - } - else - tk_defs = [] - end - - defs = tcl_defs | tk_defs - - defs.delete_if{|name,value| - conflicts.include?(name) || - ( (vtcl = tcl_defs.assoc(name)) && (vtk = tk_defs.assoc(name)) && - vtcl != vtk ) - } - - defs.map{|ary| /\S/ =~ (s = ary.join('')) and "-D" << s.strip}.compact -end - -def parse_tclConfig(file) - # check tclConfig.sh/tkConfig.sh - tbl = Hash.new{|h,k| h[k] = ""} - return tbl unless file - IO.foreach(file){|line| - line.strip! - next if line !~ /^([^\#=][^=]*)=(['"]|)(.*)\2$/ - key, val = $1, $3 - tbl[key] = val.gsub(/\$\{([^}]+)\}/){|s| - subst = $1 - (tbl[subst])? tbl[subst]: s - } rescue nil - } - tbl -end - -def get_libpath(lib_flag, lib_spec) - # get libpath from {TCL,Tk}_LIB_FLAG and {TCL,Tk}_LIB_SPEC - lib_spec.gsub(/(#{lib_flag}|-L)/, "").strip -end - -def get_tclConfig_dirs - config_dir = [] - - if CROSS_COMPILING - elsif is_win32? - if TkLib_Config["ActiveTcl"] - dirs = [] - if TkLib_Config["ActiveTcl"].kind_of?(String) - dirs << File.join(TkLib_Config["ActiveTcl"], 'lib') - end - dirs.concat [ - "c:/ActiveTcl*/lib", "c:/Tcl*/lib", - "c:/Program Files*/ActiveTcl*/lib", "c:/Program Files*/Tcl*/lib", - "/ActiveTcl*/lib", "/Tcl*/lib", - "/Program Files*/ActiveTcl*/lib", "/Program Files*/Tcl*/lib" - ] - else - dirs = [ - "c:/Tcl*/lib", "c:/Program Files*/Tcl*/lib", - "/Tcl*/lib", "/Program Files*/Tcl*/lib" - ] - end - dirs = dirs.collect{|d| Dir.glob(d, File::FNM_CASEFOLD)}.flatten.uniq - - dirs |= ENV['LIBRARY_PATH'].split(';') if ENV['LIBRARY_PATH'] - dirs |= ENV['PATH'].split(';') if ENV['PATH'] - - exeext = RbConfig::CONFIG['EXEEXT'] - ENV['PATH'].split(File::PATH_SEPARATOR).each{|dir| - dir.tr!(File::ALT_SEPARATOR, File::SEPARATOR) if File::ALT_SEPARATOR - next if Dir.glob(File.join(dir, "{tclsh,wish}*#{exeext}"), File::FNM_CASEFOLD).empty? - dirs << File.expand_path(File.join(dir, '..', 'lib')) - dirs << dir - # dirs << File.expand_path(File.join(dir, '..')) - } - - unless TkLib_Config["space-on-tk-libpath"] - dirs.delete_if{|path| path =~ / /} - end - - config_dir.concat(dirs.zip(dirs)) - - else - if framework = find_macosx_framework() - config_dir.unshift(framework) - end - - if activeTcl = TkLib_Config['ActiveTcl'] - # check latest version at first - if is_macosx? - base = File.expand_path(activeTcl) - config_dir << [ - File.join(base, 'Tcl.framework'), File.join(base, 'Tk.framework') - ] - - config_dir << [ - File.join(base, 'Tcl.framework', 'Versions', 'Current'), - File.join(base, 'Tk.framework', 'Versions', 'Current') - ] - - Dir.glob(File.join(base, 'Tcl.framework', - 'Versions', '*')).sort.reverse.each{|dir| - next if dir =~ /Current/ - config_dir << [dir, dir.gsub(/Tcl/, 'Tk')] - } - else - config_dir.concat(Dir.glob(File.join(activeTcl, 'lib'), File::FNM_CASEFOLD).sort.reverse) - end - end - - config_dir << RbConfig::CONFIG['libdir'] - - ((maybe_64bit?)? ['lib64', 'lib']: ['lib']).each{|dir| - config_dir.concat [ - File.join(RbConfig::CONFIG['exec_prefix'], dir), - File.join(RbConfig::CONFIG['prefix'], dir), - "/usr/local/opt/#{dir}", "/usr/local/pkg/#{dir}", - "/usr/local/share/#{dir}", "/usr/local/#{dir}", - "/usr/opt/#{dir}", "/usr/pkg/#{dir}", "/usr/share/#{dir}", - "/usr/contrib/#{dir}", "/usr/#{dir}" - ] - } - - config_dir.concat [ - '/opt', '/pkg', '/share', - '/usr/local/opt', '/usr/local/pkg', '/usr/local/share', '/usr/local', - '/usr/opt', '/usr/pkg', '/usr/share', '/usr/contrib', '/usr' - ].map{|dir| - Dir.glob(dir + "/{tcltk,tcl,tk}[#{TkLib_Config['major_nums']}*/lib", - File::FNM_CASEFOLD) - Dir.glob(dir + "/{tcltk,tcl,tk}[#{TkLib_Config['major_nums']}*", - File::FNM_CASEFOLD) - Dir.glob(dir + '/{tcltk,tcl,tk}/lib', File::FNM_CASEFOLD) - Dir.glob(dir + '/{tcltk,tcl,tk}', File::FNM_CASEFOLD) - }.flatten! - - exeext = RbConfig::CONFIG['EXEEXT'] - ENV['PATH'].split(File::PATH_SEPARATOR).each{|dir| - dir.tr!(File::ALT_SEPARATOR, File::SEPARATOR) if File::ALT_SEPARATOR - next if Dir.glob(File.join(dir, "{tclsh,wish}*#{exeext}"), File::FNM_CASEFOLD).empty? - config_dir << File.expand_path(File.join(dir, '..', 'lib')) - } - - # for MacOS X - paths = [ - #"~/Library/Tcl", - "/Library/Tcl", "/Network/Library/Tcl", "/System/Library/Tcl" - ] - paths.reverse! unless TkLib_Config["ActiveTcl"] - - paths.each{|path| - config_dir << path - config_dir.concat(Dir.glob(File.join(path, '{tcl,tk}*'), File::FNM_CASEFOLD).sort.reverse.find_all{|d| File.directory?(d)}) - } - - paths = [ - #"~/Library/Frameworks", - "/Library/Frameworks", - "/Network/Library/Frameworks", "/System/Library/Frameworks" - ] - paths.reverse! unless TkLib_Config["ActiveTcl"] - - paths.each{|frmwk| - base = File.expand_path(frmwk) - config_dir << [ - File.join(base, 'Tcl.framework'), File.join(base, 'Tk.framework') - ] - - config_dir << [ - File.join(base, 'Tcl.framework', 'Versions', 'Current'), - File.join(base, 'Tk.framework', 'Versions', 'Current') - ] - - Dir.glob(File.join(base, 'Tcl.framework', - 'Versions', '*')).sort.reverse.each{|dir| - next if dir =~ /Current/ - config_dir << [dir, dir.gsub(/Tcl/, 'Tk')] - } - } - end - - config_dir -end - -def get_ext_list() - exts = [CONFIG['DLEXT']] - exts.concat %w(dll) if is_win32? - exts.concat %w(bundle dylib) if is_macosx? - - if TkLib_Config["tcltk-stubs"] || TkLib_Config['enable-shared'] == false - exts.unshift "lib" if is_win32? - exts.unshift "a" - exts.unshift CONFIG['LIBEXT'] - end - - if is_win32? - exts.map!{|ext| [ext.downcase, ext.upcase]}.flatten! - end - - exts -end - -def libcheck_for_tclConfig(tcldir, tkdir, tclconf, tkconf) - tcllib_ok = tklib_ok = false - - if TkLib_Config["tcltk-stubs"] - stub = "stub" - tclfunc = "Tcl_InitStubs" - tkfunc = "Tk_InitStubs" - else - stub = "" - tclfunc = "Tcl_FindExecutable" - tkfunc = "Tk_Init" - end - - incflags = ($INCFLAGS ||= "").dup - libpath = ($LIBPATH ||= []).dup - libs_param = ($libs ||= "").dup - tcllibs = nil - mkmf_param = nil - - tclver, tkver = TkLib_Config["tcltkversion"] - exts = "(" + get_ext_list.join('|') + ")" - - if tclver - tcl_glob = "*tcl#{stub}#{tclver}.*" - tcl_regexp = /^.*(tcl#{stub}#{tclver}.*)\.(#{exts}).*$/ - elsif tclconf - tcl_glob = "*tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}{.,}#{tclconf['TCL_MINOR_VERSION']}*.*" - tcl_regexp = /^.*(tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}(?:\.|)#{tclconf['TCL_MINOR_VERSION']}.*)\.(#{exts}).*$/ - end - if tkver - tk_glob = "*tk#{stub}#{tkver}.*" - tk_regexp = /^.*(tk#{stub}#{tkver}.*)\.(#{exts}).*$/ - elsif tkconf - tk_glob = "*tk#{stub}#{tkconf['TK_MAJOR_VERSION']}{.,}#{tkconf['TK_MINOR_VERSION']}*.*" - tk_regexp = /^.*(tk#{stub}#{tkconf['TK_MAJOR_VERSION']}(?:\.|)#{tkconf['TK_MINOR_VERSION']}.*)\.#{exts}.*$/ - end - - tcllib_ok ||= !tclconf || Dir.glob(File.join(tcldir, tcl_glob), File::FNM_CASEFOLD).find{|file| - if file =~ tcl_regexp - libname = $1 - ext = $2.downcase - begin - $INCFLAGS = incflags.dup << " " << tclconf["TCL_INCLUDE_SPEC"] - #puts "check #{file} #{$1} #{tclfunc} #{tcldir}" - #find_library($1, tclfunc, tcldir) - if (tclconf && tclconf["TCL_SHARED_BUILD"] == "0") || - (ext != CONFIG['DLEXT'] && ext == CONFIG['LIBEXT']) || ext == "a" - # static link - tcllibs = $libs + " -DSTATIC_BUILD " + file.quote - - # FIX ME: avoid pathname trouble (fail to find) on MinGW. - # e.g. TCL_INCLUDE_SPEC describes "-I/usr/local/include", - # but compiler can find "-IC:/msys/1.0/local/include" only. - $INCFLAGS << " -I" << File.join(File.dirname(File.dirname(file)),"include") if is_win32? - else - tcllibs = append_library($libs, libname) - tcllibs = "#{libpathflag([tcldir])} #{tcllibs}" - - # FIX ME: avoid pathname trouble (fail to find) on MinGW. - $INCFLAGS << " -I" << File.join(File.dirname(tcldir),"include") if is_win32? - end - - $LIBPATH = libpath | [tcldir] - try_func(tclfunc, tcllibs, ["tcl.h"]) || - ( try_func(tclfunc, tcllibs << " " << tclconf['TCL_LIBS'], ["tcl.h"]) if tclconf['TCL_LIBS'] ) - - ensure - mkmf_param = { - 'PATH' => file, - 'LIBNAME' => libname, - 'libs' => tcllibs.dup, - 'INCFLAGS' => $INCFLAGS.dup, - 'LIBPATH' => $LIBPATH.dup, - } - $LIBPATH = libpath.dup - $libs = libs_param.dup - end - end - } - tclconf['MKMF_PARAMS'] = mkmf_param if tclconf && tcllib_ok - - tklib_ok ||= !tkconf || Dir.glob(File.join(tkdir, tk_glob), File::FNM_CASEFOLD).find{|file| - if file =~ tk_regexp - libname = $1 - ext = $2.downcase - begin - #puts "check #{file} #{$1} #{tkfunc} #{tkdir}" - # find_library($1, tkfunc, tkdir) - if (tkconf && tkconf["TCL_SHARED_BUILD"] == "0") || - (ext != CONFIG['DLEXT'] && ext == CONFIG['LIBEXT']) || ext == "a" - # static link - tklibs = " -DSTATIC_BUILD " + file.quote - - # FIX ME: avoid pathname trouble (fail to find) on MinGW. - $INCFLAGS << " -I" << File.join(File.dirname(File.dirname(file)),"include") if is_win32? - else - tklibs = append_library("", libname) - #tklibs = append_library("", $1) - tklibs = "#{libpathflag([tkdir])} #{tklibs}" - - # FIX ME: avoid pathname trouble (fail to find) on MinGW. - $INCFLAGS << " -I" << File.join(File.dirname(tcldir),"include") if is_win32? - end - - tklibs << " " << tcllibs if tcllibs - tmp_tklibs = tklibs.dup - $LIBPATH = libpath | [tkdir] - try_func(tkfunc, tklibs, ["tcl.h", "tk.h"]) || - ( try_func(tkfunc, tklibs << " " << tkconf['TK_LIBS'], ["tcl.h", "tk.h"]) if tkconf['TK_LIBS'] ) || - ( try_func(tkfunc, (tklibs = tmp_tklibs.dup) << " " << tkconf['TK_XLIBSW'], ["tcl.h", "tk.h"]) if tkconf['TK_XLIBSW'] ) || - ( try_func(tkfunc, tklibs << " " << tkconf['TK_LIBS'], ["tcl.h", "tk.h"]) if tkconf['TK_LIBS'] ) - - ensure - mkmf_param = { - 'PATH' => file, - 'LIBNAME' => libname, - 'libs' => tklibs.dup, - 'INCFLAGS' => $INCFLAGS.dup, - 'LIBPATH' => $LIBPATH.dup, - } - $LIBPATH = libpath.dup - $libs = libs_param.dup - end - end - } - - $INCFLAGS = incflags.dup - tkconf['MKMF_PARAMS'] = mkmf_param if tkconf && tklib_ok - - [tcllib_ok, tklib_ok] -end - -def search_tclConfig(*paths) # libdir list or [tcl-libdir|file, tk-libdir|file] - TkLib_Config["tclConfig_paths"] = [] - - paths.compact! - if paths.empty? - config_dir = get_tclConfig_dirs - elsif paths.length == 1 && !paths[0][0] && !paths[0][1] - config_dir = get_tclConfig_dirs.map{|dir| - if dir.kind_of? Array - [ (paths[0][0] == false)? nil: dir[0], - (paths[0][1] == false)? nil: dir[1] ] - else - [ (paths[0][0] == false)? nil: dir, - (paths[0][1] == false)? nil: dir ] - end - } - else - # fixed tclConfig - config_dir = [] - paths.each{|path| - if path.kind_of?(Array) - config_dir << path - else - dirs = Dir.glob(path, File::FNM_CASEFOLD) - config_dir.concat(dirs.zip(dirs)) - end - } - end - - tclver, tkver = TkLib_Config['tcltkversion'] - if tclver && tclver =~ /^\D*(\d)\.?(\d)?/ # ignore PATCH_LEVEL - tclver_major = $1 - tclver_minor = $2 - else - tclver_major = nil - tclver_minor = nil - end - if tkver && tkver =~ /^\D*(\d)\.?(\d)?/ # ignore PATCH_LEVEL - tkver_major = $1 - tkver_minor = $2 - else - tkver_major = nil - tkver_minor = nil - end - - conf = nil - progress_flag = false - - config_dir.uniq! - config_dir.map{|dir| - if dir.kind_of? Array - [ (dir[0])? dir[0].strip.chomp('/'): nil, - (dir[1])? dir[1].strip.chomp('/'): nil ] - else - dir.strip.chomp('/') - end - }.each{|dir| - progress("."); progress_flag = true - # print("check #{dir} ==>"); - if dir.kind_of? Array - tcldir, tkdir = dir - else - tcldir = tkdir = dir - end - - tails = ['Config-shared.sh', 'config-shared.sh', 'Config.sh', 'config.sh'] - - if tcldir - if File.file?(tcldir) - tclcfg_files = [tcldir] * tails.length - else - tclcfg_files = tails.map{|f| File.join(tcldir, 'tcl' << f)} - end - else - tclcfg_files = [nil] * tails.length - end - - if tkdir - if File.file?(tkdir) - tkcfg_files = [tkdir] * tails.length - else - tkcfg_files = tails.map{|f| File.join(tkdir, 'tk' << f)} - end - else - tkcfg_files = [nil] * tails.length - end - - tclcfg_files.zip(tkcfg_files).map{|tclpath, tkpath| - [ (tclpath && File.exist?(tclpath))? File.expand_path(tclpath): tclpath, - (tkpath && File.exist?(tkpath))? File.expand_path(tkpath): tkpath ] - }.uniq.each{|tclpath, tkpath| - next if tclpath && !File.exist?(tclpath) - next if tkpath && !File.exist?(tkpath) - - # parse tclConfig.sh/tkConfig.sh - tclconf = (tclpath)? parse_tclConfig(tclpath): nil - if tclconf - if tclver && ((tclver_major && tclver_major != tclconf['TCL_MAJOR_VERSION']) || (tclver_minor && tclver_minor != tclconf['TCL_MINOR_VERSION'])) - print("\n") if progress_flag - puts "Ignore \"#{tclpath}\" (unmatch with configured version)." - progress_flag = false - next - end - if TkLib_Config['unsupported_versions'].find{|ver| ver == "#{tclconf['TCL_MAJOR_VERSION']}.#{tclconf['TCL_MINOR_VERSION']}"} - print("\n") if progress_flag - puts "Ignore \"#{tclpath}\" (unsupported version of Tcl/Tk)." - progress_flag = false - next - end - end - - tkconf = (tkpath)? parse_tclConfig(tkpath): nil - if tkconf - if tkver && ((tkver_major && tkver_major != tkconf['TK_MAJOR_VERSION']) || (tkver_minor && tkver_minor != tkconf['TK_MINOR_VERSION'])) - print("\n") if progress_flag - puts "Ignore \"#{tkpath}\" (unmatch with configured version)." - progress_flag = false - next - end - if TkLib_Config['unsupported_versions'].find{|ver| ver == "#{tkconf['TK_MAJOR_VERSION']}.#{tkconf['TK_MINOR_VERSION']}"} - print("\n") if progress_flag - puts "Ignore \"#{tkpath}\" (unsupported version of Tcl/Tk)." - progress_flag = false - next - end - end - - # nativethread check - if !TkLib_Config["ruby_with_thread"] - if tclconf - if tclconf['TCL_THREADS'] == '1' - puts "\nWARNING: found #{tclpath.inspect}, but it WITH nativethread-support under ruby WITHOUT nativethread-support. So, ignore it." - TkLib_Config["tcl-NG-path"] << File.dirname(tclpath) - next - end - else - puts "\nWARNING: When not refer tclConfig.sh, cannot check native-thread support on Tcl/Tk libraries. Ruby, which is used now, does NOT support native-thread. So, if Tcl/Tk libraries support native-thread, it will NOT work properly." - end - end - - # find tclConfig.sh & tkConfig.sh - conf = [tclconf, tkconf] unless conf - - # check Tcl library - if is_macosx? && TkLib_Config["tcltk-framework"] - # if use framework, not check (believe it is installed properly) - tcllib_ok = tklib_ok = true - else - tcllib_ok, tklib_ok = - libcheck_for_tclConfig((tclpath)? File.dirname(tclpath): nil, - (tkpath)? File.dirname(tkpath): nil, - tclconf, tkconf) - end - - unless tcllib_ok && tklib_ok - unless tcllib_ok - puts "\nWARNING: found #{tclpath.inspect}, but cannot find valid Tcl library for the tclConfig.sh. So, ignore it." - TkLib_Config["tcl-NG-path"] << File.dirname(tclpath) - end - unless tklib_ok - puts "\nWARNING: found #{tkpath.inspect}, but cannot find valid Tk library for the tkConfig.sh. So, ignore it." - TkLib_Config["tk-NG-path"] << File.dirname(tkpath) - end - next - end - - #return [tclpath, tkpath] - # print(" #{[tclpath, tkpath].inspect}"); - TkLib_Config["tclConfig_paths"] << [tclpath, tkpath] - } - - # print("\n"); - } - - if is_macosx? && TkLib_Config["tcltk-stubs"] - CONFIG['LDSHARED'] << " -Xlinker -bind_at_load" - if config_string('LDSHAREDXX') - config_string('LDSHAREDXX') << " -Xlinker -bind_at_load" - end - end - - if TkLib_Config["tclConfig_paths"].empty? - [nil, nil] - else - # find tclConfig.sh and tkConfig.sh - TkLib_Config["tclConfig_info"], TkLib_Config["tkConfig_info"] = conf - TkLib_Config["tclConfig_paths"][0] - end -end - -def get_tclConfig(tclConfig_file, tkConfig_file, tclConfig_dir, tkConfig_dir) - use_tclConfig = tclConfig_file != false && tclConfig_dir != false - use_tkConfig = tkConfig_file != false && tkConfig_dir != false - - unless use_tclConfig || use_tkConfig - puts("Don't use [tclConfig.sh, tkConfig.sh]") - return [nil, nil] - end - - tclConfig_file = nil unless tclConfig_file.kind_of? String - tkConfig_file = nil unless tkConfig_file.kind_of? String - tclConfig_dir = nil unless tclConfig_dir.kind_of? String - tkConfig_dir = nil unless tkConfig_dir.kind_of? String - - if use_tclConfig && !tclConfig_dir - if tclConfig_file - tclConfig_dir = File.dirname(tclConfig_file) - elsif tkConfig_dir - tclConfig_dir = tkConfig_dir - end - end - if use_tkConfig && !tkConfig_dir - if tkConfig_file - tkConfig_dir = File.dirname(tkConfig_file) - elsif tclConfig_dir - tkConfig_dir = tclConfig_dir - end - end - tkConfig_dir ||= tclConfig_dir - - if use_tclConfig - TkLib_Config["tclConfig-file"] = tclConfig_file - TkLib_Config["tclConfig-dir"] = tclConfig_dir - else - tclConfig_file = false - tclConfig_dir = false - end - if use_tkConfig - TkLib_Config["tkConfig-file"] = tkConfig_file - TkLib_Config["tkConfig-dir"] = tkConfig_dir - else - tkConfig_file = false - tkConfig_dir = false - end - - print ("Don't use tclConfig.sh (specified by configure option).\n") unless use_tclConfig - print ("Don't use tkConfig.sh (specified by configure option).\n") unless use_tkConfig - print("Search ") - print("tclConfig.sh", (tclConfig_dir)? " (in #{tclConfig_dir})": "") if use_tclConfig - print((use_tclConfig)? " and ": "", "tkConfig.sh", (tkConfig_dir)? " (in #{tkConfig_dir})": "") if use_tkConfig - print(".") - - if tclConfig_dir || tkConfig_dir || !use_tclConfig || !use_tkConfig - tclConfig, tkConfig = - search_tclConfig([ ((tclConfig_file)? tclConfig_file: tclConfig_dir), - ((tkConfig_file)? tkConfig_file: tkConfig_dir) ]) - else - tclConfig, tkConfig = search_tclConfig() - end - print("\n") - # TclConfig_Info = TkLib_Config["tclConfig_info"] - # TkConfig_Info = TkLib_Config["tkConfig_info"] - - if tclConfig || tkConfig - dirs = TkLib_Config["tclConfig_paths"].map{|tclpath, tkpath| - [ (tclpath)? File.dirname(tclpath): nil, - (tkpath)? File.dirname(tkpath): nil ] - } - dirs |= dirs - puts("Valid [tclConfig.sh, tkConfig.sh] are found in #{dirs.inspect}") - puts("Use [tclConfig.sh, tkConfig.sh] == #{[tclConfig, tkConfig].inspect}") - $LIBPATH ||= [] - $LIBPATH |= [File.dirname(tclConfig)] if tclConfig - $LIBPATH |= [File.dirname(tkConfig)] if tkConfig - #TkLib_Config["tclConfig_paths"].each{|tclcfg, tkcfg| - # $LIBPATH |= [File.dirname(tclcfg)] | [File.dirname(tkcfg)] - #} - else - puts("Fail to find [tclConfig.sh, tkConfig.sh]") - end - - [tclConfig, tkConfig] -end - -def check_tcl_NG_path(path_list) - path_list.find_all{|path| not TkLib_Config["tcl-NG-path"].include?(path) } -end - -def check_tk_NG_path(path_list) - path_list.find_all{|path| not TkLib_Config["tk-NG-path"].include?(path) } -end - -def check_NG_path(path_list) - path_list.find_all{|path| - not (TkLib_Config["tcl-NG-path"].include?(path) && - TkLib_Config["tk-NG-path"].include?(path)) - } -end - -def check_shlib_search_path(paths) - if !paths || paths.empty? - path_list = [] - - #if TkLib_Config["ActiveTcl"] - # path_list.concat Dir.glob(TkLib_Config["ActiveTcl"], File::FNM_CASEFOLD).sort.reverse - #end - if TkLib_Config["ActiveTcl"].kind_of?(String) # glob path - path_list.concat Dir.glob(TkLib_Config["ActiveTcl"], File::FNM_CASEFOLD).sort.reverse - end - - vers = get_shlib_versions - path_head, path_dirs = get_shlib_path_head - - path_list.concat vers.map{|ver| - path_head.map{|head| - if ver.empty? - head + "/lib" - else - dirs = [] - - if Dir.glob(head, File::FNM_CASEFOLD).find{|dir| dir == head} - dirs << head + "/lib" - end - - if !Dir.glob(head + "-*", File::FNM_CASEFOLD).empty? - dirs << head + "-#{ver}/lib" if !Dir.glob(head + "-[89].*", File::FNM_CASEFOLD).empty? - dirs << head + "-#{ver.delete('.')}/lib" if !Dir.glob(head + "-[89][0-9]*", File::FNM_CASEFOLD).empty? - end - - if !Dir.glob(head + "[_-]*", File::FNM_CASEFOLD).empty? - dirs << head + "_#{ver}/lib" if !Dir.glob(head + "_[89].*", File::FNM_CASEFOLD).empty? - dirs << head + "-#{ver}/lib" if !Dir.glob(head + "-[89].*", File::FNM_CASEFOLD).empty? - dirs << head + "_#{ver.delete('.')}/lib" if !Dir.glob(head + "_[89][0-9]*", File::FNM_CASEFOLD).empty? - dirs << head + "-#{ver.delete('.')}/lib" if !Dir.glob(head + "-[89][0-9]*", File::FNM_CASEFOLD).empty? - end - - dirs - end - } - }.flatten! - - path_list.concat path_dirs - - else - # paths is a string with PATH environment style - path_list = paths.split((is_win32?)? ';': ':') - end - - path_list = check_NG_path(path_list) - path_list.map!{|path| path.strip} - - if !CROSS_COMPILING and (is_win32? || is_macosx?) - # exist-dir only - path_list.delete_if{|path| Dir.glob(File.join(path, "*.{a,so,dll,lib}")).empty?} - end - - # keep paths for searching dynamic libs - #$LIBPATH |= path_list - path_list.uniq -end - -def search_vers_on_path(vers, path, *heads) - exts = get_ext_list.join(',') - files = Dir.glob(File.join(path, "*{#{heads.join(',')}}*.{#{exts}}"), File::FNM_CASEFOLD) - vers.find_all{|ver| files.find{|f| f =~ /(#{ver}|#{ver.delete('.')})/} } -end - -def find_tcl(tcllib, stubs, version, *opt_paths) - if TclConfig_Info['MKMF_PARAMS'] - # already checked existence of tcl library based on tclConfig.sh - ($INCFLAGS ||= "") << " " << TclConfig_Info['MKMF_PARAMS']['INCFLAGS'] - $LIBPATH ||= []; $LIBPATH |= TclConfig_Info['MKMF_PARAMS']['LIBPATH'] - ($libs ||= "") << " " << TclConfig_Info['MKMF_PARAMS']['libs'] - return [true, nil, nil, nil] - end - # else, no available tclConfig.sh on the system - - print "Search Tcl library" - - if stubs - func = "Tcl_InitStubs" - lib = "tclstub" - else - func = "Tcl_FindExecutable" - lib = "tcl" - end - - if version && ! version.empty? - versions = [version] - else - versions = TkLib_Config['search_versions'] - end - - default_paths = [] - - default_paths.concat [ - RbConfig::CONFIG['libdir'], - File.join(RbConfig::CONFIG['exec_prefix'], 'lib'), - File.join(RbConfig::CONFIG['prefix'], 'lib'), - "/usr/local/lib", "/usr/pkg/lib", "/usr/contrib/lib", "/usr/lib" - ].find_all{|dir| File.directory?(dir)} unless CROSS_COMPILING - - if TkLib_Config["ActiveTcl"].kind_of?(String) # glob path - default_paths.concat Dir.glob(TkLib_Config["ActiveTcl"]).sort.reverse.map{|d| d << "/lib"} - end - - if !CROSS_COMPILING and is_win32? - default_paths.concat [ - "c:/Tcl/lib","c:/Program Files/Tcl/lib","c:/Program Files (x86)/Tcl/lib", - "/Tcl/lib","/Program Files/Tcl/lib","/Program Files (x86)/Tcl/lib" - ].find_all{|dir| File.directory?(dir)}.map{|dir| File.expand_path(dir)} - - # for MinGW - ["/usr/local/lib64", "/usr/lib64", "/usr/local/lib", "/usr/lib"].each{|dir| - default_paths << File.expand_path(dir) if File.directory? dir - } - - default_paths |= ENV['LIBRARY_PATH'].split(';').find_all{|dir| File.directory? dir}.map{|dir| File.expand_path(dir)} if ENV['LIBRARY_PATH'] - default_paths |= ENV['PATH'].split(';').find_all{|dir| File.directory? dir}.map{|dir| File.expand_path(dir)} if ENV['PATH'] - end - - default_paths |= TkLib_Config["checked_shlib_dirs"] - - unless TkLib_Config["space-on-tk-libpath"] - default_paths.delete_if{|path| path =~ / /} - end - - if (paths = opt_paths.compact).empty? - paths = check_tcl_NG_path(default_paths) - end - - incflags = ($INCFLAGS ||= "").dup - libpath = ($LIBPATH ||= []).dup - libs_param = ($libs ||= "").dup - tcllibs = nil - - exts = "(" + get_ext_list.join('|') + ")" - - paths.map{|path| - lib_w_sufx = lib - begin - $LIBPATH |= [path] - inc = [File.join(File.dirname(path),"include"), File.dirname(path)] - inc.each{|f| $INCFLAGS << " -I" << f } - - if tcllib - print(".") - if have_library(tcllib, func, ["tcl.h"]) - return [true, path, tcllib, nil, *inc] - end - else - sufx_list = ['', 't', 'g', 's', 'x'] - search_vers_on_path(versions, path, lib, 'tcl').find{|ver| - dir_enum = Dir.foreach(path) - no_dot_ver = ver.delete('.') - libnames = ["#{lib}#{ver}", "#{lib}#{no_dot_ver}"] - libnames << "tcl#{ver}" << "tcl#{no_dot_ver}" if lib != "tcl" - libnames.find{|libname| - sufx_list.find{|sufx| - print(".") - dir_enum.map{|fname| - if fname =~ /^.*(#{libname}.*#{sufx})\.(#{exts}).*$/ - [fname, $1, $2] - end - }.compact.find{|fname, lib_w_sufx, ext| - ext.downcase! - if (ext != CONFIG['DLEXT'] && ext == CONFIG['LIBEXT']) || - ext == "a" - # static link - tcllibs = libs_param + " -DSTATIC_BUILD " + fname.quote - else - tcllibs = append_library($libs, lib_w_sufx) - tcllibs = "#{libpathflag([path])} #{tcllibs}" - end - if try_func(func, tcllibs, ["tcl.h"]) - return [true, path, nil, tcllibs, *inc] - end - } - } - } - } - if (!version && (print(".");try_func(func, libs_param, ["tcl.h"]))) - return [true, path, lib_w_sufx, nil, *inc] - end - end - ensure - $LIBPATH = libpath.dup - $libs = libs_param.dup - $INCFLAGS = incflags.dup - end - } - - progress("\n") - [false, nil, nil, nil] -end - -def parse_TK_LIBS(tklibs) - sfx = "lib|shlib|dll|so" - re = /(("|')[^"']+\.(#{sfx})\2|[^"' ]+\.(#{sfx})|-l("|')[^"']+\5|-l[^" ]+)/#' - - tklibs.scan(re).map{|lib,| - if lib =~ /^("|')([^"]+)\.(#{sfx})\1/ - "\"-l#{$2}\"" - elsif lib =~ /([^" ]+)\.(#{sfx})/ - "-l#{$1}" - else - lib - end - }.join(' ') -end - -def find_tk(tklib, stubs, version, *opt_paths) - if TkConfig_Info['MKMF_PARAMS'] - # already checked existence of tcl library based on tkConfig.sh - ($INCFLAGS ||= "") << " " << TkConfig_Info['MKMF_PARAMS']['INCFLAGS'] - $LIBPATH ||= []; $LIBPATH |= TkConfig_Info['MKMF_PARAMS']['LIBPATH'] - ($libs ||= "") << " " << TkConfig_Info['MKMF_PARAMS']['libs'] - return [true, nil, nil, nil] - end - # else, no available tkConfig.sh on the system - - print "Search Tk library" - - if stubs - func = "Tk_InitStubs" - lib = "tkstub" - else - func = "Tk_Init" - lib = "tk" - end - - if version && ! version.empty? - versions = [version] - else - versions = TkLib_Config['search_versions'] - end - - default_paths = [] - - default_paths.concat [ - RbConfig::CONFIG['libdir'], - File.join(RbConfig::CONFIG['exec_prefix'], 'lib'), - File.join(RbConfig::CONFIG['prefix'], 'lib'), - "/usr/local/lib", "/usr/pkg/lib", "/usr/contrib/lib", "/usr/lib" - ].find_all{|dir| File.directory?(dir)} unless CROSS_COMPILING - - if !CROSS_COMPILING and is_win32? - default_paths.concat [ - "c:/Tcl/lib","c:/Program Files/Tcl/lib","c:/Program Files (x86)/Tcl/lib", - "/Tcl/lib","/Program Files/Tcl/lib","/Program Files (x86)/Tcl/lib" - ].find_all{|dir| File.directory?(dir)} - - # for MinGW - ["/usr/local/lib64", "/usr/lib64", "/usr/local/lib", "/usr/lib"].each{|dir| - default_paths << File.expand_path(dir) if File.directory? dir - } - - default_paths |= ENV['LIBRARY_PATH'].split(';').find_all{|dir| File.directory? dir}.map{|dir| File.expand_path(dir)} if ENV['LIBRARY_PATH'] - default_paths |= ENV['PATH'].split(';').find_all{|dir| File.directory? dir}.map{|dir| File.expand_path(dir)} if ENV['PATH'] - end - - default_paths |= TkLib_Config["checked_shlib_dirs"] - - unless TkLib_Config["space-on-tk-libpath"] - default_paths.delete_if{|path| path =~ / /} - end - - if (paths = opt_paths.compact).empty? - paths = check_tk_NG_path(default_paths) - end - - incflags = ($INCFLAGS ||= "").dup - libpath = ($LIBPATH ||= []).dup - libs_param = ($libs ||= "").dup - tcllibs = nil - - exts = "(" + get_ext_list.join('|') + ")" - - paths.map{|path| - lib_w_sufx = lib - begin - $LIBPATH |= [path] - inc = [File.join(File.dirname(path),"include"), File.dirname(path)] - inc.each{|f| $INCFLAGS << " -I" << f } - - if tklib - print(".") - if have_library(tklib, func, ["tcl.h", "tk.h"]) - return [true, path, tklib, nil, *inc] - end - else - sufx_list = ['', 't', 'g', 's', 'x'] - search_vers_on_path(versions, path, lib, 'tk').find{|ver| - dir_enum = Dir.foreach(path) - no_dot_ver = ver.delete('.') - libnames = ["#{lib}#{ver}", "#{lib}#{no_dot_ver}"] - libnames << "tk#{ver}" << "tk#{no_dot_ver}" if lib != "tk" - libnames.find{|libname| - sufx_list.find{|sufx| - print(".") - dir_enum.map{|fname| - if fname =~ /^.*(#{libname}.*#{sufx})\.(#{exts}).*$/ - [fname, $1, $2] - end - }.compact.find{|fname, lib_w_sufx, ext| - if (ext != CONFIG['DLEXT'] && ext == CONFIG['LIBEXT']) || - ext == "a" - # static link - tklibs = libs_param + " -DSTATIC_BUILD " + fname.quote - else - tklibs = append_library($libs, lib_w_sufx) - tklibs = "#{libpathflag([path])} #{tklibs}" - end - if try_func(func, tklibs, ["tcl.h", "tk.h"]) - return [true, path, nil, tklibs, *inc] - end - } - } - } - } - if (!version && (print(".");try_func(func, libs_param, ["tcl.h", "tk.h"]))) - return [true, path, lib_w_sufx, nil, *inc] - end - end - ensure - $LIBPATH = libpath - $libs = libs_param - $INCFLAGS = incflags.dup - end - } - - progress("\n") - [false, nil, nil, nil] -end - -def find_tcltk_library(tcllib, tklib, stubs, tclversion, tkversion, - tcl_opt_paths, tk_opt_paths) - st,path,lib,libs,*inc = find_tcl(tcllib, stubs, tclversion, *tcl_opt_paths) - if !st && TkLib_Config['enable-shared'] == nil - TkLib_Config['enable-shared'] = false - st,path,lib,libs,*inc = find_tcl(tcllib, stubs, tclversion, *tcl_opt_paths) - end - unless st - puts("\n""Warning:: cannot find Tcl library. tcltklib will not be compiled (tcltklib is disabled on your Ruby. That is, Ruby/Tk will not work). Please check configure options.") - return false - else - ($LIBPATH ||= []; $LIBPATH |= [path]) if path - $libs = append_library($libs, lib) if lib - ($libs ||= "") << " " << libs if libs - $INCFLAGS ||= "" - inc.each{|f| $INCFLAGS << " -I" << f} - end - - st,path,lib,libs,*inc = find_tk(tklib, stubs, tkversion, *tk_opt_paths) - if !st && TkLib_Config['enable-shared'] == nil - TkLib_Config['enable-shared'] = false - st,path,lib,libs,*inc = find_tk(tklib, stubs, tkversion, *tk_opt_paths) - end - unless st - puts("\n""Warning:: cannot find Tk library. tcltklib will not be compiled (tcltklib is disabled on your Ruby. That is, Ruby/Tk will not work). Please check configure options.") - return false - else - ($LIBPATH ||= []; $LIBPATH |= [path]) if path - $libs = append_library($libs, lib) if lib && !lib.empty? - ($libs ||= "") << " " << libs if libs - $INCFLAGS ||= "" - inc.each{|f| $INCFLAGS << " -I" << f} - end - - true -end - -def find_tcltk_header(tclver, tkver) - base_dir = [] - - base_dir.concat [ - File.join(RbConfig::CONFIG['prefix'], 'include'), - "/usr/local/include", "/usr/pkg/include", "/usr/contrib/include", - "/usr/include" - ].find_all{|dir| File.directory?(dir)}.map{|dir| File.expand_path(dir)} - - if !CROSS_COMPILING && is_win32? - base_dir.concat [ - "c:/Tcl/include","c:/Program Files/Tcl/include", - "c:/Program Files (x86)/Tcl/include", - "/Tcl/include","/Program Files/Tcl/include", - "/Program Files (x86)/Tcl/include" - ].find_all{|dir| File.directory?(dir)}.map{|dir| File.expand_path(dir)} - - if ENV['CPATH'] - base_dir |= ENV['CPATH'].split(';').find_all{|dir| File.directory?(dir)}.map{|dir| File.expand_path(dir)} - end - end - - base_dir |= TkLib_Config["checked_shlib_dirs"] - - unless TkLib_Config["space-on-tk-libpath"] - base_dir.delete_if{|path| path =~ / /} - end - - # tcl.h - if TclConfig_Info['MKMF_PARAMS'] - # already checked existence of tcl headers based on tclConfig.sh - have_tcl_h = true - else - print "Search tcl.h" - newline - if enable_config("tcl-h-ver-check", true) && - tclver && tclver =~ /^\D*(\d)\.?(\d)/ - major = $1; minor = $2 - else - major = minor = nil - end - progress(".") - if major && minor - # version check on tcl.h - version_check = proc {|code| - code << ("#if TCL_MAJOR_VERSION != #{major} || TCL_MINOR_VERSION != #{minor}\n" \ - "#error VERSION does not match\n" \ - "#endif") - } - else - version_check = nil - end - have_tcl_h = have_header('tcl.h', &version_check) - unless have_tcl_h - if tclver && ! tclver.empty? - versions = [tclver] - else - versions = TkLib_Config['search_versions'] - end - paths = base_dir.dup - (versions + [""]).each{|ver| - paths.concat(base_dir.map{|dir| - [ - dir + '/tcl' + ver, - dir + '/tcl' + ver + '/include', - dir + '/tcl' + ver.delete('.'), - dir + '/tcl' + ver.delete('.') + '/include' - ] - }.flatten) - } - paths = paths.map{|dir| - (File.directory?(dir))? File.expand_path(dir): nil - }.compact.uniq - - if major || minor - version_check = proc {|code| - code << "#if TCL_MAJOR_VERSION != #{major}\n#error MAJOR_VERSION does not match\n#endif\n" if major - code << "#if TCL_MINOR_VERSION != #{minor}\n#error MINOR_VERSION does not match\n#endif\n" if minor - code - } - else - version_check = nil - end - have_tcl_h = paths.find{|path| - progress(".") - inc_opt = " -I#{path.quote}" - if try_header("tcl", inc_opt, &version_check) - ($INCFLAGS ||= "") << inc_opt - true - else - false - end - } - end - progress("\n") - end - - # tk.h - if TkConfig_Info['MKMF_PARAMS'] - # already checked existence of tk headers based on tkConfig.sh - have_tk_h = true - else - print "Search tk.h" - newline - if enable_config("tk-h-ver-check", true) && - tkver && tkver =~ /^\D*(\d)\.?(\d)/ - major = $1; minor = $2 - else - major = minor = nil - end - progress(".") - if major && minor - # version check on tk.h - version_check = proc {|code| - code << ("#if TK_MAJOR_VERSION != #{major} || TK_MINOR_VERSION != #{minor}\n" \ - "#error VERSION does not match\n" \ - "#endif") - } - else - version_check = nil - end - have_tk_h = have_header('tk.h') - unless have_tk_h - if tkver && ! tkver.empty? - versions = [tkver] - else - versions = TkLib_Config['search_versions'] - end - paths = base_dir.dup - (versions + [""]).each{|ver| - paths.concat(base_dir.map{|dir| - [ - dir + '/tk' + ver, - dir + '/tk' + ver + '/include', - dir + '/tk' + ver.delete('.'), - dir + '/tk' + ver.delete('.') + '/include' - ] - }.flatten) - } - paths = paths.map{|dir| - (File.directory?(dir))? File.expand_path(dir): nil - }.compact.uniq - - if major || minor - version_check = proc {|code| - code << "#if TK_MAJOR_VERSION != #{major}\n#error MAJOR_VERSION does not match\n#endif\n" if major - code << "#if TK_MINOR_VERSION != #{minor}\n#error MINOR_VERSION does not match\n#endif\n" if minor - code - } - else - version_check = nil - end - have_tk_h = paths.find{|path| - progress(".") - inc_opt = " -I#{path.quote}" - if try_header(%w'tcl.h tk.h', inc_opt, &version_check) - ($INCFLAGS ||= "") << inc_opt - true - else - false - end - } - end - progress("\n") - end - - puts "Can't find \"tcl.h\"." unless have_tcl_h - puts "Can't find \"tk.h\"." unless have_tk_h - have_tcl_h && have_tk_h -end - -def setup_for_macosx_framework(tclver, tkver) - # use framework, but no tclConfig.sh - unless $LIBS && $LIBS.include?('-framework') - ($LIBS ||= "") << ' -framework Tk -framework Tcl' - end - - if TkLib_Config["tcl-framework-header"] - TclConfig_Info['TCL_INCLUDE_SPEC'][0,0] = - " -I#{TkLib_Config["tcl-framework-header"].quote} " - else - tcl_base = File.join(TkLib_Config["tcltk-framework"], 'Tcl.framework') - if tclver - TclConfig_Info['TCL_INCLUDE_SPEC'] << - " -I#{File.join(tcl_base, 'Versions', tclver, 'Headers').quote} " - end - - TclConfig_Info['TCL_INCLUDE_SPEC'] << File.join(tcl_base, 'Headers') - - unless tclver - dir = Dir.glob(File.join(tcl_base, 'Versions', '*', 'Headers'), - File::FNM_CASEFOLD).sort.reverse[0] - TclConfig_Info['TCL_INCLUDE_SPEC'] << "-I#{dir.quote} " if dir - end - end - - if TkLib_Config["tk-framework-header"] - TkConfig_Info['TK_INCLUDE_SPEC'][0,0] = - " -I#{TkLib_Config["tk-framework-header"].quote} " - else - tk_base = File.join(TkLib_Config["tcltk-framework"], 'Tk.framework') - if tkver - TkConfig_Info['TK_INCLUDE_SPEC'] << - " -I#{File.join(tk_base, 'Versions', tkver, 'Headers').quote} " - end - - TkConfig_Info['TK_INCLUDE_SPEC'] << File.join(tk_base, 'Headers') - - unless tkver - dir = Dir.glob(File.join(tk_base, 'Versions', '*', 'Headers'), - File::FNM_CASEFOLD).sort.reverse[0] - TkConfig_Info['TK_INCLUDE_SPEC'] << "-I#{dir.quote} " if dir - end - end -end - -def find_X11(*opt_paths) - defaults = - [ "/usr/X11*/lib", "/usr/lib/X11*", "/usr/local/X11*", "/usr/openwin/lib" ] - paths = [] - opt_paths.compact.each{|path| paths.concat(Dir.glob(path.strip.chomp('/'), File::FNM_CASEFOLD))} - defaults.compact.each{|path| paths.concat(Dir.glob(path.strip.chomp('/'), File::FNM_CASEFOLD))} - st = find_library("X11", "XOpenDisplay", *paths) - unless st - puts("\n""Warning:: cannot find X11 library. tcltklib will not be compiled (tcltklib is disabled on your Ruby. That is, Ruby/Tk will not work). Please check configure options. If your Tcl/Tk don't require X11, please try --without-X11.") - end - st -end - -def search_X_libraries - use_tkConfig = false - if TkConfig_Info['config_file_path'] - # use definitions on tkConfig.sh - if (/\S/ =~ TkConfig_Info['TK_XINCLUDES'] || - /\S/ =~ TkConfig_Info['TK_XLIBSW']) - use_tkConfig = true - #use_X = true && with_config("X11", ! is_win32?) - use_X = with_config("X11", true) - else - #use_X = false || with_config("X11", false) - use_X = with_config("X11", false) - end - else - # depend on configure options - use_X = with_config("X11", !(is_win32? || TkLib_Config["tcltk-framework"])) - end - - if /\S/ =~ TkConfig_Info['TK_XINCLUDES'] - ($INCFLAGS ||= "") << " " << TkConfig_Info['TK_XINCLUDES'].strip - end - - if use_X - puts("Use X11 libraries (or use TK_XINCLUDES/TK_XLIBSW information on tkConfig.sh).") - x11_idir, x11_ldir = dir_config("X11") - x11_ldir2 = with_config("X11-lib") - unless find_X11(x11_ldir2, x11_ldir) - puts("Can't find X11 libraries. ") - if use_tkConfig && - /\S/ =~ TkConfig_Info['TK_XLIBSW'] - puts("But, try to use TK_XLIBSW information (believe tkConfig.sh).") - ($libs ||= "") << " " << TkConfig_Info['TK_XLIBSW'] << " " - else - puts("So, can't make tcltklib.so which is required by Ruby/Tk.") - exit - end - end - end - - use_X -end - -def pthread_check() - tcl_major_ver = nil - tcl_minor_ver = nil - - # Is tcl-thread given by user ? - case enable_config("tcl-thread") - when true - tcl_enable_thread = true - when false - tcl_enable_thread = false - else - tcl_enable_thread = nil - end - - if TclConfig_Info['config_file_path'] - if tcl_enable_thread == true - puts("\n""Warning: definition of tclConfig.sh is ignored, because --enable-tcl-thread option is given.") - elsif tcl_enable_thread == false - puts("\n""Warning: definition of tclConfig.sh is ignored, because --disable-tcl-thread option is given.") - else - # tcl-thread is unknown and tclConfig.sh is given - if TclConfig_Info['TCL_THREADS'] - tcl_enable_thread = (TclConfig_Info['TCL_THREADS'] == "1") - else - tcl_major_ver = TclConfig_Info['TCL_MAJOR_VERSION'].to_i - tcl_minor_ver = TclConfig_Info['TCL_MINOR_VERSION'].to_i - if tcl_major_ver < 8 || (tcl_major_ver == 8 && tcl_minor_ver == 0) - tcl_enable_thread = false - end - end - - if tcl_enable_thread == nil - # cannot find definition - if tcl_major_ver - puts("\n""Warning: '#{TclConfig_Info['config_file_path']}' doesn't include TCL_THREADS definition.") - else - puts("\n""Warning: '#{TclConfig_Info['config_file_path']}' may not be a tclConfig file.") - end - #tclConfig = false - end - end - end - - if tcl_enable_thread == nil && !TclConfig_Info['config_file_path'] - # tcl-thread is unknown and tclConfig is unavailable - begin - try_run("int main() { exit(0); }") - rescue Exception - # cannot try_run. Is CROSS-COMPILE environment? - puts(%Q'\ -***************************************************************************** -** -** NATIVETHREAD SUPPORT CHECK WARNING: -** -** We cannot check the consistency of nativethread support between -** Ruby and the Tcl/Tk library in your environment (are you perhaps -** cross-compiling?). If nativethread support for these 2 packages -** is inconsistent you may find you get errors when running Ruby/Tk -** (e.g. hangs or segmentation faults). We strongly recommend -** you to check the consistency manually. -** -***************************************************************************** -') - return true - end - end - - if tcl_enable_thread == nil - # tcl-thread is unknown - if try_run(<<EOF) -#include <tcl.h> -int main() { - Tcl_Interp *ip; - ip = Tcl_CreateInterp(); - exit((Tcl_Eval(ip, "set tcl_platform(threaded)") == TCL_OK)? 0: 1); -} -EOF - tcl_enable_thread = true - elsif 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 - end - - # check pthread mode - if (TkLib_Config["ruby_with_thread"]) - $CPPFLAGS ||= "" - - # ruby -> enable - unless tcl_enable_thread - # ruby -> enable && tcl -> disable - puts(%Q'\ -***************************************************************************** -** -** NATIVETHREAD SUPPORT MODE WARNING: -** -** Ruby is compiled with --enable-pthread, but your Tcl/Tk library -** seems to be compiled without nativethread support. Although you can -** create the tcltklib library, this combination may cause errors (e.g. -** hangs or segmentation faults). If you have no reason to keep the -** current nativethread support status, we recommend you reconfigure and -** recompile the libraries so that both or neither support nativethreads. -** -** If you want change the status of nativethread support, please recompile -** Ruby without "--enable-pthread" configure option (If you use Ruby 1.9.x -** or later, you cannot remove this option, because it requires native- -** thread support.) or recompile Tcl/Tk with "--enable-threads" configure -** option (if your Tcl/Tk is later than or equal to Tcl/Tk 8.1). -** -***************************************************************************** -') - end - - # ruby -> enable && tcl -> enable/disable - if tcl_enable_thread - $CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=1' - else - $CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=0' - end - - return true - - else - # ruby -> disable - if tcl_enable_thread - # ruby -> disable && tcl -> enable - puts(%Q'\ -***************************************************************************** -** -** NATIVETHREAD SUPPORT MODE ERROR: -** -** Ruby is not compiled with --enable-pthread, but your Tcl/Tk -** library seems to be compiled with nativethread support. This -** combination may cause frequent hang or segmentation fault -** errors when Ruby/Tk is working. We recommend that you NEVER -** create the library with such a combination of nativethread support. -** -** Please recompile Ruby with the "--enable-pthread" configure option -** or recompile Tcl/Tk with the "--disable-threads" configure option. -** -***************************************************************************** -') - $CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=1' - return false - else - # ruby -> disable && tcl -> disable - $CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=0' - return true - end - end -end - -############################################################## -# main -############################################################## -# check header file -print("check functions.") - -%w"ruby_native_thread_p rb_errinfo rb_safe_level rb_hash_lookup - rb_proc_new rb_obj_untrust rb_obj_taint rb_set_safe_level_force - rb_sourcefile rb_thread_alive_p rb_thread_check_trap_pending - ruby_enc_find_basename -".each do |func| - have_func(func, "ruby.h") - progress(".") -end -progress("\n") - -# check libraries -unless is_win32? - print("check libraries.") - have_library("nsl", "t_open") - progress(".") - have_library("socket", "socket") - progress(".") - have_library("dl", "dlopen") - progress(".") - have_library("m", "log", "math.h") - progress("\n") -end -$CPPFLAGS ||= "" -$CPPFLAGS += ' -D_WIN32' if /cygwin/ =~ RUBY_PLATFORM - -# Does ruby have nativethread ? -TkLib_Config["ruby_with_thread"] = - macro_defined?('HAVE_NATIVETHREAD', '#include "ruby.h"') - - -#--------------------------------------------------- -TclConfig_Info = {} -TkConfig_Info = {} - -# use Tcl/Tk build dir? (has highest priority) -TkLib_Config["tcl-build-dir"] = with_config("tcl-build-dir") -TkLib_Config["tk-build-dir"] = with_config("tk-build-dir") -if TkLib_Config["tcl-build-dir"] - puts("use Tcl build (pre-install) dir \"#{TkLib_Config["tcl-build-dir"]}\"") - TkLib_Config["tcl-build-dir"] = File.expand_path(TkLib_Config["tcl-build-dir"]) - base = File.dirname(TkLib_Config["tcl-build-dir"]) - ($INCFLAGS ||= "") << " -I#{File.join(base, "generic").quote} -I#{TkLib_Config["tcl-build-dir"].quote}" - $LIBPATH ||= []; $LIBPATH |= [TkLib_Config["tcl-build-dir"]] -end -if TkLib_Config["tk-build-dir"] - puts("use Tk build (pre-install) dir \"#{TkLib_Config["tk-build-dir"]}\"") - TkLib_Config["tk-build-dir"] = File.expand_path(TkLib_Config["tk-build-dir"]) - base = File.dirname(TkLib_Config["tk-build-dir"]) - ($INCFLAGS ||= "") << " -I#{File.join(base, "generic").quote} -I#{TkLib_Config["tk-build-dir"].quote}" - $LIBPATH ||= []; $LIBPATH |= [TkLib_Config["tk-build-dir"]] -end - -# check requirement of Tcl/tk version -tcltk_version = with_config("tcltkversion") -TkLib_Config["tcltkversion"] = check_tcltk_version(tcltk_version) - -if TkLib_Config["tcl-build-dir"] - if (cfgfile = with_config("tclConfig-file", Dir.glob(File.join(TkLib_Config["tcl-build-dir"], "tclConfig*.sh"), File::FNM_CASEFOLD)[0])) - TclConfig_Info['config_file_path'] = cfgfile - TkLib_Config["tclConfig_info"] = cfginfo = parse_tclConfig(cfgfile) - if tclver = TkLib_Config["tcltkversion"][0] - TkLib_Config["tcltkversion"][0].sub!(/\d(\.?)\d/, "#{cfginfo['TCL_MAJOR_VERSION']}\\1#{cfginfo['TCL_MINOR_VERSION']}") - else - TkLib_Config["tcltkversion"][0] = "#{cfginfo['TCL_MAJOR_VERSION']}.#{cfginfo['TCL_MINOR_VERSION']}" - end - end -end -if TkLib_Config["tk-build-dir"] - if (cfgfile = with_config("tkConfig-file", Dir.glob(File.join(TkLib_Config["tk-build-dir"], "tkConfig*.sh"), File::FNM_CASEFOLD)[0])) - TkConfig_Info['config_file_path'] = cfgfile - TkLib_Config["tkConfig_info"] = cfginfo = parse_tclConfig(cfgfile) - if TkLib_Config["tcltkversion"][1] - TkLib_Config["tcltkversion"][1].sub!(/\d(\.?)\d/, "#{cfginfo['TK_MAJOR_VERSION']}\\1#{cfginfo['TK_MINOR_VERSION']}") - else - TkLib_Config["tcltkversion"][1] = "#{cfginfo['TK_MAJOR_VERSION']}.#{cfginfo['TK_MINOR_VERSION']}" - end - end -end - -tclver, tkver = TkLib_Config["tcltkversion"] -puts("Specified Tcl/Tk version is #{[tclver, tkver].inspect}") if tclver||tkver - -# use ActiveTcl ? -#if activeTcl = with_config("ActiveTcl") -#if activeTcl = with_config("ActiveTcl", true) -if activeTcl = with_config("ActiveTcl", !(TkLib_Config["tcl-build-dir"] && TkLib_Config["tk-build-dir"])) - puts("Use ActiveTcl libraries (if available).") - unless activeTcl.kind_of? String - # set default ActiveTcl path - if CROSS_COMPILING - elsif is_win32? - activeTcl = 'c:/Tcl*' - elsif is_macosx? - activeTcl = '/Library/Frameworks' - else - activeTcl = '/opt/ActiveTcl*' - end - end -end -TkLib_Config["ActiveTcl"] = activeTcl - -# allow space chars on a libpath -TkLib_Config["space-on-tk-libpath"] = - enable_config("space-on-tk-libpath", ! is_win32?) - -# enable Tcl/Tk stubs? -=begin -if /\S/ =~ TclConfig_Info['TCL_STUB_LIB_SPEC'] && - /\S/ =~ TkConfig_Info['TK_STUB_LIB_SPEC'] - stubs = true - unless (st = enable_config("tcltk-stubs")).nil? - stubs &&= st - end - unless (st = with_config("tcltk-stubs")).nil? - stubs &&= st - end -else - stubs = enable_config("tcltk-stubs") || with_config("tcltk-stubs") -end -=end -stubs = enable_config("tcltk-stubs") || with_config("tcltk-stubs") -if (TkLib_Config["tcltk-stubs"] = stubs) - puts("Compile with Tcl/Tk stubs.") - $CPPFLAGS ||= ""; $CPPFLAGS += ' -DUSE_TCL_STUBS -DUSE_TK_STUBS' -end - -# directory configuration of Tcl/Tk libraries -if TkLib_Config["tcl-build-dir"] - tcl_idir = File.join(File.dirname(TkLib_Config["tcl-build-dir"]),"generic") - tcl_ldir = TkLib_Config["tcl-build-dir"] -else - tcl_idir, tcl_ldir = dir_config("tcl") -end -if TkLib_Config["tk-build-dir"] - tk_idir = File.join(File.dirname(TkLib_Config["tk-build-dir"]),"generic") - tk_ldir = TkLib_Config["tk-build-dir"] -else - tk_idir, tk_ldir = dir_config("tk") -end - -tcl_idir = tk_idir unless tcl_idir -tcl_ldir = tk_ldir unless tcl_ldir -tk_idir = tcl_idir unless tk_idir -tk_ldir = tcl_ldir unless tk_ldir - -TclConfig_Info['TCL_INCLUDE_SPEC'] ||= "" -TkConfig_Info['TK_INCLUDE_SPEC'] ||= "" -TclConfig_Info['TCL_INCLUDE_SPEC'][0,0] = "-I#{tcl_idir.quote} " if tcl_idir -TkConfig_Info['TK_INCLUDE_SPEC'][0,0] = "-I#{tk_idir.quote} " if tk_idir - -# get tclConfig.sh/tkConfig.sh -TkLib_Config["tcl-NG-path"] = [] -TkLib_Config["tk-NG-path"] = [] -tclcfg, tkcfg = - get_tclConfig( - TclConfig_Info['config_file_path'] || with_config("tclConfig-file", true), - TkConfig_Info['config_file_path'] || with_config("tkConfig-file", true), - (TclConfig_Info['config_file_path'])? - File.dirname(TclConfig_Info['config_file_path']) : - with_config("tclConfig-dir", tcl_ldir || true), - (TkConfig_Info['config_file_path'])? - File.dirname(TkConfig_Info['config_file_path']) : - with_config("tkConfig-dir", tk_ldir || true) - ) -TclConfig_Info.merge!(TkLib_Config["tclConfig_info"]) if TkLib_Config["tclConfig_info"] -TkConfig_Info.merge!(TkLib_Config["tkConfig_info"]) if TkLib_Config["tkConfig_info"] -TclConfig_Info['config_file_path'] ||= tclcfg -TkConfig_Info['config_file_path'] ||= tkcfg - -tk_cfg_dir = File.dirname(TkConfig_Info['config_file_path']) rescue nil -tcl_cfg_dir = File.dirname(TclConfig_Info['config_file_path']) rescue nil - -tk_ldir_list = [tk_ldir, tk_cfg_dir].uniq -tcl_ldir_list = [tcl_ldir, tcl_cfg_dir].uniq - -if TkConfig_Info['config_file_path'] - if TkLib_Config["tk-build-dir"] - spec_dir = get_libpath(TkConfig_Info['TK_LIB_FLAG'], TkConfig_Info['TK_BUILD_LIB_SPEC']) - else - spec_dir = get_libpath(TkConfig_Info['TK_LIB_FLAG'], TkConfig_Info['TK_LIB_SPEC']) - end - tk_ldir_list << spec_dir if File.directory?(spec_dir) -end -if TclConfig_Info['config_file_path'] - if TkLib_Config["tcl-build-dir"] - spec_dir = get_libpath(TclConfig_Info['TCL_LIB_FLAG'], TclConfig_Info['TCL_BUILD_LIB_SPEC']) - else - spec_dir = get_libpath(TclConfig_Info['TCL_LIB_FLAG'], TclConfig_Info['TCL_LIB_SPEC']) - end - tcl_ldir_list << spec_dir if File.directory?(spec_dir) -end - -# check tk_shlib_search_path -TkLib_Config["checked_shlib_dirs"] = - check_shlib_search_path(with_config('tk-shlib-search-path')) - -# set TCL_DEFS and TK_DEFS -$CPPFLAGS ||= "" -# $CPPFLAGS += " #{TclConfig_Info['TCL_DEFS']}" -# $CPPFLAGS += " #{TkConfig_Info['TK_DEFS']}" -$defs += collect_tcltk_defs(TclConfig_Info['TCL_DEFS'], TkConfig_Info['TK_DEFS']) - -# MacOS X Frameworks? -if TkLib_Config["tcltk-framework"] - puts("Use MacOS X Frameworks.") - ($LDFLAGS ||= "") << " " << libpathflag([TkLib_Config["tcl-build-dir"]]) if TkLib_Config["tcl-build-dir"] - - libs = '' - if tcl_cfg_dir - TclConfig_Info['TCL_LIBS'] ||= "" - ($INCFLAGS ||= "") << ' ' << TclConfig_Info['TCL_INCLUDE_SPEC'] - libs << ' ' << TclConfig_Info['TCL_LIBS'] - if stubs - if TkLib_Config["tcl-build-dir"] && - /\S/ =~ TclConfig_Info['TCL_BUILD_STUB_LIB_SPEC'] - libs << ' ' << TclConfig_Info['TCL_BUILD_STUB_LIB_SPEC'] - else - libs << ' ' << TclConfig_Info['TCL_STUB_LIB_SPEC'] - end - else - if TkLib_Config["tcl-build-dir"] && - /\S/ =~ TclConfig_Info['TCL_BUILD_LIB_SPEC'] - libs << ' ' << TclConfig_Info['TCL_BUILD_LIB_SPEC'] - else - libs << ' ' << TclConfig_Info['TCL_LIB_SPEC'] - end - end - end - - libs << " " << libpathflag([TkLib_Config["tk-build-dir"]]) if TkLib_Config["tk-build-dir"] - - if tk_cfg_dir - TkConfig_Info['TK_LIBS'] ||= "" - ($INCFLAGS ||= "") << ' ' << TkConfig_Info['TK_INCLUDE_SPEC'] - libs << ' ' << TkConfig_Info['TK_LIBS'] - if stubs - if TkLib_Config["tk-build-dir"] && - /\S/ =~ TclConfig_Info['TK_BUILD_STUB_LIB_SPEC'] - libs << ' ' << TkConfig_Info['TK_BUILD_STUB_LIB_SPEC'] - else - libs << ' ' << TkConfig_Info['TK_STUB_LIB_SPEC'] - end - else - if TkLib_Config["tk-build-dir"] && - /\S/ =~ TclConfig_Info['TK_BUILD_LIB_SPEC'] - libs << ' ' << TkConfig_Info['TK_BUILD_LIB_SPEC'] - else - libs << ' ' << TkConfig_Info['TK_LIB_SPEC'] - end - end - end - $LDFLAGS << ' ' << libs - setup_for_macosx_framework(tclver, tkver) if tcl_cfg_dir && tk_cfg_dir -end - -# name of Tcl/Tk libraries -tklib = with_config("tklib") -tcllib = with_config("tcllib") - -# search X libraries -use_X = search_X_libraries - - -#--------------------------------------------------- -if (TkLib_Config["tcltk-framework"] || - ( find_tcltk_header(tclver, tkver) && - find_tcltk_library(tcllib, tklib, stubs, tclver, tkver, - tcl_ldir_list, tk_ldir_list) ) ) && - (stubs || pthread_check()) - # create Makefile - - # for SUPPORT_STATUS - $INSTALLFILES ||= [] - $INSTALLFILES << ["lib/tkextlib/SUPPORT_STATUS", "$(RUBYLIBDIR)", "lib"] - - # remove harmful definitions. - $defs.delete_if{|x|/^-Du?intptr_t=/ =~ x} - - create_makefile("tcltklib") - - puts "\nFind Tcl/Tk libraries. Make tcltklib.so which is required by Ruby/Tk." -else - puts "\nCan't find proper Tcl/Tk libraries. So, can't make tcltklib.so which is required by Ruby/Tk." - puts "If you have Tcl/Tk libraries on your environment, you may be able to use them with configure options (see ext/tk/README.tcltklib)." - puts "At present, Tcl/Tk8.6 is not supported. Although you can try to use Tcl/Tk8.6 with configure options, it will not work correctly. I recommend you to use Tcl/Tk8.5 or 8.4." -end diff --git a/ext/tk/lib/README b/ext/tk/lib/README deleted file mode 100644 index df1c7906ea..0000000000 --- a/ext/tk/lib/README +++ /dev/null @@ -1,30 +0,0 @@ -README this file -multi-tk.rb multiple Tk interpreter (included safe-Tk) support -remotei-tk.rb control remote Tk interpreter on the other process support -tk.rb Tk interface - -tk/ library files construct Ruby/Tk - -tkextlib/ non-standard Tcl/Tk extension support libraries - -********************************************************************* -*** The followings exists for backward compatibility only. -*** The only thing which they work is that requires current -*** library files ( tk/*.rb ). -********************************************************************* -tkafter.rb handles Tcl after -tkbgerror.rb Tk error module -tkcanvas.rb Tk canvas interface -tkclass.rb provides generic names for Tk classes -tkconsole.rb console command support -tkdialog.rb Tk dialog class -tkentry.rb Tk entry class -tkfont.rb Tk font support -tkmacpkg.rb Mac resource support -tkmenubar.rb TK menubar utility -tkmngfocus.rb focus manager -tkpalette.rb palette support -tkscrollbox.rb scroll box, also example of compound widget -tktext.rb text classes -tkvirtevent.rb virtual event support -tkwinpkg.rb Win DDE and registry support diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb deleted file mode 100644 index 0fe766c049..0000000000 --- a/ext/tk/lib/multi-tk.rb +++ /dev/null @@ -1,3743 +0,0 @@ -# frozen_string_literal: false -# -# multi-tk.rb - supports multi Tk interpreters -# by Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - -require 'tcltklib' -require 'tkutil' -require 'thread' - -if defined? Tk - fail RuntimeError,"'multi-tk' library must be required before requiring 'tk'" -end - -################################################ -# ignore exception on the mainloop? - -TclTkLib.mainloop_abort_on_exception = true -# TclTkLib.mainloop_abort_on_exception = false -# TclTkLib.mainloop_abort_on_exception = nil - - -################################################ -# add ThreadGroup check to TclTkIp.new -class << TclTkIp - alias __new__ new - private :__new__ - - def new(*args) - if Thread.current.group != ThreadGroup::Default - raise SecurityError, 'only ThreadGroup::Default can call TclTkIp.new' - end - obj = __new__(*args) - obj.instance_eval{ - @force_default_encoding ||= TkUtil.untrust([false]) - @encoding ||= TkUtil.untrust([nil]) - def @encoding.to_s; self.join(nil); end - } - obj - end -end - - -################################################ -# exception to treat the return value from IP -class MultiTkIp_OK < Exception - def self.send(thread, ret=nil) - thread.raise self.new(ret) - end - - def initialize(ret=nil) - super('succeed') - @return_value = ret - end - - attr_reader :return_value - alias value return_value -end -MultiTkIp_OK.freeze - - -################################################ -# methods for construction -class MultiTkIp - class Command_Queue < Queue - def initialize(interp) - @interp = interp - super() - end - - def push(value) - if !@interp || @interp.deleted? - fail RuntimeError, "Tk interpreter is already deleted" - end - super(value) - end - alias << push - alias enq push - - def close - @interp = nil - end - end - Command_Queue.freeze - - BASE_DIR = File.dirname(__FILE__) - - WITH_RUBY_VM = Object.const_defined?(:RubyVM) && ::RubyVM.class == Class - WITH_ENCODING = defined?(::Encoding.default_external) - #WITH_ENCODING = Object.const_defined?(:Encoding) && ::Encoding.class == Class - - (@@SLAVE_IP_ID = ['slave'.freeze, TkUtil.untrust('0')]).instance_eval{ - @mutex = Mutex.new - def mutex; @mutex; end - freeze - } - - @@IP_TABLE = TkUtil.untrust({}) unless defined?(@@IP_TABLE) - - @@INIT_IP_ENV = TkUtil.untrust([]) unless defined?(@@INIT_IP_ENV) # table of Procs - @@ADD_TK_PROCS = TkUtil.untrust([]) unless defined?(@@ADD_TK_PROCS) # table of [name, args, body] - - @@TK_TABLE_LIST = TkUtil.untrust([]) unless defined?(@@TK_TABLE_LIST) - - unless defined?(@@TK_CMD_TBL) - @@TK_CMD_TBL = TkUtil.untrust(Object.new) - - # @@TK_CMD_TBL.instance_variable_set('@tbl', {}.taint) - tbl_obj = TkUtil.untrust(Hash.new{|hash,key| - fail IndexError, "unknown command ID '#{key}'" - }) - @@TK_CMD_TBL.instance_variable_set('@tbl', tbl_obj) - - class << @@TK_CMD_TBL - allow = [ - '__send__', '__id__', 'freeze', 'inspect', 'kind_of?', 'object_id', - '[]', '[]=', 'delete', 'each', 'has_key?' - ] - instance_methods.each{|m| undef_method(m) unless allow.index(m.to_s)} - - def kind_of?(klass) - @tbl.kind_of?(klass) - end - - def inspect - if Thread.current.group == ThreadGroup::Default - @tbl.inspect - else - ip = MultiTkIp.__getip - @tbl.reject{|idx, ent| ent.respond_to?(:ip) && ent.ip != ip}.inspect - end - end - - def [](idx) - return unless (ent = @tbl[idx]) - if Thread.current.group == ThreadGroup::Default - ent - elsif ent.respond_to?(:ip) - (ent.ip == MultiTkIp.__getip)? ent: nil - else - ent - end - end - - def []=(idx,val) - if self.has_key?(idx) && Thread.current.group != ThreadGroup::Default - fail SecurityError,"cannot change the entried command" - end - @tbl[idx] = val - end - - def delete(idx, &blk) - # if gets an entry, is permitted to delete - if self[idx] - @tbl.delete(idx) - elsif blk - blk.call(idx) - else - nil - end - end - - def each(&blk) - if Thread.current.group == ThreadGroup::Default - @tbl.each(&blk) - else - ip = MultiTkIp.__getip - @tbl.each{|idx, ent| - blk.call(idx, ent) unless ent.respond_to?(:ip) && ent.ip != ip - } - end - self - end - - def has_key?(k) - @tbl.has_key?(k) - end - alias include? has_key? - alias key? has_key? - alias member? has_key? - end - - @@TK_CMD_TBL.freeze - end - - ###################################### - - @@CB_ENTRY_CLASS = Class.new(TkCallbackEntry){ - def initialize(ip, cmd) - @ip = ip - @safe = safe = $SAFE - # @cmd = cmd - cmd = MultiTkIp._proc_on_safelevel(&cmd) - @cmd = proc{|*args| cmd.call(safe, *args)} - self.freeze - end - attr_reader :ip, :cmd - def inspect - cmd.inspect - end - def call(*args) - unless @ip.deleted? - current = Thread.current - backup_ip = current[:callback_ip] - current[:callback_ip] = @ip - begin - ret = @ip.cb_eval(@cmd, *args) - fail ret if ret.kind_of?(Exception) - ret - rescue TkCallbackBreak, TkCallbackContinue => e - fail e - rescue SecurityError => e - # in 'exit', 'exit!', and 'abort' : security error --> delete IP - if e.backtrace[0] =~ /^(.+?):(\d+):in `(exit|exit!|abort)'/ - @ip.delete - elsif @ip.safe? - if @ip.respond_to?(:cb_error) - @ip.cb_error(e) - else - nil # ignore - end - else - fail e - end - rescue Exception => e - fail e if e.message =~ /^TkCallback/ - - if @ip.safe? - if @ip.respond_to?(:cb_error) - @ip.cb_error(e) - else - nil # ignore - end - else - fail e - end - ensure - current[:callback_ip] = backup_ip - end - end - end - }.freeze - - ###################################### - - 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 - - def _check_and_return(thread, exception, wait=0) - unless thread - unless exception.kind_of?(MultiTkIp_OK) - msg = "#{exception.class}: #{exception.message}" - - if @interp.deleted? - warn("Warning (#{self}): " + msg) - return nil - end - - if safe? - warn("Warning (#{self}): " + msg) if $DEBUG - return nil - end - - begin - @interp._eval_without_enc(@interp._merge_tklist('bgerror', msg)) - rescue Exception => e - warn("Warning (#{self}): " + msg) - end - end - return nil - end - - if wait == 0 - # no wait - Thread.pass - if thread.stop? - thread.raise exception - end - return thread - end - - # wait to stop the caller thread - wait.times{ - if thread.stop? - # ready to send exception - thread.raise exception - return thread - end - - # wait - Thread.pass - } - - # unexpected error - thread.raise RuntimeError, "the thread may not wait for the return value" - return thread - end - - ###################################### - - def set_cb_error(cmd = Proc.new) - @cb_error_proc[0] = cmd - end - - def cb_error(e) - if @cb_error_proc[0].respond_to?(:call) - @cb_error_proc[0].call(e) - end - end - - ###################################### - - def set_safe_level(safe) - if safe > @safe_level[0] - @safe_level[0] = safe - @cmd_queue.enq([@system, 'set_safe_level', safe]) - end - @safe_level[0] - end - def safe_level=(safe) - set_safe_level(safe) - end - def self.set_safe_level(safe) - __getip.set_safe_level(safe) - end - def self.safe_level=(safe) - self.set_safe_level(safe) - end - def safe_level - @safe_level[0] - end - def self.safe_level - __getip.safe_level - end - - def wait_on_mainloop? - @wait_on_mainloop[0] - end - def wait_on_mainloop=(bool) - @wait_on_mainloop[0] = bool - end - - def running_mainloop? - @wait_on_mainloop[1] > 0 - end - - def _destroy_slaves_of_slaveIP(ip) - unless ip.deleted? - # ip._split_tklist(ip._invoke('interp', 'slaves')).each{|name| - ip._split_tklist(ip._invoke_without_enc('interp', 'slaves')).each{|name| - name = _fromUTF8(name) - begin - # ip._eval_without_enc("#{name} eval {foreach i [after info] {after cancel $i}}") - after_ids = ip._eval_without_enc("#{name} eval {after info}") - ip._eval_without_enc("#{name} eval {foreach i {#{after_ids}} {after cancel $i}}") - rescue Exception - end - begin - # ip._invoke('interp', 'eval', name, 'destroy', '.') - ip._invoke(name, 'eval', 'destroy', '.') - rescue Exception - end - - # safe_base? - if ip._eval_without_enc("catch {::safe::interpConfigure #{name}}") == '0' - begin - ip._eval_without_enc("::safe::interpDelete #{name}") - rescue Exception - end - end -=begin - if ip._invoke('interp', 'exists', name) == '1' - begin - ip._invoke(name, 'eval', 'exit') - rescue Exception - end - end -=end - unless ip.deleted? - if ip._invoke('interp', 'exists', name) == '1' - begin - ip._invoke('interp', 'delete', name) - rescue Exception - end - end - end - } - end - end - - def _receiver_eval_proc_core(safe_level, thread, cmd, *args) - begin - #ret = proc{$SAFE = safe_level; cmd.call(*args)}.call - #ret = cmd.call(safe_level, *args) - normal_ret = false - ret = catch(:IRB_EXIT) do # IRB hack - retval = cmd.call(safe_level, *args) - normal_ret = true - retval - end - unless normal_ret - # catch IRB_EXIT - exit(ret) - end - ret - rescue SystemExit => e - # delete IP - unless @interp.deleted? - @slave_ip_tbl.each{|name, subip| - _destroy_slaves_of_slaveIP(subip) - begin - # subip._eval_without_enc("foreach i [after info] {after cancel $i}") - after_ids = subip._eval_without_enc("after info") - subip._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") - rescue Exception - end -=begin - begin - subip._invoke('destroy', '.') unless subip.deleted? - rescue Exception - end -=end - # safe_base? - if @interp._eval_without_enc("catch {::safe::interpConfigure #{name}}") == '0' - begin - @interp._eval_without_enc("::safe::interpDelete #{name}") - rescue Exception - else - next if subip.deleted? - end - end - if subip.respond_to?(:safe_base?) && subip.safe_base? && - !subip.deleted? - # do 'exit' to call the delete_hook procedure - begin - subip._eval_without_enc('exit') - rescue Exception - end - else - begin - subip.delete unless subip.deleted? - rescue Exception - end - end - } - - begin - # @interp._eval_without_enc("foreach i [after info] {after cancel $i}") - after_ids = @interp._eval_without_enc("after info") - @interp._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") - rescue Exception - end - begin - @interp._invoke('destroy', '.') unless @interp.deleted? - rescue Exception - end - if @safe_base && !@interp.deleted? - # do 'exit' to call the delete_hook procedure - @interp._eval_without_enc('exit') - else - @interp.delete unless @interp.deleted? - end - end - - if e.backtrace[0] =~ /^(.+?):(\d+):in `(exit|exit!|abort)'/ - _check_and_return(thread, MultiTkIp_OK.new($3 == 'exit')) - else - _check_and_return(thread, MultiTkIp_OK.new(nil)) - end - - # if master? && !safe? && allow_ruby_exit? - if !@interp.deleted? && master? && !safe? && allow_ruby_exit? -=begin - ObjectSpace.each_object(TclTkIp){|obj| - obj.delete unless obj.deleted? - } -=end - #exit(e.status) - fail e - end - # break - - rescue SecurityError => e - # in 'exit', 'exit!', and 'abort' : security error --> delete IP - if e.backtrace[0] =~ /^(.+?):(\d+):in `(exit|exit!|abort)'/ - ret = ($3 == 'exit') - unless @interp.deleted? - @slave_ip_tbl.each{|name, subip| - _destroy_slaves_of_slaveIP(subip) - begin - # subip._eval_without_enc("foreach i [after info] {after cancel $i}") - after_ids = subip._eval_without_enc("after info") - subip._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") - rescue Exception - end -=begin - begin - subip._invoke('destroy', '.') unless subip.deleted? - rescue Exception - end -=end - # safe_base? - if @interp._eval_without_enc("catch {::safe::interpConfigure #{name}}") == '0' - begin - @interp._eval_without_enc("::safe::interpDelete #{name}") - rescue Exception - else - next if subip.deleted? - end - end - if subip.respond_to?(:safe_base?) && subip.safe_base? && - !subip.deleted? - # do 'exit' to call the delete_hook procedure - begin - subip._eval_without_enc('exit') - rescue Exception - end - else - begin - subip.delete unless subip.deleted? - rescue Exception - end - end - } - - begin - # @interp._eval_without_enc("foreach i [after info] {after cancel $i}") - after_ids = @interp._eval_without_enc("after info") - @interp._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") - rescue Exception - end -=begin - begin - @interp._invoke('destroy', '.') unless @interp.deleted? - rescue Exception - end -=end - if @safe_base && !@interp.deleted? - # do 'exit' to call the delete_hook procedure - @interp._eval_without_enc('exit') - else - @interp.delete unless @interp.deleted? - end - end - _check_and_return(thread, MultiTkIp_OK.new(ret)) - # break - - else - # raise security error - _check_and_return(thread, e) - end - - rescue Exception => e - # raise exception - begin - bt = _toUTF8(e.backtrace.join("\n")) - if MultiTkIp::WITH_ENCODING - bt.force_encoding('utf-8') - else - bt.instance_variable_set(:@encoding, 'utf-8') - end - rescue Exception - bt = e.backtrace.join("\n") - end - begin - @interp._set_global_var('errorInfo', bt) - rescue Exception - end - _check_and_return(thread, e) - - else - # no exception - _check_and_return(thread, MultiTkIp_OK.new(ret)) - end - end - - def _receiver_eval_proc(last_thread, safe_level, thread, cmd, *args) - if thread - Thread.new{ - last_thread.join if last_thread - unless @interp.deleted? - _receiver_eval_proc_core(safe_level, thread, cmd, *args) - end - } - else - Thread.new{ - unless @interp.deleted? - _receiver_eval_proc_core(safe_level, thread, cmd, *args) - end - } - last_thread - end - end - - private :_receiver_eval_proc, :_receiver_eval_proc_core - - def _receiver_mainloop(check_root) - if @evloop_thread[0] && @evloop_thread[0].alive? - @evloop_thread[0] - else - @evloop_thread[0] = Thread.new{ - while !@interp.deleted? - #if check_root - # inf = @interp._invoke_without_enc('info', 'command', '.') - # break if !inf.kind_of?(String) || inf != '.' - #end - break if check_root && !@interp.has_mainwindow? - sleep 0.5 - end - } - @evloop_thread[0] - end - end - - def _create_receiver_and_watchdog(lvl = $SAFE) - lvl = $SAFE if lvl < $SAFE - - # command-procedures receiver - receiver = Thread.new(lvl){|safe_level| - last_thread = {} - - loop do - break if @interp.deleted? - thread, cmd, *args = @cmd_queue.deq - if thread == @system - # control command - case cmd - when 'set_safe_level' - begin - safe_level = args[0] if safe_level < args[0] - rescue Exception - end - when 'call_mainloop' - thread = args.shift - _check_and_return(thread, - MultiTkIp_OK.new(_receiver_mainloop(*args))) - else - # ignore - end - - else - # procedure - last_thread[thread] = _receiver_eval_proc(last_thread[thread], - safe_level, thread, - cmd, *args) - end - end - } - - # watchdog of receiver - watchdog = Thread.new{ - begin - loop do - sleep 1 - if @interp.deleted? - receiver.kill - @cmd_queue.close - end - break unless receiver.alive? - end - rescue Exception - # ignore all kind of Exception - end - - # receiver is dead - retry_count = 3 - loop do - Thread.pass - begin - thread, cmd, *args = @cmd_queue.deq(true) # non-block - rescue ThreadError - # queue is empty - retry_count -= 1 - break if retry_count <= 0 - sleep 0.5 - retry - end - next unless thread - if thread.alive? - if @interp.deleted? - thread.raise RuntimeError, 'the interpreter is already deleted' - else - thread.raise RuntimeError, - 'the interpreter no longer receives command procedures' - end - end - end - } - - # return threads - [receiver, watchdog] - end - private :_check_and_return, :_create_receiver_and_watchdog - - ###################################### - - unless self.const_defined? :RUN_EVENTLOOP_ON_MAIN_THREAD - ### Ruby 1.9 !!!!!!!!!!!!!!!!!!!!!!!!!! - RUN_EVENTLOOP_ON_MAIN_THREAD = false - end - - if self.const_defined? :DEFAULT_MASTER_NAME - name = DEFAULT_MASTER_NAME.to_s - else - name = nil - end - if self.const_defined?(:DEFAULT_MASTER_OPTS) && - DEFAULT_MASTER_OPTS.kind_of?(Hash) - keys = DEFAULT_MASTER_OPTS - else - keys = {} - end - - @@DEFAULT_MASTER = self.allocate - @@DEFAULT_MASTER.instance_eval{ - @tk_windows = TkUtil.untrust({}) - - @tk_table_list = TkUtil.untrust([]) - - @slave_ip_tbl = TkUtil.untrust({}) - - @slave_ip_top = TkUtil.untrust({}) - - @evloop_thread = TkUtil.untrust([]) - - unless keys.kind_of? Hash - fail ArgumentError, "expecting a Hash object for the 2nd argument" - end - - if !WITH_RUBY_VM || RUN_EVENTLOOP_ON_MAIN_THREAD ### check Ruby 1.9 !!!!!!! - @interp = TclTkIp.new(name, _keys2opts(keys)) - else ### Ruby 1.9 !!!!!!!!!!! - @interp_thread = Thread.new{ - current = Thread.current - begin - current[:interp] = interp = TclTkIp.new(name, _keys2opts(keys)) - rescue e - current[:interp] = e - raise e - end - #sleep - current[:mutex] = mutex = Mutex.new - current[:root_check] = cond_var = ConditionVariable.new - - status = [nil] - def status.value - self[0] - end - def status.value=(val) - self[0] = val - end - current[:status] = status - - begin - begin - #TclTkLib.mainloop_abort_on_exception = false - #Thread.current[:status].value = TclTkLib.mainloop(true) - interp.mainloop_abort_on_exception = true - current[:status].value = interp.mainloop(true) - rescue SystemExit=>e - current[:status].value = e - rescue Exception=>e - current[:status].value = e - retry if interp.has_mainwindow? - ensure - mutex.synchronize{ cond_var.broadcast } - end - - #Thread.current[:status].value = TclTkLib.mainloop(false) - current[:status].value = interp.mainloop(false) - - ensure - # interp must be deleted before the thread for interp is dead. - # If not, raise Tcl_Panic on Tcl_AsyncDelete because async handler - # deleted by the wrong thread. - interp.delete - end - } - until @interp_thread[:interp] - Thread.pass - end - # INTERP_THREAD.run - raise @interp_thread[:interp] if @interp_thread[:interp].kind_of? Exception - @interp = @interp_thread[:interp] - - # delete the interpreter and kill the eventloop thread at exit - interp = @interp - interp_thread = @interp_thread - END{ - if interp_thread.alive? - interp.delete - interp_thread.kill - end - } - - def self.mainloop(check_root = true) - begin - TclTkLib.set_eventloop_window_mode(true) - @interp_thread.value - ensure - TclTkLib.set_eventloop_window_mode(false) - end - end - end - - @interp.instance_eval{ - @force_default_encoding ||= TkUtil.untrust([false]) - @encoding ||= TkUtil.untrust([nil]) - def @encoding.to_s; self.join(nil); end - } - - @ip_name = nil - - @callback_status = TkUtil.untrust([]) - - @system = Object.new - - @wait_on_mainloop = TkUtil.untrust([true, 0]) - - @threadgroup = Thread.current.group - - @safe_base = false - - @safe_level = [$SAFE] - - @cmd_queue = MultiTkIp::Command_Queue.new(@interp) - - @cmd_receiver, @receiver_watchdog = _create_receiver_and_watchdog(@safe_level[0]) - - @threadgroup.add @cmd_receiver - @threadgroup.add @receiver_watchdog - - # NOT enclose @threadgroup for @@DEFAULT_MASTER - - @@IP_TABLE[ThreadGroup::Default] = self - @@IP_TABLE[@threadgroup] = self - - ################################# - - @pseudo_toplevel = [false, nil] - - def self.__pseudo_toplevel - Thread.current.group == ThreadGroup::Default && - MultiTkIp.__getip == @@DEFAULT_MASTER && - self.__pseudo_toplevel_evaluable? && @pseudo_toplevel[1] - end - - def self.__pseudo_toplevel=(m) - unless (Thread.current.group == ThreadGroup::Default && - MultiTkIp.__getip == @@DEFAULT_MASTER) - fail SecurityError, "no permission to manipulate" - end - - # if m.kind_of?(Module) && m.respond_to?(:pseudo_toplevel_evaluable?) - if m.respond_to?(:pseudo_toplevel_evaluable?) - @pseudo_toplevel[0] = true - @pseudo_toplevel[1] = m - else - fail ArgumentError, 'fail to set pseudo-toplevel' - end - self - end - - def self.__pseudo_toplevel_evaluable? - begin - @pseudo_toplevel[0] && @pseudo_toplevel[1].pseudo_toplevel_evaluable? - rescue Exception - false - end - end - - def self.__pseudo_toplevel_evaluable=(mode) - unless (Thread.current.group == ThreadGroup::Default && - MultiTkIp.__getip == @@DEFAULT_MASTER) - fail SecurityError, "no permission to manipulate" - end - - @pseudo_toplevel[0] = (mode)? true: false - end - - ################################# - - @assign_request = Class.new(Exception){ - def self.new(target, ret) - obj = super() - obj.target = target - obj.ret = ret - obj - end - attr_accessor :target, :ret - } - - @assign_thread = Thread.new{ - loop do - begin - Thread.stop - rescue @assign_request=>req - begin - req.ret[0] = req.target.instance_eval{ - @cmd_receiver, @receiver_watchdog = - _create_receiver_and_watchdog(@safe_level[0]) - @threadgroup.add @cmd_receiver - @threadgroup.add @receiver_watchdog - @threadgroup.enclose - true - } - rescue Exception=>e - begin - req.ret[0] = e - rescue Exception - # ignore - end - end - rescue Exception - # ignore - end - end - } - - def self.assign_receiver_and_watchdog(target) - ret = [nil] - @assign_thread.raise(@assign_request.new(target, ret)) - while ret[0] == nil - unless @assign_thread.alive? - raise RuntimeError, 'lost the thread to assign a receiver and a watchdog thread' - end - end - if ret[0].kind_of?(Exception) - raise ret[0] - else - ret[0] - end - end - - ################################# - - @init_ip_env_queue = Queue.new - Thread.new{ - current = Thread.current - loop { - mtx, cond, ret, table, script = @init_ip_env_queue.deq - begin - ret[0] = table.each{|tg, ip| ip._init_ip_env(script) } - rescue Exception => e - ret[0] = e - ensure - mtx.synchronize{ cond.signal } - end - mtx = cond = ret = table = script = nil # clear variables for GC - } - } - - def self.__init_ip_env__(table, script) - ret = [] - mtx = (Thread.current[:MultiTk_ip_Mutex] ||= Mutex.new) - cond = (Thread.current[:MultiTk_ip_CondVar] ||= ConditionVariable.new) - mtx.synchronize{ - @init_ip_env_queue.enq([mtx, cond, ret, table, script]) - cond.wait(mtx) - } - if ret[0].kind_of?(Exception) - raise ret[0] - else - ret[0] - end - end - - ################################# - - class << self - undef :instance_eval - end - } - - @@DEFAULT_MASTER.freeze # defend against modification - - ###################################### - - def self.inherited(subclass) - # trust if on ThreadGroup::Default or @@DEFAULT_MASTER's ThreadGroup - if @@IP_TABLE[Thread.current.group] == @@DEFAULT_MASTER - begin - class << subclass - self.methods.each{|m| - name = m.to_s - begin - unless name == '__id__' || name == '__send__' || name == 'freeze' - undef_method(m) - end - rescue Exception - # ignore all exceptions - end - } - end - ensure - subclass.freeze - fail SecurityError, - "cannot create subclass of MultiTkIp on a untrusted ThreadGroup" - end - end - end - - ###################################### - - @@SAFE_OPT_LIST = [ - 'accessPath'.freeze, - 'statics'.freeze, - 'nested'.freeze, - 'deleteHook'.freeze - ].freeze - - def _parse_slaveopts(keys) - name = nil - safe = false - safe_opts = {} - tk_opts = {} - - keys.each{|k,v| - k_str = k.to_s - if k_str == 'name' - name = v - elsif k_str == 'safe' - safe = v - elsif @@SAFE_OPT_LIST.member?(k_str) - safe_opts[k_str] = v - else - tk_opts[k_str] = v - end - } - - 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 - @@SLAVE_IP_ID.mutex.synchronize{ - name = @@SLAVE_IP_ID.join('') - @@SLAVE_IP_ID[1].succ! - name.freeze - } - end - private :_create_slave_ip_name - - ###################################### - - def __check_safetk_optkeys(optkeys) - # based on 'safetk.tcl' - new_keys = {} - optkeys.each{|k,v| new_keys[k.to_s] = v} - - # check 'display' - if !new_keys.key?('display') - begin - #new_keys['display'] = @interp._invoke('winfo screen .') - new_keys['display'] = @interp._invoke('winfo', 'screen', '.') - rescue - if ENV[DISPLAY] - new_keys['display'] = ENV[DISPLAY] - elsif !new_keys.key?('use') - warn "Warning: no screen info or ENV[DISPLAY], so use ':0.0'" - new_keys['display'] = ':0.0' - end - end - end - - # check 'use' - if new_keys.key?('use') - # given 'use' - case new_keys['use'] - when TkWindow - new_keys['use'] = TkWinfo.id(new_keys['use']) - #assoc_display = @interp._eval('winfo screen .') - assoc_display = @interp._invoke('winfo', 'screen', '.') - when /^\..*/ - new_keys['use'] = @interp._invoke('winfo', 'id', new_keys['use']) - assoc_display = @interp._invoke('winfo', 'screen', new_keys['use']) - else - begin - pathname = @interp._invoke('winfo', 'pathname', new_keys['use']) - assoc_display = @interp._invoke('winfo', 'screen', pathname) - rescue - assoc_display = new_keys['display'] - end - end - - # match display? - if assoc_display != new_keys['display'] - if optkeys.key?(:display) || optkeys.key?('display') - fail RuntimeError, - "conflicting 'display'=>#{new_keys['display']} " + - "and display '#{assoc_display}' on 'use'=>#{new_keys['use']}" - else - new_keys['display'] = assoc_display - end - end - end - - # return - new_keys - end - private :__check_safetk_optkeys - - def __create_safetk_frame(slave_ip, slave_name, app_name, keys) - # display option is used by ::safe::loadTk - loadTk_keys = {} - loadTk_keys['display'] = keys['display'] - dup_keys = keys.dup - - # keys for toplevel : allow followings - toplevel_keys = {} - ['height', 'width', 'background', 'menu'].each{|k| - toplevel_keys[k] = dup_keys.delete(k) if dup_keys.key?(k) - } - toplevel_keys['classname'] = 'SafeTk' - toplevel_keys['screen'] = dup_keys.delete('display') - - # other keys used by pack option of container frame - - # create toplevel widget - begin - top = TkToplevel.new(toplevel_keys) - rescue NameError => e - fail e unless @interp.safe? - fail SecurityError, "unable create toplevel on the safe interpreter" - end - msg = "Untrusted Ruby/Tk applet (#{slave_name})" - if app_name.kind_of?(String) - top.title "#{app_name} (#{slave_name})" - else - top.title msg - end - - # 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 - slave_ip._eval_without_enc('exit') - end - begin - top.destroy if top.winfo_exist? - rescue - # ignore - end - } - 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) - - TkFrame.new(fc, :bd=>0){|f| - TkButton.new(f, - :text=>'Delete', :bd=>1, :padx=>2, :pady=>0, - :highlightthickness=>0, :command=>slave_delete_proc - ).pack(:side=>:right, :fill=>:both) - f.pack(:side=>:right, :fill=>:both, :expand=>true) - } - - TkLabel.new(fc, :text=>msg, :padx=>2, :pady=>0, - :anchor=>:w).pack(:side=>:left, :fill=>:both, :expand=>true) - - fc.pack(:side=>:bottom, :fill=>:x) - } - - # container frame for slave interpreter - dup_keys['fill'] = :both unless dup_keys.key?('fill') - dup_keys['expand'] = true unless dup_keys.key?('expand') - c = TkFrame.new(top, :container=>true).pack(dup_keys) - c.bind('Destroy', proc{top.destroy}) - - # return keys - loadTk_keys['use'] = TkWinfo.id(c) - [loadTk_keys, top.path] - end - private :__create_safetk_frame - - def __create_safe_slave_obj(safe_opts, app_name, tk_opts) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - # safe interpreter - ip_name = _create_slave_ip_name - slave_ip = @interp.create_slave(ip_name, true) - slave_ip.instance_eval{ - @force_default_encoding ||= TkUtil.untrust([false]) - @encoding ||= TkUtil.untrust([nil]) - def @encoding.to_s; self.join(nil); end - } - @slave_ip_tbl[ip_name] = slave_ip - def slave_ip.safe_base? - true - end - - @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)}") - @interp._invoke('__replace_slave_tk_commands__', ip_name) - 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 - - def __create_trusted_slave_obj(name, keys) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - ip_name = _create_slave_ip_name - slave_ip = @interp.create_slave(ip_name, false) - slave_ip.instance_eval{ - @force_default_encoding ||= TkUtil.untrust([false]) - @encoding ||= TkUtil.untrust([nil]) - def @encoding.to_s; self.join(nil); end - } - slave_ip._invoke('set', 'argv0', name) if name.kind_of?(String) - slave_ip._invoke('set', 'argv', _keys2opts(keys)) - @interp._invoke('load', '', 'Tk', ip_name) - @interp._invoke('__replace_slave_tk_commands__', ip_name) - @slave_ip_tbl[ip_name] = slave_ip - [slave_ip, ip_name] - end - - ###################################### - - def _create_slave_object(keys={}) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - ip = MultiTkIp.new_slave(self, keys={}) - @slave_ip_tbl[ip.name] = ip - end - - ###################################### - - def initialize(master, safeip=true, keys={}) - if master.deleted? && safeip == nil - fail RuntimeError, "cannot create a slave of a deleted interpreter" - end - - if !master.deleted? && !master.master? && master.safe? - fail SecurityError, "safe-slave-ip cannot create a new interpreter" - end - - if safeip == nil && !master.master? - fail SecurityError, "slave-ip cannot create a master-ip" - end - - unless keys.kind_of? Hash - fail ArgumentError, "expecting a Hash object for the 2nd argument" - end - - @tk_windows = {} - @tk_table_list = [] - @slave_ip_tbl = {} - @slave_ip_top = {} - @cb_error_proc = [] - @evloop_thread = [] - - TkUtil.untrust(@tk_windows) unless @tk_windows.tainted? - TkUtil.untrust(@tk_table_list) unless @tk_table_list.tainted? - TkUtil.untrust(@slave_ip_tbl) unless @slave_ip_tbl.tainted? - TkUtil.untrust(@slave_ip_top) unless @slave_ip_top.tainted? - TkUtil.untrust(@cb_error_proc) unless @cb_error_proc.tainted? - TkUtil.untrust(@evloop_thread) unless @evloop_thread.tainted? - - @callback_status = [] - - name, safe, safe_opts, tk_opts = _parse_slaveopts(keys) - - safe = 1 if safe && !safe.kind_of?(Fixnum) - - @safe_base = false - - if safeip == nil - # create master-ip - unless WITH_RUBY_VM - @interp = TclTkIp.new(name, _keys2opts(tk_opts)) - @interp.instance_eval{ - @force_default_encoding ||= TkUtil.untrust([false]) - @encoding ||= TkUtil.untrust([nil]) - def @encoding.to_s; self.join(nil); end - } - - else ### Ruby 1.9 !!!!!!!!!!! -=begin - @interp_thread = Thread.new{ - Thread.current[:interp] = interp = TclTkIp.new(name, _keys2opts(tk_opts)) - interp.instance_eval{ - @force_default_encoding ||= TkUtil.untrust([false]) - @encoding ||= TkUtil.untrust([nil]) - def @encoding.to_s; self.join(nil); end - } - - #sleep - TclTkLib.mainloop(true) - } - until @interp_thread[:interp] - Thread.pass - end - # INTERP_THREAD.run - @interp = @interp_thread[:interp] -=end - @interp_thread = Thread.new{ - current = Thread.current - begin - current[:interp] = interp = TclTkIp.new(name, _keys2opts(tk_opts)) - rescue e - current[:interp] = e - raise e - end - #sleep - #TclTkLib.mainloop(true) - current[:mutex] = mutex = Mutex.new - current[:root_check] = cond_ver = ConditionVariable.new - - status = [nil] - def status.value - self[0] - end - def status.value=(val) - self[0] = val - end - current[:status] = status - - begin - begin - current[:status].value = interp.mainloop(true) - rescue SystemExit=>e - current[:status].value = e - rescue Exception=>e - current[:status].value = e - retry if interp.has_mainwindow? - ensure - mutex.synchronize{ cond_var.broadcast } - end - current[:status].value = interp.mainloop(false) - ensure - interp.delete - end - } - until @interp_thread[:interp] - Thread.pass - end - # INTERP_THREAD.run - @interp = @interp_thread[:interp] - - @evloop_thread[0] = @interp_thread - - def self.mainloop(check_root = true) - begin - TclTkLib.set_eventloop_window_mode(true) - @interp_thread.value - ensure - TclTkLib.set_eventloop_window_mode(false) - end - end - end - - @interp.instance_eval{ - @force_default_encoding ||= TkUtil.untrust([false]) - @encoding ||= TkUtil.untrust([nil]) - def @encoding.to_s; self.join(nil); end - } - - @ip_name = nil - - if safe - safe = $SAFE if safe < $SAFE - @safe_level = [safe] - else - @safe_level = [$SAFE] - end - - else - # create slave-ip - if safeip || master.safe? - @safe_base = true - @interp, @ip_name = master.__create_safe_slave_obj(safe_opts, - name, tk_opts) - # @interp_thread = nil if RUBY_VERSION < '1.9.0' ### !!!!!!!!!!! - @interp_thread = nil unless WITH_RUBY_VM ### Ruby 1.9 !!!!!!!!!!! - if safe - safe = master.safe_level if safe < master.safe_level - @safe_level = [safe] - else - @safe_level = [1] - end - else - @interp, @ip_name = master.__create_trusted_slave_obj(name, tk_opts) - # @interp_thread = nil if RUBY_VERSION < '1.9.0' ### !!!!!!!!!!! - @interp_thread = nil unless WITH_RUBY_VM ### Ruby 1.9 !!!!!!!!!!! - if safe - safe = master.safe_level if safe < master.safe_level - @safe_level = [safe] - else - @safe_level = [master.safe_level] - end - end - @set_alias_proc = proc{|name| - master._invoke('interp', 'alias', @ip_name, name, '', name) - }.freeze - end - - @system = Object.new - - @wait_on_mainloop = TkUtil.untrust([true, 0]) - # @wait_on_mainloop = TkUtil.untrust([false, 0]) - - @threadgroup = ThreadGroup.new - - @pseudo_toplevel = [false, nil] - - @cmd_queue = MultiTkIp::Command_Queue.new(@interp) - -=begin - @cmd_receiver, @receiver_watchdog = _create_receiver_and_watchdog(@safe_level[0]) - - @threadgroup.add @cmd_receiver - @threadgroup.add @receiver_watchdog - - @threadgroup.enclose -=end - @@DEFAULT_MASTER.assign_receiver_and_watchdog(self) - - @@IP_TABLE[@threadgroup] = self - @@TK_TABLE_LIST.size.times{ - @tk_table_list << TkUtil.untrust({}) - } - _init_ip_internal(@@INIT_IP_ENV, @@ADD_TK_PROCS) - - class << self - undef :instance_eval - end - - # dummy call for initialization - self.eval_proc{ Tk.tk_call('set', 'tcl_patchLevel') } - - self.freeze # defend against modification - end - - ###################################### - - def _default_delete_hook(slave) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @slave_ip_tbl.delete(slave) - top = @slave_ip_top.delete(slave) - if top.kind_of?(String) - # call default hook of safetk.tcl (ignore exceptions) - if top == '' - begin - @interp._eval("::safe::disallowTk #{slave}") - rescue - warn("Warning: fail to call '::safe::disallowTk'") if $DEBUG - end - else # toplevel path - begin - @interp._eval("::safe::tkDelete {} #{top} #{slave}") - rescue - warn("Warning: fail to call '::safe::tkDelete'") if $DEBUG - begin - @interp._eval("destroy #{top}") - rescue - warn("Warning: fail to destroy toplevel") if $DEBUG - end - end - end - end - end - -end - - -# get target IP -class MultiTkIp - @@CALLBACK_SUBTHREAD = Class.new(Thread){ - def self.new(interp, &blk) - super(interp){|ip| Thread.current[:callback_ip] = ip; blk.call} - end - - @table = TkUtil.untrust(Hash.new{|h,k| h[k] = TkUtil.untrust([])}) - def self.table - @table - end - } - - def self._ip_id_ - __getip._ip_id_ - end - def _ip_id_ - # for RemoteTkIp - '' - end - - def self.__getip - current = Thread.current - if current.kind_of?(@@CALLBACK_SUBTHREAD) - return current[:callback_ip] - end - if TclTkLib.mainloop_thread? != false && current[:callback_ip] - return current[:callback_ip] - end - if current.group == ThreadGroup::Default - @@DEFAULT_MASTER - else - ip = @@IP_TABLE[current.group] - unless ip - fail SecurityError, - "cannot call Tk methods on #{Thread.current.inspect}" - end - ip - end - end -end - - -# aliases of constructor -class << MultiTkIp - alias __new new - private :__new - - def new_master(safe=nil, keys={}, &blk) - if MultiTkIp::WITH_RUBY_VM - #### TODO !!!!!! - fail RuntimeError, - 'sorry, still not support multiple master-interpreters on RubyVM' - end - - if safe.kind_of?(Hash) - keys = safe - elsif safe.kind_of?(Integer) - raise ArgumentError, "unexpected argument(s)" unless keys.kind_of?(Hash) - if !keys.key?(:safe) && !keys.key?('safe') - keys[:safe] = safe - end - elsif safe == nil - # do nothing - else - raise ArgumentError, "unexpected argument(s)" - end - - ip = __new(__getip, nil, keys) - #ip.eval_proc(proc{$SAFE=ip.safe_level; Proc.new}.call) if block_given? - if block_given? - #Thread.new{ip.eval_proc(proc{$SAFE=ip.safe_level; Proc.new}.call)} - #Thread.new{ip.eval_proc(proc{$SAFE=ip.safe_level; yield}.call)} - ip._proc_on_safelevel(&blk).call(ip.safe_level) - end - ip - end - - alias new new_master - - def new_slave(safe=nil, keys={}, &blk) - if safe.kind_of?(Hash) - keys = safe - elsif safe.kind_of?(Integer) - raise ArgumentError, "unexpected argument(s)" unless keys.kind_of?(Hash) - if !keys.key?(:safe) && !keys.key?('safe') - keys[:safe] = safe - end - elsif safe == nil - # do nothing - else - raise ArgumentError, "unexpected argument(s)" - end - - ip = __new(__getip, false, keys) - # ip.eval_proc(proc{$SAFE=ip.safe_level; Proc.new}.call) if block_given? - if block_given? - #Thread.new{ip.eval_proc(proc{$SAFE=ip.safe_level; Proc.new}.call)} - #Thread.new{ip.eval_proc(proc{$SAFE=ip.safe_level; yield}.call)} - ip._proc_on_safelevel(&blk).call(ip.safe_level) - end - ip - end - alias new_trusted_slave new_slave - - def new_safe_slave(safe=1, keys={}, &blk) - if safe.kind_of?(Hash) - keys = safe - elsif safe.kind_of?(Integer) - raise ArgumentError, "unexpected argument(s)" unless keys.kind_of?(Hash) - if !keys.key?(:safe) && !keys.key?('safe') - keys[:safe] = safe - end - else - raise ArgumentError, "unexpected argument(s)" - end - - ip = __new(__getip, true, keys) - # ip.eval_proc(proc{$SAFE=ip.safe_level; Proc.new}.call) if block_given? - if block_given? - #Thread.new{ip.eval_proc(proc{$SAFE=ip.safe_level; Proc.new}.call)} - #Thread.new{ip.eval_proc(proc{$SAFE=ip.safe_level; yield}.call)} - ip._proc_on_safelevel(&blk).call(ip.safe_level) - end - ip - end - alias new_safeTk new_safe_slave -end - - -# get info -class MultiTkIp - def inspect - s = self.to_s.chop! - if self.manipulable? - if master? - if @interp.deleted? - s << ':deleted-master' - else - s << ':master' - end - else - if @interp.deleted? - s << ':deleted-slave' - elsif @interp.safe? - s << ':safe-slave' - else - s << ':trusted-slave' - end - end - end - s << '>' - end - - def master? - if @ip_name - false - else - true - end - end - def self.master? - __getip.master? - end - - def slave? - not master? - end - def self.slave? - not self.master? - end - - def alive? - raise SecurityError, "no permission to manipulate" unless self.manipulable? - begin - return false unless @cmd_receiver.alive? - return false if @interp.deleted? - return false if @interp._invoke('interp', 'exists', '') == '0' - rescue Exception - return false - end - true - end - def self.alive? - __getip.alive? - end - - def path - @ip_name || '' - end - def self.path - __getip.path - end - def ip_name - @ip_name || '' - end - def self.ip_name - __getip.ip_name - end - def to_eval - @ip_name || '' - end - def self.to_eval - __getip.to_eval - end - - def slaves(all = false) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp','slaves').split.map!{|name| - if @slave_ip_tbl.key?(name) - @slave_ip_tbl[name] - elsif all - name - else - nil - end - }.compact! - end - def self.slaves(all = false) - __getip.slaves(all) - end - - def manipulable? - return true if (Thread.current.group == ThreadGroup::Default) - ip = MultiTkIp.__getip - (ip == self) || ip._is_master_of?(@interp) - end - def self.manipulable? - true - end - - def _is_master_of?(tcltkip_obj) - tcltkip_obj.slave_of?(@interp) - end - protected :_is_master_of? -end - - -# instance methods to treat tables -class MultiTkIp - def _tk_cmd_tbl - tbl = {} - MultiTkIp.tk_cmd_tbl.each{|id, ent| tbl[id] = ent if ent.ip == self } - tbl - end - - def _tk_windows - @tk_windows - end - - def _tk_table_list - @tk_table_list - end - - def _add_new_tables - (@@TK_TABLE_LIST.size - @tk_table_list.size).times{ - @tk_table_list << TkUtil.untrust({}) - } - end - - def _init_ip_env(script) - self.eval_proc{script.call(self)} - end - - def _add_tk_procs(name, args, body) - return if slave? - @interp._invoke('proc', name, args, body) if args && body - @interp._invoke('interp', 'slaves').split.each{|slave| - @interp._invoke('interp', 'alias', slave, name, '', name) - } - end - - def _remove_tk_procs(*names) - return if slave? - names.each{|name| - name = name.to_s - - return if @interp.deleted? - @interp._invoke('rename', name, '') - - return if @interp.deleted? - @interp._invoke('interp', 'slaves').split.each{|slave| - return if @interp.deleted? - @interp._invoke('interp', 'alias', slave, name, '') rescue nil - } - } - end - - def _init_ip_internal(init_ip_env, add_tk_procs) - #init_ip_env.each{|script| self.eval_proc{script.call(self)}} - init_ip_env.each{|script| self._init_ip_env(script)} - add_tk_procs.each{|name, args, body| - if master? - @interp._invoke('proc', name, args, body) if args && body - else - @set_alias_proc.call(name) - end - } - end -end - - -# class methods to treat tables -class MultiTkIp - def self.tk_cmd_tbl - @@TK_CMD_TBL - end - def self.tk_windows - __getip._tk_windows - end - def self.tk_object_table(id) - __getip._tk_table_list[id] - end - def self.create_table - if __getip.slave? - begin - raise SecurityError, "slave-IP has no permission creating a new table" - rescue SecurityError => e - #p e.backtrace - # Is called on a Ruby/Tk library? - caller_info = e.backtrace[1] - if caller_info =~ %r{^#{MultiTkIp::BASE_DIR}/(tk|tkextlib)/[^:]+\.rb:} - # Probably, caller is a Ruby/Tk library --> allow creating - else - raise e - end - end - end - - id = @@TK_TABLE_LIST.size - obj = Object.new - @@TK_TABLE_LIST << obj - obj.instance_variable_set(:@id, id) - obj.instance_variable_set(:@mutex, Mutex.new) - obj.instance_eval{ - def self.mutex - @mutex - end - def self.method_missing(m, *args) - MultiTkIp.tk_object_table(@id).__send__(m, *args) - end - } - obj.freeze - @@IP_TABLE.each{|tg, ip| ip._add_new_tables } - return obj - end - - def self.init_ip_env(script = Proc.new) - @@INIT_IP_ENV << script - if __getip.slave? - begin - raise SecurityError, "slave-IP has no permission initializing IP env" - rescue SecurityError => e - #p e.backtrace - # Is called on a Ruby/Tk library? - caller_info = e.backtrace[1] - if caller_info =~ %r{^#{MultiTkIp::BASE_DIR}/(tk|tkextlib)/[^:]+\.rb:} - # Probably, caller is a Ruby/Tk library --> allow creating - else - raise e - end - end - end - - # @@IP_TABLE.each{|tg, ip| - # ip._init_ip_env(script) - # } - @@DEFAULT_MASTER.__init_ip_env__(@@IP_TABLE, script) - end - - def self.add_tk_procs(name, args=nil, body=nil) - if name.kind_of?(Array) # => an array of [name, args, body] - name.each{|param| self.add_tk_procs(*param)} - else - name = name.to_s - @@ADD_TK_PROCS << [name, args, body] - @@IP_TABLE.each{|tg, ip| - ip._add_tk_procs(name, args, body) - } - end - end - - def self.remove_tk_procs(*names) - names.each{|name| - name = name.to_s - @@ADD_TK_PROCS.delete_if{|elem| - elem.kind_of?(Array) && elem[0].to_s == name - } - } - @@IP_TABLE.each{|tg, ip| - ip._remove_tk_procs(*names) - } - end - - def self.init_ip_internal - __getip._init_ip_internal(@@INIT_IP_ENV, @@ADD_TK_PROCS) - end -end - -# for callback operation -class MultiTkIp - def self.cb_entry_class - @@CB_ENTRY_CLASS - end - def self.get_cb_entry(cmd) - @@CB_ENTRY_CLASS.new(__getip, cmd).freeze - end - -=begin - def cb_eval(cmd, *args) - #self.eval_callback{ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args)) } - #ret = self.eval_callback{ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args)) } - ret = self.eval_callback(*args){|safe, *params| - $SAFE=safe if $SAFE < safe - TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *params)) - } - if ret.kind_of?(Exception) - raise ret - end - ret - end -=end - def cb_eval(cmd, *args) - self.eval_callback(*args, - &_proc_on_safelevel{|*params| - TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *params)) - }) - end -=begin - def cb_eval(cmd, *args) - self.eval_callback(*args){|safe, *params| - $SAFE=safe if $SAFE < safe - # TkUtil.eval_cmd(cmd, *params) - TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *params)) - } - end -=end -=begin - def cb_eval(cmd, *args) - @callback_status[0] ||= TkVariable.new - @callback_status[1] ||= TkVariable.new - st, val = @callback_status - th = Thread.new{ - self.eval_callback(*args){|safe, *params| - #p [status, val, safe, *params] - $SAFE=safe if $SAFE < safe - begin - TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *params)) - rescue TkCallbackContinue - st.value = 4 - rescue TkCallbackBreak - st.value = 3 - rescue TkCallbackReturn - st.value = 2 - rescue Exception => e - val.value = e.message - st.value = 1 - else - st.value = 0 - end - } - } - begin - st.wait - status = st.numeric - retval = val.value - rescue => e - fail e - end - - if status == 1 - fail RuntimeError, retval - elsif status == 2 - fail TkCallbackReturn, "Tk callback returns 'return' status" - elsif status == 3 - fail TkCallbackBreak, "Tk callback returns 'break' status" - elsif status == 4 - fail TkCallbackContinue, "Tk callback returns 'continue' status" - else - '' - end - end -=end - -end - -# pseudo-toplevel operation support -class MultiTkIp - # instance method - def __pseudo_toplevel - ip = MultiTkIp.__getip - (ip == @@DEFAULT_MASTER || ip == self) && - self.__pseudo_toplevel_evaluable? && @pseudo_toplevel[1] - end - - def __pseudo_toplevel=(m) - unless (Thread.current.group == ThreadGroup::Default && - MultiTkIp.__getip == @@DEFAULT_MASTER) - fail SecurityError, "no permission to manipulate" - end - - # if m.kind_of?(Module) && m.respond_to?(:pseudo_toplevel_evaluable?) - if m.respond_to?(:pseudo_toplevel_evaluable?) - @pseudo_toplevel[0] = true - @pseudo_toplevel[1] = m - else - fail ArgumentError, 'fail to set pseudo-toplevel' - end - self - end - - def __pseudo_toplevel_evaluable? - begin - @pseudo_toplevel[0] && @pseudo_toplevel[1].pseudo_toplevel_evaluable? - rescue Exception - false - end - end - - def __pseudo_toplevel_evaluable=(mode) - unless (Thread.current.group == ThreadGroup::Default && - MultiTkIp.__getip == @@DEFAULT_MASTER) - fail SecurityError, "no permission to manipulate" - end - - @pseudo_toplevel[0] = (mode)? true: false - end -end - - -################################################ -# use pseudo-toplevel feature of MultiTkIp ? -if (!defined?(Use_PseudoToplevel_Feature_of_MultiTkIp) || - Use_PseudoToplevel_Feature_of_MultiTkIp) - module MultiTkIp_PseudoToplevel_Evaluable - #def pseudo_toplevel_eval(body = Proc.new) - # Thread.current[:TOPLEVEL] = self - # begin - # body.call - # ensure - # Thread.current[:TOPLEVEL] = nil - # end - #end - - def pseudo_toplevel_evaluable? - @pseudo_toplevel_evaluable - end - - def pseudo_toplevel_evaluable=(mode) - @pseudo_toplevel_evaluable = (mode)? true: false - end - - def self.extended(mod) - mod.__send__(:extend_object, mod) - mod.instance_variable_set('@pseudo_toplevel_evaluable', true) - end - end - - class Object - alias __method_missing_alias_for_MultiTkIp__ method_missing - private :__method_missing_alias_for_MultiTkIp__ - - def method_missing(id, *args) - begin - has_top = (top = MultiTkIp.__getip.__pseudo_toplevel) && - top.respond_to?(:pseudo_toplevel_evaluable?) && - top.pseudo_toplevel_evaluable? && - top.respond_to?(id) - rescue Exception => e - has_top = false - end - - if has_top - top.__send__(id, *args) - else - __method_missing_alias_for_MultiTkIp__(id, *args) - end - end - end -else - # dummy - module MultiTkIp_PseudoToplevel_Evaluable - def pseudo_toplevel_evaluable? - false - end - end -end - - -################################################ -# evaluate a procedure on the proper interpreter -class MultiTkIp - # instance & class method - def _proc_on_safelevel(cmd=nil) # require a block for eval - if cmd - if cmd.kind_of?(Method) - _proc_on_safelevel{|*args| cmd.call(*args)} - else - _proc_on_safelevel(&cmd) - end - else - #Proc.new{|safe, *args| $SAFE=safe if $SAFE < safe; yield(*args)} - Proc.new{|safe, *args| - # avoid security error on Exception objects - untrust_proc = proc{|err| - begin - err.untrust if err.respond_to?(:untrust) - rescue SecurityError - end - err - } - $SAFE=safe if $SAFE < safe; - begin - yield(*args) - rescue Exception => e - fail untrust_proc.call(e) - end - } - end - end - def MultiTkIp._proc_on_safelevel(cmd=nil, &blk) - MultiTkIp.__getip._proc_on_safelevel(cmd, &blk) - end - - def _proc_on_current_safelevel(cmd=nil, &blk) # require a block for eval - safe = $SAFE - cmd = _proc_on_safelevel(cmd, &blk) - Proc.new{|*args| cmd.call(safe, *args)} - end - def MultiTkIp._proc_on_current_safelevel(cmd=nil, &blk) - MultiTkIp.__getip._proc_on_current_safelevel(cmd, &blk) - end - - ###################################### - # instance method - def eval_proc_core(req_val, cmd, *args) - # check - raise SecurityError, "no permission to manipulate" unless self.manipulable? - unless cmd.kind_of?(Proc) || cmd.kind_of?(Method) - raise RuntimeError, "A Proc/Method object is expected for the 'cmd' argument" - end - - # on IP thread - if @cmd_receiver == Thread.current || - (!req_val && TclTkLib.mainloop_thread? != false) # callback - begin - ret = cmd.call(safe_level, *args) - rescue SystemExit => e - # exit IP - warn("Warning: "+ e.inspect + " on " + self.inspect) if $DEBUG - begin - self._eval_without_enc('exit') - rescue Exception => e - end - self.delete - ret = nil - rescue Exception => e - if $DEBUG - warn("Warning: " + e.class.inspect + - ((e.message.length > 0)? ' "' + e.message + '"': '') + - " on " + self.inspect) - end -=begin - begin - bt = _toUTF8(e.backtrace.join("\n")) - bt.instance_variable_set(:@encoding, 'utf-8') - rescue Exception - bt = e.backtrace.join("\n") - end - begin - @interp._set_global_var('errorInfo', bt) - rescue Exception - end -=end - ret = e - end - return ret - end - - # send cmd to the proc-queue - unless req_val - begin - @cmd_queue.enq([nil, cmd, *args]) - rescue Exception => e - # ignore - if $DEBUG - warn("Warning: " + e.class.inspect + - ((e.message.length > 0)? ' "' + e.message + '"': '') + - " on " + self.inspect) - end - return e - end - return nil - end - - # send and get return value by exception - begin - @cmd_queue.enq([Thread.current, cmd, *args]) - Thread.stop - rescue MultiTkIp_OK => ret - # return value - return ret.value - rescue SystemExit => e - # exit IP - warn("Warning: " + e.inspect + " on " + self.inspect) if $DEBUG - begin - self._eval_without_enc('exit') - rescue Exception - end - if !self.deleted? && !safe? && allow_ruby_exit? - self.delete - fail e - else - self.delete - end - rescue Exception => e - if $DEBUG - warn("Warning: " + e.class.inspect + - ((e.message.length > 0)? ' "' + e.message + '"': '') + - " on " + self.inspect) - end - return e - end - return nil - end - private :eval_proc_core - -if false && WITH_RUBY_VM ### Ruby 1.9 - # Not stable, so disable this feature - def eval_callback(*args) - if block_given? - cmd = Proc.new - else - cmd = args.shift - end - begin - if @@CALLBACK_SUBTHREAD.table[self].index(Thread.current) - last_th = nil - else - last_th = @@CALLBACK_SUBTHREAD.table[self][-1] - end - @@CALLBACK_SUBTHREAD.new(self){ - @@CALLBACK_SUBTHREAD.table[self] << Thread.current - begin - last_th.join if last_th - eval_proc_core(false, cmd, *args) - rescue Exception=>e - e - ensure - @@CALLBACK_SUBTHREAD.table[self].delete(Thread.current) - end - } - end - end -else ### Ruby 1.8 - def eval_callback(*args) - if block_given? - cmd = Proc.new - else - cmd = args.shift - end - begin - eval_proc_core(false, cmd, *args) - rescue Exception=>e - e - ensure - end - end -end - - def eval_proc(*args, &blk) - if block_given? - cmd = _proc_on_safelevel(&blk) - else - unless (cmd = args.shift) - fail ArgumentError, "A Proc or Method object is expected for 1st argument" - end - cmd = _proc_on_safelevel(&cmd) - end - if TclTkLib.mainloop_thread? == true - # call from eventloop - current = Thread.current - backup_ip = current[:callback_ip] - current[:callback_ip] = self - begin - eval_proc_core(false, cmd, *args) - ensure - current[:callback_ip] = backup_ip - end - else - eval_proc_core(true, - proc{|safe, *params| - Thread.new{cmd.call(safe, *params)}.value - }, - *args) - end - end -=begin - def eval_proc(*args) - # The scope of the eval-block of 'eval_proc' method is different from - # the external. If you want to pass local values to the eval-block, - # use arguments of eval_proc method. They are passed to block-arguments. - if block_given? - cmd = Proc.new - else - unless (cmd = args.shift) - fail ArgumentError, "A Proc or Method object is expected for 1st argument" - end - end - if TclTkLib.mainloop_thread? == true - # call from eventloop - current = Thread.current - backup_ip = current[:callback_ip] - current[:callback_ip] = self - begin - eval_proc_core(false, - proc{|safe, *params| - $SAFE=safe if $SAFE < safe - cmd.call(*params) - }, *args) - ensure - current[:callback_ip] = backup_ip - end - else - eval_proc_core(true, - proc{|safe, *params| - $SAFE=safe if $SAFE < safe - Thread.new(*params, &cmd).value - }, - *args) - end - end -=end - alias call eval_proc - - def bg_eval_proc(*args) - if block_given? - cmd = Proc.new - else - unless (cmd = args.shift) - fail ArgumentError, "A Proc or Method object is expected for 1st argument" - end - end - Thread.new{ - eval_proc(cmd, *args) -=begin - eval_proc_core(false, - proc{|safe, *params| - $SAFE=safe if $SAFE < safe - Thread.new(*params, &cmd).value - }, - safe_level, *args) -=end - } - end - alias background_eval_proc bg_eval_proc - alias thread_eval_proc bg_eval_proc - alias bg_call bg_eval_proc - alias background_call bg_eval_proc - - def eval_string(cmd, *eval_args) - # cmd string ==> proc - unless cmd.kind_of?(String) - raise RuntimeError, "A String object is expected for the 'cmd' argument" - end - - eval_proc_core(true, - proc{|safe| - Kernel.eval("$SAFE=#{safe} if $SAFE < #{safe};" << cmd, - *eval_args) - }) - end - alias eval_str eval_string - - def bg_eval_string(cmd, *eval_args) - # cmd string ==> proc - unless cmd.kind_of?(String) - raise RuntimeError, "A String object is expected for the 'cmd' argument" - end - Thread.new{ - eval_proc_core(true, - proc{|safe| - Kernel.eval("$SAFE=#{safe} if $SAFE < #{safe};" << cmd, - *eval_args) - }) - } - end - alias background_eval_string bg_eval_string - alias bg_eval_str bg_eval_string - alias background_eval_str bg_eval_string - - def eval(*args, &blk) - if block_given? - eval_proc(*args, &blk) - elsif args[0] - if args[0].respond_to?(:call) - eval_proc(*args) - else - eval_string(*args) - end - else - fail ArgumentError, "no argument to eval" - end - end - - def bg_eval(*args, &blk) - if block_given? - bg_eval_proc(*args, &blk) - elsif args[0] - if args[0].respond_to?(:call) - bg_eval_proc(*args) - else - bg_eval_string(*args) - end - else - fail ArgumentError, "no argument to eval" - end - end - alias background_eval bg_eval -end - -class << MultiTkIp - # class method - def eval_proc(*args, &blk) - # class ==> interp object - __getip.eval_proc(*args, &blk) - end - alias call eval_proc - - def bg_eval_proc(*args, &blk) - # class ==> interp object - __getip.bg_eval_proc(*args, &blk) - end - alias background_eval_proc bg_eval_proc - alias thread_eval_proc bg_eval_proc - alias bg_call bg_eval_proc - alias background_call bg_eval_proc - - def eval_string(cmd, *eval_args) - # class ==> interp object - __getip.eval_string(cmd, *eval_args) - end - alias eval_str eval_string - - def bg_eval_string(cmd, *eval_args) - # class ==> interp object - __getip.bg_eval_string(cmd, *eval_args) - end - alias background_eval_string bg_eval_string - alias bg_eval_str bg_eval_string - alias background_eval_str bg_eval_string - - def eval(*args, &blk) - # class ==> interp object - __getip.eval(*args, &blk) - end - def bg_eval(*args, &blk) - # class ==> interp object - __getip.bg_eval(*args, &blk) - end - alias background_eval bg_eval -end - - -# event loop -# all master/slave IPs are controlled by only one event-loop -class MultiTkIp - def self.default_master? - __getip == @@DEFAULT_MASTER - end -end -class << MultiTkIp - def mainloop(check_root = true) - __getip.mainloop(check_root) - end - def mainloop_watchdog(check_root = true) - __getip.mainloop_watchdog(check_root) - end - def do_one_event(flag = TclTkLib::EventFlag::ALL) - __getip.do_one_event(flag) - end - def 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) - TclTkLib.mainloop_abort_on_exception=(mode) - end - def set_eventloop_tick(tick) - __getip.set_eventloop_tick(tick) - end - def get_eventloop_tick - __getip.get_eventloop_tick - end - def set_no_event_wait(tick) - __getip.set_no_event_wait(tick) - end - def get_no_event_wait - __getip.get_no_event_wait - end - def set_eventloop_weight(loop_max, no_event_tick) - __getip.set_eventloop_weight(loop_max, no_event_tick) - end - def get_eventloop_weight - __getip.get_eventloop_weight - end -end - -# class methods to delegate to TclTkIp -class << MultiTkIp - def method_missing(id, *args) - __getip.__send__(id, *args) - end - - def make_safe - __getip.make_safe - end - - def safe? - __getip.safe? - end - - def safe_base? - begin - __getip.safe_base? - rescue - false - end - end - - def allow_ruby_exit? - __getip.allow_ruby_exit? - end - - def allow_ruby_exit= (mode) - __getip.allow_ruby_exit = mode - end - - def delete - __getip.delete - end - - def deleted? - __getip.deleted? - end - - def has_mainwindow? - __getip.has_mainwindow? - end - - def invalid_namespace? - __getip.invalid_namespace? - end - - def abort(msg = nil) - __getip.abort(msg) - end - - def exit(st = true) - __getip.exit(st) - end - - def exit!(st = false) - __getip.exit!(st) - end - - def restart(app_name = nil, keys = {}) - init_ip_internal - - __getip._invoke('set', 'argv0', app_name) if app_name - if keys.kind_of?(Hash) - __getip._invoke('set', 'argv', _keys2opts(keys)) - end - - __getip.restart - end - - def _eval(str) - __getip._eval(str) - end - - def _invoke(*args) - __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=nil) - __getip._toUTF8(str, encoding) - end - - def _fromUTF8(str, encoding=nil) - __getip._fromUTF8(str, encoding) - end - - def _thread_vwait(var) - __getip._thread_vwait(var) - end - - def _thread_tkwait(mode, target) - __getip._thread_tkwait(mode, target) - end - - 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 _make_menu_embeddable(menu_path) - __getip._make_menu_embeddable(menu_path) - 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 - - def _create_console - __getip._create_console - end -end - - -# wrap methods on TclTkLib : not permit calling TclTkLib module methods -class << TclTkLib - def mainloop(check_root = true) - MultiTkIp.mainloop(check_root) - end - def mainloop_watchdog(check_root = true) - MultiTkIp.mainloop_watchdog(check_root) - end - 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 set_eventloop_tick(tick) - MultiTkIp.set_eventloop_tick(tick) - end - def get_eventloop_tick - MultiTkIp.get_eventloop_tick - end - def set_no_event_wait(tick) - MultiTkIp.set_no_event_wait(tick) - end - def get_no_event_wait - MultiTkIp.get_no_event_wait - end - def set_eventloop_weight(loop_max, no_event_tick) - MultiTkIp.set_eventloop_weight(loop_max, no_event_tick) - end - def get_eventloop_weight - MultiTkIp.get_eventloop_weight - end - def restart(*args) - MultiTkIp.restart(*args) - 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) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - if WITH_RUBY_VM ### Ruby 1.9 !!!!!!!!!!! - return @interp_thread.value if @interp_thread - end - - #return self if self.slave? - #return self if self != @@DEFAULT_MASTER - if self != @@DEFAULT_MASTER - if @wait_on_mainloop[0] - begin - @wait_on_mainloop[1] += 1 - @cmd_queue.enq([@system, 'call_mainloop', - Thread.current, check_root]) - Thread.stop - rescue MultiTkIp_OK => ret - # return value - if ret.value.kind_of?(Thread) - return ret.value.value - else - return ret.value - end - rescue SystemExit => e - # exit IP - warn("Warning: " + e.inspect + " on " + self.inspect) if $DEBUG - begin - self._eval_without_enc('exit') - rescue Exception - end - self.delete - rescue StandardError => e - if $DEBUG - warn("Warning: " + e.class.inspect + - ((e.message.length > 0)? ' "' + e.message + '"': '') + - " on " + self.inspect) - end - return e - rescue Exception => e - return e - ensure - @wait_on_mainloop[1] -= 1 - end - end - return - end - - unless restart_on_dead - @wait_on_mainloop[1] += 1 -=begin - begin - @interp.mainloop(check_root) - rescue StandardError => e - if $DEBUG - warn("Warning: " + e.class.inspect + - ((e.message.length > 0)? ' "' + e.message + '"': '') + - " on " + self.inspect) - end - end -=end - begin - @interp.mainloop(check_root) - ensure - @wait_on_mainloop[1] -= 1 - end - else - loop do - break unless self.alive? - if check_root - begin - break if TclTkLib.num_of_mainwindows == 0 - rescue StandardError - break - end - end - break if @interp.deleted? - begin - @wait_on_mainloop[1] += 1 - @interp.mainloop(check_root) - rescue StandardError => e - if TclTkLib.mainloop_abort_on_exception != nil - #STDERR.print("Warning: Tk mainloop receives ", $!.class.inspect, - # " exception (ignore) : ", $!.message, "\n"); - if $DEBUG - warn("Warning: Tk mainloop receives " << e.class.inspect << - " exception (ignore) : " << e.message); - end - end - #raise e - rescue Exception => e -=begin - if TclTkLib.mainloop_abort_on_exception != nil - #STDERR.print("Warning: Tk mainloop receives ", $!.class.inspect, - # " exception (ignore) : ", $!.message, "\n"); - if $DEBUG - warn("Warning: Tk mainloop receives " << e.class.inspect << - " exception (ignore) : " << e.message); - end - end -=end - raise e - ensure - @wait_on_mainloop[1] -= 1 - Thread.pass # avoid eventloop conflict - end - end - end - self - end - - def make_safe - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.make_safe - end - - def safe? - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.safe? - end - - def safe_base? - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @safe_base - end - - def allow_ruby_exit? - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.allow_ruby_exit? - end - - def allow_ruby_exit= (mode) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.allow_ruby_exit = mode - end - - def delete - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @slave_ip_tbl.each{|name, subip| - _destroy_slaves_of_slaveIP(subip) -=begin - begin - subip._invoke('destroy', '.') unless subip.deleted? - rescue Exception - end -=end - begin - # subip._eval_without_enc("foreach i [after info] {after cancel $i}") - unless subip.deleted? - after_ids = subip._eval_without_enc("after info") - subip._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") - end - rescue Exception - end - - # safe_base? - if @interp._eval_without_enc("catch {::safe::interpConfigure #{name}}") == '0' - begin - @interp._eval_without_enc("::safe::interpDelete #{name}") - rescue Exception - else - next if subip.deleted? - end - end - if subip.respond_to?(:safe_base?) && subip.safe_base? && - !subip.deleted? - # do 'exit' to call the delete_hook procedure - begin - subip._eval_without_enc('exit') - rescue Exception - end - else - begin - subip.delete unless subip.deleted? - rescue Exception - end - end - } - - begin - # @interp._eval_without_enc("foreach i [after info] {after cancel $i}") - after_ids = @interp._eval_without_enc("after info") - @interp._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}") - rescue Exception - end - - begin - @interp._invoke('destroy', '.') unless @interp.deleted? - rescue Exception - end - - if @safe_base && !@interp.deleted? - # do 'exit' to call the delete_hook procedure - @interp._eval_without_enc('exit') - end - @interp.delete - self - end - - def deleted? - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.deleted? - end - - def has_mainwindow? - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.has_mainwindow? - end - - def invalid_namespace? - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.invalid_namespace? - end - - def abort(msg = nil) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - if master? && !safe? && allow_ruby_exit? - if msg - Kernel.abort(msg) - else - Kernel.abort - end - else - # ignore msg - delete - 1 - end - end - - def exit(st = true) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - if master? && !safe? && allow_ruby_exit? - Kernel.exit(st) - else - delete - st - end - end - - def exit!(st = false) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - if master? && !safe? && allow_ruby_exit? - Kernel.exit!(st) - else - delete - st - end - end - - def restart(app_name = nil, keys = {}) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - _init_ip_internal(@@INIT_IP_ENV, @@ADD_TK_PROCS) - - @interp._invoke('set', 'argv0', app_name) if app_name - if keys.kind_of?(Hash) - @interp._invoke('set', 'argv', _keys2opts(keys)) - end - - @interp.restart - end - - def __eval(str) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.__eval(str) - end - - def __invoke(*args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.__invoke(*args) - end - - def _eval(str) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._eval(str) - end - - def _invoke(*args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke(*args) - end - - def _eval_without_enc(str) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._eval_without_enc(str) - end - - def _invoke_without_enc(*args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke_without_enc(*args) - end - - def _eval_with_enc(str) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._eval_with_enc(str) - end - - def _invoke_with_enc(*args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke_with_enc(*args) - end - - def _toUTF8(str, encoding=nil) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._toUTF8(str, encoding) - end - - def _fromUTF8(str, encoding=nil) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._fromUTF8(str, encoding) - end - - def _thread_vwait(var) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._thread_vwait(var) - end - - def _thread_tkwait(mode, target) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._thread_tkwait(mode, target) - end - - def _return_value - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._return_value - end - - def _get_variable(var, flag) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._get_variable(var, flag) - end - def _get_variable2(var, idx, flag) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._get_variable2(var, idx, flag) - end - def _set_variable(var, value, flag) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._set_variable(var, value, flag) - end - def _set_variable2(var, idx, value, flag) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._set_variable2(var, idx, value, flag) - end - def _unset_variable(var, flag) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._unset_variable(var, flag) - end - def _unset_variable2(var, idx, flag) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._unset_variable2(var, idx, flag) - end - - def _get_global_var(var) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._get_global_var(var) - end - def _get_global_var2(var, idx) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._get_global_var2(var, idx) - end - def _set_global_var(var, value) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._set_global_var(var, value) - end - def _set_global_var2(var, idx, value) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._set_global_var2(var, idx, value) - end - def _unset_global_var(var) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._unset_global_var(var) - end - def _unset_global_var2(var, idx) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._unset_global_var2(var, idx) - end - - def _make_menu_embeddable(menu_path) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._make_menu_embeddable(menu_path) - end - - def _split_tklist(str) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._split_tklist(str) - end - def _merge_tklist(*args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._merge_tklist(*args) - end - def _conv_listelement(arg) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._conv_listelement(arg) - end -end - - -# interp command support -class MultiTkIp - def _lst2ary(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 - brace = 1 - str.each_byte {|c| - c = c.chr - i += 1 - brace += 1 if c == '{' - brace -= 1 if c == '}' - break if brace == 0 - } - if i == 0 - list.push '' - elsif str[0, i] == ' ' - list.push ' ' - else - list.push str[0..i-1] - end - #list += _lst2ary(str[i+1..-1]) - list.concat(_lst2ary(str[i+1..-1])) - list - end - private :_lst2ary - - def _slavearg(slave) - if slave.kind_of?(MultiTkIp) - slave.path - elsif slave.kind_of?(String) - slave - else - slave.to_s - end - end - private :_slavearg - - def alias_info(slave, cmd_name) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - _lst2ary(@interp._invoke('interp', 'alias', _slavearg(slave), cmd_name)) - end - def self.alias_info(slave, cmd_name) - __getip.alias_info(slave, cmd_name) - end - - def alias_delete(slave, cmd_name) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'alias', _slavearg(slave), cmd_name, '') - self - end - def self.alias_delete(slave, cmd_name) - __getip.alias_delete(slave, cmd_name) - self - end - - def def_alias(slave, new_cmd, org_cmd, *args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - ret = @interp._invoke('interp', 'alias', _slavearg(slave), new_cmd, - '', org_cmd, *args) - (ret == new_cmd)? self: nil - end - def self.def_alias(slave, new_cmd, org_cmd, *args) - ret = __getip.def_alias(slave, new_cmd, org_cmd, *args) - (ret == new_cmd)? self: nil - end - - def aliases(slave = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - _lst2ary(@interp._invoke('interp', 'aliases', _slavearg(slave))) - end - def self.aliases(slave = '') - __getip.aliases(slave) - end - - def delete_slaves(*args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - slaves = args.collect{|s| _slavearg(s)} - @interp._invoke('interp', 'delete', *slaves) if slaves.size > 0 - self - end - def self.delete_slaves(*args) - __getip.delete_slaves(*args) - self - end - - def exist?(slave = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - ret = @interp._invoke('interp', 'exists', _slavearg(slave)) - (ret == '1')? true: false - end - def self.exist?(slave = '') - __getip.exist?(slave) - end - - def delete_cmd(slave, cmd) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - slave_invoke = @interp._invoke('list', 'rename', cmd, '') - @interp._invoke('interp', 'eval', _slavearg(slave), slave_invoke) - self - end - def self.delete_cmd(slave, cmd) - __getip.delete_cmd(slave, cmd) - self - end - - def expose_cmd(slave, cmd, aliasname = nil) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - if aliasname - @interp._invoke('interp', 'expose', _slavearg(slave), cmd, aliasname) - else - @interp._invoke('interp', 'expose', _slavearg(slave), cmd) - end - self - end - def self.expose_cmd(slave, cmd, aliasname = nil) - __getip.expose_cmd(slave, cmd, aliasname) - self - end - - def hide_cmd(slave, cmd, aliasname = nil) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - if aliasname - @interp._invoke('interp', 'hide', _slavearg(slave), cmd, aliasname) - else - @interp._invoke('interp', 'hide', _slavearg(slave), cmd) - end - self - end - def self.hide_cmd(slave, cmd, aliasname = nil) - __getip.hide_cmd(slave, cmd, aliasname) - self - end - - def hidden_cmds(slave = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - _lst2ary(@interp._invoke('interp', 'hidden', _slavearg(slave))) - end - def self.hidden_cmds(slave = '') - __getip.hidden_cmds(slave) - end - - def invoke_hidden(slave, cmd, *args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - if args[-1].kind_of?(Hash) - keys = _symbolkey2str(args.pop) - else - keys = [] - end - keys << _slavearg(slave) - if Tk::TCL_MAJOR_VERSION > 8 || - (Tk::TCL_MAJOR_VERSION == 8 && Tk::TCL_MINOR_VERSION >= 5) - keys << '--' - end - keys << cmd - keys.concat(args) - @interp._invoke('interp', 'invokehidden', *keys) - end - def self.invoke_hidden(slave, cmd, *args) - __getip.invoke_hidden(slave, cmd, *args) - end - - def invoke_hidden_on_global(slave, cmd, *args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - if args[-1].kind_of?(Hash) - keys = _symbolkey2str(args.pop) - else - keys = [] - end - keys << _slavearg(slave) - keys << '-global' - if Tk::TCL_MAJOR_VERSION > 8 || - (Tk::TCL_MAJOR_VERSION == 8 && Tk::TCL_MINOR_VERSION >= 5) - keys << '--' - end - keys << cmd - keys.concat(args) - @interp._invoke('interp', 'invokehidden', *keys) - end - def self.invoke_hidden_on_global(slave, cmd, *args) - __getip.invoke_hidden_on_global(slave, cmd, *args) - end - - def invoke_hidden_on_namespace(slave, ns, cmd, *args) - # for Tcl8.5 or later - raise SecurityError, "no permission to manipulate" unless self.manipulable? - if args[-1].kind_of?(Hash) - keys = _symbolkey2str(args.pop) - else - keys = [] - end - keys << _slavearg(slave) - keys << '-namespace' << TkComm._get_eval_string(ns) - keys << '--' << cmd - keys.concat(args) - @interp._invoke('interp', 'invokehidden', *keys) - end - def self.invoke_hidden_on_namespace(slave, ns, cmd, *args) - __getip.invoke_hidden_on_namespace(slave, ns, cmd, *args) - end - - def mark_trusted(slave = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'marktrusted', _slavearg(slave)) - self - end - def self.mark_trusted(slave = '') - __getip.mark_trusted(slave) - self - end - - def set_bgerror_handler(cmd = Proc.new, slave = nil, &b) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - unless TkComm._callback_entry?(cmd) - if !slave && b - slave = cmd - cmd = Proc.new(&b) - end - end - slave = '' unless slave - - @interp._invoke('interp', 'bgerror', _slavearg(slave), cmd) - end - def self.bgerror(cmd = Proc.new, slave = nil, &b) - __getip.bgerror(cmd, slave, &b) - end - - def get_bgerror_handler(slave = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - procedure(@interp._invoke('interp', 'bgerror', _slavearg(slave))) - end - def self.bgerror(slave = '') - __getip.bgerror(slave) - end - - def set_limit(limit_type, slave = '', opts = {}) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'limit', _slavearg(slave), limit_type, opts) - end - def self.set_limit(limit_type, slave = '', opts = {}) - __getip.set_limit(limit_type, slave, opts) - end - - def get_limit(limit_type, slave = '', slot = nil) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - if slot - num_or_str(@interp._invoke('interp', 'limit', _slavearg(slave), - limit_type, slot)) - else - l = @interp._split_tklist(@interp._invoke_without_enc('interp', 'limit', - _slavearg(slave), - limit_type)) - l.map!{|s| _fromUTF8(s)} - r = {} - until l.empty? - key = l.shift[1..-1] - val = l.shift - val = num_or_str(val) if val - r[key] = val - end - r - end - end - def self.get_limit(limit_type, slave = '', slot = nil) - __getip.get_limit(limit_type, slave, slot) - end - - def recursion_limit(slave = '', limit = None) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - 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 = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'target', _slavearg(slave), aliascmd) - end - def self.alias_target(aliascmd, slave = '') - __getip.alias_target(aliascmd, slave) - end - - def share_stdin(dist, src = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'share', src, 'stdin', dist) - self - end - def self.share_stdin(dist, src = '') - __getip.share_stdin(dist, src) - self - end - - def share_stdout(dist, src = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'share', src, 'stdout', dist) - self - end - def self.share_stdout(dist, src = '') - __getip.share_stdout(dist, src) - self - end - - def share_stderr(dist, src = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'share', src, 'stderr', dist) - self - end - def self.share_stderr(dist, src = '') - __getip.share_stderr(dist, src) - self - end - - def transfer_stdin(dist, src = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'transfer', src, 'stdin', dist) - self - end - def self.transfer_stdin(dist, src = '') - __getip.transfer_stdin(dist, src) - self - end - - def transfer_stdout(dist, src = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'transfer', src, 'stdout', dist) - self - end - def self.transfer_stdout(dist, src = '') - __getip.transfer_stdout(dist, src) - self - end - - def transfer_stderr(dist, src = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'transfer', src, 'stderr', dist) - self - end - def self.transfer_stderr(dist, src = '') - __getip.transfer_stderr(dist, src) - self - end - - def share_stdio(dist, src = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'share', src, 'stdin', dist) - @interp._invoke('interp', 'share', src, 'stdout', dist) - @interp._invoke('interp', 'share', src, 'stderr', dist) - self - end - def self.share_stdio(dist, src = '') - __getip.share_stdio(dist, src) - self - end - - def transfer_stdio(dist, src = '') - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._invoke('interp', 'transfer', src, 'stdin', dist) - @interp._invoke('interp', 'transfer', src, 'stdout', dist) - @interp._invoke('interp', 'transfer', src, 'stderr', dist) - self - end - def self.transfer_stdio(dist, src = '') - __getip.transfer_stdio(dist, src) - self - end -end - - -# Safe Base :: manipulating safe interpreter -class MultiTkIp - def safeip_configure(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 + ' ' + _keys2opts(slot)) - 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' -=begin - if conf[1] =~ /^rb_out\S* (c(_\d+_)?\d+)/ - ret[conf[0][1..-1]] = MultiTkIp._tk_cmd_tbl[$1] -=end - if conf[1] =~ /rb_out\S*(?:\s+(::\S*|[{](::.*)[}]|["](::.*)["]))? (c(_\d+_)?(\d+))/ - ret[conf[0][1..-1]] = MultiTkIp._tk_cmd_tbl[$4] - 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' -=begin - if v =~ /^rb_out\S* (c(_\d+_)?\d+)/ - ret[k[1..-1]] = MultiTkIp._tk_cmd_tbl[$1] -=end - if v =~ /rb_out\S*(?:\s+(::\S*|[{](::.*)[}]|["](::.*)["]))? (c(_\d+_)?(\d+))/ - ret[k[1..-1]] = MultiTkIp._tk_cmd_tbl[$4] - else - ret[k[1..-1]] = v - end - else - ret[k[1..-1]] = v - end - } - end - ret - end - - def safeip_delete - ip = MultiTkIp.__getip - ip._eval("::safe::interpDelete " + @ip_name) - end - - def safeip_add_to_access_path(dir) - ip = MultiTkIp.__getip - ip._eval("::safe::interpAddToAccessPath #{@ip_name} #{dir}") - end - - def safeip_find_in_access_path(dir) - ip = MultiTkIp.__getip - ip._eval("::safe::interpFindInAccessPath #{@ip_name} #{dir}") - end - - def safeip_set_log_cmd(cmd = Proc.new) - ip = MultiTkIp.__getip - ip._eval("::safe::setLogCmd #{@ip_name} #{_get_eval_string(cmd)}") - end -end - - -# encoding convert -class << MultiTkIp - def encoding_table - __getip.encoding_table - end - - def force_default_encoding=(mode) - __getip.force_default_encoding=(mode) - end - - def force_default_encoding? - __getip.force_default_encoding? - end - - def default_encoding=(enc) - __getip.default_encoding=(enc) - end - - def encoding=(enc) - __getip.encoding=(enc) - end - - def encoding_name - __getip.encoding_name - end - - def encoding_obj - __getip.encoding_obj - end - alias encoding encoding_name - alias default_encoding encoding_name - - def encoding_convertfrom(str, enc=None) - __getip.encoding_convertfrom(str, enc) - end - alias encoding_convert_from encoding_convertfrom - - def encoding_convertto(str, enc=None) - __getip.encoding_convertto(str, enc) - end - alias encoding_convert_to encoding_convertto -end -class MultiTkIp - def encoding_table - @interp.encoding_table - end - - def force_default_encoding=(mode) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.force_default_encoding = mode - end - def force_default_encoding? - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.force_default_encoding? - end - - def default_encoding=(enc) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.default_encoding = enc - end - - def encoding=(enc) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.encoding = enc - end - def encoding_name - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.encoding_name - end - def encoding_obj - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.encoding_obj - end - alias encoding encoding_name - alias default_encoding encoding_name - - def encoding_convertfrom(str, enc=None) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.encoding_convertfrom(str, enc) - end - alias encoding_convert_from encoding_convertfrom - - def encoding_convertto(str, enc=None) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp.encoding_convertto(str, enc) - end - alias encoding_convert_to encoding_convertto -end - - -# remove methods for security -=begin -class MultiTkIp - INTERP_THREAD = @@DEFAULT_MASTER.instance_variable_get('@interp_thread') - INTERP_MUTEX = INTERP_THREAD[:mutex] - INTERP_ROOT_CHECK = INTERP_THREAD[:root_check] - - # undef_method :instance_eval - undef_method :instance_variable_get - undef_method :instance_variable_set -end - -module TkCore - if MultiTkIp::WITH_RUBY_VM && - ! MultiTkIp::RUN_EVENTLOOP_ON_MAIN_THREAD ### check Ruby 1.9 !!!!!!! - INTERP_THREAD = MultiTkIp::INTERP_THREAD - INTERP_MUTEX = MultiTkIp::INTERP_MUTEX - INTERP_ROOT_CHECK = MultiTkIp::INTERP_ROOT_CHECK - end -end -class MultiTkIp - remove_const(:INTERP_THREAD) - remove_const(:INTERP_MUTEX) - remove_const(:INTERP_ROOT_CHECK) -end -=end -if MultiTkIp::WITH_RUBY_VM && - ! MultiTkIp::RUN_EVENTLOOP_ON_MAIN_THREAD ### check Ruby 1.9 !!!!!!! - class MultiTkIp - INTERP_THREAD = @@DEFAULT_MASTER.instance_variable_get('@interp_thread') - INTERP_THREAD_STATUS = INTERP_THREAD[:status] - INTERP_MUTEX = INTERP_THREAD[:mutex] - INTERP_ROOT_CHECK = INTERP_THREAD[:root_check] - end - module TkCore - INTERP_THREAD = MultiTkIp::INTERP_THREAD - INTERP_THREAD_STATUS = MultiTkIp::INTERP_THREAD_STATUS - INTERP_MUTEX = MultiTkIp::INTERP_MUTEX - INTERP_ROOT_CHECK = MultiTkIp::INTERP_ROOT_CHECK - end - class MultiTkIp - remove_const(:INTERP_THREAD) - remove_const(:INTERP_THREAD_STATUS) - remove_const(:INTERP_MUTEX) - remove_const(:INTERP_ROOT_CHECK) - end -end - -class MultiTkIp - # undef_method :instance_eval - undef_method :instance_variable_get - undef_method :instance_variable_set -end -# end of MultiTkIp definition - -# defend against modification -#MultiTkIp.freeze -#TclTkLib.freeze - -######################################## -# start Tk which depends on MultiTkIp -module TkCore - INTERP = MultiTkIp -end -require 'tk' diff --git a/ext/tk/lib/remote-tk.rb b/ext/tk/lib/remote-tk.rb deleted file mode 100644 index 4d33637c30..0000000000 --- a/ext/tk/lib/remote-tk.rb +++ /dev/null @@ -1,527 +0,0 @@ -# frozen_string_literal: false -# -# remote-tk.rb - supports to control remote Tk interpreters -# by Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> - -if defined? MultiTkIp - fail RuntimeError, "'remote-tk' library must be required before requiring 'multi-tk'" -end - -require 'tkutil' - -class MultiTkIp; end -class RemoteTkIp < MultiTkIp; end - -class MultiTkIp - @@IP_TABLE = TkUtil.untrust({}) unless defined?(@@IP_TABLE) - @@TK_TABLE_LIST = TkUtil.untrust([]) unless defined?(@@TK_TABLE_LIST) - def self._IP_TABLE; @@IP_TABLE; end - def self._TK_TABLE_LIST; @@TK_TABLE_LIST; end - - @flag = true - def self._DEFAULT_MASTER - # work only once - if @flag - @flag = nil - @@DEFAULT_MASTER - else - nil - end - end -end -class RemoteTkIp - @@IP_TABLE = MultiTkIp._IP_TABLE unless defined?(@@IP_TABLE) - @@TK_TABLE_LIST = MultiTkIp._TK_TABLE_LIST unless defined?(@@TK_TABLE_LIST) -end -class << MultiTkIp - undef _IP_TABLE - undef _TK_TABLE_LIST -end - -require 'multi-tk' - -class RemoteTkIp - if defined?(@@DEFAULT_MASTER) - MultiTkIp._DEFAULT_MASTER - else - @@DEFAULT_MASTER = MultiTkIp._DEFAULT_MASTER - end -end - - -############################### - -class << RemoteTkIp - undef new_master, new_slave, new_safe_slave - undef new_trusted_slave, new_safeTk - - def new(*args, &b) - ip = __new(*args) - ip.eval_proc(&b) if b - ip - end -end - -class RemoteTkIp - def initialize(remote_ip, displayof=nil, timeout=5) - @interp = MultiTkIp.__getip - if @interp.safe? - fail SecurityError, "safe-IP cannot create RemoteTkIp" - end - - - @interp.allow_ruby_exit = false - @appname = @interp._invoke('tk', 'appname') - @remote = remote_ip.to_s.dup.freeze - if displayof.kind_of?(TkWindow) - @displayof = displayof.path.dup.freeze - else - @displayof = nil - end - if self.deleted? - fail RuntimeError, "no Tk application named \"#{@remote}\"" - end - - @tk_windows = {} - @tk_table_list = [] - @slave_ip_tbl = {} - @slave_ip_top = {} - - @force_default_encoding ||= TkUtil.untrust([false]) - @encoding ||= TkUtil.untrust([nil]) - def @encoding.to_s; self.join(nil); end - - TkUtil.untrust(@tk_windows) unless @tk_windows.tainted? - TkUtil.untrust(@tk_table_list) unless @tk_table_list.tainted? - TkUtil.untrust(@slave_ip_tbl) unless @slave_ip_tbl.tainted? - TkUtil.untrust(@slave_ip_top) unless @slave_ip_top.tainted? - - @system = Object.new - - @threadgroup = ThreadGroup.new - - @safe_level = [$SAFE] - - @wait_on_mainloop = [true, 0] - - @cmd_queue = Queue.new - -=begin - @cmd_receiver, @receiver_watchdog = _create_receiver_and_watchdog() - - @threadgroup.add @cmd_receiver - @threadgroup.add @receiver_watchdog - - @threadgroup.enclose -=end - @@DEFAULT_MASTER.assign_receiver_and_watchdog(self) - - @@IP_TABLE[@threadgroup] = self - @@TK_TABLE_LIST.size.times{ - (tbl = {}).tainted? || TkUtil.untrust(tbl) - @tk_table_list << tbl - } - - @ret_val = TkVariable.new - if timeout > 0 && ! _available_check(timeout) - fail RuntimeError, "cannot create connection" - end - @ip_id = _create_connection - - class << self - undef :instance_eval - end - - self.freeze # defend against modification - end - - def manipulable? - return true if (Thread.current.group == ThreadGroup::Default) - MultiTkIp.__getip == @interp && ! @interp.safe? - end - def self.manipulable? - true - end - - def _is_master_of?(tcltkip_obj) - tcltkip_obj == @interp - end - protected :_is_master_of? - - def _ip_id_ - @ip_id - end - - def _available_check(timeout = 5) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - return nil if timeout < 1 - @ret_val.value = '' - @interp._invoke('send', '-async', @remote, - 'send', '-async', Tk.appname, - "set #{@ret_val.id} ready") - Tk.update - if @ret_val != 'ready' - (1..(timeout*5)).each{ - sleep 0.2 - Tk.update - break if @ret_val == 'ready' - } - end - @ret_val.value == 'ready' - end - private :_available_check - - def _create_connection - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - ip_id = '_' + @interp._invoke('send', @remote, <<-'EOS') + '_' - if {[catch {set _rubytk_control_ip_id_} ret] != 0} { - set _rubytk_control_ip_id_ 0 - } else { - set _rubytk_control_ip_id_ [expr $ret + 1] - } - return $_rubytk_control_ip_id_ - EOS - - @interp._invoke('send', @remote, <<-EOS) - proc rb_out#{ip_id} args { - send #{@appname} rb_out \$args - } - EOS - - ip_id - end - private :_create_connection - - def _appsend(enc_mode, async, *cmds) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - p ['_appsend', [@remote, @displayof], enc_mode, async, cmds] if $DEBUG - if $SAFE >= 1 && cmds.find{|obj| obj.tainted?} - fail SecurityError, "cannot send tainted commands at level #{$SAFE}" - end - - cmds = @interp._merge_tklist(*TkUtil::_conv_args([], enc_mode, *cmds)) - if @displayof - if async - @interp.__invoke('send', '-async', '-displayof', @displayof, - '--', @remote, *cmds) - else - @interp.__invoke('send', '-displayof', @displayof, - '--', @remote, *cmds) - end - else - if async - @interp.__invoke('send', '-async', '--', @remote, *cmds) - else - @interp.__invoke('send', '--', @remote, *cmds) - end - end - end - private :_appsend - - def ready?(timeout=5) - if timeout < 0 - fail ArgumentError, "timeout must be positive number" - end - _available_check(timeout) - end - - def is_rubytk? - return false if _appsend(false, false, 'info', 'command', 'ruby') == "" - [ _appsend(false, false, 'ruby', 'RUBY_VERSION'), - _appsend(false, false, 'set', 'tk_patchLevel') ] - end - - def appsend(async, *args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - if async != true && async != false && async != nil - args.unshift(async) - async = false - end - if @displayof - Tk.appsend_displayof(@remote, @displayof, async, *args) - else - Tk.appsend(@remote, async, *args) - end - end - - def rb_appsend(async, *args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - if async != true && async != false && async != nil - args.unshift(async) - async = false - end - if @displayof - Tk.rb_appsend_displayof(@remote, @displayof, async, *args) - else - Tk.rb_appsend(@remote, async, *args) - end - end - - def create_slave(name, safe=false) - if safe - safe_opt = '' - else - safe_opt = '-safe' - end - _appsend(false, false, "interp create #{safe_opt} -- #{name}") - end - - def make_safe - fail RuntimeError, 'cannot change safe mode of the remote interpreter' - end - - def safe? - _appsend(false, false, 'interp issafe') - end - - def safe_base? - false - end - - def allow_ruby_exit? - false - end - - def allow_ruby_exit= (mode) - fail RuntimeError, 'cannot change mode of the remote interpreter' - end - - def delete - _appsend(false, true, 'exit') - end - - def deleted? - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - if @displayof - lst = @interp._invoke_without_enc('winfo', 'interps', - '-displayof', @displayof) - else - lst = @interp._invoke_without_enc('winfo', 'interps') - end - # unless @interp._split_tklist(lst).index(@remote) - unless @interp._split_tklist(lst).index(_toUTF8(@remote)) - true - else - false - end - end - - def has_mainwindow? - raise SecurityError, "no permission to manipulate" unless self.manipulable? - - begin - inf = @interp._invoke_without_enc('info', 'command', '.') - rescue Exception - return nil - end - if !inf.kind_of?(String) || inf != '.' - false - else - true - end - end - - def invalid_namespace? - false - end - - def restart - fail RuntimeError, 'cannot restart the remote interpreter' - end - - def __eval(str) - _appsend(false, false, str) - end - def _eval(str) - _appsend(nil, false, str) - end - def _eval_without_enc(str) - _appsend(false, false, str) - end - def _eval_with_enc(str) - _appsend(true, false, str) - end - - def _invoke(*args) - _appsend(nil, false, *args) - end - - def __invoke(*args) - _appsend(false, false, *args) - end - def _invoke(*args) - _appsend(nil, false, *args) - end - def _invoke_without_enc(*args) - _appsend(false, false, *args) - end - def _invoke_with_enc(*args) - _appsend(true, false, *args) - end - - def _toUTF8(str, encoding=nil) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._toUTF8(str, encoding) - end - - def _fromUTF8(str, encoding=nil) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._fromUTF8(str, encoding) - end - - def _thread_vwait(var_name) - _appsend(false, 'thread_vwait', varname) - end - - def _thread_tkwait(mode, target) - _appsend(false, 'thread_tkwait', mode, target) - end - - def _return_value - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._return_value - end - - def _get_variable(var_name, flag) - # ignore flag - _appsend(false, 'set', TkComm::_get_eval_string(var_name)) - end - def _get_variable2(var_name, index_name, flag) - # ignore flag - _appsend(false, 'set', "#{TkComm::_get_eval_string(var_name)}(#{TkComm::_get_eval_string(index_name)})") - end - - def _set_variable(var_name, value, flag) - # ignore flag - _appsend(false, 'set', TkComm::_get_eval_string(var_name), TkComm::_get_eval_string(value)) - end - def _set_variable2(var_name, index_name, value, flag) - # ignore flag - _appsend(false, 'set', "#{TkComm::_get_eval_string(var_name)}(#{TkComm::_get_eval_string(index_name)})", TkComm::_get_eval_string(value)) - end - - def _unset_variable(var_name, flag) - # ignore flag - _appsend(false, 'unset', TkComm::_get_eval_string(var_name)) - end - def _unset_variable2(var_name, index_name, flag) - # ignore flag - _appsend(false, 'unset', "#{var_name}(#{index_name})") - end - - def _get_global_var(var_name) - _appsend(false, 'set', TkComm::_get_eval_string(var_name)) - end - def _get_global_var2(var_name, index_name) - _appsend(false, 'set', "#{TkComm::_get_eval_string(var_name)}(#{TkComm::_get_eval_string(index_name)})") - end - - def _set_global_var(var_name, value) - _appsend(false, 'set', TkComm::_get_eval_string(var_name), TkComm::_get_eval_string(value)) - end - def _set_global_var2(var_name, index_name, value) - _appsend(false, 'set', "#{TkComm::_get_eval_string(var_name)}(#{TkComm::_get_eval_string(index_name)})", TkComm::_get_eval_string(value)) - end - - def _unset_global_var(var_name) - _appsend(false, 'unset', TkComm::_get_eval_string(var_name)) - end - def _unset_global_var2(var_name, index_name) - _appsend(false, 'unset', "#{var_name}(#{index_name})") - end - - def _split_tklist(str) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._split_tklist(str) - end - - def _merge_tklist(*args) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._merge_tklist(*args) - end - - def _conv_listelement(str) - raise SecurityError, "no permission to manipulate" unless self.manipulable? - @interp._conv_listelement(str) - end - - def _create_console - fail RuntimeError, 'not support "_create_console" on the remote interpreter' - end - - def mainloop - fail RuntimeError, 'not support "mainloop" on the remote interpreter' - end - def mainloop_watchdog - fail RuntimeError, 'not support "mainloop_watchdog" on the remote interpreter' - end - def do_one_event(flag = nil) - fail RuntimeError, 'not support "do_one_event" on the remote interpreter' - end - def mainloop_abort_on_exception - fail RuntimeError, 'not support "mainloop_abort_on_exception" on the remote interpreter' - end - def mainloop_abort_on_exception=(mode) - fail RuntimeError, 'not support "mainloop_abort_on_exception=" on the remote interpreter' - end - def set_eventloop_tick(*args) - fail RuntimeError, 'not support "set_eventloop_tick" on the remote interpreter' - end - def get_eventloop_tick - fail RuntimeError, 'not support "get_eventloop_tick" on the remote interpreter' - end - def set_no_event_wait(*args) - fail RuntimeError, 'not support "set_no_event_wait" on the remote interpreter' - end - def get_no_event_wait - fail RuntimeError, 'not support "get_no_event_wait" on the remote interpreter' - end - def set_eventloop_weight(*args) - fail RuntimeError, 'not support "set_eventloop_weight" on the remote interpreter' - end - def get_eventloop_weight - fail RuntimeError, 'not support "get_eventloop_weight" on the remote interpreter' - end -end - -class << RemoteTkIp - def mainloop(*args) - fail RuntimeError, 'not support "mainloop" on the remote interpreter' - end - def mainloop_watchdog(*args) - fail RuntimeError, 'not support "mainloop_watchdog" on the remote interpreter' - end - def do_one_event(flag = nil) - fail RuntimeError, 'not support "do_one_event" on the remote interpreter' - end - def mainloop_abort_on_exception - fail RuntimeError, 'not support "mainloop_abort_on_exception" on the remote interpreter' - end - def mainloop_abort_on_exception=(mode) - fail RuntimeError, 'not support "mainloop_abort_on_exception=" on the remote interpreter' - end - def set_eventloop_tick(*args) - fail RuntimeError, 'not support "set_eventloop_tick" on the remote interpreter' - end - def get_eventloop_tick - fail RuntimeError, 'not support "get_eventloop_tick" on the remote interpreter' - end - def set_no_event_wait(*args) - fail RuntimeError, 'not support "set_no_event_wait" on the remote interpreter' - end - def get_no_event_wait - fail RuntimeError, 'not support "get_no_event_wait" on the remote interpreter' - end - def set_eventloop_weight(*args) - fail RuntimeError, 'not support "set_eventloop_weight" on the remote interpreter' - end - def get_eventloop_weight - fail RuntimeError, 'not support "get_eventloop_weight" on the remote interpreter' - end -end diff --git a/ext/tk/lib/tcltk.rb b/ext/tk/lib/tcltk.rb deleted file mode 100644 index 121f42c26e..0000000000 --- a/ext/tk/lib/tcltk.rb +++ /dev/null @@ -1,369 +0,0 @@ -# frozen_string_literal: false -# tof - -#### tcltk library, more direct manipulation of tcl/tk -#### Sep. 5, 1997 Y. Shigehiro - -require "tcltklib" - -################ - -# module TclTk: collection of tcl/tk utilities (supplies namespace.) -module TclTk - - # initialize Hash to hold unique symbols and such - @namecnt = {} - - # initialize Hash to hold callbacks - @callback = {} -end - -# TclTk.mainloop(): call TclTkLib.mainloop() -def TclTk.mainloop() - print("mainloop: start\n") if $DEBUG - TclTkLib.mainloop() - print("mainloop: end\n") if $DEBUG -end - -# TclTk.deletecallbackkey(ca): remove callback from TclTk module -# this does not remove callbacks from tcl/tk interpreter -# without calling this method, TclTkInterpreter will not be GCed -# ca: callback(TclTkCallback) -def TclTk.deletecallbackkey(ca) - print("deletecallbackkey: ", ca.to_s(), "\n") if $DEBUG - @callback.delete(ca.to_s) -end - -# TclTk.dcb(ca, wid, W): call TclTk.deletecallbackkey() for each callbacks -# in an array. -# this is for callback for top-level <Destroy> -# ca: array of callbacks(TclTkCallback) -# wid: top-level widget(TclTkWidget) -# w: information about window given by %W(String) -def TclTk.dcb(ca, wid, w) - if wid.to_s() == w - ca.each{|i| - TclTk.deletecallbackkey(i) - } - end -end - -# TclTk._addcallback(ca): register callback -# ca: callback(TclTkCallback) -def TclTk._addcallback(ca) - print("_addcallback: ", ca.to_s(), "\n") if $DEBUG - @callback[ca.to_s()] = ca -end - -# TclTk._callcallback(key, arg): invoke registered callback -# key: key to select callback (to_s value of the TclTkCallback) -# arg: parameter from tcl/tk interpreter -def TclTk._callcallback(key, arg) - print("_callcallback: ", @callback[key].inspect, "\n") if $DEBUG - @callback[key]._call(arg) - # throw out callback value - # should return String to satisfy rb_eval_string() - return "" -end - -# TclTk._newname(prefix): generate unique name(String) -# prefix: prefix of the unique name -def TclTk._newname(prefix) - # generated name counter is stored in @namecnt - if !@namecnt.key?(prefix) - # first appearing prefix, initialize - @namecnt[prefix] = 1 - else - # already appeared prefix, generate next name - @namecnt[prefix] += 1 - end - return "#{prefix}#{@namecnt[prefix]}" -end - -################ - -# class TclTkInterpreter: tcl/tk interpreter -class TclTkInterpreter - - # initialize(): - def initialize() - # generate interpreter object - @ip = TclTkIp.new() - - # add ruby_fmt command to tcl interpreter - # ruby_fmt command format arguments by `format' and call `ruby' command - # (notice ruby command receives only one argument) - if $DEBUG - @ip._eval("proc ruby_fmt {fmt args} { puts \"ruby_fmt: $fmt $args\" ; set cmd [list ruby [format $fmt $args]] ; uplevel $cmd }") - else - @ip._eval("proc ruby_fmt {fmt args} { set cmd [list ruby [format $fmt $args]] ; uplevel $cmd }") - end - - # @ip._get_eval_string(*args): generate string to evaluate in tcl interpreter - # *args: script which is going to be evaluated under tcl/tk - def @ip._get_eval_string(*args) - argstr = "" - args.each{|arg| - argstr += " " if argstr != "" - # call to_eval if it is defined - if (arg.respond_to?(:to_eval)) - argstr += arg.to_eval() - else - # call to_s unless defined - argstr += arg.to_s() - end - } - return argstr - end - - # @ip._eval_args(*args): evaluate string under tcl/tk interpreter - # returns result string. - # *args: script which is going to be evaluated under tcl/tk - def @ip._eval_args(*args) - # calculate the string to eval in the interpreter - argstr = _get_eval_string(*args) - - # evaluate under the interpreter - print("_eval: \"", argstr, "\"") if $DEBUG - res = _eval(argstr) - if $DEBUG - print(" -> \"", res, "\"\n") - elsif _return_value() != 0 - print(res, "\n") - end - fail(%Q/can't eval "#{argstr}"/) if _return_value() != 0 #' - return res - end - - # generate tcl/tk command object and register in the hash - @commands = {} - # for all commands registered in tcl/tk interpreter: - @ip._eval("info command").split(/ /).each{|comname| - if comname =~ /^[.]/ - # if command is a widget (path), generate TclTkWidget, - # and register it in the hash - @commands[comname] = TclTkWidget.new(@ip, comname) - else - # otherwise, generate TclTkCommand - @commands[comname] = TclTkCommand.new(@ip, comname) - end - } - end - - # commands(): returns hash of the tcl/tk commands - def commands() - return @commands - end - - # rootwidget(): returns root widget(TclTkWidget) - def rootwidget() - return @commands["."] - end - - # _tcltkip(): returns @ip(TclTkIp) - def _tcltkip() - return @ip - end - - # method_missing(id, *args): execute undefined method as tcl/tk command - # id: method symbol - # *args: method arguments - def method_missing(id, *args) - # if command named by id registered, then execute it - if @commands.key?(id.id2name) - return @commands[id.id2name].e(*args) - else - # otherwise, exception - super - end - end -end - -# class TclTkObject: base class of the tcl/tk objects -class TclTkObject - - # initialize(ip, exp): - # ip: interpreter(TclTkIp) - # exp: tcl/tk representation - def initialize(ip, exp) - fail("type is not TclTkIp") if !ip.kind_of?(TclTkIp) - @ip = ip - @exp = exp - end - - # to_s(): returns tcl/tk representation - def to_s() - return @exp - end -end - -# class TclTkCommand: tcl/tk commands -# you should not call TclTkCommand.new() -# commands are created by TclTkInterpreter:initialize() -class TclTkCommand < TclTkObject - - # e(*args): execute command. returns String (e is for exec or eval) - # *args: command arguments - def e(*args) - return @ip._eval_args(to_s(), *args) - end -end - -# class TclTkLibCommand: tcl/tk commands in the library -class TclTkLibCommand < TclTkCommand - - # initialize(ip, name): - # ip: interpreter(TclTkInterpreter) - # name: command name (String) - def initialize(ip, name) - super(ip._tcltkip, name) - end -end - -# class TclTkVariable: tcl/tk variable -class TclTkVariable < TclTkObject - - # initialize(interp, dat): - # interp: interpreter(TclTkInterpreter) - # dat: the value to set(String) - # if nil, not initialize variable - def initialize(interp, dat) - # auto-generate tcl/tk representation (variable name) - exp = TclTk._newname("v_") - # initialize TclTkObject - super(interp._tcltkip(), exp) - # safe this for `set' command - @set = interp.commands()["set"] - # set value - set(dat) if dat - end - - # although you can set/read variables by using set in tcl/tk, - # we provide the method for accessing variables - - # set(data): set tcl/tk variable using `set' - # data: new value - def set(data) - @set.e(to_s(), data.to_s()) - end - - # get(): read tcl/tk variable(String) using `set' - def get() - return @set.e(to_s()) - end -end - -# class TclTkWidget: tcl/tk widget -class TclTkWidget < TclTkCommand - - # initialize(*args): - # *args: parameters - def initialize(*args) - if args[0].kind_of?(TclTkIp) - # in case the 1st argument is TclTkIp: - - # Wrap tcl/tk widget by TclTkWidget - # (used in TclTkInterpreter#initialize()) - - # need two arguments - fail("invalid # of parameter") if args.size != 2 - - # ip: interpreter(TclTkIp) - # exp: tcl/tk representation - ip, exp = args - - # initialize TclTkObject - super(ip, exp) - elsif args[0].kind_of?(TclTkInterpreter) - # in case 1st parameter is TclTkInterpreter: - - # generate new widget from parent widget - - # interp: interpreter(TclTkInterpreter) - # parent: parent widget - # command: widget generating tk command(label 等) - # *args: argument to the command - interp, parent, command, *args = args - - # generate widget name - exp = parent.to_s() - exp += "." if exp !~ /[.]$/ - exp += TclTk._newname("w_") - # initialize TclTkObject - super(interp._tcltkip(), exp) - # generate widget - res = @ip._eval_args(command, exp, *args) -# fail("can't create Widget") if res != exp - # for tk_optionMenu, it is legal res != exp - return res - else - fail("first parameter is not TclTkInterpreter") - end - end -end - -# class TclTkCallback: tcl/tk callbacks -class TclTkCallback < TclTkObject - - # initialize(interp, pr, arg): - # interp: interpreter(TclTkInterpreter) - # pr: callback procedure(Proc) - # arg: string to pass as block parameters of pr - # bind command of tcl/tk uses % replacement for parameters - # pr can receive replaced data using block parameter - # its format is specified by arg string - # You should not specify arg for the command like - # scrollbar with -command option, which receives parameters - # without specifying any replacement - def initialize(interp, pr, arg = nil) - # auto-generate tcl/tk representation (variable name) - exp = TclTk._newname("c_") - # initialize TclTkObject - super(interp._tcltkip(), exp) - # save parameters - @pr = pr - @arg = arg - # register in the module - TclTk._addcallback(self) - end - - # to_eval(): returns string representation for @ip._eval_args - def to_eval() - if @arg - # bind replaces %s before calling ruby_fmt, so %%s is used - s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%%s")} #{@arg}}/ - else - s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%s")}}/ - end - - return s - end - - # _call(arg): invoke callback - # arg: callback parameter - def _call(arg) - @pr.call(arg) - end -end - -# class TclTkImage: tcl/tk images -class TclTkImage < TclTkCommand - - # initialize(interp, t, *args): - # generating image is done by TclTkImage.new() - # destroying is done by image delete (inconsistent, sigh) - # interp: interpreter(TclTkInterpreter) - # t: image type (photo, bitmap, etc.) - # *args: command argument - def initialize(interp, t, *args) - # auto-generate tcl/tk representation - exp = TclTk._newname("i_") - # initialize TclTkObject - super(interp._tcltkip(), exp) - # generate image - res = @ip._eval_args("image create", t, exp, *args) - fail("can't create Image") if res != exp - end -end - -# eof diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb deleted file mode 100644 index 956313b54e..0000000000 --- a/ext/tk/lib/tk.rb +++ /dev/null @@ -1,5758 +0,0 @@ -# frozen_string_literal: false -# -# tk.rb - Tk interface module using tcltklib -# by Yukihiro Matsumoto <matz@netlab.jp> - -# use Shigehiro's tcltklib -require 'tcltklib' -require 'tkutil' - -# autoload -require 'tk/autoload' - -# for Mutex -require 'thread' - -class TclTkIp - # backup original (without encoding) _eval and _invoke - alias _eval_without_enc _eval - alias __eval__ _eval - alias _invoke_without_enc _invoke - alias __invoke__ _invoke - - def _ip_id_ - # for RemoteTkIp - '' - end - - alias __initialize__ initialize - private :__initialize__ - - def initialize(*args) - __initialize__(*args) - - @force_default_encoding ||= TkUtil.untrust([false]) - @encoding ||= TkUtil.untrust([nil]) - def @encoding.to_s; self.join(nil); end - end -end - -# define TkComm module (step 1: basic functions) -module TkComm - include TkUtil - extend TkUtil - - WidgetClassNames = TkUtil.untrust({}) - TkExtlibAutoloadModule = TkUtil.untrust([]) - - # None = Object.new ### --> definition is moved to TkUtil module - # def None.to_s - # 'None' - # end - # None.freeze - - #Tk_CMDTBL = {} - #Tk_WINDOWS = {} - Tk_IDs = [ - TkUtil.untrust("00000"), # [0]-cmdid - TkUtil.untrust("00000") # [1]-winid - ] - Tk_IDs.instance_eval{ - @mutex = Mutex.new - def mutex; @mutex; end - freeze - } - - # for backward compatibility - Tk_CMDTBL = Object.new - def Tk_CMDTBL.method_missing(id, *args) - TkCore::INTERP.tk_cmd_tbl.__send__(id, *args) - end - Tk_CMDTBL.freeze - Tk_WINDOWS = Object.new - def Tk_WINDOWS.method_missing(id, *args) - TkCore::INTERP.tk_windows.__send__(id, *args) - end - Tk_WINDOWS.freeze - - self.instance_eval{ - @cmdtbl = TkUtil.untrust([]) - } - - 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| - c =~ %r!/tk(|core|thcore|canvas|text|entry|scrollbox)\.rb:\d+! - end - frames - end - private :error_at - - def _genobj_for_tkwidget(path) - return TkRoot.new if path == '.' - - begin - #tk_class = TkCore::INTERP._invoke('winfo', 'class', path) - tk_class = Tk.ip_invoke_without_enc('winfo', 'class', path) - rescue - return path - end - - if ruby_class = WidgetClassNames[tk_class] - ruby_class_name = ruby_class.name - # gen_class_name = ruby_class_name + 'GeneratedOnTk' - gen_class_name = ruby_class_name - classname_def = '' - else # ruby_class == nil - if Tk.const_defined?(tk_class) - Tk.const_get(tk_class) # auto_load - ruby_class = WidgetClassNames[tk_class] - end - - unless ruby_class - mods = TkExtlibAutoloadModule.find_all{|m| m.const_defined?(tk_class)} - mods.each{|mod| - begin - mod.const_get(tk_class) # auto_load - break if (ruby_class = WidgetClassNames[tk_class]) - rescue LoadError - # ignore load error - end - } - end - - unless ruby_class - std_class = 'Tk' << tk_class - if Object.const_defined?(std_class) - Object.const_get(std_class) # auto_load - ruby_class = WidgetClassNames[tk_class] - end - end - - unless ruby_class - if Tk.const_defined?('TOPLEVEL_ALIASES') && - Tk::TOPLEVEL_ALIASES.const_defined?(std_class) - Tk::TOPLEVEL_ALIASES.const_get(std_class) # auto_load - ruby_class = WidgetClassNames[tk_class] - end - end - - if ruby_class - # found - ruby_class_name = ruby_class.name - gen_class_name = ruby_class_name - classname_def = '' - else - # unknown - ruby_class_name = 'TkWindow' - gen_class_name = 'TkWidget_' + tk_class - classname_def = "WidgetClassName = '#{tk_class}'.freeze" - end - end - -################################### -=begin - if ruby_class = WidgetClassNames[tk_class] - ruby_class_name = ruby_class.name - # gen_class_name = ruby_class_name + 'GeneratedOnTk' - gen_class_name = ruby_class_name - classname_def = '' - else - mod = TkExtlibAutoloadModule.find{|m| m.const_defined?(tk_class)} - if mod - ruby_class_name = mod.name + '::' + tk_class - gen_class_name = ruby_class_name - classname_def = '' - elsif Object.const_defined?('Tk' + tk_class) - ruby_class_name = 'Tk' + tk_class - # gen_class_name = ruby_class_name + 'GeneratedOnTk' - gen_class_name = ruby_class_name - classname_def = '' - else - ruby_class_name = 'TkWindow' - # gen_class_name = ruby_class_name + tk_class + 'GeneratedOnTk' - gen_class_name = 'TkWidget_' + tk_class - classname_def = "WidgetClassName = '#{tk_class}'.freeze" - end - end -=end - -=begin - unless Object.const_defined? gen_class_name - Object.class_eval "class #{gen_class_name}<#{ruby_class_name} - #{classname_def} - end" - end - Object.class_eval "#{gen_class_name}.new('widgetname'=>'#{path}', - 'without_creating'=>true)" -=end - base = Object - gen_class_name.split('::').each{|klass| - next if klass == '' - if base.const_defined?(klass) - base = base.class_eval klass - else - base = base.class_eval "class #{klass}<#{ruby_class_name} - #{classname_def} - end - #{klass}" - end - } - base.class_eval "#{gen_class_name}.new('widgetname'=>'#{path}', - 'without_creating'=>true)" - end - private :_genobj_for_tkwidget - module_function :_genobj_for_tkwidget - - def _at(x,y=nil) - if y - "@#{Integer(x)},#{Integer(y)}" - else - "@#{Integer(x)}" - end - end - module_function :_at - - def tk_tcl2ruby(val, enc_mode = false, listobj = true) -=begin - if val =~ /^rb_out\S* (c(_\d+_)?\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 -=end - if val =~ /rb_out\S*(?:\s+(::\S*|[{](::.*)[}]|["](::.*)["]))? (c(_\d+_)?(\d+))/ - return TkCore::INTERP.tk_cmd_tbl[$4] - end - #if val.include? ?\s - # return val.split.collect{|v| tk_tcl2ruby(v)} - #end - case val - when /\A@font\S+\z/ - TkFont.get_obj(val) - when /\A-?\d+\z/ - val.to_i - when /\A\.\S*\z/ - #Tk_WINDOWS[val] ? Tk_WINDOWS[val] : _genobj_for_tkwidget(val) - TkCore::INTERP.tk_windows[val]? - TkCore::INTERP.tk_windows[val] : _genobj_for_tkwidget(val) - when /\Ai(_\d+_)?\d+\z/ - TkImage::Tk_IMGTBL.mutex.synchronize{ - TkImage::Tk_IMGTBL[val]? TkImage::Tk_IMGTBL[val] : val - } - when /\A-?\d+\.?\d*(e[-+]?\d+)?\z/ - val.to_f - when /\\ / - val.gsub(/\\ /, ' ') - when /[^\\] / - if listobj - #tk_split_escstr(val).collect{|elt| - # tk_tcl2ruby(elt, enc_mode, listobj) - #} - val = _toUTF8(val) unless enc_mode - tk_split_escstr(val, false, false).collect{|elt| - tk_tcl2ruby(elt, true, listobj) - } - elsif enc_mode - _fromUTF8(val) - else - val - end - else - if enc_mode - _fromUTF8(val) - else - val - end - end - end - - private :tk_tcl2ruby - module_function :tk_tcl2ruby - #private_class_method :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, src_enc=true, dst_enc=true) - str = _toUTF8(str) if src_enc - if dst_enc - TkCore::INTERP._split_tklist(str).map!{|s| _fromUTF8(s)} - else - TkCore::INTERP._split_tklist(str) - end - end - - def tk_split_sublist(str, depth=-1, src_enc=true, dst_enc=true) - # return [] if str == "" - # list = TkCore::INTERP._split_tklist(str) - str = _toUTF8(str) if src_enc - - if depth == 0 - return "" if str == "" - list = [str] - else - return [] if str == "" - list = TkCore::INTERP._split_tklist(str) - end - if list.size == 1 - # tk_tcl2ruby(list[0], nil, false) - tk_tcl2ruby(list[0], dst_enc, false) - else - list.collect{|token| tk_split_sublist(token, depth - 1, false, dst_enc)} - end - end - - def tk_split_list(str, depth=0, src_enc=true, dst_enc=true) - return [] if str == "" - str = _toUTF8(str) if src_enc - TkCore::INTERP._split_tklist(str).map!{|token| - tk_split_sublist(token, depth - 1, false, dst_enc) - } - end - - def tk_split_simplelist(str, src_enc=true, dst_enc=true) - #lst = TkCore::INTERP._split_tklist(str) - #if (lst.size == 1 && lst =~ /^\{.*\}$/) - # TkCore::INTERP._split_tklist(str[1..-2]) - #else - # lst - #end - - str = _toUTF8(str) if src_enc - if dst_enc - TkCore::INTERP._split_tklist(str).map!{|s| _fromUTF8(s)} - else - TkCore::INTERP._split_tklist(str) - end - end - - def array2tk_list(ary, enc=nil) - return "" if ary.size == 0 - - sys_enc = TkCore::INTERP.encoding - sys_enc = TclTkLib.encoding_system unless sys_enc - - dst_enc = (enc == nil)? sys_enc: enc - - dst = ary.collect{|e| - if e.kind_of? Array - s = array2tk_list(e, enc) - elsif e.kind_of? Hash - tmp_ary = [] - #e.each{|k,v| tmp_ary << k << v } - e.each{|k,v| tmp_ary << "-#{_get_eval_string(k)}" << v } - s = array2tk_list(tmp_ary, enc) - else - s = _get_eval_string(e, enc) - end - - if dst_enc != true && dst_enc != false - if (s_enc = s.instance_variable_get(:@encoding)) - s_enc = s_enc.to_s - elsif TkCore::WITH_ENCODING - s_enc = s.encoding.name - else - s_enc = sys_enc - end - dst_enc = true if s_enc != dst_enc - end - - s - } - - if sys_enc && dst_enc - dst.map!{|s| _toUTF8(s)} - ret = TkCore::INTERP._merge_tklist(*dst) - if TkCore::WITH_ENCODING - if dst_enc.kind_of?(String) - ret = _fromUTF8(ret, dst_enc) - ret.force_encoding(dst_enc) - else - ret.force_encoding('utf-8') - end - else # without encoding - if dst_enc.kind_of?(String) - ret = _fromUTF8(ret, dst_enc) - ret.instance_variable_set(:@encoding, dst_enc) - else - ret.instance_variable_set(:@encoding, 'utf-8') - end - end - ret - else - TkCore::INTERP._merge_tklist(*dst) - end - end - -else - ########################################################################### - # use Ruby script version of split_list (traditional methods) - ########################################################################### - - def tk_split_escstr(str, src_enc=true, dst_enc=true) - return [] if str == "" - list = [] - token = nil - escape = false - brace = 0 - str.split('').each {|c| - brace += 1 if c == '{' && !escape - brace -= 1 if c == '}' && !escape - if brace == 0 && c == ' ' && !escape - list << token.gsub(/^\{(.*)\}$/, '\1') if token - token = nil - else - token = (token || "") << c - end - escape = (c == '\\' && !escape) - } - list << token.gsub(/^\{(.*)\}$/, '\1') if token - list - end - - def tk_split_sublist(str, depth=-1, src_enc=true, dst_enc=true) - #return [] if str == "" - #return [tk_split_sublist(str[1..-2])] if str =~ /^\{.*\}$/ - #list = tk_split_escstr(str) - if depth == 0 - return "" if str == "" - str = str[1..-2] if str =~ /^\{.*\}$/ - list = [str] - else - return [] if str == [] - return [tk_split_sublist(str[1..-2], depth - 1)] if str =~ /^\{.*\}$/ - list = tk_split_escstr(str) - end - if list.size == 1 - tk_tcl2ruby(list[0], nil, false) - else - list.collect{|token| tk_split_sublist(token, depth - 1)} - end - end - - def tk_split_list(str, depth=0, src_enc=true, dst_enc=true) - return [] if str == "" - tk_split_escstr(str).collect{|token| - tk_split_sublist(token, depth - 1) - } - end - - def tk_split_simplelist(str, src_enc=true, dst_enc=true) - return [] if str == "" - list = [] - token = nil - escape = false - brace = 0 - str.split('').each {|c| - if c == '\\' && !escape - escape = true - token = (token || "") << c if brace > 0 - next - end - brace += 1 if c == '{' && !escape - brace -= 1 if c == '}' && !escape - if brace == 0 && c == ' ' && !escape - list << token.gsub(/^\{(.*)\}$/, '\1') if token - token = nil - else - token = (token || "") << c - end - escape = false - } - list << token.gsub(/^\{(.*)\}$/, '\1') if token - list - end - - def array2tk_list(ary, enc=nil) - ary.collect{|e| - if e.kind_of? Array - "{#{array2tk_list(e, enc)}}" - elsif e.kind_of? Hash - # "{#{e.to_a.collect{|ee| array2tk_list(ee)}.join(' ')}}" - e.each{|k,v| tmp_ary << "-#{_get_eval_string(k)}" << v } - array2tk_list(tmp_ary, enc) - else - s = _get_eval_string(e, enc) - (s.index(/\s/) || s.size == 0)? "{#{s}}": s - end - }.join(" ") - end -end - - private :tk_split_escstr, :tk_split_sublist - private :tk_split_list, :tk_split_simplelist - private :array2tk_list - - 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 - -=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 - 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 - end - private :hash_kv - module_function :hash_kv -=end - -=begin - ### --> definition is moved to TkUtil module - def bool(val) - case val - when "1", 1, 'yes', 'true' - true - else - false - end - end - - def number(val) - case val - when /^-?\d+$/ - val.to_i - when /^-?\d+\.?\d*(e[-+]?\d+)?$/ - val.to_f - else - fail(ArgumentError, "invalid value for Number:'#{val}'") - end - end - def string(val) - if val == "{}" - '' - elsif val[0] == ?{ && val[-1] == ?} - val[1..-2] - else - val - end - end - def num_or_str(val) - begin - number(val) - rescue ArgumentError - string(val) - end - end -=end - - def list(val, depth=0, enc=true) - tk_split_list(val, depth, enc, enc) - end - def simplelist(val, src_enc=true, dst_enc=true) - tk_split_simplelist(val, src_enc, dst_enc) - end - def window(val) - if val =~ /^\./ - #Tk_WINDOWS[val]? Tk_WINDOWS[val] : _genobj_for_tkwidget(val) - TkCore::INTERP.tk_windows[val]? - TkCore::INTERP.tk_windows[val] : _genobj_for_tkwidget(val) - else - nil - end - end - def image_obj(val) - if val =~ /^i(_\d+_)?\d+$/ - TkImage::Tk_IMGTBL.mutex.synchronize{ - TkImage::Tk_IMGTBL[val]? TkImage::Tk_IMGTBL[val] : val - } - else - val - end - end - def procedure(val) -=begin - if val =~ /^rb_out\S* (c(_\d+_)?\d+)/ - #Tk_CMDTBL[$1] - #TkCore::INTERP.tk_cmd_tbl[$1] - TkCore::INTERP.tk_cmd_tbl[$1].cmd -=end - if val =~ /rb_out\S*(?:\s+(::\S*|[{](::.*)[}]|["](::.*)["]))? (c(_\d+_)?(\d+))/ - return TkCore::INTERP.tk_cmd_tbl[$4].cmd - else - #nil - val - end - end - private :bool, :number, :num_or_str, :num_or_nil, :string - private :list, :simplelist, :window, :image_obj, :procedure - module_function :bool, :number, :num_or_str, :num_or_nil, :string - module_function :list, :simplelist, :window, :image_obj, :procedure - - if (RUBY_VERSION.split('.').map{|n| n.to_i} <=> [1,8,7]) < 0 - def slice_ary(ary, size) - sliced = [] - wk_ary = ary.dup - until wk_ary.size.zero? - sub_ary = [] - size.times{ sub_ary << wk_ary.shift } - yield(sub_ary) if block_given? - sliced << sub_ary - end - (block_given?)? ary: sliced - end - else - def slice_ary(ary, size, &b) - if b - ary.each_slice(size, &b) - else - ary.each_slice(size).to_a - end - end - end - private :slice_ary - module_function :slice_ary - - def subst(str, *opts) - # opts := :nobackslashes | :nocommands | novariables - tk_call('subst', - *(opts.collect{|opt| - opt = opt.to_s - (opt[0] == ?-)? opt: '-' << opt - } << str)) - end - - 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 _callback_entry_class?(cls) - cls <= Proc || cls <= Method || cls <= TkCallbackEntry - end - private :_callback_entry_class? - module_function :_callback_entry_class? - - def _callback_entry?(obj) - obj.kind_of?(Proc) || obj.kind_of?(Method) || obj.kind_of?(TkCallbackEntry) - end - private :_callback_entry? - module_function :_callback_entry? - -=begin - ### --> definition is moved to TkUtil module - def _get_eval_string(str, enc_mode = nil) - return nil if str == None - 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, 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 - str = "" - elsif str == false - str = "0" - elsif str == true - 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 = _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 - -=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, enc_mode)} - else - _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]) - id = "c" + TkCore::INTERP._ip_id_ + TkComm::Tk_IDs[0] - end - def _next_cmd_id - TkComm::Tk_IDs.mutex.synchronize{ - id = _curr_cmd_id - #Tk_IDs[0] += 1 - TkComm::Tk_IDs[0].succ! - id - } - end - private :_curr_cmd_id, :_next_cmd_id - module_function :_curr_cmd_id, :_next_cmd_id - - def TkComm.install_cmd(cmd, local_cmdtbl=nil) - return '' if cmd == '' - begin - ns = TkCore::INTERP._invoke_without_enc('namespace', 'current') - ns = nil if ns == '::' # for backward compatibility - rescue - # probably, Tcl7.6 - ns = nil - end - id = _next_cmd_id - #Tk_CMDTBL[id] = 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 - TkUtil.untrust(@cmdtbl) unless @cmdtbl.tainted? - @cmdtbl.push id - - if local_cmdtbl && local_cmdtbl.kind_of?(Array) - begin - local_cmdtbl << id - rescue Exception - # ignore - end - end - - #return Kernel.format("rb_out %s", id); - if ns - 'rb_out' << TkCore::INTERP._ip_id_ << ' ' << ns << ' ' << id - else - 'rb_out' << TkCore::INTERP._ip_id_ << ' ' << id - end - end - def TkComm.uninstall_cmd(id, local_cmdtbl=nil) - #id = $1 if /rb_out\S* (c(_\d+_)?\d+)/ =~ id - id = $4 if id =~ /rb_out\S*(?:\s+(::\S*|[{](::.*)[}]|["](::.*)["]))? (c(_\d+_)?(\d+))/ - - if local_cmdtbl && local_cmdtbl.kind_of?(Array) - begin - local_cmdtbl.delete(id) - rescue Exception - # ignore - end - end - @cmdtbl.delete(id) - - #Tk_CMDTBL.delete(id) - TkCore::INTERP.tk_cmd_tbl.delete(id) - end - # private :install_cmd, :uninstall_cmd - # module_function :install_cmd, :uninstall_cmd - def install_cmd(cmd) - TkComm.install_cmd(cmd, @cmdtbl) - end - def uninstall_cmd(id) - TkComm.uninstall_cmd(id, @cmdtbl) - end - -=begin - def install_win(ppath,name=nil) - if !name or name == '' - #name = format("w%.4d", Tk_IDs[1]) - #Tk_IDs[1] += 1 - name = "w" + Tk_IDs[1] - Tk_IDs[1].succ! - end - if name[0] == ?. - @path = name.dup - elsif !ppath or ppath == "." - @path = Kernel.format(".%s", name); - else - @path = Kernel.format("%s.%s", ppath, name) - end - #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 widget-name '#{name}'" - end - if name[0] == ?. - @path = '' + name - @path.freeze - return TkCore::INTERP.tk_windows[@path] = self - end - else - Tk_IDs.mutex.synchronize{ - name = "w" + TkCore::INTERP._ip_id_ + 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) - TkCore::INTERP.tk_windows.delete(@path) - end - private :install_win, :uninstall_win - - def _epath(win) - if win.kind_of?(TkObject) - win.epath - elsif win.respond_to?(:epath) - win.epath - else - 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 - context = context.path - end - if context.kind_of? Array - context = context.collect{|ev| - if ev.kind_of? TkVirtualEvent - ev.path - else - ev - end - }.join("><") - end - if /,/ =~ context - context = context.split(/\s*,\s*/).join("><") - else - context - end - end - - def _bind_core(mode, what, context, cmd, *args) - id = install_bind(cmd, *args) if cmd - begin - tk_call_without_enc(*(what + ["<#{tk_event_sequence(context)}>", - mode + id])) - rescue - uninstall_cmd(id) if cmd - fail - end - end - - def _bind(what, context, cmd, *args) - _bind_core('', what, context, cmd, *args) - end - - def _bind_append(what, context, cmd, *args) - _bind_core('+', what, context, cmd, *args) - end - - def _bind_remove(what, context) - tk_call_without_enc(*(what + ["<#{tk_event_sequence(context)}>", ''])) - end - - def _bindinfo(what, context=nil) - if context - if TkCore::WITH_RUBY_VM ### Ruby 1.9 !!!! - enum_obj = tk_call_without_enc(*what+["<#{tk_event_sequence(context)}>"]).each_line - else - enum_obj = tk_call_without_enc(*what+["<#{tk_event_sequence(context)}>"]) - end - enum_obj.collect {|cmdline| -=begin - if cmdline =~ /^rb_out\S* (c(?:_\d+_)?\d+)\s+(.*)$/ - #[Tk_CMDTBL[$1], $2] - [TkCore::INTERP.tk_cmd_tbl[$1], $2] -=end - if cmdline =~ /rb_out\S*(?:\s+(::\S*|[{](::.*)[}]|["](::.*)["]))? (c(_\d+_)?(\d+))/ - [TkCore::INTERP.tk_cmd_tbl[$4], $5] - else - cmdline - end - } - else - tk_split_simplelist(tk_call_without_enc(*what)).collect!{|seq| - l = seq.scan(/<*[^<>]+>*/).collect!{|subseq| - case (subseq) - when /^<<[^<>]+>>$/ - TkVirtualEvent.getobj(subseq[1..-2]) - when /^<[^<>]+>$/ - subseq[1..-2] - else - subseq.split('') - end - }.flatten - (l.size == 1) ? l[0] : l - } - end - end - - def _bind_core_for_event_class(klass, mode, what, context, cmd, *args) - id = install_bind_for_event_class(klass, cmd, *args) if cmd - begin - tk_call_without_enc(*(what + ["<#{tk_event_sequence(context)}>", - mode + id])) - rescue - uninstall_cmd(id) if cmd - fail - end - end - - def _bind_for_event_class(klass, what, context, cmd, *args) - _bind_core_for_event_class(klass, '', what, context, cmd, *args) - end - - def _bind_append_for_event_class(klass, what, context, cmd, *args) - _bind_core_for_event_class(klass, '+', what, context, cmd, *args) - end - - def _bind_remove_for_event_class(klass, what, context) - _bind_remove(what, context) - end - - def _bindinfo_for_event_class(klass, what, context=nil) - _bindinfo(what, context) - end - - private :tk_event_sequence - private :_bind_core, :_bind, :_bind_append, :_bind_remove, :_bindinfo - private :_bind_core_for_event_class, :_bind_for_event_class, - :_bind_append_for_event_class, :_bind_remove_for_event_class, - :_bindinfo_for_event_class - - #def bind(tagOrClass, context, cmd=Proc.new, *args) - # _bind(["bind", tagOrClass], context, cmd, *args) - # tagOrClass - #end - def bind(tagOrClass, context, *args) - # if args[0].kind_of?(Proc) || args[0].kind_of?(Method) - if TkComm._callback_entry?(args[0]) || !block_given? - cmd = args.shift - else - cmd = Proc.new - end - _bind(["bind", tagOrClass], context, cmd, *args) - tagOrClass - end - - #def bind_append(tagOrClass, context, cmd=Proc.new, *args) - # _bind_append(["bind", tagOrClass], context, cmd, *args) - # tagOrClass - #end - def bind_append(tagOrClass, context, *args) - # if args[0].kind_of?(Proc) || args[0].kind_of?(Method) - if TkComm._callback_entry?(args[0]) || !block_given? - cmd = args.shift - else - cmd = Proc.new - end - _bind_append(["bind", tagOrClass], context, cmd, *args) - tagOrClass - end - - def bind_remove(tagOrClass, context) - _bind_remove(['bind', tagOrClass], context) - tagOrClass - end - - def bindinfo(tagOrClass, context=nil) - _bindinfo(['bind', tagOrClass], context) - end - - #def bind_all(context, cmd=Proc.new, *args) - # _bind(['bind', 'all'], context, cmd, *args) - # TkBindTag::ALL - #end - def bind_all(context, *args) - # if args[0].kind_of?(Proc) || args[0].kind_of?(Method) - if TkComm._callback_entry?(args[0]) || !block_given? - cmd = args.shift - else - cmd = Proc.new - end - _bind(['bind', 'all'], context, cmd, *args) - TkBindTag::ALL - end - - #def bind_append_all(context, cmd=Proc.new, *args) - # _bind_append(['bind', 'all'], context, cmd, *args) - # TkBindTag::ALL - #end - def bind_append_all(context, *args) - # if args[0].kind_of?(Proc) || args[0].kind_of?(Method) - if TkComm._callback_entry?(args[0]) || !block_given? - cmd = args.shift - else - cmd = Proc.new - end - _bind_append(['bind', 'all'], context, cmd, *args) - TkBindTag::ALL - end - - def bind_remove_all(context) - _bind_remove(['bind', 'all'], context) - TkBindTag::ALL - end - - def bindinfo_all(context=nil) - _bindinfo(['bind', 'all'], context) - end -end - - -module TkCore - include TkComm - extend TkComm - - WITH_RUBY_VM = Object.const_defined?(:RubyVM) && ::RubyVM.class == Class - WITH_ENCODING = defined?(::Encoding.default_external) && true - #WITH_ENCODING = Object.const_defined?(:Encoding) && ::Encoding.class == Class - - unless self.const_defined? :INTERP - if self.const_defined? :IP_NAME - name = IP_NAME.to_s - else - #name = nil - name = $0 - end - if self.const_defined? :IP_OPTS - if IP_OPTS.kind_of?(Hash) - opts = hash_kv(IP_OPTS).join(' ') - else - opts = IP_OPTS.to_s - end - else - opts = '' - end - - # RUN_EVENTLOOP_ON_MAIN_THREAD = true - - unless self.const_defined? :RUN_EVENTLOOP_ON_MAIN_THREAD - if WITH_RUBY_VM ### check Ruby 1.9 !!!!!!! - # *** NEED TO FIX *** - case RUBY_PLATFORM - when /cygwin/ - RUN_EVENTLOOP_ON_MAIN_THREAD = true - when /darwin/ # MacOS X -=begin - ip = TclTkIp.new(name, opts) - if ip._invoke_without_enc('tk', 'windowingsystem') == 'aqua' && - (TclTkLib.get_version<=>[8,4,TclTkLib::RELEASE_TYPE::FINAL,6]) > 0 -=end - if TclTkLib::WINDOWING_SYSTEM == 'aqua' && - (TclTkLib.get_version<=>[8,4,TclTkLib::RELEASE_TYPE::FINAL,6]) > 0 - # *** KNOWN BUG *** - # Main event loop thread of TkAqua (> Tk8.4.9) must be the main - # application thread. So, ruby1.9 users must call Tk.mainloop on - # the main application thread. - # - # *** ADD (2009/05/10) *** - # In some cases (I don't know the description of conditions), - # TkAqua 8.4.7 has a same kind of hang-up trouble. - # So, if 8.4.7 or later, set RUN_EVENTLOOP_ON_MAIN_THREAD to true. - # When you want to control this mode, please call the following - # (set true/false as you want) before "require 'tk'". - # ---------------------------------------------------------- - # module TkCore; RUN_EVENTLOOP_ON_MAIN_THREAD = true; end - # ---------------------------------------------------------- - # - # *** ADD (2010/07/05) *** - # The value of TclTkLib::WINDOWING_SYSTEM is defined at compiling. - # If it is inconsistent with linked DLL, please call the following - # before "require 'tk'". - # ---------------------------------------------------------- - # require 'tcltklib' - # module TclTkLib - # remove_const :WINDOWING_SYSTEM - # WINDOWING_SYSTEM = 'x11' # or 'aqua' - # end - # ---------------------------------------------------------- - # - RUN_EVENTLOOP_ON_MAIN_THREAD = true - else - RUN_EVENTLOOP_ON_MAIN_THREAD = false -=begin - ip.delete - ip = nil -=end - end - else - RUN_EVENTLOOP_ON_MAIN_THREAD = false - end - - else # Ruby 1.8.x - RUN_EVENTLOOP_ON_MAIN_THREAD = false - end - end - - if !WITH_RUBY_VM || RUN_EVENTLOOP_ON_MAIN_THREAD ### check Ruby 1.9 !!!!!!! - INTERP = TclTkIp.new(name, opts) unless self.const_defined? :INTERP - else - INTERP_MUTEX = Mutex.new - INTERP_ROOT_CHECK = ConditionVariable.new - INTERP_THREAD = Thread.new{ - begin - #Thread.current[:interp] = interp = TclTkIp.new(name, opts) - interp = TclTkIp.new(name, opts) - rescue => e - Thread.current[:interp] = e - raise e - end - - interp.mainloop_abort_on_exception = true - Thread.current.instance_variable_set("@interp", interp) - - status = [nil] - def status.value - self[0] - end - def status.value=(val) - self[0] = val - end - - Thread.current[:status] = status - #sleep - - # like as 1.8, withdraw a root widget before calling Tk.mainloop - interp._eval <<EOS -wm withdraw . -rename wm __wm_orig__ -proc wm {subcmd win args} { - set val [eval [list __wm_orig__ $subcmd $win] $args] - if {[string equal $subcmd withdraw] && [string equal $win .]} { - rename wm {} - rename __wm_orig__ wm - } - return $val -} -proc __startup_rbtk_mainloop__ {args} { - rename __startup_rbtk_mainloop__ {} - if {[info command __wm_orig__] == "__wm_orig__"} { - rename wm {} - rename __wm_orig__ wm - if [string equal [wm state .] withdrawn] { - wm deiconify . - } - } -} -set __initial_state_of_rubytk__ 1 -trace add variable __initial_state_of_rubytk__ unset __startup_rbtk_mainloop__ - -# complete initializing -ruby {TkCore::INTERP_THREAD[:interp] = TkCore::INTERP_THREAD.instance_variable_get('@interp')} -EOS - - begin - begin - #TclTkLib.mainloop_abort_on_exception = false - #interp.mainloop_abort_on_exception = true - #Thread.current[:interp] = interp - #Thread.current[:status].value = TclTkLib.mainloop(true) - Thread.current[:status].value = interp.mainloop(true) - rescue SystemExit=>e - Thread.current[:status].value = e - rescue Exception=>e - Thread.current[:status].value = e - p e if $DEBUG - retry if interp.has_mainwindow? - ensure - INTERP_MUTEX.synchronize{ INTERP_ROOT_CHECK.broadcast } - end - - unless interp.deleted? - begin - #Thread.current[:status].value = TclTkLib.mainloop(false) - Thread.current[:status].value = interp.mainloop(false) - rescue Exception=>e - puts "ignore exception on interp: #{e.inspect}\n" if $DEBUG - end - end - - ensure - # interp must be deleted before the thread for interp is dead. - # If not, raise Tcl_Panic on Tcl_AsyncDelete because async handler - # deleted by the wrong thread. - interp.delete - end - } - - # check a Tcl/Tk interpreter is initialized - until INTERP_THREAD[:interp] - # Thread.pass - INTERP_THREAD.run - end - - # INTERP_THREAD.run - raise INTERP_THREAD[:interp] if INTERP_THREAD[:interp].kind_of? Exception - - # check an eventloop is running - while INTERP_THREAD.alive? && TclTkLib.mainloop_thread?.nil? - INTERP_THREAD.run - end - - INTERP = INTERP_THREAD[:interp] - INTERP_THREAD_STATUS = INTERP_THREAD[:status] - - # delete the interpreter and kill the eventloop thread at exit - END{ - if INTERP_THREAD.alive? - INTERP.delete - INTERP_THREAD.kill - end - } - - # (for safety's sake) force the eventloop to run - INTERP_THREAD.run - end - - def INTERP.__getip - self - end - def INTERP.default_master? - true - end - - INTERP.instance_eval{ - # @tk_cmd_tbl = TkUtil.untrust({}) - @tk_cmd_tbl = - TkUtil.untrust(Hash.new{|hash, key| - fail IndexError, "unknown command ID '#{key}'" - }) - def @tk_cmd_tbl.[]=(idx,val) - if self.has_key?(idx) && Thread.current.group != ThreadGroup::Default - fail SecurityError,"cannot change the entried command" - end - super(idx,val) - end - - @tk_windows = TkUtil.untrust({}) - - @tk_table_list = TkUtil.untrust([]) - - @init_ip_env = TkUtil.untrust([]) # table of Procs - @add_tk_procs = TkUtil.untrust([]) # table of [name, args, body] - - @force_default_encoding ||= TkUtil.untrust([false]) - @encoding ||= TkUtil.untrust([nil]) - def @encoding.to_s; self.join(nil); end - - @cb_entry_class = Class.new(TkCallbackEntry){ - class << self - def inspect - sprintf("#<Class(TkCallbackEntry):%0x>", self.__id__) - end - alias to_s inspect - end - - def initialize(ip, cmd) - @ip = ip - @cmd = cmd - end - attr_reader :ip, :cmd - 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 - def INTERP.tk_windows - @tk_windows - end - - class Tk_OBJECT_TABLE - def initialize(id) - @id = id - @mutex = Mutex.new - end - def mutex - @mutex - 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 - def INTERP.create_table - id = @tk_table_list.size - (tbl = {}).tainted? || TkUtil.untrust(tbl) - @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 - 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) - TkUtil._get_eval_string(TkUtil.eval_cmd(cmd, *args)) - end - - def INTERP.init_ip_env(script = Proc.new) - @init_ip_env << script - script.call(self) - end - def INTERP.add_tk_procs(name, args = nil, body = nil) - if name.kind_of?(Array) - name.each{|param| self.add_tk_procs(*param)} - else - name = name.to_s - @add_tk_procs << [name, args, body] - self._invoke('proc', name, args, body) if args && body - end - end - def INTERP.remove_tk_procs(*names) - names.each{|name| - name = name.to_s - @add_tk_procs.delete_if{|elem| - elem.kind_of?(Array) && elem[0].to_s == name - } - #self._invoke('rename', name, '') - self.__invoke__('rename', name, '') - } - end - def INTERP.init_ip_internal - ip = self - @init_ip_env.each{|script| script.call(ip)} - @add_tk_procs.each{|name,args,body| ip._invoke('proc',name,args,body)} - end - end - - unless self.const_defined? :RUN_EVENTLOOP_ON_MAIN_THREAD - ### Ruby 1.9 !!!!!!!!!!!!!!!!!!!!!!!!!! - RUN_EVENTLOOP_ON_MAIN_THREAD = false - 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_cmd(proc{|path| - unless TkCore::INTERP.deleted? - begin - if (widget=TkCore::INTERP.tk_windows[path]) - if widget.respond_to?(:__destroy_hook__) - widget.__destroy_hook__ - end - end - rescue Exception=>e - p e if $DEBUG - end - end - }) << ' %W') - - INTERP.add_tk_procs(TclTkLib::FINALIZE_PROC_NAME, '', - "catch { bind all <#{WIDGET_DESTROY_HOOK}> {} }") - - INTERP.add_tk_procs('rb_out', 'ns args', <<-'EOL') - if [regexp {^::} $ns] { - set cmd {namespace eval $ns {ruby_cmd TkCore callback} $args} - } else { - set cmd {eval {ruby_cmd TkCore callback} $ns $args} - } - if {[set st [catch $cmd 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') - 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 -=end -=begin - INTERP.add_tk_procs('rb_out', 'args', <<-'EOL') - #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 - 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 - - if !WITH_RUBY_VM || RUN_EVENTLOOP_ON_MAIN_THREAD ### check Ruby 1.9 !!!!!!! - at_exit{ INTERP.remove_tk_procs(TclTkLib::FINALIZE_PROC_NAME) } - else - at_exit{ - Tk.root.destroy - INTERP.remove_tk_procs(TclTkLib::FINALIZE_PROC_NAME) - INTERP_THREAD.kill.join - } - end - - EventFlag = TclTkLib::EventFlag - - def callback_break - fail TkCallbackBreak, "Tk callback returns 'break' status" - end - - def callback_continue - fail TkCallbackContinue, "Tk callback returns 'continue' status" - end - - def callback_return - fail TkCallbackReturn, "Tk callback returns 'return' status" - end - - def TkCore.callback(*arg) - begin - if TkCore::INTERP.tk_cmd_tbl.kind_of?(Hash) - #TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg) - normal_ret = false - ret = catch(:IRB_EXIT) do # IRB hack - retval = TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg) - normal_ret = true - retval - end - unless normal_ret - # catch IRB_EXIT - exit(ret) - end - ret - end - rescue SystemExit=>e - exit(e.status) - rescue Interrupt=>e - fail(e) - 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 >-------" - if TkCore::WITH_ENCODING - msg.force_encoding('utf-8') - else - msg.instance_variable_set(:@encoding, 'utf-8') - end - 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 - # TkCore::INTERP._set_global_var('errorInfo', msg) - # fail(e) - 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)) - end - - def after(ms, cmd=Proc.new) - cmdid = install_cmd(proc{ret = cmd.call;uninstall_cmd(cmdid); ret}) - after_id = tk_call_without_enc("after",ms,cmdid) - after_id.instance_variable_set('@cmdid', cmdid) - after_id - end -=begin - def after(ms, cmd=Proc.new) - crit_bup = Thread.critical - Thread.critical = true - - myid = _curr_cmd_id - cmdid = install_cmd(proc{ret = cmd.call;uninstall_cmd(myid); ret}) - - Thread.critical = crit_bup - - tk_call_without_enc("after",ms,cmdid) # return id -# return -# if false #defined? Thread -# Thread.start do -# ms = Float(ms)/1000 -# ms = 10 if ms == 0 -# sleep ms/1000 -# cmd.call -# end -# else -# cmdid = install_cmd(cmd) -# tk_call("after",ms,cmdid) -# end - end -=end - - def after_idle(cmd=Proc.new) - cmdid = install_cmd(proc{ret = cmd.call;uninstall_cmd(cmdid); ret}) - after_id = tk_call_without_enc('after','idle',cmdid) - after_id.instance_variable_set('@cmdid', cmdid) - after_id - end -=begin - def after_idle(cmd=Proc.new) - crit_bup = Thread.critical - Thread.critical = true - - myid = _curr_cmd_id - cmdid = install_cmd(proc{ret = cmd.call;uninstall_cmd(myid); ret}) - - Thread.critical = crit_bup - - tk_call_without_enc('after','idle',cmdid) - end -=end - - def after_cancel(afterId) - tk_call_without_enc('after','cancel',afterId) - if (cmdid = afterId.instance_variable_get('@cmdid')) - afterId.instance_variable_set('@cmdid', nil) - uninstall_cmd(cmdid) - end - afterId - end - - def windowingsystem - tk_call_without_enc('tk', 'windowingsystem') - end - - def scaling(scale=nil) - if scale - tk_call_without_enc('tk', 'scaling', scale) - else - Float(number(tk_call_without_enc('tk', 'scaling'))) - end - end - def scaling_displayof(win, scale=nil) - if scale - tk_call_without_enc('tk', 'scaling', '-displayof', win, scale) - else - Float(number(tk_call_without_enc('tk', '-displayof', win, 'scaling'))) - end - end - - def inactive - Integer(tk_call_without_enc('tk', 'inactive')) - end - def inactive_displayof(win) - Integer(tk_call_without_enc('tk', 'inactive', '-displayof', win)) - end - def reset_inactive - tk_call_without_enc('tk', 'inactive', 'reset') - end - def reset_inactive_displayof(win) - tk_call_without_enc('tk', 'inactive', '-displayof', win, 'reset') - end - - def appname(name=None) - tk_call('tk', 'appname', name) - end - - def appsend_deny - tk_call('rename', 'send', '') - end - - def appsend(interp, async, *args) - if $SAFE >= 1 && args.find{|obj| obj.tainted?} - fail SecurityError, "cannot send tainted Tk commands at level #{$SAFE}" - end - if async != true && async != false && async != nil - args.unshift(async) - async = false - end - if async - tk_call('send', '-async', '--', interp, *args) - else - tk_call('send', '--', interp, *args) - end - end - - def rb_appsend(interp, async, *args) - if $SAFE >= 1 && args.find{|obj| obj.tainted?} - fail SecurityError, "cannot send tainted Ruby commands at level #{$SAFE}" - end - if async != true && async != false && async != nil - args.unshift(async) - async = false - end - #args = args.collect!{|c| _get_eval_string(c).gsub(/[\[\]$"]/, '\\\\\&')} - args = args.collect!{|c| _get_eval_string(c).gsub(/[\[\]$"\\]/, '\\\\\&')} - # args.push(').to_s"') - # appsend(interp, async, 'ruby "(', *args) - args.push('}.call)"') - appsend(interp, async, 'ruby "TkComm._get_eval_string(proc{', *args) - end - - def appsend_displayof(interp, win, async, *args) - if $SAFE >= 1 && args.find{|obj| obj.tainted?} - fail SecurityError, "cannot send tainted Tk commands at level #{$SAFE}" - end - win = '.' if win == nil - if async != true && async != false && async != nil - args.unshift(async) - async = false - end - if async - tk_call('send', '-async', '-displayof', win, '--', interp, *args) - else - tk_call('send', '-displayor', win, '--', interp, *args) - end - end - - def rb_appsend_displayof(interp, win, async, *args) - if $SAFE >= 1 && args.find{|obj| obj.tainted?} - fail SecurityError, "cannot send tainted Ruby commands at level #{$SAFE}" - end - win = '.' if win == nil - if async != true && async != false && async != nil - args.unshift(async) - async = false - end - #args = args.collect!{|c| _get_eval_string(c).gsub(/[\[\]$"]/, '\\\\\&')} - args = args.collect!{|c| _get_eval_string(c).gsub(/[\[\]$"\\]/, '\\\\\&')} - # args.push(').to_s"') - # appsend_displayof(interp, win, async, 'ruby "(', *args) - args.push('}.call)"') - appsend(interp, win, async, 'ruby "TkComm._get_eval_string(proc{', *args) - end - - def info(*args) - tk_call('info', *args) - end - - def mainloop(check_root = true) - if !TkCore::WITH_RUBY_VM - TclTkLib.mainloop(check_root) - - elsif TkCore::RUN_EVENTLOOP_ON_MAIN_THREAD - # if TclTkLib::WINDOWING_SYSTEM == 'aqua' && - #if TkCore::INTERP._invoke_without_enc('tk','windowingsystem')=='aqua' && - # Thread.current != Thread.main && - # (TclTkLib.get_version <=> [8,4,TclTkLib::RELEASE_TYPE::FINAL,9]) > 0 - # raise RuntimeError, - # "eventloop on TkAqua ( > Tk8.4.9 ) works on the main thread only" - #end - if Thread.current != Thread.main - raise RuntimeError, "Tk.mainloop is allowed on the main thread only" - end - TclTkLib.mainloop(check_root) - - else ### Ruby 1.9 !!!!! - unless TkCore::INTERP.default_master? - # [MultiTkIp] slave interp ? - return TkCore::INTERP._thread_tkwait('window', '.') if check_root - end - - # like as 1.8, withdraw a root widget before calling Tk.mainloop - TkCore::INTERP._eval_without_enc('catch {unset __initial_state_of_rubytk__}') - INTERP_THREAD.run - - begin - TclTkLib.set_eventloop_window_mode(true) - - # force run the eventloop - TkCore::INTERP._eval_without_enc('update') - TkCore::INTERP._eval_without_enc('catch {set __initial_state_of_rubytk__}') - INTERP_THREAD.run - if check_root - INTERP_MUTEX.synchronize{ - INTERP_ROOT_CHECK.wait(INTERP_MUTEX) - status = INTERP_THREAD_STATUS.value - if status && TkCore::INTERP.default_master? - INTERP_THREAD_STATUS.value = nil - raise status if status.kind_of?(Exception) - end - } - else - # INTERP_THREAD.value - begin - INTERP_THREAD.value - rescue Exception => e - raise e - end - end - rescue Exception => e - raise e - ensure - TclTkLib.set_eventloop_window_mode(false) - end - end - end - - def mainloop_thread? - # true : current thread is mainloop - # nil : there is no mainloop - # false : mainloop is running on the other thread - # ( At then, it is dangerous to call Tk interpreter directly. ) - if !TkCore::WITH_RUBY_VM || TkCore::RUN_EVENTLOOP_ON_MAIN_THREAD - ### Ruby 1.9 !!!!!!!!!!! - TclTkLib.mainloop_thread? - else - Thread.current == INTERP_THREAD - end - end - - def mainloop_exist? - TclTkLib.mainloop_thread? != nil - end - - def is_mainloop? - TclTkLib.mainloop_thread? == true - end - - def mainloop_watchdog(check_root = true) - # watchdog restarts mainloop when mainloop is dead - TclTkLib.mainloop_watchdog(check_root) - end - - def do_one_event(flag = TclTkLib::EventFlag::ALL) - TclTkLib.do_one_event(flag) - end - - def set_eventloop_tick(timer_tick) - TclTkLib.set_eventloop_tick(timer_tick) - end - - def get_eventloop_tick() - TclTkLib.get_eventloop_tick - end - - def set_no_event_wait(wait) - TclTkLib.set_no_even_wait(wait) - end - - def get_no_event_wait() - TclTkLib.get_no_eventloop_wait - end - - def set_eventloop_weight(loop_max, no_event_tick) - TclTkLib.set_eventloop_weight(loop_max, no_event_tick) - end - - def get_eventloop_weight() - TclTkLib.get_eventloop_weight - end - - def restart(app_name = nil, keys = {}) - TkCore::INTERP.init_ip_internal - - tk_call('set', 'argv0', app_name) if app_name - if keys.kind_of?(Hash) - # tk_call('set', 'argc', keys.size * 2) - tk_call('set', 'argv', hash_kv(keys).join(' ')) - end - - INTERP.restart - nil - end - - def event_generate(win, context, keys=nil) - #win = win.path if win.kind_of?(TkObject) - if context.kind_of?(TkEvent::Event) - context.generate(win, ((keys)? keys: {})) - elsif keys - tk_call_without_enc('event', 'generate', win, - "<#{tk_event_sequence(context)}>", - *hash_kv(keys, true)) - else - tk_call_without_enc('event', 'generate', win, - "<#{tk_event_sequence(context)}>") - end - nil - end - - def messageBox(keys) - tk_call('tk_messageBox', *hash_kv(keys)) - end - - def getOpenFile(keys = nil) - tk_call('tk_getOpenFile', *hash_kv(keys)) - end - def getMultipleOpenFile(keys = nil) - simplelist(tk_call('tk_getOpenFile', '-multiple', '1', *hash_kv(keys))) - end - - def getSaveFile(keys = nil) - tk_call('tk_getSaveFile', *hash_kv(keys)) - end - def getMultipleSaveFile(keys = nil) - simplelist(tk_call('tk_getSaveFile', '-multiple', '1', *hash_kv(keys))) - end - - def chooseColor(keys = nil) - tk_call('tk_chooseColor', *hash_kv(keys)) - end - - def chooseDirectory(keys = nil) - tk_call('tk_chooseDirectory', *hash_kv(keys)) - end - - 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_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 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 = TkUtil.untrust(INTERP._invoke(*args)) - # res = INTERP._invoke(enc_mode, *args) - res = _ip_invoke_core(enc_mode, *args) - # >>>>> _invoke returns a TAINTED string <<<<< - rescue NameError => err - # err = $! - begin - args.unshift "unknown" - #res = TkUtil.untrust(INTERP._invoke(*args)) - #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.message - fail err - end - end |