figure and bib support in scriblib

svn: r15078

collects/scriblib/autobib.css

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

collects/scriblib/autobib.ss

@@ -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))))

collects/scriblib/autobib.tex

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

collects/scriblib/figure.css

@@ -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: ";
+}
+

collects/scriblib/figure.ss

@@ -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"))))

collects/scriblib/figure.tex

@@ -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}}

collects/scriblib/private/counter.ss

@@ -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)))

collects/scriblib/scribblings/autobib.scrbl

@@ -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].}

collects/scriblib/scribblings/figure.scrbl

@@ -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.}
+

collects/scriblib/scribblings/scriblib.scrbl

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