Skip to content

Automated Resyntax fixes #464

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

Closed
resyntax-ci wants to merge 10 commits into from
Closed

Automated Resyntax fixes #464

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
00a1d6e
Fix 6 occurrences of `tidy-require`
resyntax-ci[bot] Dec 18, 2024
b15060c
Fix 5 occurrences of `let-to-define`
resyntax-ci[bot] Dec 18, 2024
729ec3e
Fix 1 occurrence of `map-to-for`
resyntax-ci[bot] Dec 18, 2024
f6c3fca
Fix 2 occurrences of `if-let-to-cond`
resyntax-ci[bot] Dec 18, 2024
ff38809
Fix 1 occurrence of `define-let-to-double-define`
resyntax-ci[bot] Dec 18, 2024
e506a8f
Fix 1 occurrence of `always-throwing-if-to-when`
resyntax-ci[bot] Dec 18, 2024
fb4fd13
Fix 1 occurrence of `define-syntax-syntax-rules-to-define-syntax-rule`
resyntax-ci[bot] Dec 18, 2024
0c94b40
Fix 1 occurrence of `cond-let-to-cond-define`
resyntax-ci[bot] Dec 18, 2024
634b20f
Fix 1 occurrence of `arrow-contract-with-rest-to-arrow-contract-with-…
resyntax-ci[bot] Dec 18, 2024
cdbcc16
Fix 1 occurrence of `let-to-define`
resyntax-ci[bot] Dec 18, 2024
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
129 changes: 59 additions & 70 deletions scribble-doc/scribblings/scribble/class-diagrams.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
#lang racket/base
(require (prefix-in etc: mzlib/etc)
(require racket/class
racket/contract
racket/draw
racket/runtime-path
texpict/mrpict
(prefix-in etc: mzlib/etc)
(only-in pict pin-line pin-arrow-line)
(except-in texpict/utils pin-line pin-arrow-line)
racket/class
racket/runtime-path
racket/draw
racket/contract
(only-in racket/list last))

(define the-font-size 12)
Expand Down Expand Up @@ -70,41 +70,33 @@
(unless (even? (length args))
(error 'method-spec "expected a list of types and argument names, but found ~a arguments"
(length args)))
(let ([first-line
(hbl-append
(type-spec range)
(normal-font " ")
(var-font name)
(cond
[(null? args)
(normal-font "()")]
[else
(hbl-append
(normal-font "(")
(let loop ([args args])
(let* ([type (car args)]
[param (cadr args)]
[single-arg
(if param
(hbl-append (type-spec type)
(normal-font " ")
(var-font param))
(type-spec type))])

(cond
[(null? (cddr args))
(hbl-append single-arg (normal-font ")"))]
[else
(hbl-append single-arg
(normal-font ", ")
(loop (cddr args)))]))))])
(if body
(hbl-append (normal-font " {"))
(blank)))])
(if body
(vl-append first-line
(hbl-append (blank 8 0) body (normal-font "}")))
first-line)))
(define first-line
(hbl-append
(type-spec range)
(normal-font " ")
(var-font name)
(cond
[(null? args) (normal-font "()")]
[else
(hbl-append
(normal-font "(")
(let loop ([args args])
(define type (car args))
(define param (cadr args))
(define single-arg
(if param
(hbl-append (type-spec type) (normal-font " ") (var-font param))
(type-spec type)))

(cond
[(null? (cddr args)) (hbl-append single-arg (normal-font ")"))]
[else (hbl-append single-arg (normal-font ", ") (loop (cddr args)))])))])
(if body
(hbl-append (normal-font " {"))
(blank))))
(if body
(vl-append first-line (hbl-append (blank 8 0) body (normal-font "}")))
first-line))

(define (type-spec str)
(cond
Expand All @@ -126,35 +118,32 @@

;; class-box : pict (or/c #f (listof pict)) (or/c #f (listof pict)) -> pict
(define (class-box name fields methods)
(let* ([mk-blank (λ () (blank 0 (+ class-box-margin class-box-margin)))])
(cond
[(and methods fields)
(let* ([top-spacer (mk-blank)]
[bottom-spacer (mk-blank)]
[main (vl-append name
top-spacer
(if (null? fields)
(blank 0 4)
(apply vl-append fields))
bottom-spacer
(if (null? methods)
(blank 0 4)
(apply vl-append methods)))])
(add-hline
(add-hline (frame (inset main class-box-margin))
top-spacer)
bottom-spacer))]
[fields
(let* ([top-spacer (mk-blank)]
[main (vl-append name
top-spacer
(if (null? fields)
(blank)
(apply vl-append fields)))])
(add-hline (frame (inset main class-box-margin))
top-spacer))]
[methods (class-box name methods fields)]
[else (frame (inset name class-box-margin))])))
(define (mk-blank)
(blank 0 (+ class-box-margin class-box-margin)))
(cond
[(and methods fields)
(let* ([top-spacer (mk-blank)]
[bottom-spacer (mk-blank)]
[main (vl-append name
top-spacer
(if (null? fields)
(blank 0 4)
(apply vl-append fields))
bottom-spacer
(if (null? methods)
(blank 0 4)
(apply vl-append methods)))])
(add-hline (add-hline (frame (inset main class-box-margin)) top-spacer) bottom-spacer))]
[fields
(let* ([top-spacer (mk-blank)]
[main (vl-append name
top-spacer
(if (null? fields)
(blank)
(apply vl-append fields)))])
(add-hline (frame (inset main class-box-margin)) top-spacer))]
[methods (class-box name methods fields)]
[else (frame (inset name class-box-margin))]))

(define (add-hline main sub)
(let-values ([(x y) (cc-find main sub)])
Expand Down Expand Up @@ -438,7 +427,7 @@
(define-values (main3 dot3) (add-dot-junction main2 dot2 cc-find finish-class ct-find))
(connect-dots #t main3 dot1 dot2 dot3)))

(define connect-dots-contract (->* (boolean? pict? pict?) () #:rest (listof pict?) (values pict?)))
(define connect-dots-contract (-> boolean? pict? pict? pict? ... (values pict?)))

(provide type-link-color)
(provide/contract
Expand Down
104 changes: 51 additions & 53 deletions scribble-doc/scribblings/scribble/utils.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -49,22 +49,20 @@
[pos base]
[second #f]
[accum null])
(if (null? e)
(datum->syntax
p (reverse accum)
(list (syntax-source p) (syntax-line p) base (add1 base)
(- pos base))
p)
(let* ([v ((norm-spacing (if (= line (syntax-line (car e)))
pos
(or second pos)))
(car e))]
[next-pos (+ (syntax-column v) (syntax-span v) 1)])
(loop (cdr e)
(syntax-line v)
next-pos
(or second next-pos)
(cons v accum)))))]
(cond
[(null? e)
(datum->syntax p
(reverse accum)
(list (syntax-source p) (syntax-line p) base (add1 base) (- pos base))
p)]
[else
(define v
((norm-spacing (if (= line (syntax-line (car e)))
pos
(or second pos)))
(car e)))
(define next-pos (+ (syntax-column v) (syntax-span v) 1))
(loop (cdr e) (syntax-line v) next-pos (or second next-pos) (cons v accum))]))]
[else (datum->syntax
p (syntax-e p)
(list (syntax-source p) (syntax-line p) base (add1 base) 1)
Expand All @@ -77,32 +75,33 @@
(port-count-lines! p)
(let loop ([r '()] [newlines? #f])
(regexp-match? #px#"^[[:space:]]*" p)
(let* ([p1 (file-position p)]
[stx (scribble:read-syntax #f p)]
[p2 (file-position p)])
(if (not (eof-object? stx))
(define p1 (file-position p))
(define stx (scribble:read-syntax #f p))
(define p2 (file-position p))
(if (not (eof-object? stx))
(let ([str (substring lines p1 p2)])
(loop (cons (list str stx) r)
(or newlines? (regexp-match? #rx#"\n" str))))
(loop (cons (list str stx) r) (or newlines? (regexp-match? #rx#"\n" str))))
(let* ([r (reverse r)]
[r (if newlines?
(cdr (apply append (map (lambda (x) (list #f x)) r)))
r)])
(make-table
plain
(map (lambda (x)
(let ([@expr (if x (litchar/lines (car x)) "")]
[sexpr (if x
(racket:to-paragraph
((norm-spacing 0) (cadr x)))
"")]
[reads-as (if x reads-as "")])
(map as-flow (list spacer @expr reads-as sexpr))))
r))))))))
(cdr (apply append (map (lambda (x) (list #f x)) r)))
r)])
(make-table plain
(map (lambda (x)
(let ([@expr (if x
(litchar/lines (car x))
"")]
[sexpr (if x
(racket:to-paragraph ((norm-spacing 0) (cadr x)))
"")]
[reads-as (if x reads-as "")])
(map as-flow (list spacer @expr reads-as sexpr))))
r)))))))

;; stuff for the scribble/text examples

(require racket/list (for-syntax racket/base racket/list))
(require (for-syntax racket/base
racket/list)
racket/list)

(define max-textsample-width 45)

Expand All @@ -112,12 +111,12 @@
(define strs2 (split out-text))
(define strsm (map (compose split cdr) more))
(define (str->elts str)
(let ([spaces (regexp-match-positions #rx"(?:^| ) +" str)])
(if spaces
(define spaces (regexp-match-positions #rx"(?:^| ) +" str))
(if spaces
(list* (str->elts (substring str 0 (caar spaces)))
(smaller (hspace (- (cdar spaces) (caar spaces))))
(str->elts (substring str (cdar spaces))))
(list (smaller (make-element 'tt str))))))
(list (smaller (make-element 'tt str)))))
(define (make-line str)
(list (as-flow (if (equal? str "")
(smaller (hspace 1))
Expand All @@ -129,15 +128,16 @@
(filebox file t)
t))))
(define filenames (map car more))
(define indent (let ([d (- max-textsample-width
(for*/fold ([m 0])
([s (in-list (cons strs1 strsm))]
[s (in-list s)])
(max m (string-length s))))])
(if (negative? d)
(error 'textsample-verbatim-boxes
"left box too wide for sample at line ~s" line)
(make-element 'tt (list (hspace d))))))
(define d
(- max-textsample-width
(for*/fold ([m 0])
([s (in-list (cons strs1 strsm))]
[s (in-list s)])
(max m (string-length s)))))
(define indent
(if (negative? d)
(error 'textsample-verbatim-boxes "left box too wide for sample at line ~s" line)
(make-element 'tt (list (hspace d)))))
;; Note: the font-size property is reset for every table, so we need it
;; everywhere there's text, and they don't accumulate for nested tables
(values
Expand Down Expand Up @@ -186,11 +186,9 @@
(and (string? (syntax-e #'sep)) (regexp-match? sep-rx (syntax-e #'sep)))
(let ([m (cond [(regexp-match sep-rx (syntax-e #'sep)) => cadr]
[else #f])])
(if (and m (not (regexp-match? file-rx m)))
(raise-syntax-error #f "bad filename specified" stx #'sep)
(loop #'xs
(list (and m (datum->syntax #'sep m #'sep #'sep)))
(cons (reverse text) texts))))]
(when (and m (not (regexp-match? file-rx m)))
(raise-syntax-error #f "bad filename specified" stx #'sep))
(loop #'xs (list (and m (datum->syntax #'sep m #'sep #'sep))) (cons (reverse text) texts)))]
[(x . xs) (loop #'xs (cons #'x text) texts)]
[() (let ([texts (reverse (cons (reverse text) texts))]
[line (syntax-line stx)])
Expand Down
6 changes: 3 additions & 3 deletions scribble-lib/scriblib/figure.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
#lang racket/base
(require racket/contract/base
scribble/manual
scribble/core
scribble/decode
scribble/html-properties
scribble/latex-properties
scribble/manual
scribble/private/lang-parameters
setup/main-collects
"private/counter.rkt"
scribble/private/lang-parameters)
"private/counter.rkt")

(provide figure
figure*
Expand Down
43 changes: 16 additions & 27 deletions scribble-lib/scriblib/footnote.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
#lang racket/base

(require scribble/core
(require racket/promise
scribble/core
scribble/decode
scribble/html-properties
scribble/latex-properties
racket/promise
setup/main-collects
"private/counter.rkt")

Expand Down Expand Up @@ -44,27 +44,19 @@
(define (footnote-part . text) (do-footnote-part footnotes id))))

(define (do-footnote footnotes id text)
(let ([tag (generated-tag)]
[content (decode-content text)])
(make-traverse-element
(lambda (get set)
(set id (cons (cons
(make-element footnote-target-style
(make-element
'superscript
(counter-target footnotes tag #f)))
(define tag (generated-tag))
(define content (decode-content text))
(make-traverse-element
(lambda (get set)
(set id
(cons (cons (make-element footnote-target-style
(make-element 'superscript (counter-target footnotes tag #f)))
content)
(get id null)))
(make-element footnote-style
(list
(make-element
footnote-ref-style
(make-element
'superscript
(counter-ref footnotes tag #f)))
(make-element
footnote-content-style
content)))))))
(get id null)))
(make-element footnote-style
(list (make-element footnote-ref-style
(make-element 'superscript (counter-ref footnotes tag #f)))
(make-element footnote-content-style content))))))

(define (do-footnote-part footnotes id)
(make-part
Expand All @@ -78,9 +70,6 @@
(lambda (get set)
(make-compound-paragraph
footnote-block-style
(map (lambda (content)
(make-paragraph
footnote-block-content-style
content))
(reverse (get id null)))))))
(for/list ([content (in-list (reverse (get id null)))])
(make-paragraph footnote-block-content-style content))))))
null))
Loading
Loading