From e788caa4abe38bc05ab8cddf68af0d45ff5dbae3 Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Tue, 29 Apr 2025 12:55:56 +0200 Subject: [PATCH 1/3] In stepper, respect the number-display format of the language. To that end, call the underlying pretty-print-print-handler instead of format, and transform write-special'ed number markup into the corresponding snip. --- htdp-lib/stepper/private/mred-extensions.rkt | 75 ++++++++++++-------- 1 file changed, 44 insertions(+), 31 deletions(-) diff --git a/htdp-lib/stepper/private/mred-extensions.rkt b/htdp-lib/stepper/private/mred-extensions.rkt index 96714d6c6..53e04c6dd 100644 --- a/htdp-lib/stepper/private/mred-extensions.rkt +++ b/htdp-lib/stepper/private/mred-extensions.rkt @@ -7,6 +7,7 @@ images/compile-time string-constants pict + simple-tree-text-markup/data (for-syntax images/icons/control images/icons/style)) (provide @@ -178,7 +179,16 @@ (inherit get-dc) (define/private (format-sexp sexp) - (define text-port (open-output-text-editor this)) + (define text-port + (open-output-text-editor this 'end + ; need to handle number-markup + (lambda (x) + (if (number-markup? x) + (f:number-snip:number->string/snip (number-markup-number x) + #:exact-prefix (number-markup-exact-prefix x) + #:inexact-prefix (number-markup-inexact-prefix x) + #:fraction-view (number-markup-fraction-view x)) + x)))) (parameterize ([pretty-print-show-inexactness show-inexactness?] @@ -187,38 +197,37 @@ ; the pretty-print-size-hook decides whether this object should be printed by the new pretty-print-hook [pretty-print-size-hook - (lambda (value display? port) - (let ([looked-up (hash-ref highlight-table value (lambda () #f))]) - (cond - [(is-a? value snip%) - ;; Calculate the effective width of the snip, so that - ;; too-long lines (as a result of large snips) are broken - ;; correctly. When the snip is actusally inserted, its width - ;; will be determined by `(send snip get-count)', but the number - ;; returned here triggers line breaking in the pretty printer. - (let ([dc (get-dc)] - [wbox (box 0)]) - (send value get-extent dc 0 0 wbox #f #f #f #f #f) - (let-values ([(xw dc dc2 dc3) (send dc get-text-extent "x")]) - (max 1 (inexact->exact (ceiling (/ (unbox wbox) xw))))))] - [(and looked-up (not (eq? looked-up 'non-confusable))) - (string-length (format "~s" (car looked-up)))] - [else #f])))] + (let ([language-pretty-print-size-hook (pretty-print-size-hook)]) + (lambda (value display? port) + (let ([looked-up (hash-ref highlight-table value (lambda () #f))]) + (cond + [(is-a? value snip%) + ;; Calculate the effective width of the snip, so that + ;; too-long lines (as a result of large snips) are broken + ;; correctly. When the snip is actusally inserted, its width + ;; will be determined by `(send snip get-count)', but the number + ;; returned here triggers line breaking in the pretty printer. + (let ([dc (get-dc)] + [wbox (box 0)]) + (send value get-extent dc 0 0 wbox #f #f #f #f #f) + (let-values ([(xw dc dc2 dc3) (send dc get-text-extent "x")]) + (max 1 (inexact->exact (ceiling (/ (unbox wbox) xw))))))] + [(and looked-up (not (eq? looked-up 'non-confusable))) + (language-pretty-print-size-hook (car looked-up) display? port)] + [else #f]))))] [pretty-print-print-hook - ; this print-hook is called for confusable highlights and for images. - (lambda (value display? port) - (let ([to-display (cond - [(hash-ref highlight-table value (lambda () #f)) => car] - [else value])]) - (cond - [(is-a? to-display snip%) - (write-special (send to-display copy) port) (set-last-style)] - [else - ;; there's already code somewhere else to handle this; this seems like a bit of a hack. - (when (and (number? to-display) (inexact? to-display) (pretty-print-show-inexactness)) - (write-string "#i" port)) - (write-string (format "~s" to-display) port)])))] + (let ([language-pretty-print-print-hook (pretty-print-print-hook)]) + ; this print-hook is called for confusable highlights and for images. + (lambda (value display? port) + (let ([to-display (cond + [(hash-ref highlight-table value (lambda () #f)) => car] + [else value])]) + (cond + [(is-a? to-display snip%) + (write-special (send to-display copy) port) (set-last-style)] + [else + (language-pretty-print-print-hook to-display display? port)]))))] [pretty-print-print-line (lambda (number port old-length dest-columns) (when (and number (not (eq? number 0))) @@ -254,10 +263,14 @@ (select-all) (clear) (reset-style) + (define start (get-start-position)) (for ([exp stripped-exps] [i (in-naturals)]) (unless (= i 0) (insert #\newline)) (format-sexp exp)) + (define end (get-start-position)) + (change-style (send (get-style-list) find-named-style "Standard") + start end) (end-edit-sequence) (lock #t)) From 41a003825fb2b0161a30ea64428ba354e592b648 Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Tue, 20 Jan 2026 16:37:59 +0100 Subject: [PATCH 2/3] Properly configure the language output settings in the stepper. This is needed to make the previous commit work. --- htdp-lib/lang/htdp-langs.rkt | 14 ++++ htdp-lib/lang/private/sl-stepper-button.rkt | 4 ++ htdp-lib/lang/stepper-language-interface.rkt | 1 + htdp-lib/stepper/private/mred-extensions.rkt | 72 ++++++++++++-------- htdp-lib/stepper/private/view-controller.rkt | 1 + htdp-lib/stepper/stepper-tool.rkt | 4 ++ 6 files changed, 66 insertions(+), 30 deletions(-) diff --git a/htdp-lib/lang/htdp-langs.rkt b/htdp-lib/lang/htdp-langs.rkt index 6e2fcbac9..0d5c8a922 100644 --- a/htdp-lib/lang/htdp-langs.rkt +++ b/htdp-lib/lang/htdp-langs.rkt @@ -726,12 +726,26 @@ (define (stepper-settings-language %) (if (implementation? % stepper-language<%>) (class* % (stepper-language<%>) + (inherit get-abbreviate-cons-as-list + get-use-function-output-syntax? + get-output-function-instead-of-lambda?) (init-field stepper:supported) (init-field stepper:enable-let-lifting) (init-field stepper:show-lambdas-as-lambdas) (define/override (stepper:supported?) stepper:supported) (define/override (stepper:enable-let-lifting?) stepper:enable-let-lifting) (define/override (stepper:show-lambdas-as-lambdas?) stepper:show-lambdas-as-lambdas) + (define/override (stepper:configure-rendering settings) + (configure/settings + (sl-runtime-settings (drscheme:language:simple-settings-printing-style settings) + (drscheme:language:simple-settings-fraction-style settings) + (drscheme:language:simple-settings-show-sharing settings) + (drscheme:language:simple-settings-insert-newlines settings) + (htdp-lang-settings-tracing? settings) + (htdp-lang-settings-true/false/empty-as-ids? settings) + (get-abbreviate-cons-as-list) + (get-use-function-output-syntax?) + (get-output-function-instead-of-lambda?)))) (super-new)) (class* % () (init stepper:supported) diff --git a/htdp-lib/lang/private/sl-stepper-button.rkt b/htdp-lib/lang/private/sl-stepper-button.rkt index 99e293fe4..fa8153d03 100644 --- a/htdp-lib/lang/private/sl-stepper-button.rkt +++ b/htdp-lib/lang/private/sl-stepper-button.rkt @@ -49,6 +49,10 @@ (public stepper:show-consumed-and/or-clauses?) (define (stepper:show-consumed-and/or-clauses?) #t) + (public stepper:configure-rendering) + (define (stepper:configure-rendering settings) + (configure/settings settings)) + (public stepper:render-to-sexp) (define (stepper:render-to-sexp val settings language-level) (when (boolean? val) diff --git a/htdp-lib/lang/stepper-language-interface.rkt b/htdp-lib/lang/stepper-language-interface.rkt index 92666384a..89d103e7a 100644 --- a/htdp-lib/lang/stepper-language-interface.rkt +++ b/htdp-lib/lang/stepper-language-interface.rkt @@ -10,4 +10,5 @@ stepper:show-lambdas-as-lambdas? stepper:show-inexactness? stepper:show-consumed-and/or-clauses? + stepper:configure-rendering stepper:render-to-sexp))) diff --git a/htdp-lib/stepper/private/mred-extensions.rkt b/htdp-lib/stepper/private/mred-extensions.rkt index 53e04c6dd..1f44c860d 100644 --- a/htdp-lib/stepper/private/mred-extensions.rkt +++ b/htdp-lib/stepper/private/mred-extensions.rkt @@ -189,7 +189,10 @@ #:inexact-prefix (number-markup-inexact-prefix x) #:fraction-view (number-markup-fraction-view x)) x)))) - + + (define language-pretty-print-size-hook (pretty-print-size-hook)) + (define language-pretty-print-print-hook (pretty-print-print-hook)) + (parameterize ([pretty-print-show-inexactness show-inexactness?] [pretty-print-columns pretty-printed-width] @@ -197,37 +200,46 @@ ; the pretty-print-size-hook decides whether this object should be printed by the new pretty-print-hook [pretty-print-size-hook - (let ([language-pretty-print-size-hook (pretty-print-size-hook)]) - (lambda (value display? port) - (let ([looked-up (hash-ref highlight-table value (lambda () #f))]) - (cond - [(is-a? value snip%) - ;; Calculate the effective width of the snip, so that - ;; too-long lines (as a result of large snips) are broken - ;; correctly. When the snip is actusally inserted, its width - ;; will be determined by `(send snip get-count)', but the number - ;; returned here triggers line breaking in the pretty printer. - (let ([dc (get-dc)] - [wbox (box 0)]) - (send value get-extent dc 0 0 wbox #f #f #f #f #f) - (let-values ([(xw dc dc2 dc3) (send dc get-text-extent "x")]) - (max 1 (inexact->exact (ceiling (/ (unbox wbox) xw))))))] - [(and looked-up (not (eq? looked-up 'non-confusable))) - (language-pretty-print-size-hook (car looked-up) display? port)] - [else #f]))))] + (lambda (value display? port) + (let ([looked-up (hash-ref highlight-table value (lambda () #f))]) + (cond + [(is-a? value snip%) + ;; Calculate the effective width of the snip, so that + ;; too-long lines (as a result of large snips) are broken + ;; correctly. When the snip is actusally inserted, its width + ;; will be determined by `(send snip get-count)', but the number + ;; returned here triggers line breaking in the pretty printer. + (let ([dc (get-dc)] + [wbox (box 0)]) + (send value get-extent dc 0 0 wbox #f #f #f #f #f) + (let-values ([(xw dc dc2 dc3) (send dc get-text-extent "x")]) + (max 1 (inexact->exact (ceiling (/ (unbox wbox) xw))))))] + [(and looked-up (not (eq? looked-up 'non-confusable))) + (or + ; note that this may return #f, but we still want the print-hook to handle it + (language-pretty-print-size-hook (car looked-up) display? port) + (string-length (format "~s" (car looked-up))))] + [else + (language-pretty-print-size-hook value display? port)])))] [pretty-print-print-hook - (let ([language-pretty-print-print-hook (pretty-print-print-hook)]) - ; this print-hook is called for confusable highlights and for images. - (lambda (value display? port) - (let ([to-display (cond - [(hash-ref highlight-table value (lambda () #f)) => car] - [else value])]) - (cond - [(is-a? to-display snip%) - (write-special (send to-display copy) port) (set-last-style)] - [else - (language-pretty-print-print-hook to-display display? port)]))))] + ; this print-hook is called for confusable highlights and for images. + (lambda (value display? port) + (let ([looked-up (hash-ref highlight-table value (lambda () #f))]) + (cond + [(is-a? value snip%) + (write-special (send value copy) port) (set-last-style)] + [(and looked-up (not (eq? looked-up 'non-confusable))) + ; we have to call the size hook *again* to find + ; out if the underlying pretty-print-print-hook + ; can handle this + (define to-display (car looked-up)) + (if (language-pretty-print-size-hook to-display display? port) + (language-pretty-print-print-hook to-display display? port) + (write-string (format "~s" to-display) port))] + [else + (language-pretty-print-print-hook value display? port)])))] + [pretty-print-print-line (lambda (number port old-length dest-columns) (when (and number (not (eq? number 0))) diff --git a/htdp-lib/stepper/private/view-controller.rkt b/htdp-lib/stepper/private/view-controller.rkt index dce0466ad..00f6a4fd6 100644 --- a/htdp-lib/stepper/private/view-controller.rkt +++ b/htdp-lib/stepper/private/view-controller.rkt @@ -410,6 +410,7 @@ (define stepper-frame-eventspace (send s-frame get-eventspace)) ;; START THE MODEL + (send language-level stepper:configure-rendering simple-settings) (start-listener-thread stepper-frame-eventspace) (model:go program-expander-prime diff --git a/htdp-lib/stepper/stepper-tool.rkt b/htdp-lib/stepper/stepper-tool.rkt index 5b73ca124..526471eae 100644 --- a/htdp-lib/stepper/stepper-tool.rkt +++ b/htdp-lib/stepper/stepper-tool.rkt @@ -50,6 +50,10 @@ (public stepper:show-consumed-and/or-clauses?) (define (stepper:show-consumed-and/or-clauses?) #t) + (public stepper:configure-rendering) + (define (stepper:configure-rendering settings) + (error 'stepper:configure-rendering "this must be overridden")) + (public stepper:render-to-sexp) (define (stepper:render-to-sexp val settings language-level) (when (boolean? val) From afe96aea720df9ab85e9410b4886746914e2244c Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Tue, 20 Jan 2026 16:43:08 +0100 Subject: [PATCH 3/3] Remove settings argument from stepper:render-to-sexp. The output settings are configured by setting parameters, so avoid confusion here. --- htdp-lib/lang/private/sl-stepper-button.rkt | 2 +- htdp-lib/stepper/private/view-controller.rkt | 2 +- htdp-lib/stepper/stepper-tool.rkt | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/htdp-lib/lang/private/sl-stepper-button.rkt b/htdp-lib/lang/private/sl-stepper-button.rkt index fa8153d03..17ef12122 100644 --- a/htdp-lib/lang/private/sl-stepper-button.rkt +++ b/htdp-lib/lang/private/sl-stepper-button.rkt @@ -54,7 +54,7 @@ (configure/settings settings)) (public stepper:render-to-sexp) - (define (stepper:render-to-sexp val settings language-level) + (define (stepper:render-to-sexp val language-level) (when (boolean? val) (log-stepper-debug "render-to-sexp got a boolean: ~v\n" val)) (or (and (procedure? val) diff --git a/htdp-lib/stepper/private/view-controller.rkt b/htdp-lib/stepper/private/view-controller.rkt index 00f6a4fd6..8bf6ad934 100644 --- a/htdp-lib/stepper/private/view-controller.rkt +++ b/htdp-lib/stepper/private/view-controller.rkt @@ -72,7 +72,7 @@ ;; render-to-sexp : TST -> sexp (define (render-to-sexp val) (send language-level stepper:render-to-sexp - val simple-settings language-level)) + val language-level)) ;; channel for incoming views (define view-channel (make-async-channel)) diff --git a/htdp-lib/stepper/stepper-tool.rkt b/htdp-lib/stepper/stepper-tool.rkt index 526471eae..f4c260a27 100644 --- a/htdp-lib/stepper/stepper-tool.rkt +++ b/htdp-lib/stepper/stepper-tool.rkt @@ -55,7 +55,7 @@ (error 'stepper:configure-rendering "this must be overridden")) (public stepper:render-to-sexp) - (define (stepper:render-to-sexp val settings language-level) + (define (stepper:render-to-sexp val language-level) (when (boolean? val) (log-stepper-debug "render-to-sexp got a boolean: ~v\n" val)) (or (and (procedure? val)