#lang racket/base
(require setup/collects
racket/contract/base
racket/list
scribble/core
scribble/base
scribble/decode
scribble/html-properties
scribble/latex-properties
scribble/private/tag
scribble/private/lang-parameters
(for-syntax racket/base))
(struct affiliation (position institution street-address city state postcode country)
#:constructor-name author-affiliation
#:name author-affiliation
#:transparent)
(struct email (text)
#:constructor-name author-email
#:name author-email
#:transparent)
(struct institution (name departments)
#:constructor-name author-institution
#:name author-institution
#:transparent)
(provide/contract
[title (->* ()
(#:short pre-content?
#:tag (or/c string? (listof string?) #f)
#:tag-prefix (or/c string? module-path? #f)
#:style (or/c style? string? symbol? #f)
#:version (or/c string? #f)
#:date (or/c string? #f))
#:rest (listof pre-content?)
title-decl?)]
[author (->* ()
(#:orcid (or/c pre-content? #f)
#:affiliation (or/c pre-content?
affiliation?
(listof affiliation?)
#f)
#:email (or/c pre-content? email? (listof email?) #f))
#:rest (listof pre-content?)
block?)]
[authorsaddresses (->* ()
()
#:rest (listof pre-content?)
block?)]
[institution (->* ()
(#:departments (listof (or/c pre-content? institution?)))
#:rest pre-content?
institution?)]
[institution? (-> any/c boolean?)]
[email (->* ()
#:rest (listof pre-content?)
email?)]
[email? (-> any/c boolean?)]
[affiliation (->* ()
(#:position (or/c pre-content? #f)
#:institution (or/c pre-content? institution? (listof institution?) #f)
#:street-address (or/c pre-content? #f)
#:city (or/c pre-content? #f)
#:state (or/c pre-content? #f)
#:postcode (or/c pre-content? #f)
#:country (or/c pre-content? #f))
affiliation?)]
[affiliation? (-> any/c boolean?)]
[abstract
(->* () () #:rest (listof pre-content?)
block?)]
[acmConference
(-> string? string? string? block?)]
[grantsponsor
(-> string? string? string? content?)]
[grantnum
(->* (string? string?) (#:url string?) content?)]
[acmBadgeR (->* (string?) (#:url string?) block?)]
[acmBadgeL (->* (string?) (#:url string?) block?)]
[received (->* (string?) (#:stage string?) block?)]
[citestyle (-> content? block?)]
[ccsdesc (->* (string?) (#:number exact-integer?) block?)]
[CCSXML
(->* () () #:rest (listof pre-content?)
any/c)])
(provide
invisible-element-to-collect-for-acmart-extras
include-abstract)
(define-syntax-rule (defopts name ...)
(begin (define-syntax (name stx)
(raise-syntax-error #f
"option must appear on the same line as `#lang scribble/acmart'"
stx))
...
(provide name ...)))
(define-syntax-rule (define-commands name ...)
(begin
(begin
(provide/contract [name (->* () () #:rest (listof pre-content?)
block?)])
(define (name . str)
(make-paragraph (make-style 'pretitle '())
(make-element (make-style (symbol->string 'name) command-props)
(decode-content str)))))
...))
(define-syntax-rule (define-environments name ...)
(begin
(begin
(provide/contract [name (->* () () #:rest (listof pre-flow?)
block?)])
(define (name . str)
(make-nested-flow (make-style (symbol->string 'name) acmart-extras)
(decode-flow str))))
...))
; comment environments ensure the \begin and \end are on their own lines
(define-syntax-rule (define-comment-environments name ...)
(begin
(begin
(provide/contract [name (->* () () #:rest (listof pre-flow?)
block?)])
(define (name . str)
(make-nested-flow (make-style (symbol->string 'name) acmart-extras)
(append (list (make-paragraph (style #f '()) '("")))
(decode-flow str)
(list (make-paragraph (style #f '()) '("")))))))
...))
; format options
(defopts manuscript acmsmall acmlarge acmtog sigconf siggraph sigplan sigchi sigchi-a
dtrap pacmcgit tiot tdsci)
; boolean options
(defopts review screen natbib anonymous authorversion 9pt 10pt 11pt 12pt)
(define acmart-extras
(let ([abs (lambda (s)
(path->collects-relative
(collection-file-path s "scribble" "acmart")))])
(list
(make-css-addition (abs "acmart.css"))
(make-tex-addition (abs "acmart.tex")))))
(define invisible-element-to-collect-for-acmart-extras
(make-element (make-style "invisible-element-to-collect-for-acmart-extras" acmart-extras) '()))
;; ----------------------------------------
;; Abstracts:
(define abstract-style (make-style "abstract" (cons 'pretitle acmart-extras)))
(define command-props (cons 'command acmart-extras))
(define multicommand-props (cons 'multicommand acmart-extras))
(define (abstract . strs)
(make-nested-flow
abstract-style
(decode-flow strs)))
(define (extract-abstract p)
(unless (part? p)
(error 'include-abstract "doc binding is not a part: ~e" p))
(unless (null? (part-parts p))
(error 'include-abstract "abstract part has sub-parts: ~e" (part-parts p)))
(when (part-title-content p)
(error 'include-abstract "abstract part has title content: ~e" (part-title-content p)))
(part-blocks p))
(define-syntax-rule (include-abstract mp)
(begin
(require (only-in mp [doc abstract-doc]))
(make-nested-flow abstract-style (extract-abstract abstract-doc))))
(define (acmConference name date venue)
(make-paragraph (make-style 'pretitle '())
(make-multiarg-element (make-style "acmConference" multicommand-props)
(list (decode-string name)
(decode-string date)
(decode-string venue)))))
(define (grantsponsor id name url)
(make-multiarg-element (make-style "grantsponsor" multicommand-props)
(list (decode-string id)
(decode-string name)
(decode-string url))))
(define (grantnum #:url [url #f] id num)
(if url
(make-multiarg-element (make-style "SgrantnumURL" multicommand-props)
(list (decode-string url)
(decode-string id)
(decode-string num)))
(make-multiarg-element (make-style "grantnum" multicommand-props)
(list (decode-string id)
(decode-string num)))))
(define (acmBadgeR #:url [url #f] str)
(make-paragraph (make-style 'pretitle '())
(if url
(make-multiarg-element (make-style "SacmBadgeRURL" (cons 'exact-chars multicommand-props))
(list (decode-string url)
(decode-string str)))
(make-element (make-style "acmBadgeR" (cons 'exact-chars command-props))
(decode-string str)))))
(define (acmBadgeL #:url [url #f] str)
(make-paragraph (make-style 'pretitle '())
(if url
(make-multiarg-element (make-style "SacmBadgeLURL" (cons 'exact-chars multicommand-props))
(list (decode-string url)
(decode-string str)))
(make-element (make-style "acmBadgeL" (cons 'exact-chars command-props))
(decode-string str)))))
(define (received #:stage [s #f] str)
(make-paragraph (make-style 'pretitle '())
(if s
(make-multiarg-element (make-style "SreceivedStage" multicommand-props)
(list (decode-string s)
(decode-string str)))
(make-element (make-style "received" command-props)
(decode-string str)))))
(define (citestyle str)
(make-paragraph (make-style 'pretitle '())
(make-element (make-style "citestyle" command-props)
(decode-string str))))
(define (ccsdesc #:number [n #f] str)
(make-paragraph (make-style 'pretitle '())
(if n
(make-multiarg-element (make-style "SccsdescNumber" (cons 'exact-chars multicommand-props))
(list (number->string n)
(decode-string str)))
(make-element (make-style "ccsdesc" (cons 'exact-chars command-props))
(decode-string str)))))
(define (title #:tag [tag #f]
#:tag-prefix [prefix #f]
#:style [style plain]
#:version [version #f]
#:date [date #f]
#:short [short #f]
. str)
(let ([content (decode-content str)])
(make-title-decl (prefix->string prefix)
(convert-tag tag content)
version
(let* ([s (convert-part-style 'title style)]
[s (if date
(make-style (style-name s)
(cons (make-document-date date)
(style-properties s)))
s)]
[s (if short
(make-style (style-name s)
(cons (short-title short)
(style-properties s)))
s)])
s)
content)))
(define (author #:orcid [orcid #f]
#:affiliation [affiliation '()]
#:email [email '()]
. name)
(make-paragraph
(make-style 'author command-props)
(decode-content
(list
(make-multiarg-element (make-style "SAuthorinfo" multicommand-props)
(list (make-element #f (decode-content name))
(make-element #f
(if orcid
(make-element
(make-style "SAuthorOrcid" multicommand-props)
(decode-content (list orcid)))
'()))
(make-element #f
(cond
[(affiliation? affiliation)
(convert-affiliation affiliation)]
[(pre-content? affiliation)
(make-element
(make-style "SAuthorPlace" multicommand-props)
(decode-content (list affiliation)))]
[else
(for/list ([a (in-list affiliation)])
(convert-affiliation a))]))
(make-element #f
(cond
[(email? email)
(convert-email email)]
[(pre-content? email)
(make-element
(make-style "SAuthorEmail" multicommand-props)
(decode-content (list email)))]
[else
(for/list ([e (in-list email)])
(convert-email e))]))))))))
(define (authorsaddresses . content)
(make-paragraph
(make-style 'pretitle command-props)
(make-element (make-style "authorsaddresses" command-props)
(decode-content content))))
(define (institution #:departments [departments '()]
. name)
(author-institution name departments))
(define (convert-institution inst
#:department? [department? #f])
(define level 0)
(define (mk-inst name
#:department? [department? department?]
#:level [level level])
(case department?
[(#f) (make-element (make-style "institution" command-props)
(decode-content name))]
[(sub) (make-element (make-style "department"
(cons (command-optional (list (number->string level)))
command-props))
(decode-content name))]
[else (make-element (make-style "department"
(append
(if (> level 0)
(list (command-optional (list (number->string level))))
(list))
command-props))
(decode-content name))]))
(define lst
(append
(for/list ([i (in-list (institution-departments inst))])
(cond
[(institution? i)
(define-values (content new-level)
(convert-institution i
#:department? (or (and department? 'sub)
#t)))
(set! level (max level (+ 1 new-level)))
content]
[else
(set! level 1)
(mk-inst (list i)
#:department? (or (and department? 'sub)
#t)
#:level 0)]))
(list (mk-inst (institution-name inst)))))
(if department?
(values lst level)
lst))
(define (email . text)
(author-email text))
(define (convert-email email)
(make-element
(make-style "SAuthorEmail" command-props)
(decode-content (email-text email))))
(define (affiliation #:position [position #f]
#:institution [institution #f]
#:street-address [street-address #f]
#:city [city #f]
#:state [state #f]
#:postcode [postcode #f]
#:country [country #f])
(author-affiliation position institution street-address city state postcode country))
(define (convert-affiliation aff)
(define (maybe-element str content)
(and (content aff) (make-element str (decode-content (list (content aff))))))
(make-element
(make-style "SAuthorPlace" command-props)
(make-multiarg-element
(make-style #f multicommand-props)
(filter values
(append (list (maybe-element "position" affiliation-position))
(if (institution? (affiliation-institution aff))
(convert-institution (affiliation-institution aff))
(list (maybe-element "institution" affiliation-institution)))
(list (maybe-element "streetaddress" affiliation-street-address)
(maybe-element "city" affiliation-city)
(maybe-element "state" affiliation-state)
(maybe-element "postcode" affiliation-postcode)
(maybe-element "country" affiliation-country)))))))
(define-commands subtitle acmJournal
thanks titlenote subtitlenote authornote acmVolume acmNumber acmArticle acmYear acmMonth
acmArticleSeq acmPrice acmISBN acmDOI
startPage terms keywords
setcopyright copyrightyear
settopmatter hortauthors)
(define (CCSXML . strs)
(make-nested-flow (make-style "CCSXML" '())
(list (make-paragraph (make-style #f '())
(make-element (make-style #f '(exact-chars))
(apply string-append strs))))))
(define-environments teaserfigure sidebar marginfigure margintable)
(define-comment-environments printonly screenonly anonsuppress acks)
; FIXME: theorem styles
(default-figure-label-text (make-element 'sf "Fig."))
(default-figure-label-sep ". ")
(default-figure-caption-style 'sf)
(default-figure-counter-style 'sf)