From 781bcc2783709e76591cd354f4976f02eb284526 Mon Sep 17 00:00:00 2001
From: Michael Gran <address@hidden>
Date: Sun, 20 Feb 2011 21:53:46 -0800
Subject: [PATCH] Add ,width meta-command to set screen width in debug output

This meta-command allows one to set the default number of columns
that output from ,backtrace and ,locals shall occupy.

* doc/ref/scheme-using.texi (Debug Commands): document ,width
* module/system/repl/command.scm (*width*): new var
  (backtrace, locals): use *width* in optarg
  (width): new meta-command
---
 doc/ref/scheme-using.texi      |    6 ++++++
 module/system/repl/command.scm |   21 ++++++++++++++++++---
 2 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index 126b845..a119d42 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -337,6 +337,12 @@ Show the VM registers associated with the current frame.
 @xref{Stack Layout}, for more information on VM stack frames.
 @end deffn
 
address@hidden {REPL Command} width [cols]
+Sets the number of display columns in the output of @code{,backtrace}
+and @code{,locals} to @var{cols}.  If @var{cols} is not given, the width
+of the terminal is used.
address@hidden deffn
+
 The next 3 commands work at any REPL.
 
 @deffn {REPL Command} break proc
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index d4b3e4a..40d720d 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -71,6 +71,8 @@
 (define *show-table*
   '((show (warranty w) (copying c) (version v))))
 
+(define *width* 72)
+
 (define (group-name g) (car g))
 (define (group-commands g) (cdr g))
 
@@ -546,7 +548,7 @@ Trace execution."
                  (format #t "Nothing to debug.~%"))))))))
 
 (define-stack-command (backtrace repl #:optional count
-                                 #:key (width 72) full?)
+                                 #:key (width *width*) full?)
   "backtrace [COUNT] [#:width W] [#:full? F]
 Print a backtrace.
 
@@ -626,12 +628,12 @@ With an argument, select a frame by index, then show it."
 Print the procedure for the selected frame."
   (repl-print repl (frame-procedure cur)))
 
-(define-stack-command (locals repl)
+(define-stack-command (locals repl #:key (width *width*))
   "locals
 Show local variables.
 
 Show locally-bound variables in the selected frame."
-  (print-locals cur))
+  (print-locals cur #:width width))
 
 (define-stack-command (error-message repl)
   "error-message
@@ -811,6 +813,19 @@ Print registers.
 Print the registers of the current frame."
   (print-registers cur))
 
+(define-meta-command (width repl #:optional x)
+  "width [X]
+Set debug output width.
+
+Set the number of screen columns in the output from `backtrace' and
+`locals'."
+  (if (and x (not (integer? x)))
+      (error "expected a column number (a non-negative integer)" x)
+      (let ((w (or x
+                   (false-if-exception (string->number (getenv "COLUMNS")))
+                   72)))
+        (format #t "Setting screen width to ~a columns~%" w)
+        (set! *width* w))))
 
 
 ;;;
-- 
1.7.4