* 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

1 files changed, 47 insertions, 4 deletions

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