cripslock

commit 6484345a0eec47265d1b056036510e152be343bb
parent 10d4b1d6689321f097ed132633ce06c4b8dd3227
Author: Daniel Barlow <dan@telent.net>
Date:   Tue,  5 Aug 2025 13:33:16 +0100

textile: recognise <pre> and don't process its innards

Diffstat:
M
tests/blog.textile
 | 
6
++++--
M
textile.fnl
 | 
75
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------------

2 files changed, 67 insertions(+), 14 deletions(-)
diff --git a/tests/blog.textile b/tests/blog.textile
@@ -9,7 +9,9 @@ This is the second para
 
 bq. this block is quoted
 
-pre.
+<pre>
 line one
-line 2
+-line 2-
+
 hello
+</pre>
diff --git a/textile.fnl b/textile.fnl
@@ -10,16 +10,64 @@
 (fn list-append [a1 a2]
   (icollect [_ v (ipairs a2) &into a1] v))
 
+(fn extract-blocks [doc]
+  (let [{ : P : C : Ct : V }  lpeg
+        eof (- (P 1))
+        p (P {
+              1 :doc
+              :doc (/ (^ (V :block) 1) #[$...])
+              :block (+ (V :pre) (V :para))
+
+              :pre (* (P "<pre>") (V :pre-body) (P "</pre>")
+                      (^ (P "\n") 0))
+              
+              :pre-body (/  (^ (- (P 1) (P "</pre>")) 1)
+                               #(.. "pre. " $1))
+
+
+              :para (* (/ (^ (- (P 1) (P "\n\n")) 1) #(.. $1 "\n"))
+                       (+ (^ (P "\n") 2) eof))
+              })]
+    (p:match doc)))
+
 (fn read-blocks [stream]
-  (fn []
-    (if (not (stream:read 0)) ; eof
-        nil
-        (let [lines (icollect [l #(stream:read "L")
-                               &until (or (not l) (= l "\n") (= l "\r\n"))]
-                      (do
-                        l))]
-          (table.concat lines "")))))
+  (let [co (coroutine.create
+            (fn []
+              (let [blocks (extract-blocks (stream:read "*a"))]
+                (each [_ b (ipairs blocks)]
+                  (coroutine.yield b)))))]
+    (fn []
+      (let [(code res) (coroutine.resume co)]
+        res))))
+
+(define-tests :extract-blocks
+  (with-open [f (io.open "tests/paras.txt" :r)]
+    (let [paras (extract-blocks (f:read "*a"))]
+      (expect= (# paras) 4)
+      (expect= (. paras 2) "this is\nalso a paragraph\n")))
+  (expect= (extract-blocks "a para
+
+<pre>
+some untouchable text
+
+that may contain double newlines
 
+lala
+la
+</pre>
+
+h1. heading")
+           ["a para\n"
+ "pre. 
+some untouchable text
+
+that may contain double newlines
+
+lala
+la
+"
+            "h1. heading\n"]
+           ))
 
 
 (define-tests :read-blocks
@@ -310,7 +358,9 @@ filesystem.  "])
 (fn parse-stream [stream]
   (icollect [p (read-blocks stream)]
     (let [(tag body) (tag-and-body p)]
-      (prepend tag (extract-lists body)))))
+      (if (= tag :pre)
+          [tag body]
+          (prepend tag (extract-lists body))))))
 
 
 (define-tests :parse-stream
@@ -322,8 +372,8 @@ filesystem.  "])
         (out:seek :set 0)
         (out:read "*a"))))
 
-  (expect= (convert "tests/hello.txt") "<p>hello world\n</p>")
-  (expect= (convert "tests/link.textile") "<p><a href=\"https://www.example.com\">example</a>\n</p>")
+  (expect= (convert "tests/hello.txt") "<p>hello world\n\n</p>")
+  (expect= (convert "tests/link.textile") "<p><a href=\"https://www.example.com\">example</a>\n\n</p>")
   (expect= (convert "tests/blog.textile")
            "<h1>header 1
 </h1><p>This is the first para
@@ -333,7 +383,8 @@ filesystem.  "])
 </p><blockquote>this block is quoted
 </blockquote><pre>
 line one
-line 2
+-line 2-
+
 hello
 </pre>")