suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Merge tag 'v7.6' into my-changes-rebased

Browse Source
This commit is contained in:
Suzanne Soy 2021-07-06 03:07:11 +01:00
commit a7a8bcd015
32 changed files with 1783 additions and 1669 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
LICENSE Normal file
View File

@ -0,0 +1,10 @@
This component of Racket is distributed under the under the Apache 2.0
and MIT licenses. The user can choose the license under which they
will be using the software. There may be other licenses within the
distribution with which the user must also comply.
See the files
https://github.com/racket/racket/blob/master/racket/src/LICENSE-APACHE.txt
and
https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt
for the full text of the licenses.

24
README.md Normal file
View File

@ -0,0 +1,24 @@
# scribble-text-lib
This the source for the Racket packages: "scribble", "scribble-doc", "scribble-html-lib", "scribble-lib", "scribble-test", "scribble-text-lib".
### Contributing
Contribute to Racket by submitting a [pull request], reporting an
[issue], joining the [development mailing list], or visiting the
IRC or Slack channels.
### License
Racket, including these packages, is free software, see [LICENSE]
for more details.
By making a contribution, you are agreeing that your contribution
is licensed under the [Apache 2.0] license and the [MIT] license.
[MIT]: https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt
[Apache 2.0]: https://www.apache.org/licenses/LICENSE-2.0.txt
[pull request]: https://github.com/racket/scribble-text-lib/pulls
[issue]: https://github.com/racket/scribble-text-lib/issues
[development mailing list]: https://lists.racket-lang.org
[LICENSE]: LICENSE

11
scribble-doc/LICENSE.txt
View File

@ -1,11 +0,0 @@
scribble-doc
Copyright (c) 2010-2014 PLT Design Inc.
This package is distributed under the GNU Lesser General Public
License (LGPL). This means that you can link this package into proprietary
applications, provided you follow the rules stated in the LGPL. You
can also modify this package; if you distribute a modified version,
you must distribute it under the terms of the LGPL, which in
particular means that you must release the source code for the
modified software. See http://www.gnu.org/copyleft/lesser.html
for more information.

4
scribble-doc/scribblings/scribble/base.scrbl
View File

