If $DEBUG == true and some exception is caused in a callback

operation, Ruby/Tk shows a (verbose) backtrace information on
the callback process.


git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@4787 b2dd03c8-39d4-4d8f-98ff-823fe69b080e

2 files changed, 23 insertions, 1 deletions

diff --git a/ChangeLog b/ChangeLog
index 59bfaddc1d..5e79eb0dd6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+Thu Oct 16 23:51:04 2003  Hidetoshi NAGAI  <nagai@ai.kyutech.ac.jp>
+
+	* ext/tk/lib/tk.rb: If $DEBUG == true and some exception is caused
+	  in a callback operation, Ruby/Tk shows a (verbose) backtrace
+	  information on the callback process. 
+
 Thu Oct 16 16:54:57 2003  Yukihiro Matsumoto  <matz@ruby-lang.org>
 
 	* string.c (rb_str_upto): ("a"..."a").to_a should return [].
diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index e904278b25..0394611172 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -772,7 +772,23 @@ module TkCore
     #_get_eval_string(TkUtil.eval_cmd(TkCore::INTERP.tk_cmd_tbl[arg.shift], 
     #  			     *arg))
     cb_obj = TkCore::INTERP.tk_cmd_tbl[arg.shift]
-    cb_obj.call(*arg)
+    unless $DEBUG
+      cb_obj.call(*arg)
+    else
+      begin
+	raise 'check backtrace'
+      rescue
+	# ignore backtrace before 'callback'
+	pos = -($!.backtrace.size)
+      end
+      begin
+	cb_obj.call(*arg)
+      rescue
+	trace = $!.backtrace
+	raise $!, "\n#{trace[0]}: #{$!.message} (#{$!.class})\n" + 
+	          "\tfrom #{trace[1..pos].join("\n\tfrom ")}"
+      end
+    end
   end
 
   def load_cmd_on_ip(tk_cmd)