From e788caa4abe38bc05ab8cddf68af0d45ff5dbae3 Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Tue, 29 Apr 2025 12:55:56 +0200 Subject: [PATCH 1/5] 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/5] 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/5] 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) From 897b9ac3e0139193034ae4b1f24fbe8b6261199a Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Mon, 2 Feb 2026 07:55:08 +0100 Subject: [PATCH 4/5] Get the language's pretty-print hooks via a non-mutating method --- htdp-lib/lang/htdp-langs.rkt | 35 ++++++++++++++------ htdp-lib/lang/private/sl-stepper-button.rkt | 18 ++++++++-- htdp-lib/lang/stepper-language-interface.rkt | 4 ++- htdp-lib/stepper/private/mred-extensions.rkt | 18 ++++++---- htdp-lib/stepper/private/view-controller.rkt | 13 +++++++- htdp-lib/stepper/stepper-tool.rkt | 4 +++ 6 files changed, 69 insertions(+), 23 deletions(-) diff --git a/htdp-lib/lang/htdp-langs.rkt b/htdp-lib/lang/htdp-langs.rkt index 0d5c8a922..84fa0c406 100644 --- a/htdp-lib/lang/htdp-langs.rkt +++ b/htdp-lib/lang/htdp-langs.rkt @@ -735,17 +735,30 @@ (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?)))) + (define/override (stepper:pretty-print-hooks settings previous-size-hook previous-print-hook) + ;; avoid mutating the parameters in the current thread + ;; (the stepper will typically run in the same thread on subsequent invocations) + (let ((channel (make-channel))) + (thread + (lambda () + (parameterize ((pretty-print-size-hook previous-size-hook) + (pretty-print-print-hook previous-print-hook)) + (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?))) + (channel-put + channel + (list (pretty-print-size-hook) + (pretty-print-print-hook)))))) + (apply values (channel-get channel)))) + (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 17ef12122..014825a4d 100644 --- a/htdp-lib/lang/private/sl-stepper-button.rkt +++ b/htdp-lib/lang/private/sl-stepper-button.rkt @@ -49,9 +49,21 @@ (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:pretty-print-hooks) + (define (stepper:pretty-print-hooks settings previous-size-hook previous-print-hook) + ;; avoid mutating the parameters in the current thread + ;; (the stepper will typically run in the same thread on subsequent invocations) + (let ((channel (make-channel))) + (thread + (lambda () + (parameterize ((pretty-print-size-hook previous-size-hook) + (pretty-print-print-hook previous-print-hook)) + (configure/settings settings) + (channel-put + channel + (list (pretty-print-size-hook) + (pretty-print-print-hook)))))) + (apply values (channel-get channel)))) (public stepper:render-to-sexp) (define (stepper:render-to-sexp val language-level) diff --git a/htdp-lib/lang/stepper-language-interface.rkt b/htdp-lib/lang/stepper-language-interface.rkt index 89d103e7a..6606990ed 100644 --- a/htdp-lib/lang/stepper-language-interface.rkt +++ b/htdp-lib/lang/stepper-language-interface.rkt @@ -10,5 +10,7 @@ stepper:show-lambdas-as-lambdas? stepper:show-inexactness? stepper:show-consumed-and/or-clauses? - stepper:configure-rendering + ; takes settings, previous -size-hook and -print-hook as arguments + ; returns the language's -size-hook, -print-hook + stepper:pretty-print-hooks stepper:render-to-sexp))) diff --git a/htdp-lib/stepper/private/mred-extensions.rkt b/htdp-lib/stepper/private/mred-extensions.rkt index 1f44c860d..c43207de7 100644 --- a/htdp-lib/stepper/private/mred-extensions.rkt +++ b/htdp-lib/stepper/private/mred-extensions.rkt @@ -138,7 +138,10 @@ (define stepper-sub-text% (class f:text:standard-style-list% - (init-field exps highlight-color show-inexactness? print-boolean-long-form?) + (init-field exps highlight-color + language-pretty-print-size-hook + language-pretty-print-print-hook + show-inexactness? print-boolean-long-form?) (inherit insert get-style-list set-style-list change-style highlight-range last-position lock erase begin-edit-sequence end-edit-sequence get-start-position select-all clear) @@ -190,9 +193,6 @@ #: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] @@ -373,7 +373,8 @@ (define stepper-text% (class f:text:standard-style-list% - (init-field left-side right-side show-inexactness? print-boolean-long-form?) + (init-field left-side right-side show-inexactness? print-boolean-long-form? + language-pretty-print-size-hook language-pretty-print-print-hook) (inherit find-snip insert change-style highlight-range last-position lock erase auto-wrap begin-edit-sequence end-edit-sequence get-start-position get-style-list set-style-list @@ -440,8 +441,11 @@ (make-object stepper-sub-error-text% error-or-exps)] [else (make-object stepper-sub-text% - error-or-exps highlight-color show-inexactness? - print-boolean-long-form?)]))) + error-or-exps highlight-color + language-pretty-print-size-hook + language-pretty-print-print-hook + show-inexactness? + print-boolean-long-form?)]))) (setup-editor-snip before-snip left-side 'stepper:redex-highlight-color) (setup-editor-snip after-snip right-side 'stepper:reduct-highlight-color) diff --git a/htdp-lib/stepper/private/view-controller.rkt b/htdp-lib/stepper/private/view-controller.rkt index 8bf6ad934..1c796a8db 100644 --- a/htdp-lib/stepper/private/view-controller.rkt +++ b/htdp-lib/stepper/private/view-controller.rkt @@ -10,6 +10,8 @@ (require racket/class racket/match racket/list + (only-in racket/pretty + pretty-print-size-hook pretty-print-print-hook) drracket/tool mred string-constants @@ -353,6 +355,10 @@ (set! disable-runaway-counter #t) #t])) + (define-values (language-pretty-print-size-hook + language-pretty-print-print-hook) + (send language-level stepper:pretty-print-hooks simple-settings + (pretty-print-size-hook) (pretty-print-print-hook))) ;; translates a result into a step ;; format-result : step-result -> step? @@ -362,6 +368,8 @@ (Step (new x:stepper-text% [left-side (map sstx-s pre-exps)] [right-side (map sstx-s post-exps)] + [language-pretty-print-size-hook language-pretty-print-size-hook] + [language-pretty-print-print-hook language-pretty-print-print-hook] [show-inexactness? (send language-level stepper:show-inexactness?)] [print-boolean-long-form? @@ -372,6 +380,8 @@ (Step (new x:stepper-text% [left-side (map sstx-s pre-exps)] [right-side err-msg] + [language-pretty-print-size-hook language-pretty-print-size-hook] + [language-pretty-print-print-hook language-pretty-print-print-hook] [show-inexactness? (send language-level stepper:show-inexactness?)] [print-boolean-long-form? @@ -382,6 +392,8 @@ (Step (new x:stepper-text% [left-side null] [right-side err-msg] + [language-pretty-print-size-hook language-pretty-print-size-hook] + [language-pretty-print-print-hook language-pretty-print-print-hook] [show-inexactness? (send language-level stepper:show-inexactness?)] [print-boolean-long-form? @@ -410,7 +422,6 @@ (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 f4c260a27..234c13576 100644 --- a/htdp-lib/stepper/stepper-tool.rkt +++ b/htdp-lib/stepper/stepper-tool.rkt @@ -54,6 +54,10 @@ (define (stepper:configure-rendering settings) (error 'stepper:configure-rendering "this must be overridden")) + (public stepper:pretty-print-hooks) + (define (stepper:pretty-print-hooks settings previous-size-hook previous-print-hook) + (error 'stepper:configure-rendering "this must be overridden")) + (public stepper:render-to-sexp) (define (stepper:render-to-sexp val language-level) (when (boolean? val) From 8ea7ee9d1970df07f1ac4807379309360c727c81 Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Mon, 2 Feb 2026 18:15:06 +0100 Subject: [PATCH 5/5] Use thread-wait instead of a channel. --- htdp-lib/lang/htdp-langs.rkt | 10 ++++----- htdp-lib/lang/private/sl-stepper-button.rkt | 23 ++++++++------------- 2 files changed, 13 insertions(+), 20 deletions(-) diff --git a/htdp-lib/lang/htdp-langs.rkt b/htdp-lib/lang/htdp-langs.rkt index 84fa0c406..0767079fd 100644 --- a/htdp-lib/lang/htdp-langs.rkt +++ b/htdp-lib/lang/htdp-langs.rkt @@ -738,7 +738,7 @@ (define/override (stepper:pretty-print-hooks settings previous-size-hook previous-print-hook) ;; avoid mutating the parameters in the current thread ;; (the stepper will typically run in the same thread on subsequent invocations) - (let ((channel (make-channel))) + (thread-wait (thread (lambda () (parameterize ((pretty-print-size-hook previous-size-hook) @@ -753,11 +753,9 @@ (get-abbreviate-cons-as-list) (get-use-function-output-syntax?) (get-output-function-instead-of-lambda?))) - (channel-put - channel - (list (pretty-print-size-hook) - (pretty-print-print-hook)))))) - (apply values (channel-get channel)))) + (values (pretty-print-size-hook) + (pretty-print-print-hook)))) + #:keep 'results))) (super-new)) (class* % () diff --git a/htdp-lib/lang/private/sl-stepper-button.rkt b/htdp-lib/lang/private/sl-stepper-button.rkt index 014825a4d..329e6e5b7 100644 --- a/htdp-lib/lang/private/sl-stepper-button.rkt +++ b/htdp-lib/lang/private/sl-stepper-button.rkt @@ -53,17 +53,15 @@ (define (stepper:pretty-print-hooks settings previous-size-hook previous-print-hook) ;; avoid mutating the parameters in the current thread ;; (the stepper will typically run in the same thread on subsequent invocations) - (let ((channel (make-channel))) - (thread - (lambda () - (parameterize ((pretty-print-size-hook previous-size-hook) - (pretty-print-print-hook previous-print-hook)) - (configure/settings settings) - (channel-put - channel - (list (pretty-print-size-hook) - (pretty-print-print-hook)))))) - (apply values (channel-get channel)))) + (thread-wait + (thread + (lambda () + (parameterize ((pretty-print-size-hook previous-size-hook) + (pretty-print-print-hook previous-print-hook)) + (configure/settings settings) + (values (pretty-print-size-hook) + (pretty-print-print-hook)))) + #:keep 'results))) (public stepper:render-to-sexp) (define (stepper:render-to-sexp val language-level) @@ -79,6 +77,3 @@ (print val port))) (super-instantiate ()))) - - -