From: Chris Hanson Date: Fri, 10 Jan 2003 20:10:00 +0000 (+0000) Subject: Rework code that starts the debugger. The edwin variable X-Git-Tag: 20090517-FFI~2065 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c452143542b60d449c4668fab8555d4836a27b77;p=mit-scheme.git Rework code that starts the debugger. The edwin variable DEBUGGER-START-ON-ERROR? has been removed, and the various DEBUG-ON-*-ERROR edwin variables have been generalized to take a 'ASK value that prompts the user. The prompting has been cleaned up, and the interface simplified. --- diff --git a/v7/src/edwin/artdebug.scm b/v7/src/edwin/artdebug.scm index 431d18e4c..0aa5ba9f9 100644 --- a/v7/src/edwin/artdebug.scm +++ b/v7/src/edwin/artdebug.scm @@ -1,25 +1,27 @@ -;;; -*-Scheme-*- -;;; -;;; $Id: artdebug.scm,v 1.31 2002/11/20 19:45:57 cph Exp $ -;;; -;;; Copyright (c) 1989-1999, 2001 Massachusetts Institute of Technology -;;; -;;; This file is part of MIT Scheme. -;;; -;;; MIT Scheme is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published -;;; by the Free Software Foundation; either version 2 of the License, -;;; or (at your option) any later version. -;;; -;;; MIT Scheme is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with MIT Scheme; if not, write to the Free Software -;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;;; 02111-1307, USA. +#| -*-Scheme-*- + +$Id: artdebug.scm,v 1.32 2003/01/10 20:09:22 cph Exp $ + +Copyright 1989,1990,1991,1992,1993,1998 Massachusetts Institute of Technology +Copyright 1999,2001,2003 Massachusetts Institute of Technology + +This file is part of MIT Scheme. + +MIT Scheme is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2 of the License, or (at your +option) any later version. + +MIT Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT Scheme; if not, write to the Free Software Foundation, +Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +|# ;;;; Continuation Browser @@ -108,13 +110,6 @@ will always create a new buffer." 'ASK (lambda (value) (or (boolean? value) (eq? value 'ASK)))) -(define-variable debugger-start-on-error? - "True means always start the debugger on evaluation errors, false -means never start the debugger on errors, and ASK means ask the user -each time." - 'ASK - (lambda (value) (or (boolean? value) (eq? value 'ASK)))) - (define-variable debugger-quit-on-return? "True means quit debugger when executing a \"return\" command." #t @@ -165,37 +160,37 @@ or #F meaning no limit." #f boolean?) -(define in-debugger? #f) +(define starting-debugger? #f) (define in-debugger-evaluation? #f) -(define (maybe-debug-scheme-error switch-variable condition error-type-name) - (if (variable-value switch-variable) - (debug-scheme-error condition error-type-name))) - -(define (debug-scheme-error condition error-type-name) - (cond (in-debugger? +(define (debug-scheme-error error-type condition ask?) + (cond (starting-debugger? (quit-editor-and-signal-error condition)) - ((and (if in-debugger-evaluation? - (ref-variable debugger-debug-evaluations?) - (ref-variable debugger-start-on-error?)) - (or (not (eq? (ref-variable debugger-start-on-error?) 'ASK)) - (debug-scheme-error? condition error-type-name))) - (fluid-let ((in-debugger? #t)) - ((if (ref-variable debugger-split-window?) - select-buffer-other-window - select-buffer) - (continuation-browser-buffer condition))) - (message error-type-name " error") - (editor-beep) + ((and in-debugger-evaluation? + (not (ref-variable debugger-debug-evaluations? #f))) + unspecific) + (else + (let ((start-debugger + (lambda () + (fluid-let ((starting-debugger? #t)) + ((if (ref-variable debugger-split-window? #f) + select-buffer-other-window + select-buffer) + (continuation-browser-buffer condition)))))) + (if ask? + (if (cleanup-pop-up-buffers + (lambda () + (standard-error-report error-type condition #t) + (editor-beep) + (prompt-for-confirmation? "Start debugger"))) + (start-debugger)) + (begin + (start-debugger) + (message (string-capitalize (symbol->string error-type)) + " error") + (editor-beep)))) (return-to-command-loop condition)))) -(define (debug-scheme-error? condition error-type-name) - (cleanup-pop-up-buffers - (lambda () - (standard-error-report condition error-type-name #t) - (editor-beep) - (prompt-for-confirmation? "Start debugger")))) - (define-command browse-continuation "Invoke the continuation-browser on CONTINUATION." "XBrowse Continuation" diff --git a/v7/src/edwin/debug.scm b/v7/src/edwin/debug.scm index d6c5edb10..713b10be6 100644 --- a/v7/src/edwin/debug.scm +++ b/v7/src/edwin/debug.scm @@ -1,25 +1,27 @@ -;;; -*-Scheme-*- -;;; -;;; $Id: debug.scm,v 1.63 2002/11/20 19:45:59 cph Exp $ -;;; -;;; Copyright (c) 1992-2002 Massachusetts Institute of Technology -;;; -;;; This file is part of MIT Scheme. -;;; -;;; MIT Scheme is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published -;;; by the Free Software Foundation; either version 2 of the License, -;;; or (at your option) any later version. -;;; -;;; MIT Scheme is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with MIT Scheme; if not, write to the Free Software -;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;;; 02111-1307, USA. +#| -*-Scheme-*- + +$Id: debug.scm,v 1.64 2003/01/10 20:09:29 cph Exp $ + +Copyright 1992,1993,1994,1995,1996,1997 Massachusetts Institute of Technology +Copyright 1998,1999,2000,2001,2002,2003 Massachusetts Institute of Technology + +This file is part of MIT Scheme. + +MIT Scheme is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2 of the License, or (at your +option) any later version. + +MIT Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT Scheme; if not, write to the Free Software Foundation, +Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +|# ;;;; Browser-style Debug and Where ;;; Package: (edwin debugger) @@ -830,13 +832,6 @@ 'ASK boolean-or-ask?) -(define-variable debugger-start-on-error? - "#T means start the debugger whenever there is an evaluation error. -#F means ignore evaluation errors. -'ASK means ask user what to do for each evaluation error." - 'ASK - boolean-or-ask?) - (define-variable debugger-max-subproblems "Maximum number of subproblems displayed when debugger starts. Set this variable to #F to disable this limit." @@ -864,7 +859,8 @@ Quitting the debugger kills the debugger buffer and any associated buffers." #t boolean?) -;;;Limited this bc the bindings are now pretty-printed +;;; Limited this because the bindings are now pretty-printed. + (define-variable environment-package-limit "Packages with more than this number of bindings will be abbreviated. Set this variable to #F to disable this abbreviation." @@ -872,7 +868,7 @@ Set this variable to #F to disable this abbreviation." (lambda (object) (or (not object) (exact-nonnegative-integer? object)))) - + (define-variable debugger-show-help-message? "True means show the help message, false means don't." #T @@ -886,7 +882,7 @@ Set this variable to #F to disable this abbreviation." boolean-or-ask?) (define edwin-variable$debugger-start-new-screen? edwin-variable$debugger-start-new-frame?) - + (define-variable debugger-hide-system-code? "True means don't show subproblems created by the runtime system." #T @@ -915,14 +911,16 @@ a fixed size terminal." #F boolean?) -;;;; Pred's +;;;; Predicates + +;;; Determines if a frame is marked. -;;;Determines if a frame is marked (define (system-frame? stack-frame) (stack-frame/repl-eval-boundary? stack-frame)) -;;;Bad implementation to determine for breaks -;;;if a value to proceed with is desired +;;; Bad implementation to determine for breaks if a value to proceed +;;; with is desired. + (define value? #f) (define (invalid-subexpression? subexpression) @@ -935,32 +933,55 @@ a fixed size terminal." ;;;; Help Messages -;;;The help messages for the debugger +;;; The help messages for the debugger (define where-help-message -" COMMANDS: ? - Help q - Quit Environment browser +" COMMANDS: ? - Help q - Quit environment browser -This is an environment browser buffer. +This is an environment-browser buffer. Lines identify environment frames. The buffer below shows the bindings of the selected environment. ------------ -") +-----------") (define debugger-help-message -" COMMANDS: ? - Help q - Quit Debugger e - Environment browser +" COMMANDS: ? - Help q - Quit debugger e - Environment browser This is a debugger buffer. Lines identify stack frames, most recent first. - Sx means frame is in subproblem number x - Ry means frame is reduction number y + Sx means frame is in subproblem number x. + Ry means frame is reduction number y. -The buffer below describes the current subproblem or reduction. +The buffer below shows the current subproblem or reduction. -----------") -;;;; Debugger Entry +;;;; Debugger entry point + +(define starting-debugger? #f) + +(define (debug-scheme-error error-type condition ask?) + (if starting-debugger? + (quit-editor-and-signal-error condition) + (begin + (let ((start-debugger + (lambda () + (fluid-let ((starting-debugger? #t)) + (select-continuation-browser-buffer condition))))) + (if ask? + (if (cleanup-pop-up-buffers + (lambda () + (standard-error-report error-type condition #t) + (editor-beep) + (prompt-for-confirmation? "Start debugger"))) + (start-debugger)) + (begin + (start-debugger) + (message (string-capitalize (symbol->string error-type)) + " error") + (editor-beep)))) + (return-to-command-loop condition)))) (define (select-continuation-browser-buffer object #!optional thread) (set! value? #f) @@ -986,7 +1007,7 @@ The buffer below describes the current subproblem or reduction. "Invoke the continuation-browser on CONTINUATION." "XBrowse Continuation" select-continuation-browser-buffer) - + (define (make-debug-screen buffer) (and (multiple-screens?) (let ((new-screen? (ref-variable debugger-start-new-screen? buffer))) @@ -1052,7 +1073,7 @@ The buffer below describes the current subproblem or reduction. (begin (write-string "The " port) (write-string (if (condition/error? object) - "*ERROR*" + "error" "condition") port) (write-string " that started the debugger is:" port) @@ -1070,83 +1091,17 @@ The buffer below describes the current subproblem or reduction. (buffer-end buffer) (bline/start-mark (car blines)))) buffer))) - + (define (find-debugger-buffers) (list-transform-positive (buffer-list) (let ((debugger-mode (ref-mode-object continuation-browser))) (lambda (buffer) (eq? (buffer-major-mode buffer) debugger-mode))))) - -;;;Procedure that actually calls the cont-browser with the continuation -;;;and stops the thread when a break-pt is called -(define (break-to-debugger #!optional pred-thunk) - (let ((pred - (if (default-object? pred-thunk) - (prompt-for-yes-or-no? - "Enter the continuation browser at breakpoint") - (pred-thunk)))) - (if pred - (with-simple-restart 'CONTINUE "Return from BKPT." - (lambda () - (let ((thread (current-thread))) - (call-with-current-continuation - (lambda (cont) - (select-continuation-browser-buffer cont thread) - (if (eq? thread editor-thread) - (abort-current-command) - (stop-current-thread)) - (if value? - (abort-current-command)))))))))) - -;;;Calls the break pt thing with a pred thunk and a thunk to do -(define (with-break-on pred-thunk val-thunk) - (let ((val value?) - (bkvalue (break-to-debugger pred-thunk))) - (set! value? #f) - (if val - bkvalue - (val-thunk)))) - -;;;Calls the break pt thing with a pred-thunk a proc and args -(define (call-with-break pred-thunk proc . args) - (let ((val value?) - (bkvalue (break-to-debugger pred-thunk))) - (set! value? #f) - (if val - bkvalue - (apply proc args)))) - -;;;; External Entry Point - -(define (maybe-debug-scheme-error switch-variable condition error-type-name) - (if (variable-value switch-variable) - (debug-scheme-error condition error-type-name))) - -(define (debug-scheme-error condition error-type-name) - (cond (starting-debugger? - (quit-editor-and-signal-error condition)) - ((let ((start? (ref-variable debugger-start-on-error?))) - (if (eq? 'ASK start?) - (debug-scheme-error? condition error-type-name) - start?)) - (fluid-let ((starting-debugger? #t)) - (select-continuation-browser-buffer condition)) - (message (string-capitalize error-type-name) " error") - (return-to-command-loop condition)))) - -(define starting-debugger? #f) - -(define (debug-scheme-error? condition error-type-name) - (cleanup-pop-up-buffers - (lambda () - (standard-error-report condition error-type-name #t) - (editor-beep) - (prompt-for-confirmation? "Start debugger")))) ;;;; Continuation Browser Mode (define-major-mode continuation-browser read-only "Debug" - " ********Debugger Help******** + " ******* Debugger Help ******* Commands: @@ -1249,7 +1204,8 @@ it has been renamed, it will not be deleted automatically.") ;; of bindings. Subproblems, reductions, and environment frames are ;; ordered; bindings are not. -;;;Stops from displaying subproblems past marked frame by default +;;; Stops displaying subproblems past marked frame by default. + (define (continuation->blines continuation limit) (let ((beyond-system-code #f)) (let loop ((frame (continuation/first-subproblem continuation)) @@ -1508,7 +1464,8 @@ it has been renamed, it will not be deleted automatically.") (lambda (environment) (select-buffer (environment-browser-buffer environment)))) -;;;adds a help line +;;; Adds a help line. + (define (environment-browser-buffer object) (let ((environment (->environment object))) (let ((browser diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm index c2f34ba2b..4b2238855 100644 --- a/v7/src/edwin/editor.scm +++ b/v7/src/edwin/editor.scm @@ -1,25 +1,28 @@ -;;; -*-Scheme-*- -;;; -;;; $Id: editor.scm,v 1.255 2002/12/27 03:48:01 cph Exp $ -;;; -;;; Copyright (c) 1986, 1989-2002 Massachusetts Institute of Technology -;;; -;;; This file is part of MIT Scheme. -;;; -;;; MIT Scheme is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published -;;; by the Free Software Foundation; either version 2 of the License, -;;; or (at your option) any later version. -;;; -;;; MIT Scheme is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with MIT Scheme; if not, write to the Free Software -;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;;; 02111-1307, USA. +#| -*-Scheme-*- + +$Id: editor.scm,v 1.256 2003/01/10 20:09:36 cph Exp $ + +Copyright 1986,1989,1990,1991,1992,1993 Massachusetts Institute of Technology +Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology +Copyright 2000,2001,2002,2003 Massachusetts Institute of Technology + +This file is part of MIT Scheme. + +MIT Scheme is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2 of the License, or (at your +option) any later version. + +MIT Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT Scheme; if not, write to the Free Software Foundation, +Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +|# ;;;; Editor Top Level @@ -260,6 +263,8 @@ with the contents of the startup message." (add-gc-daemon!/no-restore editor-gc-daemon) (add-event-receiver! event:after-restore editor-gc-daemon) +;;;; Error handling + (define (internal-error-handler condition) (cond ((and (eq? condition-type:primitive-procedure-error (condition/type condition)) @@ -273,25 +278,32 @@ with the contents of the startup message." (debug-internal-errors? (error condition)) (else - (maybe-debug-scheme-error - (ref-variable-object debug-on-internal-error) - condition "internal") - (editor-beep) - (message (condition/report-string condition)) - (return-to-command-loop condition)))) + (maybe-debug-scheme-error 'INTERNAL condition)))) + +(define (maybe-debug-scheme-error error-type condition) + (let ((p + (variable-default-value + (or (name->variable (symbol-append 'DEBUG-ON- error-type '-ERROR) #f) + (ref-variable-object debug-on-internal-error))))) + (if p + (debug-scheme-error error-type condition (eq? p 'ASK)))) + (standard-error-report error-type condition #f) + (editor-beep) + (return-to-command-loop condition)) (define-variable debug-on-internal-error - "True means enter debugger if error is signalled while the editor is running. + "True means enter debugger if an internal error is signalled. +False means ignore the error and resume editing (this is the default value). +The symbol ASK means ask what to do. This does not affect editor errors or evaluation errors." #f - boolean?) + (lambda (x) (or (boolean? x) (eq? x 'ASK)))) (define debug-internal-errors? #f) (define condition-type:editor-error (make-condition-type 'EDITOR-ERROR condition-type:error '(STRINGS) (lambda (condition port) - (write-string "Editor error: " port) (write-string (message-args->string (editor-error-strings condition)) port)))) @@ -307,52 +319,62 @@ This does not affect editor errors or evaluation errors." (condition-accessor condition-type:editor-error 'STRINGS)) (define (editor-error-handler condition) - (maybe-debug-scheme-error (ref-variable-object debug-on-editor-error) - condition "editor") - (editor-beep) - (let ((strings (editor-error-strings condition))) - (if (not (null? strings)) - (apply message strings))) - (return-to-command-loop condition)) + (maybe-debug-scheme-error 'EDITOR condition)) (define-variable debug-on-editor-error - "True means signal Scheme error when an editor error occurs." + "True means enter debugger if an editor error is signalled. +False means ignore the error and resume editing (this is the default value). +The symbol ASK means ask what to do. +This does not affect internal errors or evaluation errors." #f - boolean?) + (lambda (x) (or (boolean? x) (eq? x 'ASK)))) -(define (standard-error-report condition error-type-name in-prompt?) - (let ((report-string (condition/report-string condition))) +(define (standard-error-report error-type condition in-prompt?) + (let ((type-string + (string-append (string-capitalize (symbol->string error-type)) + " error")) + (report-string (condition/report-string condition)) + (get-error-buffer + (lambda strings + (string->temporary-buffer (apply string-append strings) + "*error*" + '(SHRINK-WINDOW))))) (let ((typein-report (lambda () - (message (string-capitalize error-type-name) - " error: " - report-string))) + (if (eq? error-type 'EDITOR) + (message report-string) + (message type-string ": " report-string)))) (error-buffer-report (lambda () - (string->temporary-buffer report-string "*error*" - '(SHRINK-WINDOW)) - (message (string-capitalize error-type-name) " error") + (if in-prompt? + (if (eq? error-type 'EDITOR) + (get-error-buffer report-string) + (get-error-buffer type-string ":\n" report-string)) + (begin + (get-error-buffer report-string) + (message type-string))) (update-screens! #f))) (transcript-report (lambda () (and (ref-variable enable-transcript-buffer) (begin (with-output-to-transcript-buffer - (lambda () - (fresh-line) - (write-string ";Error: ") - (write-string report-string) - (newline) - (newline))) + (lambda () + (fresh-line) + (write-string ";") + (write-string type-string) + (write-string ": ") + (write-string report-string) + (newline) + (newline))) #t))))) (let ((fit-report (lambda () (if (and (not in-prompt?) (not (string-find-next-char report-string #\newline)) - (< (string-columns - report-string 0 8 - (variable-default-value - (ref-variable-object char-image-strings))) + (< (string-columns report-string 0 8 + (ref-variable char-image-strings + #f)) (window-x-size (typein-window)))) (typein-report) (error-buffer-report))))) @@ -367,16 +389,18 @@ This does not affect editor errors or evaluation errors." "Value of this variable controls the way evaluation error messages are displayed: STANDARD like FIT, except messages also appear in transcript buffer, - if it is enabled. + if it is enabled (this is the default value). FIT messages appear in typein window if they fit; - in *error* buffer if they don't. + in \"*error*\" buffer if they don't. TYPEIN messages appear in typein window. -ERROR-BUFFER messages appear in *error* buffer. +ERROR-BUFFER messages appear in \"*error*\" buffer. TRANSCRIPT messages appear in transcript buffer, if it is enabled; otherwise this is the same as FIT." 'STANDARD (lambda (value) (memq value '(STANDARD TRANSCRIPT ERROR-BUFFER TYPEIN FIT)))) +;;;; Abort and quit + (define condition-type:abort-current-command (make-condition-type 'ABORT-CURRENT-COMMAND #f '(INPUT) (lambda (condition port) @@ -510,6 +534,8 @@ TRANSCRIPT messages appear in transcript buffer, if it is enabled; (define (editor-child-cmdl-port port) (lambda (cmdl) cmdl port)) +;;;; Inferior threads + (define inferior-thread-changes?) (define inferior-threads) diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg index 82a8e2148..e8561faf3 100644 --- a/v7/src/edwin/edwin.pkg +++ b/v7/src/edwin/edwin.pkg @@ -1,8 +1,10 @@ #| -*-Scheme-*- -$Id: edwin.pkg,v 1.283 2002/12/09 06:04:58 cph Exp $ +$Id: edwin.pkg,v 1.284 2003/01/10 20:09:46 cph Exp $ -Copyright (c) 1989-2002 Massachusetts Institute of Technology +Copyright 1989,1990,1991,1992,1993,1994 Massachusetts Institute of Technology +Copyright 1995,1996,1997,1998,1999,2000 Massachusetts Institute of Technology +Copyright 2001,2002,2003 Massachusetts Institute of Technology This file is part of MIT Scheme. @@ -813,9 +815,6 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (define-package (edwin debugger) (files "debug") (parent (edwin)) - (export () - with-break-on - call-with-break) (export (edwin) debug-scheme-error edwin-command$browse-continuation @@ -840,10 +839,8 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. edwin-variable$debugger-split-window? edwin-variable$debugger-start-new-frame? edwin-variable$debugger-start-new-screen? - edwin-variable$debugger-start-on-error? edwin-variable$debugger-verbose-mode? - edwin-variable$environment-package-limit - maybe-debug-scheme-error) + edwin-variable$environment-package-limit) (import (runtime debugger) command/condition-restart command/frame diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm index 6359a60ab..0676fe058 100644 --- a/v7/src/edwin/evlcom.scm +++ b/v7/src/edwin/evlcom.scm @@ -1,25 +1,28 @@ -;;; -*-Scheme-*- -;;; -;;; $Id: evlcom.scm,v 1.66 2002/11/20 19:46:00 cph Exp $ -;;; -;;; Copyright (c) 1986, 1989-2001 Massachusetts Institute of Technology -;;; -;;; This file is part of MIT Scheme. -;;; -;;; MIT Scheme is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published -;;; by the Free Software Foundation; either version 2 of the License, -;;; or (at your option) any later version. -;;; -;;; MIT Scheme is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with MIT Scheme; if not, write to the Free Software -;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;;; 02111-1307, USA. +#| -*-Scheme-*- + +$Id: evlcom.scm,v 1.67 2003/01/10 20:09:53 cph Exp $ + +Copyright 1986,1989,1991,1992,1993,1994 Massachusetts Institute of Technology +Copyright 1995,1997,1998,1999,2000,2001 Massachusetts Institute of Technology +Copyright 2003 Massachusetts Institute of Technology + +This file is part of MIT Scheme. + +MIT Scheme is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2 of the License, or (at your +option) any later version. + +MIT Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT Scheme; if not, write to the Free Software Foundation, +Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +|# ;;;; Evaluation Commands ;;; Package: (edwin) @@ -69,10 +72,12 @@ If 'DEFAULT, use the default (REP loop) environment." (define-variable-local-value! buffer run-light #f)))))) (define-variable debug-on-evaluation-error - "True means enter debugger if error is signalled while evaluating. -This does not affect editor errors." - #t - boolean?) + "True means enter debugger if an evaluation error is signalled. +False means ignore the error and resume editing. +The symbol ASK means ask what to do (this is the default value). +This does not affect editor errors or internal errors." + 'ASK + (lambda (x) (or (boolean? x) (eq? x 'ASK)))) (define-variable evaluation-input-recorder "A procedure that receives each input region before evaluation. @@ -418,10 +423,8 @@ Set by Scheme evaluation code to update the mode line." (hook/repl-eval #f expression environment)))) (define (evaluation-error-handler condition) - (maybe-debug-scheme-error (ref-variable-object debug-on-evaluation-error) - condition - "evaluation") - (standard-error-report condition "evaluation" #f) + (maybe-debug-scheme-error 'EVALUATION condition) + (standard-error-report 'EVALUATION condition #f) (editor-beep) (return-to-command-loop condition)) diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm index a39b3266a..0d4d39e2c 100644 --- a/v7/src/edwin/intmod.scm +++ b/v7/src/edwin/intmod.scm @@ -1,25 +1,27 @@ -;;; -*-Scheme-*- -;;; -;;; $Id: intmod.scm,v 1.117 2002/11/20 19:46:00 cph Exp $ -;;; -;;; Copyright (c) 1986, 1989-2002 Massachusetts Institute of Technology -;;; -;;; This file is part of MIT Scheme. -;;; -;;; MIT Scheme is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published -;;; by the Free Software Foundation; either version 2 of the License, -;;; or (at your option) any later version. -;;; -;;; MIT Scheme is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with MIT Scheme; if not, write to the Free Software -;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;;; 02111-1307, USA. +#| -*-Scheme-*- + +$Id: intmod.scm,v 1.118 2003/01/10 20:10:00 cph Exp $ + +Copyright 1986,1989,1991,1992,1993,1999 Massachusetts Institute of Technology +Copyright 2000,2001,2002,2003 Massachusetts Institute of Technology + +This file is part of MIT Scheme. + +MIT Scheme is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2 of the License, or (at your +option) any later version. + +MIT Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT Scheme; if not, write to the Free Software Foundation, +Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +|# ;;;; Inferior REPL Mode ;;; Package: (edwin inferior-repl) @@ -383,29 +385,28 @@ evaluated in the specified inferior REPL buffer." (loop)))))) cmdl-interrupt/abort-top-level)) ((PROMPT) - (if (and (ref-variable debug-on-evaluation-error) - (let ((start? (ref-variable debugger-start-on-error?))) - (if (eq? 'ASK start?) - (let loop () - (fresh-line port) - (write-string ";Start debugger? (y or n): " port) - (let ((char - (read-command-char port - (cmdl/level repl)))) - (write-char char port) - (cond ((or (char-ci=? char #\y) - (char-ci=? char #\space)) - (fresh-line port) - (write-string ";Starting debugger..." - port) - #t) - ((or (char-ci=? char #\n) - (char-ci=? char #\rubout)) - #f) - (else - (beep port) - (loop))))) - start?))) + (if (let ((start? (ref-variable debug-on-evaluation-error #f))) + (if (eq? 'ASK start?) + (let loop () + (fresh-line port) + (write-string ";Start debugger? (y or n): " port) + (let ((char + (read-command-char port + (cmdl/level repl)))) + (write-char char port) + (cond ((or (char-ci=? char #\y) + (char-ci=? char #\space)) + (fresh-line port) + (write-string ";Starting debugger..." + port) + #t) + ((or (char-ci=? char #\n) + (char-ci=? char #\rubout)) + #f) + (else + (beep port) + (loop))))) + start?)) (start-debugger)))))))) ;;;; Modes