From 3ef7aa2a45fe21a6bdb3b5a884ba072a368953a8 Mon Sep 17 00:00:00 2001 From: John Clements Date: Wed, 20 Jun 2012 23:37:48 -0700 Subject: [PATCH] rackety --- collects/stepper/private/mred-extensions.rkt | 4 +-- collects/stepper/private/view-controller.rkt | 36 +++++++++++++------- 2 files changed, 26 insertions(+), 14 deletions(-) diff --git a/collects/stepper/private/mred-extensions.rkt b/collects/stepper/private/mred-extensions.rkt index 3e8ba1124b..e44e86d260 100644 --- a/collects/stepper/private/mred-extensions.rkt +++ b/collects/stepper/private/mred-extensions.rkt @@ -1,5 +1,5 @@ #lang racket - + (require mred (prefix-in f: framework) racket/pretty @@ -235,7 +235,7 @@ ;; jbc : this could be fixed in the same way that inexact-number printing is handled.... [read-case-sensitive #t] ) - (pretty-print sexp text-port))) + (pretty-write sexp text-port))) (define/public (format-whole-step) (lock #f) diff --git a/collects/stepper/private/view-controller.rkt b/collects/stepper/private/view-controller.rkt index d53a2ffd5f..11cb180850 100644 --- a/collects/stepper/private/view-controller.rkt +++ b/collects/stepper/private/view-controller.rkt @@ -1,5 +1,12 @@ #lang racket/unit +;; this module implements the UI side of the stepper; it +;; opens a window, starts the stepper thread running, +;; and handles the resulting calls to 'break'. + +;; this module lies outside of the "testing boundary" +;; of through-tests; it is not tested automatically at all. + ;; this version of the view-controller just collects the steps up front rather ;; than blocking until the user presses the "next" button. @@ -91,6 +98,9 @@ ;; wait for steps to show up on the channel. ;; When they do, add them to the list. (define (start-listener-thread stepper-frame-eventspace) + ;; as of 2012-06-20, I no longer believe there's any + ;; need for this thread, as the queue-callback handles + ;; the needed separation. (thread (lambda () (let loop () @@ -514,15 +524,17 @@ (< overlap-begin overlap-end))])))])) ;; a few unit tests. Use them if changing span-overlap. -#;(and -;; zero-length selection cases: -(equal? ((span-overlap 13 13) (model:make-posn-info 14 4)) #f) -(equal? ((span-overlap 14 14) (model:make-posn-info 14 4)) #t) -(equal? ((span-overlap 18 18) (model:make-posn-info 14 4)) #f) -;; nonzero-length selection cases: -(equal? ((span-overlap 13 14) (model:make-posn-info 14 4)) #f) -(equal? ((span-overlap 13 15) (model:make-posn-info 14 4)) #t) -(equal? ((span-overlap 13 23) (model:make-posn-info 14 4)) #t) -(equal? ((span-overlap 16 17) (model:make-posn-info 14 4)) #t) -(equal? ((span-overlap 16 24) (model:make-posn-info 14 4)) #t) -(equal? ((span-overlap 18 21) (model:make-posn-info 14 4)) #f)) +;; ...oops, can't use module+ inside of a unit. +#;(module+ test + (require rackunit) + ;; zero-length selection cases: + (check-equal? ((span-overlap 13 13) (model:make-posn-info 14 4)) #f) + (check-equal? ((span-overlap 14 14) (model:make-posn-info 14 4)) #t) + (check-equal? ((span-overlap 18 18) (model:make-posn-info 14 4)) #f) + ;; nonzero-length selection cases: + (check-equal? ((span-overlap 13 14) (model:make-posn-info 14 4)) #f) + (check-equal? ((span-overlap 13 15) (model:make-posn-info 14 4)) #t) + (check-equal? ((span-overlap 13 23) (model:make-posn-info 14 4)) #t) + (check-equal? ((span-overlap 16 17) (model:make-posn-info 14 4)) #t) + (check-equal? ((span-overlap 16 24) (model:make-posn-info 14 4)) #t) + (check-equal? ((span-overlap 18 21) (model:make-posn-info 14 4)) #f))