-;;; -*-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
'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
#f
boolean?)
\f
-(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"
-;;; -*-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)
'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."
#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."
(lambda (object)
(or (not object)
(exact-nonnegative-integer? object))))
-
+\f
(define-variable debugger-show-help-message?
"True means show the help message, false means don't."
#T
boolean-or-ask?)
(define edwin-variable$debugger-start-new-screen?
edwin-variable$debugger-start-new-frame?)
-\f
+
(define-variable debugger-hide-system-code?
"True means don't show subproblems created by the runtime system."
#T
#F
boolean?)
\f
-;;;; 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)
;;;; 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.
-----------")
\f
-;;;; 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)
"Invoke the continuation-browser on CONTINUATION."
"XBrowse Continuation"
select-continuation-browser-buffer)
-
+\f
(define (make-debug-screen buffer)
(and (multiple-screens?)
(let ((new-screen? (ref-variable debugger-start-new-screen? buffer)))
(begin
(write-string "The " port)
(write-string (if (condition/error? object)
- "*ERROR*"
+ "error"
"condition")
port)
(write-string " that started the debugger is:" port)
(buffer-end buffer)
(bline/start-mark (car blines))))
buffer)))
-\f
+
(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))))
-\f
-;;;; 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"))))
\f
;;;; Continuation Browser Mode
(define-major-mode continuation-browser read-only "Debug"
- " ********Debugger Help********
+ " ******* Debugger Help *******
Commands:
;; 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))
(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
-;;; -*-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
(add-gc-daemon!/no-restore editor-gc-daemon)
(add-event-receiver! event:after-restore editor-gc-daemon)
\f
+;;;; Error handling
+
(define (internal-error-handler condition)
(cond ((and (eq? condition-type:primitive-procedure-error
(condition/type condition))
(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))))
(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))))
\f
-(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)))))
"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))))
\f
+;;;; Abort and quit
+
(define condition-type:abort-current-command
(make-condition-type 'ABORT-CURRENT-COMMAND #f '(INPUT)
(lambda (condition port)
(define (editor-child-cmdl-port port)
(lambda (cmdl) cmdl port))
\f
+;;;; Inferior threads
+
(define inferior-thread-changes?)
(define inferior-threads)
#| -*-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.
(define-package (edwin debugger)
(files "debug")
(parent (edwin))
- (export ()
- with-break-on
- call-with-break)
(export (edwin)
debug-scheme-error
edwin-command$browse-continuation
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
-;;; -*-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)
(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))))
\f
(define-variable evaluation-input-recorder
"A procedure that receives each input region before evaluation.
(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))
\f
-;;; -*-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)
(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))))))))
\f
;;;; Modes
projects / mit-scheme.git / commitdiff