Skip to content

Automated Resyntax fixes #757

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 10 commits into
base: master
Choose a base branch
from
Open

Automated Resyntax fixes #757

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
9e372da
Fix 9 occurrences of `let-to-define`
resyntax-ci[bot] Jul 13, 2025
21a195c
Fix 1 occurrence of `define-lambda-to-define`
resyntax-ci[bot] Jul 13, 2025
24e5a54
Fix 1 occurrence of `if-else-false-to-and`
resyntax-ci[bot] Jul 13, 2025
27f4dec
Fix 2 occurrences of `for-each-to-for`
resyntax-ci[bot] Jul 13, 2025
3d781cd
Fix 1 occurrence of `apply-flattening`
resyntax-ci[bot] Jul 13, 2025
9646d22
Fix 1 occurrence of `when-expression-in-for-loop-to-when-keyword`
resyntax-ci[bot] Jul 13, 2025
b9963dc
Fix 2 occurrences of `map-to-for`
resyntax-ci[bot] Jul 13, 2025
7536896
Fix 1 occurrence of `if-begin-to-cond`
resyntax-ci[bot] Jul 13, 2025
3062d0d
Fix 1 occurrence of `send-chain-to-send+`
resyntax-ci[bot] Jul 13, 2025
2f1136a
Fix 1 occurrence of `nested-if-to-cond`
resyntax-ci[bot] Jul 13, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion drracket-tool-lib/drracket/private/standalone-module-browser.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1272,7 +1272,8 @@
[(null? ms) (substring short-name 0 (min 2 (string-length short-name)))]
[else
(apply string-append
(cons (substring short-name 0 1) (map (λ (x) (substring x 1 2)) ms)))])])]
(substring short-name 0 1)
(map (λ (x) (substring x 1 2)) ms))])])]
[(long) word]
[(very-long) (string-append word ": " (format "~s" require-phases))]))
last-name]))
Expand Down
31 changes: 14 additions & 17 deletions drracket/browser/private/bullet.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,8 +11,7 @@

(define bullet-size
(make-parameter
(let ([s (send (send (send (make-object text%) get-style-list) basic-style)
get-size)])
(let ([s (send+ (make-object text%) (get-style-list) (basic-style) (get-size))])
(max 7 (quotient s 2)))))

(define (get-bullet-width)
Expand Down Expand Up @@ -51,16 +50,15 @@
[(0) (values (lambda (x y w h) (send dc draw-ellipse x y w h)) #t)]
[(1) (values (lambda (x y w h) (send dc draw-ellipse x y w h)) #f)]
[else (values (lambda (x y w h) (send dc draw-rectangle x y w h)) #f)])])
(let ([b (send dc get-brush)])
(send dc set-brush
(if solid?
(send the-brush-list
find-or-create-brush
(send (send dc get-pen) get-color)
'solid)
transparent-brush))
(draw x y bsize bsize)
(send dc set-brush b)))))]
(define b (send dc get-brush))
(send dc set-brush
(if solid?
(send the-brush-list find-or-create-brush
(send (send dc get-pen) get-color)
'solid)
transparent-brush))
(draw x y bsize bsize)
(send dc set-brush b))))]
[define/override copy
(lambda ()
(make-object bullet-snip% depth))]
Expand All @@ -69,11 +67,10 @@
(send stream put depth))]
[define/override get-text
(lambda (offset num flattened?)
(if (< num 1)
""
(if flattened?
"* "
"*")))]
(cond
[(< num 1) ""]
[flattened? "* "]
[else "*"]))]
(super-new)
(set-snipclass bullet-snip-class)
(set-count 1)))
Expand Down
253 changes: 113 additions & 140 deletions drracket/browser/private/html.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -118,19 +118,17 @@
(super on-event dc x y editor-x editor-y evt))

