improve markdown renderer, including support for section links

scribble-doc/scribblings/scribble/manual.scrbl

@@ -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].}
 

scribble-doc/scribblings/scribble/renderer.scrbl

@@ -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}

scribble-lib/info.rkt

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

scribble-lib/scribble/markdown-render.rkt

@@ -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,6 +169,13 @@
         (write-string (make-string (note-depth) #\>))
         (unless (zero? (note-depth))
           (write-string " ")))
+      (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))
@@ -171,7 +194,7 @@
          (write-note)
          (write-string (car lines))
          (for ([line (in-list (cdr lines))])
-        (newline) (indent) (write-note) (write-string line))
+           (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) ">"]
+                    [(lang) "<"]
-                    [(rang) "<"]
+                    [(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?)
+         (let* ([i (cond
+                     [(in-code?)
                       (regexp-replace** i '([#rx"``" . "\U201C"]
-                                             [#rx"''" . "\U201D"]))
+                                            [#rx"''" . "\U201D"]))]
-                       (regexp-replace* #px"([#_*`\\[\\(\\]\\)]{1})" i "\\\\\\1"))]
+                     [(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)

scribble-lib/scribble/run.rkt

@@ -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)))]