commit 9da2f4f40fd37bfb2b308611190d84cf97b9310e
parent 5c7c8a3bd0ceb3e1529307f5a5bf88938689a057
Author: Leif Andersen <leif@leifandersen.net>
Date: Sat, 25 Mar 2017 10:08:18 -0400
Add a pretitle style property for nested flows. (#94)
* Add a pretitle style property for nested flows.
This allows us to raise nested flows above the title. So that we do
things like raise the abstract above the title:
```
\begin{abstract}
Abstract text
\end{abstract}
\titleCommand{...}
```
This style is required by the acmart style guide.
* Paragraphs and nested flows extracted in the same order
* Fix `scribble/acmart`'s abstract form so that it gets lifted above `maketitle`, where it should be.
Diffstat:
4 files changed, 71 insertions(+), 44 deletions(-)
diff --git a/scribble-doc/scribblings/scribble/core.scrbl b/scribble-doc/scribblings/scribble/core.scrbl
@@ -729,6 +729,8 @@ The following @tech{style properties} are currently recognized:
@item{@racket[alt-tag] structure --- Generates the indicated HTML tag
instead of @tt{<blockquote>}.}
+ @item{@racket['pretitle] --- For Latex, raises the contents
+ of the flow to above the title.}
]}
@@ -1115,7 +1117,7 @@ reverse order):
any number or lists element, while @racket[""] is used in place
of all non-empty strings.}
-]}
+]
@history[#:changed "6.4" @elem{Added @racket[(list/c string? string?)]
number items for
diff --git a/scribble-lib/scribble/acmart.rkt b/scribble-lib/scribble/acmart.rkt
@@ -141,7 +141,7 @@
;; ----------------------------------------
;; Abstracts:
-(define abstract-style (make-style "abstract" acmart-extras))
+(define abstract-style (make-style "abstract" (cons 'pretitle acmart-extras)))
(define command-props (cons 'command acmart-extras))
(define multicommand-props (cons 'multicommand acmart-extras))
diff --git a/scribble-lib/scribble/base-render.rkt b/scribble-lib/scribble/base-render.rkt
@@ -251,25 +251,42 @@
(document-date-text v)))
(style-properties (part-style d))))
- (define/private (extract-pre-paras d sym)
+ (define/private (extract-content d lift-proc)
(let loop ([l (part-blocks d)])
+ (apply append
+ (for/list ([b (in-list l)])
+ (define lifted (lift-proc b loop))
+ lifted))))
+
+ (define/private (extract-pre-paras-proc sym)
+ (λ (v loop)
+ (cond
+ [(and (paragraph? v)
+ (eq? sym (style-name (paragraph-style v))))
+ (list v)]
+ [(compound-paragraph? v)
+ (loop (compound-paragraph-blocks v))]
+ [else '()])))
+
+ (define/private (extract-pre-content-proc sym)
+ (λ (v loop)
+ (define pre-para ((extract-pre-paras-proc sym) v loop))
(cond
- [(null? l) null]
- [else (let ([v (car l)])
- (cond
- [(and (paragraph? v)
- (eq? sym (style-name (paragraph-style v))))
- (cons v (loop (cdr l)))]
- [(compound-paragraph? v)
- (append (loop (compound-paragraph-blocks v))
- (loop (cdr l)))]
- [else (loop (cdr l))]))])))
+ [(not (null? pre-para)) pre-para]
+ [(and (nested-flow? v)
+ (member sym (style-properties (nested-flow-style v))))
+ (list v)]
+ [else '()])))
- (define/public (extract-authors d)
- (extract-pre-paras d 'author))
+ (define/public (extract-authors d)
+ (extract-content d (extract-pre-paras-proc 'author)))
+
(define/public (extract-pretitle d)
- (extract-pre-paras d 'pretitle))
+ (extract-content d (extract-pre-paras-proc 'pretitle)))
+
+ (define/public (extract-pretitle-content d)
+ (extract-content d (extract-pre-content-proc 'pretitle)))
;; ----------------------------------------
diff --git a/scribble-lib/scribble/latex-render.rkt b/scribble-lib/scribble/latex-render.rkt
@@ -81,7 +81,7 @@
extract-version
extract-date
extract-authors
- extract-pretitle)
+ extract-pretitle-content)
(define/public (extract-short-title d)
(ormap (lambda (v)
@@ -150,14 +150,19 @@
(when (part-title-content d)
(let ([vers (extract-version d)]
[date (extract-date d)]
- [pres (extract-pretitle d)]
+ [pres (extract-pretitle-content d)]
[auths (extract-authors d)]
[short (extract-short-title d)])
(for ([pre (in-list pres)])
(printf "\n\n")
- (do-render-paragraph pre d ri #t #f))
+ (cond
+ [(paragraph? pre)
+ (do-render-paragraph pre d ri #t #f)]
+ [(nested-flow? pre)
+ (do-render-nested-flow pre d ri #t #f #t)]))
(when date (printf "\\date{~a}\n" date))
- (printf "\\titleAnd~aVersionAnd~aAuthors~a{"
+ (printf "\\titleAnd~aVersionAnd~aAuthors~a{"
+
(if (equal? vers "") "Empty" "")
(if (null? auths) "Empty" "")
(if short "AndShort" ""))
@@ -187,7 +192,7 @@
(and d (positive? d)))))
(when (eq? (style-name (part-style d)) 'index)
(printf "\\twocolumn\n\\parskip=0pt\n\\addcontentsline{toc}{section}{Index}\n"))
- (let ([pres (extract-pretitle d)])
+ (let ([pres (extract-pretitle-content d)])
(for ([pre (in-list pres)])
(printf "\n\n")
(do-render-paragraph pre d ri #t #f)))
@@ -645,6 +650,7 @@
part
ri
#t
+ #f
#f)
(when (string? s-name)
(printf "\\end{~a}" s-name)))
@@ -848,7 +854,7 @@
[(table? p)
(render-table* p part ri #f (format "[~a]" mode))]
[(nested-flow? p)
- (do-render-nested-flow p part ri #f mode)]
+ (do-render-nested-flow p part ri #f mode #f)]
[(paragraph? p)
(do-render-paragraph p part ri #f mode)]))
@@ -879,7 +885,7 @@
(printf "\\end{~a}" mode)
null))
- (define/private (do-render-nested-flow t part ri single-column? as-box-mode)
+ (define/private (do-render-nested-flow t part ri single-column? as-box-mode show-pre?)
(let* ([props (style-properties (nested-flow-style t))]
[kind (or (and as-box-mode
(or
@@ -900,29 +906,31 @@
[multicommand? (memq 'multicommand props)]
[command? (or (and as-box-mode (not multicommand?))
(memq 'command props))])
- (cond
- [command? (printf "\\~a{" kind)]
- [multicommand? (printf "\\~a" kind)]
- [else (printf "\\begin{~a}" kind)])
- (parameterize ([current-table-mode (if (or single-column?
- (not (current-table-mode)))
- (current-table-mode)
- (list "nested-flow" t))])
- (if as-box-mode
- (for-each (lambda (p)
- (when multicommand? (printf "{"))
- (render-boxable-block p part ri as-box-mode)
- (when multicommand? (printf "}")))
- (nested-flow-blocks t))
- (render-flow (nested-flow-blocks t) part ri #f multicommand?)))
- (cond
- [command? (printf "}")]
- [multicommand? (void)]
- [else (printf "\\end{~a}" kind)])
- null))
+ (unless (and (not show-pre?)
+ (member 'pretitle props))
+ (cond
+ [command? (printf "\\~a{" kind)]
+ [multicommand? (printf "\\~a" kind)]
+ [else (printf "\\begin{~a}" kind)])
+ (parameterize ([current-table-mode (if (or single-column?
+ (not (current-table-mode)))
+ (current-table-mode)
+ (list "nested-flow" t))])
+ (if as-box-mode
+ (for-each (lambda (p)
+ (when multicommand? (printf "{"))
+ (render-boxable-block p part ri as-box-mode)
+ (when multicommand? (printf "}")))
+ (nested-flow-blocks t))
+ (render-flow (nested-flow-blocks t) part ri #f multicommand?)))
+ (cond
+ [command? (printf "}")]
+ [multicommand? (void)]
+ [else (printf "\\end{~a}" kind)])
+ null)))
(define/override (render-nested-flow t part ri starting-item?)
- (do-render-nested-flow t part ri #f #f))
+ (do-render-nested-flow t part ri #f #f #f))
(define/override (render-compound-paragraph t part ri starting-item?)
(let ([kind (style-name (compound-paragraph-style t))]