(define/override (adjust-cursor dc x y editor-x editor-y evt)
(let ([snipx (- (send evt get-x) x)]
[snipy (- (send evt get-y) y)])
(if (find-rect snipx snipy)
finger-cursor
#f)))
(define snipx (- (send evt get-x) x))
(define snipy (- (send evt get-y) y))
(if (find-rect snipx snipy) finger-cursor #f))

;; warning: buggy. This doesn't actually copy the bitmap
;; over because there's no get-bitmap method for image-snip%
;; at the time of this writing.
(define/override (copy)
(let ([cp (new image-map-snip% (html-text html-text))])
(send cp set-key key)
(send cp set-rects rects)))
(define cp (new image-map-snip% (html-text html-text)))
(send cp set-key key)
(send cp set-rects rects))

(super-make-object)

Expand All @@ -143,9 +141,9 @@
;;

(define (make-racket-color-delta col)
(let ([d (make-object style-delta%)])
(send d set-delta-foreground col)
d))
(define d (make-object style-delta%))
(send d set-delta-foreground col)
d)

(define racket-code-delta (make-racket-color-delta "brown"))
(define racket-code-delta/keyword
Expand All @@ -163,17 +161,17 @@
(define current-style-class (make-parameter null))

(define (lookup-class-delta class)
(let ([class-path (cons class (current-style-class))])
(cond
[(sub-path? class-path '("racket")) racket-code-delta]
[(sub-path? class-path '("keyword" "racket")) racket-code-delta/keyword]
[(sub-path? class-path '("variable" "racket")) racket-code-delta/variable]
[(sub-path? class-path '("global" "racket")) racket-code-delta/global]
[(or (sub-path? class-path '("selfeval" "racket"))
(sub-path? class-path '("racketresponse"))) racket-code-delta/selfeval]
[(sub-path? class-path '("comment" "racket")) racket-code-delta/comment]
[(sub-path? class-path '("navigation")) navigation-delta]
[else #f])))
(define class-path (cons class (current-style-class)))
(cond
[(sub-path? class-path '("racket")) racket-code-delta]
[(sub-path? class-path '("keyword" "racket")) racket-code-delta/keyword]
[(sub-path? class-path '("variable" "racket")) racket-code-delta/variable]
[(sub-path? class-path '("global" "racket")) racket-code-delta/global]
[(or (sub-path? class-path '("selfeval" "racket")) (sub-path? class-path '("racketresponse")))
racket-code-delta/selfeval]
[(sub-path? class-path '("comment" "racket")) racket-code-delta/comment]
[(sub-path? class-path '("navigation")) navigation-delta]
[else #f]))

(define (sub-path? a b)
(cond
Expand All @@ -193,99 +191,85 @@
(define re:hexcolor
(regexp "^#([0-9a-fA-F][0-9a-fA-F])([0-9a-fA-F][0-9a-fA-F])([0-9a-fA-F][0-9a-fA-F])$"))

(define color-string->color
(lambda (str)
(let ([m (regexp-match re:hexcolor str)])
(if m
(make-object color%
(string->number (cadr m) 16)
(string->number (caddr m) 16)
(string->number (cadddr m) 16))
(send the-color-database find-color str)))))
(define (color-string->color str)
(let ([m (regexp-match re:hexcolor str)])
(if m
(make-object color%
(string->number (cadr m) 16)
(string->number (caddr m) 16)
(string->number (cadddr m) 16))
(send the-color-database find-color str))))

(define html-eval-ok (make-parameter #t))
(define html-img-ok (make-parameter #t))

(define (get-bitmap-from-url url)
(if (html-img-ok)
(let ([tmp-filename (make-temporary-file "rktguiimg~a")])
(load-status #t "image" url)
(call-with-output-file* tmp-filename
(lambda (op)
(with-handlers ([exn:fail?
(lambda (x)
(printf "exn.9 ~s\n" (and (exn? x)
(exn-message x)))
(void))])
(call/input-url
url
get-pure-port
(lambda (ip)
(copy-port ip op)))))
#:exists 'truncate)
(pop-status)
(let ([bitmap (make-object bitmap% tmp-filename)])
(with-handlers ([exn:fail?
(lambda (x)
(message-box "Warning"
(format "Could not delete file ~s\n\n~a"
tmp-filename
(if (exn? x)
(exn-message x)
x))))])
(delete-file tmp-filename))
(if (send bitmap ok?)
bitmap
#f)))
#f))
(and (html-img-ok)
(let ([tmp-filename (make-temporary-file "rktguiimg~a")])
(load-status #t "image" url)
(call-with-output-file*
tmp-filename
(lambda (op)
(with-handlers ([exn:fail? (lambda (x)
(printf "exn.9 ~s\n" (and (exn? x) (exn-message x)))
(void))])
(call/input-url url get-pure-port (lambda (ip) (copy-port ip op)))))
#:exists 'truncate)
(pop-status)
(let ([bitmap (make-object bitmap% tmp-filename)])
(with-handlers ([exn:fail? (lambda (x)
(message-box "Warning"
(format "Could not delete file ~s\n\n~a"
tmp-filename
(if (exn? x)
(exn-message x)
x))))])
(delete-file tmp-filename))
(if (send bitmap ok?) bitmap #f)))))

;; cache-bitmap : string -> (is-a?/c bitmap%)
(define (cache-bitmap url)
(let ([url-string (url->string url)])
(let loop ([n 0])
(cond
[(= n NUM-CACHED)
;; Look for item to uncache
(vector-set! cached-use 0 (max 0 (sub1 (vector-ref cached-use 0))))
(let ([m (let loop ([n 1][m (vector-ref cached-use 0)])
(if (= n NUM-CACHED)
m
(begin
(vector-set! cached-use n (max 0 (sub1 (vector-ref cached-use n))))
(loop (add1 n) (min m (vector-ref cached-use n))))))])
(let loop ([n 0])
(if (= (vector-ref cached-use n) m)
(let ([bitmap (get-bitmap-from-url url)])
(cond
(define url-string (url->string url))
(let loop ([n 0])
(cond
[(= n NUM-CACHED)
;; Look for item to uncache
(vector-set! cached-use 0 (max 0 (sub1 (vector-ref cached-use 0))))
(let ([m (let loop ([n 1]
[m (vector-ref cached-use 0)])
(if (= n NUM-CACHED)
m
(begin
(vector-set! cached-use n (max 0 (sub1 (vector-ref cached-use n))))
(loop (add1 n) (min m (vector-ref cached-use n))))))])
(let loop ([n 0])
(if (= (vector-ref cached-use n) m)
(let ([bitmap (get-bitmap-from-url url)])
(cond
[bitmap
(vector-set! cached n bitmap)
(vector-set! cached-name n url-string)
(vector-set! cached-use n 5)
bitmap]
[else #f]))
(loop (add1 n)))))]
[(equal? url-string (vector-ref cached-name n))
(vector-set! cached-use n (min 10 (add1 (vector-ref cached-use n))))
(vector-ref cached n)]
[else
(loop (add1 n))]))))
(loop (add1 n)))))]
[(equal? url-string (vector-ref cached-name n))
(vector-set! cached-use n (min 10 (add1 (vector-ref cached-use n))))
(vector-ref cached n)]
[else (loop (add1 n))])))

(define (update-image-maps image-map-snips image-maps)
(for-each
(lambda (image-map-snip)
(let ([image-map-key (send image-map-snip get-key)])
(let loop ([image-maps image-maps])
(cond
[(null? image-maps) (void)]
[else
(let* ([image-map (car image-maps)]
[name (get-field image-map 'name)])
(if (and name
(equal? (format "#~a" name)
(send image-map-snip get-key)))
(find/add-areas image-map-snip image-map)
(loop (cdr image-maps))))]))))
image-map-snips))
(for ([image-map-snip (in-list image-map-snips)])
(send image-map-snip get-key)
(let loop ([image-maps image-maps])
(cond
[(null? image-maps) (void)]
[else
(let* ([image-map (car image-maps)]
[name (get-field image-map 'name)])
(if (and name (equal? (format "#~a" name) (send image-map-snip get-key)))
(find/add-areas image-map-snip image-map)
(loop (cdr image-maps))))]))))

(define (find/add-areas image-map-snip image-map)
(let loop ([sexp image-map])
Expand All @@ -305,28 +289,25 @@
;; matches the above, it is interprted propoerly;
;; otherwise silently nothing happens.
(define (add-area image-map-snip sexp)
(let ([shape #f]
[coords #f]
[href #f])
(let loop ([sexp sexp])
(cond
[(pair? sexp)
(let ([fst (car sexp)])
(when (and (pair? fst)
(symbol? (car fst))
(pair? (cdr fst))
(string? (cadr fst)))
(case (car fst)
[(shape) (set! shape (cadr fst))]
[(coords) (set! coords (cadr fst))]
[(href) (set! href (cadr fst))]
[else (void)]))
(loop (cdr sexp)))]
[else (void)]))
(when (and shape coords href)
(let ([p-coords (parse-coords coords)])
(when p-coords
(send image-map-snip add-area shape p-coords href))))))
(define shape #f)
(define coords #f)
(define href #f)
(let loop ([sexp sexp])
(cond
[(pair? sexp)
(let ([fst (car sexp)])
(when (and (pair? fst) (symbol? (car fst)) (pair? (cdr fst)) (string? (cadr fst)))
(case (car fst)
[(shape) (set! shape (cadr fst))]
[(coords) (set! coords (cadr fst))]
[(href) (set! href (cadr fst))]
[else (void)]))
(loop (cdr sexp)))]
[else (void)]))
(when (and shape coords href)
(let ([p-coords (parse-coords coords)])
(when p-coords
(send image-map-snip add-area shape p-coords href)))))

;; parse-coords : string -> (listof number)
;; separates out a bunch of comma separated numbers in a string
Expand All @@ -337,32 +318,24 @@
[(regexp-match #rx"^[ \t\n]*([0-9]+)[ \t\n]*,(.*)$" str)
=>
(lambda (m)
(let ([num (cadr m)]
[rst (caddr m)])
(cons (string->number num)
(loop rst))))]
(define num (cadr m))
(define rst (caddr m))
(cons (string->number num) (loop rst)))]
[(regexp-match #rx"^[ \t\n]*([0-9]+)[ \t\n]*" str)
=>
(lambda (m)
(list (string->number (cadr m))))]
[else null])))

(define (make-get-field str)
(let ([s (apply
string-append
(map
(lambda (c)
(format "[~a~a]"
(char-upcase c)
(char-downcase c)))
(string->list str)))]
[spc (string #\space #\tab #\newline #\return #\vtab)])
(let ([re:plain (regexp (format "(^|[~a])~a[~a]*=[~a]*([^~a]*)" spc s spc spc spc))]
[re:quote (regexp (format "(^|[~a])~a[~a]*=[~a]*\"([^\"]*)\"" spc s spc spc))])
(lambda (args)
(let ([m (or (regexp-match re:quote args)
(regexp-match re:plain args))])
(and m (caddr m)))))))
(define s
(apply string-append
(map (lambda (c) (format "[~a~a]" (char-upcase c) (char-downcase c))) (string->list str))))
(define spc (string #\space #\tab #\newline #\return #\vtab))
(define re:plain (regexp (format "(^|[~a])~a[~a]*=[~a]*([^~a]*)" spc s spc spc spc)))
(define re:quote (regexp (format "(^|[~a])~a[~a]*=[~a]*\"([^\"]*)\"" spc s spc spc)))
(lambda (args)
(let ([m (or (regexp-match re:quote args) (regexp-match re:plain args))]) (and m (caddr m)))))

(define (get-field e name)
(let ([a (assq name (cadr e))])
Expand Down
Loading