@ -467,7 +467,9 @@ gets progressively smaller.}
gets progressively larger.} gets progressively larger.}
@defproc[(emph [pre-content pre-content?] ...) element?]{ @defproc[(emph [pre-content pre-content?] ...) element?]{
The same as @racket[italic].} Like @racket[elem], but emphasised. Typically, italics are used for
emphasis. Uses of @racket[emph] can be nested; typically this causes
the text to alternate between italic and upright.}
@defproc[(literal [str string?] ...+) element?]{ @defproc[(literal [str string?] ...+) element?]{

2
scribble-doc/scribblings/scribble/config.scrbl
View File

@ -332,7 +332,7 @@ The style classes:
[@css{versionbox} @elem{Outer wrapper for version}] [@css{versionbox} @elem{Outer wrapper for version}]
[@css{version} @elem{Inner wrapper for version in the case of search box and/or navigation.}] [@css{version} @elem{Inner wrapper for version in the case of search box and/or navigation.}]
[@css{versionNoNav} @elem{Inner wrapper for version in the acse of no search box and navigation.}] [@css{versionNoNav} @elem{Inner wrapper for version in the case of no search box and navigation.}]
[@spacer @spacer] [@spacer @spacer]

34
scribble-doc/scribblings/scribble/core.scrbl
View File

@ -441,6 +441,14 @@ The recognized @tech{style properties} are as follows:
listing except when those sub-parts are top-level entries in listing except when those sub-parts are top-level entries in
the listing.} the listing.}
@item{@indexed-racket['no-toc+aux] --- As a @tech{style property} for
the main part of a rendered page, causes the HTML output to not
include a margin box for the main table of contents, ``on this
page'', or tables with the @racket['aux] style property. The
@racket['no-toc+aux] property effectively implies
@racket['no-toc] and @racket['no-sidebar], but also suppresses
@racket['aux] tables.}
@item{@indexed-racket['no-toc] --- As a @tech{style property} for the main part of a @item{@indexed-racket['no-toc] --- As a @tech{style property} for the main part of a
rendered page, causes the HTML output to not include a margin box rendered page, causes the HTML output to not include a margin box
for the main table of contents; the ``on this page'' box that for the main table of contents; the ``on this page'' box that
@ -541,7 +549,8 @@ sub-parts).
The @racket[parts] field contains sub-parts. The @racket[parts] field contains sub-parts.
@history[#:changed "1.25" @elem{Added @racket['no-index] support.} @history[#:changed "1.25" @elem{Added @racket['no-index] support.}
#:changed "1.26" @elem{Added @racket[link-render-style] support.}]} #:changed "1.26" @elem{Added @racket[link-render-style] support.}
#:changed "1.27" @elem{Added @racket['no-toc+aux] support.}]}
@defstruct[paragraph ([style style?] [content content?])]{ @defstruct[paragraph ([style style?] [content content?])]{
@ -590,10 +599,6 @@ The currently recognized @tech{style properties} are as follows:
@item{@racket[attributes] structure --- Provides additional HTML @item{@racket[attributes] structure --- Provides additional HTML
attributes for the @tt{<p>}, @tt{<div>}, or alternate tag.} attributes for the @tt{<p>}, @tt{<div>}, or alternate tag.}
@item{@racket[body-id] structure --- For HTML, uses the given string
as an @tt{id} attribute of the @tt{<p>}, @tt{<div>}, or
alternate tag.}
@item{@indexed-racket['never-indents] --- For Latex and @tech{compound @item{@indexed-racket['never-indents] --- For Latex and @tech{compound
paragraphs}; see @racket[compound-paragraph].} paragraphs}; see @racket[compound-paragraph].}
@ -649,9 +654,6 @@ The following @tech{style properties} are currently recognized:
@item{@racket[attributes] structure --- Provides additional HTML @item{@racket[attributes] structure --- Provides additional HTML
attributes for the @tt{<table>} tag.} attributes for the @tt{<table>} tag.}
@item{@racket[body-id] structure --- For HTML, uses the given string
as an @tt{id} attribute of the @tt{<table>} tag.}
@item{@indexed-racket['aux] --- For HTML, include the table in the @item{@indexed-racket['aux] --- For HTML, include the table in the
table-of-contents display for the enclosing part.} table-of-contents display for the enclosing part.}
@ -698,9 +700,6 @@ The following @tech{style properties} are currently recognized:
@item{@racket[attributes] structure --- Provides additional HTML @item{@racket[attributes] structure --- Provides additional HTML
attributes for the @tt{<ul>} or @tt{<ol>} tag.} attributes for the @tt{<ul>} or @tt{<ol>} tag.}
@item{@racket[body-id] structure --- For HTML, uses the given string
as an @tt{id} attribute of the @tt{<ul>} or @tt{<ol>} tag.}
@item{@indexed-racket['never-indents] --- For Latex and @tech{compound @item{@indexed-racket['never-indents] --- For Latex and @tech{compound
paragraphs}; see @racket[compound-paragraph].} paragraphs}; see @racket[compound-paragraph].}
@ -749,9 +748,6 @@ The following @tech{style properties} are currently recognized:
@item{@racket[attributes] structure --- Provides additional HTML @item{@racket[attributes] structure --- Provides additional HTML
attributes for the @tt{<blockquote>} tag.} attributes for the @tt{<blockquote>} tag.}
@item{@racket[body-id] structure --- For HTML, uses the given string
as an @tt{id} attribute of the @tt{<blockquote>} tag.}
@item{@indexed-racket['never-indents] --- For Latex and @tech{compound @item{@indexed-racket['never-indents] --- For Latex and @tech{compound
paragraphs}; see @racket[compound-paragraph].} paragraphs}; see @racket[compound-paragraph].}
@ -802,9 +798,6 @@ for Latex output (see @secref["extra-style"]). The following
@item{@racket[attributes] structure --- Provides additional HTML @item{@racket[attributes] structure --- Provides additional HTML
attributes for the @tt{<p>} or alternate tag.} attributes for the @tt{<p>} or alternate tag.}
@item{@racket[body-id] structure --- For HTML, uses the given string
as an @tt{id} attribute of the @tt{<p>} or alternate tag.}
@item{@indexed-racket['never-indents] --- For Latex within another @item{@indexed-racket['never-indents] --- For Latex within another
@tech{compound paragraph}; see above.} @tech{compound paragraph}; see above.}
@ -914,9 +907,6 @@ The following @tech{style properties} are currently recognized:
@item{@racket[xexpr-property] structure --- For HTML, supplies literal @item{@racket[xexpr-property] structure --- For HTML, supplies literal
HTML to render before and after @racket[content].} HTML to render before and after @racket[content].}
@item{@racket[body-id] structure --- For HTML uses the given
string as an @tt{id} attribute of the @tt{<span>} tag.}
@item{@indexed-racket['aux] --- Intended for use in titles, where the @item{@indexed-racket['aux] --- Intended for use in titles, where the
auxiliary part of the title can be omitted in hyperlinks. See, auxiliary part of the title can be omitted in hyperlinks. See,
for example, @racket[secref].} for example, @racket[secref].}
@ -1818,7 +1808,7 @@ Like @racket[css-style-addition], but for a JavaScript file instead of a CSS fil
@defstruct[body-id ([value string?])]{ @defstruct[body-id ([value string?])]{
Used as a @tech{style property} to associate an @tt{id} attribute with Used as a @tech{style property} to associate an @tt{id} attribute with
an HTML tag.} an HTML tag within a main @racket[part].}
@defstruct[document-source ([module-path module-path?])]{ @defstruct[document-source ([module-path module-path?])]{
@ -1958,7 +1948,7 @@ arguments to the element's command in Latex output.}
@defstruct[command-optional ([arguments (listof string?)])]{ @defstruct[command-optional ([arguments (listof string?)])]{
Used as a @tech{style property} on a @racket[element] to add Used as a @tech{style property} on a @racket[element] to add
a optional arguments to the element's command in Latex output. optional arguments to the element's command in Latex output.
@history[#:added "1.20"] @history[#:added "1.20"]
} }

9
scribble-doc/scribblings/scribble/manual.scrbl
View File

@ -1714,9 +1714,8 @@ Typesets the given combination of a GUI's menu and item name.}
@tech{decode}d @racket[pre-content] as a file name (e.g., in @tech{decode}d @racket[pre-content] as a file name (e.g., in
typewriter font and in quotes).} typewriter font and in quotes).}
@defproc[(exec [pre-content pre-content?] ...) element?]{Typesets the @defproc[(exec [content content?] ...) element?]{Typesets the
@tech{decode}d @racket[pre-content] as a command line (e.g., in @racket[content] as a command line (e.g., in typewriter font).}
typewriter font).}
@defproc[(envvar [pre-content pre-content?] ...) element?]{Typesets the given @defproc[(envvar [pre-content pre-content?] ...) element?]{Typesets the given
@tech{decode}d @racket[pre-content] as an environment variable (e.g., @tech{decode}d @racket[pre-content] as an environment variable (e.g.,
@ -2028,7 +2027,7 @@ that is hyperlinked to an explanation.}
@defthing[undefined-const element?]{Returns an element for @|undefined-const|.} @defthing[undefined-const element?]{Returns an element for @|undefined-const|.}
@defproc[(commandline [pre-content pre-content?] ...) paragraph?]{Produces @defproc[(commandline [content content?] ...) paragraph?]{Produces
an inset command-line example (e.g., in typewriter font).} an inset command-line example (e.g., in typewriter font).}
@defproc[(inset-flow [pre-flow pre-flow?] ...) nested-flow?]{ @defproc[(inset-flow [pre-flow pre-flow?] ...) nested-flow?]{
@ -2201,7 +2200,7 @@ For HTML rendering:
@filepath{manual-style.css} from the @filepath{scribble} @filepath{manual-style.css} from the @filepath{scribble}
collection in @racket[html-defaults].} collection in @racket[html-defaults].}
@item{The file @filepath{manual-files.css} from the @item{The file @filepath{manual-fonts.css} from the
@filepath{scribble} collection is designated as an additional @filepath{scribble} collection is designated as an additional
accompanying file in @racket[html-defaults].} accompanying file in @racket[html-defaults].}

7
scribble-doc/scribblings/scribble/renderer.scrbl
View File

@ -607,6 +607,13 @@ Code blocks are marked using the
"Github convention"] @verbatim{```racket} so that they are lexed and "Github convention"] @verbatim{```racket} so that they are lexed and
formatted as Racket code.}} formatted as Racket code.}}
@defboolparam[current-markdown-link-sections enabled?]{
Determines whether section links within an output document are
rendered as a section link. The default is @racket[#f].
@history[#:added "1.31"]}
@; ---------------------------------------- @; ----------------------------------------
@section{HTML Renderer} @section{HTML Renderer}

9
scribble-doc/scriblib/scribblings/autobib.scrbl
View File

@ -1,5 +1,6 @@
#lang scribble/manual #lang scribble/manual
@(require (for-label scribble/struct @(require (for-label (only-in scribble/core content?)
scribble/struct
scriblib/autobib scriblib/autobib
scheme/base scheme/base
scheme/contract)) scheme/contract))
@ -228,7 +229,7 @@ Both arguments are optional, but at least one must be supplied.}
Combines elements to generate an element that is suitable for Combines elements to generate an element that is suitable for
describing a technical report's location.} describing a technical report's location.}
@defproc[(dissertation-location [#:institution institution edition any/c] @defproc[(dissertation-location [#:institution institution any/c]
[#:degree degree any/c "PhD"]) [#:degree degree any/c "PhD"])
element?]{ element?]{
@ -264,7 +265,7 @@ alphabetized appropriately. Any of @racket[name] or @racket[names]
that are strings are that are strings are
parsed in the same way as by @racket[make-bib].} parsed in the same way as by @racket[make-bib].}
@defproc[(org-author-name [name any/c]) element?]{ @defproc[(org-author-name [name (or/c element? string?)]) element?]{
Converts an element for an organization name to one suitable for use Converts an element for an organization name to one suitable for use
as a bib-value author.} as a bib-value author.}
@ -275,7 +276,7 @@ Generates an element that is suitable for use as a ``others'' author.
When combined with another author element via @racket[authors], the When combined with another author element via @racket[authors], the
one created by @racket[other-authors] renders as ``et al.''} one created by @racket[other-authors] renders as ``et al.''}
@defproc[(editor [name name/c]) element?]{ @defproc[(editor [name (or/c element? string?)]) element?]{
Takes an author-name element and create one that represents the editor Takes an author-name element and create one that represents the editor
of a collection. If a @racket[name] is a string, it is parsed in the of a collection. If a @racket[name] is a string, it is parsed in the

11
scribble-html-lib/LICENSE.txt
View File

@ -1,11 +0,0 @@
scribble-text-lib
Copyright (c) 2010-2014 PLT Design Inc.
This package is distributed under the GNU Lesser General Public
License (LGPL). This means that you can link this package into proprietary
applications, provided you follow the rules stated in the LGPL. You
can also modify this package; if you distribute a modified version,
you must distribute it under the terms of the LGPL, which in
particular means that you must release the source code for the
modified software. See http://www.gnu.org/copyleft/lesser.html
for more information.

2
scribble-html-lib/scribble/html/xml.rkt
View File

@ -33,7 +33,7 @@
(let loop ([xs xs] [as '()]) (let loop ([xs xs] [as '()])
(define a (and (pair? xs) (attribute->symbol (car xs)))) (define a (and (pair? xs) (attribute->symbol (car xs))))
(cond [(not a) (values (reverse as) xs)] (cond [(not a) (values (reverse as) xs)]
[(null? (cdr xs)) (error 'attriubtes+body [(null? (cdr xs)) (error 'attributes+body
"missing attribute value for `~s:'" a)] "missing attribute value for `~s:'" a)]
[else (loop (cddr xs) (cons (cons a (cadr xs)) as))]))) [else (loop (cddr xs) (cons (cons a (cadr xs)) as))])))

