From 491ab3c12b196f067777630b4c4a7d9e6a0947ee Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 2 Jul 2010 11:14:04 -0600 Subject: [PATCH] expose internal display/write/print-limiting functionality via `printf' addition of ~. --- collects/scribblings/reference/write.scrbl | 13 ++++++- collects/tests/racket/file.rktl | 16 ++++++++ src/racket/src/error.c | 6 +-- src/racket/src/schpriv.h | 2 + src/racket/src/string.c | 45 +++++++++++++++++++++- 5 files changed, 76 insertions(+), 6 deletions(-) diff --git a/collects/scribblings/reference/write.scrbl b/collects/scribblings/reference/write.scrbl index 29dde9ca52..6d0d1c0944 100644 --- a/collects/scribblings/reference/write.scrbl +++ b/collects/scribblings/reference/write.scrbl @@ -81,7 +81,8 @@ escapes: @itemize[ - @item{@FmtMark{n} or @FmtMark{%} prints a newline, the same as @litchar{\n}} + @item{@FmtMark{n} or @FmtMark{%} prints a newline character (which + is equivalent to @litchar{\n} in a literal format string)} @item{@FmtMark{a} or @FmtMark{A} @racket[display]s the next argument among the @racket[v]s} @@ -92,10 +93,18 @@ escapes: @item{@FmtMark{v} or @FmtMark{V} @racket[print]s the next argument among the @racket[v]s} + @item{@FmtMark{.}@nonterm{c} where @nonterm{c} is @litchar{a}, + @litchar{A}, @litchar{s}, @litchar{S}, @litchar{v}, or @litchar{V}: + truncates @racket[display], @racket[write], or @racket[print] output + to @racket[(error-print-width)] characters, using @litchar{...} as + the last three characters if the untruncated output would be longer} + @item{@FmtMark{e} or @FmtMark{E} outputs the next argument among the @racket[v]s using the current error value conversion handler (see @racket[error-value->string-handler]) and current error printing - width} @item{@FmtMark{c} or @FmtMark{C} @racket[write-char]s the + width} + + @item{@FmtMark{c} or @FmtMark{C} @racket[write-char]s the next argument in @racket[v]s; if the next argument is not a character, the @exnraise[exn:fail:contract]} diff --git a/collects/tests/racket/file.rktl b/collects/tests/racket/file.rktl index 806ec3d886..73388a7f6e 100644 --- a/collects/tests/racket/file.rktl +++ b/collects/tests/racket/file.rktl @@ -1108,6 +1108,9 @@ (test "hello---~---there" format "~a---~~---~a" "hello" 'there) (test "\"hello\"---~---there" format "~s---~~---~s" "hello" 'there) (test "\"hello\"---~---'there" format "~v---~~---~v" "hello" 'there) + (test "hello---~---there" format "~.a---~~---~a" "hello" 'there) + (test "\"hello\"---~---there" format "~.s---~~---~s" "hello" 'there) + (test "\"hello\"---~---'there" format "~.v---~~---~v" "hello" 'there) (test (string #\a #\newline #\b #\newline #\c) format "a~nb~%c") (let ([try-newline-stuff (lambda (newlines) @@ -1120,6 +1123,7 @@ (test "twenty=20..." format "twenty=~s..." 20) (test "twenty=20..." format "twenty=~v..." 20) (test "twenty=20..." format "twenty=~e..." 20) + (test "twenty=20..." format "twenty=~.s..." 20) (test "twenty=14..." format "twenty=~x..." 20) (test "twenty=24..." format "twenty=~o..." 20) (test "twenty=10100..." format "twenty=~b..." 20) @@ -1129,6 +1133,18 @@ (lambda (s) (string-ref s (sub1 (string-length s)))) (parameterize ([error-print-width 40]) (format "~e" (make-string 200 #\v)))) + (test "(vvvvvv..." + '.a + (parameterize ([error-print-width 10]) + (format "~.a" (list (make-string 200 #\v))))) + (test "(\"vvvvv..." + '.v + (parameterize ([error-print-width 10]) + (format "~.s" (list (make-string 200 #\v))))) + (test "'(\"vvvv..." + '.v + (parameterize ([error-print-width 10]) + (format "~.v" (list (make-string 200 #\v))))) (let() (define bads diff --git a/src/racket/src/error.c b/src/racket/src/error.c index a8b29c23f9..912f1c2f0a 100644 --- a/src/racket/src/error.c +++ b/src/racket/src/error.c @@ -751,7 +751,7 @@ call_error(char *buffer, int len, Scheme_Object *exn) } } -static long get_print_width(void) +long scheme_get_print_width(void) { long print_width; Scheme_Object *w; @@ -774,7 +774,7 @@ static char *init_buf(long *len, long *_size) long size; local_max_symbol_length = scheme_get_max_symbol_length(); - print_width = get_print_width(); + print_width = scheme_get_print_width(); size = (3 * local_max_symbol_length + 500 + 2 * print_width); @@ -1950,7 +1950,7 @@ char *scheme_make_provided_string(Scheme_Object *o, int count, int *lenout) { long len; - len = get_print_width(); + len = scheme_get_print_width(); if (count) len /= count; diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index dacaa8fec7..71a06d3733 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -1960,6 +1960,8 @@ void scheme_flush_stack_cache(void); struct Scheme_Load_Delay; Scheme_Object *scheme_load_delayed_code(int pos, struct Scheme_Load_Delay *ld); +long scheme_get_print_width(void); + /*========================================================================*/ /* compile and link */ /*========================================================================*/ diff --git a/src/racket/src/string.c b/src/racket/src/string.c index b10f44d3a6..8fcc72e862 100644 --- a/src/racket/src/string.c +++ b/src/racket/src/string.c @@ -1663,6 +1663,23 @@ void scheme_do_format(const char *procname, Scheme_Object *port, case 'E': used++; break; + case '.': + switch (format[i+1]) { + case 'a': + case 'A': + case 's': + case 'S': + case 'v': + case 'V': + break; + default: + scheme_wrong_type(procname, + "pattern-string (tag `~.' not followed by `a', `s', or `v')", + fpos, argc, argv); + break; + } + used++; + break; case 'x': case 'X': case 'o': @@ -1689,7 +1706,7 @@ void scheme_do_format(const char *procname, Scheme_Object *port, default: { char buffer[64]; - sprintf(buffer, "pattern-string (tag ~%c not allowed)", format[i]); + sprintf(buffer, "pattern-string (tag `~%c' not allowed)", format[i]); scheme_wrong_type(procname, buffer, fpos, argc, argv); return; } @@ -1796,6 +1813,32 @@ void scheme_do_format(const char *procname, Scheme_Object *port, scheme_write_byte_string(s, len, port); } break; + case '.': + { + long len; + char *s; + len = scheme_get_print_width(); + i++; + switch (format[i]) { + case 'a': + case 'A': + s = scheme_display_to_string_w_max(argv[used++], &len, len); + break; + case 's': + case 'S': + s = scheme_write_to_string_w_max(argv[used++], &len, len); + break; + case 'v': + case 'V': + s = scheme_print_to_string_w_max(argv[used++], &len, len); + break; + default: + s = "???"; + len = 3; + } + scheme_write_byte_string(s, len, port); + } + break; case 'x': case 'X': case 'o':