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