11
scribble-lib/LICENSE.txt
View File

@ -1,11 +0,0 @@
scribble-lib
Copyright (c) 2010-2014 PLT Design Inc.
This package is distributed under the GNU Lesser General Public
License (LGPL). This means that you can link this package into proprietary
applications, provided you follow the rules stated in the LGPL. You
can also modify this package; if you distribute a modified version,
you must distribute it under the terms of the LGPL, which in
particular means that you must release the source code for the
modified software. See http://www.gnu.org/copyleft/lesser.html
for more information.

2
scribble-lib/info.rkt
View File

@ -23,4 +23,4 @@
(define pkg-authors '(mflatt eli)) (define pkg-authors '(mflatt eli))
(define version "1.30") (define version "1.32")

2
scribble-lib/scribble/base.rkt
View File

@ -258,7 +258,7 @@
(make-element 'larger (decode-content str))) (make-element 'larger (decode-content str)))
(define (emph . str) (define (emph . str)
(make-element 'italic (decode-content str))) (make-element 'emph (decode-content str)))
(define (tt . str) (define (tt . str)
(let* ([l (decode-content str)] (let* ([l (decode-content str)]

209
scribble-lib/scribble/bnf.rkt
View File

@ -1,121 +1,122 @@
(module bnf racket #lang racket
(require scribble/decode
(except-in scribble/struct
element?)
(only-in scribble/core
content?
element?
make-style
make-table-columns)
)
(provide (contract-out (require scribble/decode
[BNF (-> (cons/c (or/c block? content?) (except-in scribble/struct
(non-empty-listof (or/c block? content?))) element?)
... (only-in scribble/core
table?)] content?
[BNF-etc element?] element?
;; operate on content make-style
[BNF-seq (-> content? ... make-table-columns)
(or/c element? ""))] )
[BNF-seq-lines (-> (listof content?) ...
block?)] (provide (contract-out
[BNF-alt (-> content? ... [BNF (-> (cons/c (or/c block? content?)
element?)] (non-empty-listof (or/c block? content?)))
[BNF-alt/close (-> content? ... ...
element?)] table?)]
;; operate on pre-content [BNF-etc element?]
[BNF-group (-> pre-content? ... ;; operate on content
element?)] [BNF-seq (-> content? ...
[nonterm (-> pre-content? ... (or/c element? ""))]
element?)] [BNF-seq-lines (-> (listof content?) ...
[optional (-> pre-content? ... block?)]
element?)] [BNF-alt (-> content? ...
[kleenestar (-> pre-content? ... element?)]
element?)] [BNF-alt/close (-> content? ...
[kleeneplus (-> pre-content? ...
element?)]
[kleenerange (-> any/c any/c pre-content? ...
element?)] element?)]
)) ;; operate on pre-content
[BNF-group (-> pre-content? ...
element?)]
(define spacer (make-element 'hspace (list " "))) [nonterm (-> pre-content? ...
(define equals (make-element 'tt (list spacer "::=" spacer))) element?)]
(define alt (make-element 'tt (list spacer spacer "|" spacer spacer))) [optional (-> pre-content? ...
element?)]
(define (as-flow i) (make-flow (list (if (block? i) [kleenestar (-> pre-content? ...
i element?)]
(make-paragraph (list i)))))) [kleeneplus (-> pre-content? ...
element?)]
[kleenerange (-> any/c any/c pre-content? ...
element?)]
))
(define baseline (make-style #f '(baseline))) (define spacer (make-element 'hspace (list " ")))
(define equals (make-element 'tt (list spacer "::=" spacer)))
(define alt (make-element 'tt (list spacer spacer "|" spacer spacer)))
(define (BNF . defns) (define (as-flow i) (make-flow (list (if (block? i)
(make-table i
(make-style #f (make-paragraph (list i))))))
(list
(make-table-columns
(list baseline baseline baseline baseline))))
(apply
append
(map (match-lambda
[(cons lhs (cons rhs0 more-rhs))
(cons
(list (as-flow spacer) (as-flow lhs) (as-flow equals) (as-flow rhs0))
(map (lambda (i)
(list (as-flow spacer) (as-flow " ") (as-flow alt) (as-flow i)))
more-rhs))])
defns))))
;; interleave : (listof content?) element? -> element?
(define (interleave l spacer)
(make-element #f (cons (car l)
(apply append
(map (lambda (i)
(list spacer i))
(cdr l))))))
(define (BNF-seq . l) (define baseline (make-style #f '(baseline)))
(if (null? l)
""
(interleave l spacer)))
(define (BNF-seq-lines . l) (define (BNF . defns)
(make-table #f (map (lambda (row) (list (as-flow (apply BNF-seq row)))) (make-table
l))) (make-style #f
(list
(make-table-columns
(list baseline baseline baseline baseline))))
(apply
append
(map (match-lambda
[(cons lhs (cons rhs0 more-rhs))
(cons
(list (as-flow spacer) (as-flow lhs) (as-flow equals) (as-flow rhs0))
(map (lambda (i)
(list (as-flow spacer) (as-flow " ") (as-flow alt) (as-flow i)))
more-rhs))])
defns))))
(define (BNF-alt . l) ;; interleave : (listof content?) element? -> element?
(interleave l alt)) (define (interleave l spacer)
(make-element #f (cons (car l)
(apply append
(map (lambda (i)
(list spacer i))
(cdr l))))))
(define (BNF-alt/close . l) (define (BNF-seq . l)
(interleave l (make-element 'roman " | "))) (if (null? l)
""
(interleave l spacer)))
(define BNF-etc (make-element 'roman "...")) (define (BNF-seq-lines . l)
(make-table #f (map (lambda (row) (list (as-flow (apply BNF-seq row))))
l)))
(define (nonterm . s) (define (BNF-alt . l)
(make-element 'roman (append (list 'lang) (interleave l alt))
(list (make-element 'italic (decode-content s)))
(list 'rang))))
(define (optional . s) (define (BNF-alt/close . l)
(make-element #f (append (list (make-element 'roman "[")) (interleave l (make-element 'roman " | ")))
(decode-content s)
(list (make-element 'roman "]")))))
(define (BNF-group . s) (define BNF-etc (make-element 'roman "..."))
(make-element #f (append (list (make-element 'roman "{"))
(list (apply BNF-seq (decode-content s)))
(list (make-element 'roman "}")))))
(define (kleenestar . s) (define (nonterm . s)
(make-element #f (append (decode-content s) (list (make-element 'roman "*"))))) (make-element 'roman (append (list 'lang)
(list (make-element 'italic (decode-content s)))
(list 'rang))))
(define (kleeneplus . s) (define (optional . s)
(make-element #f (append (decode-content s) (list (make-element 'superscript (list "+")))))) (make-element #f (append (list (make-element 'roman "["))
(decode-content s)
(list (make-element 'roman "]")))))
(define (kleenerange a b . s) (define (BNF-group . s)
(make-element #f (append (decode-content s) (make-element #f (append (list (make-element 'roman "{"))
(list (make-element 'roman (list (apply BNF-seq (decode-content s)))
(make-element 'superscript (list (make-element 'roman "}")))))
(list (format "{~a,~a}" a b)))))))))
(define (kleenestar . s)
(make-element #f (append (decode-content s) (list (make-element 'roman "*")))))
(define (kleeneplus . s)
(make-element #f (append (decode-content s) (list (make-element 'superscript (list "+"))))))
(define (kleenerange a b . s)
(make-element #f (append (decode-content s)
(list (make-element 'roman
(make-element 'superscript
(list (format "{~a,~a}" a b))))))))

2
scribble-lib/scribble/book/style.tex
View File

@ -38,7 +38,7 @@
\renewcommand{\Ssubsubsubsectiongrouperstar}[1]{\setcounter{GrouperTemp}{\value{subsubsection}}\Ssubsubsectionstar{#1}\setcounter{subsubsection}{\value{GrouperTemp}}} \renewcommand{\Ssubsubsubsectiongrouperstar}[1]{\setcounter{GrouperTemp}{\value{subsubsection}}\Ssubsubsectionstar{#1}\setcounter{subsubsection}{\value{GrouperTemp}}}
\renewcommand{\Ssubsubsubsubsectiongrouperstar}[1]{\Ssubsubsubsubsectionstar{#1}} \renewcommand{\Ssubsubsubsubsectiongrouperstar}[1]{\Ssubsubsubsubsectionstar{#1}}
% To increments section numbers: % To increment section numbers:
\renewcommand{\Sincpart}{\stepcounter{part}} \renewcommand{\Sincpart}{\stepcounter{part}}
\renewcommand{\Sincsection}{\stepcounter{chapter}} \renewcommand{\Sincsection}{\stepcounter{chapter}}
\renewcommand{\Sincsubsection}{\stepcounter{section}} \renewcommand{\Sincsubsection}{\stepcounter{section}}

149
scribble-lib/scribble/comment-reader.rkt
View File

@ -1,83 +1,84 @@
(module comment-reader scheme/base #lang scheme/base
(require (only-in racket/port peeking-input-port))
(provide (rename-out [*read read] (require (only-in racket/port peeking-input-port))
[*read-syntax read-syntax])
make-comment-readtable)
(define unsyntaxer (make-parameter 'unsyntax)) (provide (rename-out [*read read]
[*read-syntax read-syntax])
make-comment-readtable)
(define (*read [inp (current-input-port)]) (define unsyntaxer (make-parameter 'unsyntax))
(parameterize ([unsyntaxer (read-unsyntaxer inp)]
[current-readtable (make-comment-readtable)])
(read/recursive inp)))
(define (*read-syntax src [port (current-input-port)]) (define (*read [inp (current-input-port)])
(parameterize ([unsyntaxer (read-unsyntaxer port)] (parameterize ([unsyntaxer (read-unsyntaxer inp)]
[current-readtable (make-comment-readtable)]) [current-readtable (make-comment-readtable)])
(read-syntax/recursive src port))) (read/recursive inp)))
(define (*read-syntax src [port (current-input-port)])
(parameterize ([unsyntaxer (read-unsyntaxer port)]
[current-readtable (make-comment-readtable)])
(read-syntax/recursive src port)))
(define (read-unsyntaxer port) (define (read-unsyntaxer port)
(let ([p (peeking-input-port port)]) (let ([p (peeking-input-port port)])
(if (eq? (read p) '#:escape-id) (if (eq? (read p) '#:escape-id)
(begin (read port) (read port)) (begin (read port) (read port))
'unsyntax))) 'unsyntax)))
(define (make-comment-readtable #:readtable [rt (current-readtable)]) (define (make-comment-readtable #:readtable [rt (current-readtable)])
(make-readtable rt (make-readtable rt
#\; 'terminating-macro #\; 'terminating-macro
(case-lambda (case-lambda
[(char port) [(char port)
(do-comment port (lambda () (read/recursive port #\@)))] (do-comment port (lambda () (read/recursive port #\@)))]
[(char port src line col pos) [(char port src line col pos)
(let ([v (do-comment port (lambda () (read-syntax/recursive src port #\@)))]) (let ([v (do-comment port (lambda () (read-syntax/recursive src port #\@)))])
(let-values ([(eline ecol epos) (port-next-location port)]) (let-values ([(eline ecol epos) (port-next-location port)])
(datum->syntax (datum->syntax
#f #f
v v
(list src line col pos (and pos epos (- epos pos))))))]))) (list src line col pos (and pos epos (- epos pos))))))])))
(define (do-comment port recur) (define (do-comment port recur)
(let loop () (let loop ()
(when (equal? #\; (peek-char port)) (when (equal? #\; (peek-char port))
(read-char port) (read-char port)
(loop))) (loop)))
(when (equal? #\space (peek-char port)) (when (equal? #\space (peek-char port))
(read-char port)) (read-char port))
`(code:comment `(code:comment
(,(unsyntaxer) (,(unsyntaxer)
(t (t
,@(append-strings ,@(append-strings
(let loop () (let loop ()
(let ([c (read-char port)]) (let ([c (read-char port)])
(cond (cond
[(or (eof-object? c) [(or (eof-object? c)
(char=? c #\newline)) (char=? c #\newline))
null] null]
[(char=? c #\@) [(char=? c #\@)
(cons (recur) (loop))] (cons (recur) (loop))]
[else [else
(cons (string c) (cons (string c)
(loop))])))))))) (loop))]))))))))
(define (append-strings l) (define (append-strings l)
(let loop ([l l][s null]) (let loop ([l l][s null])
(cond (cond
[(null? l) (if (null? s) [(null? l) (if (null? s)
null null
(preserve-space (apply string-append (reverse s))))] (preserve-space (apply string-append (reverse s))))]
[(string? (car l)) [(string? (car l))
(loop (cdr l) (cons (car l) s))] (loop (cdr l) (cons (car l) s))]
[else [else
(append (loop null s) (append (loop null s)
(cons (cons
(car l) (car l)
(loop (cdr l) null)))]))) (loop (cdr l) null)))])))
(define (preserve-space s) (define (preserve-space s)
(let ([m (regexp-match-positions #rx" +" s)]) (let ([m (regexp-match-positions #rx" +" s)])
(if m (if m
(append (preserve-space (substring s 0 (caar m))) (append (preserve-space (substring s 0 (caar m)))
(list `(hspace ,(- (cdar m) (caar m)))) (list `(hspace ,(- (cdar m) (caar m))))
(preserve-space (substring s (cdar m)))) (preserve-space (substring s (cdar m))))
(list s))))) (list s))))

7
scribble-lib/scribble/config.rkt
View File

@ -1,6 +1,5 @@
#lang mzscheme
(module config mzscheme (provide value-color)
(provide value-color) (define value-color "schemevalue")
(define value-color "schemevalue"))

6
scribble-lib/scribble/html-render.rkt
View File

@ -226,6 +226,7 @@
([class "searchbox"] ([class "searchbox"]
[style ,(sa "color: "dimcolor";")] [style ,(sa "color: "dimcolor";")]
[type "text"] [type "text"]
[tabindex "1"]
[value ,emptylabel] [value ,emptylabel]
[title "Enter a search string to search the manuals"] [title "Enter a search string to search the manuals"]
[onkeypress ,(format "return DoSearchKey(event, this, ~s, ~s);" [onkeypress ,(format "return DoSearchKey(event, this, ~s, ~s);"
@ -905,7 +906,9 @@
(head-extra-xexpr p))) (head-extra-xexpr p)))
(body ([id ,(or (extract-part-body-id d ri) (body ([id ,(or (extract-part-body-id d ri)
"scribble-racket-lang-org")]) "scribble-racket-lang-org")])
,@(render-toc-view d ri) ,@(if (part-style? d 'no-toc+aux)
null
(render-toc-view d ri))
(div ([class "maincolumn"]) (div ([class "maincolumn"])
(div ([class "main"]) (div ([class "main"])
,@(parameterize ([current-version (extract-version d)]) ,@(parameterize ([current-version (extract-version d)])
@ -1607,6 +1610,7 @@
(cond (cond
[(symbol? name) [(symbol? name)
(case name (case name
[(emph) '([class "emph"])]
[(italic) '([style "font-style: italic"])] [(italic) '([style "font-style: italic"])]
[(bold) '([style "font-weight: bold"])] [(bold) '([style "font-weight: bold"])]
[(tt) '([class "stt"])] [(tt) '([class "stt"])]

6
scribble-lib/scribble/latex-render.rkt
View File

@ -151,7 +151,9 @@
(install-file style-file)))) (install-file style-file))))
(when whole-doc? (when whole-doc?
(printf "\\begin{document}\n\\preDoc\n") (printf "\\begin{document}\n\\preDoc\n")
(when (part-title-content d) (when (and (part-title-content d)
(not (and (part-style? d 'hidden)
(equal? "" (content->string (part-title-content d))))))
(let ([vers (extract-version d)] (let ([vers (extract-version d)]
[date (extract-date d)] [date (extract-date d)]
[pres (extract-pretitle-content d)] [pres (extract-pretitle-content d)]
@ -166,7 +168,6 @@
(do-render-nested-flow pre d ri #t #f #t)])) (do-render-nested-flow pre d ri #t #f #t)]))
(when date (printf "\\date{~a}\n" date)) (when date (printf "\\date{~a}\n" date))
(printf "\\titleAnd~aVersionAnd~aAuthors~a{" (printf "\\titleAnd~aVersionAnd~aAuthors~a{"
(if (equal? vers "") "Empty" "") (if (equal? vers "") "Empty" "")
(if (null? auths) "Empty" "") (if (null? auths) "Empty" "")
(if short "AndShort" "")) (if short "AndShort" ""))
@ -471,6 +472,7 @@
(cond (cond
[(symbol? style-name) [(symbol? style-name)
(case style-name (case style-name
[(emph) (wrap e "emph" tt?)]
[(italic) (wrap e "textit" tt?)] [(italic) (wrap e "textit" tt?)]
[(bold) (wrap e "textbf" tt?)] [(bold) (wrap e "textbf" tt?)]
[(tt) (wrap e "Scribtexttt" #t)] [(tt) (wrap e "Scribtexttt" #t)]

148
scribble-lib/scribble/markdown-render.rkt
View File

@ -4,7 +4,10 @@
"private/render-utils.rkt" "private/render-utils.rkt"
racket/class racket/port racket/list racket/string racket/match racket/class racket/port racket/list racket/string racket/match
scribble/text/wrap) scribble/text/wrap)
(provide render-mixin) (provide render-mixin
current-markdown-link-sections)
(define current-markdown-link-sections (make-parameter #f))
(define current-indent (make-parameter 0)) (define current-indent (make-parameter 0))
(define (make-indent amt) (define (make-indent amt)
@ -17,6 +20,9 @@
(indent)) (indent))
(define note-depth (make-parameter 0)) (define note-depth (make-parameter 0))
(define in-toc (make-parameter #f))
(define markdown-part-tag 'markdown-section)
(define (render-mixin %) (define (render-mixin %)
(class % (class %
@ -37,6 +43,16 @@
format-number format-number
number-depth) number-depth)
(define/override (collect-part-tags d ci number)
(for ([t (part-tags d)])
(let ([t (generate-tag t ci)])
(collect-put! ci
t
(vector (or (part-title-content d) '("???"))
(add-current-tag-prefix t)
number
markdown-part-tag)))))
(define/override (render-part d ht) (define/override (render-part d ht)
(let ([number (collected-info-number (part-collected-info d ht))]) (let ([number (collected-info-number (part-collected-info d ht))])
(unless (part-style? d 'hidden) (unless (part-style? d 'hidden)
@ -153,25 +169,32 @@
(write-string (make-string (note-depth) #\>)) (write-string (make-string (note-depth) #\>))
(unless (zero? (note-depth)) (unless (zero? (note-depth))
(write-string " "))) (write-string " ")))
(define o (open-output-string)) (cond
(parameterize ([current-output-port o]) [(in-toc)
(super render-paragraph p part ri)) (write-note)
;; 1. Remove newlines so we can re-wrap the text. (super render-paragraph p part ri)
;; ;; two spaces at a line end creates a line break:
;; 2. Combine adjacent code spans into one. These result from (write-string " ")]
;; something like @racket[(x y)] being treated as multiple [else
;; RktXXX items rather than one. (Although it would be (define o (open-output-string))
;; more-correct to handle them at that level, I don't easily see (parameterize ([current-output-port o])
;; how. As a result I'm handling it after-the-fact, at the (super render-paragraph p part ri))
;; text/Markdown stage.) ;; 1. Remove newlines so we can re-wrap the text.
(define to-wrap (regexp-replaces (get-output-string o) ;;
'([#rx"\n" " "] ;1 ;; 2. Combine adjacent code spans into one. These result from
[#rx"``" ""]))) ;2 ;; something like @racket[(x y)] being treated as multiple
(define lines (wrap-line (string-trim to-wrap) (- 72 (current-indent)))) ;; RktXXX items rather than one. (Although it would be
(write-note) ;; more-correct to handle them at that level, I don't easily see
(write-string (car lines)) ;; how. As a result I'm handling it after-the-fact, at the
(for ([line (in-list (cdr lines))]) ;; text/Markdown stage.)
(newline) (indent) (write-note) (write-string line)) (define to-wrap (regexp-replaces (get-output-string o)
'([#rx"\n" " "] ;1
[#rx"``" ""]))) ;2
(define lines (wrap-line (string-trim to-wrap) (- 72 (current-indent))))
(write-note)
(write-string (car lines))
(for ([line (in-list (cdr lines))])
(newline) (indent) (write-note) (write-string line))])
(newline) (newline)
null) null)
@ -193,6 +216,9 @@
(define (italic? i) (define (italic? i)
(and (element? i) (eq? (element-style i) 'italic))) (and (element? i) (eq? (element-style i) 'italic)))
(define (emph? i)
(and (element? i) (eq? (element-style i) 'emph)))
(define (code? i) (define (code? i)
(and (element? i) (and (element? i)
(let ([s (element-style i)]) (let ([s (element-style i)])
@ -230,12 +256,18 @@
[(and (code? i) (not (in-code?))) [(and (code? i) (not (in-code?)))
(recurse-wrapped "`" in-code?)] (recurse-wrapped "`" in-code?)]
[(and (bold? i) (not (in-bold?))) [(and (bold? i) (not (in-bold?)) (not (in-code?)))
(recurse-wrapped "**" in-bold?)] (recurse-wrapped "**" in-bold?)]
[(and (italic? i) (not (in-italic?))) [(and (italic? i) (not (in-italic?)) (not (in-code?)))
(recurse-wrapped "_" in-italic?)] (recurse-wrapped "_" in-italic?)]
[(and (emph? i) (not (in-code?)))
(display "​_") ;; zero-width space, underscore
(begin0
(super render-content i part ri)
(display "_​"))] ;; underscore, zero-width space
[(and (preserve-spaces? i) (not (preserving-spaces?))) [(and (preserve-spaces? i) (not (preserving-spaces?)))
(parameterize ([preserving-spaces? #t]) (parameterize ([preserving-spaces? #t])
(render-content i part ri))] (render-content i part ri))]
@ -248,15 +280,45 @@
(render-content i part ri)) (render-content i part ri))
(printf "](~a)" (sanitize-parens link))))] (printf "](~a)" (sanitize-parens link))))]
[(and (link-element? i)
(current-markdown-link-sections)
(not (in-link?))
;; Link to a part within this document?
(let ([vec (resolve-get part ri (link-element-tag i))])
(and (vector? vec)
(= 4 (vector-length vec))
(eq? markdown-part-tag (vector-ref vec 3))
vec)))
=> (lambda (vec)
(define s (string-append
(let ([s (if (vector-ref vec 2)
(format-number (vector-ref vec 2) '() #t)
'())])
(if (null? s)
""
(string-append (car s) " ")))
(content->string (vector-ref vec 0))))
(display "[")
(begin0
(parameterize ([in-link? #t])
(super render-content i part ri))
(display "](#")
(display (regexp-replace* #" "
(regexp-replace* #rx"[^a-zA-Z0-9_ -]" (string-downcase s) "")
#"-"))
(display ")")))]
[else (super render-content i part ri)])) [else (super render-content i part ri)]))
(define/override (render-nested-flow i part ri starting-item?) (define/override (render-nested-flow i part ri starting-item?)
(define s (nested-flow-style i)) (define s (nested-flow-style i))
(unless (memq 'decorative (style-properties s)) (unless (memq 'decorative (style-properties s))
(define note? (equal? (style-name s) "refcontent")) (define note? (equal? (style-name s) "refcontent"))
(define toc? (equal? (style-name s) 'table-of-contents))
(when note? (when note?
(note-depth (add1 (note-depth)))) (note-depth (add1 (note-depth))))
(begin0 (super render-nested-flow i part ri starting-item?) (begin0 (parameterize ([in-toc (or toc? (in-toc))])
(super render-nested-flow i part ri starting-item?))
(when note? (when note?
(note-depth (sub1 (note-depth))))))) (note-depth (sub1 (note-depth)))))))
@ -270,8 +332,8 @@
[(rdquo) "\U201D"] [(rdquo) "\U201D"]
[(lsquo) "\U2018"] [(lsquo) "\U2018"]
[(rsquo) "\U2019"] [(rsquo) "\U2019"]
[(lang) ">"] [(lang) "<"]
[(rang) "<"] [(rang) ">"]
[(rarr) "->"] [(rarr) "->"]
[(nbsp) "\uA0"] [(nbsp) "\uA0"]
[(prime) "'"] [(prime) "'"]
@ -280,10 +342,17 @@
[else (error 'markdown-render "unknown element symbol: ~e" [else (error 'markdown-render "unknown element symbol: ~e"
i)]))] i)]))]
[(string? i) [(string? i)
(let* ([i (if (in-code?) (let* ([i (cond
(regexp-replace** i '([#rx"``" . "\U201C"] [(in-code?)
[#rx"''" . "\U201D"])) (regexp-replace** i '([#rx"``" . "\U201C"]
(regexp-replace* #px"([#_*`\\[\\(\\]\\)]{1})" i "\\\\\\1"))] [#rx"''" . "\U201D"]))]
[(or (in-link?)
(regexp-match? #rx"^[(]" i)
(regexp-match? #rx"[]][(]" i))
(regexp-replace* #px"([#_*`\\[\\(\\]\\)]{1})" i "\\\\\\1")]
[else
;; Avoid escaping parentheses
(regexp-replace* #px"([#_*`\\[\\]]{1})" i "\\\\\\1")])]
[i (if (preserving-spaces?) [i (if (preserving-spaces?)
(regexp-replace* #rx" " i "\uA0") (regexp-replace* #rx" " i "\uA0")
i)]) i)])
@ -291,6 +360,26 @@
[else (write i)]) [else (write i)])
null) null)
(define/override (table-of-contents part ri)
(define t (super table-of-contents part ri))
(cond
[(current-markdown-link-sections)
;; Table generated by `table-of-contents` always has one
;; column, and each row has one paragraph that starts
;; with a 'hspace element to indent
(nested-flow
(style 'table-of-contents null)
(for/list ([p (map car (table-blockss t))])
(define c (paragraph-content p))
(define keep-c (cdr c))
(define (spaces->depth n)
(add1 (quotient (- n 4) 2)))
(for/fold ([p (paragraph plain keep-c)]) ([s (in-range
(spaces->depth
(string-length (car (element-content (car c))))))])
(nested-flow (style "refcontent" null) (list p)))))]
[else t]))
(super-new))) (super-new)))
(define (regexp-replace** str ptns&reps) (define (regexp-replace** str ptns&reps)
@ -298,4 +387,3 @@
([ptn (map car ptns&reps)] ([ptn (map car ptns&reps)]
[rep (map cdr ptns&reps)]) [rep (map cdr ptns&reps)])
(regexp-replace* ptn str rep))) (regexp-replace* ptn str rep)))

7
scribble-lib/scribble/private/manual-style.rkt
View File

@ -4,7 +4,7 @@
"../base.rkt" "../base.rkt"
(only-in "../basic.rkt" aux-elem itemize) (only-in "../basic.rkt" aux-elem itemize)
"../scheme.rkt" "../scheme.rkt"
(only-in "../core.rkt" make-style plain (only-in "../core.rkt" content? make-style plain
make-nested-flow nested-flow? box-mode box-mode* make-nested-flow nested-flow? box-mode box-mode*
[element? core:element?]) [element? core:element?])
"manual-utils.rkt" "manual-utils.rkt"
@ -31,7 +31,7 @@
(provide-styling racketmodfont racketoutput (provide-styling racketmodfont racketoutput
racketerror racketfont racketplainfont racketvalfont racketidfont racketvarfont racketerror racketfont racketplainfont racketvalfont racketidfont racketvarfont
racketcommentfont racketparenfont racketkeywordfont racketmetafont racketcommentfont racketparenfont racketkeywordfont racketmetafont
onscreen defterm filepath exec envvar Flag DFlag PFlag DPFlag math onscreen defterm filepath envvar Flag DFlag PFlag DPFlag math
procedure procedure
indexed-file indexed-envvar idefterm pidefterm) indexed-file indexed-envvar idefterm pidefterm)
(provide (provide
@ -59,7 +59,8 @@
[inset-flow (() () #:rest (listof pre-content?) . ->* . nested-flow?)] [inset-flow (() () #:rest (listof pre-content?) . ->* . nested-flow?)]
[litchar (() () #:rest (listof string?) . ->* . element?)] [litchar (() () #:rest (listof string?) . ->* . element?)]
[t (() () #:rest (listof pre-content?) . ->* . paragraph?)] [t (() () #:rest (listof pre-content?) . ->* . paragraph?)]
[commandline (() () #:rest (listof pre-content?) . ->* . paragraph?)] [exec (() () #:rest (listof content?) . ->* . element?)]
[commandline (() () #:rest (listof content?) . ->* . paragraph?)]
[menuitem (string? string? . -> . element?)]) [menuitem (string? string? . -> . element?)])
(define PLaneT (make-element "planetName" '("PLaneT"))) (define PLaneT (make-element "planetName" '("PLaneT")))

2343
scribble-lib/scribble/racket.rkt
View File

File diff suppressed because it is too large Load Diff

2
scribble-lib/scribble/run.rkt
View File

@ -106,6 +106,8 @@
(current-style-file file)] (current-style-file file)]
[("--prefix") file "use given .html/.tex prefix (for doctype/documentclass)" [("--prefix") file "use given .html/.tex prefix (for doctype/documentclass)"
(current-prefix-file file)] (current-prefix-file file)]
[("--link-section") "support section links for markdown"
(markdown:current-markdown-link-sections #t)]
#:multi #:multi
[("++extra") file "add given file" [("++extra") file "add given file"
(current-extra-files (cons file (current-extra-files)))] (current-extra-files (cons file (current-extra-files)))]

20
scribble-lib/scribble/scribble.css
View File

@ -30,6 +30,26 @@
font-weight: bold; font-weight: bold;
} }
/* Emphasis: alternate italics and normal as we nest */
.emph {
font-style: italic;
}
.emph .emph {
font-style: normal;
}
.emph .emph .emph {
font-style: italic;
}
.emph .emph .emph .emph {
font-style: normal;
}
.emph .emph .emph .emph .emph {
font-style: italic;
}
.emph .emph .emph .emph .emph .emph {
font-style: normal;
}
/* ---------------------------------------- */ /* ---------------------------------------- */
p, .SIntrapara { p, .SIntrapara {

8
scribble-lib/scribble/scribble.tex
View File

@ -83,8 +83,8 @@
\newcommand{\textsuper}[1]{$^{\hbox{\textsmaller{#1}}}$} \newcommand{\textsuper}[1]{$^{\hbox{\textsmaller{#1}}}$}
\newcommand{\intextcolor}[2]{\textcolor{#1}{#2}} \newcommand{\intextcolor}[2]{\textcolor{#1}{#2}}
\newcommand{\intextrgbcolor}[2]{\textcolor[rgb]{#1}{#2}} \newcommand{\intextrgbcolor}[2]{\textcolor[rgb]{#1}{#2}}
\newcommand{\incolorbox}[2]{{\fboxrule=0pt\fboxsep=0pt\colorbox{#1}{#2}}} \newcommand{\incolorbox}[2]{{\fboxrule=0pt\fboxsep=0pt\protect\colorbox{#1}{#2}}}
\newcommand{\inrgbcolorbox}[2]{{\fboxrule=0pt\fboxsep=0pt\colorbox[rgb]{#1}{#2}}} \newcommand{\inrgbcolorbox}[2]{{\fboxrule=0pt\fboxsep=0pt\protect\colorbox[rgb]{#1}{#2}}}
\newcommand{\plainlink}[1]{#1} \newcommand{\plainlink}[1]{#1}
\newcommand{\techoutside}[1]{#1} \newcommand{\techoutside}[1]{#1}
\newcommand{\techinside}[1]{#1} \newcommand{\techinside}[1]{#1}
@ -112,7 +112,7 @@
\makeatletter \makeatletter
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\message{pltstabular is a modification of stabular} \message{pltstabular is a modification of stabular}
%% A renamed vsetion of: %% A renamed version of:
%% stabular.sty %% stabular.sty
%% Copyright 1998 Sigitas Tolu\v sis %% Copyright 1998 Sigitas Tolu\v sis
%% VTeX Ltd., Akademijos 4, Vilnius, Lithuania %% VTeX Ltd., Akademijos 4, Vilnius, Lithuania
@ -372,7 +372,7 @@
% For hidden parts with an empty title: % For hidden parts with an empty title:
\newcommand{\notitlesection}{\vspace{2ex}\phantomsection\noindent} \newcommand{\notitlesection}{\vspace{2ex}\phantomsection\noindent}
% To increments section numbers: % To increment section numbers:
\newcommand{\Sincpart}{\stepcounter{part}} \newcommand{\Sincpart}{\stepcounter{part}}
\newcommand{\Sincsection}{\stepcounter{section}} \newcommand{\Sincsection}{\stepcounter{section}}
\newcommand{\Sincsubsection}{\stepcounter{subsection}} \newcommand{\Sincsubsection}{\stepcounter{subsection}}

343
scribble-lib/scribble/search.rkt
View File

@ -1,142 +1,143 @@
(module search racket/base #lang racket/base
(require "struct.rkt"
"basic.rkt"
syntax/modcode)
(provide find-racket-tag (require "struct.rkt"
(rename-out [find-racket-tag find-scheme-tag])) "basic.rkt"
syntax/modcode)
(define module-info-cache (make-hasheq)) (provide find-racket-tag
(rename-out [find-racket-tag find-scheme-tag]))
(define (module-path-index-rejoin mpi rel-to) (define module-info-cache (make-hasheq))
(let-values ([(name base) (module-path-index-split mpi)])
(cond
[(not name) rel-to]
[(not base) mpi]
[else
(module-path-index-join name
(module-path-index-rejoin base rel-to))])))
(define (try thunk fail-thunk) (define (module-path-index-rejoin mpi rel-to)
(with-handlers* ([exn:fail? (lambda (exn) (fail-thunk))]) (let-values ([(name base) (module-path-index-split mpi)])
(thunk))) (cond
[(not name) rel-to]
[(not base) mpi]
[else
(module-path-index-join name
(module-path-index-rejoin base rel-to))])))
(define (find-racket-tag part ri stx/binding phase-level) (define (try thunk fail-thunk)
;; The phase-level argument is used only when `stx/binding' (with-handlers* ([exn:fail? (lambda (exn) (fail-thunk))])
;; is an identifier. (thunk)))
;;
;; Note: documentation keys currently don't distinguish different (define (find-racket-tag part ri stx/binding phase-level)
;; phase definitions of an identifier from a source module. ;; The phase-level argument is used only when `stx/binding'
;; That is, there's no way to document (define x ....) differently ;; is an identifier.
;; from (define-for-syntax x ...). This isn't a problem in practice, ;;
;; because no one uses the same name for different-phase exported ;; Note: documentation keys currently don't distinguish different
;; bindings. ;; phase definitions of an identifier from a source module.
;; ;; That is, there's no way to document (define x ....) differently
;; Formerly, we assumed that bindings are defined as originating from some ;; from (define-for-syntax x ...). This isn't a problem in practice,
;; module at phase 0. [Maybe it's defined at phase 1 and re-exported ;; because no one uses the same name for different-phase exported
;; later for phase 0 (after a require-for-template), in which case the ;; bindings.
;; re-exporting module is the one we find.] That assumption has been ;;
;; lifted, however; search for "GONE" below. ;; Formerly, we assumed that bindings are defined as originating from some
(let ([b (cond ;; module at phase 0. [Maybe it's defined at phase 1 and re-exported
[(identifier? stx/binding) ;; later for phase 0 (after a require-for-template), in which case the
(identifier-binding stx/binding phase-level)] ;; re-exporting module is the one we find.] That assumption has been
[(and (list? stx/binding) ;; lifted, however; search for "GONE" below.
(= 7 (length stx/binding))) (let ([b (cond
stx/binding] [(identifier? stx/binding)
[else (identifier-binding stx/binding phase-level)]
(and (not (symbol? (car stx/binding))) [(and (list? stx/binding)
(list #f (= 7 (length stx/binding)))
(cadr stx/binding) stx/binding]
(car stx/binding) [else
(cadr stx/binding) (and (not (symbol? (car stx/binding)))
(if (= 2 (length stx/binding)) (list #f
0 (cadr stx/binding)
(caddr stx/binding)) (car stx/binding)
(if (= 2 (length stx/binding)) (cadr stx/binding)
0 (if (= 2 (length stx/binding))
(cadddr stx/binding)) 0
(if (= 2 (length stx/binding)) (caddr stx/binding))
0 (if (= 2 (length stx/binding))
(cadddr (cdr stx/binding)))))])]) 0
(and (cadddr stx/binding))
(pair? b) (if (= 2 (length stx/binding))
(let ([seen (make-hash)] 0
[search-key #f]) (cadddr (cdr stx/binding)))))])])
(let loop ([queue (list (list (caddr b) (cadddr b) (list-ref b 4) (list-ref b 5) (list-ref b 6)))] (and
[rqueue null] (pair? b)
[need-result? #t]) (let ([seen (make-hash)]
(cond [search-key #f])
[(null? queue) (let loop ([queue (list (list (caddr b) (cadddr b) (list-ref b 4) (list-ref b 5) (list-ref b 6)))]
(if (null? rqueue) [rqueue null]
;; Not documented [need-result? #t])
#f (cond
(loop (reverse rqueue) null need-result?))] [(null? queue)
[else (if (null? rqueue)
(let ([mod (list-ref (car queue) 0)] ;; Not documented
[id (list-ref (car queue) 1)] #f
[defn-phase (list-ref (car queue) 2)] (loop (reverse rqueue) null need-result?))]
[import-phase (list-ref (car queue) 3)] [else
[export-phase (list-ref (car queue) 4)] (let ([mod (list-ref (car queue) 0)]
[queue (cdr queue)]) [id (list-ref (car queue) 1)]
(let* ([rmp (module-path-index-resolve mod)] [defn-phase (list-ref (car queue) 2)]
[eb (and ;; GONE: (equal? 0 export-phase) ;; look for the phase-0 export; good idea? [import-phase (list-ref (car queue) 3)]
(list (module-path-index->taglet mod) [export-phase (list-ref (car queue) 4)]
id))]) [queue (cdr queue)])
(when (and eb (let* ([rmp (module-path-index-resolve mod)]
(not search-key)) [eb (and ;; GONE: (equal? 0 export-phase) ;; look for the phase-0 export; good idea?
(set! search-key eb)) (list (module-path-index->taglet mod)
(let ([v (and eb (resolve-search search-key part ri `(dep ,eb)))]) id))])
(let* ([here-result (when (and eb
(and need-result? (not search-key))
v (set! search-key eb))
(let ([v (resolve-get/tentative part ri `(form ,eb))]) (let ([v (and eb (resolve-search search-key part ri `(dep ,eb)))])
(or (and v `(form ,eb)) (let* ([here-result
`(def ,eb))))] (and need-result?
[need-result? (and need-result? (not here-result))] v
[rmp-name (resolved-module-path-name rmp)]) (let ([v (resolve-get/tentative part ri `(form ,eb))])
;; Even if we've found `here-result', look deeper so that we have (or (and v `(form ,eb))
;; consistent `dep' results. `(def ,eb))))]
(let ([nest-result [need-result? (and need-result? (not here-result))]
;; Maybe it's re-exported from this module... [rmp-name (resolved-module-path-name rmp)])
;; Try a shortcut: ;; Even if we've found `here-result', look deeper so that we have
(if (eq? rmp (and (car b) (module-path-index-resolve (car b)))) ;; consistent `dep' results.
;; Not defined through this path, so keep looking (let ([nest-result
(loop queue rqueue need-result?) ;; Maybe it's re-exported from this module...
;; Check parents, if we can get the source: ;; Try a shortcut:
(if (and (or (path? rmp-name) (if (eq? rmp (and (car b) (module-path-index-resolve (car b))))
(and (list? rmp-name) ;; Not defined through this path, so keep looking
(path? (car rmp-name)))) (loop queue rqueue need-result?)
(not (hash-ref seen (cons export-phase rmp) #f))) ;; Check parents, if we can get the source:
(let ([exports (if (and (or (path? rmp-name)
(hash-ref (and (list? rmp-name)
module-info-cache (path? (car rmp-name))))
rmp (not (hash-ref seen (cons export-phase rmp) #f)))
(lambda () (let ([exports
(let-values ([(valss stxess) (hash-ref
(try module-info-cache
(lambda () rmp
;; First, try using bytecode: (lambda ()
(module-compiled-exports (let-values ([(valss stxess)
(get-module-code (if (list? rmp-name) (try
(car rmp-name) (lambda ()
rmp-name) ;; First, try using bytecode:
#:submodule-path (if (list? rmp-name) (module-compiled-exports
(cdr rmp-name) (get-module-code (if (list? rmp-name)
'()) (car rmp-name)
#:choose (lambda (src zo so) 'zo)))) rmp-name)
(lambda () #:submodule-path (if (list? rmp-name)
(try (cdr rmp-name)
(lambda () '())
;; Bytecode not available. Declaration in the #:choose (lambda (src zo so) 'zo))))
;; current namespace? (lambda ()
(module->exports rmp)) (try
(lambda () (lambda ()
(values null null)))))]) ;; Bytecode not available. Declaration in the
(let ([t ;; current namespace?
;; Merge the two association lists: (module->exports rmp))
(let loop ([base valss] (lambda ()
[stxess stxess]) (values null null)))))])
(cond (let ([t
;; Merge the two association lists:
(let loop ([base valss]
[stxess stxess])
(cond
[(null? stxess) base] [(null? stxess) base]
[(assoc (caar stxess) base) [(assoc (caar stxess) base)
=> (lambda (l) => (lambda (l)
@ -148,40 +149,40 @@
[else (loop (cons (car stxess) [else (loop (cons (car stxess)
base) base)
(cdr stxess))]))]) (cdr stxess))]))])
(hash-set! module-info-cache rmp t) (hash-set! module-info-cache rmp t)
t))))]) t))))])
(hash-set! seen (cons export-phase rmp) #t) (hash-set! seen (cons export-phase rmp) #t)
(let ([a (assq id (let ([a (assoc export-phase exports)]) (let ([a (assq id (let ([a (assoc export-phase exports)])
(if a (if a
(cdr a) (cdr a)
null)))]) null)))])
(if a (if a
(loop queue (loop queue
(append (map (lambda (m) (append (map (lambda (m)
(if (pair? m) (if (pair? m)
(list (module-path-index-rejoin (car m) mod) (list (module-path-index-rejoin (car m) mod)
(list-ref m 2) (list-ref m 2)
defn-phase defn-phase
(list-ref m 1) (list-ref m 1)
(list-ref m 3)) (list-ref m 3))
(list (module-path-index-rejoin m mod) (list (module-path-index-rejoin m mod)
id id
defn-phase defn-phase
import-phase import-phase
export-phase))) export-phase)))
(reverse (cadr a))) (reverse (cadr a)))
rqueue) rqueue)
need-result?) need-result?)
(begin (begin
;; A dead end may not be our fault: the files could ;; A dead end may not be our fault: the files could
;; have changed in inconsistent ways. So just say #f ;; have changed in inconsistent ways. So just say #f
;; for now. ;; for now.
#; #;
(error 'find-racket-tag (error 'find-racket-tag
"dead end when looking for binding source: ~e" "dead end when looking for binding source: ~e"
id) id)
(loop queue rqueue need-result?))))) (loop queue rqueue need-result?)))))
;; Can't get the module source, so continue with queue: ;; Can't get the module source, so continue with queue:
(loop queue rqueue need-result?)))]) (loop queue rqueue need-result?)))])
(or here-result (or here-result
nest-result))))))]))))))) nest-result))))))]))))))

2
scribble-lib/scriblib/autobib.rkt
View File

@ -621,7 +621,7 @@
(define (authors name . names*) (define (authors name . names*)
(define names (map parse-author (cons name names*))) (define names (map parse-author (cons name names*)))
(define slash-names (string-join (map author-element-names names) " / ")) (define slash-names (string-join (map (compose1 content->string author-element-names) names) " / "))
(define cite (define cite
(case (length names) (case (length names)
[(1) (author-element-cite (car names))] [(1) (author-element-cite (car names))]

11
scribble-test/LICENSE.txt
View File

@ -1,11 +0,0 @@
scribble-test
Copyright (c) 2010-2014 PLT Design Inc.
This package is distributed under the GNU Lesser General Public
License (LGPL). This means that you can link this package into proprietary
applications, provided you follow the rules stated in the LGPL. You
can also modify this package; if you distribute a modified version,
you must distribute it under the terms of the LGPL, which in
particular means that you must release the source code for the
modified software. See http://www.gnu.org/copyleft/lesser.html
for more information.

29
scribble-test/tests/scriblib/autobib.rkt
View File

@ -55,7 +55,6 @@
(check-equal? (book-location #:edition "4th") (check-equal? (book-location #:edition "4th")
(mk-bookloc-elem/ed "4th"))) (mk-bookloc-elem/ed "4th")))
(test-case "techrpt-location" (test-case "techrpt-location"
(check-not-exn (check-not-exn
(λ () (techrpt-location #:institution "MIT" #:number 'AIM-353))) (λ () (techrpt-location #:institution "MIT" #:number 'AIM-353)))
@ -71,3 +70,31 @@
(λ () (dissertation-location #:institution "Georgetown University" #:degree "BS"))) (λ () (dissertation-location #:institution "Georgetown University" #:degree "BS")))
(check-exn exn:fail:contract? (check-exn exn:fail:contract?
(λ () (dissertation-location #:degree "PhD")))) (λ () (dissertation-location #:degree "PhD"))))
(test-case "authors"
;; Define authors, make a bibliography
;; https://github.com/racket/scribble/issues/216
(check-not-exn
(lambda ()
(define-cite cite citet gen-bib)
(define x*
(map
cite
(list
(make-bib
#:title "Histoire d'une Montagne"
#:author (authors "Elisée Reclus"))
(make-bib
#:title "The Jeffersonians"
#:author (authors "Richard B. Morris" "James Leslie Woods"))
(make-bib
#:title "Lucifer Magazine"
#:author (authors "H.P. Blavatsky" (other-authors)))
(make-bib
#:title "Dean's Electronics"
#:author (authors (org-author-name "robco") (org-author-name (authors "industries"))
(editor "mister") (editor (authors "crowley"))
(other-authors))))))
(gen-bib))))

11
scribble-text-lib/LICENSE.txt
View File

@ -1,11 +0,0 @@
scribble-text-lib
Copyright (c) 2010-2014 PLT Design Inc.
This package is distributed under the GNU Lesser General Public
License (LGPL). This means that you can link this package into proprietary
applications, provided you follow the rules stated in the LGPL. You
can also modify this package; if you distribute a modified version,
you must distribute it under the terms of the LGPL, which in
particular means that you must release the source code for the
modified software. See http://www.gnu.org/copyleft/lesser.html
for more information.

11
scribble/LICENSE.txt
View File

@ -1,11 +0,0 @@
scribble
Copyright (c) 2010-2014 PLT Design Inc.
This package is distributed under the GNU Lesser General Public
License (LGPL). This means that you can link this package into proprietary
applications, provided you follow the rules stated in the LGPL. You
can also modify this package; if you distribute a modified version,
you must distribute it under the terms of the LGPL, which in
particular means that you must release the source code for the
modified software. See http://www.gnu.org/copyleft/lesser.html
for more information.