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

generalize set-interactive-write-handler & use it in text:ports-mixin

Browse Source 
to avoid duplicate code between the drracket support for printing and
for write/display; also add a special case for 2htdp/image images
because they can be trusted across the boundary between DrRacket's
implementation and the user's program (as there is no way to embed
arbitrary code into a 2htdp/image image)
This commit is contained in:
Robby Findler 2016-05-28 09:02:50 -05:00
parent 7794ace98d
commit c3f4b5dedd
7 changed files with 100 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
gui-doc/mrlib/scribblings/interactive-value-port.scrbl
View File

@ -6,35 +6,53 @@
@defmodule[mrlib/interactive-value-port]
@defproc[(set-interactive-display-handler [port output-port?]) void?]{
@defproc[(set-interactive-display-handler
[port output-port?]
[#:snip-handler snip-handler
(or/c #f (-> (is-a?/c snip%) output-port? any))
#f])
void?]{
Sets @racket[port]'s display handler (via
@racket[port-display-handler]) so that when it encounters these
values:
Sets @racket[port]'s display handler (via
@racket[port-display-handler]) so that when it encounters
these values:
@itemize[@item{syntax objects}
@item{snips}]
@itemize[
@item{exact, real, non-integral numbers}
it uses @racket[write-special] to send snips to the port
and uses @racketmodname[mrlib/syntax-browser] to turn
syntax object into snips and then uses
@racket[write-special] with the result to send it to the
port. Otherwise, it behaves like the default handler.
@item{syntax objects}
If @racket[snip-handler] is not @racket[#f], then
@racket[set-interactive-display-handler] passes any snips
to it (not those it creates by
@racketmodname[mrlib/syntax-browser]) instead of calling
@racket[write-special].
]
it uses @racket[write-special] to send snips to the port,
instead of those values. Otherwise, it behaves like the
default handler.
To show values embedded in lists and other compound object, it uses
@racket[pretty-print].}
To show values embedded in lists and other compound object,
it uses @racket[pretty-display].
}
@defproc[(set-interactive-write-handler [port output-port?]) void?]{
@defproc[(set-interactive-write-handler
[port output-port?]
[#:snip-handler snip-handler
(or/c #f (-> (is-a?/c snip%) output-port? any))
#f])
void?]{
Like @racket[set-interactive-display-handler], but sets the
@racket[port-write-handler].}
@racket[port-write-handler] and uses @racket[pretty-write].}
@defproc[(set-interactive-print-handler [port output-port?]) void?]{
@defproc[(set-interactive-print-handler
[port output-port?]
[#:snip-handler snip-handler
(or/c #f (-> (is-a?/c snip%) output-port? any))
#f])
void?]{
Like @racket[set-interactive-display-handler], but sets the
@racket[port-print-handler].}
@racket[port-print-handler] and uses @racket[pretty-print].}

8
gui-lib/framework/main.rkt
View File

@ -183,6 +183,14 @@
(v)
@{Recognizes the result of @racket[text:make-snip-special].})
(proc-doc/names
text:send-snip-to-port
(-> (is-a?/c snip%) output-port? void?)
(snip port)
@{Sends @racket[snip] to @racket[port] by using @racket[text:make-snip-special],
handling a few special cases for performance and backwards compatibility
reasons.})
(proc-doc/names
number-snip:make-repeating-decimal-snip
(real? boolean? . -> . (is-a?/c snip%))

3
gui-lib/framework/private/sig.rkt
View File

@ -259,7 +259,8 @@
range-color
make-snip-special
snip-special?))
snip-special?
send-snip-to-port))
(define-signature canvas-class^
(basic<%>

29
gui-lib/framework/private/text.rkt
View File

@ -12,6 +12,7 @@
"autocomplete.rkt"
mred/mred-sig
mrlib/interactive-value-port
(prefix-in image-core: mrlib/image-core)
racket/list
"logging-timer.rkt"
"coroutine.rkt"
@ -2866,8 +2867,8 @@
;; don't want to set the port-print-handler here;
;; instead drracket sets the global-port-print-handler
;; to catch fractions and the like
(set-interactive-write-handler port)
(set-interactive-display-handler port))])
(set-interactive-write-handler port #:snip-handler send-snip-to-port)
(set-interactive-display-handler port #:snip-handler send-snip-to-port))])
(install-handlers out-port)
(install-handlers err-port)
(install-handlers value-port))))
@ -3006,6 +3007,30 @@
(define in-port (make-in-port-with-a-name (get-port-name)))
(define in-box-port (make-in-box-port-with-a-name (get-port-name)))))
(define (send-snip-to-port value port)
(cond
[(image-core:image? value)
;; do this computation here so that any failures
;; during drawing happen under the user's custodian
(image-core:compute-image-cache value)
;; once that is done, we trust the value not to run
;; any code that the user wrote, so just send it over
(write-special value port)]
[else
(define str (format "~s" value))
(cond
;; special case these snips as they don't work properly
;; without this and we aren't ready to break them yet
;; and image-core:image? should be safe-- there is no user
;; code in those images to fail
[(or (regexp-match? #rx"plot-snip%" str)
(regexp-match? #rx"pict3d%" str))
(write-special (send value copy) port)]
[else
(write-special (make-snip-special (send value copy)) port)])])
(void))
(define input-box<%>
(interface ((class->interface text%))
))

2
gui-lib/info.rkt
View File

@ -30,4 +30,4 @@
(define pkg-authors '(mflatt robby))
(define version "1.25")
(define version "1.26")

9
gui-lib/mrlib/image-core.rkt
View File

@ -30,6 +30,7 @@ has been moved out).
"private/image-core-snipclass.rkt"
"private/regmk.rkt"
racket/snip
(prefix-in : racket/base)
(prefix-in cis: "cache-image-snip.rkt"))
@ -454,9 +455,11 @@ has been moved out).
(set-box/f! lspace 0)
(set-box/f! rspace 0)))
(define/override (write f)
(let ([bytes (string->bytes/utf-8 (format "~s" (list shape bb pinhole)))])
(send f put (bytes-length bytes) bytes)))
(define/override (write f)
(define bp (open-output-bytes))
(:write (list shape bb pinhole) bp)
(define bytes (get-output-bytes bp))
(send f put (bytes-length bytes) bytes))
(super-new)

