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

racket/pretty: replace internal table with `prop:output-port' structs

Browse Source
This commit is contained in:
Matthew Flatt 2012-08-27 12:25:29 -06:00
parent 8a4567f5aa
commit 310945ee73
1 changed files with 16 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/racket/pretty.rkt
View File

@ -305,8 +305,7 @@
(newline p))
(set! first-line? #f)
0)
esc))
p))
esc))))
(define (make-tentative-pretty-print-output-port pport width esc)
(let ([p (make-tentative-output-port pport width esc)])
@ -336,10 +335,10 @@
(lambda (use-line? offset width)
(set! line (add1 line))
(print-line (and use-line? line) p offset width))
void))
p)))
void)))))
(define printing-ports (make-weak-hasheq))
(struct printing-port (port info)
#:property prop:output-port 0)
(define-struct print-port-info (get-content
def-box
@ -350,21 +349,13 @@
esc))
(define (register-printing-port p info)
(hash-set! printing-ports p (make-ephemeron p info)))
(printing-port p info))
(define (register-printing-port-like p pport)
(hash-set! printing-ports p
(make-ephemeron p
(ephemeron-value (hash-ref printing-ports pport)))))
(printing-port p (printing-port-info pport)))
(define (get pport selector)
(let ([e (hash-ref printing-ports pport #f)])
(selector (if e
(ephemeron-value e)
(make-print-port-info
(lambda () null)
(box #t)
void void void void void)))))
(selector (printing-port-info pport)))
(define (printing-port-pre-print pport)
(get pport print-port-info-pre-print))
@ -696,10 +687,10 @@
(port-write-handler p writer)
(port-display-handler p displayer)
(port-print-handler p printer))
(register-printing-port-like p pport)
(let ([p (register-printing-port-like p pport)])
(parameterize ([pretty-printing multi-line?]
[pretty-print-columns (or width 'infinity)])
((custom-write-accessor obj) obj p (or qd (not display?)))))))
((custom-write-accessor obj) obj p (or qd (not display?))))))))
;; ------------------------------------------------------------