patch for strict markdown

quad/qtest/test-symbol.rkt

@@ -1,7 +1,5 @@
 #lang quadwriter/markdown
 
 ```
-excl-middl→¬¬-elim : ∀ {A : Set} → A ⊎ ¬ A → (¬ ¬ A → A)
+foo
-excl-middl→¬¬-elim (inj₁ a) = λ ¬¬a → a
-excl-middl→¬¬-elim (inj₂ ¬a) = λ ¬¬a → ⊥-elim (¬¬a ¬a)
 ```

quad/quadwriter/markdown.rkt

@@ -8,14 +8,6 @@
          #%app #%top #%datum #%top-interaction require
          (all-from-out "tags.rkt"))
 
-(define rsquo "’")
-(define rdquo "”")
-(define lsquo "‘")
-(define ldquo "“")
-(define hellip "…")
-(define ndash "–")
-(define mdash "—")
-
 (define (doc-proc exprs)
   (define strs (match exprs
                  [(? null?) '(" ")] ; single nonbreaking space, so something prints
@@ -32,8 +24,7 @@
 (module reader racket/base
   (require racket/port markdown "lang-helper.rkt")
   (provide read-syntax get-info)
-  (define read-syntax
+  (define read-syntax (make-read-syntax 'quadwriter/markdown
-    (make-read-syntax 'quadwriter/markdown
+                                        (λ (path-string p) (xexpr->parse-tree
-                      (λ (path-string p) (xexpr->parse-tree
+                                                            (parameterize ([current-strict-markdown? #t])
-                                          (parameterize ([current-strict-markdown? #true])
+                                                              (parse-markdown (port->string p))))))))
-                                            (parse-markdown (port->string p))))))))

quad/quadwriter/tags.rkt

@@ -16,22 +16,25 @@
   (qexpr attrs exprs))
 
 (define-tag-function (p attrs exprs)
-  ;; no font-family so that it adopts whatever the surrounding family is
+  (match exprs
-  (qexpr (append (list->attrs
+    [(cons (? txexpr? tx) _)
-                  :keep-first-lines "2"
+     #:when (equal? (attr-ref tx :font-family #false) "code")
-                  :keep-last-lines "3"
+     ;; wrap code blocks in `pre` to distinguish them from inline
-                  :font-size-adjust "100%"
+     (apply pre attrs exprs)]
-                  :hyphenate "true"
+    ;; no font-family so that it adopts whatever the surrounding family is
-                  :display (symbol->string (gensym)))
+    [_ (qexpr (append (list->attrs
-                 attrs) exprs))
+                       :keep-first-lines "2"
-
+                       :keep-last-lines "3"
-(define div p)
+                       :font-size-adjust "100%"
+                       :hyphenate "true"
+                       :display (symbol->string (gensym)))
+                      attrs) exprs)]))
 
 (define-tag-function (img attrs exprs)
   (qexpr (list->attrs
-                  :image-data (second (assq 'src attrs))
+          :image-data (second (assq 'src attrs))
-                  :image-alt (second (assq 'alt attrs))
+          :image-alt (second (assq 'alt attrs))
-                  :display (symbol->string (gensym))) exprs))
+          :display (symbol->string (gensym))) exprs))
 
 (define-tag-function (br attrs exprs) line-break)
 
@@ -86,6 +89,7 @@
           (list->attrs
            :font-italic "true"
            :font-size-adjust "100%") attrs) exprs))
+
 (define i em)
 
 (define-syntax-rule (attr-list . attrs) 'attrs)
@@ -124,7 +128,7 @@
   (define new-exprs (add-between
                      (for*/list ([expr (in-list exprs)]
                                  [str (in-list (string-split (string-join (get-elements expr) "") "\n"))])
-                       (list (get-tag expr) (get-attrs expr) (string-replace str " " " ")))
+                                (list (get-tag expr) (get-attrs expr) (string-replace str " " " ")))
                      line-break))
   (qexpr (append (list->attrs
                   :display "block"
@@ -152,7 +156,7 @@
          (add-between
           (for/list ([(expr idx) (in-indexed exprs)]
                      #:when (txexpr? expr))
-            (list* (get-tag expr) (cons (list :list-index (or bullet-val (format "~a" (add1 idx)))) (get-attrs expr)) (get-elements expr)))
+                    (list* (get-tag expr) (cons (list :list-index (or bullet-val (format "~a" (add1 idx)))) (get-attrs expr)) (get-elements expr)))
           para-break)))
 
 (define bullet-quad '(q ((special "bullet"))))