summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authornagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2006-07-03 10:08:11 +0000
committernagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2006-07-03 10:08:11 +0000
commitc47bf50af77734b6e43a02486d2bf779bc80e19e (patch)
treed6741514bddfd6563283c754b7712d4f96126ab6 /ext
parentc6956e0d72a68642807de2af7d9ddebd1cf01a6a (diff)
* ext/tk/tcltklib.c (ip_make_menu_embeddable): help to make a menu
widget embeddable (pack, grid, and so on) like as a general widget. However, an embeddable menu may require to be definied some event bindings for general use. * ext/tk/lib/tk/event.rb: [bug fix] Tk.callback_break and Tk.callback_continue don't work on MultiTkIp. * ext/tk/lib/multi-tk.rb: ditto. * ext/tk/lib/tk.rb: lack of Tk.callback_return. * ext/tk/lib/tk/menu.rb: improve creating clone menus. git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/branches/ruby_1_8@10461 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'ext')
-rw-r--r--ext/tk/lib/multi-tk.rb76
-rw-r--r--ext/tk/lib/tk.rb6
-rw-r--r--ext/tk/lib/tk/event.rb51
-rw-r--r--ext/tk/lib/tk/menu.rb70
-rw-r--r--ext/tk/tcltklib.c109
5 files changed, 301 insertions, 11 deletions
diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb
index 408dd0fc30..42f92c3b55 100644
--- a/ext/tk/lib/multi-tk.rb
+++ b/ext/tk/lib/multi-tk.rb
@@ -158,7 +158,9 @@ class MultiTkIp
backup_ip = current['callback_ip']
current['callback_ip'] = @ip
begin
- @ip.cb_eval(@cmd, *args)
+ ret = @ip.cb_eval(@cmd, *args)
+ fail ret if ret.kind_of?(Exception)
+ ret
rescue TkCallbackBreak, TkCallbackContinue => e
fail e
rescue SecurityError => e
@@ -175,6 +177,8 @@ class MultiTkIp
fail e
end
rescue Exception => e
+ fail e if e.message =~ /^TkCallback/
+
if @ip.safe?
if @ip.respond_to?(:cb_error)
@ip.cb_error(e)
@@ -662,6 +666,8 @@ class MultiTkIp
@interp = TclTkIp.new(name, _keys2opts(keys))
@ip_name = nil
+ @callback_status = [].taint
+
@system = Object.new
@wait_on_mainloop = [true, 0].taint
@@ -1057,6 +1063,8 @@ class MultiTkIp
@cb_error_proc.taint unless @cb_error_proc.tainted?
@evloop_thread.taint unless @evloop_thread.tainted?
+ @callback_status = []
+
name, safe, safe_opts, tk_opts = _parse_slaveopts(keys)
safe = 4 if safe && !safe.kind_of?(Fixnum)
@@ -1487,6 +1495,7 @@ class MultiTkIp
@@CB_ENTRY_CLASS.new(__getip, cmd).freeze
end
+=begin
def cb_eval(cmd, *args)
#self.eval_callback{ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args)) }
#ret = self.eval_callback{ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args)) }
@@ -1499,8 +1508,62 @@ class MultiTkIp
end
ret
end
-end
+=end
+ def cb_eval(cmd, *args)
+ self.eval_callback(*args){|safe, *params|
+ $SAFE=safe if $SAFE < safe
+ # TkUtil.eval_cmd(cmd, *params)
+ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *params))
+ }
+ end
+=begin
+ def cb_eval(cmd, *args)
+ @callback_status[0] ||= TkVariable.new
+ @callback_status[1] ||= TkVariable.new
+ st, val = @callback_status
+ th = Thread.new{
+ self.eval_callback(*args){|safe, *params|
+ #p [status, val, safe, *params]
+ $SAFE=safe if $SAFE < safe
+ begin
+ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *params))
+ rescue TkCallbackContinue
+ st.value = 4
+ rescue TkCallbackBreak
+ st.value = 3
+ rescue TkCallbackReturn
+ st.value = 2
+ rescue Exception => e
+ val.value = e.message
+ st.value = 1
+ else
+ st.value = 0
+ end
+ }
+ }
+ begin
+ st.wait
+ status = st.numeric
+ retval = val.value
+ rescue => e
+ fail e
+ end
+
+ if status == 1
+ fail RuntimeError, retval
+ elsif status == 2
+ fail TkCallbackReturn, "Tk callback returns 'return' status"
+ elsif status == 3
+ fail TkCallbackBreak, "Tk callback returns 'break' status"
+ elsif status == 4
+ fail TkCallbackContinue, "Tk callback returns 'continue' status"
+ else
+ ''
+ end
+ end
+=end
+end
# evaluate a procedure on the proper interpreter
class MultiTkIp
@@ -1969,6 +2032,10 @@ class << MultiTkIp
__getip._unset_global_var2(var, idx)
end
+ def _make_menu_embeddable(menu_path)
+ __getip._make_menu_embeddable(menu_path)
+ end
+
def _split_tklist(str)
__getip._split_tklist(str)
end
@@ -2410,6 +2477,11 @@ class MultiTkIp
@interp._unset_global_var2(var, idx)
end
+ def _make_menu_embeddable(menu_path)
+ raise SecurityError, "no permission to manipulate" unless self.manipulable?
+ @interp._make_menu_embeddable(menu_path)
+ end
+
def _split_tklist(str)
raise SecurityError, "no permission to manipulate" unless self.manipulable?
@interp._split_tklist(str)
diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index c80dc45ea5..4504d1d2ec 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -1295,6 +1295,10 @@ module TkCore
fail TkCallbackContinue, "Tk callback returns 'continue' status"
end
+ def callback_return
+ fail TkCallbackReturn, "Tk callback returns 'return' status"
+ end
+
def TkCore.callback(*arg)
begin
if TkCore::INTERP.tk_cmd_tbl.kind_of?(Hash)
@@ -4559,7 +4563,7 @@ end
#Tk.freeze
module Tk
- RELEASE_DATE = '2006-06-27'.freeze
+ RELEASE_DATE = '2006-07-03'.freeze
autoload :AUTO_PATH, 'tk/variable'
autoload :TCL_PACKAGE_PATH, 'tk/variable'
diff --git a/ext/tk/lib/tk/event.rb b/ext/tk/lib/tk/event.rb
index af05dc96de..70a1e38bbe 100644
--- a/ext/tk/lib/tk/event.rb
+++ b/ext/tk/lib/tk/event.rb
@@ -416,10 +416,18 @@ module TkEvent
id = install_cmd(proc{|*arg|
ex_args = []
extra_args_tbl.reverse_each{|conv| ex_args << conv.call(arg.pop)}
- TkUtil.eval_cmd(cmd, *(ex_args.concat(klass.scan_args(keys, arg))))
+ begin
+ TkUtil.eval_cmd(cmd, *(ex_args.concat(klass.scan_args(keys, arg))))
+ rescue Exception=>e
+ if TkCore::INTERP.kind_of?(TclTkIp)
+ fail e
+ else
+ # MultiTkIp
+ fail Exception, "#{e.class}: #{e.message.dup}"
+ end
+ end
})
end
- id + ' ' + args
else
keys, args = klass._get_all_subst_keys
@@ -431,11 +439,46 @@ module TkEvent
id = install_cmd(proc{|*arg|
ex_args = []
extra_args_tbl.reverse_each{|conv| ex_args << conv.call(arg.pop)}
- TkUtil.eval_cmd(cmd,
- *(ex_args << klass.new(*klass.scan_args(keys, arg))))
+ begin
+ TkUtil.eval_cmd(cmd, *(ex_args << klass.new(*klass.scan_args(keys, arg))))
+ rescue Exception=>e
+ if TkCore::INTERP.kind_of?(TclTkIp)
+ fail e
+ else
+ # MultiTkIp
+ fail Exception, "#{e.class}: #{e.message.dup}"
+ end
+ end
})
end
+ end
+
+ if TkCore::INTERP.kind_of?(TclTkIp)
id + ' ' + args
+ else
+ # MultiTkIp
+ "if {[set st [catch {#{id} #{args}} ret]] != 0} {
+ if {$st == 4} {
+ return -code continue $ret
+ } elseif {$st == 3} {
+ return -code break $ret
+ } elseif {$st == 2} {
+ return -code return $ret
+ } elseif {[regexp {^Exception: (TkCallbackContinue: .*)$} \
+ $ret m msg]} {
+ return -code continue $msg
+ } elseif {[regexp {^Exception: (TkCallbackBreak: .*)$} $ret m msg]} {
+ return -code break $msg
+ } elseif {[regexp {^Exception: (TkCallbackReturn: .*)$} $ret m msg]} {
+ return -code return $msg
+ } elseif {[regexp {^Exception: (\\S+: .*)$} $ret m msg]} {
+ return -code return $msg
+ } else {
+ return -code error $ret
+ }
+ } else {
+ set ret
+ }"
end
end
diff --git a/ext/tk/lib/tk/menu.rb b/ext/tk/lib/tk/menu.rb
index be8ec2ddee..ddddc8e53e 100644
--- a/ext/tk/lib/tk/menu.rb
+++ b/ext/tk/lib/tk/menu.rb
@@ -43,6 +43,7 @@ module TkMenuEntryConfig
end
class TkMenu<TkWindow
+ include Wm
include TkMenuEntryConfig
extend TkMenuSpec
@@ -115,6 +116,36 @@ class TkMenu<TkWindow
def add_separator(keys=nil)
add('separator', keys)
end
+
+ def clone_menu(*args)
+ if args[0].kind_of?(TkWindow)
+ parent = args.shift
+ else
+ parent = self
+ end
+
+ if args[0].kind_of?(String) || args[0].kind_of?(Symbol) # menu type
+ type = args.shift
+ else
+ type = None # 'normal'
+ end
+
+ if args[0].kind_of?(Hash)
+ keys = _symbolkey2str(args.shift)
+ else
+ keys = {}
+ end
+
+ parent = keys.delete('parent') if keys.has_key?('parent')
+ type = keys.delete('type') if keys.has_key?('type')
+
+ if keys.empty?
+ TkMenuClone.new(self, parent, type)
+ else
+ TkMenuClone.new(self, parent, type, keys)
+ end
+ end
+
def index(idx)
ret = tk_send_without_enc('index', _get_eval_enc_str(idx))
(ret == 'none')? nil: number(ret)
@@ -352,6 +383,7 @@ end
class TkMenuClone<TkMenu
+=begin
def initialize(parent, type=None)
widgetname = nil
if parent.kind_of? Hash
@@ -367,8 +399,44 @@ class TkMenuClone<TkMenu
install_win(@parent.path, widgetname)
tk_call_without_enc(@parent.path, 'clone', @path, type)
end
-end
+=end
+ def initialize(src_menu, *args)
+ widgetname = nil
+
+ if args[0].kind_of?(TkWindow) # parent window
+ parent = args.shift
+ else
+ parent = src_menu
+ end
+
+ if args[0].kind_of?(String) || args[0].kind_of?(Symbol) # menu type
+ type = args.shift
+ else
+ type = None # 'normal'
+ end
+
+ if args[0].kind_of?(Hash)
+ keys = _symbolkey2str(args.shift)
+ parent = keys.delete('parent') if keys.has_key?('parent')
+ widgetname = keys.delete('widgetname')
+ type = keys.delete('type') if keys.has_key?('type')
+ else
+ keys = nil
+ end
+ @src_menu = src_menu
+ @parent = parent
+ @type = type
+ install_win(@parent.path, widgetname)
+ tk_call_without_enc(@src_menu.path, 'clone', @path, @type)
+ configure(keys) if keys && !keys.empty?
+ end
+
+ def source_menu
+ @src_menu
+ end
+end
+TkCloneMenu = TkMenuClone
module TkSystemMenu
def initialize(parent, keys=nil)
diff --git a/ext/tk/tcltklib.c b/ext/tk/tcltklib.c
index 183486a3a6..5c986f1dcf 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-06-26"
+#define TCLTKLIB_RELEASE_DATE "2006-07-03"
#include "ruby.h"
#include "rubysig.h"
@@ -129,7 +129,10 @@ tcl_eval(interp, cmd)
const char *cmd; /* don't have to be writable */
{
char *buf = strdup(cmd);
- const int ret = Tcl_Eval(interp, buf);
+ int ret;
+
+ Tcl_AllowExceptions(interp);
+ ret = Tcl_Eval(interp, buf);
free(buf);
return ret;
}
@@ -143,7 +146,10 @@ tcl_global_eval(interp, cmd)
const char *cmd; /* don't have to be writable */
{
char *buf = strdup(cmd);
- const int ret = Tcl_GlobalEval(interp, buf);
+ int ret;
+
+ Tcl_AllowExceptions(interp);
+ ret = Tcl_GlobalEval(interp, buf);
free(buf);
return ret;
}
@@ -5591,6 +5597,7 @@ call_tcl_eval(arg)
{
struct call_eval_info *inf = (struct call_eval_info *)arg;
+ Tcl_AllowExceptions(inf->ptr->ip);
inf->ptr->return_value = Tcl_EvalObj(inf->ptr->ip, inf->cmd);
return Qnil;
@@ -7721,6 +7728,98 @@ tcltklib_compile_info()
return ret;
}
+/*###############################################*/
+
+/*
+ * The following is based on tkMenu.[ch]
+ * of Tcl/Tk (>=8.0) source code.
+ */
+#if TCL_MAJOR_VERSION >= 8
+
+#define MASTER_MENU 0
+#define TEAROFF_MENU 1
+#define MENUBAR 2
+
+struct dummy_TkMenuEntry {
+ int type;
+ struct dummy_TkMenu *menuPtr;
+ /* , and etc. */
+};
+
+struct dummy_TkMenu {
+ Tk_Window tkwin;
+ Display *display;
+ Tcl_Interp *interp;
+ Tcl_Command widgetCmd;
+ struct dummy_TkMenuEntry **entries;
+ int numEntries;
+ int active;
+ int menuType; /* MASTER_MENU, TEAROFF_MENU, or MENUBAR */
+ Tcl_Obj *menuTypePtr;
+ /* , and etc. */
+};
+
+struct dummy_TkMenuRef {
+ struct dummy_TkMenu *menuPtr;
+ char *dummy1;
+ char *dummy2;
+ char *dummy3;
+};
+
+EXTERN struct dummy_TkMenuRef *TkFindMenuReferences(Tcl_Interp*, char*);
+
+#endif
+
+static VALUE
+ip_make_menu_embeddable(interp, menu_path)
+ VALUE interp;
+ VALUE menu_path;
+{
+#if TCL_MAJOR_VERSION >= 8
+ struct tcltkip *ptr = get_ip(interp);
+ struct dummy_TkMenuRef *menuRefPtr;
+
+ StringValue(menu_path);
+
+ menuRefPtr = TkFindMenuReferences(ptr->ip, RSTRING(menu_path)->ptr);
+ if (menuRefPtr == (struct dummy_TkMenuRef *) NULL) {
+ rb_raise(rb_eArgError, "not a menu widget, or invalid widget path");
+ }
+
+ if (menuRefPtr->menuPtr == (struct dummy_TkMenu *) NULL) {
+ rb_raise(rb_eRuntimeError,
+ "invalid menu widget (maybe already destroyed)");
+ }
+
+ if ((menuRefPtr->menuPtr)->menuType != MENUBAR) {
+ rb_raise(rb_eRuntimeError,
+ "target menu widget must be a MENUBAR type");
+ }
+
+ (menuRefPtr->menuPtr)->menuType = TEAROFF_MENU;
+#if 0 /* cause SEGV */
+ {
+ /* char *s = "tearoff"; */
+ char *s = "normal";
+ /* Tcl_SetStringObj((menuRefPtr->menuPtr)->menuTypePtr, s, strlen(s));*/
+ (menuRefPtr->menuPtr)->menuTypePtr = Tcl_NewStringObj(s, strlen(s));
+ /* (menuRefPtr->menuPtr)->menuType = TEAROFF_MENU; */
+ (menuRefPtr->menuPtr)->menuType = MASTER_MENU;
+ }
+#endif
+
+ TkEventuallyRecomputeMenu(menuRefPtr->menuPtr);
+ TkEventuallyRedrawMenu(menuRefPtr->menuPtr,
+ (struct dummy_TkMenuEntry *)NULL);
+
+#else /* TCL_MAJOR_VERSION <= 7 */
+ rb_notimplement();
+#endif
+
+ return interp;
+}
+
+/*###############################################*/
/*---- initialization ----*/
void
@@ -7918,6 +8017,10 @@ Init_tcltklib()
/* --------------------------------------------------------------- */
+ rb_define_method(ip, "_make_menu_embeddable", ip_make_menu_embeddable, 1);
+
+ /* --------------------------------------------------------------- */
+
rb_define_method(ip, "_split_tklist", ip_split_tklist, 1);
rb_define_method(ip, "_merge_tklist", lib_merge_tklist, -1);
rb_define_method(ip, "_conv_listelement", lib_conv_listelement, 1);