figure and bib support in scriblib

svn: r15078
This commit is contained in:
Matthew Flatt 2009-06-04 16:46:25 +00:00
parent e14e58c8df
commit 818d7cb292
10 changed files with 614 additions and 0 deletions

View File

@ -0,0 +1,5 @@
.SBibliography p {
padding-left: 1em;
text-indent: -1em;
}

View File

@ -0,0 +1,268 @@
#lang at-exp scheme/base
(require scribble/manual
scribble/struct
scribble/decode
scheme/string)
(provide autobib-style-extras
define-cite
make-bib in-bib (rename-out [auto-bib? bib?])
proceedings-location journal-location book-location techrpt-location
author-name org-author-name authors editor)
(define (autobib-style-extras)
(let ([abs (lambda (s)
(build-path (collection-path "scriblib") s))])
`((css ,(abs "autobib.css")) (tex ,(abs "autobib.tex")))))
(define-struct auto-bib (author date entry-element key specific))
(define-struct bib-group (ht))
(define-struct (author-element element) (names cite))
(define (add-cite group bib-entry which)
(hash-set! (bib-group-ht group) bib-entry #t)
(make-delayed-element
(lambda (renderer part ri)
(let ([s (resolve-get part ri `(,which ,(auto-bib-key bib-entry)))])
(list (make-link-element #f
(list s (auto-bib-specific bib-entry))
`(autobib ,(auto-bib-key bib-entry))))))
(lambda () "(???)")
(lambda () "(???)")))
(define (add-cites group bib-entries)
(make-element
#f
(list 'nbsp
"("
(let loop ([keys bib-entries])
(if (null? (cdr keys))
(add-cite group (car keys) 'autobib-cite)
(make-element
#f
(list (loop (list (car keys)))
"; "
(loop (cdr keys))))))
")")))
(define (gen-bib tag group)
(let* ([author<? (lambda (a b)
(string<? (author-element-names (auto-bib-author a))
(author-element-names (auto-bib-author b))))]
[bibs (sort (hash-map (bib-group-ht group)
(lambda (k v) k))
author<?)])
(make-unnumbered-part
#f
`((part ,tag))
'("Bibliography")
'()
null
(make-flow
(list
(make-table
"SBibliography"
(map (lambda (k)
(list
(make-flow
(list
(make-paragraph
(list
(make-collect-element
#f
(list (make-target-element
#f
(list (auto-bib-entry-element k))
`(autobib ,(auto-bib-key k))))
(lambda (ci)
(collect-put! ci
`(autobib-cite ,(auto-bib-key k))
(make-element
#f
(list
(author-element-cite (auto-bib-author k))
" "
(auto-bib-date k))))
(collect-put! ci
`(autobib-inline ,(auto-bib-key k))
(make-element
#f
(list
(author-element-cite (auto-bib-author k))
'nbsp
"("
(auto-bib-date k)
")")))))))))))
bibs))))
null)))
(define-syntax-rule (define-cite ~cite citet generate-bibliography)
(begin
(define group (make-bib-group (make-hasheq)))
(define (~cite bib-entry . bib-entries)
(add-cites group (cons bib-entry bib-entries)))
(define (citet bib-entry)
(add-cite group bib-entry 'autobib-inline))
(define (generate-bibliography #:tag [tag "doc-bibliography"])
(gen-bib tag group))))
(define (make-bib #:title title
#:author [author #f]
#:is-book? [is-book? #f]
#:location [location #f]
#:date [date #f]
#:url [url #f])
(let* ([author (if (author-element? author)
author
(parse-author author))]
[elem (make-element
"bibentry"
(append
(if author `(,@(decode-content (list author)) ". ") null)
;; (if is-book? null '(ldquo))
(if is-book?
(list (italic title))
(decode-content (list title)))
(if (regexp-match? #rx"[.!?,]$" (element->string title))
null
'("."))
;; (if is-book? null '(rdquo))
(if location
`(" " ,@(decode-content (list location)) ,(if date "," "."))
null)
(if date `(" " ,@(decode-content (list date)) ".") null)
(if url `(" " ,(link url (make-element 'url (list url)))) null)))])
(make-auto-bib
author
date
elem
(element->string elem)
"")))
(define (in-bib bib where)
(make-auto-bib
(auto-bib-author bib)
(auto-bib-date bib)
(auto-bib-entry-element bib)
(auto-bib-key bib)
(string-append (auto-bib-specific bib) where)))
(define (parse-author a)
(if (author-element? a)
a
(let* ([s (element->string a)]
[m (regexp-match #rx"^(.*) ([A-Za-z]+)$" s)])
(make-author-element
#f
(list a)
(if m
(string-append (caddr m) " " (cadr m))
s)
(if m
(caddr m)
s)))))
(define (proceedings-location
location
#:pages [pages #f]
#:series [series #f]
#:volume [volume #f])
(let* ([s @elem{In @italic{@elem{Proc. @|location|}}}]
[s (if series
@elem{@|s|, @|series|}
s)]
[s (if volume
@elem{@|s| volume @|volume|}
s)]
[s (if pages
@elem{@|s|, pp. @(car pages)--@(cadr pages)}
s)])
s))
(define (journal-location
location
#:pages [pages #f]
#:number [number #f]
#:volume [volume #f])
(let* ([s @italic{@|location|}]
[s (if volume
@elem{@|s| @|volume|}
s)]
[s (if number
@elem{@|s|(@|number|)}
s)]
[s (if pages
@elem{@|s|, pp. @(car pages)--@(cadr pages)}
s)])
s))
(define (book-location
#:edition [edition #f]
#:publisher [publisher #f])
(let* ([s (if edition
@elem{@(string-titlecase edition) edition}
#f)]
[s (if publisher
(if s
@elem{@|s|. @|publisher|}
publisher)
s)])
(unless s
(error 'book-location "no arguments"))
s))
(define (techrpt-location
#:institution org
#:number num)
@elem{@|org|, @|num|})
;; ----------------------------------------
(define (author-name first last #:suffix [suffix #f])
(make-author-element
#f
(list
(format "~a ~a~a" first last (if suffix
(format " ~a" suffix)
"")))
(format "~a ~a~a" last first (if suffix
(format " ~a" suffix)
""))
last))
(define (org-author-name org)
(make-author-element
#f
(list org)
org
org))
(define (authors name . names)
(let ([names (map parse-author (cons name names))])
(make-author-element
#f
(let loop ([names names])
(if (null? (cdr names))
(list (car names))
(append (loop (list (car names)))
(list (if (null? (cddr names))
", and "
", "))
(loop (cdr names)))))
(string-join (map author-element-names names) " / ")
(case (length names)
[(1) (author-element-cite (car names))]
[(2) (format "~a and ~a"
(author-element-cite (car names))
(author-element-cite (cadr names)))]
[else (format "~a et al." (author-element-cite (car names)))]))))
(define (editor name)
(let ([name (parse-author name)])
(make-author-element
#f
(append (element-content name)
'(" (Ed.)"))
(author-element-names name)
(author-element-cite name))))

View File

@ -0,0 +1,2 @@
% Nothing

View File

@ -0,0 +1,21 @@
.Centerfigure, .CenterfigureMulti, .centerfigureMultiWide {
margin: 1em 0 1em 0;
width: 100%;
border: 1px solid #1818FF;
text-align: center;
}
.CenterfigureMultiWide {
width: 125%;
}
.FigureInside {
margin: 0 0 0 0;
padding: 0 1em 0 1em;
}
.Caption:before {
content: "Figure: ";
}

View File

@ -0,0 +1,61 @@
#lang scheme/base
(require scribble/manual
scribble/struct
scribble/decode
"private/counter.ss")
(provide figure
figure*
figure**
Figure-target
Figure-ref
figure-style-extras)
(define (figure-style-extras)
(let ([abs (lambda (s)
(build-path (collection-path "scriblib") s))])
`((css ,(abs "figure.css")) (tex ,(abs "figure.tex")))))
(define (figure tag caption . content)
(make-blockquote
"Centerfigure"
(list
(make-blockquote
"FigureInside"
(append
(flow-paragraphs
(decode-flow content))
(list
(make-paragraph
(list
(make-element "Legend"
(list* (Figure-target tag) ": "
(decode-content (list caption))))))))))))
(define (*figure style tag caption content)
(make-blockquote
style
(list
(make-blockquote
"FigureInside"
(append
(flow-paragraphs
(decode-flow content))
(list
(make-paragraph
(list
(make-element "Legend"
(list* (Figure-target tag) ": "
(decode-content (list caption))))))))))))
(define (figure* tag caption . content)
(*figure "CenterfigureMulti" tag caption content))
(define (figure** tag caption . content)
(*figure "CenterfigureMultiWide" tag caption content))
(define figures (new-counter "figure"))
(define (Figure-target tag)
(counter-target figures tag "Figure"))
(define (Figure-ref tag)
(make-element #f (list (counter-ref figures tag "Figure"))))

View File

@ -0,0 +1,15 @@
\usepackage{ccaption}
\newcommand{\Legend}[1]{~
\hrule width \hsize height .33pt
\vspace{4pt}
\legend{#1}}
\newlength{\FigOrigskip}
\FigOrigskip=\parskip
\newenvironment{CenterfigureMulti}{\begin{figure*}\centering}{\end{figure*}}
\newenvironment{CenterfigureMultiWide}{\begin{CenterfigureMulti}}{\end{CenterfigureMulti}}
\newenvironment{Centerfigure}{\begin{figure}\centering}{\end{figure}}
\newenvironment{FigureInside}{\begin{list}{}{\leftmargin=0pt\parsep=\FigOrigskip}\item}{\end{list}}

View File

@ -0,0 +1,60 @@
#lang scheme
(require scribble/struct
scribble/decode)
(provide new-counter
counter-target
counter-ref)
(define-struct counter ([n #:mutable] name))
(define (new-counter name)
(make-counter 0 name))
(define (counter-target counter tag label . content)
(let ([content (decode-content content)])
(make-target-element
#f
(list
(make-collect-element
#f
(if label
(list
(make-delayed-element
(lambda (renderer part ri)
(let ([n (resolve-get part ri `(counter (,(counter-name counter) ,tag "value")))])
(list* label 'nbsp (format "~a" n)
content)))
(lambda () (if label
(list* label 'nbsp "N" content)
content))
(lambda () (if label
(list* label 'nbsp "N" content)
content))))
content)
(lambda (ci)
(let ([n (add1 (counter-n counter))])
(set-counter-n! counter n)
(collect-put! ci `(counter (,(counter-name counter) ,tag "value")) n)))))
`(counter (,(counter-name counter) ,tag)))))
(define (counter-ref counter tag label)
(let ([n (make-delayed-element
(lambda (renderer part ri)
(let ([n (resolve-get part ri `(counter (,(counter-name counter) ,tag "value")))])
(list (format "~a" n))))
(lambda () (if label
(list label 'nbsp "N")
(list "N")))
(lambda () (if label
(list label 'nbsp "N")
(list "N"))))])
(if label
(make-link-element
#f
(list
label
'nbsp
n)
`(counter (,(counter-name counter) ,tag)))
n)))

View File

@ -0,0 +1,137 @@
#lang scribble/manual
@(require (for-label scribble/struct
scriblib/autobib
scheme/base
scheme/contract))
@title[#:tag "autobib"]{Bibliographies}
@defmodule[scriblib/autobib]
@defproc[(autobib-style-extras) list?]{
Include the content of the result list in the style of a document part
that includes all figures. These style extras pull in HTML and Latex
rendering support.}
@defform[(define-cite ~cite-id citet-id generate-bibliography-id)]{
Binds @scheme[~cite-id], @scheme[citet-id], and
@scheme[generate-bibliography-id], which share state to accumulate and
render citations.
The function bound to @scheme[~cite-id] produces a citation with a
preceding non-breaking space. It has the contract
@schemeblock[
((bib?) () (listof bib?) . ->* . element?)
]
The function bound to @scheme[citet-id] has the same contract as the
function for @scheme[~cite-id], but it generates an element suitable
for use as a noun refering to the document or its author.
The function bound to @scheme[generate-bibliography-id] generates the
section for the bibliography. It has the contract
@schemeblock[
(() (#:tag [tag "doc-bibliography"]) null? . ->* . part?)
]}
@defproc[(bib? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a value produced by
@scheme[make-bib] or @scheme[in-bib], @scheme[#f] otherwise.}
@defproc[(make-bib [#:title title any/c]
[#:author author any/c #f]
[#:is-book? is-book? any/c #f]
[#:location location any/c #f]
[#:date date any/c #f]
[#:url url string? #f])
bib?]{
Produces a value that represents a document to cite. Except for
@scheme[is-book?] and @scheme[url], the arguments are used as
elements, except that @scheme[#f] means that the information is not
supplied. Functions like @scheme[proceedings-location],
@scheme[author-name], and @scheme[authors] help produce elements in a
standard format.
An element produces by a function like @scheme[author-name] tracks
first, last names, and name suffixes separately, so that names can be
ordered and rendered correctly. When a string is provided as an author
name, the last non-empty sequence of ASCII alphabetic characters after
a space is treated as the author name, and the rest is treated as the
first name.}
@defproc[(in-bib [orig bib?] [where string?]) bib?]{
Extends a bib value so that the rendered citation is suffixed with
@scheme[where], which might be a page or chapter number.}
@defproc[(proceedings-location [location any/c]
[#:pages pages (or (list/c any/c any/c) #f) #f]
[#:series series any/c #f]
[#:volume volume any/c #f])
element?]{
Combines elements to generate an element that is suitable for
describing a paper's location within a conference or workshop
proceedings.}
@defproc[(journal-location [title any/c]
[#:pages pages (or (list/c any/c any/c) #f) #f]
[#:number number any/c #f]
[#:volume volume any/c #f])
element?]{
Combines elements to generate an element that is suitable for
describing a paper's location within a journal.}
@defproc[(book-location [#:edition edition any/c #f]
[#:publisher publisher any/c #f])
element?]{
Combines elements to generate an element that is suitable for
describing a book's location.}
@defproc[(techrpt-location [#:institution institution edition any/c]
[#:number number any/c])
element?]{
Combines elements to generate an element that is suitable for
describing a technical report's location.}
@defproc[(author-name [first any/c]
[last any/c]
[#:suffix suffix any/c #f])
element?]{
Combines elements to generate an element that is suitable for
describing an author's name, especially where the last name is not
merely a sequence of ASCII alphabet letters or where the name has a
suffix (such as ``Jr.'').}
@defproc[(authors [name any/c] ...) element?]{
Combines multiple author elements into one, so that it is rendered and
alphabetized appropriately. If a @scheme[name] is a string, it is
parsed in the same way as by @scheme[make-bib].}
@defproc[(org-author-name [name any/c]) element?]{
Converts an element for an organization name to one suitable for use
as a bib-value author.}
@defproc[(editor [name name/c]) element?]{
Takes an author-name element and create one that represents the editor
of a collection. If a @scheme[name] is a string, it is parsed in the
same way as by @scheme[make-bib].}

View File

@ -0,0 +1,43 @@
#lang scribble/manual
@(require (for-label scribble/struct
scriblib/figure
scheme/base
scheme/contract))
@title[#:tag "figure"]{Figures}
@defmodule[scriblib/figure]
@defproc[(figure-style-extras) list?]{
Include the content of the result list in the style of a document part
that includes all figures. These style extras pull in HTML and Latex
rendering support.}
@deftogether[(
@defproc[(figure [tag string?] [caption any/c] [pre-content any/c] ...) block?]
@defproc[(figure* [tag string?] [caption any/c] [pre-content any/c] ...) block?]
@defproc[(figure** [tag string?] [caption any/c] [pre-content any/c] ...) block?]
)]{
Creates a figure. The given @scheme[tag] is for use with
@scheme[Figure-ref]. The @scheme[caption] is an element. The
@scheme[pre-content] is decoded as a flow.
For HTML output, the @scheme[figure*] and @scheme[figure*] functions
center the figure content, while @scheme[figure**] allows the content
to be wider than the document body.
For two-column latex output, @scheme[figure*] and @scheme[figure**]
generate a figure that spans columns.}
@defproc[(Figure-target [tag string?]) element?]{
Generates a new figure label---normally not used directly, since it is
used by @scheme[figure].}
@defproc[(Figure-ref [tag string?]) element?]{
Generates a reference to a figure.}

View File

@ -5,3 +5,5 @@
@table-of-contents[]
@include-section["gui-eval.scrbl"]
@include-section["figure.scrbl"]
@include-section["autobib.scrbl"]