Skip to content

Commit 2c1e16a

Browse files
committed
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.
1 parent 615b2eb commit 2c1e16a

File tree

1 file changed

+40
-31
lines changed

1 file changed

+40
-31
lines changed

htdp-lib/stepper/private/mred-extensions.rkt

Lines changed: 40 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77
images/compile-time
88
string-constants
99
pict
10+
simple-tree-text-markup/data
1011
(for-syntax images/icons/control images/icons/style))
1112

1213
(provide
@@ -178,7 +179,16 @@
178179
(inherit get-dc)
179180

180181
(define/private (format-sexp sexp)
181-
(define text-port (open-output-text-editor this))
182+
(define text-port
183+
(open-output-text-editor this 'end
184+
; need to handle number-markup
185+
(lambda (x)
186+
(if (number-markup? x)
187+
(f:number-snip:number->string/snip (number-markup-number x)
188+
#:exact-prefix (number-markup-exact-prefix x)
189+
#:inexact-prefix (number-markup-inexact-prefix x)
190+
#:fraction-view (number-markup-fraction-view x))
191+
x))))
182192

183193
(parameterize
184194
([pretty-print-show-inexactness show-inexactness?]
@@ -187,38 +197,37 @@
187197

188198
; the pretty-print-size-hook decides whether this object should be printed by the new pretty-print-hook
189199
[pretty-print-size-hook
190-
(lambda (value display? port)
191-
(let ([looked-up (hash-ref highlight-table value (lambda () #f))])
192-
(cond
193-
[(is-a? value snip%)
194-
;; Calculate the effective width of the snip, so that
195-
;; too-long lines (as a result of large snips) are broken
196-
;; correctly. When the snip is actusally inserted, its width
197-
;; will be determined by `(send snip get-count)', but the number
198-
;; returned here triggers line breaking in the pretty printer.
199-
(let ([dc (get-dc)]
200-
[wbox (box 0)])
201-
(send value get-extent dc 0 0 wbox #f #f #f #f #f)
202-
(let-values ([(xw dc dc2 dc3) (send dc get-text-extent "x")])
203-
(max 1 (inexact->exact (ceiling (/ (unbox wbox) xw))))))]
204-
[(and looked-up (not (eq? looked-up 'non-confusable)))
205-
(string-length (format "~s" (car looked-up)))]
206-
[else #f])))]
200+
(let ([language-pretty-print-size-hook (pretty-print-size-hook)])
201+
(lambda (value display? port)
202+
(let ([looked-up (hash-ref highlight-table value (lambda () #f))])
203+
(cond
204+
[(is-a? value snip%)
205+
;; Calculate the effective width of the snip, so that
206+
;; too-long lines (as a result of large snips) are broken
207+
;; correctly. When the snip is actusally inserted, its width
208+
;; will be determined by `(send snip get-count)', but the number
209+
;; returned here triggers line breaking in the pretty printer.
210+
(let ([dc (get-dc)]
211+
[wbox (box 0)])
212+
(send value get-extent dc 0 0 wbox #f #f #f #f #f)
213+
(let-values ([(xw dc dc2 dc3) (send dc get-text-extent "x")])
214+
(max 1 (inexact->exact (ceiling (/ (unbox wbox) xw))))))]
215+
[(and looked-up (not (eq? looked-up 'non-confusable)))
216+
(language-pretty-print-size-hook (car looked-up) display? port)]
217+
[else #f]))))]
207218

208219
[pretty-print-print-hook
209-
; this print-hook is called for confusable highlights and for images.
210-
(lambda (value display? port)
211-
(let ([to-display (cond
212-
[(hash-ref highlight-table value (lambda () #f)) => car]
213-
[else value])])
214-
(cond
215-
[(is-a? to-display snip%)
216-
(write-special (send to-display copy) port) (set-last-style)]
217-
[else
218-
;; there's already code somewhere else to handle this; this seems like a bit of a hack.
219-
(when (and (number? to-display) (inexact? to-display) (pretty-print-show-inexactness))
220-
(write-string "#i" port))
221-
(write-string (format "~s" to-display) port)])))]
220+
(let ([language-pretty-print-print-hook (pretty-print-print-hook)])
221+
; this print-hook is called for confusable highlights and for images.
222+
(lambda (value display? port)
223+
(let ([to-display (cond
224+
[(hash-ref highlight-table value (lambda () #f)) => car]
225+
[else value])])
226+
(cond
227+
[(is-a? to-display snip%)
228+
(write-special (send to-display copy) port) (set-last-style)]
229+
[else
230+
(language-pretty-print-print-hook to-display display? port)]))))]
222231
[pretty-print-print-line
223232
(lambda (number port old-length dest-columns)
224233
(when (and number (not (eq? number 0)))

0 commit comments

Comments
 (0)