diff --git a/collects/scribble/markdown-render.rkt b/collects/scribble/markdown-render.rkt new file mode 100644 index 00000000..5886e613 --- /dev/null +++ b/collects/scribble/markdown-render.rkt @@ -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))) + diff --git a/collects/scribble/run.rkt b/collects/scribble/run.rkt index ed004a94..752004de 100644 --- a/collects/scribble/run.rkt +++ b/collects/scribble/run.rkt @@ -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 " (current-dest-directory dir)] diff --git a/collects/scribblings/scribble/renderer.scrbl b/collects/scribblings/scribble/renderer.scrbl index 4ac3fb28..bb2399f3 100644 --- a/collects/scribblings/scribble/renderer.scrbl +++ b/collects/scribblings/scribble/renderer.scrbl @@ -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]{ diff --git a/collects/scribblings/scribble/running.scrbl b/collects/scribblings/scribble/running.scrbl index ebec22b2..4cb92533 100644 --- a/collects/scribblings/scribble/running.scrbl +++ b/collects/scribblings/scribble/running.scrbl @@ -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, diff --git a/collects/tests/scribble/main.rkt b/collects/tests/scribble/main.rkt index 3fd1df3c..cb542ae1 100644 --- a/collects/tests/scribble/main.rkt +++ b/collects/tests/scribble/main.rkt @@ -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)) diff --git a/collects/tests/scribble/markdown-docs/example.md b/collects/tests/scribble/markdown-docs/example.md new file mode 100644 index 00000000..b613de0b --- /dev/null +++ b/collects/tests/scribble/markdown-docs/example.md @@ -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` diff --git a/collects/tests/scribble/markdown-docs/example.scrbl b/collects/tests/scribble/markdown-docs/example.scrbl new file mode 100644 index 00000000..0b27bb82 --- /dev/null +++ b/collects/tests/scribble/markdown-docs/example.scrbl @@ -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] + +} diff --git a/collects/tests/scribble/markdown.rkt b/collects/tests/scribble/markdown.rkt new file mode 100644 index 00000000..8cc7dd70 --- /dev/null +++ b/collects/tests/scribble/markdown.rkt @@ -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))))