suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

expose internal display/write/print-limiting functionality via `printf'

Browse Source 
addition of ~.
This commit is contained in:
Matthew Flatt 2010-07-02 11:14:04 -06:00
parent e1112b45cd
commit 491ab3c12b
5 changed files with 76 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/scribblings/reference/write.scrbl
View File

@ -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]}

16
collects/tests/racket/file.rktl
View File

@ -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

6
src/racket/src/error.c
View File

@ -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;

2
src/racket/src/schpriv.h
View File

@ -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 */
/*========================================================================*/

45
src/racket/src/string.c
View File

@ -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':