Add control variable to allow limiting the amount of a string that is

printed when slashification is turned on.  Use this variable in the
debugger.

diff --git a/v7/src/runtime/debug.scm b/v7/src/runtime/debug.scm
index 184f6a9fcf352bc060b5a9643a54b255665454d3..c74bafbed608f0ba2168bff11e57f21e9944e496 100644 (file)
--- a/v7/src/runtime/debug.scm
+++ b/v7/src/runtime/debug.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.24 1991/02/15 18:04:50 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.25 1991/05/15 18:13:49 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -44,6 +44,7 @@ MIT in each case. |#
 (define debugger:use-history? false)
 (define debugger:list-depth-limit 5)
 (define debugger:list-breadth-limit 5)
+(define debugger:string-length-limit 70)
 
 (define (debug #!optional object)
   (if (default-object? object)
@@ -329,7 +330,8 @@ MIT in each case. |#
 
 (define (debugger-pp expression indentation)
   (fluid-let ((*unparser-list-depth-limit* debugger:list-depth-limit)
-             (*unparser-list-breadth-limit* debugger:list-breadth-limit))
+             (*unparser-list-breadth-limit* debugger:list-breadth-limit)
+             (*unparser-string-length-limit* debugger:string-length-limit))
     (pretty-print expression (current-output-port) true indentation)))
 
 (define expression-indentation 4)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 4c7994018aa02d4898c0b787cc3622258d4172b3..8f1b8d1e09ccb1a96b6ab8a544d158bb4b045d2f 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.105 1991/05/10 05:24:27 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.106 1991/05/15 18:14:02 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -387,6 +387,7 @@ MIT in each case. |#
          debugger:list-breadth-limit
          debugger:list-depth-limit
          debugger:print-return-values?
+         debugger:string-length-limit
          debugger:student-walk?
          debugger:use-history?)
   (initialization (initialize-package!)))
@@ -2205,6 +2206,7 @@ MIT in each case. |#
          *unparser-list-breadth-limit*
          *unparser-list-depth-limit*
          *unparser-radix*
+         *unparser-string-length-limit*
          current-unparser-table
          guarantee-unparser-state
          guarantee-unparser-table

diff --git a/v7/src/runtime/unpars.scm b/v7/src/runtime/unpars.scm
index b4f8ec1ecda62888d00fbc42271d0f701b2cb294..2df894834ac5bca0322ded3f42e0dc2dc50b598c 100644 (file)
--- a/v7/src/runtime/unpars.scm
+++ b/v7/src/runtime/unpars.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 14.18 1990/09/19 00:34:16 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 14.19 1991/05/15 18:13:06 cph Exp $
 
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-91 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -44,6 +44,7 @@ MIT in each case. |#
   (set! *unparser-radix* 10)
   (set! *unparser-list-breadth-limit* false)
   (set! *unparser-list-depth-limit* false)
+  (set! *unparser-string-length-limit* false)
   (set! *unparse-primitives-by-name?* false)
   (set! *unparse-uninterned-symbols-by-name?* false)
   (set! *unparse-with-maximum-readability?* false)
@@ -53,6 +54,7 @@ MIT in each case. |#
 (define *unparser-radix*)
 (define *unparser-list-breadth-limit*)
 (define *unparser-list-depth-limit*)
+(define *unparser-string-length-limit*)
 (define *unparse-primitives-by-name?*)
 (define *unparse-uninterned-symbols-by-name?*)
 (define *unparse-with-maximum-readability?*)
@@ -185,7 +187,7 @@ MIT in each case. |#
   (output-port/write-string *output-port* string))
 
 (define-integrable (*unparse-substring string start end)
-  (*unparse-string (substring string start end)))
+  (output-port/write-substring *output-port* string start end))
 
 (define-integrable (*unparse-datum object)
   (*unparse-hex (object-datum object)))
@@ -308,37 +310,43 @@ MIT in each case. |#
 (define (unparse/string string)
   (cond ((char-set? string)
         (*unparse-with-brackets 'CHARACTER-SET string false))
-       (*slashify?*
-        (*unparse-char #\")
-        (let ((end (string-length string)))
-          (define (loop start)
-            (let ((index
-                   (substring-find-next-char-in-set string start end
-                                                    string-delimiters)))
-              (if index
-                  (begin (*unparse-substring string start index)
-                         (*unparse-char #\\)
-                         (let ((char (string-ref string index)))
-                           (cond ((char=? char #\Tab)
-                                  (*unparse-char #\t))
-                                 ((char=? char char:newline)
-                                  (*unparse-char #\n))
-                                 ((char=? char #\Page)
-                                  (*unparse-char #\f))
-                                 ((or (char=? char #\\)
-                                      (char=? char #\"))
-                                  (*unparse-char char))
-                                 (else
-                                  (*unparse-string (char->octal char)))))
-                         (loop (1+ index)))
-                  (*unparse-substring string start end))))
-          (if (substring-find-next-char-in-set string 0 end
-                                               string-delimiters)
-              (loop 0)
-              (*unparse-string string)))
-        (*unparse-char #\"))
+       ((not *slashify?*)
+        (*unparse-substring string))
        (else
-        (*unparse-string string))))
+        (let ((end (string-length string)))
+          (let ((end*
+                 (if *unparser-string-length-limit*
+                     (min *unparser-string-length-limit* end)
+                     end)))
+            (*unparse-char #\")
+            (if (substring-find-next-char-in-set string 0 end*
+                                                 string-delimiters)
+                (let loop ((start 0))
+                  (let ((index
+                         (substring-find-next-char-in-set string start end*
+                                                          string-delimiters)))
+                    (if index
+                        (begin
+                          (*unparse-substring string start index)
+                          (*unparse-char #\\)
+                          (let ((char (string-ref string index)))
+                            (cond ((char=? char #\Tab)
+                                   (*unparse-char #\t))
+                                  ((char=? char char:newline)
+                                   (*unparse-char #\n))
+                                  ((char=? char #\Page)
+                                   (*unparse-char #\f))
+                                  ((or (char=? char #\\)
+                                       (char=? char #\"))
+                                   (*unparse-char char))
+                                  (else
+                                   (*unparse-string (char->octal char)))))
+                          (loop (+ index 1)))
+                        (*unparse-substring string start end*))))
+                (*unparse-substring string 0 end*))
+            (if (< end* end)
+                (*unparse-string "..."))
+            (*unparse-char #\"))))))
 
 (define (char->octal char)
   (let ((qr1 (integer-divide (char->ascii char) 8)))

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 655d9ccc1401701157299cf94c563a07e746d0dd..9898c9a198d4aa6ac01b468468c0c4137127df57 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.105 1991/05/10 05:24:27 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.106 1991/05/15 18:14:02 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -387,6 +387,7 @@ MIT in each case. |#
          debugger:list-breadth-limit
          debugger:list-depth-limit
          debugger:print-return-values?
+         debugger:string-length-limit
          debugger:student-walk?
          debugger:use-history?)
   (initialization (initialize-package!)))
@@ -2205,6 +2206,7 @@ MIT in each case. |#
          *unparser-list-breadth-limit*
          *unparser-list-depth-limit*
          *unparser-radix*
+         *unparser-string-length-limit*
          current-unparser-table
          guarantee-unparser-state
          guarantee-unparser-table