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/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
@@ -158,19 +159,17 @@
 ;; get-defn-indent : text number -> number
 ;; returns the amount to indent a particular definition
 (define (get-defn-indent text pos)
-  (let* ([para (send text position-paragraph pos)]
-         [para-start (send text paragraph-start-position para #t)])
-    (let loop ([c-pos para-start]
-               [offset 0])
-      (cond
-        [(< c-pos pos)
-         (define char (send text get-character c-pos))
-         (cond
-           [(char=? char #\tab)
-            (loop (+ c-pos 1) (+ offset (- 8 (modulo offset 8))))]
-           [else
-            (loop (+ c-pos 1) (+ offset 1))])]
-        [else offset]))))
+  (define para (send text position-paragraph pos))
+  (define para-start (send text paragraph-start-position para #t))
+  (let loop ([c-pos para-start]
+             [offset 0])
+    (cond
+      [(< c-pos pos)
+       (define char (send text get-character c-pos))
+       (cond
+         [(char=? char #\tab) (loop (+ c-pos 1) (+ offset (- 8 (modulo offset 8))))]
+         [else (loop (+ c-pos 1) (+ offset 1))])]
+      [else offset])))
 
 ;; whitespace-or-paren?
 (define (whitespace-or-paren? char)

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 "#|")

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)

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