Skip to content
8 changes: 4 additions & 4 deletions scribble-lib/scribble/acmart.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -45,8 +45,8 @@
#:email (or/c pre-content? email? (listof email?)))
#:rest (listof pre-content?)
block?)]
[authorsaddresses (->* () () #:rest (listof pre-content?) block?)]
[shortauthors (->* () () #:rest (listof pre-content?) element?)]
[authorsaddresses (-> pre-content? ... block?)]
[shortauthors (-> pre-content? ... element?)]
[institution
(->* ()
(#:departments (listof (or/c pre-content? institution?)))
Expand All @@ -67,7 +67,7 @@
#:country (or/c pre-content? #f))
affiliation?)]
[affiliation? (-> any/c boolean?)]
[abstract (->* () () #:rest (listof pre-content?) block?)]
[abstract (-> pre-content? ... block?)]
[acmConference (-> string? string? string? block?)]
[grantsponsor (-> string? string? string? content?)]
[grantnum (->* (string? string?) (#:url string?) content?)]
Expand All @@ -76,7 +76,7 @@
[received (->* (string?) (#:stage string?) block?)]
[citestyle (-> content? block?)]
[ccsdesc (->* (string?) (#:number exact-integer?) block?)]
[CCSXML (->* () () #:rest (listof pre-content?) any/c)]))
[CCSXML (-> pre-content? ... any/c)]))
(provide
invisible-element-to-collect-for-acmart-extras
include-abstract)
Expand Down
3 changes: 1 addition & 2 deletions scribble-lib/scribble/example.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -15,8 +15,7 @@

make-log-based-eval
scribble-exn->string
scribble-eval-handler
make-log-based-eval)
scribble-eval-handler)

(define example-title
(make-paragraph (list "Example:")))
Expand Down
62 changes: 30 additions & 32 deletions scribble-lib/scribble/run.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,8 @@

(module test racket/base)

(define multi-html:render-mixin
(lambda (%) (html:render-multi-mixin (html:render-mixin %))))
(define (multi-html:render-mixin %)
(html:render-multi-mixin (html:render-mixin %)))

(define current-render-mixin (make-parameter html:render-mixin))
(define current-html (make-parameter #t))
Expand All @@ -37,10 +37,9 @@
(define current-image-prefs (make-parameter null)) ; reverse order

(define (read-one str)
(let ([i (open-input-string str)])
(with-handlers ([exn:fail:read? (lambda (x) #f)])
(let ([v (read i)])
(and (eof-object? (read i)) v)))))
(define i (open-input-string str))
(with-handlers ([exn:fail:read? (lambda (x) #f)])
(let ([v (read i)]) (and (eof-object? (read i)) v))))

(define (run)
(define doc-binding 'doc)
Expand Down Expand Up @@ -171,32 +170,29 @@
(make-compilation-manager-load/use-compiled-handler))])
(parameterize ([current-command-line-arguments
(list->vector (reverse (doc-command-line-arguments)))])
(build-docs (map (lambda (file)
(define (go)
(let ([mp (if (current-lib-mode)
`(lib ,file)
`(file ,file))])
;; Try `doc' submodule, first:
(if (module-declared? `(submod ,mp ,doc-binding) #t)
(dynamic-require `(submod ,mp ,doc-binding)
doc-binding)
(dynamic-require mp doc-binding))))
(if maker
(parameterize ([current-load/use-compiled maker])
(go))
(go)))
files)
(build-docs (for/list ([file (in-list files)])
(define (go)
(let ([mp (if (current-lib-mode)
`(lib ,file)
`(file ,file))])
;; Try `doc' submodule, first:
(if (module-declared? `(submod ,mp ,doc-binding) #t)
(dynamic-require `(submod ,mp ,doc-binding) doc-binding)
(dynamic-require mp doc-binding))))
(if maker
(parameterize ([current-load/use-compiled maker])
(go))
(go)))
files)))))

(define (build-docs docs files)
(when (and (current-dest-name)
((length files) . > . 1))
(raise-user-error 'scribble "cannot supply a destination name with multiple inputs"))
(render docs
(map (lambda (fn)
(let-values ([(base name dir?) (split-path fn)])
(or (current-dest-name) name)))
files)
(for/list ([fn (in-list files)])
(define-values (base name dir?) (split-path fn))
(or (current-dest-name) name))
#:dest-dir (current-dest-directory)
#:render-mixin (current-render-mixin)
#:image-preferences (reverse (current-image-prefs))
Expand All @@ -212,13 +208,15 @@
#:quiet? (current-quiet)
#:info-in-files (reverse (current-info-input-files))
#:xrefs (for/list ([mod+id (in-list (reverse (current-xref-input-modules)))])
(let* ([get-xref (dynamic-require (car mod+id) (cdr mod+id))]
[xr (get-xref)])
(unless (xref? xr)
(raise-user-error
'scribble "result from `~s' of `~s' is not an xref: ~e"
(cdr mod+id) (car mod+id) xr))
xr))
(define get-xref (dynamic-require (car mod+id) (cdr mod+id)))
(define xr (get-xref))
(unless (xref? xr)
(raise-user-error 'scribble
"result from `~s' of `~s' is not an xref: ~e"
(cdr mod+id)
(car mod+id)
xr))
xr)
#:info-out-file (current-info-output-file)))

(run)
137 changes: 74 additions & 63 deletions scribble-lib/scribble/srcdoc.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -75,14 +75,13 @@
(syntax-shift-phase-level s #f)))
(with-syntax ([((req ...) ...)
(for/list ([rs (in-list (reverse requires))])
(map (lambda (r)
(syntax-case r ()
[(op arg ...)
(with-syntax ([(arg ...) (map shift-and-introduce
(syntax->list #'(arg ...)))])
#'(op arg ...))]
[else (shift-and-introduce r)]))
(syntax->list rs)))]
(for/list ([r (in-list (syntax->list rs))])
(syntax-case r ()
[(op arg ...)
(with-syntax ([(arg ...) (map shift-and-introduce
(syntax->list #'(arg ...)))])
#'(op arg ...))]
[else (shift-and-introduce r)])))]
[(expr ...)
(map shift-and-introduce (reverse doc-exprs))]
[doc-body
Expand Down Expand Up @@ -128,11 +127,12 @@
(let ([t (syntax-local-value #'id (lambda () #f))])
(unless (provide/doc-transformer? t)
(raise-syntax-error #f "not bound as a provide/doc transformer" stx #'id))
(let* ([i (make-syntax-introducer)]
[i2 (lambda (x) (syntax-local-introduce (i x)))])
(let-values ([(p/c d req/d id) ((provide/doc-transformer-proc t)
(i (syntax-local-introduce form)))])
(list (i2 p/c) (i req/d) (i d) (i id)))))]
(define i (make-syntax-introducer))
(define (i2 x)
(syntax-local-introduce (i x)))
(let-values ([(p/c d req/d id) ((provide/doc-transformer-proc t)
(i (syntax-local-introduce form)))])
(list (i2 p/c) (i req/d) (i d) (i id))))]
[_ (raise-syntax-error #f "not a provide/doc sub-form" stx form)]))])
(with-syntax ([(p/c ...)
(map (lambda (form f)
Expand Down Expand Up @@ -345,44 +345,52 @@

(let ([build-mandatories/optionals
(λ (names contracts extras)
(let ([names-length (length names)]
[contracts-length (length contracts)])
(let loop ([contracts contracts]
[names names]
[extras extras])
(cond
[(and (null? names) (null? contracts)) '()]
[(or (null? names) (null? contracts))
(raise-syntax-error #f
(format "mismatched ~a argument list count and domain contract count (~a)"
(if extras "optional" "mandatory")
(if (null? names)
"ran out of names"
"ran out of contracts"))
stx)]
[else
(let ([fst-name (car names)]
[fst-ctc (car contracts)])
(if (keyword? (syntax-e fst-ctc))
(begin
(unless (pair? (cdr contracts))
(raise-syntax-error #f
"keyword not followed by a contract"
stx))
(cons (if extras
(list fst-ctc fst-name (cadr contracts) (car extras))
(list fst-ctc fst-name (cadr contracts)))
(loop (cddr contracts)
(cdr names)
(if extras
(cdr extras)
extras))))
(cons (if extras
(list fst-name fst-ctc (car extras))
(list fst-name fst-ctc))
(loop (cdr contracts) (cdr names) (if extras
(cdr extras)
extras)))))]))))])
(length names)
(length contracts)
(let loop ([contracts contracts]
[names names]
[extras extras])
(cond
[(and (null? names) (null? contracts)) '()]
[(or (null? names) (null? contracts))
(raise-syntax-error
#f
(format
"mismatched ~a argument list count and domain contract count (~a)"
(if extras "optional" "mandatory")
(if (null? names)
"ran out of names"
"ran out of contracts"))
stx)]
[else
(let ([fst-name (car names)]
[fst-ctc (car contracts)])
(if (keyword? (syntax-e fst-ctc))
(begin
(unless (pair? (cdr contracts))
(raise-syntax-error
#f
"keyword not followed by a contract"
stx))
(cons (if extras
(list fst-ctc
fst-name
(cadr contracts)
(car extras))
(list fst-ctc fst-name (cadr contracts)))
(loop (cddr contracts)
(cdr names)
(if extras
(cdr extras)
extras))))
(cons (if extras
(list fst-name fst-ctc (car extras))
(list fst-name fst-ctc))
(loop (cdr contracts)
(cdr names)
(if extras
(cdr extras)
extras)))))])))])

#`([(id #,@(build-mandatories/optionals (syntax->list #'(mandatory-names ...))
(syntax->list #'(mandatory ...))
Expand All @@ -404,19 +412,22 @@
[((x y) ...)
(andmap identifier? (syntax->list #'(x ... y ...)))]
[((x y) ...)
(for-each
(λ (var)
(unless (identifier? var)
(raise-syntax-error #f "expected an identifier in the optional names" stx var)))
(syntax->list #'(x ... y ...)))]
(for ([var (in-list (syntax->list #'(x ... y ...)))])
(unless (identifier? var)
(raise-syntax-error
#f
"expected an identifier in the optional names"
stx
var)))]
[(a ...)
(for-each
(λ (a)
(syntax-case stx ()
[(x y) (void)]
[other
(raise-syntax-error #f "expected an sequence of two idenfiers" stx #'other)]))
(syntax->list #'(a ...)))]))]
(for ([a (in-list (syntax->list #'(a ...)))])
(syntax-case stx ()
[(x y) (void)]
[other
(raise-syntax-error #f
"expected an sequence of two idenfiers"
stx
#'other)]))]))]
[x
(raise-syntax-error
#f
Expand Down
Loading