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

A whole bunch of missing newlines at EOFs (and a few other spaceages).

Browse Source
This commit is contained in:
Eli Barzilay 2012-10-19 06:47:24 -04:00
parent 6b1f423c98
commit cbfb1fdb37
24 changed files with 639 additions and 659 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/2htdp/tests/struct-universe.rkt
View File

@ -50,4 +50,4 @@
(launch-many-worlds (client 'blue) (client 'red) (server)))
(require (submod "." run))
(require (submod "." run))

2
collects/compatibility/defmacro.rkt
View File

@ -133,4 +133,4 @@
[else v])))))))
;; this require has to be here after the submodule
(require (for-syntax 'dmhelp))
(require (for-syntax 'dmhelp))

20
collects/future-visualizer/main.rkt
View File

@ -33,21 +33,17 @@
(x y width height)
(implies (or x y width height)
(and x y width height))
[p pict?])]))
[p pict?])]))
(define-syntax-rule (visualize-futures e ...)
(begin (start-future-tracing!)
(begin0 (begin e ...)
(stop-future-tracing!)
(show-visualizer))))
(define-syntax-rule (visualize-futures e ...)
(begin (start-future-tracing!)
(begin0 (begin e ...)
(stop-future-tracing!)
(show-visualizer))))
;;visualize-futures-thunk : (-> any/c) -> any/c
(define (visualize-futures-thunk thunk)
(start-future-tracing!)
(begin0
(thunk)
(start-future-tracing!)
(begin0 (thunk)
(stop-future-tracing!)
(show-visualizer)))

52
collects/future-visualizer/private/constants.rkt
View File

@ -1,47 +1,47 @@
#lang racket/base
(provide DEF-WINDOW-WIDTH
DEF-WINDOW-HEIGHT
RT-THREAD-ID
MIN-SEG-WIDTH
STROKE-WIDTH
MIN-SEG-INNER-WIDTH
DEFAULT-TIME-INTERVAL
TIMELINE-HEADER-OPACITY
CONNECTION-LINE-HAT-THRESHOLD
HAT-HEIGHT
CREATE-GRAPH-NODE-DIAMETER
#lang racket/base
(provide DEF-WINDOW-WIDTH
DEF-WINDOW-HEIGHT
RT-THREAD-ID
MIN-SEG-WIDTH
STROKE-WIDTH
MIN-SEG-INNER-WIDTH
DEFAULT-TIME-INTERVAL
TIMELINE-HEADER-OPACITY
CONNECTION-LINE-HAT-THRESHOLD
HAT-HEIGHT
CREATE-GRAPH-NODE-DIAMETER
CREATE-GRAPH-PADDING
CREATE-GRAPH-MIN-ZOOM
CREATE-GRAPH-MAX-ZOOM
CREATE-GRAPH-DEFAULT-ZOOM
CREATE-GRAPH-MIN-ZOOM
CREATE-GRAPH-MAX-ZOOM
CREATE-GRAPH-DEFAULT-ZOOM
CREATE-GRAPH-ZOOM-FACTOR
TIMELINE-ROW-HEIGHT
TIMELINE-ROW-HEIGHT
TIMELINE-MIN-TICK-PADDING
HEADER-PADDING
DEFAULT-TIMELINE-WIDTH
HEADER-HEIGHT
HEADER-PADDING
DEFAULT-TIMELINE-WIDTH
HEADER-HEIGHT
TOOLTIP-MARGIN)
(define DEF-WINDOW-WIDTH 1500)
(define DEF-WINDOW-WIDTH 1500)
(define DEF-WINDOW-HEIGHT 1000)
(define RT-THREAD-ID 0)
(define MIN-SEG-WIDTH 10)
(define STROKE-WIDTH 2)
(define MIN-SEG-INNER-WIDTH (- MIN-SEG-WIDTH STROKE-WIDTH))
(define MIN-SEG-INNER-WIDTH (- MIN-SEG-WIDTH STROKE-WIDTH))
;Default time interval (in MS) between ticks on the timeline
(define DEFAULT-TIME-INTERVAL (/ 1 10))
(define TIMELINE-HEADER-OPACITY 0.6)
(define CONNECTION-LINE-HAT-THRESHOLD 20)
(define CONNECTION-LINE-HAT-THRESHOLD 20)
(define HAT-HEIGHT 9)
(define CREATE-GRAPH-NODE-DIAMETER 30)
(define CREATE-GRAPH-PADDING 5)
(define CREATE-GRAPH-MIN-ZOOM 1)
(define CREATE-GRAPH-MAX-ZOOM 5)
(define CREATE-GRAPH-MIN-ZOOM 1)
(define CREATE-GRAPH-MAX-ZOOM 5)
(define CREATE-GRAPH-DEFAULT-ZOOM 3)
(define CREATE-GRAPH-ZOOM-FACTOR .4)
(define TIMELINE-ROW-HEIGHT 100)
(define TIMELINE-MIN-TICK-PADDING 10)
(define HEADER-PADDING 5)
(define DEFAULT-TIMELINE-WIDTH 1000)
(define HEADER-HEIGHT 30)
(define TOOLTIP-MARGIN 5)
(define HEADER-HEIGHT 30)
(define TOOLTIP-MARGIN 5)

139
collects/future-visualizer/private/drawing-helpers.rkt
View File

@ -1,109 +1,106 @@
#lang racket/base
(require slideshow/pict
#lang racket/base
(require slideshow/pict
"display.rkt"
"constants.rkt")
(provide opacity-layer
circle-pict
rect-pict
text-pict
text-block-pict
draw-line-onto
make-stand-out
at
(provide opacity-layer
circle-pict
rect-pict
text-pict
text-block-pict
draw-line-onto
make-stand-out
at
draw-stack-onto)
;;opacity-layer : float uint uint -> pict
(define (opacity-layer alpha w h)
(define (opacity-layer alpha w h)
(cellophane (colorize (filled-rectangle w h)
"white")
"white")
0.6))
;;circle-pict : string string uint [uint] -> pict
(define (circle-pict color stroke-color width #:stroke-width [stroke-width 1])
(pin-over (colorize (filled-ellipse width
width)
stroke-color)
(* stroke-width 2)
(* stroke-width 2)
(colorize (filled-ellipse (- width (* stroke-width 4))
(- width (* stroke-width 4)))
(define (circle-pict color stroke-color width #:stroke-width [stroke-width 1])
(pin-over (colorize (filled-ellipse width width)
stroke-color)
(* stroke-width 2)
(* stroke-width 2)
(colorize (filled-ellipse (- width (* stroke-width 4))
(- width (* stroke-width 4)))
color)))
;;rect-pict : string string uint uint [uint] -> pict
(define (rect-pict color stroke-color width height #:stroke-width [stroke-width 1])
(pin-over (colorize (filled-rectangle width height)
stroke-color)
(* stroke-width 2)
(* stroke-width 2)
(colorize (filled-rectangle (- width (* stroke-width 4))
(- height (* stroke-width 4)))
(define (rect-pict color stroke-color width height #:stroke-width [stroke-width 1])
(pin-over (colorize (filled-rectangle width height)
stroke-color)
(* stroke-width 2)
(* stroke-width 2)
(colorize (filled-rectangle (- width (* stroke-width 4))
(- height (* stroke-width 4)))
color)))
;;text-pict : string [string] -> pict
(define (text-pict t #:color [color "black"])
(define (text-pict t #:color [color "black"])
(colorize (text t) color))
;;text-block-pict : string [string] [string] [uint] [float] [uint] [uint] -> pict
(define (text-block-pict t #:backcolor [backcolor "white"]
#:forecolor [forecolor "black"]
#:padding [padding 10]
#:opacity [opacity 1.0]
#:width [width 0]
(define (text-block-pict t #:backcolor [backcolor "white"]
#:forecolor [forecolor "black"]
#:padding [padding 10]
#:opacity [opacity 1.0]
#:width [width 0]
#:height [height 0])
(let* ([textp (colorize (text t) forecolor)]
[padx2 (* padding 2)]
[text-cont (pin-over (blank (+ (pict-width textp) padx2)
(+ (pict-height textp) padx2))
padding
padding
[text-cont (pin-over (blank (+ (pict-width textp) padx2)
(+ (pict-height textp) padx2))
padding
padding
textp)]
[bg (cellophane (colorize (filled-rectangle (max width (pict-width text-cont))
(max height (pict-height text-cont)))
backcolor)
opacity)])
(lc-superimpose bg text-cont)))
[bg (cellophane (colorize (filled-rectangle (max width (pict-width text-cont))
(max height (pict-height text-cont)))
backcolor)
opacity)])
(lc-superimpose bg text-cont)))
;;draw-line-onto : pict uint uint uint uint string -> pict
(define (draw-line-onto base
startx
starty
endx
endy
(define (draw-line-onto base
startx
starty
endx
endy
color
#:width [width 1]
#:with-arrow [with-arrow #f]
#:width [width 1]
#:with-arrow [with-arrow #f]
#:arrow-sz [arrow-sz 10]
#:style [style 'solid])
(let ([dx (- endx startx)]
[dy (- endy starty)]
#:style [style 'solid])
(let ([dx (- endx startx)]
[dy (- endy starty)]
[line-f (if with-arrow pip-arrow-line pip-line)])
(pin-over base
startx
starty
(linewidth width
(linestyle style
(colorize (line-f dx
dy
arrow-sz)
(pin-over base
startx
starty
(linewidth width
(linestyle style
(colorize (line-f dx dy arrow-sz)
color))))))
;;make-stand-out : pict -> pict
(define (make-stand-out pict)
(define (make-stand-out pict)
(scale pict 2))
(struct draw-at (x y p) #:transparent)
;;at : uint uint pict -> draw-at
(define (at x y p)
(define (at x y p)
(draw-at x y p))
;;draw-stack-onto : pict (listof pict) -> pict
(define (draw-stack-onto base . picts)
(for/fold ([p base]) ([cur-p (in-list picts)])
(cond
[(pict? cur-p) (pin-over p 0 0 cur-p)]
[(draw-at? cur-p) (pin-over p
(draw-at-x cur-p)
(draw-at-y cur-p)
(draw-at-p cur-p))]
[else (error 'draw-onto "Invalid argument in 'picts' list.")])))
(define (draw-stack-onto base . picts)
(for/fold ([p base]) ([cur-p (in-list picts)])
(cond
[(pict? cur-p) (pin-over p 0 0 cur-p)]
[(draw-at? cur-p) (pin-over p
(draw-at-x cur-p)
(draw-at-y cur-p)
(draw-at-p cur-p))]
[else (error 'draw-onto "Invalid argument in 'picts' list.")])))

2
collects/future-visualizer/private/graph-drawing.rkt
View File

@ -194,4 +194,4 @@
(error 'draw-tree "Invalid tree drawing style.")])])
(graph-layout (+ (graph-layout-width layout) scaled-padding)
(+ (graph-layout-height layout) scaled-padding)
(graph-layout-nodes layout))))
(graph-layout-nodes layout))))

45
collects/future-visualizer/private/gui-helpers.rkt
View File

@ -15,15 +15,15 @@
post-event)
(define bold-system-font
(send the-font-list find-or-create-font
(send normal-control-font get-point-size)
(send normal-control-font get-family)
(send normal-control-font get-style)
(send the-font-list find-or-create-font
(send normal-control-font get-point-size)
(send normal-control-font get-family)
(send normal-control-font get-style)
'bold))
(define (label p str)
(new message% [parent p]
[label str]
(define (label p str)
(new message% [parent p]
[label str]
[stretchable-width #t]))
(define (mt-label p)
@ -77,30 +77,23 @@
c))
;Events
;receiver : any
;receiver : any
;handler : (any -> void)
(struct event-target (receiver handler) #:transparent)
(define (make-listener-table) (make-hash))
(define (add-receiver table evt-name object handler)
(hash-update! table
evt-name
(λ (old)
(cons (event-target object handler) old))
(define (add-receiver table evt-name object handler)
(hash-update! table
evt-name
(λ (old)
(cons (event-target object handler) old))
(list (event-target object handler))))
(define (post-event table name sender arg)
(let ([targets (hash-ref table name)])
(for ([target (in-list targets)])
(let ([receiver (event-target-receiver target)]
[handler (event-target-handler target)])
(unless (eq? receiver sender)
(define (post-event table name sender arg)
(let ([targets (hash-ref table name)])
(for ([target (in-list targets)])
(let ([receiver (event-target-receiver target)]
[handler (event-target-handler target)])
(unless (eq? receiver sender)
(handler arg))))))

2
collects/future-visualizer/private/visualizer-data.rkt
View File

@ -526,4 +526,4 @@
(node root
(build-creation-graph/private future-timelines root))))
(node 'runtime-thread
root-nodes))
root-nodes))

976
collects/future-visualizer/private/visualizer-drawing.rkt
View File

File diff suppressed because it is too large Load Diff

24
collects/future-visualizer/trace.rkt
View File

@ -1,26 +1,26 @@
#lang racket/base
(require racket/contract
(require racket/contract
"private/visualizer-data.rkt")
(provide (struct-out future-event)
(provide (struct-out future-event)
(struct-out gc-info)
(struct-out indexed-future-event)
trace-futures
(struct-out indexed-future-event)
trace-futures
(contract-out
[start-future-tracing! (-> void?)]
[start-future-tracing! (-> void?)]
[stop-future-tracing! (-> void?)]
[timeline-events (-> (listof indexed-future-event?))]
[trace-futures-thunk ((-> any/c) . -> . (listof indexed-future-event?))]))
(define-syntax-rule (trace-futures e ...)
(begin (start-future-tracing!)
(begin (begin e ...)
(define-syntax-rule (trace-futures e ...)
(begin (start-future-tracing!)
(begin (begin e ...)
(stop-future-tracing!)
(timeline-events))))
;;trace-futures-thunk : (-> any) -> (listof indexed-future-event)
(define (trace-futures-thunk thunk)
(start-future-tracing!)
(define (trace-futures-thunk thunk)
(start-future-tracing!)
(begin
(thunk)
(thunk)
(stop-future-tracing!)
(timeline-events)))
(timeline-events)))

8
collects/lang/private/sl-eval.rkt
View File

@ -1,6 +1,10 @@
#lang racket
(require teachpack/2htdp/scribblings/img-eval racket/sandbox mzlib/pconvert file/convertible scribble/eval)
(require teachpack/2htdp/scribblings/img-eval
racket/sandbox
mzlib/pconvert
file/convertible
scribble/eval)
(provide
;; syntax:
@ -110,4 +114,4 @@
(parameterize ([sandbox-namespace-specs (list (lambda () (namespace-anchor->namespace ns)))]
[sandbox-error-output 'string]
[sandbox-output 'string])
(make-base-eval)))))
(make-base-eval)))))

2
collects/mzlib/integer-set.rkt
View File

@ -9,4 +9,4 @@
count)
(rename-out [subtract difference]
[symmetric-difference xor]
[count card]))
[count card]))

2
collects/mzlib/process.rkt
View File

@ -3,4 +3,4 @@
;; deprecated library, see `racket/system`
(require racket/system)
(provide (all-from-out racket/system))
(provide (all-from-out racket/system))

2
collects/scribblings/scribble/renderer.scrbl
View File

@ -362,4 +362,4 @@ it saves the resulting files in a different place.
that it saves the file @filepath{blueboxes.rktd} in
the same directory where each @racket[dests] element resides.
}}
}
}

2
collects/stepper/examples/external-interface-example.rkt
View File

@ -28,4 +28,4 @@
;; the file interface:
(define-runtime-path bobby "./bobby.rkt")
(step-program-file bobby handler)
(step-program-file bobby handler)

2
collects/tests/drracket/snip/run-all.rkt
View File

@ -46,4 +46,4 @@
(unless (zero? failures)
(eprintf "~a attempt~a failed\n"
failures
(if (= failures 1) "" "s")))
(if (= failures 1) "" "s")))

2
collects/tests/future/trace.rkt
View File

@ -94,4 +94,4 @@ Invariants:
(define l (trace-futures (let ([f (future (λ () (printf "hello\n")))])
(sleep 0.1)
(touch f))))
(check-equal? l '())])
(check-equal? l '())])

2
collects/tests/generic/empty-interface.rkt
View File

@ -2,4 +2,4 @@
(require racket/generic)
(define-generics name)
(struct foo ()
#:methods gen:name [])
#:methods gen:name [])

2
collects/tests/typed-racket/send-places.rkt
View File

@ -28,4 +28,4 @@
(place-channel-put enq-ch (vector 'log name dir res-ch*))
(place-channel-get res-ch)]
[else
(generate-log/place name dir)]))
(generate-log/place name dir)]))

2
collects/tests/typed-racket/succeed/poly-struct-pred.rkt
View File

@ -6,4 +6,4 @@
(define (f t)
(match t
[(s value) (s value)]
[_ (error 'fail)]))
[_ (error 'fail)]))

2
collects/typed-racket/env/env-req.rkt vendored
View File

@ -11,4 +11,4 @@
(dynamic-require (collapse-module-path '(submod "." #%type-decl) m)
#f))))
(provide add-mod! do-requires)
(provide add-mod! do-requires)

2
collects/typed-racket/env/mvar-env.rkt vendored
View File

@ -10,4 +10,4 @@
(dict-set! mvar-env id #t))
(define (is-var-mutated? id)
(dict-ref mvar-env id #f))
(dict-ref mvar-env id #f))

2
collects/typed-racket/utils/disappeared-use.rkt
View File

@ -7,4 +7,4 @@
(disappeared-use-todo (cons t (disappeared-use-todo))))
(define disappeared-bindings-todo (make-parameter '()))
(define (add-disappeared-binding t)
(disappeared-bindings-todo (cons t (disappeared-bindings-todo))))
(disappeared-bindings-todo (cons t (disappeared-bindings-todo))))

2
collects/unstable/open-place.rkt
View File

@ -25,4 +25,4 @@
"free variable values must be allowable as place messages"
(symbol->string (syntax-e n)) e)))
(place-channel-put p vec)
p)]))
p)]))