From bb455e4f94d8e339c9b8a69e178110cf3dfa5bcb Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 17 Mar 2011 12:33:58 +0100 Subject: 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. --- module/system/repl/debug.scm | 32 ++++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) (limited to 'module/system/repl/debug.scm') 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 ( 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)) @@ -56,6 +57,25 @@ (define-record frames index error-message for-trap?) + + +;; 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) @@ -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 -- cgit v1.2.3