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

improve markdown renderer, including support for section links

Browse Source
This commit is contained in:
Matthew Flatt 2019-10-15 19:01:40 -06:00
parent e44a5bb9f1
commit 431bb95c7b
5 changed files with 120 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2201,7 +2201,7 @@ For HTML rendering:
@filepath{manual-style.css} from the @filepath{scribble}
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
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
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}

2
scribble-lib/info.rkt
View File

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

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

@ -4,7 +4,10 @@
"private/render-utils.rkt"
racket/class racket/port racket/list racket/string racket/match
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 (make-indent amt)
@ -17,6 +20,9 @@
(indent))
(define note-depth (make-parameter 0))
(define in-toc (make-parameter #f))
(define markdown-part-tag 'markdown-section)
(define (render-mixin %)
(class %
@ -37,6 +43,16 @@
format-number
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)
(let ([number (collected-info-number (part-collected-info d ht))])
(unless (part-style? d 'hidden)
@ -153,25 +169,32 @@
(write-string (make-string (note-depth) #\>))
(unless (zero? (note-depth))
(write-string " ")))
(define o (open-output-string))
(parameterize ([current-output-port o])
(super render-paragraph p part ri))
;; 1. Remove newlines so we can re-wrap the text.
;;
;; 2. Combine adjacent code spans into one. These result from
;; something like @racket[(x y)] being treated as multiple
;; RktXXX items rather than one. (Although it would be
;; more-correct to handle them at that level, I don't easily see
;; how. As a result I'm handling it after-the-fact, at the
;; text/Markdown stage.)
(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))
(cond
[(in-toc)
(write-note)
(super render-paragraph p part ri)
;; two spaces at a line end creates a line break:
(write-string " ")]
[else
(define o (open-output-string))
(parameterize ([current-output-port o])
(super render-paragraph p part ri))
;; 1. Remove newlines so we can re-wrap the text.
;;
;; 2. Combine adjacent code spans into one. These result from
;; something like @racket[(x y)] being treated as multiple
;; RktXXX items rather than one. (Although it would be
;; more-correct to handle them at that level, I don't easily see
;; how. As a result I'm handling it after-the-fact, at the
;; text/Markdown stage.)
(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)
null)
@ -230,10 +253,10 @@
[(and (code? i) (not (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?)]
[(and (italic? i) (not (in-italic?)))
[(and (italic? i) (not (in-italic?)) (not (in-code?)))
(recurse-wrapped "_" in-italic?)]
[(and (preserve-spaces? i) (not (preserving-spaces?)))
@ -248,15 +271,45 @@
(render-content i part ri))
(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)]))
(define/override (render-nested-flow i part ri starting-item?)
(define s (nested-flow-style i))
(unless (memq 'decorative (style-properties s))
(define note? (equal? (style-name s) "refcontent"))
(define toc? (equal? (style-name s) 'table-of-contents))
(when note?
(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?
(note-depth (sub1 (note-depth)))))))
@ -270,8 +323,8 @@
[(rdquo) "\U201D"]
[(lsquo) "\U2018"]
[(rsquo) "\U2019"]
[(lang) ">"]
[(rang) "<"]
[(lang) "<"]
[(rang) ">"]
[(rarr) "->"]
[(nbsp) "\uA0"]
[(prime) "'"]
@ -280,10 +333,17 @@
[else (error 'markdown-render "unknown element symbol: ~e"
i)]))]
[(string? i)
(let* ([i (if (in-code?)
(regexp-replace** i '([#rx"``" . "\U201C"]
[#rx"''" . "\U201D"]))
(regexp-replace* #px"([#_*`\\[\\(\\]\\)]{1})" i "\\\\\\1"))]
(let* ([i (cond
[(in-code?)
(regexp-replace** i '([#rx"``" . "\U201C"]
[#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?)
(regexp-replace* #rx" " i "\uA0")
i)])
@ -291,6 +351,26 @@
[else (write i)])
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)))
(define (regexp-replace** str ptns&reps)

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

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