From c3f4b5dedd2107f5adce30e9947343f734164374 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 28 May 2016 09:02:50 -0500 Subject: [PATCH] generalize set-interactive-write-handler & use it in text:ports-mixin 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) --- .../scribblings/interactive-value-port.scrbl | 58 ++++++++++++------- gui-lib/framework/main.rkt | 8 +++ gui-lib/framework/private/sig.rkt | 3 +- gui-lib/framework/private/text.rkt | 29 +++++++++- gui-lib/info.rkt | 2 +- gui-lib/mrlib/image-core.rkt | 9 ++- gui-lib/mrlib/interactive-value-port.rkt | 38 ++++++------ 7 files changed, 100 insertions(+), 47 deletions(-) diff --git a/gui-doc/mrlib/scribblings/interactive-value-port.scrbl b/gui-doc/mrlib/scribblings/interactive-value-port.scrbl index 768718e1..fb5cd8e7 100644 --- a/gui-doc/mrlib/scribblings/interactive-value-port.scrbl +++ b/gui-doc/mrlib/scribblings/interactive-value-port.scrbl @@ -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].} diff --git a/gui-lib/framework/main.rkt b/gui-lib/framework/main.rkt index 946be03a..df02157b 100644 --- a/gui-lib/framework/main.rkt +++ b/gui-lib/framework/main.rkt @@ -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%)) diff --git a/gui-lib/framework/private/sig.rkt b/gui-lib/framework/private/sig.rkt index 8653c3d6..97ae42df 100644 --- a/gui-lib/framework/private/sig.rkt +++ b/gui-lib/framework/private/sig.rkt @@ -259,7 +259,8 @@ range-color make-snip-special - snip-special?)) + snip-special? + send-snip-to-port)) (define-signature canvas-class^ (basic<%> diff --git a/gui-lib/framework/private/text.rkt b/gui-lib/framework/private/text.rkt index e7e52700..1e99ab3a 100644 --- a/gui-lib/framework/private/text.rkt +++ b/gui-lib/framework/private/text.rkt @@ -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%)) )) diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt index b4b508b1..e275ac6b 100644 --- a/gui-lib/info.rkt +++ b/gui-lib/info.rkt @@ -30,4 +30,4 @@ (define pkg-authors '(mflatt robby)) -(define version "1.25") +(define version "1.26") diff --git a/gui-lib/mrlib/image-core.rkt b/gui-lib/mrlib/image-core.rkt index 632bb551..108e598d 100644 --- a/gui-lib/mrlib/image-core.rkt +++ b/gui-lib/mrlib/image-core.rkt @@ -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) diff --git a/gui-lib/mrlib/interactive-value-port.rkt b/gui-lib/mrlib/interactive-value-port.rkt index 566faf28..f7e0e63f 100644 --- a/gui-lib/mrlib/interactive-value-port.rkt +++ b/gui-lib/mrlib/interactive-value-port.rkt @@ -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)))