From 727995a409632d4c143ba4b6b088c7df40f074e7 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Sat, 18 May 2024 21:15:54 -0500
Subject: Scheme bit!
---
src/emit.scm | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 109 insertions(+)
create mode 100644 src/emit.scm
(limited to 'src/emit.scm')
diff --git a/src/emit.scm b/src/emit.scm
new file mode 100644
index 0000000..aa36eb5
--- /dev/null
+++ b/src/emit.scm
@@ -0,0 +1,109 @@
+(declare (module (jimmy emit)))
+
+(import scheme (chicken base)
+ (jimmy util)
+ (chicken format)
+ (chicken irregex)
+ (chicken string))
+
+(define-public (emit document)
+ (for-each display
+ (map format-block document)))
+
+(define-public formats
+ ;;; (type line-format block-format [line-in-block-format])
+ ;; these default to gemtext
+ '((para (line . "~A ")
+ (block . "~A~%~%"))
+ (verb (line . "~A~%")
+ (block . "```~%~A```~%~%"))
+ (link (line . "=> ~A ~A~%")
+ (block . "~A~%")
+ (inline . "~%=> ~A ~A~%")) ;TODO: have 2 args to format
+ (list (line . "* ~A~%")
+ (block . "~A~%"))
+ (quot (line . "~A ")
+ (block . "> ~A~%~%"))
+ (hdr1 (line . "# ~A~%")
+ (block . "~A~%"))
+ (hdr2 (line . "## ~A~%")
+ (block . "~A~%"))
+ (hdr3 (line . "### ~A~%")
+ (block . "~A~%"))
+ (default
+ (line . "~A")
+ (block . "~A~%~%"))))
+
+(define (string-join ss #!optional sep)
+ (if (string? ss) ss
+ (string-intersperse ss (or sep " "))))
+
+(define (char->tag char beg end)
+ (lambda (str)
+ (irregex-replace/all `(: ($ (or bos space))
+ ,char ($ (+ (~ ,char))) ,char
+ ($ (or space eos)))
+ str
+ 1 beg 2 end 3)))
+
+(define-public filters
+ `((para
+ (line . ,(o (char->tag "*" "" "")
+ (char->tag "_" "" "")
+ (char->tag "`" "" "
")
+ string-join))
+ (block . ,(lambda (ln)
+ (irregex-replace/all '(: bol (* " ")) ln ""))))
+ (link
+ (line . ,(lambda (ln)
+ (let ((ws (cond ((list? ln) ln)
+ ((string? ln) (string-split ln)))))
+ (list (car ws) (string-join (cdr ws)))))))
+ (default
+ (line . ,list)
+ (block . ,identity))))
+
+(define (get-from from type subtype)
+ (or (alist-walk from type subtype)
+ (if (eq? subtype 'inline)
+ (alist-walk from type 'list)
+ (lambda _ '("")))))
+
+(define (get-format type subtype) (get-from formats type subtype))
+(define (get-filter type subtype) (get-from filters type subtype))
+
+(define (format-line fmt line type)
+ (cond
+ ;; if LINE is a string, wrap it in a list
+ ((string? line)
+ (set! line (list line)))
+ ;; if it's a list of strings, join them together and filter them
+ ((and (list? line)
+ (string? (car line)))
+ (set! line ((get-filter type 'line) line)))
+ ;; if the car of LINE is a symbol, it's an inline thing.
+ ((and (list? line)
+ (symbol? (car line)))
+ (set! line (format-line (get-format (car line) 'inline)
+ ((get-filter (car line) 'line) (cdr line))
+ type)))
+ (else (error "Malformed line" line)))
+ (apply sprintf fmt line))
+
+(define (format-block block)
+ (if (assq (car block) formats)
+ (let* ((type (car block))
+ (data (cdr block))
+ (text (cond
+ ((string? data) data)
+ ((list? data)
+ (apply string-append
+ (map (lambda (ln)
+ (format-line (get-format type 'line)
+ ln
+ type))
+ data)))
+ (else (error "Malformed block" block)))))
+ (sprintf (get-format type 'block)
+ ((get-filter type 'block) text)))
+ ""))
--
cgit 1.4.1-21-gabe81