Skip to content

Automated Resyntax fixes #518

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.

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

Merged
merged 10 commits into from
Jun 26, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
31 changes: 12 additions & 19 deletions scribble-lib/scribble/private/doc-begin.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -66,22 +66,15 @@
#'(check-pre-part s (quote-syntax loc))))]))

(define (check-pre-part v loc-stx)
(if (pre-part? v)
v
(error
(format
"~a: not valid in document body (need a pre-part for decode) in: ~e"
(cond
[(and (syntax-source loc-stx)
(syntax-line loc-stx))
(format "~a:~a:~a"
(syntax-source loc-stx)
(syntax-line loc-stx)
(syntax-column loc-stx))]
[(and (syntax-source loc-stx)
(syntax-position loc-stx))
(format "~a:::~a"
(syntax-source loc-stx)
(syntax-position loc-stx))]
[else 'document])
v))))
(unless (pre-part? v)
(error
(format
"~a: not valid in document body (need a pre-part for decode) in: ~e"
(cond
[(and (syntax-source loc-stx) (syntax-line loc-stx))
(format "~a:~a:~a" (syntax-source loc-stx) (syntax-line loc-stx) (syntax-column loc-stx))]
[(and (syntax-source loc-stx) (syntax-position loc-stx))
(format "~a:::~a" (syntax-source loc-stx) (syntax-position loc-stx))]
[else 'document])
v)))
v)
43 changes: 23 additions & 20 deletions scribble-lib/scribble/private/manual-bib.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -11,18 +11,21 @@

(define-struct a-bib-entry (key val))

(provide/contract
[cite ((string?) () #:rest (listof string?) . ->* . element?)]
[bib-entry ((#:key string? #:title (or/c #f pre-content?))
(#:is-book? boolean? #:author (or/c #f pre-content?)
#:location (or/c #f pre-content?)
#:date (or/c #f pre-content?)
#:url (or/c #f pre-content?)
#:note (or/c #f pre-content?))
. ->* .
a-bib-entry?)]
[rename a-bib-entry? bib-entry? predicate/c]
[bibliography (() (#:tag string?) #:rest (listof a-bib-entry?) . ->* . part?)])
(provide (contract-out
[cite ((string?) () #:rest (listof string?) . ->* . element?)]
[bib-entry
((#:key string? #:title (or/c #f pre-content?)) (#:is-book? boolean?
#:author (or/c #f pre-content?)
#:location (or/c #f pre-content?)
#:date (or/c #f pre-content?)
#:url (or/c #f pre-content?)
#:note (or/c #f pre-content?))
. ->* .
a-bib-entry?)]
(rename a-bib-entry?
bib-entry?
predicate/c)
[bibliography (() (#:tag string?) #:rest (listof a-bib-entry?) . ->* . part?)]))

(define (cite key . keys)
(make-element
Expand Down Expand Up @@ -65,7 +68,9 @@
`(" " ,@(decode-content (list location)) ,(if date "," "."))
null)
(if date `(" " ,@(decode-content (list date)) ".") null)
(if url `(" " ,(link url (tt url))) null)
(if url (list " "
(link url
(tt url))) null)
(if note (decode-content (list note)) null)))))

(define-on-demand bib-style (make-style "RBibliography" scheme-properties))
Expand All @@ -81,12 +86,10 @@
(list
(make-table
bib-style
(map (lambda (c)
(define key (a-bib-entry-key c))
(define val (a-bib-entry-val c))
(list
(to-flow (make-target-element #f `("[" ,key "]") `(cite ,key)))
(for/list ([c (in-list citations)])
(define key (a-bib-entry-key c))
(define val (a-bib-entry-val c))
(list (to-flow (make-target-element #f `("[" ,key "]") `(cite ,key)))
flow-spacer
(to-flow val)))
citations))))
(to-flow val))))))
null))
189 changes: 85 additions & 104 deletions scribble-lib/scribble/private/manual-bind.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -59,10 +59,7 @@
(define hovers (make-weak-hasheq))
(define (intern-hover-style text)
(let ([text (datum-intern-literal text)])
(or (hash-ref hovers text #f)
(let ([s (make-style #f (list (make-hover-property text)))])
(hash-set! hovers text s)
s))))
(hash-ref! hovers text (λ () (make-style #f (list (make-hover-property text)))))))

(define (annote-exporting-library e)
(make-delayed-element
Expand All @@ -71,15 +68,14 @@
(if (and from (pair? from))
(make-element
(intern-hover-style
(string-append
"Provided from: "
(string-join (map ~s from) ", ")
(let ([from-pkgs (resolve-get/tentative p ri '(exporting-packages #f))])
(if (and from-pkgs (pair? from-pkgs))
(string-append
" | Package: "
(string-join (map ~a from-pkgs) ", "))
""))))
(string-join (map ~s from)
", "
#:before-first "Provided from: "
#:after-last
(let ([from-pkgs (resolve-get/tentative p ri '(exporting-packages #f))])
(if (and from-pkgs (pair? from-pkgs))
(string-append " | Package: " (string-join (map ~a from-pkgs) ", "))
""))))
e)
e))
(lambda () e)
Expand Down Expand Up @@ -114,30 +110,30 @@
(lambda (x add) x)))
(let ([lib
(or (for/or ([lib (in-list (or source-libs null))])
(let ([checker
(hash-ref
checkers lib
(lambda ()
(define ns-id
(let ([ns (make-base-empty-namespace)])
(parameterize ([current-namespace ns])
;; A `(namespace-require `(for-label ,lib))` can
;; fail if `lib` provides different bindings of the
;; same name at different phases. We can require phases
;; 1 and 0 separately, in which case the phase-0
;; binding shadows the phase-1 one in that case.
;; This strategy only works for documenting bindings
;; at phases 0 and 1, though.
(namespace-require `(just-meta 1 (for-label ,lib)))
(namespace-require `(just-meta 0 (for-label ,lib)))
(namespace-syntax-introduce (datum->syntax #f 'x)))))
(define (checker id intro)
(free-label-identifier=?
(intro (datum->syntax ns-id (syntax-e id)) 'add)
(intro id 'add)))
(hash-set! checkers lib checker)
checker))])
(and (checker id intro) lib)))
(define checker
(hash-ref checkers
lib
(lambda ()
(define ns-id
(let ([ns (make-base-empty-namespace)])
(parameterize ([current-namespace ns])
;; A `(namespace-require `(for-label ,lib))` can
;; fail if `lib` provides different bindings of the
;; same name at different phases. We can require phases
;; 1 and 0 separately, in which case the phase-0
;; binding shadows the phase-1 one in that case.
;; This strategy only works for documenting bindings
;; at phases 0 and 1, though.
(namespace-require `(just-meta 1 (for-label ,lib)))
(namespace-require `(just-meta 0 (for-label ,lib)))
(namespace-syntax-introduce (datum->syntax #f 'x)))))
(define (checker id intro)
(free-label-identifier=? (intro (datum->syntax ns-id (syntax-e id))
'add)
(intro id 'add)))
(hash-set! checkers lib checker)
checker)))
(and (checker id intro) lib))
(and (pair? libs) (car libs)))])
(and lib (module-path-index->taglet
(module-path-index-join lib #f)))))
Expand Down Expand Up @@ -198,79 +194,64 @@
#:show-libs? [show-libs? #t])
;; This function could have more optional argument to select
;; whether to index the id, include a toc link, etc.
(let ([dep? #t])
(define maker
(if form?
(id-to-form-target-maker id dep?)
(id-to-target-maker id dep?)))
(define-values (elem elem-ref)
(if show-libs?
(definition-site (syntax-e id) id form?)
(values (to-element id #:defn? #t)
(to-element id))))
(if maker
(maker elem
(lambda (tag)
(let ([elem
(if index?
(make-index-element
#f (list elem) tag
(list (datum-intern-literal (symbol->string (syntax-e id))))
(list elem)
(and show-libs?
(with-exporting-libraries
(lambda (libs)
(make-exported-index-desc (syntax-e id)
libs)))))
elem)])
(make-target-element #f (list elem) tag))))
elem)))
(define dep? #t)
(define maker
(if form?
(id-to-form-target-maker id dep?)
(id-to-target-maker id dep?)))
(define-values (elem elem-ref)
(if show-libs?
(definition-site (syntax-e id) id form?)
(values (to-element id #:defn? #t) (to-element id))))
(if maker
(maker elem
(lambda (tag)
(let ([elem (if index?
(make-index-element
#f
(list elem)
tag
(list (datum-intern-literal (symbol->string (syntax-e id))))
(list elem)
(and show-libs?
(with-exporting-libraries
(lambda (libs) (make-exported-index-desc (syntax-e id) libs)))))
elem)])
(make-target-element #f (list elem) tag))))
elem))

(define (make-binding-redirect-elements mod-path redirects)
(define taglet (module-path-index->taglet
(module-path-index-join mod-path #f)))
(make-element
#f
(map
(lambda (redirect)
(define id (car redirect))
(define form? (cadr redirect))
(define path (caddr redirect))
(define anchor (cadddr redirect))
(define (make-one kind)
(make-redirect-target-element
#f
null
(intern-taglet (list kind (list taglet id)))
path
anchor))
(make-element
#f
(list (make-one (if form? 'form 'def))
(make-dep (list taglet id) null)
(let ([str (datum-intern-literal (symbol->string id))])
(make-index-element #f
null
(intern-taglet
(list (if form? 'form 'def)
(list taglet id)))
(list str)
(list
(make-element
symbol-color
(list
(make-element
(if form?
syntax-link-color
value-link-color)
(list str)))))
(make-exported-index-desc*
id
(list mod-path)
(hash 'kind (if form?
"syntax"
"procedure"))))))))
redirects)))
(for/list ([redirect (in-list redirects)])
(define id (car redirect))
(define form? (cadr redirect))
(define path (caddr redirect))
(define anchor (cadddr redirect))
(define (make-one kind)
(make-redirect-target-element #f
null
(intern-taglet (list kind (list taglet id)))
path
anchor))
(make-element
#f
(list (make-one (if form? 'form 'def))
(make-dep (list taglet id) null)
(let ([str (datum-intern-literal (symbol->string id))])
(make-index-element
#f
null
(intern-taglet (list (if form? 'form 'def) (list taglet id)))
(list str)
(list (make-element symbol-color
(list (make-element (if form? syntax-link-color value-link-color)
(list str)))))
(make-exported-index-desc* id
(list mod-path)
(hash 'kind (if form? "syntax" "procedure"))))))))))


(define (make-dep t content)
Expand Down
37 changes: 16 additions & 21 deletions scribble-lib/scribble/private/manual-form.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -413,11 +413,12 @@
flow-empty-line flow-empty-line)
(list (to-flow nonterm) flow-empty-line (to-flow "=") flow-empty-line
(make-flow (list (car clauses))))
(map (lambda (clause)
(list flow-empty-line flow-empty-line
(to-flow "|") flow-empty-line
(make-flow (list clause))))
(cdr clauses))))
(for/list ([clause (in-list (cdr clauses))])
(list flow-empty-line
flow-empty-line
(to-flow "|")
flow-empty-line
(make-flow (list clause))))))
nonterms clauseses))))

(define (*racketrawgrammar style nonterm clause1 . clauses)
Expand All @@ -426,11 +427,8 @@
(define (*racketgrammar lits s-expr clauseses-thunk)
(define l (clauseses-thunk))
(*racketrawgrammars #f
(map (lambda (x)
(make-element #f
(list (hspace 2)
(car x))))
l)
(for/list ([x (in-list l)])
(make-element #f (list (hspace 2) (car x))))
(map cdr l)))

(define (*var id)
Expand All @@ -445,14 +443,11 @@
(append
(list (list flow-empty-line))
(list (list (make-flow
(map (lambda (c)
(make-table
"argcontract"
(list
(list (to-flow (hspace 2))
(to-flow ((car c)))
flow-spacer
(to-flow ":")
flow-spacer
(make-flow (list ((cadr c))))))))
contract-procs)))))))
(for/list ([c (in-list contract-procs)])
(make-table "argcontract"
(list (list (to-flow (hspace 2))
(to-flow ((car c)))
flow-spacer
(to-flow ":")
flow-spacer
(make-flow (list ((cadr c))))))))))))))
Loading
Loading