fixed PR 8213

svn: r3995
This commit is contained in:
Robby Findler 2006-08-09 03:42:21 +00:00
parent 2edea47556
commit 2d8f5f4a21
2 changed files with 12 additions and 22 deletions

View File

@ -45,6 +45,7 @@
[pretty-print-size-hook
(λ (value display? port)
(cond
[(not (port-writes-special? port)) #f]
[(is-a? value snip%) 1]
;[(use-number-snip? value) 1]
[(syntax? value) 1]

View File

@ -67,9 +67,6 @@ needed to really make this work:
(define info-text (make-object text%))
(define info-port (make-text-port info-text))
;; assume that there aren't any eq? sub structures, only eq? flat stuff (symbols, etc)
;; this is guaranteed by syntax-object->datum/ht
;; range-start-ht : hash-table[obj -o> number]
(define range-start-ht (make-hash-table))
@ -118,6 +115,17 @@ needed to really make this work:
[else
(loop val enclosing-stx)]))
(pop!))]
[(vector? val)
(push!)
(record val enclosing-stx)
(begin0
(let lst-loop ([val (vector->list val)])
(cond
[(pair? val)
(cons (loop (car val) #f)
(lst-loop (cdr val)))]
[(null? val) '()]))
(pop!))]
[else
(push!)
(record val enclosing-stx)
@ -507,25 +515,6 @@ needed to really make this work:
(send down-click-bitmap get-width)))
(define arrow-snip-cursor (make-object cursor% 'arrow))
;; syntax-object->datum/ht : stx -> (values any hash-table[any -o> syntax])
;; the resulting hash-table maps from the each sub-object's to it's syntax.
(define (syntax-object->datum/ht stx)
(let ([ht (make-hash-table)])
(values (let loop ([obj stx])
(cond
[(syntax? obj)
(let ([lp-datum (loop (syntax-e obj))])
(hash-table-put! ht lp-datum obj)
lp-datum)]
[(pair? obj)
(cons (loop (car obj))
(loop (cdr obj)))]
[(vector? obj)
(list->vector (map loop (vector->list obj)))]
[else
obj]))
ht)))
(define (syntax-properties stx)
(let ([is-property? (λ (prop) (syntax-property stx prop))])
(filter is-property?