commit d438cd4fab05826c9b1939c3cf2554d854417745
parent f15af6e90bbfc3cadc15e1c9eb05338e27e78afa
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 21 May 2010 18:44:16 -0600
add scriblib/footnote library
original commit: 69230100e4859c642f1fa4a1a61ddc6c7a976535
Diffstat:
4 files changed, 145 insertions(+), 20 deletions(-)
diff --git a/collects/scriblib/footnote.css b/collects/scriblib/footnote.css
@@ -0,0 +1,26 @@
+
+.NoteBox {
+ position: relative;
+ float: right;
+ left: 2em;
+ height: 0em;
+ width: 13em;
+ margin: 0em -13em 0em 0em;
+}
+
+.NoteContent {
+ margin: 0 0 0 0;
+}
+
+.FootnoteContent {
+ display: none;
+}
+
+.FootnoteBlock {
+ border-top: 1px solid black;
+}
+
+.FootnoteBlockContent {
+ padding-left: 1em;
+ text-indent: -0.5em;
+}
diff --git a/collects/scriblib/footnote.rkt b/collects/scriblib/footnote.rkt
@@ -0,0 +1,84 @@
+#lang scheme/base
+
+(require scribble/core
+ scribble/decode
+ scribble/html-properties
+ scribble/latex-properties
+ racket/promise
+ "private/counter.ss")
+
+(provide note
+ define-footnote)
+
+(define footnote-style-extras
+ (let ([abs (lambda (s)
+ (build-path (collection-path "scriblib") s))])
+ (list (make-css-addition (abs "footnote.css"))
+ (make-tex-addition (abs "footnote.tex")))))
+
+
+(define note-box-style (make-style "NoteBox" footnote-style-extras))
+(define note-content-style (make-style "NoteContent" footnote-style-extras))
+
+(define (note . text)
+ (make-element
+ note-box-style
+ (make-element note-content-style
+ (decode-content text))))
+
+
+(define footnote-style (make-style "Footnote" footnote-style-extras))
+(define footnote-ref-style (make-style "FootnoteRef" footnote-style-extras))
+(define footnote-content-style (make-style "FootnoteContent" footnote-style-extras))
+(define footnote-target-style (make-style "FootnoteTarget" footnote-style-extras))
+(define footnote-block-style (make-style "FootnoteBlock" footnote-style-extras))
+(define footnote-block-content-style (make-style "FootnoteBlockContent" footnote-style-extras))
+
+(define-syntax-rule (define-footnote footnote footnote-part)
+ (begin
+ (define footnotes (new-counter "footnote"))
+ (define id (gensym))
+ (define (footnote . text) (do-footnote footnotes id text))
+ (define (footnote-part . text) (do-footnote-part footnotes id))))
+
+(define (do-footnote footnotes id text)
+ (let ([tag (generated-tag)]
+ [content (decode-content text)])
+ (make-traverse-element
+ (lambda (get set)
+ (set id (cons (cons
+ (make-element footnote-target-style
+ (make-element
+ 'superscript
+ (counter-target footnotes tag #f)))
+ content)
+ (get id null)))
+ (make-element footnote-style
+ (list
+ (make-element
+ footnote-ref-style
+ (make-element
+ 'superscript
+ (counter-ref footnotes tag #f)))
+ (make-element
+ footnote-content-style
+ content)))))))
+
+(define (do-footnote-part footnotes id)
+ (make-part
+ #f
+ (list `(part ,(generated-tag)))
+ #f
+ (make-style #f '(hidden toc-hidden))
+ null
+ (list
+ (make-traverse-block
+ (lambda (get set)
+ (make-compound-paragraph
+ footnote-block-style
+ (map (lambda (content)
+ (make-paragraph
+ footnote-block-content-style
+ content))
+ (reverse (get id null)))))))
+ null))
diff --git a/collects/scriblib/footnote.tex b/collects/scriblib/footnote.tex
@@ -0,0 +1,11 @@
+
+\newcommand{\NoteBox}[1]{\footnote{#1}}
+\newcommand{\NoteContent}[1]{#1}
+
+\newcommand{\Footnote}[1]{\footnote{#1}}
+\newcommand{\FootnoteRef}[1]{}
+\newcommand{\FootnoteTarget}[1]{}
+\newcommand{\FootnoteContent}[1]{#1}
+
+\newenvironment{FootnoteBlock}{}{}
+\newcommand{\FootnoteBlockContent}[1]{}
diff --git a/collects/scriblib/private/counter.rkt b/collects/scriblib/private/counter.rkt
@@ -4,7 +4,8 @@
(provide new-counter
counter-target
- counter-ref)
+ counter-ref
+ counter-collect-value)
(define-struct counter ([n #:mutable] name))
@@ -18,20 +19,20 @@
(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)
+ (list
+ (make-delayed-element
+ (lambda (renderer part ri)
+ (let ([n (resolve-get part ri `(counter (,(counter-name counter) ,tag "value")))])
+ (let ([l (cons (format "~a" n) content)])
+ (if label
+ (list* label 'nbsp l)
+ l))))
+ (lambda () (if label
+ (list* label 'nbsp "N" content)
+ (cons "N" content)))
+ (lambda () (if label
+ (list* label 'nbsp "N" content)
+ (cons "N" content)))))
(lambda (ci)
(let ([n (add1 (counter-n counter))])
(set-counter-n! counter n)
@@ -49,12 +50,15 @@
(lambda () (if label
(list label 'nbsp "N")
(list "N"))))])
- (if label
- (make-link-element
- #f
+ (make-link-element
+ #f
+ (if label
(list
label
'nbsp
n)
- `(counter (,(counter-name counter) ,tag)))
- n)))
+ n)
+ `(counter (,(counter-name counter) ,tag)))))
+
+(define (counter-collect-value counter)
+ (counter-n counter))
