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

add custom-print to printable<%>; redirect printable<%> to writable and pretty-print to pretty-write in 'scheme'

Browse Source
This commit is contained in:
Matthew Flatt 2010-05-01 08:31:33 -06:00
parent 835ebc0785
commit cb5c83c5a7
8 changed files with 97 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/racket/private/class-internal.rkt
View File

@ -34,7 +34,7 @@
class?
mixin
interface interface* interface?
object% object? externalizable<%> printable<%> equal<%>
object% object? externalizable<%> printable<%> writable<%> equal<%>
object=?
new make-object instantiate
send send/apply send* class-field-accessor class-field-mutator with-method
@ -4669,14 +4669,23 @@
(define externalizable<%>
(_interface () externalize internalize))
(define printable<%>
(define writable<%>
(interface* ()
([prop:custom-write (lambda (obj port write?)
(if write?
([prop:custom-write (lambda (obj port mode)
(if mode
(send obj custom-write port)
(send obj custom-display port)))])
custom-write custom-display))
(define printable<%>
(interface* ()
([prop:custom-write (lambda (obj port mode)
(case mode
[(#t) (send obj custom-write port)]
[(#f) (send obj custom-display port)]
[else (send obj custom-print port mode)]))])
custom-write custom-display custom-print))
(define equal<%>
(interface* ()
([prop:equal+hash (list
@ -4728,7 +4737,7 @@
class?
mixin
(rename-out [_interface interface]) interface* interface?
object% object? object=? externalizable<%> printable<%> equal<%>
object% object? object=? externalizable<%> printable<%> writable<%> equal<%>
new make-object instantiate
get-field set-field! field-bound? field-names
send send/apply send* class-field-accessor class-field-mutator with-method

3
collects/scheme/base.rkt
View File

@ -3,6 +3,7 @@
(provide (except-out (all-from-out racket/base)
struct
hash hasheq hasheqv)
hash hasheq hasheqv
in-directory)
make-base-empty-namespace
make-base-namespace)

7
collects/scheme/class.rkt
View File

@ -1,2 +1,5 @@
#lang scheme/private/provider
racket/class
#lang scheme/base
(require racket/class)
(provide (except-out (all-from-out racket/class)
printable<%>)
(rename-out [writable<%> printable<%>]))

7
collects/scheme/pretty.rkt
View File

@ -1,2 +1,5 @@
#lang scheme/private/provider
racket/pretty
#lang scheme/base
(require racket/pretty)
(provide (except-out (all-from-out racket/pretty)
pretty-print)
(rename-out [pretty-write pretty-print]))

26
collects/scribblings/reference/class.scrbl
View File

@ -1847,25 +1847,37 @@ The @scheme[externalizable<%>] interface includes only the
@section[#:tag "objectprinting"]{Object Printing}
To customize the way that a class instance is printed by @scheme[write]
or @scheme[display], implement the @scheme[printable<%>] interface.
To customize the way that a class instance is printed by
@racket[print], @scheme[write] and @scheme[display], implement the
@scheme[printable<%>] interface.
@defthing[printable<%> interface?]{
The @scheme[printable<%>] interface includes only the
@scheme[custom-write] and @scheme[custom-print] methods. Each accepts
@scheme[custom-print], @scheme[custom-write], and
@scheme[custom-display] methods. The @scheme[custom-print] method
accepts two arguments: the destination port and the current
@scheme[quaisquote] depth as an exact nonnegative integer. The
@scheme[custom-write] and @scheme[custom-display] methods each accepts
a single argument, which is the destination port to @scheme[write] or
@scheme[display] the object.
Calls to the @scheme[custom-write] or @scheme[custom-display] are like
calls to a procedure attached to a structure type through the
@scheme[prop:custom-write] property. In particular, recursive printing
can trigger an escape from the call.
Calls to the @racket[custom-print], @scheme[custom-write], or
@scheme[custom-display] methods are like calls to a procedure attached
to a structure type through the @scheme[prop:custom-write]
property. In particular, recursive printing can trigger an escape from
the call.
See @scheme[prop:custom-write] for more information. The
@scheme[printable<%>] interface is implemented with
@scheme[interface*] and @scheme[prop:custom-write].}
@defthing[writable<%> interface?]{
Like @scheme[printable<%>], but includes only the
@scheme[custom-write] and @scheme[custom-print] methods.
A @racket[print] request is directed to @scheme[custom-write].}
@; ------------------------------------------------------------------------
@section[#:tag "objectutils"]{Object, Class, and Interface Utilities}

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

@ -44,7 +44,7 @@ proportional to the depth of the value being printed, due to the
initial cycle check.}
@defproc[(print [datum any/c][out output-port? (current-output-port)]
[exact-nonnegative-integer? qq-depth 0])
[qq-depth exact-nonnegative-integer? 0])
void?]{
Writes @racket[datum] to @racket[out], normally the same way as

58
collects/scribblings/scheme/scheme.scrbl
View File

@ -2,6 +2,10 @@
@(require (for-syntax racket)
(for-label (only-in scheme/foreign unsafe! provide* define-unsafer)
(only-in scheme/base make-base-namespace make-base-empty-namespace)
(only-in scheme/pretty pretty-print)
(only-in racket/pretty pretty-write)
(only-in scheme/class printable<%>)
(only-in racket/class writable<%>)
scheme/gui/base
scheme/sandbox))
@ -10,24 +14,31 @@
make-base-empty-namespace-id
sandbox-namespace-specs-id
make-evaluator-id
make-module-evaluator-id)
make-module-evaluator-id
pretty-print-id
printable<%>-id)
(begin
(require (for-label (only-in scheme struct)
(only-in racket/base make-base-namespace
make-base-empty-namespace)
(only-in racket/pretty pretty-print)
racket/sandbox))
(define unit-struct (racket struct))
(define make-base-namespace-id (racket make-base-namespace))
(define make-base-empty-namespace-id (racket make-base-empty-namespace))
(define sandbox-namespace-specs-id (racket sandbox-namespace-specs))
(define make-evaluator-id (racket make-evaluator))
(define make-module-evaluator-id (racket make-module-evaluator))))
(define make-module-evaluator-id (racket make-module-evaluator))
(define pretty-print-id (racket pretty-print))
(define printable<%>-id (racket printable<%>))))
@(def-extras unit-struct
make-base-namespace-id
make-base-empty-namespace-id
sandbox-namespace-specs-id
make-evaluator-id
make-module-evaluator-id)
make-module-evaluator-id
pretty-print-id
printable<%>-id)
@(define-syntax-rule (compat-except sid rid . rest)
(begin
@ -47,11 +58,14 @@ old name.
@compat-except[scheme racket]{, except that @schememodname[racket]'s
@scheme[struct] is not exported, the @|unit-struct| from
@schememodname[scheme/unit] is exported, @schememodname[scheme/set]
is not re-exported, and @schememodname[scheme/nest] is re-exported}
@schememodname[scheme/unit] is exported, @schememodname[scheme/set] is
not re-exported, @racket[pretty-print] is re-directed in as
@racketmodname[scheme/pretty], and @schememodname[scheme/nest] is
re-exported}
@compat-except[scheme/base racket/base]{, except that
@schememodname[racket]'s @scheme[struct] is not exported, and
@schememodname[racket]'s @scheme[struct] is not exported, @scheme[in-directory]
is not exported, and
@scheme[make-base-namespace] and @scheme[make-base-empty-namespace]
are different}
@ -68,7 +82,21 @@ with @schememodname[scheme/base] attached.}
@compat[scheme/async-channel racket/async-channel]
@compat[scheme/bool racket/bool]
@compat[scheme/class racket/class]
@; ----------------------------------------------------------------------
@compat-except[scheme/class racket/class]{, except that
@racket[writable<%>] is exported under the name @racket[printable<%>]
(and @|printable<%>-id| from @schememodname[racket/class] is not
exported)}
@defthing[printable<%> interface?]{
An alias for @racket[writable<%>].
}
@; ----------------------------------------------------------------------
@compat[scheme/cmdline racket/cmdline]
@compat[scheme/contract racket/contract]
@compat[scheme/control racket/control]
@ -180,7 +208,21 @@ than a precise prose description:
@compat[scheme/package racket/package]
@compat[scheme/path racket/path]
@compat[scheme/port racket/port]
@compat[scheme/pretty racket/pretty]
@; ----------------------------------------
@compat-except[scheme/pretty racket/pretty]{, except that
@racket[pretty-write] is exported under the name @racket[pretty-print]
(and @|pretty-print-id| from @schememodname[racket/pretty] is not
exported)}
@defproc[(pretty-print [v any/c] [port output-port? (current-output-port)])
void?]{
An alias for @racket[pretty-write].}
@; ----------------------------------------
@compat[scheme/promise racket/promise]
@compat[scheme/provide racket/provide]
@compat[scheme/provide-syntax racket/provide-syntax]

2
collects/scribblings/scribble/renderer.scrbl
View File

@ -1,7 +1,7 @@
#lang scribble/doc
@(require scribble/manual
"utils.ss"
(for-label scheme/class))
(for-label racket/class))
@(define-syntax-rule (defmodule/local lib . content)
(begin