[librep] Backtrace and debugger option fix. Previously, if 'backtrace-on-error' is t, then it is printed even

[Christopher Bratusek <chrisb src gnome org>]

commit ec4a1b9dfa77db5b702447791d27504908c70c62
Author: Teika kazura <teika lavabit com>
Date:   Sat Jun 26 14:32:24 2010 +0900

    Backtrace and debugger option fix.
    Previously, if 'backtrace-on-error' is t, then it is printed even if
    it's inside of a 'condition-case'. Now, it doesn't. Similar for
    'debug-on-error'.
    
    However, this edit is not perfect, but does not bring in any new
    inconvenience. Read the news and the manual for the details.

 lisp/rep/lang/interpreter.jl |   17 +++++++------
 lisp/rep/vm/compiler/rep.jl  |    6 +++-
 man/lang.texi                |   21 +++++++++++++---
 man/news.texi                |   20 ++++++++++++++-
 src/lisp.c                   |   54 ++++++++++++++++++++++++++++++-----------
 5 files changed, 88 insertions(+), 30 deletions(-)
---
diff --git a/lisp/rep/lang/interpreter.jl b/lisp/rep/lang/interpreter.jl
index 033877a..bc6fc8a 100644
--- a/lisp/rep/lang/interpreter.jl
+++ b/lisp/rep/lang/interpreter.jl
@@ -431,13 +431,13 @@ of the possible declaration types.")
 	 (raise-exception data)
        (let ((type (nth 1 data)))
 	 (let loop ((rest handlers))
-	   (if (null rest)
-	       (raise-exception data)
-	     (let ((h-type (caar rest)))
-	       (if (or (and (listp h-type) (memq type h-type))
-		       (eq h-type 'error) (eq h-type type))
-		   ((cdar rest) (cdr data))
-		 (loop (cdr rest)))))))))))
+	      (if (null rest)
+		  (raise-exception data)
+		(let ((h-type (caar rest)))
+		  (if (or (and (listp h-type) (memq type h-type))
+			  (eq h-type 'error) (eq h-type type))
+		      ((cdar rest) (cdr data))
+		    (loop (cdr rest)))))))))))
 
 (defmacro catch (tag . body)
   "Evaluate BODY in an implicit progn; non-local exits are allowed with
@@ -474,7 +474,8 @@ If VAR is true it's a symbol whose values is bound to `(ERROR-SYMBOL .
 DATA)' while the handler is evaluated (these are the arguments given to
 `signal' when the error was raised)."
   (list* 'call-with-error-handlers
-	 (list 'lambda '() form)
+	 (list 'lambda '()
+	       (list 'let '((%in-condition-case t)) form))
 	 (mapcar (lambda (h)
 		   (list 'cons (list 'quote (car h))
 			 (list* 'lambda (and (symbolp var)
diff --git a/lisp/rep/vm/compiler/rep.jl b/lisp/rep/vm/compiler/rep.jl
index b04e2f1..4d7a49a 100644
--- a/lisp/rep/vm/compiler/rep.jl
+++ b/lisp/rep/vm/compiler/rep.jl
@@ -747,7 +747,7 @@
 	 (start-label (make-label))
 	 (end-label (make-label))
 	 (handlers (nthcdr 3 form)))
-    (let-fluids ((lexically-pure nil))
+      (let-fluids ((lexically-pure nil))
 
       ;;		jmp start
       ;; cleanup:
@@ -828,7 +828,9 @@
       (emit-insn '(binderr))
       (increment-b-stack)
       (decrement-stack)
-      (compile-form-1 (nth 2 form))
+
+      (compile-form-1
+       (list 'let '((%in-condition-case t)) (nth 2 form)))
 
       ;; end:
       ;;		unbind			;unbind error handler or VAR
diff --git a/man/lang.texi b/man/lang.texi
index 50d909f..e44afc6 100644
--- a/man/lang.texi
+++ b/man/lang.texi
@@ -5061,15 +5061,28 @@ is a string formatted by @var{template} and @var{VALUES}. (@pxref{Formatted Outp
 
 @defvar debug-on-error
 This variable is consulted by the function @code{signal}. If its value
-is either @code{t} or a list containing the @var{error-symbol} to
+is either non-nil or a list containing the @var{error-symbol} to
 @code{signal} as one of its elements, the Lisp debugger is entered.
 When the debugger exits the error is signalled as normal.
+
+More exactly, if it's a symbol @code{always} or a list, then the
+debugger is entered always. If some other non-nil value, then it's
+ignored if an error is signalled from the inside of
+ code{condition-case} described below. Notice that it's not checked if
+the error is actually handled by an error handler defined in
+ code{condition-case} 
+
+ lisp
+(setq backtrace-on-error t) ;; Ordinary usage.
+(setq backtrace-on-error '(void-value bad-arg)) 
+   ;; Enter debugger for only these two cases
+ end lisp
 @end defvar
 
 @defvar backtrace-on-error
-Similar to @code{debug-on-error}, but if an error is matched, the
-current backtrace is printed to the standard error stream, and control
-continues.
+Similar to @code{debug-on-error}, but instead of entering the
+debugger, the current backtrace is printed to the standard error
+stream, and control continues.
 @end defvar
 
 When you expect an error to occur and need to be able to regain control
diff --git a/man/news.texi b/man/news.texi
index 86f9e64..0499d70 100644
--- a/man/news.texi
+++ b/man/news.texi
@@ -5,11 +5,29 @@
 
 @heading 0.90.7
 @itemize @bullet
+
+ item Important notice
+
+You have to byte compile all codes again. Otherwise they may emit many
+messages. In particular @file{sawfish-config} is likely to crash. It
+is due to the backtrace change described below.
+
+ item Half way improvement of @code{debug-on-error} and @code{backtrace-on-error} [Teika Kazura]
+
+Previously, setting these values to @code{t} triggered the debugger /
+the backtrace even if the error is signalled inside of
+ code{condition-case}  Now, they don't. Previous behavior can be
+obtained by setting them to a symbol @code{always}.
+
+The default value of @code{backtrace-on-error} is @code{t}.
+ emph{Please} notice that in this case, even if the error is not
+handled by an error handler, then the debugger / the backtrace is not
+invoked. It is not the best, but we can't improve it.
+
 @item When you evaluate a closure, the module to which it belongs is printed, too. [Teika kazura]
 
 @item Better documentation on ``fluid'' and @code{let}. [Teika kazura]
 @end itemize
-
 @heading 0.90.6
 @itemize @bullet
 
diff --git a/src/lisp.c b/src/lisp.c
index 3c0281b..548e878 100644
--- a/src/lisp.c
+++ b/src/lisp.c
@@ -131,15 +131,15 @@ DEFSYM(debug_macros, "debug-macros");
 DEFSYM(error_handler_function, "error-handler-function"); /*
 ::doc:debug-on-error::
 When an error is signalled this variable controls whether or not to
-enter the Lisp debugger immediately. If the variable's value is t or a
+enter the Lisp debugger immediately. If the variable's value is non-nil or a
 list of symbols--one of which is the signalled error symbol--the
-debugger is entered.
+debugger is entered. Read info for the details.
 ::end::
 ::doc:backtrace-on-error::
 When an error is signalled this variable controls whether or not to
-print a backtrace immediately. If the variable's value is t or a list
-of symbols--one of which is the signalled error symbol--the debugger is
-entered.
+print the backtrace immediately. If the variable's value is non-nil or a list
+of symbols--one of which is the signalled error symbol--the backtrace
+is printed. Read info for the details.
 ::end::
 ::doc:debug-macros::
 When nil, the debugger isn't entered while expanding macro definitions.
@@ -170,6 +170,9 @@ The maximum number of list elements to print before abbreviating.
 The number of list levels to descend when printing before abbreviating.
 ::end:: */
 
+DEFSYM(in_condition_case, "%in-condition-case");
+DEFSYM(always, "always");
+
 DEFSYM(load, "load");
 DEFSYM(require, "require");
 
@@ -1267,7 +1270,7 @@ bind_lambda_list_1 (repv lambdaList, repv *args, int nargs)
 	switch (state)
 	{
 	    repv key;
-            int i;
+	    int i;
 
 	case STATE_REQUIRED:
 	case STATE_OPTIONAL:
@@ -2081,7 +2084,7 @@ rep_call_lispn (repv fun, int argc, repv *argv)
 	/* if (bc_apply == 0) */
 	    ret = rep_apply_bytecode (rep_FUNARG (fun)->fun, argc, argv);
 	/* else
-        ret = bc_apply (rep_FUNARG (fun)->fun, argc, argv); */
+	ret = bc_apply (rep_FUNARG (fun)->fun, argc, argv); */
 	rep_POP_CALL (lc);
 	return ret;
     }
@@ -2503,16 +2506,26 @@ be made available to any error-handler or printed by the default error
 handler.
 ::end:: */
 {
-    repv tmp, errlist, on_error;
+    repv tmp, errlist, on_error, in_cond;
     /* Can only have one error at once.	 */
     if(rep_throw_value)
 	return rep_NULL;
     rep_DECLARE1(error, rep_SYMBOLP);
 
     on_error = Fsymbol_value (Qbacktrace_on_error, Qt);
-    if ((on_error == Qt && error != Qend_of_stream)
-	|| (rep_CONSP(on_error)
-	    && (tmp = Fmemq (error, on_error)) && tmp != Qnil))
+    in_cond = Fsymbol_value(Qin_condition_case, Qt);
+
+    if (/* Usual case */
+	(error != Qend_of_stream
+	 &&
+	 (
+	  (on_error == Qalways)
+	  ||
+	  (on_error != Qnil && !rep_CONSP(on_error) && in_cond != Qt)))
+	||
+	/* a list */
+	(rep_CONSP(on_error)
+	 && (tmp = Fmemq (error, on_error)) && tmp != Qnil))
     {
 	fprintf (stderr, "\nLisp backtrace:\n");
 	Fbacktrace (Fstderr_file());
@@ -2521,9 +2534,16 @@ handler.
 
     errlist = Fcons(error, data);
     on_error = Fsymbol_value(Qdebug_on_error, Qt);
-    if(((on_error != rep_NULL && on_error == Qt && error != Qend_of_stream)
-	|| (rep_CONSP(on_error)
-	    && (tmp = Fmemq(error, on_error)) && !rep_NILP(tmp))))
+    if(/* Usual case */
+       ((on_error != rep_NULL && error != Qend_of_stream)
+	 &&
+	 (
+	  (on_error == Qalways)
+	  ||
+	  (on_error != Qnil && !rep_CONSP(on_error) && in_cond != Qt)))
+       /* a list */
+       || (rep_CONSP(on_error)
+	    && (tmp = Fmemq(error, on_error)) && !rep_NILP(tmp)))
     {
 	/* Enter debugger. */
 	rep_GC_root gc_on_error;
@@ -2848,11 +2868,15 @@ rep_lisp_init(void)
     rep_INTERN_SPECIAL(debug_on_error);
     Fset (Qdebug_on_error, Qnil);
     rep_INTERN_SPECIAL(backtrace_on_error);
-    Fset (Qbacktrace_on_error, Qnil);
+    Fset (Qbacktrace_on_error, Qt);
+    rep_INTERN(always);
     rep_INTERN_SPECIAL(debug_macros);
     Fset (Qdebug_macros, Qnil);
     rep_INTERN_SPECIAL(error_handler_function);
 
+    rep_INTERN_SPECIAL(in_condition_case);
+    Fset (Qin_condition_case, Qnil);
+
     rep_int_cell = Fcons(Quser_interrupt, Qnil);
     rep_mark_static(&rep_int_cell);
     rep_term_cell = Fcons(Qterm_interrupt, Qnil);