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

removed stepper's application < \ > buttons, added choice boxes instead, misc. cleanup and

Browse Source 
racket-ification of associated file.
This commit is contained in:
John Clements 2010-08-30 11:31:00 -07:00
parent bc5d1c2011
commit adc7d272a8
2 changed files with 25 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
collects/stepper/view-controller.rkt
View File

@ -1,23 +1,20 @@
#lang scheme/unit #lang racket/unit
;; this version of the view-controller (will) just collect the steps up front rather ;; this version of the view-controller just collects the steps up front rather
;; than blocking until the user presses the "next" button. ;; than blocking until the user presses the "next" button.
;; contracts are bogus all over the place. (require racket/class
racket/match
(require scheme/class racket/list
scheme/match
scheme/list
drscheme/tool drscheme/tool
mred mred
string-constants string-constants
scheme/async-channel racket/async-channel
(prefix-in model: "private/model.ss") (prefix-in model: "private/model.ss")
(prefix-in x: "private/mred-extensions.ss") (prefix-in x: "private/mred-extensions.ss")
"private/shared.ss" "private/shared.ss"
"private/model-settings.ss" "private/model-settings.ss"
"xml-sig.ss" "xml-sig.ss")
(only-in scheme/pretty pretty-print-show-inexactness))
(import drscheme:tool^ xml^ stepper-frame^) (import drscheme:tool^ xml^ stepper-frame^)
@ -65,11 +62,6 @@
;; the view in the stepper window ;; the view in the stepper window
(define view #f) (define view #f)
;; hand-off-and-block : (-> text%? any (listof (or/c posn-info? false?)) void?)
;; puts the step on the channel, to be fetched by the aggregator
(define (hand-off result)
(async-channel-put view-channel result))
;; wait for steps to show up on the channel. When they do, add them to the list. ;; wait for steps to show up on the channel. When they do, add them to the list.
(define (start-listener-thread) (define (start-listener-thread)
(thread (thread
@ -102,10 +94,6 @@
(cdr remaining) (cdr remaining)
(or seen-final? (finished-stepping-step? (car remaining))))])))) (or seen-final? (finished-stepping-step? (car remaining))))]))))
;; find-later-step/boolean : similar, but just return #f or #t.
(define (find-later-step/boolean p n)
(number? (find-later-step p n)))
;; find-earlier-step : like find-later-step, but searches backward from ;; find-earlier-step : like find-later-step, but searches backward from
;; the given step. ;; the given step.
(define (find-earlier-step p n) (define (find-earlier-step p n)
@ -185,39 +173,18 @@
(define (next) (define (next)
(next-of-specified-kind (lambda (x) #t))) (next-of-specified-kind (lambda (x) #t)))
;; respond to a click on the "next application" button ;; previous : the action of the 'previous' button
(define (next-application) (define (previous)
(next-of-specified-kind application-step?)) (prior-of-specified-kind (lambda (x) #t)))
;; respond to a click on the "Jump To..." choice ;; respond to a click on the "Jump To..." choice
(define (jump-to control event) (define (jump-to control event)
((second (list-ref pulldown-choices (send control get-selection))))) ((second (list-ref pulldown-choices (send control get-selection)))))
;; previous : the action of the 'previous' button
(define (previous)
(prior-of-specified-kind (lambda (x) #t)))
;; previous-application : the action of the 'previous-application'
;; button
(define (previous-application)
(prior-of-specified-kind application-step?))
;; jump-to-beginning : the action of the choice menu entry ;; jump-to-beginning : the action of the choice menu entry
(define (jump-to-beginning) (define (jump-to-beginning)
(first-of-specified-kind (lambda (x) #t))) (first-of-specified-kind (lambda (x) #t)))
;; jump-to-end : the action of the choice menu entry
(define (jump-to-end)
(next-of-specified-kind finished-stepping-step?))
;; jump-forward-to-selected : the action of the choice menu entry
(define (jump-to-selected)
(first-of-specified-kind selected-exp-step?))
;; jump-back-to-selection : the action of the choice menu entry
(define (jump-back-to-selection)
(prior-of-specified-kind selected-exp-step?))
;; GUI ELEMENTS: ;; GUI ELEMENTS:
(define s-frame (define s-frame
(make-object stepper-frame% drscheme-frame)) (make-object stepper-frame% drscheme-frame))
@ -237,14 +204,14 @@
[enabled #f])) [enabled #f]))
(define pulldown-choices (define pulldown-choices
`((,(string-constant stepper-jump-to-beginning) ,jump-to-beginning) `((,(string-constant stepper-jump-to-beginning) ,(lambda () (first-of-specified-kind (lambda (x) #t))))
(,(string-constant stepper-jump-to-end) ,jump-to-end) (,(string-constant stepper-jump-to-end) ,(lambda () (next-of-specified-kind finished-stepping-step?)))
(,(string-constant stepper-jump-to-selected) ,jump-to-selected))) (,(string-constant stepper-jump-to-selected) ,(lambda () (first-of-specified-kind selected-exp-step?)))
(,(string-constant stepper-jump-to-next-application) ,(lambda () (next-of-specified-kind application-step?)))
(,(string-constant stepper-jump-to-previous-application) ,(lambda () (prior-of-specified-kind application-step?)))))
(define previous-application-button (add-button (string-constant stepper-previous-application) previous-application))
(define previous-button (add-button (string-constant stepper-previous) previous)) (define previous-button (add-button (string-constant stepper-previous) previous))
(define next-button (add-button (string-constant stepper-next) next)) (define next-button (add-button (string-constant stepper-next) next))
(define next-application-button (add-button (string-constant stepper-next-application) next-application))
(define jump-button (add-choice-box (string-constant stepper-jump) jump-to)) (define jump-button (add-choice-box (string-constant stepper-jump) jump-to))
@ -293,10 +260,8 @@
(define update-status-bar-semaphore (make-semaphore 1)) (define update-status-bar-semaphore (make-semaphore 1))
(define (enable-all-buttons) (define (enable-all-buttons)
(send previous-application-button enable #t)
(send previous-button enable #t) (send previous-button enable #t)
(send next-button enable #t) (send next-button enable #t)
(send next-application-button enable #t)
(send jump-button enable #t)) (send jump-button enable #t))
@ -354,7 +319,8 @@
(start-listener-thread) (start-listener-thread)
(model:go (model:go
program-expander-prime program-expander-prime
hand-off ;; what do do with the results:
(lambda (result) (async-channel-put view-channel result))
(get-render-settings render-to-string render-to-sexp (get-render-settings render-to-string render-to-sexp
(send language-level stepper:enable-let-lifting?) (send language-level stepper:enable-let-lifting?)
(send language-level stepper:show-consumed-and/or-clauses?)) (send language-level stepper:show-consumed-and/or-clauses?))

14
collects/string-constants/english-string-constants.rkt
View File

@ -1269,18 +1269,20 @@ please adhere to these guidelines:
(stepper-language-level-message "The stepper does not work for language \"~a\".") (stepper-language-level-message "The stepper does not work for language \"~a\".")
(stepper-button-label "Step") (stepper-button-label "Step")
(stepper-previous-application "|< Application")
(stepper-previous "< Step") (stepper-previous "< Step")
(stepper-next "Step >") (stepper-next "Step >")
(stepper-next-application "Application >|") (stepper-jump "Jump...")
(stepper-jump "Jump...") ;; this one is changed. action? (stepper-jump-to-beginning "to beginning")
(stepper-jump-to-end "to end")
(stepper-jump-to-selected "to beginning of selected")
(stepper-jump-to-previous-application "to previous application step")
(stepper-jump-to-next-application "to next application step")
(stepper-out-of-steps "Reached the end of evaluation before finding the kind of step you were looking for.") (stepper-out-of-steps "Reached the end of evaluation before finding the kind of step you were looking for.")
(stepper-no-such-step/title "Step Not Found") (stepper-no-such-step/title "Step Not Found")
(stepper-no-such-step "Couldn't find a step matching that criterion.") (stepper-no-such-step "Couldn't find a step matching that criterion.")
(stepper-no-such-step/earlier "Couldn't find an earlier step matching that criterion.") (stepper-no-such-step/earlier "Couldn't find an earlier step matching that criterion.")
(stepper-jump-to-beginning "to beginning") ;; name changed from stepper-home to stepper-jump-to-beginning
(stepper-jump-to-end "to end") ;; content changed
(stepper-jump-to-selected "to beginning of selected") ;; new
(debug-tool-button-name "Debug") (debug-tool-button-name "Debug")