38
gui-lib/mrlib/interactive-value-port.rkt
View File

@ -1,7 +1,8 @@
(module interactive-value-port mzscheme
(require mzlib/pretty
mred
mzlib/class
#lang racket/base
(require racket/pretty
racket/gui/base
racket/class
"syntax-browser.rkt")
(provide set-interactive-display-handler
set-interactive-write-handler
@ -10,7 +11,7 @@
(define op (current-output-port))
(define (oprintf . x) (apply fprintf op x))
(define (set-interactive-display-handler port)
(define (set-interactive-display-handler port #:snip-handler [snip-handler #f])
(let ([original-port-display-handler (port-display-handler port)])
(port-display-handler
port
@ -18,19 +19,19 @@
(cond
[(string? val) (original-port-display-handler val port)]
[else
(do-printing pretty-display val port)])))))
(do-printing pretty-display val port snip-handler)])))))
(define (set-interactive-write-handler port)
(define (set-interactive-write-handler port #:snip-handler [snip-handler #f])
(port-write-handler
port
(λ (val port)
(do-printing pretty-print val port))))
(do-printing pretty-print val port snip-handler))))
(define (set-interactive-print-handler port)
(define (set-interactive-print-handler port #:snip-handler [snip-handler #f])
(port-print-handler
port
(λ (val port)
(do-printing pretty-print val port))))
(do-printing pretty-print val port snip-handler))))
(define (use-number-snip? x)
(and #f
@ -41,7 +42,7 @@
(define default-pretty-print-current-style-table (pretty-print-current-style-table))
(define (do-printing pretty value port)
(define (do-printing pretty value port snip-handler)
(parameterize (;; these handlers aren't used, but are set to override the user's settings
[pretty-print-print-line (λ (line-number op old-line dest-columns)
(when (and (not (equal? line-number 0))
@ -70,22 +71,19 @@
(cond
[(not (port-writes-special? port)) #f]
[(is-a? value snip%) 1]
;[(use-number-snip? value) 1]
[(syntax? value) 1]
[else #f]))]
[pretty-print-print-hook
(λ (value display? port)
(cond
[(is-a? value snip%)
(write-special value port)
1]
#;
[(use-number-snip? value)
(write-special
(number-snip:make-repeating-decimal-snip value #f)
port)
(cond
[snip-handler
(snip-handler value port)]
[else
(write-special value port)])
1]
[(syntax? value)
(write-special (render-syntax/snip value))]
[else (void)]))])
(pretty value port))))
(pretty value port)))