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

adjust online expansion so it is off by default; also fix the preference so

Browse Source 
it really actually works (and also doesn't create a place until it is turned
on at least once)
This commit is contained in:
Robby Findler 2011-09-15 17:33:43 -05:00
parent 808c2bdf27
commit e7d3a2e1d8
3 changed files with 74 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/drracket/private/main.rkt
View File

@ -525,7 +525,7 @@
lang lang
(or settings (send lang default-settings))))))))) (or settings (send lang default-settings)))))))))
(preferences:set-default 'drracket:online-compilation #t boolean?) (preferences:set-default 'drracket:online-compilation-default-off #f boolean?)
(drr:set-default 'drracket:multi-file-search:recur? #t boolean?) (drr:set-default 'drracket:multi-file-search:recur? #t boolean?)
(drr:set-default 'drracket:multi-file-search:filter? #t boolean?) (drr:set-default 'drracket:multi-file-search:filter? #t boolean?)

68
collects/drracket/private/module-language.rkt
View File

@ -912,26 +912,33 @@
(define tooltip-frame #f) (define tooltip-frame #f)
(define/private (show-tooltip) (define/private (show-tooltip)
(define tooltip-labels-to-show
(if (preferences:get 'drracket:online-compilation-default-off)
tooltip-labels
(list (string-constant online-expansion-is-disabled))))
(cond (cond
[tooltip-labels [tooltip-labels-to-show
(unless tooltip-frame (unless tooltip-frame
(set! tooltip-frame (new tooltip-frame%))) (set! tooltip-frame (new tooltip-frame%)))
(send tooltip-frame set-tooltip tooltip-labels) (send tooltip-frame set-tooltip tooltip-labels-to-show)
(define-values (rx ry) (send running-canvas client->screen 0 0)) (define-values (rx ry) (send running-canvas client->screen 0 0))
(define-values (cw ch) (send running-canvas get-client-size)) (define-values (cw ch) (send running-canvas get-client-size))
(send tooltip-frame show-over rx ry cw ch #:prefer-upper-left? #t)] (send tooltip-frame show-over rx ry cw ch #:prefer-upper-left? #t)]
[else [else
(when tooltip-frame (when tooltip-frame
(send tooltip-frame show #f))])) (send tooltip-frame show #f))]))
(define/private (update-tooltip) (define/private (update-tooltip)
(when tooltip-frame (when tooltip-frame
(cond (cond
[tooltip-labels [(or tooltip-labels
(not (preferences:get 'drracket:online-compilation-default-off)))
(when (send tooltip-frame is-shown?) (when (send tooltip-frame is-shown?)
;; just call this, as it updates the tooltip label already ;; just call this, as it updates the tooltip label already
(show-tooltip))] (show-tooltip))]
[else [else
(send tooltip-frame show #f)]))) (send tooltip-frame show #f)])))
(define/private (hide-tooltip) (define/private (hide-tooltip)
(when tooltip-frame (when tooltip-frame
(send tooltip-frame show #f))) (send tooltip-frame show #f)))
@ -954,7 +961,11 @@
(inherit get-dc popup-menu refresh get-client-size) (inherit get-dc popup-menu refresh get-client-size)
(define/override (on-paint) (define/override (on-paint)
(let ([dc (get-dc)]) (let ([dc (get-dc)])
(when colors (define colors-to-draw
(if (preferences:get 'drracket:online-compilation-default-off)
colors
(list "red")))
(when colors-to-draw
(send dc set-smoothing 'aligned) (send dc set-smoothing 'aligned)
(send dc set-pen "black" 1 'transparent) (send dc set-pen "black" 1 'transparent)
(send dc set-text-foreground "darkred") (send dc set-text-foreground "darkred")
@ -962,9 +973,9 @@
(define-values (tw th td ta) (send dc get-text-extent parens-mismatch-str)) (define-values (tw th td ta) (send dc get-text-extent parens-mismatch-str))
(define-values (cw ch) (get-client-size)) (define-values (cw ch) (get-client-size))
(cond (cond
[(list? colors) [(list? colors-to-draw)
(define len (length colors)) (define len (length colors-to-draw))
(for ([color (in-list colors)] (for ([color (in-list colors-to-draw)]
[i (in-naturals)]) [i (in-naturals)])
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
(send dc draw-arc (send dc draw-arc
@ -973,19 +984,19 @@
ball-size ball-size ball-size ball-size
(* 2 pi (/ i len)) (* 2 pi (/ i len))
(* 2 pi (/ (+ i 1) len))))] (* 2 pi (/ (+ i 1) len))))]
[(eq? colors 'parens) [(eq? colors-to-draw 'parens)
(send dc draw-text parens-mismatch-str (send dc draw-text parens-mismatch-str
(- (/ cw 2) (/ tw 2)) (- (/ cw 2) (/ tw 2))
(- (/ ch 2) (/ th 2)))])))) (- (/ ch 2) (/ th 2)))]))))
(define cb-proc (λ (sym new-val) (define cb-proc (λ (sym new-val)
(set! colors #f) (set! colors #f)
(refresh))) (refresh)))
(preferences:add-callback 'drracket:online-compilation cb-proc #t) (preferences:add-callback 'drracket:online-compilation-default-off cb-proc #t)
(define/override (on-event evt) (define/override (on-event evt)
(cond (cond
[(send evt button-down?) [(send evt button-down?)
(define menu (new popup-menu%)) (define menu (new popup-menu%))
(define on? (preferences:get 'drracket:online-compilation)) (define on? (preferences:get 'drracket:online-compilation-default-off))
(new menu-item% (new menu-item%
[parent menu] [parent menu]
[label (if on? [label (if on?
@ -993,7 +1004,7 @@
"Enable online compilation")] "Enable online compilation")]
[callback [callback
(λ args (λ args
(preferences:set 'drracket:online-compilation (not on?)))]) (preferences:set 'drracket:online-compilation-default-off (not on?)))])
(popup-menu menu (send evt get-x) (send evt get-y))] (popup-menu menu (send evt get-x) (send evt get-y))]
[(send evt entering?) [(send evt entering?)
(show-tooltip)] (show-tooltip)]
@ -1080,16 +1091,12 @@
(send dc draw-text label 2 (+ 2 (* i th))))) (send dc draw-text label 2 (+ 2 (* i th)))))
(super-new [stretchable-width #f] [stretchable-height #f]))) (super-new [stretchable-width #f] [stretchable-height #f])))
(define expanding-place (define expanding-place #f)
(and (>= (processor-count) 1)
(dynamic-place expanding-place.rkt 'start)))
(define place-initialized? #f)
(define pending-thread #f) (define pending-thread #f)
(define (send-to-place editor-contents filename prefab-module-settings show-results) (define (send-to-place editor-contents filename prefab-module-settings show-results)
(when expanding-place (unless expanding-place
(unless place-initialized? (set! expanding-place (dynamic-place expanding-place.rkt 'start))
(set! place-initialized? #t)
(place-channel-put expanding-place module-language-compile-lock) (place-channel-put expanding-place module-language-compile-lock)
(place-channel-put (place-channel-put
expanding-place expanding-place
@ -1112,7 +1119,7 @@
(λ () (λ ()
(when (eq? t pending-thread) (when (eq? t pending-thread)
(set! pending-thread #f) (set! pending-thread #f)
(show-results res))))))))))) (show-results res))))))))))
(define (stop-place-running) (define (stop-place-running)
(when expanding-place (when expanding-place
@ -1140,26 +1147,37 @@
(define cb-proc (λ (sym new-val) (define cb-proc (λ (sym new-val)
(when new-val (when new-val
(queue-callback (λ () (buffer-modified)))))) (queue-callback (λ () (buffer-modified))))))
(preferences:add-callback 'drracket:online-compilation cb-proc #t) (preferences:add-callback 'drracket:online-compilation-default-off cb-proc #t)
;; buffer-modified and restart-place
;; are the two entry points that might
;; trigger a compilation in a separate
;; place (and thus trigger the creation
;; of the separate place)
;; thus, they are where we check the preference
;; before doing anything
(define/private (buffer-modified) (define/private (buffer-modified)
(when (and (preferences:get 'drracket:online-compilation-default-off)
(> (processor-count) 1))
(clear-old-error) (clear-old-error)
(reset-frame-expand-error) (reset-frame-expand-error)
(let ([tlw (get-top-level-window)]) (let ([tlw (get-top-level-window)])
(when expanding-place
(when (in-module-language tlw) (when (in-module-language tlw)
(send (get-tab) show-bkg-running 'nothing #f) (send (get-tab) show-bkg-running 'nothing #f)
(stop-place-running) (stop-place-running)
(set! compilation-out-of-date? #t) (set! compilation-out-of-date? #t)
(when (preferences:get 'drracket:online-compilation)
(when (eq? (send tlw get-current-tab) (get-tab)) (when (eq? (send tlw get-current-tab) (get-tab))
(send tmr stop) (send tmr stop)
(send tmr start 250 #t))))))) (send tmr start 250 #t))))))
(define/public (restart-place) (define/public (restart-place)
(when (and (preferences:get 'drracket:online-compilation-default-off)
(> (processor-count) 1))
(stop-place-running) (stop-place-running)
(when compilation-out-of-date? (when compilation-out-of-date?
(send tmr start 250 #t))) (send tmr start 250 #t))))
(define/private (send-off) (define/private (send-off)
(define tlw (get-top-level-window)) (define tlw (get-top-level-window))
@ -1322,7 +1340,7 @@
(send dc set-smoothing 'smoothed) (send dc set-smoothing 'smoothed)
(define path (new dc-path%)) (define path (new dc-path%))
(send dc set-brush "black" 'transparent) (send dc set-brush "red" 'transparent)
(send dc set-pen (send the-pen-list find-or-create-pen "red" (send dc set-pen (send the-pen-list find-or-create-pen "red"
online-compilation-error-pen-width online-compilation-error-pen-width
'solid 'butt 'miter)) 'solid 'butt 'miter))

1
collects/string-constants/private/english-string-constants.rkt
View File

@ -223,6 +223,7 @@ please adhere to these guidelines:
(only-raw-text-files-supported "Only pure text files supported") (only-raw-text-files-supported "Only pure text files supported")
(abnormal-termination "Online expansion terminated abnormally") (abnormal-termination "Online expansion terminated abnormally")
(jump-to-error "Jump to Error") (jump-to-error "Jump to Error")
(online-expansion-is-disabled "Online expansion is disabled")
;;; info bar at botttom of drscheme frame ;;; info bar at botttom of drscheme frame
(collect-button-label "GC") (collect-button-label "GC")