summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
Diffstat (limited to 'ext')
-rw-r--r--ext/tk/extconf.rb308
-rw-r--r--ext/tk/lib/tk.rb90
-rw-r--r--ext/tk/stubs.c20
-rw-r--r--ext/tk/tcltklib.c275
4 files changed, 573 insertions, 120 deletions
diff --git a/ext/tk/extconf.rb b/ext/tk/extconf.rb
index c5dbfeafa6..3f46562f37 100644
--- a/ext/tk/extconf.rb
+++ b/ext/tk/extconf.rb
@@ -1,13 +1,14 @@
##############################################################
# extconf.rb for tcltklib
-# release date: 2010-05-19
+# release date: 2010-05-31
##############################################################
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.3 8.2 8.1 8.0]
+ %w[8.7 8.6 8.5 8.4 8.0] # to shorten search steps
##############################################################
@@ -178,7 +179,9 @@ def get_shlib_path_head
path_dirs = []
if TkLib_Config["ActiveTcl"].kind_of?(String) # glob path
- path_dirs.concat Dir.glob(TkLib_Config["ActiveTcl"], File::FNM_CASEFOLD).sort.reverse
+ # 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
@@ -288,6 +291,7 @@ def find_macosx_framework
"/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.directory?(tcldir = File.join(dir, "Tcl.framework"))
@@ -379,7 +383,7 @@ def get_tclConfig_dirs
if TkLib_Config["ActiveTcl"]
dirs = []
if TkLib_Config["ActiveTcl"].kind_of?(String)
- dirs << TkLib_Config["ActiveTcl"]
+ dirs << File.join(TkLib_Config["ActiveTcl"], 'lib')
end
dirs.concat [
"c:/ActiveTcl*/lib", "c:/Tcl*/lib",
@@ -411,13 +415,32 @@ def get_tclConfig_dirs
config_dir.concat(dirs.zip(dirs))
- elsif framework = find_macosx_framework()
- config_dir.unshift(framework)
-
else
+ if framework = find_macosx_framework()
+ config_dir.unshift(framework)
+ end
+
if activeTcl = TkLib_Config['ActiveTcl']
# check latest version at first
- config_dir.concat(Dir.glob(activeTcl, File::FNM_CASEFOLD).sort.reverse)
+ 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.concat [
@@ -448,27 +471,88 @@ def get_tclConfig_dirs
}
# for MacOS X
- #config_dir << "~/Library/Tcl"
- #config_dir.concat(Dir.glob("~/Library/Tcl/*", File::FNM_CASEFOLD).sort.reverse)
- config_dir << "/Library/Tcl"
- config_dir.concat(Dir.glob("/Library/Tcl/*", File::FNM_CASEFOLD).sort.reverse)
- config_dir << "/Network/Library/Tcl"
- config_dir.concat(Dir.glob("/Network/Library/Tcl/*", File::FNM_CASEFOLD).sort.reverse)
- config_dir << "/System/Library/Tcl"
- config_dir.concat(Dir.glob("/System/Library/Tcl/*", File::FNM_CASEFOLD).sort.reverse)
- [
+ 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"
- ].each{|framework|
- config_dir << [File.expand_path(File.join(framework, 'Tcl.framework')),
- File.expand_path(File.join(framework, 'Tk.framework'))]
+ ]
+ paths.reverse! unless TkLib_Config["ActiveTcl"]
+
+ paths.each{|framework|
+ base = File.expand_path(framework)
+ 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 libcheck_for_tclConfig(dir, 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
+
+ libpath = $LIBPATH
+ tcllibs = nil
+
+ begin
+ tcllib_ok ||= Dir.glob(File.join(dir, "*tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}{.,}#{tclconf['TCL_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file|
+ if file =~ /^.*(tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}(\.|)#{tclconf['TCL_MINOR_VERSION']}.*)\.[^.]*$/
+ #puts "check #{file} #{$1} #{tclfunc} #{dir}"
+ #find_library($1, tclfunc, dir)
+ tcllibs = append_library($libs, $1)
+ $LIBPATH = libpath | [dir]
+ try_func(tclfunc, tcllibs)
+ end
+ }
+ tklib_ok ||= Dir.glob(File.join(dir, "*tk#{stub}#{tkconf['TK_MAJOR_VERSION']}{.,}#{tkconf['TK_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file|
+ if file =~ /^.*(tk#{stub}#{tkconf['TK_MAJOR_VERSION']}(\.|)#{tkconf['TK_MINOR_VERSION']}.*)\.[^.]*$/
+ #puts "check #{file} #{$1} #{tkfunc} #{dir}"
+ # find_library($1, tkfunc, dir)
+ tklibs = append_library(tcllibs, $1)
+ $LIBPATH = libpath | [dir]
+ try_func(tkfunc, tklibs)
+ end
+ }
+ ensure
+ $LIBPATH = libpath
+ end
+
+ [tcllib_ok, tklib_ok]
+end
+
def search_tclConfig(*paths) # libdir list or [tcl-libdir|file, tk-libdir|file]
TkLib_Config["tclConfig_paths"] = []
@@ -518,7 +602,7 @@ def search_tclConfig(*paths) # libdir list or [tcl-libdir|file, tk-libdir|file]
if File.file?(tkdir)
tkcfg_files = [tkdir] * tails.length
else
- tkcfg_files = tails.map{|f| File.join(tcldir, 'tk' << f)}
+ tkcfg_files = tails.map{|f| File.join(tkdir, 'tk' << f)}
end
tclcfg_files.zip(tkcfg_files).uniq.each{|tclpath, tkpath|
@@ -532,7 +616,7 @@ def search_tclConfig(*paths) # libdir list or [tcl-libdir|file, tk-libdir|file]
# nativethread check
if !TkLib_Config["ruby_with_thread"] && tclconf['TCL_THREADS'] == '1'
- puts "WARNING: found #{tclpath.inspect}, but it WITH nativethread-support under ruby WITHOUT nativethread-support. So, ignore it."
+ puts "\nWARNING: found #{tclpath.inspect}, but it WITH nativethread-support under ruby WITHOUT nativethread-support. So, ignore it."
TkLib_Config["tcltk-NG-path"] << File.dirname(tclpath)
next
end
@@ -541,43 +625,54 @@ def search_tclConfig(*paths) # libdir list or [tcl-libdir|file, tk-libdir|file]
conf = [tclconf, tkconf] unless conf
# check Tcl library
- if TkLib_Config["tcltk-stubs"]
- stub = "stub"
- tclfunc = "Tcl_InitStubs"
- tkfunc = "Tk_InitStubs"
+ if is_macosx? && TkLib_Config["tcltk-framework"]
+ # if use framework, not check (believe it is installed properly)
+ tcllib_ok = tklib_ok = true
else
- stub = ""
- tclfunc = "Tcl_FindExecutable"
- tkfunc = "Tk_Init"
- end
- dir = File.dirname(tclpath)
- libpath = $LIBPATH
- tcllibs = nil
- begin
- tcllib_ok = Dir.glob(File.join(dir, "*tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}{.,}#{tclconf['TCL_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file|
- if file =~ /^.*(tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}(\.|)#{tclconf['TCL_MINOR_VERSION']}.*)\.[^.]*$/
- #puts "check #{file} #{$1} #{tclfunc} #{dir}"
- #find_library($1, tclfunc, dir)
- tcllibs = append_library($libs, $1)
- $LIBPATH = libpath | [dir]
- try_func(tclfunc, tcllibs)
- end
- }
- tklib_ok = Dir.glob(File.join(dir, "*tk#{stub}#{tkconf['TK_MAJOR_VERSION']}{.,}#{tkconf['TK_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file|
- if file =~ /^.*(tk#{stub}#{tkconf['TK_MAJOR_VERSION']}(\.|)#{tkconf['TK_MINOR_VERSION']}.*)\.[^.]*$/
- #puts "check #{file} #{$1} #{tkfunc} #{dir}"
- # find_library($1, tkfunc, dir)
- tklibs = append_library(tcllibs, $1)
- $LIBPATH = libpath | [dir]
- try_func(tkfunc, tklibs)
- end
- }
- ensure
- $LIBPATH = libpath
+ tcllib_ok, tklib_ok = libcheck_for_tclConfig(File.dirname(tclpath),
+ tclconf, tkconf)
+=begin
+ 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
+ dir = File.dirname(tclpath)
+ libpath = $LIBPATH
+ tcllibs = nil
+
+ begin
+ tcllib_ok ||= Dir.glob(File.join(dir, "*tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}{.,}#{tclconf['TCL_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file|
+ if file =~ /^.*(tcl#{stub}#{tclconf['TCL_MAJOR_VERSION']}(\.|)#{tclconf['TCL_MINOR_VERSION']}.*)\.[^.]*$/
+ #puts "check #{file} #{$1} #{tclfunc} #{dir}"
+ #find_library($1, tclfunc, dir)
+ tcllibs = append_library($libs, $1)
+ $LIBPATH = libpath | [dir]
+ try_func(tclfunc, tcllibs)
+ end
+ }
+ tklib_ok ||= Dir.glob(File.join(dir, "*tk#{stub}#{tkconf['TK_MAJOR_VERSION']}{.,}#{tkconf['TK_MINOR_VERSION']}*.*"), File::FNM_CASEFOLD).find{|file|
+ if file =~ /^.*(tk#{stub}#{tkconf['TK_MAJOR_VERSION']}(\.|)#{tkconf['TK_MINOR_VERSION']}.*)\.[^.]*$/
+ #puts "check #{file} #{$1} #{tkfunc} #{dir}"
+ # find_library($1, tkfunc, dir)
+ tklibs = append_library(tcllibs, $1)
+ $LIBPATH = libpath | [dir]
+ try_func(tkfunc, tklibs)
+ end
+ }
+ ensure
+ $LIBPATH = libpath
+ end
+=end
end
unless tcllib_ok && tklib_ok
- puts "WARNING: found #{tclpath.inspect}, but cannot find valid Tcl/Tk libraries on the same directory. So, ignore it."
+ puts "\nWARNING: found #{tclpath.inspect}, but cannot find valid Tcl/Tk libraries on the same directory. So, ignore it."
TkLib_Config["tcltk-NG-path"] << File.dirname(tclpath)
next
end
@@ -590,6 +685,13 @@ def search_tclConfig(*paths) # libdir list or [tcl-libdir|file, tk-libdir|file]
# 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
@@ -691,6 +793,10 @@ def check_shlib_search_path(paths)
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?
@@ -718,7 +824,7 @@ def check_shlib_search_path(paths)
path_list = check_NG_path(path_list)
path_list.map!{|path| path.strip}
- if !CROSS_COMPILING and is_win32?
+ 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
@@ -1031,29 +1137,52 @@ def find_tcltk_header(tclver, tkver)
have_tcl_h && have_tk_h
end
-def setup_for_macosx_framework
- # search directory of header files
- if File.exist?(dir = File.join(TkLib_Config["tcltk-framework"],
- 'Tcl.framework', 'Headers'))
- TclConfig_Info['TCL_INCLUDE_SPEC'] = "-I#{dir} "
- TkConfig_Info['TK_INCLUDE_SPEC'] = "-I#{File.join(TkLib_Config['tcltk-framework'], 'Tk.framework', 'Headers')} "
- else
- dir = Dir.glob(File.join(TkLib_Config["tcltk-framework"],
- 'Tcl.framework', '*', 'Headers'),
- File::FNM_CASEFOLD)
- TclConfig_Info['TCL_INCLUDE_SPEC'] = "-I#{dir[0]} " unless dir.empty?
- TkConfig_Info['TK_INCLUDE_SPEC'] = "-I#{Dir.glob(File.join(TkLib_Config['tcltk-framework'], 'Tk.framework', '*', 'Headers'), File::FNM_CASEFOLD)[0]} "
+def setup_for_macosx_framework(tclver, tkver)
+ # use framework, but no tclConfig.sh
+ unless $LDFLAGS.include?('-framework')
+ $LDFLAGS << ' -framework Tk -framework Tcl'
end
- $LDFLAGS << ' -framework Tk -framework Tcl'
-
if TkLib_Config["tcl-framework-header"]
- TclConfig_Info['TCL_INCLUDE_SPEC'] =
- "-I#{TkLib_Config["tcl-framework-header"]} "
+ TclConfig_Info['TCL_INCLUDE_SPEC'] <<
+ "-I#{TkLib_Config["tcl-framework-header"].quote} "
+ else
+ TclConfig_Info['TCL_INCLUDE_SPEC'] = ""
+
+ 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'] =
- "-I#{TkLib_Config["tk-framework-header"]} "
+ "-I#{TkLib_Config["tk-framework-header"].quote} "
+ else
+ TkConfig_Info['TK_INCLUDE_SPEC'] = ""
+
+ 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
@@ -1320,7 +1449,17 @@ puts("Specified Tcl/Tk version is #{[tclver, tkver].inspect}") if tclver&&tkver
#if activeTcl = with_config("ActiveTcl")
if activeTcl = with_config("ActiveTcl", true)
puts("Use ActiveTcl libraries (if available).")
- activeTcl = '/opt/ActiveTcl*/lib' unless activeTcl.kind_of? String
+ 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
@@ -1379,7 +1518,6 @@ tcl_cfg_dir = File.dirname(TclConfig_Info['config_file_path']) rescue nil
tk_ldir_list = [tk_ldir, tk_cfg_dir]
tcl_ldir_list = [tcl_ldir, tcl_cfg_dir]
-
# check tk_shlib_search_path
check_shlib_search_path(with_config('tk-shlib-search-path'))
@@ -1391,7 +1529,25 @@ $CPPFLAGS += collect_tcltk_defs(TclConfig_Info['TCL_DEFS'], TkConfig_Info['TK_DE
# MacOS X Frameworks?
if TkLib_Config["tcltk-framework"]
puts("Use MacOS X Frameworks.")
- setup_for_macosx_framework
+ if tcl_cfg_dir
+ $INCFLAGS << ' ' << TclConfig_Info['TCL_INCLUDE_SPEC']
+ $LDFLAGS << ' ' << TclConfig_Info['TCL_LIBS']
+ if stubs
+ $LDFLAGS << ' ' << TclConfig_Info['TCL_STUB_LIB_SPEC']
+ else
+ $LDFLAGS << ' ' << TclConfig_Info['TCL_LIB_SPEC']
+ end
+ end
+ if tk_cfg_dir
+ $INCFLAGS << ' ' << TkConfig_Info['TK_INCLUDE_SPEC']
+ $LDFLAGS << ' ' << TkConfig_Info['TK_LIBS']
+ if stubs
+ $LDFLAGS << ' ' << TkConfig_Info['TK_STUB_LIB_SPEC']
+ else
+ $LDFLAGS << ' ' << TkConfig_Info['TK_LIB_SPEC']
+ end
+ end
+ setup_for_macosx_framework(tclver, tkver) if tcl_cfg_dir && tk_cfg_dir
end
# name of Tcl/Tk libraries
diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index 594442c3b6..927cf18063 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -1179,40 +1179,43 @@ module TkCore
unless self.const_defined? :RUN_EVENTLOOP_ON_MAIN_THREAD
if WITH_RUBY_VM ### check Ruby 1.9 !!!!!!!
# *** NEED TO FIX ***
- ip = TclTkIp.new(name, opts)
- if RUBY_PLATFORM =~ /cygwin/
+ case RUBY_PLATFORM
+ when /cygwin/
RUN_EVENTLOOP_ON_MAIN_THREAD = true
- INTERP = ip
- elsif ip._invoke_without_enc('tk', 'windowingsystem') == '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
- # ----------------------------------------------------------
- #
- RUN_EVENTLOOP_ON_MAIN_THREAD = true
- INTERP = ip
- else
- unless self.const_defined? :RUN_EVENTLOOP_ON_MAIN_THREAD
- RUN_EVENTLOOP_ON_MAIN_THREAD = false
- end
- if RUN_EVENTLOOP_ON_MAIN_THREAD
- INTERP = ip
+ 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
+ # ----------------------------------------------------------
+ #
+ 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
- ip = nil
else # Ruby 1.8.x
RUN_EVENTLOOP_ON_MAIN_THREAD = false
@@ -1243,6 +1246,30 @@ module TkCore
Thread.current[:status] = status
#sleep
+ # like as 1.8, withdraw a root widget before calling Tk.mainloop
+ interp._eval <<EOS
+rename wm __wm_orig__
+proc wm {subcmd win args} {
+ eval [list __wm_orig__ $subcmd $win] $args
+ if {[string equal $subcmd withdraw] && [string equal $win .]} {
+ rename wm {}
+ rename __wm_orig__ wm
+ }
+}
+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__
+EOS
+
begin
begin
#TclTkLib.mainloop_abort_on_exception = false
@@ -1808,6 +1835,9 @@ module TkCore
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('unset __initail_state_of_rubytk__')
+
begin
TclTkLib.set_eventloop_window_mode(true)
if check_root
@@ -5663,7 +5693,7 @@ TkWidget = TkWindow
#Tk.freeze
module Tk
- RELEASE_DATE = '2010-02-01'.freeze
+ RELEASE_DATE = '2010-05-31'.freeze
autoload :AUTO_PATH, 'tk/variable'
autoload :TCL_PACKAGE_PATH, 'tk/variable'
diff --git a/ext/tk/stubs.c b/ext/tk/stubs.c
index 712c5ced9f..d76e0c8632 100644
--- a/ext/tk/stubs.c
+++ b/ext/tk/stubs.c
@@ -92,6 +92,10 @@ _nativethread_consistency_check(ip)
# define TK_INDEX 7
# define TCL_NAME "libtcl8.9%s"
# define TK_NAME "libtk8.9%s"
+# if defined(__APPLE__) && defined(__MACH__) /* Mac OS X */
+# undef DLEXT
+# define DLEXT ".dylib"
+# endif
#endif
static DL_HANDLE tcl_dll = (DL_HANDLE)0;
@@ -321,6 +325,22 @@ ruby_tk_stubs_init(tcl_ip)
if (!p_Tk_Init)
return NO_Tk_Init;
+#if defined USE_TK_STUBS && defined TK_FRAMEWORK && defined(__APPLE__) && defined(__MACH__)
+ /*
+ FIX ME : dirty hack for Mac OS X frameworks.
+ With stubs, fails to find Resource/Script directory of Tk.framework.
+ So, teach it to a Tcl interpreter by an environment variable.
+ e.g. when $tcl_library ==
+ /Library/Frameworks/Tcl.framwwork/8.5/Resources/Scripts
+ ==> /Library/Frameworks/Tk.framwwork/8.5/Resources/Scripts
+ */
+ if (Tcl_Eval(tcl_ip,
+ "if {[array get env TK_LIBRARY] == {}} { set env(TK_LIBRARY) [regsub -all -nocase {(t)cl} $tcl_library {\\1k}] }"
+ ) != TCL_OK) {
+ return FAIL_Tk_Init;
+ }
+#endif
+
if ((*p_Tk_Init)(tcl_ip) == TCL_ERROR)
return FAIL_Tk_Init;
diff --git a/ext/tk/tcltklib.c b/ext/tk/tcltklib.c
index 6165ec8620..193114eb6a 100644
--- a/ext/tk/tcltklib.c
+++ b/ext/tk/tcltklib.c
@@ -4,7 +4,8 @@
* Oct. 24, 1997 Y. Matsumoto
*/
-#define TCLTKLIB_RELEASE_DATE "2010-03-26"
+#define TCLTKLIB_RELEASE_DATE "2010-05-31"
+/* #define CREATE_RUBYTK_KIT */
#include "ruby.h"
@@ -56,6 +57,20 @@ extern VALUE rb_proc_new _((VALUE (*)(ANYARGS/* VALUE yieldarg[, VALUE procarg]
#define va_init_list(a,b) va_start(a)
#endif
#include <string.h>
+
+#if !defined HAVE_VSNPRINTF && !defined vsnprintf
+# ifdef WIN32
+ /* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */
+# define vsnprintf _vsnprintf
+# else
+# ifdef HAVE_RUBY_RUBY_H
+# include "ruby/missing.h"
+# else
+# include "missing.h"
+# endif
+# endif
+#endif
+
#include <tcl.h>
#include <tk.h>
@@ -68,9 +83,14 @@ extern VALUE rb_proc_new _((VALUE (*)(ANYARGS/* VALUE yieldarg[, VALUE procarg]
#ifndef HAVE_RB_ERRINFO
#define rb_errinfo() (ruby_errinfo+0) /* cannot be l-value */
+#else
+VALUE rb_errinfo(void);
#endif
#ifndef HAVE_RB_SAFE_LEVEL
-#define rb_safe_level() (ruby_safe_level+0) /* cannot be l-value */
+#define rb_safe_level() (ruby_safe_level+0)
+#endif
+#ifndef HAVE_RB_SOURCEFILE
+#define rb_sourcefile() (ruby_sourcefile+0)
#endif
#include "stubs.h"
@@ -529,7 +549,6 @@ struct cmd_body_arg {
VALUE args;
};
-
/*----------------------------*/
/* use Tcl internal functions */
/*----------------------------*/
@@ -837,6 +856,195 @@ create_ip_exc(interp, exc, fmt, va_alist)
return einfo;
}
+/*-------------------------------------------------------*/
+#if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
+
+/* Tcl/Tk stubs may work, but probably it is meaningless. */
+#if defined USE_TCL_STUBS || defined USE_TK_STUBS
+# error Not support Tcl/Tk stubs with Ruby/Tk-Kit or Rubykit.
+#endif
+
+#ifndef KIT_INCLUDES_TK
+# define KIT_INCLUDES_TK 1
+#endif
+/* #define KIT_INCLUDES_ITCL 1 */
+/* #define KIT_INCLUDES_THREAD 1 */
+
+#ifdef KIT_INCLUDES_ITCL
+Tcl_AppInitProc Itcl_Init;
+#endif
+Tcl_AppInitProc Mk4tcl_Init, Vfs_Init, Rechan_Init, Zlib_Init;
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
+Tcl_AppInitProc Pwb_Init;
+#endif
+#if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
+Tcl_AppInitProc Thread_Init;
+#endif
+#ifdef _WIN32
+Tcl_AppInitProc Dde_Init, Registry_Init;
+#endif
+
+static const char *tcltklib_filepath = "[info nameofexecutable]";
+static char *rubytkkit_preInitCmd = (char *)NULL;
+static const char *rubytkkit_preInitCmd_head = "set ::rubytkkit_exe [list ";
+static const char *rubytkkit_preInitCmd_tail =
+"]\n"
+/*=== following init scripts are quoted from kitInit.c of Tclkit ===*/
+/* Tclkit license terms ---
+ LICENSE
+
+ The Tclkit-specific sources are license free, they just have a copyright.
+ Hold the author(s) harmless and any lawful use is permitted.
+
+ This does *not* apply to any of the sources of the other major Open Source
+ Software used in Tclkit, which each have very liberal BSD/MIT-like licenses:
+ Tcl/Tk, Incrtcl, Metakit, TclVFS, Zlib
+*/
+#ifdef _WIN32_WCE
+/* silly hack to get wince port to launch, some sort of std{in,out,err} problem
+*/
+"open /kitout.txt a; open /kitout.txt a; open /kitout.txt a\n"
+/* this too seems to be needed on wince - it appears to be related to the above
+*/
+"catch {rename source ::tcl::source}\n"
+"proc source file {\n"
+ "set old [info script]\n"
+ "info script $file\n"
+ "set fid [open $file]\n"
+ "set data [read $fid]\n"
+ "close $fid\n"
+ "set code [catch {uplevel 1 $data} res]\n"
+ "info script $old\n"
+ "if {$code == 2} { set code 0 }\n"
+ "return -code $code $res\n"
+"}\n"
+#endif
+"proc tclKitInit {} {\n"
+ "rename tclKitInit {}\n"
+ "load {} Mk4tcl\n"
+#if defined KIT_VFS_WRITABLE && !defined CREATE_RUBYKIT
+ /* running command cannot open itself for writing */
+ "mk::file open exe $::rubytkkit_exe\n"
+#else
+ "mk::file open exe $::rubytkkit_exe -readonly\n"
+#endif
+ "set n [mk::select exe.dirs!0.files name boot.tcl]\n"
+ "if {$n != \"\"} {\n"
+ "set s [mk::get exe.dirs!0.files!$n contents]\n"
+ "if {![string length $s]} { error \"empty boot.tcl\" }\n"
+ "catch {load {} zlib}\n"
+ "if {[mk::get exe.dirs!0.files!$n size] != [string length $s]} {\n"
+ "set s [zlib decompress $s]\n"
+ "}\n"
+ "} else {\n"
+ "set f [open setup.tcl]\n"
+ "set s [read $f]\n"
+ "close $f\n"
+ "}\n"
+ "uplevel #0 $s\n"
+#ifdef _WIN32
+ "package ifneeded dde 1.3.1 {load {} dde}\n"
+ "package ifneeded registry 1.1.5 {load {} registry}\n"
+#endif
+"}\n"
+"tclKitInit"
+;
+
+#if 0
+/* Not use this script.
+ It's a memo to support an initScript for Tcl interpreters in the future. */
+static const char initScript[] =
+"if {[file isfile [file join $::rubytkkit_exe main.tcl]]} {\n"
+ "if {[info commands console] != {}} { console hide }\n"
+ "set tcl_interactive 0\n"
+ "incr argc\n"
+ "set argv [linsert $argv 0 $argv0]\n"
+ "set argv0 [file join $::rubytkkit_exe main.tcl]\n"
+"} else continue\n"
+;
+#endif
+
+#if !defined(TclSetPreInitScript) && !defined(TclSetPreInitScript_TCL_DECLARED)
+EXTERN char* TclSetPreInitScript _((char *));
+#endif
+static char*
+setup_preInitCmd(const char *path)
+{
+ int head_len, path_len, tail_len;
+ char *ptr;
+
+ head_len = strlen(rubytkkit_preInitCmd_head);
+ path_len = strlen(path);
+ tail_len = strlen(rubytkkit_preInitCmd_tail);
+
+ rubytkkit_preInitCmd = ALLOC_N(char, head_len + path_len + tail_len + 1);
+
+ ptr = rubytkkit_preInitCmd;
+ memcpy(ptr, rubytkkit_preInitCmd_head, head_len);
+
+ ptr += head_len;
+ memcpy(ptr, path, path_len);
+
+ ptr += path_len;
+ memcpy(ptr, rubytkkit_preInitCmd_tail, tail_len);
+
+ ptr += tail_len;
+ *ptr = '\0';
+
+ return TclSetPreInitScript(rubytkkit_preInitCmd);
+}
+
+static void
+init_static_tcltk_packages()
+{
+#ifdef KIT_INCLUDES_ITCL
+ Tcl_StaticPackage(0, "Itcl", Itcl_Init, NULL);
+#endif
+ Tcl_StaticPackage(0, "Mk4tcl", Mk4tcl_Init, NULL);
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
+ Tcl_StaticPackage(0, "pwb", Pwb_Init, NULL);
+#endif
+ Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL);
+ Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL);
+ Tcl_StaticPackage(0, "zlib", Zlib_Init, NULL);
+#if defined TCL_THREADS && defined KIT_INCLUDES_THREAD
+ Tcl_StaticPackage(0, "Thread", Thread_Init, NULL);
+#endif
+#ifdef _WIN32
+ Tcl_StaticPackage(0, "dde", Dde_Init, NULL);
+ Tcl_StaticPackage(0, "registry", Registry_Init, NULL);
+#endif
+#ifdef KIT_INCLUDES_TK
+ Tcl_StaticPackage(0, "Tk", Tk_Init, Tk_SafeInit);
+#endif
+}
+
+/* SetExecName -- Hack to get around Tcl bug 1224888. */
+void SetExecName(Tcl_Interp *interp) {
+ /* dummy */
+}
+#endif /* defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT */
+
+static int
+call_tclkit_init_script(Tcl_Interp *interp)
+{
+#if 0
+ /* Currently, nothing do in this function.
+ It's a memo (quoted from kitInit.c of Tclkit)
+ to support an initScript for Tcl interpreters in the future. */
+ if (Tcl_Eval(interp, initScript) == TCL_OK) {
+ Tcl_Obj* path = TclGetStartupScriptPath();
+ TclSetStartupScriptPath(Tcl_GetObjResult(interp));
+ if (path == NULL)
+ Tcl_Eval(interp, "incr argc -1; set argv [lrange $argv 1 end]");
+ }
+#endif
+
+ return 1;
+}
+
+
+/**********************************************************************/
/* stub status */
static void
@@ -5668,6 +5876,30 @@ ip_CallWhenDeleted(clientData, ip)
rb_thread_critical = thr_crit_bup;
}
+/*--------------------------------------------------------*/
+
+#ifdef __WIN32__
+/* #include <tkWinInt.h> *//* conflict definition of struct timezone */
+/* #include <tkIntPlatDecls.h> */
+/* #include <windows.h> */
+EXTERN void TkWinSetHINSTANCE(HINSTANCE hInstance);
+void rbtk_win32_SetHINSTANCE(const char *module_name)
+{
+ /* TCHAR szBuf[256]; */
+ HINSTANCE hInst;
+
+ /* hInst = GetModuleHandle(NULL); */
+ /* hInst = GetModuleHandle("tcltklib.so"); */
+ hInst = GetModuleHandle(module_name);
+ TkWinSetHINSTANCE(hInst);
+
+ /* GetModuleFileName(hInst, szBuf, sizeof(szBuf) / sizeof(TCHAR)); */
+ /* MessageBox(NULL, szBuf, TEXT("OK"), MB_OK); */
+}
+#endif
+
+/*--------------------------------------------------------*/
+
/* initialize interpreter */
static VALUE
ip_init(argc, argv, self)
@@ -5739,6 +5971,8 @@ ip_init(argc, argv, self)
DUMP2("IP ref_count = %d", ptr->ref_count);
current_interp = ptr->ip;
+ call_tclkit_init_script(current_interp);
+
ptr->has_orig_exit
= Tcl_GetCommandInfo(ptr->ip, "exit", &(ptr->orig_exit_info));
@@ -10315,17 +10549,17 @@ Init_tcltklib()
/* --------------------------------------------------------------- */
#ifdef __WIN32__
-#define TK_WINDOWING_SYSTEM "win32"
-#else
-#ifdef MAC_TCL
-#define TK_WINDOWING_SYSTEM "classic"
-#else
-#ifdef MAC_OSX_TK
-#define TK_WINDOWING_SYSTEM "aqua"
-#else
-#define TK_WINDOWING_SYSTEM "x11"
-#endif
-#endif
+# define TK_WINDOWING_SYSTEM "win32"
+#else
+# ifdef MAC_TCL
+# define TK_WINDOWING_SYSTEM "classic"
+# else
+# ifdef MAC_OSX_TK
+# define TK_WINDOWING_SYSTEM "aqua"
+# else
+# define TK_WINDOWING_SYSTEM "x11"
+# endif
+# endif
#endif
rb_define_const(lib, "WINDOWING_SYSTEM",
rb_obj_freeze(rb_str_new2(TK_WINDOWING_SYSTEM)));
@@ -10581,6 +10815,19 @@ Init_tcltklib()
/* --------------------------------------------------------------- */
+#if defined CREATE_RUBYTK_KIT
+#ifdef __WIN32__
+ rbtk_win32_SetHINSTANCE("tcltklib.so");
+#endif
+ tcltklib_filepath = strdup(rb_sourcefile());
+#endif
+#if defined CREATE_RUBYTK_KIT || defined CREATE_RUBYKIT
+ init_static_tcltk_packages();
+ setup_preInitCmd(tcltklib_filepath);
+#endif
+
+ /* --------------------------------------------------------------- */
+
/* Tcl stub check */
tcl_stubs_check();