From ddc2a19b6591dc254462d44aefa37bc25aaaf9bb Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 27 May 2024 00:01:46 -0500 Subject: Fix emit and read, add imports, fix makefile --- src/emit.scm | 140 +++++++++++++++++++++++------------------------------------ src/read.scm | 2 +- src/util.scm | 6 ++- 3 files changed, 59 insertions(+), 89 deletions(-) (limited to 'src') diff --git a/src/emit.scm b/src/emit.scm index d6fe19e..e57e437 100644 --- a/src/emit.scm +++ b/src/emit.scm @@ -1,111 +1,79 @@ -(declare (module (jimmy emit))) - (import scheme (chicken base) - (jimmy util) (chicken format) (chicken irregex) - (chicken string)) + (chicken string) + (only utf8-srfi-13 string-join) + (jimmy util)) -(define-public (emit document) - (for-each display - (map format-block document))) +(define-public (emit doc) + (for-each display (map format-stanza doc))) (define-public formats - ;;; (type line-format block-format [line-in-block-format]) - ;; these default to gemtext - '((para (line . "~A ") - (block . "~A~%~%")) + ;;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT)) + '((para (line . "~A") + (stanza . "~A~%~%")) (verb (line . "~A~%") - (block . "```~%~A```~%~%")) - (link (line . "=> ~A ~A~%") - (block . "~A~%") - (inline . "~%=> ~A ~A~%")) ;TODO: have 2 args to format + (stanza . "```~%~A```~%~%")) + (link (line . "=> ~A ~A~%") ; Note: link has 2 format arguments + (stanza . "~A~%") + (inline . "~%=> ~A ~A~%")) (list (line . "* ~A~%") - (block . "~A~%")) - (quot (line . "~A ") - (block . "> ~A~%~%")) + (stanza . "~A~%")) + (quot (line . "~A") + (stanza . "> ~A~%~%")) (hdr1 (line . "# ~A~%") - (block . "~A~%")) + (stanza . "~A~%")) (hdr2 (line . "## ~A~%") - (block . "~A~%")) + (stanza . "~A~%")) (hdr3 (line . "### ~A~%") - (block . "~A~%")) + (stanza . "~A~%")) + (meta (line . "") + (stanza . "")) (default (line . "~A") - (block . "~A~%~%")))) + (stanza . "~A~%~%")))) (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))))) - (let ((x (list (car ws) (string-join (cdr ws))))) - x))))) + ;;; (TYPE (line . LINE-FILTER) (stanza . STANZA-FILTER)) + ;; line-filter : (lambda (list-of-strs) ...) -> list-of-strs (for format) + ;; stanza-filter : (lambda (list-of-strs) ...) -> str + `((verb (line . ,identity) + (stanza . ,(lambda (lines) (apply string-append lines)))) (default - (line . ,(lambda (x) (print x) (if (list? x) x (list x)))) - (block . ,identity)))) - -(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 (get-from from type subtype) - (or (alist-walk from type subtype) - (get-from from 'default subtype))) + (line . ,identity) + (stanza . ,(lambda (lines) + (irregex-replace/all '(: bol (* space)) + (string-join lines) "")))))) -(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) +(define (format-line line el) (cond - ;; if LINE is a string, wrap it in a list - ((string? line) - (sprintf (get-format type 'line) - ((get-filter type 'line) line))) - ;; if it's a list of strings, join them together and filter them - ((and (list? line) - (string? (car line))) - (sprintf (get-format type 'line) - (apply string-append ((get-filter type 'line) line)))) - ;; if the car of LINE is a symbol, it's an inline thing. - ((and (list? line) - (symbol? (car line))) + ((string? (car line)) ; regular stanza line + (sprintf* (get-format el 'line) + ((get-filter el 'line) line))) + ((symbol? (car line)) ; inline element (sprintf* (get-format (car line) 'inline) ((get-filter (car line) 'line) (cdr line)))) (else (error "Malformed line" 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))) - "")) +(define (format-stanza stanza) + (let* ((type (car stanza)) + (data (cdr stanza)) + (text (map (lambda (ln) + (format-line ln type)) + data))) + (sprintf (get-format type 'stanza) + ((get-filter type 'stanza) text)))) + +;;; Utilities + +(define (get-from alist el scope) + (or (alist-walk alist el scope) + (alist-walk alist 'default scope) + (and (eq? scope 'inline) + (alist-walk alist 'default 'line)))) + +(define (get-format el scope) (get-from formats el scope)) +(define (get-filter el scope) (get-from filters el scope)) (define (sprintf* fmt lis) (let loop ((num (length (irregex-extract "~[aA]" fmt))) diff --git a/src/read.scm b/src/read.scm index 5e655a7..94708ef 100644 --- a/src/read.scm +++ b/src/read.scm @@ -48,7 +48,7 @@ ((equal? (car lines) "```") ; end of verbatim block (parse-lines (cdr lines) (close-verbatim))) (else ; verbatim block continues - (parse-verbatim (cdr lines) doc (cons (car lines) block))))) + (parse-verbatim (cdr lines) doc (cons (list (car lines)) block))))) (define (parse-stanza lines doc stanza st-type #!optional (st-inlines '()) (st-words cdr)) diff --git a/src/util.scm b/src/util.scm index 7bf89ac..41da769 100644 --- a/src/util.scm +++ b/src/util.scm @@ -1,7 +1,8 @@ (module (jimmy util) * (import scheme (chicken base) - (chicken condition)) + (chicken condition) + (chicken string)) (define-syntax define-public (syntax-rules () @@ -32,6 +33,7 @@ ((list? (cdr kv)) (apply alist-walk (cdr kv) (cdr keys))))))) - ) + (define (string-join ss #!optional (sep " ")) + (string-intersperse ss sep))) -- cgit 1.4.1-21-gabe81