diff --git a/drracket-core-lib/browser/external.rkt b/drracket-core-lib/browser/external.rkt index 15da0c670..ee6301e36 100644 --- a/drracket-core-lib/browser/external.rkt +++ b/drracket-core-lib/browser/external.rkt @@ -183,11 +183,11 @@ [parent h-panel] [callback (lambda (radio event) - (let ([n (send radio get-selection)]) - (set-browser! (cond - [(= n none-index) #f] - [(= n custom-index) (get-custom)] - [else (list-ref raw:unix-browser-list n)]))))])] + (define n (send radio get-selection)) + (set-browser! (cond + [(= n none-index) #f] + [(= n custom-index) (get-custom)] + [else (list-ref raw:unix-browser-list n)])))])] [select-custom (lambda (_ __) (send r set-selection custom-index) (set-browser! (get-custom)))] @@ -219,11 +219,10 @@ [n 0]) (cond [(null? x) (send r set-selection n)] + [(eq? pref (car x)) (send r set-selection n)] [else - (if (eq? pref (car x)) - (send r set-selection n) - (init (cdr x) - (add1 n)))]))]))]) + (init (cdr x) + (add1 n))]))]))]) (unless ask-later? (send r enable none-index #f)) diff --git a/drracket-core-lib/drracket/private/palaka.rkt b/drracket-core-lib/drracket/private/palaka.rkt index 8399d52c3..373e8a140 100644 --- a/drracket-core-lib/drracket/private/palaka.rkt +++ b/drracket-core-lib/drracket/private/palaka.rkt @@ -24,17 +24,13 @@ (define (draw-palaka dc w h) (define alpha (send dc get-alpha)) (send dc set-pen palaka-color 1 'transparent) - (let loop ([dx (- (/ quadrant-size 2))]) - (when (< dx w) - (let loop ([dy (- (/ quadrant-size 2))]) - (when (< dy h) - (send dc set-alpha 1) - (send dc set-brush palaka-color 'solid) - (send dc draw-rectangle dx dy quadrant-size quadrant-size) - (send dc set-brush "white" 'solid) - (draw-one-palaka dc dx dy) - (loop (+ dy quadrant-size)))) - (loop (+ dx quadrant-size)))) + (for ([dx (in-range (- (/ quadrant-size 2)) w quadrant-size)]) + (for ([dy (in-range (- (/ quadrant-size 2)) h quadrant-size)]) + (send dc set-alpha 1) + (send dc set-brush palaka-color 'solid) + (send dc draw-rectangle dx dy quadrant-size quadrant-size) + (send dc set-brush "white" 'solid) + (draw-one-palaka dc dx dy))) (send dc set-alpha alpha)) (define (draw-one-palaka dc dx dy) diff --git a/drracket-core-lib/drracket/sprof.rkt b/drracket-core-lib/drracket/sprof.rkt index 6245bdfd0..bc665d140 100644 --- a/drracket-core-lib/drracket/sprof.rkt +++ b/drracket-core-lib/drracket/sprof.rkt @@ -16,9 +16,9 @@ (sleep pause-time) (define new-traces (map (λ (t) (continuation-mark-set->context (continuation-marks t))) (get-threads))) - (for ([trace (in-list new-traces)]) - (for ([line (in-list trace)]) - (hash-set! traces-table line (cons trace (hash-ref traces-table line '()))))) + (for* ([trace (in-list new-traces)] + [line (in-list trace)]) + (hash-set! traces-table line (cons trace (hash-ref traces-table line '())))) (cond [(zero? i) (update-gui traces-table) diff --git a/drracket-core-lib/scribble/tools/drracket-buttons.rkt b/drracket-core-lib/scribble/tools/drracket-buttons.rkt index 462d83f99..ead95d229 100644 --- a/drracket-core-lib/scribble/tools/drracket-buttons.rkt +++ b/drracket-core-lib/scribble/tools/drracket-buttons.rkt @@ -44,9 +44,9 @@ ;; if (eval 'doc) goes wrong, then we assume that's because of ;; an earlier failure, so we just don't do anything. (when doc - (printf "scribble: loading xref\n") + (displayln "scribble: loading xref") (define xref ((dynamic-require 'setup/xref 'load-collections-xref))) - (printf "scribble: rendering\n") + (displayln "scribble: rendering") (parameterize ([current-input-port (open-input-string "")]) ((dynamic-require 'scribble/render 'render) (list doc) diff --git a/drracket-test/tests/drracket/private/gui.rkt b/drracket-test/tests/drracket/private/gui.rkt index b4709ac1b..74cc3bad8 100644 --- a/drracket-test/tests/drracket/private/gui.rkt +++ b/drracket-test/tests/drracket/private/gui.rkt @@ -17,30 +17,17 @@ (cond [(= i (string-length string1)) (only-whitespace? string2 j)] [(= j (string-length string2)) (only-whitespace? string1 i)] - [else (let ([c1 (string-ref string1 i)] - [c2 (string-ref string2 j)]) - (cond - [in-whitespace? - (cond - [(whitespace? c1) - (loop (+ i 1) - j - #t)] - [(whitespace? c2) - (loop i - (+ j 1) - #t)] - [else (loop i j #f)])] - [(and (whitespace? c1) - (whitespace? c2)) - (loop (+ i 1) - (+ j 1) - #t)] - [(char=? c1 c2) - (loop (+ i 1) - (+ j 1) - #f)] - [else #f]))]))) + [else (define c1 (string-ref string1 i)) + (define c2 (string-ref string2 j)) + (cond + [in-whitespace? + (cond + [(whitespace? c1) (loop (+ i 1) j #t)] + [(whitespace? c2) (loop i (+ j 1) #t)] + [else (loop i j #f)])] + [(and (whitespace? c1) (whitespace? c2)) (loop (+ i 1) (+ j 1) #t)] + [(char=? c1 c2) (loop (+ i 1) (+ j 1) #f)] + [else #f])]))) ;; whitespace? : char -> boolean ;; deteremines if `c' is whitespace @@ -113,11 +100,11 @@ window label class)) (let loop ([window window]) (cond - [(and (or (not class) - (is-a? window class)) - (let ([win-label (and (is-a? window window<%>) - (send window get-label))]) - (equal? label win-label))) + [(cond + [(or (not class) (is-a? window class)) + (define win-label (and (is-a? window window<%>) (send window get-label))) + (equal? label win-label)] + [else #f]) (list window)] [(is-a? window area-container<%>) (apply append (map loop (send window get-children)))] [else '()]))) diff --git a/drracket-test/tests/drracket/private/no-fw-test-util.rkt b/drracket-test/tests/drracket/private/no-fw-test-util.rkt index a47a10584..765b9bce5 100644 --- a/drracket-test/tests/drracket/private/no-fw-test-util.rkt +++ b/drracket-test/tests/drracket/private/no-fw-test-util.rkt @@ -57,80 +57,81 @@ (yield (make-semaphore 0))))))) (semaphore-wait s)) -(define (use-hash-for-prefs preferences:low-level-get-preference +(define (use-hash-for-prefs preferences:low-level-get-preference preferences:low-level-put-preferences preferences:restore-defaults preferences:set preferences:default-set? prefs) - ;; change the preferences system so that it doesn't write to + ;; change the preferences system so that it doesn't write to ;; a file; partly to avoid problems of concurrency in drdr ;; but also to make the test suite easier for everyone to run. - (let ([prefs-table (make-hash)]) - (preferences:low-level-put-preferences - (λ (names vals) - (for ([name (in-list names)] - [val (in-list vals)]) - (hash-set! prefs-table name val)))) - (preferences:low-level-get-preference - (λ (name [fail (lambda () #f)]) - (hash-ref prefs-table name fail))) - - ;; set all preferences to their defaults (some pref values may have - ;; been read by this point, but hopefully that won't affect the - ;; startup of drracket) - (preferences:restore-defaults) - - ;; initialize some preferences to simulate these - ;; being saved already in the user's prefs file - ;; call preferences:set too since the prefs file - ;; may have been "read" already at this point - (for ([pref (in-list prefs)]) - (define pref-key (list-ref pref 0)) - (define pref-val (list-ref pref 1)) - (define m (regexp-match #rx"^plt:framework-pref:(.*)$" (symbol->string pref-key))) - (cond - [m - (hash-set! prefs-table pref-key pref-val) - (define fw-pref-key (string->symbol (list-ref m 1))) - (when (preferences:default-set? fw-pref-key) - (preferences:set fw-pref-key pref-val))] - [else - ;; this currently doesn't happen, and it is easy to forget - ;; that prefix, so print a message here to remind - (printf "WARNING: setting a preference that isn't set via the framework: ~s\n" - pref-key)])))) + (define prefs-table (make-hash)) + (preferences:low-level-put-preferences (λ (names vals) + (for ([name (in-list names)] + [val (in-list vals)]) + (hash-set! prefs-table name val)))) + (preferences:low-level-get-preference (λ (name [fail (lambda () #f)]) + (hash-ref prefs-table name fail))) + + ;; set all preferences to their defaults (some pref values may have + ;; been read by this point, but hopefully that won't affect the + ;; startup of drracket) + (preferences:restore-defaults) + + ;; initialize some preferences to simulate these + ;; being saved already in the user's prefs file + ;; call preferences:set too since the prefs file + ;; may have been "read" already at this point + (for ([pref (in-list prefs)]) + (define pref-key (list-ref pref 0)) + (define pref-val (list-ref pref 1)) + (define m (regexp-match #rx"^plt:framework-pref:(.*)$" (symbol->string pref-key))) + (cond + [m + (hash-set! prefs-table pref-key pref-val) + (define fw-pref-key (string->symbol (list-ref m 1))) + (when (preferences:default-set? fw-pref-key) + (preferences:set fw-pref-key pref-val))] + [else + ;; this currently doesn't happen, and it is easy to forget + ;; that prefix, so print a message here to remind + (printf "WARNING: setting a preference that isn't set via the framework: ~s\n" pref-key)]))) (define (queue-callback/res thunk) (not-on-eventspace-handler-thread 'queue-callback/res #:more (λ () (format "\n thunk: ~e" thunk))) - (let ([c (make-channel)]) - (queue-callback (λ () (channel-put c (with-handlers ((exn:fail? values)) - (call-with-values thunk list)))) - #f) - (define res (channel-get c)) - (when (exn? res) (raise res)) - (apply values res))) + (define c (make-channel)) + (queue-callback (λ () + (channel-put c + (with-handlers ([exn:fail? values]) + (call-with-values thunk list)))) + #f) + (define res (channel-get c)) + (when (exn? res) + (raise res)) + (apply values res)) ;; poll-until : (-> alpha) number (-> alpha) -> alpha ;; waits until pred return a true value and returns that. ;; if that doesn't happen by `secs', calls fail and returns that. -(define (poll-until pred - [secs 10] - [fail (lambda () - (error 'poll-until - "timeout after ~e secs, ~e never returned a true value" - secs pred))]) - (let ([step 1/20]) - (let loop ([counter secs]) - (if (<= counter 0) - (fail) - (let ([result (pred)]) - (or result - (begin - (sleep step) - (loop (- counter step))))))))) +(define (poll-until + pred + [secs 10] + [fail + (lambda () + (error 'poll-until "timeout after ~e secs, ~e never returned a true value" secs pred))]) + (define step 1/20) + (let loop ([counter secs]) + (cond + [(<= counter 0) (fail)] + [else + (define result (pred)) + (or result + (begin + (sleep step) + (loop (- counter step))))]))) (define (wait-for-events-in-frame-eventspace fr) (define sema (make-semaphore 0)) diff --git a/drracket-test/tests/drracket/time-keystrokes.rkt b/drracket-test/tests/drracket/time-keystrokes.rkt index 6b3471281..c439f5c81 100644 --- a/drracket-test/tests/drracket/time-keystrokes.rkt +++ b/drracket-test/tests/drracket/time-keystrokes.rkt @@ -84,7 +84,7 @@ (loop (send w get-parent) (cons w l))))) (when (getenv "PLTDRKEYS") - (printf "PLTDRKEYS: installing unit frame mixin\n") + (displayln "PLTDRKEYS: installing unit frame mixin") (drracket:get/extend:extend-unit-frame tool-mixin)))) (module+ test diff --git a/drracket-tool-lib/drracket/private/standalone-module-browser.rkt b/drracket-tool-lib/drracket/private/standalone-module-browser.rkt index 78cd6299e..591740dfb 100644 --- a/drracket-tool-lib/drracket/private/standalone-module-browser.rkt +++ b/drracket-tool-lib/drracket/private/standalone-module-browser.rkt @@ -1396,9 +1396,7 @@ (show-status val) (loop)] [(connect) - (define name-original (list-ref val 0)) - (define path-key (list-ref val 1)) - (define require-depth (list-ref val 2)) + (match-define (list name-original path-key require-depth) val) (send pasteboard add-connection name-original path-key require-depth) (loop)]))) (send pasteboard end-adding-connections) diff --git a/drracket-tool-text-lib/drracket/find-module-path-completions.rkt b/drracket-tool-text-lib/drracket/find-module-path-completions.rkt index c715ac956..2c4741a0d 100644 --- a/drracket-tool-text-lib/drracket/find-module-path-completions.rkt +++ b/drracket-tool-text-lib/drracket/find-module-path-completions.rkt @@ -183,20 +183,20 @@ (and (regexp? (list-ref link-ent 2)) (regexp-match (list-ref link-ent 2) (version))) #t)) - `(,(list-ref link-ent 0) - ,(simplify-path - (let* ([encoded-path (list-ref link-ent 1)] - [path (cond - [(string? encoded-path) encoded-path] - [(bytes? encoded-path) (bytes->path encoded-path)] - [else (apply build-path - (for/list ([elem (in-list encoded-path)]) - (if (bytes? elem) - (bytes->path-element elem) - elem)))])]) - (if (relative-path? path) - (build-path base path) - path)))))] + (list (list-ref link-ent 0) + (simplify-path (let* ([encoded-path (list-ref link-ent 1)] + [path (cond + [(string? encoded-path) encoded-path] + [(bytes? encoded-path) (bytes->path encoded-path)] + [else + (apply build-path + (for/list ([elem (in-list encoded-path)]) + (if (bytes? elem) + (bytes->path-element elem) + elem)))])]) + (if (relative-path? path) + (build-path base path) + path)))))] [else '()])] [else (for/list ([clp (in-list library-collection-paths)]) diff --git a/drracket/help/private/save-bug-report.rkt b/drracket/help/private/save-bug-report.rkt index c8f5064f3..82fe323e3 100644 --- a/drracket/help/private/save-bug-report.rkt +++ b/drracket/help/private/save-bug-report.rkt @@ -89,12 +89,9 @@ (λ (bug-reports) (define ids (map saved-report-id bug-reports)) (define new-id - (let loop ([i 0]) - (cond - [(member i ids) - (loop (+ i 1))] - [else - i]))) + (for/first ([i (in-naturals 0)] + #:unless (member i ids)) + i)) (set! ans (blank-bug-form new-id)) (cons ans bug-reports))) ans)