suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Add a Markdown rendering mode to Scribble.

Browse Source 
Uses "Github flavored markdown". Specifically, code blocks are opened
using ```scheme so that Github will lex and format them as Scheme code
rather than generic monospace.

Note: I would have used ```racket, but we are still waiting for the
pygments.rb project to pull again from pygments-main -- to which I
contributed a Racket lexer back in August. After pygments.rb pulls,
can update this to use ```racket instead.

original commit: 6aa6dc0400f4fed688e6f5b5278da2e34d82ad88
This commit is contained in:
Greg Hendershott 2012-12-05 21:47:19 -05:00 committed by Matthew Flatt
parent cd18c13bf9
commit 51d487bc1b
8 changed files with 402 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

225
collects/scribble/markdown-render.rkt Normal file
View File

@ -0,0 +1,225 @@
#lang racket/base
(require "core.rkt" "base-render.rkt"
racket/class racket/port racket/list racket/string
scribble/text/wrap)
(provide render-mixin)
(define current-preserve-spaces (make-parameter #f))
(define current-indent (make-parameter 0))
(define (make-indent amt)
(+ amt (current-indent)))
(define (indent)
(define i (current-indent))
(unless (zero? i) (display (make-string i #\space))))
(define (indented-newline)
(newline)
(indent))
(define table-ticks-depth (make-parameter 0))
(define phrase-ticks-depth (make-parameter 0))
(define (render-mixin %)
(class %
(define/override (current-render-mode)
'(markdown))
(define/override (get-suffix) #".md")
(define/override (get-substitutions)
'((#rx"---" "\U2014")
(#rx"--" "\U2013")
(#rx"``" "\U201C")
(#rx"''" "\U201D")
(#rx"'" "\U2019")))
(inherit render-block)
(define/override (render-part d ht)
(let ([number (collected-info-number (part-collected-info d ht))])
(printf (make-string (add1 (length number)) #\#))
(printf " ")
(for ([n (in-list (reverse number))] #:when n) (printf "~s." n))
(when (part-title-content d)
(when (ormap values number) (printf " "))
(render-content (part-title-content d) d ht))
(when (or (ormap values number) (part-title-content d))
(newline)
(newline))
(render-flow (part-blocks d) d ht #f)
(let loop ([pos 1]
[secs (part-parts d)]
[need-newline? (pair? (part-blocks d))])
(unless (null? secs)
(when need-newline? (newline))
(render-part (car secs) ht)
(loop (add1 pos) (cdr secs) #t)))))
(define/override (render-flow f part ht starting-item?)
(if (null? f)
null
(append*
(render-block (car f) part ht starting-item?)
(for/list ([p (in-list (cdr f))])
(indented-newline)
(render-block p part ht #f)))))
(define/override (render-intrapara-block p part ri first? last? starting-item?)
(unless first? (indented-newline))
(super render-intrapara-block p part ri first? last? starting-item?))
(define/override (render-table i part ht inline?)
(define flowss (table-blockss i))
(unless (null? flowss)
;; Set table-ticks-depth prior to render-block calls
(define tick? (member (style-name (table-style i))
(list 'boxed "defmodule" "RktBlk")))
(when tick?
(table-ticks-depth (add1 (table-ticks-depth))))
(define strs (map (lambda (flows)
(map (lambda (d)
(if (eq? d 'cont)
d
(let ([o (open-output-string)])
(parameterize ([current-indent 0]
[current-output-port o])
(render-block d part ht #f))
(regexp-split
#rx"\n"
(regexp-replace #rx"\n$"
(get-output-string o)
"")))))
flows))
flowss))
(define widths (map (lambda (col)
(for/fold ([d 0]) ([i (in-list col)])
(if (eq? i 'cont)
0
(apply max d (map string-length i)))))
(apply map list strs)))
(define x-length (lambda (col) (if (eq? col 'cont) 0 (length col))))
(when tick?
(displayln (string-append "```scheme")))
(for/fold ([indent? #f]) ([row (in-list strs)])
(let ([h (apply max 0 (map x-length row))])
(let ([row* (for/list ([i (in-range h)])
(for/list ([col (in-list row)])
(if (i . < . (x-length col))
(list-ref col i)
"")))])
(for/fold ([indent? indent?]) ([sub-row (in-list row*)])
(when indent? (indent))
(for/fold ([space? #f])
([col (in-list sub-row)]
[w (in-list widths)])
(let ([col (if (eq? col 'cont) "" col)])
(display (regexp-replace* #rx"\uA0" col " "))
(display (make-string (max 0 (- w (string-length col))) #\space)))
#t)
(newline)
#t)))
#t)
(when tick?
(displayln "```")
(table-ticks-depth (sub1 (table-ticks-depth)))))
null)
(define/override (render-itemization i part ht)
(let ([flows (itemization-blockss i)])
(if (null? flows)
null
(append*
(begin (printf "* ")
(parameterize ([current-indent (make-indent 2)])
(render-flow (car flows) part ht #t)))
(for/list ([d (in-list (cdr flows))])
(indented-newline)
(printf "* ")
(parameterize ([current-indent (make-indent 2)])
(render-flow d part ht #f)))))))
(define/override (render-paragraph p part ri)
(define o (open-output-string))
(parameterize ([current-output-port o])
(super render-paragraph p part ri))
(define to-wrap (regexp-replace* #rx"\n" (get-output-string o) " "))
(define lines (wrap-line (string-trim to-wrap) (- 72 (current-indent))))
(write-string (car lines))
(for ([line (in-list (cdr lines))])
(newline) (indent) (write-string line))
(newline)
null)
(define/override (render-content i part ri)
(define tick?
(and (zero? (table-ticks-depth))
(element? i)
(let ([s (element-style i)])
(or (eq? 'tt s)
(and (style? s)
(style-name s)
(regexp-match? #rx"^Rkt[A-Z]" (style-name s)))))))
(when tick?
(when (zero? (phrase-ticks-depth))
(display "`"))
(phrase-ticks-depth (add1 (phrase-ticks-depth))))
(begin0
(if (and (element? i)
(let ([s (element-style i)])
(or (eq? 'hspace s)
(and (style? s)
(eq? 'hspace (style-name s))))))
(parameterize ([current-preserve-spaces #t])
(super render-content i part ri))
(super render-content i part ri))
(when tick?
(phrase-ticks-depth (sub1 (phrase-ticks-depth)))
(when (zero? (phrase-ticks-depth))
(display "`")))))
(define/override (render-nested-flow i part ri starting-item?)
(define s (nested-flow-style i))
(unless (memq 'decorative (style-properties s))
(super render-nested-flow i part ri starting-item?)))
(define/override (render-other i part ht)
(cond
[(symbol? i)
(display (case i
[(mdash) "\U2014"]
[(ndash) "\U2013"]
[(ldquo) "\U201C"]
[(rdquo) "\U201D"]
[(lsquo) "\U2018"]
[(rsquo) "\U2019"]
[(lang) ">"]
[(rang) "<"]
[(rarr) "->"]
[(nbsp) "\uA0"]
[(prime) "'"]
[(alpha) "\u03B1"]
[(infin) "\u221E"]
[else (error 'markdown-render "unknown element symbol: ~e"
i)]))]
[(string? i)
(let* ([i (if (or (not (zero? (phrase-ticks-depth)))
(not (zero? (table-ticks-depth))))
(regexp-replace** i '([#rx"``" . "\U201C"]
[#rx"''" . "\U201D"]))
(regexp-replace* #px"([#_*`]{1})" i "\\\\\\1"))]
[i (if (current-preserve-spaces)
(regexp-replace* #rx" " i "\uA0")
i)])
(display i))]
[else (write i)])
null)
(super-new)))
(define (regexp-replace** str ptns&reps)
(for/fold ([str str])
([ptn (map car ptns&reps)]
[rep (map cdr ptns&reps)])
(regexp-replace* ptn str rep)))

11
collects/scribble/run.rkt
View File

@ -4,10 +4,11 @@
"render.rkt"
scheme/cmdline
raco/command-name
(prefix-in text: "text-render.rkt")
(prefix-in html: "html-render.rkt")
(prefix-in latex: "latex-render.rkt")
(prefix-in pdf: "pdf-render.rkt"))
(prefix-in text: "text-render.rkt")
(prefix-in markdown: "markdown-render.rkt")
(prefix-in html: "html-render.rkt")
(prefix-in latex: "latex-render.rkt")
(prefix-in pdf: "pdf-render.rkt"))
(define multi-html:render-mixin
(lambda (%) (html:render-multi-mixin (html:render-mixin %))))
@ -54,6 +55,8 @@
(current-render-mixin (latex:make-render-part-mixin v)))]
[("--text") "generate text-format output"
(current-render-mixin text:render-mixin)]
[("--markdown") "generate markdown-format output"
(current-render-mixin markdown:render-mixin)]
#:once-each
[("--dest") dir "write output in <dir>"
(current-dest-directory dir)]

16
collects/scribblings/scribble/renderer.scrbl
View File

@ -101,6 +101,7 @@ current error port.}
@racketmodname[scribble/base-render] module provides @racket[render%],
which implements the core of a renderer. This rendering class must be
refined with a mixin from @racketmodname[scribble/text-render],
@racketmodname[scribble/markdown-render], or
@racketmodname[scribble/html-render], or
@racketmodname[scribble/latex-render].}
@ -289,6 +290,21 @@ Specializes a @racket[render<%>] class for generating plain text.}}
@; ----------------------------------------
@section{Markdown Renderer}
@defmodule/local[scribble/markdown-render]{
@defmixin[render-mixin (render<%>) ()]{
Specializes a @racket[render<%>] class for generating Markdown text.
Code blocks are marked using the
@hyperlink["http://github.github.com/github-flavored-markdown/"
"Github convention"] @verbatim{```scheme} so that they are lexed and
formatted as Scheme code.}}
@; ----------------------------------------
@section{HTML Renderer}
@defmodule/local[scribble/html-render]{

3
collects/scribblings/scribble/running.scrbl
View File

@ -40,6 +40,9 @@ its file suffix:
@item{@DFlag{text} --- plain text in a single file
@filepath{@|fn|.txt}, with non-ASCII content encoded as UTF-8}
@item{@DFlag{markdown} --- Markdown text in a single file
@filepath{@|fn|.md}, with non-ASCII content encoded as UTF-8}
]
Use @DFlag{dest-name} to specify a @|fn| other than the default name,

5
collects/tests/scribble/main.rkt
View File

@ -2,7 +2,7 @@
(require tests/eli-tester
"reader.rkt" "text-collect.rkt" "text-lang.rkt" "text-wrap.rkt"
"docs.rkt" "render.rkt" "xref.rkt")
"docs.rkt" "render.rkt" "xref.rkt" "markdown.rkt")
(test do (reader-tests)
do (begin/collect-tests)
@ -10,4 +10,5 @@
do (wrap-tests)
do (docs-tests)
do (render-tests)
do (xref-tests))
do (xref-tests)
do (markdown-tests))

43
collects/tests/scribble/markdown-docs/example.md Normal file
View File

@ -0,0 +1,43 @@
# ```scheme
(require racket/string)
```
* Item 1.
* Item 2.
## 1. Section
Italic. \_Just underlines\_.
Bold. \*Just asterisks.\*
“Dobule quoted”. ‘Single quoted’.
`Hi, world.`
`A “quote”.`
`Second line.`
`Last line.`
The end.
`THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS`
`“AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT`
`LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR`
`A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT`
`HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,`
`SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT`
`LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,`
`DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY`
`THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT`
`(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE`
`OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.`
```scheme
(make-string k [char]) -> string?
k : exact-nonnegative-integer?
char : char? = #\nul
```
Returns a new mutable string of length `k` where each position in the
string is initialized with the character `char`

52
collects/tests/scribble/markdown-docs/example.scrbl Normal file
View File

@ -0,0 +1,52 @@
#lang scribble/doc
@(require scribble/manual
(for-label racket/base racket/contract racket/string))
@defmodule[racket/string]
@itemize[
@item{Item 1.}
@item{Item 2.}
]
@section{Section}
@italic{Italic}.
_Just underlines_.
@bold{Bold}.
*Just asterisks.*
``Dobule quoted''.
`Single quoted'.
@verbatim{
Hi, world.
A ``quote''.
Second line.
Last line.
}
The end.
@verbatim{
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
}
@defproc[(make-string [k exact-nonnegative-integer?][char char? #\nul]) string?]{
Returns a new mutable string of length @racket[k] where each position in the
string is initialized with the character @racket[char]
}

53
collects/tests/scribble/markdown.rkt Normal file
View File

@ -0,0 +1,53 @@
#lang racket/base
;; Use text renderer to check some Scribble functionality
(require scribble/base-render (prefix-in markdown: scribble/markdown-render)
racket/file racket/class racket/runtime-path tests/eli-tester)
(define-runtime-path source-dir "markdown-docs")
(define work-dir (build-path (find-system-path 'temp-dir)
"scribble-docs-tests"))
(define (build-markdown-doc src-file dest-file)
(let* ([renderer (new (markdown:render-mixin render%) [dest-dir work-dir])]
[docs (list (dynamic-require src-file 'doc))]
[fns (list (build-path work-dir dest-file))]
[fp (send renderer traverse docs fns)]
[info (send renderer collect docs fns fp)]
[r-info (send renderer resolve docs fns info)])
(send renderer render docs fns r-info)
(send renderer get-undefined r-info)))
(provide markdown-tests)
(module+ main (markdown-tests))
(define (markdown-tests)
(when (or (file-exists? work-dir) (directory-exists? work-dir))
(delete-directory/files work-dir))
(dynamic-wind
(λ() (make-directory work-dir))
(λ()
(define files (map path-element->string (directory-list source-dir)))
(test do
(for ([scrbl (in-list files)]
#:when (regexp-match? #rx"\\.scrbl$" scrbl)
[md (in-value (regexp-replace #rx"\\.scrbl$" scrbl ".md"))]
#:when (member md files))
;; (printf "Testing ~s -> ~s\n" scrbl md)
(define src-file (build-path source-dir scrbl))
(define expect-file (build-path source-dir md))
(define generated-file (build-path work-dir "gen.md"))
(define (contents file)
(regexp-replace #rx"\n+$" (file->string file) ""))
(define undefineds (build-markdown-doc src-file "gen.md"))
(for ([u (in-list undefineds)])
(when (eq? 'tech (car u))
(test #:failure-message
(format "undefined tech: ~e" u)
#f)))
(test #:failure-message
(format
"mismatch for: \"~a\", expected text in: \"~a\", got:\n~a"
scrbl md (contents generated-file))
(string=? (contents expect-file) (contents generated-file))))))
(λ() (delete-directory/files work-dir))))