From 59a07a0690ea964aa1f6d2f250a9ef176cac49ab Mon Sep 17 00:00:00 2001 From: nagai Date: Fri, 21 Dec 2007 08:57:35 +0000 Subject: Ruby/Tk :: provisional support on Ruby-VM and Tcl/Tk8.5. git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@14426 b2dd03c8-39d4-4d8f-98ff-823fe69b080e --- ext/tk/MANUAL_tcltklib.eng | 17 ++ ext/tk/MANUAL_tcltklib.eucj | 16 ++ ext/tk/extconf.rb | 16 +- ext/tk/lib/multi-tk.rb | 55 ++++- ext/tk/lib/tk.rb | 190 +++++++++++--- ext/tk/lib/tk/autoload.rb | 356 ++++++++++++++++++--------- ext/tk/lib/tk/button.rb | 4 +- ext/tk/lib/tk/canvas.rb | 5 +- ext/tk/lib/tk/checkbutton.rb | 7 +- ext/tk/lib/tk/composite.rb | 5 + ext/tk/lib/tk/entry.rb | 4 +- ext/tk/lib/tk/frame.rb | 4 +- ext/tk/lib/tk/label.rb | 4 +- ext/tk/lib/tk/labelframe.rb | 7 +- ext/tk/lib/tk/listbox.rb | 4 +- ext/tk/lib/tk/macpkg.rb | 8 +- ext/tk/lib/tk/menu.rb | 32 ++- ext/tk/lib/tk/message.rb | 4 +- ext/tk/lib/tk/package.rb | 4 + ext/tk/lib/tk/panedwindow.rb | 7 +- ext/tk/lib/tk/radiobutton.rb | 7 +- ext/tk/lib/tk/root.rb | 4 +- ext/tk/lib/tk/scale.rb | 4 +- ext/tk/lib/tk/scrollbar.rb | 14 +- ext/tk/lib/tk/spinbox.rb | 4 +- ext/tk/lib/tk/text.rb | 10 +- ext/tk/lib/tk/textimage.rb | 2 + ext/tk/lib/tk/textmark.rb | 5 + ext/tk/lib/tk/texttag.rb | 3 + ext/tk/lib/tk/textwindow.rb | 2 + ext/tk/lib/tk/toplevel.rb | 10 +- ext/tk/lib/tk/ttk_selector.rb | 55 +++++ ext/tk/lib/tk/winpkg.rb | 16 +- ext/tk/lib/tkextlib/iwidgets/scrolledtext.rb | 5 + ext/tk/lib/tkextlib/tile.rb | 81 ++++-- ext/tk/lib/tkextlib/tile/style.rb | 37 +-- ext/tk/lib/tkextlib/tile/tpaned.rb | 8 +- ext/tk/lib/tkextlib/tile/tscrollbar.rb | 19 ++ ext/tk/sample/demos-en/bind.rb | 18 +- ext/tk/sample/demos-en/pendulum.rb | 35 ++- ext/tk/sample/demos-jp/bind.rb | 18 +- ext/tk/sample/demos-jp/pendulum.rb | 35 ++- ext/tk/sample/demos-jp/widget | 6 +- ext/tk/sample/tkextlib/vu/canvSticker2.rb | 12 +- ext/tk/tcltklib.c | 351 +++++++++++++++++++++++--- 45 files changed, 1185 insertions(+), 325 deletions(-) create mode 100644 ext/tk/lib/tk/ttk_selector.rb (limited to 'ext/tk') diff --git a/ext/tk/MANUAL_tcltklib.eng b/ext/tk/MANUAL_tcltklib.eng index 1db61f228e..9ef9adf26c 100644 --- a/ext/tk/MANUAL_tcltklib.eng +++ b/ext/tk/MANUAL_tcltklib.eng @@ -125,7 +125,24 @@ module TclTklib : 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, + : number, release-type name, 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. diff --git a/ext/tk/MANUAL_tcltklib.eucj b/ext/tk/MANUAL_tcltklib.eucj index 5dd36726ba..d291b7e807 100644 --- a/ext/tk/MANUAL_tcltklib.eucj +++ b/ext/tk/MANUAL_tcltklib.eucj @@ -221,7 +221,23 @@ require "tcltklib" : ¤«¤éÃê½Ð¤µ¤ì¤ë¤Ï¤º¤Ç¤¢¤ë¤«¤é¡¤index_name °ú¿ô¤Ï nil ¤È : ¤»¤Í¤Ð¤Ê¤é¤Ê¤¤¡¥ + ¥â¥¸¥å¡¼¥ë TclTkLib::RELEASE_TYPE + : Tcl/Tk ¤Î¥ê¥ê¡¼¥¹¥¿¥¤¥×ÈÖ¹æ¤ÎÄêµÁ + + Äê¿ô ALPHA + : ALPHA ¥ê¥ê¡¼¥¹ + + Äê¿ô BETA + : BETA ¥ê¥ê¡¼¥¹ + + Äê¿ô FINAL + : FINAL ¥ê¥ê¡¼¥¹ + ¥â¥¸¥å¡¼¥ë¥á¥½¥Ã¥É + get_version() + : Tcl/Tk ¤Î major, minor, release-type ÈÖ¹æ, release-type ̾, + : patchlevel ¤òÇÛÎó¤Ë¤·¤ÆÊÖ¤¹¡¥ + mainloop(check_root = true) : ¥¤¥Ù¥ó¥È¥ë¡¼¥×¤òµ¯Æ°¤¹¤ë¡¥check_root ¤¬ true ¤Ç¤¢¤ì¤Ð¡¤ : root widget ¤¬Â¸ºß¤¹¤ë¸Â¤ê¡¤¤³¤Î¥á¥½¥Ã¥É¤Ï½ªÎ»¤·¤Ê¤¤¡¥ diff --git a/ext/tk/extconf.rb b/ext/tk/extconf.rb index 123899043a..292b18a5c0 100644 --- a/ext/tk/extconf.rb +++ b/ext/tk/extconf.rb @@ -63,11 +63,15 @@ def find_tcl(tcllib, stubs) elsif find_library(lib, func, *paths) true else - %w[8.5 8.4 8.3 8.2 8.1 8.0 7.6].find { |ver| + %w[8.6 8.5 8.4 8.3 8.2 8.1 8.0 7.6].find { |ver| find_library("#{lib}#{ver}", func, *paths) or find_library("#{lib}#{ver.delete('.')}", func, *paths) or find_library("tcl#{ver}", func, *paths) or - find_library("tcl#{ver.delete('.')}", func, *paths) + find_library("tcl#{ver.delete('.')}", func, *paths) or + find_library("#{lib}#{ver}g", func, *paths) or + find_library("#{lib}#{ver.delete('.')}g", func, *paths) or + find_library("tcl#{ver}g", func, *paths) or + find_library("tcl#{ver.delete('.')}g", func, *paths) } end end @@ -86,11 +90,15 @@ def find_tk(tklib, stubs) elsif find_library(lib, func, *paths) true else - %w[8.5 8.4 8.3 8.2 8.1 8.0 4.2].find { |ver| + %w[8.6 8.5 8.4 8.3 8.2 8.1 8.0 4.2].find { |ver| find_library("#{lib}#{ver}", func, *paths) or find_library("#{lib}#{ver.delete('.')}", func, *paths) or find_library("tk#{ver}", func, *paths) or - find_library("tk#{ver.delete('.')}", func, *paths) + find_library("tk#{ver.delete('.')}", func, *paths) or + find_library("#{lib}#{ver}g", func, *paths) or + find_library("#{lib}#{ver.delete('.')}g", func, *paths) or + find_library("tk#{ver}g", func, *paths) or + find_library("tk#{ver.delete('.')}g", func, *paths) } end end diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb index 78ed1aa6ee..7b25c22063 100644 --- a/ext/tk/lib/multi-tk.rb +++ b/ext/tk/lib/multi-tk.rb @@ -130,10 +130,10 @@ class MultiTkIp class << @@TK_CMD_TBL allow = [ - '__send__', '__id__', 'freeze', 'inspect', 'kind_of?', + '__send__', '__id__', 'freeze', 'inspect', 'kind_of?', 'object_id', '[]', '[]=', 'delete', 'each', 'has_key?' ] - instance_methods.each{|m| undef_method(m) unless allow.index(m)} + instance_methods.each{|m| undef_method(m) unless allow.index(m.to_s)} def kind_of?(klass) @tbl.kind_of?(klass) @@ -206,7 +206,7 @@ class MultiTkIp def initialize(ip, cmd) @ip = ip @cmd = cmd - freeze + self.freeze end attr_reader :ip, :cmd def inspect @@ -723,7 +723,30 @@ class MultiTkIp fail ArgumentError, "expecting a Hash object for the 2nd argument" end - @interp = TclTkIp.new(name, _keys2opts(keys)) + if RUBY_VERSION < '1.9.0' ### !!!!!!!!!!! + @interp = TclTkIp.new(name, _keys2opts(keys)) + else + @interp_thread = Thread.new{ + Thread.current[:interp] = interp = TclTkIp.new(name, _keys2opts(keys)) + #sleep + interp.mainloop(true) + } + until @interp_thread[:interp] + Thread.pass + end + # INTERP_THREAD.run + @interp = @interp_thread[:interp] + + 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 + @ip_name = nil @callback_status = [].taint @@ -868,7 +891,7 @@ class MultiTkIp ret = [] mtx = Mutex.new.lock @init_ip_env_queue.enq([mtx, ret, table, script]) - mtx.lock + # mtx.lock if ret[0].kind_of?(Exception) raise ret[0] else @@ -1206,7 +1229,20 @@ class MultiTkIp if safeip == nil # create master-ip - @interp = TclTkIp.new(name, _keys2opts(tk_opts)) + if RUBY_VERSION < '1.9.0' ### !!!!!!!!!!! + @interp = TclTkIp.new(name, _keys2opts(tk_opts)) + else + @interp_thread = Thread.new{ + Thread.current[:interp] = interp = TclTkIp.new(name, _keys2opts(tk_opts)) + #sleep + TclTkLib.mainloop(true) + } + until @interp_thread[:interp] + Thread.pass + end + # INTERP_THREAD.run + @interp = @interp_thread[:interp] + end @ip_name = nil if safe @@ -1221,6 +1257,7 @@ class MultiTkIp @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' ### !!!!!!!!!!! if safe safe = master.safe_level if safe < master.safe_level @safe_level = [safe] @@ -1229,6 +1266,7 @@ class MultiTkIp end else @interp, @ip_name = master.__create_trusted_slave_obj(name, tk_opts) + @interp_thread = nil if RUBY_VERSION < '1.9.0' ### !!!!!!!!!!! if safe safe = master.safe_level if safe < master.safe_level @safe_level = [safe] @@ -2338,6 +2376,11 @@ end class MultiTkIp def mainloop(check_root = true, restart_on_dead = true) raise SecurityError, "no permission to manipulate" unless self.manipulable? + + if RUBY_VERSION < '1.9.0' ### !!!!!!!!!!! + return @interp_thread.value if @interp_thread + end + #return self if self.slave? #return self if self != @@DEFAULT_MASTER if self != @@DEFAULT_MASTER diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb index 32b5e20bc5..d079bb9ed9 100644 --- a/ext/tk/lib/tk.rb +++ b/ext/tk/lib/tk.rb @@ -1077,11 +1077,14 @@ module TkComm end end - module TkCore include TkComm extend TkComm + unless self.const_defined? :RUN_EVENTLOOP_ON_MAIN_THREAD + RUN_EVENTLOOP_ON_MAIN_THREAD = false + end + unless self.const_defined? :INTERP if self.const_defined? :IP_NAME name = IP_NAME.to_s @@ -1099,7 +1102,40 @@ module TkCore opts = '' end - INTERP = TclTkIp.new(name, opts) + if RUBY_VERSION < '1.9.0' || RUN_EVENTLOOP_ON_MAIN_THREAD ### !!!!!!!!!!! + INTERP = TclTkIp.new(name, opts) + else + require 'thread' + INTERP_MUTEX = Mutex.new + INTERP_ROOT_CHECK = ConditionVariable.new + INTERP_THREAD = Thread.new{ + begin + Thread.current[:interp] = interp = TclTkIp.new(name, opts) + rescue => e + Thread.current[:interp] = e + raise e + end + Thread.current[:status] = nil + #sleep + + begin + Thread.current[:status] = TclTkLib.mainloop(true) + rescue Exception=>e + Thread.current[:status] = e + ensure + INTERP_MUTEX.synchronize{ INTERP_ROOT_CHECK.broadcast } + end + Thread.current[:status] = TclTkLib.mainloop(false) + } + + 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] + end def INTERP.__getip self @@ -1554,7 +1590,28 @@ module TkCore end def mainloop(check_root = true) - TclTkLib.mainloop(check_root) + if RUBY_VERSION < '1.9.0' || + TkCore::RUN_EVENTLOOP_ON_MAIN_THREAD ### !!!!!!!!!!! + TclTkLib.mainloop(check_root) + else + begin + TclTkLib.set_eventloop_window_mode(true) + if check_root + INTERP_MUTEX.synchronize{ + INTERP_ROOT_CHECK.wait(INTERP_MUTEX) + status = INTERP_THREAD[:status] + if status + INTERP_THREAD[:status] = nil + raise status if status.kind_of?(Exception) + end + } + else + INTERP_THREAD.value + end + ensure + TclTkLib.set_eventloop_window_mode(false) + end + end end def mainloop_thread? @@ -1562,7 +1619,12 @@ module TkCore # nil : there is no mainloop # false : mainloop is running on the other thread # ( At then, it is dangerous to call Tk interpreter directly. ) - TclTkLib.mainloop_thread? + if RUBY_VERSION < '1.9.0' || + TkCore::RUN_EVENTLOOP_ON_MAIN_THREAD ### !!!!!!!!!!! + TclTkLib.mainloop_thread? + else + Thread.current == INTERP_THREAD + end end def mainloop_exist? @@ -1798,7 +1860,6 @@ module TkCore end end - module Tk include TkCore extend Tk @@ -2405,34 +2466,101 @@ if (/^(8\.[1-9]|9\.|[1-9][0-9])/ =~ Tk::TCL_VERSION && !Tk::JAPANIZED_TK) end # estimate encoding - case $KCODE - when /^e/i # EUC - Tk.encoding = 'euc-jp' - Tk.encoding_system = 'euc-jp' - when /^s/i # SJIS - begin - if Tk.encoding_system == 'cp932' - Tk.encoding = 'cp932' - else + if RUBY_VERSION < '1.9.0' + case $KCODE + when /^e/i # EUC + Tk.encoding = 'euc-jp' + Tk.encoding_system = 'euc-jp' + when /^s/i # SJIS + begin + if Tk.encoding_system == 'cp932' + Tk.encoding = 'cp932' + else + Tk.encoding = 'shiftjis' + Tk.encoding_system = 'shiftjis' + end + rescue StandardError, NameError Tk.encoding = 'shiftjis' Tk.encoding_system = 'shiftjis' end - rescue StandardError, NameError - Tk.encoding = 'shiftjis' - Tk.encoding_system = 'shiftjis' - end - when /^u/i # UTF8 - Tk.encoding = 'utf-8' - Tk.encoding_system = 'utf-8' - else # NONE - if defined? DEFAULT_TK_ENCODING - Tk.encoding_system = DEFAULT_TK_ENCODING + when /^u/i # UTF8 + Tk.encoding = 'utf-8' + Tk.encoding_system = 'utf-8' + else # NONE + if defined? DEFAULT_TK_ENCODING + Tk.encoding_system = DEFAULT_TK_ENCODING + end + begin + Tk.encoding = Tk.encoding_system + rescue StandardError, NameError + Tk.encoding = 'utf-8' + Tk.encoding_system = 'utf-8' + end end - begin - Tk.encoding = Tk.encoding_system - rescue StandardError, NameError + else ######################### + $TK_ENCODING ||= Encoding.default_external.name + case $TK_ENCODING + when 'US_ASCII' + Tk.encoding = 'ascii' + Tk.encoding_system = 'ascii' + when 'BIG5' + Tk.encoding = 'big5' + Tk.encoding_system = 'big5' + when 'CP1251' + Tk.encoding = 'cp1251' + Tk.encoding_system = 'cp1251' + when 'EUC-JP' + Tk.encoding = 'euc-jp' + Tk.encoding_system = 'euc-jp' + when 'EUC-KR' + Tk.encoding = 'euc-kr' + Tk.encoding_system = 'euc-kr' + when 'EUC-TW', 'EUC-CN' + Tk.encoding = 'euc-cn' + Tk.encoding_system = 'euc-cn' + #when 'GB18030' + # Tk.encoding = 'gb12345' # ???????????? + # Tk.encoding_system = 'gb12345' # ???????????? + when 'ISO-2022-JP' + Tk.encoding = 'iso2022-jp' + Tk.encoding_system = 'iso2022-jp' + when /ISO-8859-(.*)/ + Tk.encoding = 'iso8859-' << $1 + Tk.encoding_system = 'iso8859-' << $1 + #when 'KOI8', 'KOI8-U' + # Tk.encoding = 'koi8-u' # ???????????? + # Tk.encoding_system = 'koi8-u' # ???????????? + when 'KOI8-R' + Tk.encoding = 'koi8-r' + Tk.encoding_system = 'koi8-r' + when 'Shift_JIS' + begin + if Tk.encoding_system == 'cp932' + Tk.encoding = 'cp932' + else + Tk.encoding = 'shiftjis' + Tk.encoding_system = 'shiftjis' + end + rescue StandardError, NameError + Tk.encoding = 'shiftjis' + Tk.encoding_system = 'shiftjis' + end + when 'UNICODE' + Tk.encoding = 'unicode' + Tk.encoding_system = 'unicode' + when 'UTF-8' Tk.encoding = 'utf-8' Tk.encoding_system = 'utf-8' + else ###### 'ASCII-8BIT' + if defined? DEFAULT_TK_ENCODING + Tk.encoding_system = DEFAULT_TK_ENCODING + end + begin + Tk.encoding = Tk.encoding_system + rescue StandardError, NameError + Tk.encoding = 'utf-8' + Tk.encoding_system = 'utf-8' + end end end @@ -4076,6 +4204,11 @@ class TkWindow' + end + def exist? TkWinfo.exist?(self) end @@ -4586,7 +4719,6 @@ class TkWindow 8 || + (major == 8 && minor > 5) || + (major == 8 && minor == 5 && type >= TclTkLib::RELEASE_TYPE::BETA) + # Tcl/Tk 8.5 beta or later + autoload :Ttk, 'tkextlib/tile' + module Tk + autoload :Tile, 'tkextlib/tile' + end +end -####################### +###################################### # geometry manager +module Tk + autoload :Grid, 'tk/grid' + def Grid(*args); TkGrid.configure(*args); end + + autoload :Pack, 'tk/pack' + def Pack(*args); TkPack.configure(*args); end + + autoload :Place, 'tk/place' + def Place(*args); TkPlace.configure(*args); end +end + autoload :TkGrid, 'tk/grid' def TkGrid(*args); TkGrid.configure(*args); end @@ -14,183 +38,275 @@ autoload :TkPlace, 'tk/place' def TkPlace(*args); TkPlace.configure(*args); end -####################### -# others -autoload :TkBgError, 'tk/bgerror' +###################################### +# Ttk (Tile) support +require 'tk/ttk_selector' -autoload :TkBindTag, 'tk/bindtag' -autoload :TkBindTagAll, 'tk/bindtag' -autoload :TkDatabaseClass, 'tk/bindtag' -autoload :TkButton, 'tk/button' +###################################### +# classes on Tk module +module Tk + autoload :Button, 'tk/button' -autoload :TkConsole, 'tk/console' + autoload :Canvas, 'tk/canvas' -autoload :TkCanvas, 'tk/canvas' + autoload :CheckButton, 'tk/checkbutton' + autoload :Checkbutton, 'tk/checkbutton' -autoload :TkcTagAccess, 'tk/canvastag' -autoload :TkcTag, 'tk/canvastag' -autoload :TkcTagString, 'tk/canvastag' -autoload :TkcNamedTag, 'tk/canvastag' -autoload :TkcTagAll, 'tk/canvastag' -autoload :TkcTagCurrent, 'tk/canvastag' -autoload :TkcTagGroup, 'tk/canvastag' + autoload :Entry, 'tk/entry' -autoload :TkCheckButton, 'tk/checkbutton' -autoload :TkCheckbutton, 'tk/checkbutton' + autoload :Frame, 'tk/frame' -autoload :TkClipboard, 'tk/clipboard' + autoload :Label, 'tk/label' -autoload :TkComposite, 'tk/composite' + autoload :LabelFrame, 'tk/labelframe' + autoload :Labelframe, 'tk/labelframe' -autoload :TkConsole, 'tk/console' + autoload :Listbox, 'tk/listbox' -autoload :TkDialog, 'tk/dialog' -autoload :TkDialog2, 'tk/dialog' -autoload :TkDialogObj, 'tk/dialog' -autoload :TkWarning, 'tk/dialog' -autoload :TkWarning2, 'tk/dialog' -autoload :TkWarningObj, 'tk/dialog' + autoload :Menu, 'tk/menu' + autoload :MenuClone, 'tk/menu' + autoload :SystemMenu, 'tk/menu' + autoload :SysMenu_Help, 'tk/menu' + autoload :SysMenu_System, 'tk/menu' + autoload :SysMenu_Apple, 'tk/menu' + autoload :Menubutton, 'tk/menu' + autoload :OptionMenubutton, 'tk/menu' -autoload :TkEntry, 'tk/entry' + autoload :Message, 'tk/message' -autoload :TkEvent, 'tk/event' + autoload :PanedWindow, 'tk/panedwindow' + autoload :Panedwindow, 'tk/panedwindow' -autoload :TkFont, 'tk/font' -autoload :TkTreatTagFont, 'tk/font' + autoload :RadioButton, 'tk/radiobutton' + autoload :Radiobutton, 'tk/radiobutton' -autoload :TkFrame, 'tk/frame' + autoload :Root, 'tk/root' -autoload :TkImage, 'tk/image' -autoload :TkBitmapImage, 'tk/image' -autoload :TkPhotoImage, 'tk/image' + autoload :Scale, 'tk/scale' -autoload :TkItemConfigMethod, 'tk/itemconfig' + autoload :Scrollbar, 'tk/scrollbar' + autoload :XScrollbar, 'tk/scrollbar' + autoload :YScrollbar, 'tk/scrollbar' -autoload :TkTreatItemFont, 'tk/itemfont' + autoload :Spinbox, 'tk/spinbox' -autoload :TkKinput, 'tk/kinput' + autoload :Text, 'tk/text' -autoload :TkLabel, 'tk/label' + autoload :Toplevel, 'tk/toplevel' +end -autoload :TkLabelFrame, 'tk/labelframe' -autoload :TkLabelframe, 'tk/labelframe' -autoload :TkListbox, 'tk/listbox' +###################################### +# sub-module of Tk +module Tk + autoload :Clock, 'tk/clock' -autoload :TkMacResource, 'tk/macpkg' + autoload :OptionObj, 'tk/optionobj' -autoload :TkMenu, 'tk/menu' -autoload :TkMenuClone, 'tk/menu' -autoload :TkSystemMenu, 'tk/menu' -autoload :TkSysMenu_Help, 'tk/menu' -autoload :TkSysMenu_System, 'tk/menu' -autoload :TkSysMenu_Apple, 'tk/menu' -autoload :TkMenubutton, 'tk/menu' -autoload :TkOptionMenubutton, 'tk/menu' + autoload :X_Scrollable, 'tk/scrollable' + autoload :Y_Scrollable, 'tk/scrollable' + autoload :Scrollable, 'tk/scrollable' -autoload :TkMenubar, 'tk/menubar' + autoload :Wm, 'tk/wm' -autoload :TkMenuSpec, 'tk/menuspec' + autoload :MacResource, 'tk/macpkg' -autoload :TkMessage, 'tk/message' + autoload :WinDDE, 'tk/winpkg' + autoload :WinRegistry, 'tk/winpkg' -autoload :TkManageFocus, 'tk/mngfocus' + autoload :ValidateConfigure, 'tk/validation' + autoload :ItemValidateConfigure, 'tk/validation' -autoload :TkMsgCatalog, 'tk/msgcat' -autoload :TkMsgCat, 'tk/msgcat' + autoload :EncodedString, 'tk/encodedstr' + def Tk.EncodedString(str, enc = nil); Tk::EncodedString.new(str, enc); end -autoload :TkNamespace, 'tk/namespace' + autoload :BinaryString, 'tk/encodedstr' + def Tk.BinaryString(str); Tk::BinaryString.new(str); end -autoload :TkOptionDB, 'tk/optiondb' -autoload :TkOption, 'tk/optiondb' -autoload :TkResourceDB, 'tk/optiondb' + autoload :UTF8_String, 'tk/encodedstr' + def Tk.UTF8_String(str); Tk::UTF8_String.new(str); end -autoload :TkPackage, 'tk/package' +end -autoload :TkPalette, 'tk/palette' +###################################### +# toplevel classes/modules +autoload_list = { + :TkBgError => 'tk/bgerror', -autoload :TkPanedWindow, 'tk/panedwindow' -autoload :TkPanedwindow, 'tk/panedwindow' + :TkBindTag => 'tk/bindtag', + :TkBindTagAll => 'tk/bindtag', + :TkDatabaseClass => 'tk/bindtag', -autoload :TkRadioButton, 'tk/radiobutton' -autoload :TkRadiobutton, 'tk/radiobutton' + :TkButton => 'tk/button', -autoload :TkRoot, 'tk/root' + :TkCanvas => 'tk/canvas', -autoload :TkScale, 'tk/scale' + :TkcItem => 'tk/canvas', + :TkcArc => 'tk/canvas', + :TkcBitmap => 'tk/canvas', + :TkcImage => 'tk/canvas', + :TkcLine => 'tk/canvas', + :TkcOval => 'tk/canvas', + :TkcPolygon => 'tk/canvas', + :TkcRectangle => 'tk/canvas', + :TkcText => 'tk/canvas', + :TkcWindow => 'tk/canvas', -autoload :TkScrollbar, 'tk/scrollbar' -autoload :TkXScrollbar, 'tk/scrollbar' -autoload :TkYScrollbar, 'tk/scrollbar' + :TkcTagAccess => 'tk/canvastag', + :TkcTag => 'tk/canvastag', + :TkcTagString => 'tk/canvastag', + :TkcNamedTag => 'tk/canvastag', + :TkcTagAll => 'tk/canvastag', + :TkcTagCurrent => 'tk/canvastag', + :TkcTagGroup => 'tk/canvastag', -autoload :TkScrollbox, 'tk/scrollbox' + :TkCheckButton => 'tk/checkbutton', + :TkCheckbutton => 'tk/checkbutton', -autoload :TkSelection, 'tk/selection' + :TkClipboard => 'tk/clipboard', -autoload :TkSpinbox, 'tk/spinbox' + :TkComposite => 'tk/composite', -autoload :TkTreatTagFont, 'tk/tagfont' + :TkConsole => 'tk/console', -autoload :TkText, 'tk/text' + :TkDialog => 'tk/dialog', + :TkDialog2 => 'tk/dialog', + :TkDialogObj => 'tk/dialog', + :TkWarning => 'tk/dialog', + :TkWarning2 => 'tk/dialog', + :TkWarningObj => 'tk/dialog', -autoload :TkTextImage, 'tk/textimage' + :TkEntry => 'tk/entry', -autoload :TkTextMark, 'tk/textmark' -autoload :TkTextNamedMark, 'tk/textmark' -autoload :TkTextMarkInsert, 'tk/textmark' -autoload :TkTextMarkCurrent, 'tk/textmark' -autoload :TkTextMarkAnchor, 'tk/textmark' + :TkEvent => 'tk/event', -autoload :TkTextTag, 'tk/texttag' -autoload :TkTextNamedTag, 'tk/texttag' -autoload :TkTextTagSel, 'tk/texttag' + :TkFont => 'tk/font', + :TkTreatTagFont => 'tk/font', -autoload :TkTextWindow, 'tk/textwindow' + :TkFrame => 'tk/frame', -autoload :TkAfter, 'tk/timer' -autoload :TkTimer, 'tk/timer' -autoload :TkRTTimer, 'tk/timer' + :TkImage => 'tk/image', + :TkBitmapImage => 'tk/image', + :TkPhotoImage => 'tk/image', -autoload :TkToplevel, 'tk/toplevel' + :TkItemConfigMethod => 'tk/itemconfig', -autoload :TkTextWin, 'tk/txtwin_abst' + :TkTreatItemFont => 'tk/itemfont', -autoload :TkValidation, 'tk/validation' + :TkKinput => 'tk/kinput', -autoload :TkVariable, 'tk/variable' -autoload :TkVarAccess, 'tk/variable' + :TkLabel => 'tk/label', -autoload :TkVirtualEvent, 'tk/virtevent' -autoload :TkNamedVirtualEvent,'tk/virtevent' + :TkLabelFrame => 'tk/labelframe', + :TkLabelframe => 'tk/labelframe', -autoload :TkWinfo, 'tk/winfo' + :TkListbox => 'tk/listbox', -autoload :TkWinDDE, 'tk/winpkg' -autoload :TkWinRegistry, 'tk/winpkg' + :TkMacResource => 'tk/macpkg', -autoload :TkXIM, 'tk/xim' + :TkMenu => 'tk/menu', + :TkMenuClone => 'tk/menu', + :TkSystemMenu => 'tk/menu', + :TkSysMenu_Help => 'tk/menu', + :TkSysMenu_System => 'tk/menu', + :TkSysMenu_Apple => 'tk/menu', + :TkMenubutton => 'tk/menu', + :TkOptionMenubutton => 'tk/menu', + :TkMenubar => 'tk/menubar', -####################### -# sub-module of Tk -module Tk - autoload :Clock, 'tk/clock' - autoload :OptionObj, 'tk/optionobj' - autoload :X_Scrollable, 'tk/scrollable' - autoload :Y_Scrollable, 'tk/scrollable' - autoload :Scrollable, 'tk/scrollable' - autoload :Wm, 'tk/wm' + :TkMenuSpec => 'tk/menuspec', - autoload :ValidateConfigure, 'tk/validation' - autoload :ItemValidateConfigure, 'tk/validation' + :TkMessage => 'tk/message', - autoload :EncodedString, 'tk/encodedstr' - def Tk.EncodedString(str, enc = nil); Tk::EncodedString.new(str, enc); end + :TkManageFocus => 'tk/mngfocus', - autoload :BinaryString, 'tk/encodedstr' - def Tk.BinaryString(str); Tk::BinaryString.new(str); end + :TkMsgCatalog => 'tk/msgcat', + :TkMsgCat => 'tk/msgcat', - autoload :UTF8_String, 'tk/encodedstr' - def Tk.UTF8_String(str); Tk::UTF8_String.new(str); end -end + :TkNamespace => 'tk/namespace', + + :TkOptionDB => 'tk/optiondb', + :TkOption => 'tk/optiondb', + :TkResourceDB => 'tk/optiondb', + + :TkPackage => 'tk/package', + + :TkPalette => 'tk/palette', + + :TkPanedWindow => 'tk/panedwindow', + :TkPanedwindow => 'tk/panedwindow', + + :TkRadioButton => 'tk/radiobutton', + :TkRadiobutton => 'tk/radiobutton', + + :TkRoot => 'tk/root', + + :TkScale => 'tk/scale', + + :TkScrollbar => 'tk/scrollbar', + :TkXScrollbar => 'tk/scrollbar', + :TkYScrollbar => 'tk/scrollbar', + + :TkScrollbox => 'tk/scrollbox', + + :TkSelection => 'tk/selection', + + :TkSpinbox => 'tk/spinbox', + + :TkTreatTagFont => 'tk/tagfont', + + :TkText => 'tk/text', + + :TkTextImage => 'tk/textimage', + :TktImage => 'tk/textimage', + + :TkTextMark => 'tk/textmark', + :TkTextNamedMark => 'tk/textmark', + :TkTextMarkInsert => 'tk/textmark', + :TkTextMarkCurrent => 'tk/textmark', + :TkTextMarkAnchor => 'tk/textmark', + :TktMark => 'tk/textmark', + :TktNamedMark => 'tk/textmark', + :TktMarkInsert => 'tk/textmark', + :TktMarkCurrent => 'tk/textmark', + :TktMarkAnchor => 'tk/textmark', + + :TkTextTag => 'tk/texttag', + :TkTextNamedTag => 'tk/texttag', + :TkTextTagSel => 'tk/texttag', + :TktTag => 'tk/texttag', + :TktNamedTag => 'tk/texttag', + :TktTagSel => 'tk/texttag', + + :TkTextWindow => 'tk/textwindow', + :TktWindow => 'tk/textwindow', + + :TkAfter => 'tk/timer', + :TkTimer => 'tk/timer', + :TkRTTimer => 'tk/timer', + + :TkToplevel => 'tk/toplevel', + + :TkTextWin => 'tk/txtwin_abst', + + :TkValidation => 'tk/validation', + + :TkVariable => 'tk/variable', + :TkVarAccess => 'tk/variable', + + :TkVirtualEvent => 'tk/virtevent', + :TkNamedVirtualEvent => 'tk/virtevent', + + :TkWinfo => 'tk/winfo', + + :TkWinDDE => 'tk/winpkg', + :TkWinRegistry => 'tk/winpkg', + + :TkXIM => 'tk/xim', +} +autoload_list.each{|mod, lib| + #autoload mod, lib unless + autoload mod, lib unless (Object.const_defined? mod) && (autoload? mod) +} diff --git a/ext/tk/lib/tk/button.rb b/ext/tk/lib/tk/button.rb index 407a47c400..04454cc6f7 100644 --- a/ext/tk/lib/tk/button.rb +++ b/ext/tk/lib/tk/button.rb @@ -4,7 +4,7 @@ require 'tk' require 'tk/label' -class TkButton' + end + def option_methods(*opts) opts.each{|m_set, m_cget, m_info| m_set = m_set.to_s diff --git a/ext/tk/lib/tk/entry.rb b/ext/tk/lib/tk/entry.rb index 4ac3f28229..2b55a0cafb 100644 --- a/ext/tk/lib/tk/entry.rb +++ b/ext/tk/lib/tk/entry.rb @@ -8,7 +8,7 @@ require 'tk/label' require 'tk/scrollable' require 'tk/validation' -class TkEntry 8 || + (Tk::TK_MAJOR_VERSION == 8 && Tk::TK_MINOR_VERSION >= 5) + begin + verstr = TkPackage.require('Ttk') + rescue RuntimeError + verstr = TkPackage.require('tile') + end +else + verstr = TkPackage.require('tile') +end + ver = verstr.split('.') -if ver[0].to_i == 0 && ver[1].to_i <= 4 - # version 0.4 or former - module Tk - module Tile - USE_TILE_NAMESPACE = true - USE_TTK_NAMESPACE = false - TILE_SPEC_VERSION_ID = 0 +if ver[0].to_i == 0 + # Tile extension package + if ver[1].to_i <= 4 + # version 0.4 or former + module Tk + module Tile + USE_TILE_NAMESPACE = true + USE_TTK_NAMESPACE = false + TILE_SPEC_VERSION_ID = 0 + end end - end -elsif ver[0].to_i == 0 && ver[1].to_i <= 6 - # version 0.5 -- version 0.6 - module Tk - module Tile - USE_TILE_NAMESPACE = true - USE_TTK_NAMESPACE = true - TILE_SPEC_VERSION_ID = 5 + elsif ver[1].to_i <= 6 + # version 0.5 -- version 0.6 + module Tk + module Tile + USE_TILE_NAMESPACE = true + USE_TTK_NAMESPACE = true + TILE_SPEC_VERSION_ID = 5 + end + end + elsif ver[1].to_i <= 7 + module Tk + module Tile + USE_TILE_NAMESPACE = false + USE_TTK_NAMESPACE = true + TILE_SPEC_VERSION_ID = 7 + end + end + else + # version 0.8 or later + module Tk + module Tile + USE_TILE_NAMESPACE = false + USE_TTK_NAMESPACE = true + TILE_SPEC_VERSION_ID = 8 + end end end + + module Tk::Tile + PACKAGE_NAME = 'tile'.freeze + end else - # version 0.7 or later + # Ttk package merged Tcl/Tk core (Tcl/Tk 8.5+) module Tk module Tile USE_TILE_NAMESPACE = false USE_TTK_NAMESPACE = true - TILE_SPEC_VERSION_ID = 7 + TILE_SPEC_VERSION_ID = 8 + + PACKAGE_NAME = 'Ttk'.freeze end end end @@ -51,14 +87,13 @@ module Tk module Tile TkComm::TkExtlibAutoloadModule.unshift(self) - PACKAGE_NAME = 'tile'.freeze def self.package_name PACKAGE_NAME end def self.package_version begin - TkPackage.require('tile') + TkPackage.require(PACKAGE_NAME) rescue '' end @@ -200,6 +235,8 @@ module Tk autoload :TPaned, 'tkextlib/tile/tpaned' autoload :Paned, 'tkextlib/tile/tpaned' + autoload :PanedWindow, 'tkextlib/tile/tpaned' + autoload :Panedwindow, 'tkextlib/tile/tpaned' autoload :TProgressbar, 'tkextlib/tile/tprogressbar' autoload :Progressbar, 'tkextlib/tile/tprogressbar' @@ -216,6 +253,8 @@ module Tk autoload :TScrollbar, 'tkextlib/tile/tscrollbar' autoload :Scrollbar, 'tkextlib/tile/tscrollbar' + autoload :XScrollbar, 'tkextlib/tile/tscrollbar' + autoload :YScrollbar, 'tkextlib/tile/tscrollbar' autoload :TSeparator, 'tkextlib/tile/tseparator' autoload :Separator, 'tkextlib/tile/tseparator' @@ -228,3 +267,5 @@ module Tk autoload :Style, 'tkextlib/tile/style' end end + +Ttk = Tk::Tile diff --git a/ext/tk/lib/tkextlib/tile/style.rb b/ext/tk/lib/tkextlib/tile/style.rb index 59bc4b0d78..b319d24d54 100644 --- a/ext/tk/lib/tkextlib/tile/style.rb +++ b/ext/tk/lib/tkextlib/tile/style.rb @@ -17,6 +17,12 @@ module Tk::Tile::Style end class << Tk::Tile::Style + if Tk::Tile::TILE_SPEC_VERSION_ID < 8 + TkCommandNames = ['style'.freeze].freeze + else + TkCommandNames = ['::ttk::style'.freeze].freeze + end + def configure(style=nil, keys=nil) if style.kind_of?(Hash) keys = style @@ -31,9 +37,9 @@ class << Tk::Tile::Style end if keys && keys != None - tk_call('style', sub_cmd, style, *hash_kv(keys)) + tk_call(TkCommandNames[0], sub_cmd, style, *hash_kv(keys)) else - tk_call('style', sub_cmd, style) + tk_call(TkCommandNames[0], sub_cmd, style) end end alias default configure @@ -46,14 +52,15 @@ class << Tk::Tile::Style style = '.' unless style if keys && keys != None - tk_call('style', 'map', style, *hash_kv(keys)) + tk_call(TkCommandNames[0], 'map', style, *hash_kv(keys)) else - tk_call('style', 'map', style) + tk_call(TkCommandNames[0], 'map', style) end end def lookup(style, opt, state=None, fallback_value=None) - tk_call('style', 'lookup', style, '-' << opt.to_s, state, fallback_value) + tk_call(TkCommandNames[0], 'lookup', style, + '-' << opt.to_s, state, fallback_value) end include Tk::Tile::ParseStyleLayout @@ -66,42 +73,42 @@ class << Tk::Tile::Style style = '.' unless style if spec - tk_call('style', 'layout', style, spec) + tk_call(TkCommandNames[0], 'layout', style, spec) else - _style_layout(list(tk_call('style', 'layout', style))) + _style_layout(list(tk_call(TkCommandNames[0], 'layout', style))) end end def element_create(name, type, *args) - tk_call('style', 'element', 'create', name, type, *args) + tk_call(TkCommandNames[0], 'element', 'create', name, type, *args) end def element_names() - list(tk_call('style', 'element', 'names')) + list(tk_call(TkCommandNames[0], 'element', 'names')) end def element_options(elem) - simplelist(tk_call('style', 'element', 'options', elem)) + simplelist(tk_call(TkCommandNames[0], 'element', 'options', elem)) end def theme_create(name, keys=nil) if keys && keys != None - tk_call('style', 'theme', 'create', name, *hash_kv(keys)) + tk_call(TkCommandNames[0], 'theme', 'create', name, *hash_kv(keys)) else - tk_call('style', 'theme', 'create', name) + tk_call(TkCommandNames[0], 'theme', 'create', name) end end def theme_settings(name, cmd=nil, &b) cmd = Proc.new(&b) if !cmd && b - tk_call('style', 'theme', 'settings', name, cmd) + tk_call(TkCommandNames[0], 'theme', 'settings', name, cmd) end def theme_names() - list(tk_call('style', 'theme', 'names')) + list(tk_call(TkCommandNames[0], 'theme', 'names')) end def theme_use(name) - tk_call('style', 'theme', 'use', name) + tk_call(TkCommandNames[0], 'theme', 'use', name) end end diff --git a/ext/tk/lib/tkextlib/tile/tpaned.rb b/ext/tk/lib/tkextlib/tile/tpaned.rb index 11178b19d3..2a2a25ea59 100644 --- a/ext/tk/lib/tkextlib/tile/tpaned.rb +++ b/ext/tk/lib/tkextlib/tile/tpaned.rb @@ -9,7 +9,7 @@ module Tk module Tile class TPaned < TkWindow end - Paned = TPaned + PanedWindow = Panedwindow = Paned = TPaned end end @@ -17,7 +17,11 @@ class Tk::Tile::TPaned < TkWindow include Tk::Tile::TileWidget if Tk::Tile::USE_TTK_NAMESPACE - TkCommandNames = ['::ttk::paned'.freeze].freeze + if Tk::Tile::TILE_SPEC_VERSION_ID < 8 + TkCommandNames = ['::ttk::paned'.freeze].freeze + else + TkCommandNames = ['::ttk::panedwindow'.freeze].freeze + end else TkCommandNames = ['::tpaned'.freeze].freeze end diff --git a/ext/tk/lib/tkextlib/tile/tscrollbar.rb b/ext/tk/lib/tkextlib/tile/tscrollbar.rb index bd49ae18e3..10b84e84a0 100644 --- a/ext/tk/lib/tkextlib/tile/tscrollbar.rb +++ b/ext/tk/lib/tkextlib/tile/tscrollbar.rb @@ -28,3 +28,22 @@ class Tk::Tile::TScrollbar < TkScrollbar [self::WidgetClassName, *(args.map!{|a| _get_eval_string(a)})].join('.') end end + +class Tk::Tile::XScrollbar < Tk::Tile::TScrollbar + def create_self(keys) + keys = {} unless keys + keys['orient'] = 'horizontal' + super(keys) + end + private :create_self +end + +class Tk::Tile::YScrollbar < Tk::Tile::TScrollbar + def create_self(keys) + keys = {} unless keys + keys['orient'] = 'vertical' + super(keys) + end + private :create_self +end + diff --git a/ext/tk/sample/demos-en/bind.rb b/ext/tk/sample/demos-en/bind.rb index aabe7f0849..6faeeaa30c 100644 --- a/ext/tk/sample/demos-en/bind.rb +++ b/ext/tk/sample/demos-en/bind.rb @@ -94,33 +94,27 @@ TkText.new($bind_demo){|t| } d1.bind('1', proc{ - eval(`cat #{[$demo_dir,'items.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'items.rb'].join(File::Separator)\}`) }) d2.bind('1', proc{ - eval(`cat #{[$demo_dir,'plot.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'plot.rb'].join(File::Separator)\}`) }) d3.bind('1', proc{ - eval(`cat #{[$demo_dir,'ctext.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'ctext.rb'].join(File::Separator)\}`) }) d4.bind('1', proc{ - eval(`cat #{[$demo_dir,'arrow.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'arrow.rb'].join(File::Separator)\}`) }) d5.bind('1', proc{ - eval(`cat #{[$demo_dir,'ruler.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'ruler.rb'].join(File::Separator)\}`) }) d6.bind('1', proc{ - eval(`cat #{[$demo_dir,'cscroll.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'cscroll.rb'].join(File::Separator)\}`) }) TkTextMarkInsert.new(t, '0.0') diff --git a/ext/tk/sample/demos-en/pendulum.rb b/ext/tk/sample/demos-en/pendulum.rb index 36bb44edec..a3498d67cf 100644 --- a/ext/tk/sample/demos-en/pendulum.rb +++ b/ext/tk/sample/demos-en/pendulum.rb @@ -49,9 +49,11 @@ TkFrame.new($pendulum_demo) {|frame| class PendulumAnimationDemo def initialize(frame) # Create some structural widgets - pane = TkPanedWindow.new(frame).pack(:fill=>:both, :expand=>true) - pane.add(@lf1 = TkLabelFrame.new(pane, :text=>'Pendulum Simulation')) - pane.add(@lf2 = TkLabelFrame.new(pane, :text=>'Phase Space')) + @pane = TkPanedWindow.new(frame).pack(:fill=>:both, :expand=>true) +# @pane.add(@lf1 = TkLabelFrame.new(@pane, :text=>'Pendulum Simulation')) +# @pane.add(@lf2 = TkLabelFrame.new(@pane, :text=>'Phase Space')) + @lf1 = TkLabelFrame.new(@pane, :text=>'Pendulum Simulation') + @lf2 = TkLabelFrame.new(@pane, :text=>'Phase Space') # Create the canvas containing the graphical representation of the # simulated system. @@ -99,23 +101,24 @@ class PendulumAnimationDemo @dTheta = 0.0 @length = 150 - # init display - showPendulum - # animation loop @timer = TkTimer.new(15){ repeat } # binding @c.bindtags_unshift(btag = TkBindTag.new) btag.bind('Destroy'){ @timer.stop } - btag.bind('1', proc{|x, y| @timer.stop; showPendulum(x, y)}, '%x %y') - btag.bind('B1-Motion', proc{|x, y| showPendulum(x, y)}, '%x %y') + btag.bind('1', proc{|x, y| @timer.stop; showPendulum(x.to_i, y.to_i)}, + '%x %y') + btag.bind('B1-Motion', proc{|x, y| showPendulum(x.to_i, y.to_i)}, '%x %y') btag.bind('ButtonRelease-1', - proc{|x, y| showPendulum(x, y); @timer.start }, '%x %y') + proc{|x, y| showPendulum(x.to_i, y.to_i); @timer.start }, + '%x %y') - btag.bind('Configure', proc{|w| @plate.coords(0, 25, w, 25)}, '%w') + btag.bind('Configure', proc{|w| @plate.coords(0, 25, w.to_i, 25)}, '%w') @k.bind('Configure', proc{|h, w| + h = h.to_i + w = w.to_i @psh = h/2; @psw = w/2 @x_axis.coords(2, @psh, w-2, @psh) @@ -124,6 +127,14 @@ class PendulumAnimationDemo @label_dtheta.coords(w-6, @psh+4) }, '%h %w') + # add + Tk.update + @pane.add(@lf1) + @pane.add(@lf2) + + # init display + showPendulum + # animation start @timer.start(500) end @@ -154,6 +165,10 @@ class PendulumAnimationDemo # rate at which the angle is changing (the first derivative with # respect to time.) def showPhase + unless @psw && @psh + @psw = @k.width/2 + @psh = @k.height/2 + end @points << @theta + @psw << -20*@dTheta + @psh if @points.length > 100 @points = @points[-100..-1] diff --git a/ext/tk/sample/demos-jp/bind.rb b/ext/tk/sample/demos-jp/bind.rb index 779e395826..af4e04fe8d 100644 --- a/ext/tk/sample/demos-jp/bind.rb +++ b/ext/tk/sample/demos-jp/bind.rb @@ -92,33 +92,27 @@ TkText.new($bind_demo){|t| } d1.bind('1', proc{ - eval(`cat #{[$demo_dir,'items.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'items.rb'].join(File::Separator)\}`) }) d2.bind('1', proc{ - eval(`cat #{[$demo_dir,'plot.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'plot.rb'].join(File::Separator)\}`) }) d3.bind('1', proc{ - eval(`cat #{[$demo_dir,'ctext.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'ctext.rb'].join(File::Separator)\}`) }) d4.bind('1', proc{ - eval(`cat #{[$demo_dir,'arrow.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'arrow.rb'].join(File::Separator)\}`) }) d5.bind('1', proc{ - eval(`cat #{[$demo_dir,'ruler.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'ruler.rb'].join(File::Separator)\}`) }) d6.bind('1', proc{ - eval(`cat #{[$demo_dir,'cscroll.rb'].join(File::Separator)}`, - _null_binding) + eval_samplecode(`cat #{[$demo_dir,'cscroll.rb'].join(File::Separator)\}`) }) TkTextMarkInsert.new(t, '0.0') diff --git a/ext/tk/sample/demos-jp/pendulum.rb b/ext/tk/sample/demos-jp/pendulum.rb index c245136d5c..e19b57a2d6 100644 --- a/ext/tk/sample/demos-jp/pendulum.rb +++ b/ext/tk/sample/demos-jp/pendulum.rb @@ -51,9 +51,11 @@ TkFrame.new($pendulum_demo) {|frame| class PendulumAnimationDemo def initialize(frame) # Create some structural widgets - pane = TkPanedWindow.new(frame).pack(:fill=>:both, :expand=>true) - pane.add(@lf1 = TkLabelFrame.new(pane, :text=>'Pendulum Simulation')) - pane.add(@lf2 = TkLabelFrame.new(pane, :text=>'Phase Space')) + @pane = TkPanedWindow.new(frame).pack(:fill=>:both, :expand=>true) +# @pane.add(@lf1 = TkLabelFrame.new(@pane, :text=>'Pendulum Simulation')) +# @pane.add(@lf2 = TkLabelFrame.new(@pane, :text=>'Phase Space')) + @lf1 = TkLabelFrame.new(@pane, :text=>'Pendulum Simulation') + @lf2 = TkLabelFrame.new(@pane, :text=>'Phase Space') # Create the canvas containing the graphical representation of the # simulated system. @@ -101,23 +103,24 @@ class PendulumAnimationDemo @dTheta = 0.0 @length = 150 - # init display - showPendulum - # animation loop @timer = TkTimer.new(15){ repeat } # binding @c.bindtags_unshift(btag = TkBindTag.new) btag.bind('Destroy'){ @timer.stop } - btag.bind('1', proc{|x, y| @timer.stop; showPendulum(x, y)}, '%x %y') - btag.bind('B1-Motion', proc{|x, y| showPendulum(x, y)}, '%x %y') + btag.bind('1', proc{|x, y| @timer.stop; showPendulum(x.to_i, y.to_i)}, + '%x %y') + btag.bind('B1-Motion', proc{|x, y| showPendulum(x.to_i, y.to_i)}, '%x %y') btag.bind('ButtonRelease-1', - proc{|x, y| showPendulum(x, y); @timer.start }, '%x %y') + proc{|x, y| showPendulum(x.to_i, y.to_i); @timer.start }, + '%x %y') - btag.bind('Configure', proc{|w| @plate.coords(0, 25, w, 25)}, '%w') + btag.bind('Configure', proc{|w| @plate.coords(0, 25, w.to_i, 25)}, '%w') @k.bind('Configure', proc{|h, w| + h = h.to_i + w = w.to_i @psh = h/2; @psw = w/2 @x_axis.coords(2, @psh, w-2, @psh) @@ -126,6 +129,14 @@ class PendulumAnimationDemo @label_dtheta.coords(w-6, @psh+4) }, '%h %w') + # add + Tk.update + @pane.add(@lf1) + @pane.add(@lf2) + + # init display + showPendulum + # animation start @timer.start(500) end @@ -156,6 +167,10 @@ class PendulumAnimationDemo # rate at which the angle is changing (the first derivative with # respect to time.) def showPhase + unless @psw && @psh + @psw = @k.width/2 + @psh = @k.height/2 + end @points << @theta + @psw << -20*@dTheta + @psh if @points.length > 100 @points = @points[-100..-1] diff --git a/ext/tk/sample/demos-jp/widget b/ext/tk/sample/demos-jp/widget index b369bfba96..7982a6651e 100644 --- a/ext/tk/sample/demos-jp/widget +++ b/ext/tk/sample/demos-jp/widget @@ -2,7 +2,11 @@ # -*- coding: euc-jp -*- # ´Á»ú¥³¡¼¥ÉÀßÄê ( tk.rb ¤Î¥í¡¼¥É»þ¤Î encoding ¿äÄê/ÀßÄê¤Ë»È¤ï¤ì¤ë ) -$KCODE = 'euc' +if RUBY_VERSION < '1.9.0' ### !!!!!!!!!!!!!! + $KCODE = 'euc' +else + $TK_ENCODING = 'EUC-JP' +end # tk ´Ø·¸¥é¥¤¥Ö¥é¥ê¤ÎÆɤ߹þ¤ß require 'tk' diff --git a/ext/tk/sample/tkextlib/vu/canvSticker2.rb b/ext/tk/sample/tkextlib/vu/canvSticker2.rb index f54e748660..34daf9ae3b 100644 --- a/ext/tk/sample/tkextlib/vu/canvSticker2.rb +++ b/ext/tk/sample/tkextlib/vu/canvSticker2.rb @@ -20,14 +20,16 @@ c.destroy #--- #--- set STRING {{x0 y0 x1 y1} {...text...} {resize point: center} -#sti_conf = [ [10, 10, 180, 180], "Sticker äöüß@²³¼½¾", :center ] -#txt_conf = [ [210, 210], "Text äöüß@²³¼½¾", :center ] +#sti_conf = [ [10, 10, 180, 180], "Sticker äöüß@²³¼½¾", :center ] +#txt_conf = [ [210, 210], "Text äöüß@²³¼½¾", :center ] sti_conf = [ [10, 10, 350, 350], - Tk::UTF8_String("Sticker äöüß@²³¼½¾"), :center ] + Tk::UTF8_String('Sticker \u00E4\u00F6\u00FC\u00DF\u0040\u00B2\u00B3\u00BC\u00BD\\u00BE') + :center ] txt_conf = [ [250, 250], - Tk::UTF8_String("Text äöüß@²³¼½¾"), :center ] + Tk::UTF8_String('Text \u00E4\u00F6\u00FC\u00DF\u0040\u00B2\u00B3\u00BC\u00BD\\u00BE') + :center ] -p sti_conf +#p sti_conf fnt = TkFont.new('Helvetica 24 bold') diff --git a/ext/tk/tcltklib.c b/ext/tk/tcltklib.c index d963f9231a..baa28c9640 100644 --- a/ext/tk/tcltklib.c +++ b/ext/tk/tcltklib.c @@ -4,7 +4,7 @@ * Oct. 24, 1997 Y. Matsumoto */ -#define TCLTKLIB_RELEASE_DATE "2006-12-01" +#define TCLTKLIB_RELEASE_DATE "2007-12-21" #include "ruby/ruby.h" #include "ruby/signal.h" @@ -312,6 +312,7 @@ call_queue_mark(struct call_queue *q) static VALUE eventloop_thread; static VALUE eventloop_stack; +static int window_event_mode = ~(TCL_WINDOW_EVENTS | TCL_IDLE_EVENTS); static VALUE watchdog_thread; @@ -564,6 +565,9 @@ struct tcltkip { Tcl_Interp *ip; /* the interpreter */ #if TCL_NAMESPACE_DEBUG Tcl_Namespace *default_ns; /* default namespace */ +#endif +#ifdef RUBY_VM + Tcl_ThreadId tk_thread_id; /* default namespace */ #endif int has_orig_exit; /* has original 'exit' command ? */ Tcl_CmdInfo orig_exit_info; /* command info of original 'exit' command */ @@ -755,6 +759,10 @@ tcltkip_init_tk(interp) } #endif +#ifdef RUBY_VM + ptr->tk_thread_id = Tcl_GetCurrentThread(); +#endif + return Qnil; } @@ -862,7 +870,8 @@ call_original_exit(ptr, state) if (info->isNativeObjectProc) { Tcl_Obj **argv; - argv = (Tcl_Obj **)ALLOC_N(Tcl_Obj *, 3); + // argv = (Tcl_Obj **)ALLOC_N(Tcl_Obj *, 3); /* XXXXXXXXXX */ + argv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * 3); argv[0] = Tcl_NewStringObj("exit", 4); argv[1] = state_obj; argv[2] = (Tcl_Obj *)NULL; @@ -875,7 +884,8 @@ call_original_exit(ptr, state) } else { /* string interface */ char **argv; - argv = (char **)ALLOC_N(char *, 3); + //argv = (char **)ALLOC_N(char *, 3); /* XXXXXXXXXX */ + argv = (char **)ckalloc(sizeof(char *) * 3); argv[0] = "exit"; /* argv[1] = Tcl_GetString(state_obj); */ argv[1] = Tcl_GetStringFromObj(state_obj, (int*)NULL); @@ -944,6 +954,34 @@ _timer_for_tcl(clientData) /* tick_counter += event_loop_max; */ } + +static VALUE +set_eventloop_window_mode(self, mode) + VALUE self; + VALUE mode; +{ + rb_secure(4); + + if (RTEST(mode)) { + window_event_mode = ~0; + } else { + window_event_mode = ~(TCL_WINDOW_EVENTS | TCL_IDLE_EVENTS); + } + + return mode; +} + +static VALUE +get_eventloop_window_mode(self) + VALUE self; +{ + if ( ~window_event_mode ) { + return Qfalse; + } else { + return Qtrue; + } +} + static VALUE set_eventloop_tick(self, tick) VALUE self; @@ -1258,18 +1296,24 @@ eventloop_sleep(dummy) t.tv_sec = (time_t)0; t.tv_usec = (time_t)(no_event_wait*1000.0); +#if 0 #ifdef HAVE_NATIVETHREAD if (!is_ruby_native_thread()) { rb_bug("cross-thread violation on eventloop_sleep()"); } +#endif #endif + DUMP2("eventloop_sleep: rb_thread_wait_for() at thread : %lx", rb_thread_current()); rb_thread_wait_for(t); + DUMP2("eventloop_sleep: finish at thread : %lx", rb_thread_current()); +#if 0 #ifdef HAVE_NATIVETHREAD if (!is_ruby_native_thread()) { rb_bug("cross-thread violation on eventloop_sleep()"); } +#endif #endif return Qnil; @@ -1310,14 +1354,19 @@ lib_eventloop_core(check_root, update_flag, check_var, interp) } for(;;) { +#ifdef RUBY_VM + if (0) { +#else if (rb_thread_alone()) { +#endif DUMP1("no other thread"); event_loop_wait_event = 0; if (update_flag) { event_flag = update_flag | TCL_DONT_WAIT; /* for safety */ } else { - event_flag = TCL_ALL_EVENTS; + // event_flag = TCL_ALL_EVENTS; + event_flag = TCL_FILE_EVENTS | TCL_TIMER_EVENTS | TCL_DONT_WAIT; } if (timer_tick == 0 && update_flag == 0) { @@ -1457,10 +1506,20 @@ lib_eventloop_core(check_root, update_flag, check_var, interp) if (NIL_P(eventloop_thread) || current == eventloop_thread) { int st; int status; - +#ifdef RUBY_VM + if (update_flag) { + st = RTEST(rb_protect(call_DoOneEvent, + INT2FIX(event_flag), &status)); + } else { + st = RTEST(rb_protect(call_DoOneEvent, + INT2FIX(event_flag & window_event_mode), + &status)); + } +#else /* st = Tcl_DoOneEvent(event_flag); */ st = RTEST(rb_protect(call_DoOneEvent, INT2FIX(event_flag), &status)); +#endif if (status) { switch (status) { case TAG_RAISE: @@ -1531,7 +1590,9 @@ lib_eventloop_core(check_root, update_flag, check_var, interp) tick_counter += no_event_tick; /* rb_thread_wait_for(t); */ +#if 0 rb_protect(eventloop_sleep, Qnil, &status); +#endif if (status) { switch (status) { @@ -1614,6 +1675,9 @@ lib_eventloop_core(check_root, update_flag, check_var, interp) break; /* switch to other thread */ } } + + DUMP1("thread scheduling"); + rb_thread_schedule(); } DUMP1("trap check & thread scheduling"); @@ -2004,9 +2068,11 @@ lib_thread_callback(argc, argv, self) proc = rb_block_proc(); } - q = (struct thread_call_proc_arg *)ALLOC(struct thread_call_proc_arg); + //q = (struct thread_call_proc_arg *)ALLOC(struct thread_call_proc_arg); + q = (struct thread_call_proc_arg *)ckalloc(sizeof(struct thread_call_proc_arg)); q->proc = proc; - q->done = (int*)ALLOC(int); + //q->done = (int*)ALLOC(int); + q->done = (int*)ckalloc(sizeof(int)); *(q->done) = 0; /* create call-proc thread */ @@ -2025,8 +2091,10 @@ lib_thread_callback(argc, argv, self) ret = rb_protect(_thread_call_proc_value, th, &status); } - free(q->done); - free(q); + //free(q->done); + //free(q); + ckfree((char*)q->done); + ckfree((char*)q); if (NIL_P(rbtk_pending_exception)) { /* return rb_errinfo(); */ @@ -2157,7 +2225,8 @@ ip_set_exc_message(interp, exc) } /* to avoid a garbled error message dialog */ - buf = ALLOC_N(char, (RSTRING_LEN(msg))+1); + // buf = ALLOC_N(char, (RSTRING_LEN(msg))+1); + buf = ckalloc(sizeof(char)*((RSTRING_LEN(msg))+1)); memcpy(buf, RSTRING_PTR(msg), RSTRING_LEN(msg)); buf[RSTRING_LEN(msg)] = 0; @@ -2168,7 +2237,8 @@ ip_set_exc_message(interp, exc) Tcl_AppendResult(interp, Tcl_DStringValue(&dstr), (char*)NULL); DUMP2("error message:%s", Tcl_DStringValue(&dstr)); Tcl_DStringFree(&dstr); - free(buf); + //free(buf); + ckfree(buf); #else /* TCL_VERSION <= 8.0 */ Tcl_AppendResult(interp, RSTRING_PTR(msg), (char*)NULL); @@ -2385,10 +2455,12 @@ tcl_protect(interp, proc, data) int old_trapflag = rb_trap_immediate; int code; +#if 0 #ifdef HAVE_NATIVETHREAD if (!is_ruby_native_thread()) { rb_bug("cross-thread violation on tcl_protect()"); } +#endif #endif rb_trap_immediate = 0; @@ -2792,10 +2864,12 @@ ip_rbUpdateCommand(clientData, interp, objc, objv) "IP is deleted"); return TCL_ERROR; } +#if 0 #ifdef HAVE_NATIVETHREAD if (!is_ruby_native_thread()) { rb_bug("cross-thread violation on ip_ruby_eval()"); } +#endif #endif if (objc == 1) { @@ -2939,10 +3013,12 @@ ip_rb_threadUpdateCommand(clientData, interp, objc, objv) "IP is deleted"); return TCL_ERROR; } +#if 0 #ifdef HAVE_NATIVETHREAD if (!is_ruby_native_thread()) { rb_bug("cross-thread violation on ip_ruby_eval()"); } +#endif #endif if (rb_thread_alone() @@ -3116,10 +3192,12 @@ ip_rbVwaitCommand(clientData, interp, objc, objv) #endif Tcl_Preserve(interp); +#if 0 #ifdef HAVE_NATIVETHREAD if (!is_ruby_native_thread()) { rb_bug("cross-thread violation on ip_ruby_eval()"); } +#endif #endif if (objc != 2) { @@ -4754,6 +4832,9 @@ ip_init(argc, argv, self) Data_Get_Struct(self, struct tcltkip, ptr); ptr = ALLOC(struct tcltkip); DATA_PTR(self) = ptr; +#ifdef RUBY_VM + ptr->tk_thread_id = 0; +#endif ptr->ref_count = 0; ptr->allow_ruby_exit = 1; ptr->return_value = 0; @@ -4861,6 +4942,9 @@ ip_init(argc, argv, self) (Tcl_PackageInitProc *) NULL); #endif +#ifdef RUBY_VM + ptr->tk_thread_id = Tcl_GetCurrentThread(); +#endif /* get main window */ mainWin = Tk_MainWindow(ptr->ip); Tk_Preserve((ClientData)mainWin); @@ -4924,7 +5008,7 @@ ip_init(argc, argv, self) if (mainWin != (Tk_Window)NULL) { Tk_Release((ClientData)mainWin); } - + return self; } @@ -5388,7 +5472,9 @@ get_str_from_obj(obj) #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 s = Tcl_GetStringFromObj(obj, &len); -#else /* TCL_VERSION >= 8.1 */ +#else +#if 0 + /* TCL_VERSION >= 8.1 */ if (Tcl_GetCharLength(obj) != Tcl_UniCharLen(Tcl_GetUnicode(obj))) { /* possibly binary string */ s = Tcl_GetByteArrayFromObj(obj, &len); @@ -5397,6 +5483,26 @@ get_str_from_obj(obj) /* possibly text string */ s = Tcl_GetStringFromObj(obj, &len); } +#else +#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 4 + if (Tcl_GetCharLength(obj) != Tcl_UniCharLen(Tcl_GetUnicode(obj))) { + /* possibly binary string */ + s = Tcl_GetByteArrayFromObj(obj, &len); + binary = 1; + } else { + /* possibly text string */ + s = Tcl_GetStringFromObj(obj, &len); + } +#else /* TCL_VERSION >= 8.5 */ + /* TODO: Known BUG: + Tcl_GetByteArrayFromObj() returns "alloc: invalid block" */ + if (Tcl_GetCharLength(obj) != Tcl_UniCharLen(Tcl_GetUnicode(obj))) { + /* possibly binary string */ + binary = 1; + } + s = Tcl_GetStringFromObj(obj, &len); +#endif +#endif #endif str = s ? rb_str_new(s, len) : rb_str_new2(""); if (binary) rb_ivar_set(str, ID_at_enc, rb_str_new2("binary")); @@ -5446,6 +5552,7 @@ ip_get_result_string_obj(interp) Tcl_IncrRefCount(retObj); strval = get_str_from_obj(retObj); OBJ_TAINT(strval); + Tcl_ResetResult(interp); Tcl_DecrRefCount(retObj); return strval; #else @@ -5479,7 +5586,7 @@ call_queue_handler(evPtr, flags) struct tcltkip *ptr; DUMP2("do_call_queue_handler : evPtr = %p", evPtr); - DUMP2("queue_handler thread : %lx", rb_thread_current()); + DUMP2("call_queue_handler thread : %lx", rb_thread_current()); DUMP2("added by thread : %lx", q->thread); if (*(q->done)) { @@ -5541,6 +5648,9 @@ tk_funcall(func, argc, argv, obj) VALUE obj; { struct call_queue *callq; +#ifdef RUBY_VM + struct tcltkip *ptr; +#endif int *alloc_done; int thr_crit_bup; volatile VALUE current = rb_thread_current(); @@ -5553,7 +5663,17 @@ tk_funcall(func, argc, argv, obj) return Qnil; } - if (NIL_P(eventloop_thread) || current == eventloop_thread) { +#ifdef RUBY_VM + ptr = get_ip(ip_obj); +#endif + + if ( +#ifdef RUBY_VM + (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread()) + && +#endif + (NIL_P(eventloop_thread) || current == eventloop_thread) + ) { if (NIL_P(eventloop_thread)) { DUMP2("tk_funcall from thread:%lx but no eventloop", current); } else { @@ -5602,14 +5722,25 @@ tk_funcall(func, argc, argv, obj) /* add the handler to Tcl event queue */ DUMP1("add handler"); +#ifdef RUBY_VM + if (ptr->tk_thread_id) { + Tcl_ThreadQueueEvent(ptr->tk_thread_id, &(callq->ev), TCL_QUEUE_HEAD); + Tcl_ThreadAlert(ptr->tk_thread_id); + } else { + Tcl_QueueEvent(&(callq->ev), TCL_QUEUE_HEAD); + } +#else Tcl_QueueEvent(&(callq->ev), TCL_QUEUE_HEAD); +#endif rb_thread_critical = thr_crit_bup; /* wait for the handler to be processed */ DUMP2("wait for handler (current thread:%lx)", current); while(*alloc_done >= 0) { + DUMP2("*** wait for handler (current thread:%lx)", current); rb_thread_stop(); + DUMP2("*** wakeup (current thread:%lx)", current); } DUMP2("back from handler (current thread:%lx)", current); @@ -5806,6 +5937,11 @@ eval_queue_handler(evPtr, flags) struct eval_queue *q = (struct eval_queue *)evPtr; volatile VALUE ret; volatile VALUE q_dat; + struct tcltkip *ptr; + + DUMP2("do_eval_queue_handler : evPtr = %p", evPtr); + DUMP2("eval_queue_thread : %lx", rb_thread_current()); + DUMP2("added by thread : %lx", q->thread); if (*(q->done)) { DUMP1("processed by another event-loop"); @@ -5817,12 +5953,21 @@ eval_queue_handler(evPtr, flags) /* process it */ *(q->done) = 1; + /* deleted ipterp ? */ + ptr = get_ip(q->interp); + if (deleted_ip(ptr)) { + /* deleted IP --> ignore */ + return 1; + } + /* check safe-level */ if (rb_safe_level() != q->safe_level) { +#if 0 #ifdef HAVE_NATIVETHREAD if (!is_ruby_native_thread()) { rb_bug("cross-thread violation on eval_queue_handler()"); } +#endif #endif /* q_dat = Data_Wrap_Struct(rb_cData,0,0,q); */ q_dat = Data_Wrap_Struct(rb_cData,eval_queue_mark,0,q); @@ -5860,6 +6005,9 @@ ip_eval(self, str) VALUE str; { struct eval_queue *evq; +#ifdef RUBY_VM + struct tcltkip *ptr; +#endif char *eval_str; int *alloc_done; int thr_crit_bup; @@ -5874,7 +6022,17 @@ ip_eval(self, str) StringValue(str); rb_thread_critical = thr_crit_bup; - if (NIL_P(eventloop_thread) || current == eventloop_thread) { +#ifdef RUBY_VM + ptr = get_ip(ip_obj); +#endif + + if ( +#ifdef RUBY_VM + (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread()) + && +#endif + (NIL_P(eventloop_thread) || current == eventloop_thread) + ) { if (NIL_P(eventloop_thread)) { DUMP2("eval from thread:%lx but no eventloop", current); } else { @@ -5921,14 +6079,25 @@ ip_eval(self, str) /* add the handler to Tcl event queue */ DUMP1("add handler"); +#ifdef RUBY_VM + if (ptr->tk_thread_id) { + Tcl_ThreadQueueEvent(ptr->tk_thread_id, &(evq->ev), position); + Tcl_ThreadAlert(ptr->tk_thread_id); + } else { + Tcl_QueueEvent(&(evq->ev), position); + } +#else Tcl_QueueEvent(&(evq->ev), position); +#endif rb_thread_critical = thr_crit_bup; /* wait for the handler to be processed */ DUMP2("wait for handler (current thread:%lx)", current); while(*alloc_done >= 0) { + DUMP2("*** wait for handler (current thread:%lx)", current); rb_thread_stop(); + DUMP2("*** wakeup (current thread:%lx)", current); } DUMP2("back from handler (current thread:%lx)", current); @@ -6492,7 +6661,8 @@ invoke_tcl_proc(arg) #if TCL_MAJOR_VERSION >= 8 if (!inf->cmdinfo.isNativeObjectProc) { /* string interface */ - argv = (char **)ALLOC_N(char *, argc+1); + // argv = (char **)ALLOC_N(char *, argc+1); /* XXXXXXXXXX */ + argv = (char **)ckalloc(sizeof(char *)*(argc+1)); for (i = 0; i < argc; ++i) { argv[i] = Tcl_GetStringFromObj(inf->objv[i], &len); } @@ -6505,6 +6675,7 @@ invoke_tcl_proc(arg) /* Invoke the C procedure */ #if TCL_MAJOR_VERSION >= 8 if (inf->cmdinfo.isNativeObjectProc) { + int ret_val; inf->ptr->return_value = (*(inf->cmdinfo.objProc))(inf->cmdinfo.objClientData, inf->ptr->ip, inf->objc, inf->objv); @@ -6517,7 +6688,8 @@ invoke_tcl_proc(arg) = (*(inf->cmdinfo.proc))(inf->cmdinfo.clientData, inf->ptr->ip, argc, (CONST84 char **)argv); - free(argv); + //free(argv); + ckfree((char*)argv); #else /* TCL_MAJOR_VERSION < 8 */ inf->ptr->return_value @@ -6563,6 +6735,9 @@ ip_invoke_core(interp, argc, argv) #endif #endif + /* get the data struct */ + ptr = get_ip(interp); + /* get the command name string */ #if TCL_MAJOR_VERSION >= 8 cmd = Tcl_GetStringFromObj(objv[0], &len); @@ -6570,9 +6745,6 @@ ip_invoke_core(interp, argc, argv) cmd = argv[0]; #endif - /* get the data struct */ - ptr = get_ip(interp); - /* ip is deleted? */ if (deleted_ip(ptr)) { return rb_tainted_str_new2(""); @@ -6622,7 +6794,8 @@ ip_invoke_core(interp, argc, argv) unknown_flag = 1; #if TCL_MAJOR_VERSION >= 8 - unknown_objv = (Tcl_Obj **)ALLOC_N(Tcl_Obj *, objc+2); + //unknown_objv = (Tcl_Obj **)ALLOC_N(Tcl_Obj *, objc+2); + unknown_objv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * (objc+2)); unknown_objv[0] = Tcl_NewStringObj("::unknown", 9); Tcl_IncrRefCount(unknown_objv[0]); memcpy(unknown_objv + 1, objv, sizeof(Tcl_Obj *)*objc); @@ -6642,7 +6815,6 @@ ip_invoke_core(interp, argc, argv) thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; - #if 1 /* wrap tcl-proc call */ /* setup params */ inf.ptr = ptr; @@ -6683,7 +6855,8 @@ ip_invoke_core(interp, argc, argv) int i; /* string interface */ - argv = (char **)ALLOC_N(char *, argc+1); + //argv = (char **)ALLOC_N(char *, argc+1); + argv = (char **)ckalloc(sizeof(char *) * (argc+1)); for (i = 0; i < argc; ++i) { argv[i] = Tcl_GetStringFromObj(objv[i], &len); } @@ -6712,7 +6885,8 @@ ip_invoke_core(interp, argc, argv) ptr->return_value = (*info.proc)(info.clientData, ptr->ip, argc, (CONST84 char **)argv); - free(argv); + //free(argv); + ckfree(argv); #else /* TCL_MAJOR_VERSION < 8 */ ptr->return_value = (*info.proc)(info.clientData, ptr->ip, @@ -6783,7 +6957,8 @@ alloc_invoke_arguments(argc, argv) /* memory allocation */ #if TCL_MAJOR_VERSION >= 8 - av = ALLOC_N(Tcl_Obj *, argc+1); + //av = ALLOC_N(Tcl_Obj *, argc+1); /* XXXXXXXXXX */ + av = (Tcl_Obj**)ckalloc(sizeof(Tcl_Obj *)*(argc+1)); for (i = 0; i < argc; ++i) { av[i] = get_obj_from_str(argv[i]); Tcl_IncrRefCount(av[i]); @@ -6822,7 +6997,11 @@ free_invoke_arguments(argc, av) free(av[i]); #endif } +#if TCL_MAJOR_VERSION >= 8 + ckfree((char*)av); +#else /* TCL_MAJOR_VERSION < 8 */ free(av); +#endif } static VALUE @@ -6942,6 +7121,9 @@ ip_invoke_with_position(argc, argv, obj, position) Tcl_QueuePosition position; { struct invoke_queue *ivq; +#ifdef RUBY_VM + struct tcltkip *ptr; +#endif int *alloc_done; int thr_crit_bup; volatile VALUE current = rb_thread_current(); @@ -6958,7 +7140,21 @@ ip_invoke_with_position(argc, argv, obj, position) if (argc < 1) { rb_raise(rb_eArgError, "command name missing"); } - if (NIL_P(eventloop_thread) || current == eventloop_thread) { + +#ifdef RUBY_VM + ptr = get_ip(ip_obj); +#endif + DUMP2("status: ptr->tk_thread_id %d", ptr->tk_thread_id); + DUMP2("status: Tcl_GetCurrentThread %d", Tcl_GetCurrentThread()); + DUMP2("status: eventloopt_thread %lx", eventloop_thread); + + if ( +#ifdef RUBY_VM + (ptr->tk_thread_id == 0 || ptr->tk_thread_id == Tcl_GetCurrentThread()) + && +#endif + (NIL_P(eventloop_thread) || current == eventloop_thread) + ) { if (NIL_P(eventloop_thread)) { DUMP2("invoke from thread:%lx but no eventloop", current); } else { @@ -6971,8 +7167,6 @@ ip_invoke_with_position(argc, argv, obj, position) return result; } - DUMP2("invoke from thread %lx (NOT current eventloop)", current); - thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; @@ -6980,11 +7174,12 @@ ip_invoke_with_position(argc, argv, obj, position) av = alloc_invoke_arguments(argc, argv); /* allocate memory (keep result) */ - alloc_done = (int*)ALLOC(int); + //alloc_done = (int*)ALLOC(int); + alloc_done = (int*)ckalloc(sizeof(int)); *alloc_done = 0; /* allocate memory (freed by Tcl_ServiceEvent) */ - ivq = (struct invoke_queue *)Tcl_Alloc(sizeof(struct invoke_queue)); + ivq = (struct invoke_queue *)ckalloc(sizeof(struct invoke_queue)); Tcl_Preserve(ivq); /* allocate result obj */ @@ -7002,20 +7197,30 @@ ip_invoke_with_position(argc, argv, obj, position) /* add the handler to Tcl event queue */ DUMP1("add handler"); +#ifdef RUBY_VM + if (ptr->tk_thread_id) { + Tcl_ThreadQueueEvent(ptr->tk_thread_id, &(ivq->ev), position); + Tcl_ThreadAlert(ptr->tk_thread_id); + } else { + Tcl_QueueEvent(&(ivq->ev), position); + } +#else Tcl_QueueEvent(&(ivq->ev), position); +#endif rb_thread_critical = thr_crit_bup; /* wait for the handler to be processed */ DUMP2("wait for handler (current thread:%lx)", current); while(*alloc_done >= 0) { - rb_thread_stop(); + rb_thread_stop(); } DUMP2("back from handler (current thread:%lx)", current); /* get result & free allocated memory */ ret = RARRAY_PTR(result)[0]; - free(alloc_done); + //free(alloc_done); + ckfree((char*)alloc_done); Tcl_Release(ivq); @@ -7028,7 +7233,6 @@ ip_invoke_with_position(argc, argv, obj, position) rb_exc_raise(ret); } - DUMP1("exit ip_invoke"); return ret; } @@ -7645,7 +7849,7 @@ lib_merge_tklist(argc, argv, obj) } /* pass 2 */ - result = (char *)Tcl_Alloc(len); + result = (char *)ckalloc(len); dst = result; for(num = 0; num < argc; num++) { #if TCL_MAJOR_VERSION >= 8 @@ -7670,7 +7874,7 @@ lib_merge_tklist(argc, argv, obj) /* create object */ str = rb_str_new(result, dst - result - 1); if (taint_flag) OBJ_TAINT(str); - Tcl_Free(result); + ckfree(result); if (old_gc == Qfalse) rb_gc_enable(); rb_thread_critical = thr_crit_bup; @@ -7716,6 +7920,35 @@ lib_conv_listelement(self, src) } +static VALUE +lib_getversion(self) + VALUE self; +{ + int major, minor, patchlevel, type; + volatile VALUE type_name; + + Tcl_GetVersion(&major, &minor, &patchlevel, &type); + + switch(type) { + case TCL_ALPHA_RELEASE: + type_name = rb_str_new2("alpha"); + break; + case TCL_BETA_RELEASE: + type_name = rb_str_new2("beta"); + break; + case TCL_FINAL_RELEASE: + type_name = rb_str_new2("final"); + break; + default: + type_name = rb_str_new2("unknown"); + } + + return rb_ary_new3(5, INT2NUM(major), INT2NUM(minor), + INT2NUM(type), type_name, + INT2NUM(patchlevel)); +} + + static VALUE tcltklib_compile_info() { @@ -7780,7 +8013,7 @@ tcltklib_compile_info() /* * The following is based on tkMenu.[ch] - * of Tcl/Tk (>=8.0) source code. + * of Tcl/Tk (Tk8.0 -- Tk8.5b1) source code. */ #if TCL_MAJOR_VERSION >= 8 @@ -7814,7 +8047,11 @@ struct dummy_TkMenuRef { char *dummy3; }; +#if 0 EXTERN struct dummy_TkMenuRef *TkFindMenuReferences(Tcl_Interp*, char*); +#else +#define MENU_HASH_KEY "tkMenus" /* based on Tk8.0 - Tk8.5b1 */ +#endif #endif @@ -7825,11 +8062,27 @@ ip_make_menu_embeddable(interp, menu_path) { #if TCL_MAJOR_VERSION >= 8 struct tcltkip *ptr = get_ip(interp); - struct dummy_TkMenuRef *menuRefPtr; + struct dummy_TkMenuRef *menuRefPtr = NULL; + XEvent event; + Tcl_HashTable *menuTablePtr; + Tcl_HashEntry *hashEntryPtr; StringValue(menu_path); +#if 0 /* was available on Tk8.0 -- Tk8.4 */ menuRefPtr = TkFindMenuReferences(ptr->ip, RSTRING_PTR(menu_path)); +#else /* based on Tk8.0 -- Tk8.5b1 */ + if ((menuTablePtr + = (Tcl_HashTable *) Tcl_GetAssocData(ptr->ip, MENU_HASH_KEY, NULL)) + != NULL) { + if ((hashEntryPtr + = Tcl_FindHashEntry(menuTablePtr, RSTRING_PTR(menu_path))) + != NULL) { + menuRefPtr = (struct dummy_TkMenuRef *) Tcl_GetHashValue(hashEntryPtr); + } + } +#endif + if (menuRefPtr == (struct dummy_TkMenuRef *) NULL) { rb_raise(rb_eArgError, "not a menu widget, or invalid widget path"); } @@ -7856,9 +8109,20 @@ ip_make_menu_embeddable(interp, menu_path) } #endif +#if 0 /* was available on Tk8.0 -- Tk8.4 */ TkEventuallyRecomputeMenu(menuRefPtr->menuPtr); TkEventuallyRedrawMenu(menuRefPtr->menuPtr, (struct dummy_TkMenuEntry *)NULL); +#else /* based on Tk8.0 -- Tk8.5b1 */ + memset((void *) &event, 0, sizeof(event)); + event.xany.type = ConfigureNotify; + event.xany.serial = NextRequest(Tk_Display((menuRefPtr->menuPtr)->tkwin)); + event.xany.send_event = 0; /* FALSE */ + event.xany.window = Tk_WindowId((menuRefPtr->menuPtr)->tkwin); + event.xany.display = Tk_Display((menuRefPtr->menuPtr)->tkwin); + event.xconfigure.window = event.xany.window; + Tk_HandleEvent(&event); +#endif #else /* TCL_MAJOR_VERSION <= 7 */ rb_notimplement(); @@ -7880,6 +8144,7 @@ Init_tcltklib() VALUE ev_flag = rb_define_module_under(lib, "EventFlag"); VALUE var_flag = rb_define_module_under(lib, "VarAccessFlag"); + VALUE release_type = rb_define_module_under(lib, "RELEASE_TYPE"); /* --------------------------------------------------------------- */ @@ -7937,6 +8202,14 @@ Init_tcltklib() /* --------------------------------------------------------------- */ + rb_define_module_function(lib, "get_version", lib_getversion, -1); + + rb_define_const(release_type, "ALPHA", INT2FIX(TCL_ALPHA_RELEASE)); + rb_define_const(release_type, "BETA", INT2FIX(TCL_BETA_RELEASE)); + rb_define_const(release_type, "FINAL", INT2FIX(TCL_FINAL_RELEASE)); + + /* --------------------------------------------------------------- */ + eTkCallbackReturn = rb_define_class("TkCallbackReturn", rb_eStandardError); eTkCallbackBreak = rb_define_class("TkCallbackBreak", rb_eStandardError); eTkCallbackContinue = rb_define_class("TkCallbackContinue", @@ -7989,6 +8262,8 @@ Init_tcltklib() lib_evloop_abort_on_exc, 0); rb_define_module_function(lib, "mainloop_abort_on_exception=", lib_evloop_abort_on_exc_set, 1); + rb_define_module_function(lib, "set_eventloop_window_mode",set_eventloop_window_mode,1); + rb_define_module_function(lib, "get_eventloop_window_mode",get_eventloop_window_mode,0); rb_define_module_function(lib, "set_eventloop_tick",set_eventloop_tick,1); rb_define_module_function(lib, "get_eventloop_tick",get_eventloop_tick,0); rb_define_module_function(lib, "set_no_event_wait", set_no_event_wait, 1); -- cgit v1.2.3