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

Racketifies Redex documentation

Browse Source
This commit is contained in:
Casey Klein 2010-05-12 07:58:08 -05:00
parent 88d1cb2029
commit 7b15edee41
3 changed files with 460 additions and 448 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/redex/gui.rkt
View File

@ -35,6 +35,7 @@
(any/c term-node? . -> . any)) (any/c term-node? . -> . any))
#:pp pp-contract #:pp pp-contract
#:colors (listof (list/c string? string?)) #:colors (listof (list/c string? string?))
#:racket-colors? boolean?
#:scheme-colors? boolean? #:scheme-colors? boolean?
#:layout (-> any/c any/c) #:layout (-> any/c any/c)
#:edge-label-font (or/c #f (is-a?/c font%)) #:edge-label-font (or/c #f (is-a?/c font%))
@ -51,6 +52,8 @@
(any/c term-node? . -> . any)) (any/c term-node? . -> . any))
#:pp pp-contract #:pp pp-contract
#:colors (listof any/c) #:colors (listof any/c)
#:racket-colors? boolean?
#:scheme-colors? boolean?
#:layout (-> any/c any/c) #:layout (-> any/c any/c)
#:edge-label-font (or/c #f (is-a?/c font%)) #:edge-label-font (or/c #f (is-a?/c font%))
#:edge-labels? boolean? #:edge-labels? boolean?

20
collects/redex/private/traces.rkt
View File

@ -131,7 +131,8 @@
#:multiple? [multiple? #f] #:multiple? [multiple? #f]
#:pred [pred (λ (x) #t)] #:pred [pred (λ (x) #t)]
#:pp [pp default-pretty-printer] #:pp [pp default-pretty-printer]
#:scheme-colors? [scheme-colors? #t] #:racket-colors? [racket-colors? #t]
#:scheme-colors? [scheme-colors? racket-colors?]
#:colors [colors '()] #:colors [colors '()]
#:layout [layout void] #:layout [layout void]
#:edge-label-font [edge-label-font #f] #:edge-label-font [edge-label-font #f]
@ -147,6 +148,7 @@
#:multiple? multiple? #:multiple? multiple?
#:pred pred #:pred pred
#:pp pp #:pp pp
#:racket-colors? racket-colors?
#:scheme-colors? scheme-colors? #:scheme-colors? scheme-colors?
#:colors colors #:colors colors
#:layout layout #:layout layout
@ -241,7 +243,8 @@
#:pred [pred (λ (x) #t)] #:pred [pred (λ (x) #t)]
#:pp [pp default-pretty-printer] #:pp [pp default-pretty-printer]
#:colors [colors '()] #:colors [colors '()]
#:scheme-colors? [scheme-colors? #t] #:racket-colors? [racket-colors? #t]
#:scheme-colors? [scheme-colors? racket-colors?]
#:layout [layout void] #:layout [layout void]
#:edge-label-font [edge-label-font #f] #:edge-label-font [edge-label-font #f]
#:edge-labels? [edge-labels? #t] #:edge-labels? [edge-labels? #t]
@ -354,6 +357,7 @@
(dark-text-color) (light-text-color) (dark-text-color) (light-text-color)
(dark-brush-color) (light-brush-color))) (dark-brush-color) (light-brush-color)))
(define code-colors? (and racket-colors? scheme-colors?))
;; only changed on the reduction thread ;; only changed on the reduction thread
;; frontier : (listof (is-a?/c graph-editor-snip%)) ;; frontier : (listof (is-a?/c graph-editor-snip%))
@ -361,7 +365,7 @@
(filter (filter
(λ (x) x) (λ (x) x)
(map (lambda (expr) (apply build-snip (map (lambda (expr) (apply build-snip
snip-cache #f expr pred pp #f scheme-colors? snip-cache #f expr pred pp #f code-colors?
(get-user-char-width user-char-width expr) (get-user-char-width user-char-width expr)
default-colors)) default-colors))
exprs))) exprs)))
@ -432,7 +436,7 @@
dark-pen-color dark-pen-color
light-pen-color) light-pen-color)
(red->colors name)]) (red->colors name)])
(build-snip snip-cache snip sexp pred pp name scheme-colors? (build-snip snip-cache snip sexp pred pp name code-colors?
(get-user-char-width user-char-width sexp) (get-user-char-width user-char-width sexp)
light-arrow-color dark-arrow-color dark-label-color light-label-color light-arrow-color dark-arrow-color dark-label-color light-label-color
dark-pen-color light-pen-color))))))) dark-pen-color light-pen-color)))))))
@ -788,7 +792,7 @@
;; returns #f if a snip corresponding to the expr has already been created. ;; returns #f if a snip corresponding to the expr has already been created.
;; also adds in the links to the parent snip ;; also adds in the links to the parent snip
;; =eventspace main thread= ;; =eventspace main thread=
(define (build-snip cache parent-snip expr pred pp name scheme-colors? cw (define (build-snip cache parent-snip expr pred pp name code-colors? cw
light-arrow-color dark-arrow-color dark-label-color light-label-color light-arrow-color dark-arrow-color dark-label-color light-label-color
dark-brush-color light-brush-color) dark-brush-color light-brush-color)
(let-values ([(snip new?) (let-values ([(snip new?)
@ -797,7 +801,7 @@
cache cache
expr expr
(lambda () (lambda ()
(let ([new-snip (make-snip parent-snip expr pred pp scheme-colors? cw)]) (let ([new-snip (make-snip parent-snip expr pred pp code-colors? cw)])
(hash-set! cache expr new-snip) (hash-set! cache expr new-snip)
(k new-snip #t)))) (k new-snip #t))))
#f))]) #f))])
@ -844,7 +848,7 @@
;; -> (is-a?/c graph-editor-snip%) ;; -> (is-a?/c graph-editor-snip%)
;; unconditionally creates a new graph-editor-snip ;; unconditionally creates a new graph-editor-snip
;; =eventspace main thread= ;; =eventspace main thread=
(define (make-snip parent-snip expr pred pp scheme-colors? cw) (define (make-snip parent-snip expr pred pp code-colors? cw)
(let* ([text (new program-text%)] (let* ([text (new program-text%)]
[es (instantiate graph-editor-snip% () [es (instantiate graph-editor-snip% ()
(char-width cw) (char-width cw)
@ -855,7 +859,7 @@
(send text set-autowrap-bitmap #f) (send text set-autowrap-bitmap #f)
(send text set-max-width 'none) (send text set-max-width 'none)
(send text freeze-colorer) (send text freeze-colorer)
(unless scheme-colors? (unless code-colors?
(send text stop-colorer #t)) (send text stop-colorer #t))
(send es format-expr) (send es format-expr)
es)) es))

883
collects/redex/redex.scrbl
View File

File diff suppressed because it is too large Load Diff