diff options
author | Andy Wingo <wingo@pobox.com> | 2011-03-17 12:33:58 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-03-17 12:39:59 +0100 |
commit | bb455e4f94d8e339c9b8a69e178110cf3dfa5bcb (patch) | |
tree | 89adfe25c7fdac2bd30376516990eb2bb41f0a1e /module/system/repl/debug.scm | |
parent | 17ab1dc3d630dcaeee45e1cb42a8f8699585eea0 (diff) | |
download | guile-bb455e4f94d8e339c9b8a69e178110cf3dfa5bcb.tar.gz |
allow ,option on-error report instead of debug
* module/system/repl/command.scm:
* module/system/repl/debug.scm (terminal-width): Move terminal-width
here, make it thread-local, and export it.
(print-locals, print-frame, print-frames): Default width to
terminal-width.
* module/system/repl/error-handling.scm (call-with-error-handling): Add
`report' and `backtrace' on-error handlers.
* module/system/repl/common.scm (repl-default-options): Add on-error
REPL option, defaulting to `debug', but which may be changed.
* module/system/repl/repl.scm (run-repl): Pass the #:on-error REPL
option to call-with-error-handling.
Diffstat (limited to 'module/system/repl/debug.scm')
-rw-r--r-- | module/system/repl/debug.scm | 32 |
1 files changed, 26 insertions, 6 deletions
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm index 46ea6b4db..cf408063e 100644 --- a/module/system/repl/debug.scm +++ b/module/system/repl/debug.scm @@ -1,6 +1,6 @@ ;;; Guile VM debugging facilities -;;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc. +;;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -32,6 +32,7 @@ #:export (<debug> make-debug debug? debug-frames debug-index debug-error-message debug-for-trap? + terminal-width print-registers print-locals print-frame print-frames frame->module stack->vector narrow-stack->vector frame->stack-vector)) @@ -58,6 +59,25 @@ +;; A fluid, because terminals are usually implicitly associated with +;; threads. +;; +(define terminal-width + (let ((set-width (make-fluid))) + (case-lambda + (() + (or (fluid-ref set-width) + (let ((w (false-if-exception (string->number (getenv "COLUMNS"))))) + (and (integer? w) (exact? w) (> w 0) w)) + 72)) + ((w) + (if (or (not w) (and (integer? w) (exact? w) (> w 0))) + (fluid-set! set-width w) + (error "Expected a column number (a positive integer)" w)))))) + + + + (define (reverse-hashq h) (let ((ret (make-hash-table))) (hash-for-each @@ -79,7 +99,7 @@ (print "fp = #x~x\n" (frame-address frame))) (define* (print-locals frame #:optional (port (current-output-port)) - #:key (width 72) (per-line-prefix " ")) + #:key (width (terminal-width)) (per-line-prefix " ")) (let ((bindings (frame-bindings frame))) (cond ((null? bindings) @@ -99,8 +119,8 @@ (frame-bindings frame)))))) (define* (print-frame frame #:optional (port (current-output-port)) - #:key index (width 72) (full? #f) (last-source #f) - next-source?) + #:key index (width (terminal-width)) (full? #f) + (last-source #f) next-source?) (define (source:pretty-file source) (if source (or (source:file source) "current input") @@ -120,8 +140,8 @@ (define* (print-frames frames #:optional (port (current-output-port)) - #:key (width 72) (full? #f) (forward? #f) count - for-trap?) + #:key (width (terminal-width)) (full? #f) + (forward? #f) count for-trap?) (let* ((len (vector-length frames)) (lower-idx (if (or (not count) (positive? count)) 0 |