diff --git a/drracket-core-lib/drracket/private/get-defs.rkt b/drracket-core-lib/drracket/private/get-defs.rkt index 6cb476909..eb0877ad9 100644 --- a/drracket-core-lib/drracket/private/get-defs.rkt +++ b/drracket-core-lib/drracket/private/get-defs.rkt @@ -96,12 +96,13 @@ (and smallest-i (string-length (define-popup-info-prefix (list-ref the-define-popup-infos smallest-i)))) - (and smallest-i - (let ([proc (define-popup-info-get-name - (list-ref the-define-popup-infos smallest-i))]) - (if proc - (lambda (text pos) (proc text pos get-defn-name)) - get-defn-name))) + (cond + [smallest-i + (define proc (define-popup-info-get-name (list-ref the-define-popup-infos smallest-i))) + (if proc + (lambda (text pos) (proc text pos get-defn-name)) + get-defn-name)] + [else #f]) final-positions)) (define defs diff --git a/drracket-core-lib/drracket/private/insulated-read-language.rkt b/drracket-core-lib/drracket/private/insulated-read-language.rkt index 935bce4a7..e8778c509 100644 --- a/drracket-core-lib/drracket/private/insulated-read-language.rkt +++ b/drracket-core-lib/drracket/private/insulated-read-language.rkt @@ -266,8 +266,7 @@ Will not work with the definitions text surrogate interposition that (λ () (val text start-position limit-position direction)))))] [(drracket:keystrokes) (for/list ([pr (in-list val)]) - (define key (list-ref pr 0)) - (define proc (list-ref pr 1)) + (match-define (list key proc) pr) (list key (procedure-rename (λ (txt evt) (call-in-irl-context/abort @@ -440,9 +439,8 @@ Will not work with the definitions text surrogate interposition that [(and (equal? p1 #\|) (equal? (peek-char-or-special port 1) #\#)) (get-it "|#") - (cond - [(= depth 0) (void)] - [else (loop (- depth 1))])] + (unless (= depth 0) + (loop (- depth 1)))] [(and (equal? p1 #\#) (equal? (peek-char-or-special port 1) #\|)) (get-it "#|") @@ -479,9 +477,9 @@ Will not work with the definitions text surrogate interposition that (for ([chars (in-list (syntax->list #'(chars ...)))]) (unless (string? (syntax-e chars)) (raise-syntax-error 'chars "expected a string" stx chars)) - (for ([char (in-string (syntax-e chars))]) - (unless (< (char->integer char) 128) - (raise-syntax-error 'chars "expected only one-byte chars" stx chars)))) + (for ([char (in-string (syntax-e chars))] + #:unless (< (char->integer char) 128)) + (raise-syntax-error 'chars "expected only one-byte chars" stx chars))) #'(cond [(check-chars port chars) rhs ...] diff --git a/drracket-core-lib/drracket/private/stick-figures.rkt b/drracket-core-lib/drracket/private/stick-figures.rkt index af068f910..e500542dc 100644 --- a/drracket-core-lib/drracket/private/stick-figures.rkt +++ b/drracket-core-lib/drracket/private/stick-figures.rkt @@ -154,10 +154,8 @@ (define (normalize points) (define-values (min-x min-y) (get-max/min-x/y min points)) - (map (λ (x) (list (car x) - (- (list-ref x 1) min-x) - (- (list-ref x 2) min-y))) - points)) + (for/list ([x (in-list points)]) + (list (car x) (- (list-ref x 1) min-x) (- (list-ref x 2) min-y)))) (define (get-max/min-x/y choose points) (values (apply choose @@ -185,14 +183,14 @@ (send dc set-brush "black" 'transparent) (draw-points points dc factor dx dy) - (let* ([head (assoc 'head points)] - [hx (list-ref head 1)] - [hy (list-ref head 2)]) - (send dc draw-ellipse - (+ dx (* factor (- hx (/ head-size 2)))) - (+ dy (* factor (- hy (/ head-size 2)))) - (* factor head-size) - (* factor head-size))))) + (define head (assoc 'head points)) + (define hx (list-ref head 1)) + (define hy (list-ref head 2)) + (send dc draw-ellipse + (+ dx (* factor (- hx (/ head-size 2)))) + (+ dy (* factor (- hy (/ head-size 2)))) + (* factor head-size) + (* factor head-size)))) (define (draw-points points dc factor dx dy) (connect 'neck 'shoulders points dc factor dx dy) @@ -250,13 +248,12 @@ (set! orig-y (list-ref orig-point 2)))] [(and clicked-point (send evt moving?)) (set! points - (map (λ (x) - (if (eq? (car x) clicked-point) - (list (list-ref x 0) - (+ orig-x (- (send evt get-x) clicked-x)) - (+ orig-y (- (send evt get-y) clicked-y))) - x)) - points)) + (for/list ([x (in-list points)]) + (if (eq? (car x) clicked-point) + (list (list-ref x 0) + (+ orig-x (- (send evt get-x) clicked-x)) + (+ orig-y (- (send evt get-y) clicked-y))) + x))) (refresh) (send csmall refresh)] [(send evt button-up? 'left) diff --git a/drracket-core-lib/drracket/private/syncheck/blueboxes-gui.rkt b/drracket-core-lib/drracket/private/syncheck/blueboxes-gui.rkt index b440ae04d..01e082921 100644 --- a/drracket-core-lib/drracket/private/syncheck/blueboxes-gui.rkt +++ b/drracket-core-lib/drracket/private/syncheck/blueboxes-gui.rkt @@ -778,8 +778,7 @@ (handle-evt get-blueboxes-cache-chan (λ (resp-chan+to-update-the-strs) - (define resp-chan (list-ref resp-chan+to-update-the-strs 0)) - (define to-update-the-strs (list-ref resp-chan+to-update-the-strs 1)) + (match-define (list resp-chan to-update-the-strs) resp-chan+to-update-the-strs) (define (start-blueboxes-computation) (thread diff --git a/drracket-core-lib/drracket/private/tool-contract-language.rkt b/drracket-core-lib/drracket/private/tool-contract-language.rkt index 0c9d2affe..abc17bcac 100644 --- a/drracket-core-lib/drracket/private/tool-contract-language.rkt +++ b/drracket-core-lib/drracket/private/tool-contract-language.rkt @@ -59,23 +59,19 @@ body)))))])))))))] [(_ (name type type-names strs ...) ...) (begin - (for-each - (λ (str-stx) - (when (string? (syntax->datum str-stx)) - (raise-syntax-error 'tool-contract-language.rkt "expected type name specification" - stx - str-stx))) - (syntax->list (syntax (type-names ...)))) - (for-each - (λ (name) - (unless (identifier? name) - (raise-syntax-error 'tool-contract-language.rkt "expected identifier" stx name))) - (syntax->list (syntax (name ...)))) - (for-each - (λ (str) - (unless (string? (syntax->datum str)) - (raise-syntax-error 'tool-contract-language.rkt "expected docs string" stx str))) - (apply append (map syntax->list (syntax->list (syntax ((strs ...) ...)))))))])) + (for ([str-stx (in-list (syntax->list (syntax (type-names ...))))]) + (when (string? (syntax->datum str-stx)) + (raise-syntax-error 'tool-contract-language.rkt + "expected type name specification" + stx + str-stx))) + (for ([name (in-list (syntax->list (syntax (name ...))))]) + (unless (identifier? name) + (raise-syntax-error 'tool-contract-language.rkt "expected identifier" stx name))) + (for ([str (in-list (apply append + (map syntax->list (syntax->list (syntax ((strs ...) ...))))))]) + (unless (string? (syntax->datum str)) + (raise-syntax-error 'tool-contract-language.rkt "expected docs string" stx str))))])) (define-syntax (-#%module-begin2 stx) (syntax-case stx () @@ -116,20 +112,16 @@ body)))]))))))] [(_ (name type type-names strs ...) ...) (begin - (for-each - (λ (str-stx) - (when (string? (syntax->datum str-stx)) - (raise-syntax-error 'tool-contract-language.rkt "expected type name specification" - stx - str-stx))) - (syntax->list (syntax (type-names ...)))) - (for-each - (λ (name) - (unless (identifier? name) - (raise-syntax-error 'tool-contract-language.rkt "expected identifier" stx name))) - (syntax->list (syntax (name ...)))) - (for-each - (λ (str) - (unless (string? (syntax->datum str)) - (raise-syntax-error 'tool-contract-language.rkt "expected docs string" stx str))) - (apply append (map syntax->list (syntax->list (syntax ((strs ...) ...)))))))])) + (for ([str-stx (in-list (syntax->list (syntax (type-names ...))))]) + (when (string? (syntax->datum str-stx)) + (raise-syntax-error 'tool-contract-language.rkt + "expected type name specification" + stx + str-stx))) + (for ([name (in-list (syntax->list (syntax (name ...))))]) + (unless (identifier? name) + (raise-syntax-error 'tool-contract-language.rkt "expected identifier" stx name))) + (for ([str (in-list (apply append + (map syntax->list (syntax->list (syntax ((strs ...) ...))))))]) + (unless (string? (syntax->datum str)) + (raise-syntax-error 'tool-contract-language.rkt "expected docs string" stx str))))])) diff --git a/drracket-core-lib/drracket/private/tooltip.rkt b/drracket-core-lib/drracket/private/tooltip.rkt index ab867d45c..aa33b50a0 100644 --- a/drracket-core-lib/drracket/private/tooltip.rkt +++ b/drracket-core-lib/drracket/private/tooltip.rkt @@ -73,8 +73,7 @@ (define-values (w h) (for/fold ([w #;#;: Nonnegative-Real 0] [h #;#;: Nonnegative-Real 0]) ([space+label (in-list labels)]) - (define space (list-ref space+label 0)) - (define label (list-ref space+label 1)) + (match-define (list space label) space+label) (define-values (space-w _1 _2 _3) (send dc get-text-extent space)) (define-values (this-w this-h _4 _5) (send dc get-text-extent label)) (values (max (+ space-w this-w) w) @@ -103,8 +102,7 @@ (send dc draw-rectangle 0 0 w h) (for ([space+label (in-list labels)] [i (in-naturals)]) - (define space (list-ref space+label 0)) - (define label (list-ref space+label 1)) + (match-define (list space label) space+label) (define-values (space-w _1 _2 _3) (send dc get-text-extent space #f 'grapheme)) (send dc draw-text label (+ 2 space-w) (+ 2 (* i th)) 'grapheme))) (super-new [stretchable-width #f] [stretchable-height #f]))) @@ -116,14 +114,13 @@ (init-field [frame-to-track #;#;: (Option (Instance Window<%>)) #f]) (: timer (Option (Instance Timer%))) (define timer - (let ([frame-to-track frame-to-track]) - (and frame-to-track - (new timer% - [notify-callback - (λ () - (unless (send frame-to-track is-shown?) - (show #f) - (send (assert timer) stop)))])))) + (and frame-to-track + (new timer% + [notify-callback + (λ () + (unless (send frame-to-track is-shown?) + (show #f) + (send (assert timer) stop)))]))) (define/override (on-subwindow-event r evt) 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)