Do not actually use dependent contracts in provide/doc if there is no dependency
original commit: 334978a8e42347ef0db5480fe6c959ca90cb3bb9
This commit is contained in:
Jay McCarthy
commit
5c2c949a7c
|
|
@ -21,7 +21,7 @@
|
|||
;; running a browser on local files (like NEU). If you use this, then
|
||||
;; it is a good idea to put the documentation tree somewhere local, to
|
||||
;; have better interaction times and not overload the PLT server.
|
||||
;; (define doc-url "http://download.racket-lang.org/doc/4.1/html/")
|
||||
;; (define doc-url "http://download.racket-lang.org/docs/5.0/html/")
|
||||
;; (define (send-main-page #:sub [sub "index.html"]
|
||||
;; #:fragment [fragment #f] #:query [query #f])
|
||||
;; (define (part pfx x) (if x (list pfx x) '()))
|
||||
|
|
|
|||
|
|
@ -170,8 +170,7 @@
|
|||
(provide style/inline)
|
||||
(define (style/inline . args)
|
||||
(let-values ([(attrs body) (attributes+body args)])
|
||||
(make-element 'style attrs
|
||||
`("\n" ,(apply comment #:newlines? #t body) "\n"))))
|
||||
(make-element 'style attrs `("\n" ,body "\n"))))
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Entities
|
||||
|
|
|
|||
|
|
@ -35,36 +35,50 @@
|
|||
;; the currently rendered directory, as a list
|
||||
(define rendered-dirpath (make-parameter '()))
|
||||
|
||||
;; a mapping from path prefixes to urls (actually, any string) -- when two
|
||||
;; A mapping from path prefixes to urls (actually, any string) -- when two
|
||||
;; paths are in the same prefix, links from one to the other are relative, but
|
||||
;; if they're in different prefixes, the url will be used instead; the roots
|
||||
;; are expected to be disjoint (= no "/foo" and "/foo/bar" roots)
|
||||
;; are expected to be disjoint (= no "/foo" and "/foo/bar" roots).
|
||||
;; Additionally, optional symbol flags can appear in each entry, currently only
|
||||
;; 'abs is used below for roots that should always use absolute links (needed
|
||||
;; for some skeleton pages that are used in nested subdirectories).
|
||||
(provide url-roots)
|
||||
(define url-roots
|
||||
;; takes in a (listof (list prefix-string url-string)), and produces an alist
|
||||
;; with lists of strings for the keys; the prefix-strings are split on "/"s,
|
||||
;; and the url-strings can be anything at all actually (they are put as-is
|
||||
;; before the path with a "/" between them)
|
||||
(make-parameter #f
|
||||
(lambda (x)
|
||||
(and (list? x) (pair? x)
|
||||
(map (lambda (x)
|
||||
(cons (regexp-match* #rx"[^/]+" (car x))
|
||||
(regexp-replace #rx"/$" (cadr x) "")))
|
||||
x)))))
|
||||
(define url-roots (make-parameter #f))
|
||||
|
||||
(define cached-roots '(#f . #f))
|
||||
(define (current-url-roots)
|
||||
;; takes in a (listof (list prefix-string url-string . flags)), and produces
|
||||
;; an alist with lists of strings for the keys; the prefix-strings are split
|
||||
;; on "/"s, and the url-strings can be anything at all actually (they are put
|
||||
;; as-is before the path with a "/" between them).
|
||||
(let ([roots (url-roots)])
|
||||
(unless (eq? roots (car cached-roots))
|
||||
(set! cached-roots
|
||||
(cons roots
|
||||
(and (list? roots) (pair? roots)
|
||||
(map (lambda (root)
|
||||
(list* (regexp-match* #rx"[^/]+" (car root))
|
||||
(regexp-replace #rx"/$" (cadr root) "")
|
||||
(cddr root)))
|
||||
roots)))))
|
||||
(cdr cached-roots)))
|
||||
|
||||
;; a utility for relative paths, taking the above `default-file' and
|
||||
;; `url-roots' into consideration.
|
||||
(define (relativize file tgtdir curdir)
|
||||
(define file* (if (equal? file default-file) "" file))
|
||||
(define roots (url-roots))
|
||||
(define (make-rooted path)
|
||||
(ormap (lambda (root+url)
|
||||
(let loop ([r (car root+url)] [p path])
|
||||
(if (null? r)
|
||||
`(,(cdr root+url) ,@p ,file*)
|
||||
(define roots (current-url-roots))
|
||||
(define (find-root path mode)
|
||||
(ormap (lambda (root+url+flags)
|
||||
(let loop ([r (car root+url+flags)] [p path])
|
||||
(if (pair? r)
|
||||
(and (pair? p) (equal? (car p) (car r))
|
||||
(loop (cdr r) (cdr p))))))
|
||||
(loop (cdr r) (cdr p)))
|
||||
(case mode
|
||||
[(get-path) `(,(cadr root+url+flags) ,@p ,file*)]
|
||||
[(get-abs-or-true)
|
||||
(if (memq 'abs (cddr root+url+flags)) `("" ,@p) #t)]
|
||||
[else (error 'relativize "internal error: ~e" mode)]))))
|
||||
roots))
|
||||
(define result
|
||||
(let loop ([t tgtdir] [c curdir] [pfx '()])
|
||||
|
|
@ -73,13 +87,17 @@
|
|||
[(and (pair? t) (pair? c) (equal? (car t) (car c)))
|
||||
(loop (cdr t) (cdr c) (cons (car t) pfx))]
|
||||
;; done
|
||||
[(or (not roots) ; if there are no roots
|
||||
(make-rooted (reverse pfx))) ; or if they share a root
|
||||
;; then make them relative
|
||||
`(,@(map (lambda (_) "..") c) ,@t ,file*)]
|
||||
;; no roots => always use a relative path (useful for debugging)
|
||||
[(not roots) `(,@(map (lambda (_) "..") c) ,@t ,file*)]
|
||||
;; share a root => use a relative path unless its an absolute root
|
||||
[(find-root (reverse pfx) 'get-abs-or-true)
|
||||
=> (lambda (abs/true)
|
||||
`(;; rel. => as above
|
||||
,@(if (list? abs/true) abs/true (map (lambda (_) "..") c))
|
||||
,@t ,file*))]
|
||||
;; different roots => use the one for the target
|
||||
[(make-rooted t)]
|
||||
;; otherwise throw an error
|
||||
[(find-root tgtdir 'get-path)]
|
||||
;; if there isn't any, throw an error
|
||||
[else (error 'relativize "target url is not in any known root: ~a"
|
||||
(string-join `(,@tgtdir ,file*) "/"))])))
|
||||
(if (equal? '("") result) "." (string-join result "/")))
|
||||
|
|
@ -127,7 +145,10 @@
|
|||
(R "index.html" '() '("x" "y")) =error> "not in any"
|
||||
(R "index.html" '("x") '("x" "y")) => "../"
|
||||
(R "index.html" '("x" "y") '("x" "y")) => "."
|
||||
(R "index.html" '("x" "y") '("y" "x")) => "/X/y/"))))
|
||||
(R "index.html" '("x" "y") '("y" "x")) => "/X/y/"))
|
||||
do (parameterize ([url-roots '(["/x" "/X/"] ["/y" "/Y/" abs])])
|
||||
(test (R "foo.txt" '("x" "1") '("x" "2")) => "../1/foo.txt"
|
||||
(R "foo.txt" '("y" "1") '("y" "2")) => "/1/foo.txt"))))
|
||||
|#
|
||||
|
||||
;; utility for keeping a list of renderer thunks
|
||||
|
|
@ -179,7 +200,13 @@
|
|||
(add-renderer path render)
|
||||
(make-keyword-procedure
|
||||
(lambda (kws kvs . args) (keyword-apply referrer kws kvs (url) args))
|
||||
(lambda args (apply referrer (url) args)))))
|
||||
(case-lambda [(x) (if (eq? x get-resource-path) (url) (referrer (url) x))]
|
||||
[args (apply referrer (url) args)]))))
|
||||
|
||||
;; make it possible to always get the path to a resource
|
||||
(provide get-resource-path)
|
||||
(define (get-resource-path resource)
|
||||
(resource get-resource-path))
|
||||
|
||||
;; a convenient utility to create renderers from some output function (like
|
||||
;; `output-xml' or `display') and some content
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
;; XML-like objects and functions, with rendering
|
||||
|
||||
(require scribble/text)
|
||||
(require scribble/text racket/port)
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Represent attribute names as `foo:' symbols. They are made self-quoting in
|
||||
|
|
@ -37,6 +37,15 @@
|
|||
"missing attribute value for `~s:'" a)]
|
||||
[else (loop (cddr xs) (cons (cons a (cadr xs)) as))]))))
|
||||
|
||||
;; similar, but keeps the attributes as a list, useful to build new functions
|
||||
;; that accept attributes without knowing about the xml structs.
|
||||
(provide split-attributes+body)
|
||||
(define (split-attributes+body xs)
|
||||
(let loop ([xs xs] [as '()])
|
||||
(if (and (pair? xs) (pair? (cdr xs)) (attribute->symbol (car xs)))
|
||||
(loop (cddr xs) (list* (cadr xs) (car xs) as))
|
||||
(values (reverse as) xs))))
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; An output that handles xml quoting, customizable
|
||||
|
||||
|
|
@ -61,6 +70,10 @@
|
|||
(define (output-xml content [p (current-output-port)])
|
||||
(output (disable-prefix (with-writer (xml-writer) content)) p))
|
||||
|
||||
(provide xml->string)
|
||||
(define (xml->string content)
|
||||
(with-output-to-string (lambda () (output-xml content))))
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Structs for xml data: elements, literals, entities
|
||||
|
||||
|
|
|
|||
|
|
@ -295,6 +295,7 @@
|
|||
(append-map (lambda (s) (cond
|
||||
[(string? s) (decode-string s)]
|
||||
[(void? s) null]
|
||||
[(splice? s) (decode-content (splice-run s))]
|
||||
[else (list s)]))
|
||||
(skip-whitespace l)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require "struct.ss"
|
||||
"decode.ss"
|
||||
(for-syntax scheme/base
|
||||
(for-syntax racket/base
|
||||
syntax/kerncase))
|
||||
|
||||
(provide (except-out (all-from-out scheme/base) #%module-begin)
|
||||
(provide (except-out (all-from-out racket/base) #%module-begin)
|
||||
(rename-out [*module-begin #%module-begin]))
|
||||
|
||||
;; Module wrapper ----------------------------------------
|
||||
|
|
|
|||
|
|
@ -65,7 +65,7 @@
|
|||
(if date `(" " ,@(decode-content (list date)) ".") null)
|
||||
(if url `(" " ,(link url (tt url))) null)))))
|
||||
|
||||
(define-on-demand bib-style (make-style "SBibliography" scheme-properties))
|
||||
(define-on-demand bib-style (make-style "RBibliography" scheme-properties))
|
||||
|
||||
(define (bibliography #:tag [tag "doc-bibliography"] . citations)
|
||||
(make-unnumbered-part
|
||||
|
|
|
|||
|
|
@ -11,5 +11,5 @@
|
|||
(define-on-demand scheme-properties
|
||||
(let ([abs (lambda (s)
|
||||
(path->main-collects-relative (build-path (collection-path "scribble") s)))])
|
||||
(list (make-css-addition (abs "scheme.css"))
|
||||
(make-tex-addition (abs "scheme.tex")))))
|
||||
(list (make-css-addition (abs "racket.css"))
|
||||
(make-tex-addition (abs "racket.tex")))))
|
||||
|
|
|
|||
|
|
@ -217,17 +217,17 @@
|
|||
|
||||
(define (filebox filename . inside)
|
||||
(make-nested-flow
|
||||
(make-style "Sfilebox" scheme-properties)
|
||||
(make-style "Rfilebox" scheme-properties)
|
||||
(list
|
||||
(make-styled-paragraph
|
||||
(list (make-element
|
||||
(make-style "Sfilename" scheme-properties)
|
||||
(make-style "Rfilename" scheme-properties)
|
||||
(if (string? filename)
|
||||
(filepath filename)
|
||||
filename)))
|
||||
(make-style "Sfiletitle" scheme-properties))
|
||||
(make-style "Rfiletitle" scheme-properties))
|
||||
(make-nested-flow
|
||||
(make-style "Sfilecontent" scheme-properties)
|
||||
(make-style "Rfilecontent" scheme-properties)
|
||||
(decode-flow inside)))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -2,9 +2,9 @@
|
|||
/* See the beginning of "scribble.css". */
|
||||
|
||||
/* Monospace: */
|
||||
.ScmIn, .ScmRdr, .ScmPn, .ScmMeta,
|
||||
.ScmMod, .ScmKw, .ScmVar, .ScmSym,
|
||||
.ScmRes, .ScmOut, .ScmCmt, .ScmVal {
|
||||
.RktIn, .RktRdr, .RktPn, .RktMeta,
|
||||
.RktMod, .RktKw, .RktVar, .RktSym,
|
||||
.RktRes, .RktOut, .RktCmt, .RktVal {
|
||||
font-family: monospace;
|
||||
}
|
||||
|
||||
|
|
@ -35,84 +35,84 @@
|
|||
}
|
||||
|
||||
/* ---------------------------------------- */
|
||||
/* Scheme text styles */
|
||||
/* Racket text styles */
|
||||
|
||||
.ScmIn {
|
||||
.RktIn {
|
||||
color: #cc6633;
|
||||
background-color: #eeeeee;
|
||||
}
|
||||
|
||||
.ScmInBG {
|
||||
.RktInBG {
|
||||
background-color: #eeeeee;
|
||||
}
|
||||
|
||||
.ScmRdr {
|
||||
.RktRdr {
|
||||
}
|
||||
|
||||
.ScmPn {
|
||||
.RktPn {
|
||||
color: #843c24;
|
||||
}
|
||||
|
||||
.ScmMeta {
|
||||
.RktMeta {
|
||||
color: black;
|
||||
}
|
||||
|
||||
.ScmMod {
|
||||
.RktMod {
|
||||
color: black;
|
||||
}
|
||||
|
||||
.ScmOpt {
|
||||
.RktOpt {
|
||||
color: black;
|
||||
}
|
||||
|
||||
.ScmKw {
|
||||
.RktKw {
|
||||
color: black;
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
.ScmErr {
|
||||
.RktErr {
|
||||
color: red;
|
||||
font-style: italic;
|
||||
}
|
||||
|
||||
.ScmVar {
|
||||
.RktVar {
|
||||
color: #262680;
|
||||
font-style: italic;
|
||||
}
|
||||
|
||||
.ScmSym {
|
||||
.RktSym {
|
||||
color: #262680;
|
||||
}
|
||||
|
||||
.ScmValLink {
|
||||
.RktValLink {
|
||||
text-decoration: none;
|
||||
color: blue;
|
||||
}
|
||||
|
||||
.ScmModLink {
|
||||
.RktModLink {
|
||||
text-decoration: none;
|
||||
color: blue;
|
||||
}
|
||||
|
||||
.ScmStxLink {
|
||||
.RktStxLink {
|
||||
text-decoration: none;
|
||||
color: black;
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
.ScmRes {
|
||||
.RktRes {
|
||||
color: #0000af;
|
||||
}
|
||||
|
||||
.ScmOut {
|
||||
.RktOut {
|
||||
color: #960096;
|
||||
}
|
||||
|
||||
.ScmCmt {
|
||||
.RktCmt {
|
||||
color: #c2741f;
|
||||
}
|
||||
|
||||
.ScmVal {
|
||||
.RktVal {
|
||||
color: #228b22;
|
||||
}
|
||||
|
||||
|
|
@ -130,7 +130,7 @@
|
|||
vertical-align: bottom;
|
||||
}
|
||||
|
||||
.ScmBlk td {
|
||||
.RktBlk td {
|
||||
vertical-align: baseline;
|
||||
}
|
||||
|
||||
|
|
@ -151,7 +151,7 @@
|
|||
float: right;
|
||||
}
|
||||
|
||||
.SBibliography td {
|
||||
.RBibliography td {
|
||||
vertical-align: text-top;
|
||||
}
|
||||
|
||||
|
|
@ -165,17 +165,17 @@
|
|||
margin-right: 1em;
|
||||
}
|
||||
|
||||
.Sfilebox {
|
||||
.Rfilebox {
|
||||
margin-left: 1em;
|
||||
margin-right: 1em;
|
||||
}
|
||||
|
||||
.Sfiletitle {
|
||||
.Rfiletitle {
|
||||
text-align: right;
|
||||
margin: 0em 0em 0em 0em;
|
||||
}
|
||||
|
||||
.Sfilename {
|
||||
.Rfilename {
|
||||
border-top: 1px solid #6C8585;
|
||||
border-right: 1px solid #6C8585;
|
||||
padding-left: 0.5em;
|
||||
|
|
@ -183,6 +183,6 @@
|
|||
background-color: #ECF5F5;
|
||||
}
|
||||
|
||||
.Sfilecontent {
|
||||
.Rfilecontent {
|
||||
margin: 0em 0em 0em 0em;
|
||||
}
|
||||
|
|
@ -58,26 +58,26 @@
|
|||
(cons 'tt-chars scheme-properties)
|
||||
scheme-properties)))
|
||||
|
||||
(define-on-demand output-color (make-racket-style "ScmOut"))
|
||||
(define-on-demand input-color (make-racket-style "ScmIn"))
|
||||
(define-on-demand input-background-color (make-racket-style "ScmInBG"))
|
||||
(define-on-demand no-color (make-racket-style "ScmPlain"))
|
||||
(define-on-demand reader-color (make-racket-style "ScmRdr"))
|
||||
(define-on-demand result-color (make-racket-style "ScmRes"))
|
||||
(define-on-demand keyword-color (make-racket-style "ScmKw"))
|
||||
(define-on-demand comment-color (make-racket-style "ScmCmt"))
|
||||
(define-on-demand paren-color (make-racket-style "ScmPn"))
|
||||
(define-on-demand meta-color (make-racket-style "ScmMeta"))
|
||||
(define-on-demand value-color (make-racket-style "ScmVal"))
|
||||
(define-on-demand symbol-color (make-racket-style "ScmSym"))
|
||||
(define-on-demand variable-color (make-racket-style "ScmVar"))
|
||||
(define-on-demand opt-color (make-racket-style "ScmOpt"))
|
||||
(define-on-demand error-color (make-racket-style "ScmErr" #:tt? #f))
|
||||
(define-on-demand syntax-link-color (make-racket-style "ScmStxLink"))
|
||||
(define-on-demand value-link-color (make-racket-style "ScmValLink"))
|
||||
(define-on-demand module-color (make-racket-style "ScmMod"))
|
||||
(define-on-demand module-link-color (make-racket-style "ScmModLink"))
|
||||
(define-on-demand block-color (make-racket-style "ScmBlk"))
|
||||
(define-on-demand output-color (make-racket-style "RktOut"))
|
||||
(define-on-demand input-color (make-racket-style "RktIn"))
|
||||
(define-on-demand input-background-color (make-racket-style "RktInBG"))
|
||||
(define-on-demand no-color (make-racket-style "RktPlain"))
|
||||
(define-on-demand reader-color (make-racket-style "RktRdr"))
|
||||
(define-on-demand result-color (make-racket-style "RktRes"))
|
||||
(define-on-demand keyword-color (make-racket-style "RktKw"))
|
||||
(define-on-demand comment-color (make-racket-style "RktCmt"))
|
||||
(define-on-demand paren-color (make-racket-style "RktPn"))
|
||||
(define-on-demand meta-color (make-racket-style "RktMeta"))
|
||||
(define-on-demand value-color (make-racket-style "RktVal"))
|
||||
(define-on-demand symbol-color (make-racket-style "RktSym"))
|
||||
(define-on-demand variable-color (make-racket-style "RktVar"))
|
||||
(define-on-demand opt-color (make-racket-style "RktOpt"))
|
||||
(define-on-demand error-color (make-racket-style "RktErr" #:tt? #f))
|
||||
(define-on-demand syntax-link-color (make-racket-style "RktStxLink"))
|
||||
(define-on-demand value-link-color (make-racket-style "RktValLink"))
|
||||
(define-on-demand module-color (make-racket-style "RktMod"))
|
||||
(define-on-demand module-link-color (make-racket-style "RktModLink"))
|
||||
(define-on-demand block-color (make-racket-style "RktBlk"))
|
||||
(define-on-demand highlighted-color (make-racket-style "highlighted" #:tt? #f))
|
||||
|
||||
(define current-keyword-list
|
||||
|
|
|
|||
58
collects/scribble/racket.tex
Normal file
58
collects/scribble/racket.tex
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
|
||||
% Redefine \SColorize to produce B&W Scheme text
|
||||
\newcommand{\SColorize}[2]{\color{#1}{#2}}
|
||||
|
||||
\newcommand{\inColor}[2]{{\Scribtexttt{\SColorize{#1}{#2}}}}
|
||||
\definecolor{PaleBlue}{rgb}{0.90,0.90,1.0}
|
||||
\definecolor{LightGray}{rgb}{0.90,0.90,0.90}
|
||||
\definecolor{CommentColor}{rgb}{0.76,0.45,0.12}
|
||||
\definecolor{ParenColor}{rgb}{0.52,0.24,0.14}
|
||||
\definecolor{IdentifierColor}{rgb}{0.15,0.15,0.50}
|
||||
\definecolor{ResultColor}{rgb}{0.0,0.0,0.69}
|
||||
\definecolor{ValueColor}{rgb}{0.13,0.55,0.13}
|
||||
\definecolor{OutputColor}{rgb}{0.59,0.00,0.59}
|
||||
|
||||
\newcommand{\RktPlain}[1]{\inColor{black}{#1}}
|
||||
\newcommand{\RktKw}[1]{{\SColorize{black}{\Scribtexttt{\textbf{#1}}}}}
|
||||
\newcommand{\RktStxLink}[1]{\RktKw{#1}}
|
||||
\newcommand{\RktCmt}[1]{\inColor{CommentColor}{#1}}
|
||||
\newcommand{\RktPn}[1]{\inColor{ParenColor}{#1}}
|
||||
\newcommand{\RktInBG}[1]{\inColor{ParenColor}{#1}}
|
||||
\newcommand{\RktSym}[1]{\inColor{IdentifierColor}{#1}}
|
||||
\newcommand{\RktVal}[1]{\inColor{ValueColor}{#1}}
|
||||
\newcommand{\RktValLink}[1]{\inColor{blue}{#1}}
|
||||
\newcommand{\RktModLink}[1]{\inColor{blue}{#1}}
|
||||
\newcommand{\RktRes}[1]{\inColor{ResultColor}{#1}}
|
||||
\newcommand{\RktOut}[1]{\inColor{OutputColor}{#1}}
|
||||
\newcommand{\RktMeta}[1]{\inColor{IdentifierColor}{#1}}
|
||||
\newcommand{\RktMod}[1]{\inColor{black}{#1}}
|
||||
\newcommand{\RktRdr}[1]{\inColor{black}{#1}}
|
||||
\newcommand{\RktVarCol}[1]{\inColor{IdentifierColor}{#1}}
|
||||
\newcommand{\RktVar}[1]{{\RktVarCol{\textsl{#1}}}}
|
||||
\newcommand{\RktErrCol}[1]{\inColor{red}{#1}}
|
||||
\newcommand{\RktErr}[1]{{\RktErrCol{\textrm{\textit{#1}}}}}
|
||||
\newcommand{\RktOpt}[1]{#1}
|
||||
\newcommand{\RktIn}[1]{\incolorbox{LightGray}{\RktInBG{#1}}}
|
||||
\newcommand{\highlighted}[1]{\colorbox{PaleBlue}{\hspace{-0.5ex}\RktInBG{#1}\hspace{-0.5ex}}}
|
||||
|
||||
\newenvironment{RktBlk}{}{}
|
||||
\newenvironment{defmodule}{}{}
|
||||
\newenvironment{prototype}{}{}
|
||||
\newenvironment{argcontract}{}{}
|
||||
\newenvironment{together}{}{}
|
||||
|
||||
\newenvironment{specgrammar}{}{}
|
||||
|
||||
|
||||
\newenvironment{RBibliography}{}{}
|
||||
\newcommand{\bibentry}[1]{\parbox[t]{0.8\linewidth}{#1}}
|
||||
|
||||
\newenvironment{leftindent}{\begin{quote}}{\end{quote}}
|
||||
\newenvironment{insetpara}{\begin{quote}}{\end{quote}}
|
||||
|
||||
\newcommand{\Rfiletitle}[1]{\hfill \fbox{#1}}
|
||||
\newcommand{\Rfilename}[1]{#1}
|
||||
\newenvironment{Rfilebox}{\begin{list}{}{\topsep=0pt\partopsep=0pt%
|
||||
\listparindent=0pt\itemindent=0pt\labelwidth=0pt\leftmargin=2ex\rightmargin=2ex%
|
||||
\itemsep=0pt\parsep=0pt}\item}{\end{list}}
|
||||
\newenvironment{Rfilecontent}{}{}
|
||||
|
|
@ -1,5 +1,6 @@
|
|||
#lang scheme/base
|
||||
(require setup/main-collects
|
||||
scheme/contract
|
||||
scribble/core
|
||||
scribble/base
|
||||
scribble/decode
|
||||
|
|
@ -7,11 +8,35 @@
|
|||
scribble/latex-properties
|
||||
(for-syntax scheme/base))
|
||||
|
||||
(provide/contract
|
||||
[abstract
|
||||
(->* () () #:rest (listof pre-content?)
|
||||
block?)]
|
||||
[authorinfo
|
||||
(-> pre-content? pre-content? pre-content?
|
||||
block?)]
|
||||
[conferenceinfo
|
||||
(-> pre-content? pre-content?
|
||||
block?)]
|
||||
[copyrightyear
|
||||
(->* () () #:rest (listof pre-content?)
|
||||
block?)]
|
||||
[copyrightdata
|
||||
(->* () () #:rest (listof pre-content?)
|
||||
block?)]
|
||||
[category
|
||||
(->* (pre-content? pre-content? pre-content?)
|
||||
((or/c false/c pre-content?))
|
||||
content?)]
|
||||
[terms
|
||||
(->* () () #:rest (listof pre-content?)
|
||||
content?)]
|
||||
[keywords
|
||||
(->* () () #:rest (listof pre-content?)
|
||||
content?)])
|
||||
|
||||
(provide preprint 10pt
|
||||
abstract include-abstract
|
||||
authorinfo
|
||||
conferenceinfo copyrightyear copyrightdata
|
||||
category terms keywords)
|
||||
include-abstract)
|
||||
|
||||
(define-syntax (preprint stx)
|
||||
(raise-syntax-error #f
|
||||
|
|
@ -97,11 +122,10 @@
|
|||
(define (category sec title sub [more #f])
|
||||
(make-multiarg-element
|
||||
(make-style (format "SCategory~a" (if more "Plus" "")) sigplan-extras)
|
||||
(append
|
||||
(list
|
||||
(list*
|
||||
(make-element #f (decode-content (list sec)))
|
||||
(make-element #f (decode-content (list title)))
|
||||
(make-element #f (decode-content (list sub))))
|
||||
(make-element #f (decode-content (list sub)))
|
||||
(if more
|
||||
(list (make-element #f (decode-content (list more))))
|
||||
null))))
|
||||
|
|
|
|||
|
|
@ -57,18 +57,33 @@
|
|||
(lambda (stx)
|
||||
(syntax-case stx ()
|
||||
[(_ id contract desc)
|
||||
(with-syntax ([(header result (body-stuff ...))
|
||||
(with-syntax ([(header result (body-stuff ...) better-contract)
|
||||
(syntax-case #'contract (->d -> values)
|
||||
[(->d (req ...) () (values [name res] ...))
|
||||
#'((id req ...) (values res ...) ())]
|
||||
[(->d ([arg-id arg/c] ...) () (values [name res] ...))
|
||||
#'((id [arg-id arg/c] ...)
|
||||
(values res ...)
|
||||
()
|
||||
(-> arg/c ... (values res ...)))]
|
||||
[(->d (req ...) () #:pre-cond condition (values [name res] ...))
|
||||
#'((id req ...) (values res ...) ((bold "Pre-condition: ") (scheme condition) "\n" "\n"))]
|
||||
[(->d (req ...) () [name res])
|
||||
#'((id req ...) res ())]
|
||||
#'((id req ...)
|
||||
(values res ...)
|
||||
((bold "Pre-condition: ") (scheme condition) "\n" "\n")
|
||||
contract)]
|
||||
[(->d ([arg-id arg/c] ...) () [name res])
|
||||
#'((id [arg-id arg/c] ...)
|
||||
res
|
||||
()
|
||||
(-> arg/c ... res))]
|
||||
[(->d (req ...) () #:pre-cond condition [name res])
|
||||
#'((id req ...) res ((bold "Pre-condition: ") (scheme condition) "\n" "\n" ))]
|
||||
[(->d (req ...) () #:rest rest rest-ctc [name res])
|
||||
#'((id req ... [rest rest-ctc] (... ...)) res ())]
|
||||
#'((id req ...)
|
||||
res
|
||||
((bold "Pre-condition: ") (scheme condition) "\n" "\n" )
|
||||
contract)]
|
||||
[(->d ([arg-id arg/c] ...) () #:rest rest rest-ctc [name res])
|
||||
#'((id [arg-id arg/c] ... [rest rest-ctc] (... ...))
|
||||
res
|
||||
()
|
||||
(->* (arg/c ...) () #:rest rest-ctc res))]
|
||||
[(->d (req ...) (one more ...) whatever)
|
||||
(raise-syntax-error
|
||||
#f
|
||||
|
|
@ -83,7 +98,7 @@
|
|||
stx
|
||||
#'contract)]
|
||||
[(-> result)
|
||||
#'((id) result ())]
|
||||
#'((id) result () contract)]
|
||||
[(-> whatever ...)
|
||||
(raise-syntax-error
|
||||
#f
|
||||
|
|
@ -98,7 +113,7 @@
|
|||
stx
|
||||
#'contract)])])
|
||||
(values
|
||||
#'[id contract]
|
||||
#'[id better-contract]
|
||||
#'(defproc header result body-stuff ... . desc)
|
||||
#'(scribble/manual)
|
||||
#'id))])))
|
||||
|
|
|
|||
|
|
@ -141,7 +141,7 @@ expressions.
|
|||
}===|
|
||||
|
||||
The command part of an @"@"-form is optional as well. In that case,
|
||||
the @"@" forms is read as a list, which usually counts as a function
|
||||
the @"@" form is read as a list, which usually counts as a function
|
||||
application, but it also useful when quoted with the usual Racket
|
||||
@racket[quote]:
|
||||
|
||||
|
|
|
|||
|
|
@ -65,9 +65,9 @@ Declares information that is collected into the copyright region of the paper.}
|
|||
@defproc[(category [CR-number pre-content?]
|
||||
[subcategory pre-content?]
|
||||
[third-level pre-content?]
|
||||
[fourth-level (or/c #f pre-content?) #f]) block?]
|
||||
@defproc[(terms [content pre-content?] ...) block?]
|
||||
@defproc[(keywords [content pre-content?] ...) block?]
|
||||
[fourth-level (or/c #f pre-content?) #f]) content?]
|
||||
@defproc[(terms [content pre-content?] ...) content?]
|
||||
@defproc[(keywords [content pre-content?] ...) content?]
|
||||
)]{
|
||||
|
||||
Typesets category, term, and keyword information for the paper, which
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang at-exp scheme/base
|
||||
#lang at-exp racket/base
|
||||
(require scribble/manual
|
||||
scribble/core
|
||||
scribble/decode
|
||||
|
|
@ -41,6 +41,25 @@
|
|||
(lambda () "(???)")
|
||||
(lambda () "(???)")))
|
||||
|
||||
(define (add-inline-cite group bib-entries)
|
||||
(for ([i bib-entries]) (hash-set! (bib-group-ht group) i #t))
|
||||
(when (and (pair? (cdr bib-entries)) (not (apply equal? (map auto-bib-author bib-entries))))
|
||||
(error 'citet "citet must be used with identical authors, given ~a" (map auto-bib-author bib-entries)))
|
||||
(make-element
|
||||
#f
|
||||
(list (add-cite group (car bib-entries) 'autobib-author)
|
||||
'nbsp
|
||||
"("
|
||||
(let loop ([keys bib-entries])
|
||||
(if (null? (cdr keys))
|
||||
(add-cite group (car keys) 'autobib-date)
|
||||
(make-element
|
||||
#f
|
||||
(list (loop (list (car keys)))
|
||||
"; "
|
||||
(loop (cdr keys))))))
|
||||
")")))
|
||||
|
||||
(define (add-cites group bib-entries)
|
||||
(make-element
|
||||
#f
|
||||
|
|
@ -48,7 +67,12 @@
|
|||
"("
|
||||
(let loop ([keys bib-entries])
|
||||
(if (null? (cdr keys))
|
||||
(add-cite group (car keys) 'autobib-cite)
|
||||
(make-element
|
||||
#f
|
||||
(list
|
||||
(add-cite group (car keys) 'autobib-author)
|
||||
" "
|
||||
(add-cite group (car keys) 'autobib-date)))
|
||||
(make-element
|
||||
#f
|
||||
(list (loop (list (car keys)))
|
||||
|
|
@ -87,23 +111,17 @@
|
|||
`(autobib ,(auto-bib-key k))))
|
||||
(lambda (ci)
|
||||
(collect-put! ci
|
||||
`(autobib-cite ,(auto-bib-key k))
|
||||
`(autobib-author ,(auto-bib-key k))
|
||||
(make-element
|
||||
#f
|
||||
(list
|
||||
(author-element-cite (auto-bib-author k))
|
||||
" "
|
||||
(auto-bib-date k))))
|
||||
(author-element-cite (auto-bib-author k)))))
|
||||
(collect-put! ci
|
||||
`(autobib-inline ,(auto-bib-key k))
|
||||
`(autobib-date ,(auto-bib-key k))
|
||||
(make-element
|
||||
#f
|
||||
(list
|
||||
(author-element-cite (auto-bib-author k))
|
||||
'nbsp
|
||||
"("
|
||||
(auto-bib-date k)
|
||||
")")))))))))
|
||||
(auto-bib-date k))))))))))
|
||||
bibs)))
|
||||
null)))
|
||||
|
||||
|
|
@ -112,8 +130,8 @@
|
|||
(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 (citet bib-entry . bib-entries)
|
||||
(add-inline-cite group (cons bib-entry bib-entries)))
|
||||
(define (generate-bibliography #:tag [tag "doc-bibliography"])
|
||||
(gen-bib tag group))))
|
||||
|
||||
|
|
@ -171,7 +189,7 @@
|
|||
(if (author-element? a)
|
||||
a
|
||||
(let* ([s (content->string a)]
|
||||
[m (regexp-match #px"^(.*) (\\p{L}+)$" s)])
|
||||
[m (regexp-match #px"^(.*) (([\\-]|\\p{L})+)$" s)])
|
||||
(make-author-element
|
||||
#f
|
||||
(list a)
|
||||
|
|
|
|||
|
|
@ -8,21 +8,40 @@
|
|||
racket/runtime-path
|
||||
racket/serialize
|
||||
"private/gui-eval-exn.ss"
|
||||
racket/system)
|
||||
racket/system
|
||||
(for-syntax racket/base))
|
||||
|
||||
(define-syntax define-mr
|
||||
(syntax-rules ()
|
||||
[(_ mr orig)
|
||||
(begin
|
||||
(provide mr)
|
||||
(define-syntax mr
|
||||
(syntax-rules ()
|
||||
(define-syntax (mr stx)
|
||||
(syntax-case stx ()
|
||||
[(_ #:eval+opts the-eval get-predicate? get-render get-get-width get-get-height x (... ...))
|
||||
#'(let ([the-eval-x the-eval])
|
||||
(parameterize ([scribble-eval-handler (gui-eval-handler the-eval-x
|
||||
get-predicate?
|
||||
get-render
|
||||
get-get-width
|
||||
get-get-height)])
|
||||
(orig #:eval the-eval-x x (... ...))))]
|
||||
[(_ x (... ...))
|
||||
(parameterize ([scribble-eval-handler gui-eval-handler])
|
||||
#'(parameterize ([scribble-eval-handler (gui-eval-handler gui-eval
|
||||
(λ () (gui-eval 'pict?))
|
||||
(λ () (gui-eval 'draw-pict))
|
||||
(λ () (gui-eval 'pict-width))
|
||||
(λ () (gui-eval 'pict-height)))])
|
||||
(orig #:eval gui-eval x (... ...)))])))]))
|
||||
|
||||
(define gui-eval (make-base-eval))
|
||||
|
||||
(define mred? (getenv "MREVAL"))
|
||||
|
||||
(when mred?
|
||||
(gui-eval '(require racket/gui/base))
|
||||
(gui-eval '(require slideshow)))
|
||||
|
||||
(define-mr gui-interaction interaction)
|
||||
(define-mr gui-interaction-eval interaction-eval)
|
||||
(define-mr gui-interaction-eval-show interaction-eval-show)
|
||||
|
|
@ -34,12 +53,6 @@
|
|||
(provide (rename-out [gui-racketmod+eval gui-schememod+eval]
|
||||
[gui-racketblock+eval gui-schemeblock+eval]))
|
||||
|
||||
(define mred? (getenv "MREVAL"))
|
||||
|
||||
(when mred?
|
||||
(gui-eval '(require racket/gui/base))
|
||||
(gui-eval '(require slideshow)))
|
||||
|
||||
;; This one needs to be relative, because it ends up in the
|
||||
;; exprs.dat file:
|
||||
(define img-dir "images") ; relative to src dir
|
||||
|
|
@ -52,6 +65,7 @@
|
|||
(if mred?
|
||||
(let ([eh (scribble-eval-handler)]
|
||||
[log-file (open-output-file exprs-dat-file #:exists 'truncate/replace)])
|
||||
(λ (gui-eval get-predicate? get-render get-get-width get-get-height)
|
||||
(lambda (ev catching-exns? expr)
|
||||
(write (serialize (if (syntax? expr) (syntax->datum expr) expr)) log-file)
|
||||
(newline log-file)
|
||||
|
|
@ -60,8 +74,11 @@
|
|||
(with-handlers ([exn:fail?
|
||||
(lambda (exn)
|
||||
(make-gui-exn (exn-message exn)))])
|
||||
(eh ev catching-exns? expr))])
|
||||
(let ([result (fixup-picts result)])
|
||||
;; put the call to fixup-picts in the handlers
|
||||
;; so that errors in the user-supplied predicates &
|
||||
;; conversion functions show up in the rendered output
|
||||
(fixup-picts (get-predicate?) (get-render) (get-get-width) (get-get-height)
|
||||
(eh ev catching-exns? expr)))])
|
||||
(write (serialize result) log-file)
|
||||
(newline log-file)
|
||||
(flush-output log-file)
|
||||
|
|
@ -74,6 +91,7 @@
|
|||
(lambda (exn)
|
||||
(open-input-string ""))])
|
||||
(open-input-file exprs-dat-file))])
|
||||
(λ (gui-eval get-predicate? get-render get-get-width get-get-height)
|
||||
(lambda (ev catching-exns? expr)
|
||||
(with-handlers ([exn:fail? (lambda (exn)
|
||||
(if catching-exns?
|
||||
|
|
@ -98,16 +116,17 @@
|
|||
(error 'mreval
|
||||
"expression does not match log file: ~e versus: ~e"
|
||||
expr
|
||||
v))))))))))
|
||||
v)))))))))))
|
||||
|
||||
(define image-counter 0)
|
||||
|
||||
;; This path will be marshaled for use on multiple platforms
|
||||
(define (build-string-path a b) (string-append a "/" b))
|
||||
|
||||
(define (fixup-picts v)
|
||||
(define (fixup-picts predicate? render get-width get-height v)
|
||||
(let loop ([v v])
|
||||
(cond
|
||||
[((gui-eval 'pict?) v)
|
||||
[(predicate? v)
|
||||
(let ([fn (build-string-path img-dir
|
||||
(format "img~a.png" image-counter))])
|
||||
(set! image-counter (add1 image-counter))
|
||||
|
|
@ -118,17 +137,17 @@
|
|||
(make-object (gui-eval 'post-script-dc%) #f)))])
|
||||
(send dc start-doc "Image")
|
||||
(send dc start-page)
|
||||
(((gui-eval 'make-pict-drawer) v) dc 0 0)
|
||||
(render v dc 0 0)
|
||||
(send dc end-page)
|
||||
(send dc end-doc)
|
||||
(system (format "epstopdf ~a" (path-replace-suffix fn #".ps"))))
|
||||
(let* ([bm (make-object (gui-eval 'bitmap%)
|
||||
(inexact->exact (ceiling ((gui-eval 'pict-width) v)))
|
||||
(inexact->exact (ceiling ((gui-eval 'pict-height) v))))]
|
||||
(inexact->exact (ceiling (get-width v)))
|
||||
(inexact->exact (ceiling (get-height v))))]
|
||||
[dc (make-object (gui-eval 'bitmap-dc%) bm)])
|
||||
(send dc set-smoothing 'aligned)
|
||||
(send dc clear)
|
||||
(((gui-eval 'make-pict-drawer) v) dc 0 0)
|
||||
(render v dc 0 0)
|
||||
(send bm save-file fn 'png)
|
||||
(make-image-element
|
||||
#f
|
||||
|
|
@ -138,7 +157,7 @@
|
|||
(path->string (path-replace-suffix fn #""))
|
||||
'(".pdf" ".png")
|
||||
1.0)))]
|
||||
[(pair? v) (cons (fixup-picts (car v))
|
||||
(fixup-picts (cdr v)))]
|
||||
[(pair? v) (cons (loop (car v))
|
||||
(loop (cdr v)))]
|
||||
[(serializable? v) v]
|
||||
[else (make-element #f (list (format "~s" v)))]))
|
||||
[else (make-element #f (list (format "~s" v)))])))
|
||||
|
|
|
|||
|
|
@ -22,16 +22,21 @@ 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
|
||||
The function bound to @scheme[~cite-id] produces a citation referring
|
||||
to one or more bibliography entries 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[citet-id] generates an element suitable
|
||||
for use as a noun---referring to a document or its author---for one
|
||||
or more bibliography entries which share an author. It has the contract
|
||||
|
||||
@schemeblock[
|
||||
((bib?) () (listof bib?) . ->* . element?)
|
||||
]
|
||||
|
||||
The function bound to @scheme[generate-bibliography-id] generates the
|
||||
section for the bibliography. It has the contract
|
||||
|
|
@ -65,9 +70,9 @@ standard format.
|
|||
An element produced 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.}
|
||||
name, the last non-empty sequence of alphabetic characters or
|
||||
@litchar["-"] 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?]{
|
||||
|
||||
|
|
|
|||
|
|
@ -16,16 +16,65 @@ images. Future runs (with the environment variable unset) use the
|
|||
generated image.
|
||||
|
||||
@deftogether[(
|
||||
@defform[(gui-interaction datum ...)]
|
||||
@defform[(gui-interaction-eval datum ...)]
|
||||
@defform[(gui-interaction-eval-show datum ...)]
|
||||
@defform[(gui-schemeblock+eval datum ...)]
|
||||
@defform[(gui-schememod+eval datum ...)]
|
||||
@defform[(gui-def+int datum ...)]
|
||||
@defform[(gui-defs+int datum ...)]
|
||||
@defform*[((gui-interaction datum ...)
|
||||
(gui-interaction
|
||||
#:eval+opts the-eval get-predicate? get-render
|
||||
get-get-width get-get-height
|
||||
datum ...))
|
||||
]
|
||||
@defform*[((gui-interaction-eval datum ...)
|
||||
(gui-interaction-eval
|
||||
#:eval+opts the-eval get-predicate? get-render
|
||||
get-get-width get-get-height
|
||||
datum ... ))]
|
||||
@defform*[((gui-interaction-eval-show datum ...)
|
||||
(gui-interaction-eval-show
|
||||
#:eval+opts the-eval get-predicate? get-render
|
||||
get-get-width get-get-height
|
||||
datum ...))]
|
||||
@defform*[((gui-schemeblock+eval datum ...)
|
||||
(gui-schemeblock+eval
|
||||
#:eval+opts the-eval get-predicate? get-render
|
||||
get-get-width get-get-height
|
||||
datum ...))]
|
||||
@defform*[((gui-schememod+eval datum ...)
|
||||
(gui-schememod+eval
|
||||
#:eval+opts the-eval get-predicate? get-render
|
||||
get-get-width get-get-height
|
||||
datum ...))]
|
||||
@defform*[((gui-def+int datum ...)
|
||||
(gui-def+int
|
||||
#:eval+opts the-eval get-predicate? get-render
|
||||
get-get-width get-get-height
|
||||
datum ...))]
|
||||
@defform*[((gui-defs+int datum ...)
|
||||
(gui-defs+int
|
||||
#:eval+opts the-eval get-predicate? get-render
|
||||
get-get-width get-get-height
|
||||
datum ...))]
|
||||
)]{
|
||||
|
||||
Like @scheme[interaction], etc., but actually evaluating the forms
|
||||
The first option of each of the above is
|
||||
like @scheme[interaction], etc., but actually evaluating the forms
|
||||
only when the @envvar{MREVAL} environment variable is set, and then in
|
||||
an evaluator that is initialized with @schememodname[racket/gui/base]
|
||||
and @schememodname[slideshow]. }
|
||||
and @schememodname[slideshow].
|
||||
|
||||
The second option of each allows you to specify your own evaluator via
|
||||
the @scheme[the-eval] argument and then to specify four thunks that
|
||||
return functions for finding and rendering graphical objects:
|
||||
@itemize[
|
||||
@item{@scheme[get-predicate? : (-> (-> any/c boolean?))]
|
||||
Determines if a value is a graphical object (and thus handled by the other operations)}
|
||||
@item{@scheme[get-render : (-> (-> any/c (is-a?/c dc<%>) number? number? void?))]
|
||||
Draws a graphical object (only called if the predicate returned @scheme[#t]; the first
|
||||
argument will be the value for which the predicate holds).}
|
||||
@item{@scheme[get-get-width : (-> (-> any/c number?))]
|
||||
Gets the width of a graphical object (only called if the predicate returned @scheme[#t]; the first
|
||||
argument will be the value for which the predicate holds).}
|
||||
@item{@scheme[get-get-height : (-> (-> any/c number?))]
|
||||
Gets the height of a graphical object (only called if the predicate returned @scheme[#t]; the first
|
||||
argument will be the value for which the predicate holds).}
|
||||
]
|
||||
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user