From: Chris Hanson Date: Wed, 15 May 1991 18:14:02 +0000 (+0000) Subject: Add control variable to allow limiting the amount of a string that is X-Git-Tag: 20090517-FFI~10582 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c6cdcbb2fd5ef2deeca4749e5e82ca8398cc11fc;p=mit-scheme.git 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 184f6a9fc..c74bafbed 100644 --- 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 4c7994018..8f1b8d1e0 100644 --- 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 b4f8ec1ec..2df894834 100644 --- 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 655d9ccc1..9898c9a19 100644 --- 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