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

Rackety

Browse Source
This commit is contained in:
Robby Findler 2010-09-16 13:11:25 -05:00
parent 28a253b206
commit b8fc5fcfce
3 changed files with 25 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/redex/gui.rkt
View File

@ -2,7 +2,7 @@
;; use `count-snips'; use something associated with the ;; use `count-snips'; use something associated with the
;; equal hash-table ;; equal hash-table
#lang scheme/base #lang racket/base
(require "private/stepper.ss" (require "private/stepper.ss"
"private/traces.ss" "private/traces.ss"
@ -10,9 +10,9 @@
"private/reduction-semantics.ss" "private/reduction-semantics.ss"
"private/size-snip.ss" "private/size-snip.ss"
mrlib/graph mrlib/graph
scheme/contract racket/contract
scheme/class racket/class
scheme/gui/base) racket/gui/base)
(define pp-contract (define pp-contract
(or/c (-> any/c string?) (or/c (-> any/c string?)
@ -35,8 +35,8 @@
(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?
#:racket-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?
@ -52,8 +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? #:scheme-colors? boolean?
#:racket-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?

17
collects/redex/private/stepper.rkt
View File

@ -11,16 +11,16 @@ todo:
|# |#
#lang scheme/base #lang racket/base
(require scheme/pretty (require racket/pretty
scheme/gui/base racket/gui/base
scheme/list racket/list
scheme/class racket/class
scheme/set racket/set
framework framework
mrlib/graph mrlib/graph
scheme/contract racket/contract
"sexp-diffs.ss" "sexp-diffs.ss"
"size-snip.ss" "size-snip.ss"
"reduction-semantics.ss") "reduction-semantics.ss")
@ -712,8 +712,7 @@ todo:
(super-new))) (super-new)))
(define (mk-big-snip sexp node pp init-cw) (define (mk-big-snip sexp node pp init-cw)
(let* (#;[txt (new scheme:text%)] (let* ([txt (new text:keymap%)]
[txt (new text:keymap%)]
[s (new big-snip% [s (new big-snip%
[pp pp] [pp pp]
[node node] [node node]

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

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
;; should cache the count of new snips -- dont ;; should cache the count of new snips -- dont
;; use `count-snips'; use something associated with the ;; use `count-snips'; use something associated with the
@ -9,9 +9,9 @@
"matcher.ss" "matcher.ss"
"size-snip.ss" "size-snip.ss"
"dot.ss" "dot.ss"
scheme/gui/base racket/gui/base
scheme/class racket/class
scheme/file racket/file
framework) framework)
(preferences:set-default 'plt-reducer:show-bottom #t boolean?) (preferences:set-default 'plt-reducer:show-bottom #t boolean?)
@ -374,13 +374,13 @@
;; set-font-size : number -> void ;; set-font-size : number -> void
;; =eventspace main thread= ;; =eventspace main thread=
(define (set-font-size size) (define (set-font-size size)
(let* ([scheme-standard (send (editor:get-standard-style-list) find-named-style (let* ([standard (send (editor:get-standard-style-list) find-named-style
"Standard")] "Standard")]
[scheme-delta (make-object style-delta%)]) [delta (make-object style-delta%)])
(send scheme-standard get-delta scheme-delta) (send standard get-delta delta)
(send scheme-delta set-size-mult 0) (send delta set-size-mult 0)
(send scheme-delta set-size-add size) (send delta set-size-add size)
(send scheme-standard set-delta scheme-delta) (send standard set-delta delta)
(let loop ([snip (send graph-pb find-first-snip)]) (let loop ([snip (send graph-pb find-first-snip)])
(when snip (when snip
(when (is-a? snip reflowing-snip<%>) (when (is-a? snip reflowing-snip<%>)