Automated Resyntax fixes

drracket-core-lib/drracket/private/colored-errors.rkt

@@ -47,15 +47,16 @@
 ;; of additional source locations. These additional location will also be highlighted in the code,
 ;; even though they do not correspond to any section of the text of the error message.
 (struct colored-error-message (fragments additional-highlights) #:transparent)
-(provide/contract [struct colored-error-message
-                          ([fragments (listof msg-fragment?)]
-                           [additional-highlights additional-highlights/c])]
-                  [struct msg-fragment:str ([str string?])]
-                  [struct msg-fragment:v ([v any/c])]
-                  [struct colored-msg-fragment ([locs srcloc-syntax/c]
-                                                [frags (listof (or/c msg-fragment:str? msg-fragment:v?))]
-                                                [important boolean?]
-                                                [color color/c])])
+(provide (contract-out (struct colored-error-message
+                               ([fragments (listof msg-fragment?)] [additional-highlights
+                                                                    additional-highlights/c]))
+                       (struct msg-fragment:str ([str string?]))
+                       (struct msg-fragment:v ([v any/c]))
+                       (struct colored-msg-fragment
+                               ([locs srcloc-syntax/c]
+                                [frags (listof (or/c msg-fragment:str? msg-fragment:v?))]
+                                [important boolean?]
+                                [color color/c]))))
 
 ;; prop:exn:colored-message : The property of exceptions that contain colored-message information.
 ;;     The property's value is a function that when given an exception, returns the colored-error-message.
@@ -72,7 +73,7 @@
 ;; get-error-message/color : When given an exception, if that exception contains coloring information,
 ;;    returns it, otherwise, returns a colored-error-message that capture the information provided by
 ;;    by field message and the srclocs property (if any) of the exception.
-(provide/contract [get-error-message/color (exn? . -> . colored-error-message?)])
+(provide (contract-out [get-error-message/color (exn? . -> . colored-error-message?)]))
 (define (get-error-message/color exn)
   (cond [(exn:colored-message? exn) ((exn:colored-message-accessor exn) exn)]
         [(exn:srclocs? exn)
@@ -81,11 +82,13 @@
         [else
          (colored-error-message (list (msg-fragment:str (exn-message exn))) empty)]))
 
-(provide/contract [get-error-colored-srclocs (exn? . -> . (listof (list/c srcloc-syntax/c color/c)))])
+(provide (contract-out [get-error-colored-srclocs
+                        (exn? . -> . (listof (list/c srcloc-syntax/c color/c)))]))
 (define (get-error-colored-srclocs exn)
   (get-message-colored-srclocs (get-error-message/color exn)))
 
-(provide/contract [get-message-colored-srclocs (colored-error-message? . -> . (listof (list/c srcloc-syntax/c color/c)))])
+(provide (contract-out [get-message-colored-srclocs
+                        (colored-error-message? . -> . (listof (list/c srcloc-syntax/c color/c)))]))
 (define (get-message-colored-srclocs msg)
   (define (promote srcloc) (if (list? srcloc) srcloc (list srcloc #f)))
   (map promote
@@ -165,12 +168,12 @@
   (check-arg "~|" args 1)
   (define-values (sub rest-args)
     (let loop ([fragments fragments] [args (rest args)])
-      (if (empty? fragments)
-          (values empty args)
-          (let ()
-            (define-values (f rest-args) (colored-format:str-or-v (first fragments) args))
-            (define-values (rest-fs rest-rest-args) (loop (rest fragments) rest-args))
-            (values (cons f rest-fs) rest-rest-args)))))
+      (cond
+        [(empty? fragments) (values empty args)]
+        [else
+         (define-values (f rest-args) (colored-format:str-or-v (first fragments) args))
+         (define-values (rest-fs rest-rest-args) (loop (rest fragments) rest-args))
+         (values (cons f rest-fs) rest-rest-args)])))
   (define the-arg (first args))
   (match the-arg
     [(list loc imp col other ..1)
@@ -190,7 +193,7 @@
 
 (define colored-format/c (([fmt string?]) (#:additional-highlights [additional-highlights additional-highlights/c]) #:rest [_ any/c]
                                                    . ->i . [_ colored-error-message?]))
-(provide/contract [colored-format colored-format/c])
+(provide (contract-out [colored-format colored-format/c]))
 
 ;; colored-format : Takes a format string and a number of arguments, and produces a string where each
 ;;                  format marker has been replaced by their corresponding argument. This function support 
@@ -279,7 +282,7 @@
 ;;                              The message and srcloc fields of the exception are populated from the information 
 ;;                              in the fmt. additional-highlights specifies srclocs that should be highlighted, in addition
 ;;                              to the highlights used to explicate the correspondance between the text and the piece of codes.
-(provide/contract [raise-colored-syntax-error colored-format/c])
+(provide (contract-out [raise-colored-syntax-error colored-format/c]))
 (define (raise-colored-syntax-error fmt #:additional-highlights [additional-highlights empty] . args)
   (define formatted (apply colored-format fmt #:additional-highlights additional-highlights args))
   (raise (exn:fail:colored:syntax (uncolor-message formatted)

drracket-core-lib/drracket/private/frame.rkt

@@ -262,47 +262,42 @@
           (when (is-a? item menu-item-container<%>)
             (loop item))))
       (when (member (system-type) '(unix windows))
-        (for ([top-level-menu (in-list (send mb get-items))])
-          (when (is-a? top-level-menu menu%)
-            (define amp-key
-              (let loop ([str (send top-level-menu get-label)])
-                (cond
-                  [(regexp-match #rx"[^&]*[&](.)(.*)" str)
-                   =>
-                   (λ (m)
-                     (define this-amp (list-ref m 1))
-                     (define rest (list-ref m 2))
-                     (cond
-                       [(equal? this-amp "&")
-                        (loop rest)]
-                       [else 
-                        (string-downcase this-amp)]))]
-                  [else #f])))
-            (when amp-key
-              (hash-set! name-ht 
-                         (string->symbol (format "m:~a" amp-key))
-                         (format "~a menu" (send top-level-menu get-plain-label)))
-              (when (equal? (system-type) 'windows)
-                (hash-set! name-ht 
-                           (string->symbol (format "m:s:~a" amp-key))
-                           (format "~a menu" (send top-level-menu get-plain-label)))))))))
+        (for ([top-level-menu (in-list (send mb get-items))]
+              #:when (is-a? top-level-menu menu%))
+          (define amp-key
+            (let loop ([str (send top-level-menu get-label)])
+              (cond
+                [(regexp-match #rx"[^&]*[&](.)(.*)" str)
+                 =>
+                 (λ (m)
+                   (define this-amp (list-ref m 1))
+                   (define rest (list-ref m 2))
+                   (cond
+                     [(equal? this-amp "&") (loop rest)]
+                     [else (string-downcase this-amp)]))]
+                [else #f])))
+          (when amp-key
+            (hash-set! name-ht
+                       (string->symbol (format "m:~a" amp-key))
+                       (format "~a menu" (send top-level-menu get-plain-label)))
+            (when (equal? (system-type) 'windows)
+              (hash-set! name-ht
+                         (string->symbol (format "m:s:~a" amp-key))
+                         (format "~a menu" (send top-level-menu get-plain-label))))))))
     name-ht)
 
   (define (menu-item->prefix-string item)
     (apply
      string-append
-     (map (λ (prefix)
-            (case prefix
-              [(alt) (if (eq? (system-type) 'windows)
-                         "m:"
-                         "a:")]
-              [(cmd) "d:"]
-              [(meta) "m:"]
-              [(ctl) "c:"]
-              [(shift) "s:"]
-              [(opt option) "a:"]
-              [else (error 'menu-item->prefix-string "unknown prefix ~s\n" prefix)]))
-          (send item get-shortcut-prefix)))))
+     (for/list ([prefix (in-list (send item get-shortcut-prefix))])
+       (case prefix
+         [(alt) (if (eq? (system-type) 'windows) "m:" "a:")]
+         [(cmd) "d:"]
+         [(meta) "m:"]
+         [(ctl) "c:"]
+         [(shift) "s:"]
+         [(opt option) "a:"]
+         [else (error 'menu-item->prefix-string "unknown prefix ~s\n" prefix)])))))
 
 (require string-constants
          racket/match

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 ...]

drracket-core-lib/drracket/private/palaka.rkt

@@ -24,17 +24,15 @@
 (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)])
+    (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)))))
   (send dc set-alpha alpha))
 
 (define (draw-one-palaka dc dx dy)

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)

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)

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)

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)])