From 703e9e93087d32364087a0ebc9e315869b70ff7c Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sat, 15 Jun 2024 21:17:03 -0500 Subject: Update things --- lib/emit.scm | 96 +++++++++++++++++++++++++++++++++++++++++++----------------- lib/html.scm | 9 ++++-- lib/read.scm | 10 +++---- lib/util.scm | 29 ++++++++++++++---- 4 files changed, 103 insertions(+), 41 deletions(-) (limited to 'lib') diff --git a/lib/emit.scm b/lib/emit.scm index 2a8ab97..546ec5c 100644 --- a/lib/emit.scm +++ b/lib/emit.scm @@ -2,8 +2,10 @@ (import scheme (chicken base) (chicken format) + (chicken io) (chicken irregex) (chicken port) + (chicken process) (chicken string) (only utf8-srfi-13 string-join) (jimmy util)) @@ -15,9 +17,14 @@ (with-output-to-string (lambda () (emit doc)))) +;;; Change these for different output types + +(define-public output-type + (make-parameter 'gemini)) + (define-public formats (make-parameter - ;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT)) + ;; (EL (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT)) '((para (line . "~A") (stanza . "~A~%~%")) (verb (line . "~A~%") @@ -36,35 +43,60 @@ (hdr3 (line . "### ~A~%") (stanza . "~A~%"))))) +(define-public set-formats! formats) + (define-public filters (make-parameter - ;; (TYPE (line . LINE-FILTER) (stanza . STANZA-FILTER)) + ;; (EL (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 . ,join-lines)) + `((verb + (stanza . ,(o ensure-newline (cut string-join <> "\n")))) (default (line . ,identity) (stanza . ,flush-lines-left))))) +(define-public set-filters! filters) + +;;; Implementation + (define (format-line line el) (cond ((string? (car line)) ; regular stanza line - (sprintf* (get-format el 'line) - ((get-filter el 'line) line))) + (format/filter el 'line line)) ((symbol? (car line)) ; inline element - (sprintf* (get-format (car line) 'inline) - ((get-filter (car line) 'line) (cdr line)))) + (format/filter (car line) '(inline . line) (cdr line))) (else (error "Malformed line" line)))) (define (format-stanza stanza) - (let* ((type (car stanza)) - (data (cdr stanza)) + (let* ((el (caar stanza)) (text (map (lambda (ln) - (format-line ln type)) - data))) - (sprintf (get-format type 'stanza) - ((get-filter type 'stanza) text)))) + (format-line ln el)) + (cdr stanza)))) + (case el + ((verb) (format-verb stanza)) + (else + (format/filter el 'stanza text))))) + +(define (format-verb stanza) + (let ((el (car stanza)) + (text (apply append (cdr stanza)))) + (with-output-to-string + (lambda () + (cond + ((and (pair? (cdr el)) + (equal? (cadr el) "|")) + ;; special case: pipe to an external process + (let ((cmdline (cddr el))) + (if (find-command (car cmdline) #;) + (receive (in out pid) + (process (car cmdline) (cdr cmdline) + `(("JIMMY_OUTPUT" . ,(->string (output-type))))) + (display (ensure-newline text) out) + (read-string #f in))))) + (else ; verbatim baby + (printf (get-format 'verb 'stanza) + ((get-filter 'verb 'stanza) text)))))))) ;;; Utilities @@ -77,18 +109,28 @@ (define (get-format el scope) (or (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))) - (lis lis) - (out '())) - (cond - ((null? lis) - (apply sprintf fmt (reverse out))) - ((= 1 num) - (loop 0 '() (cons (string-join lis) out))) - (else - (loop (- num 1) - (cdr lis) - (cons (car lis) out)))))) +(define (format/filter el scope text) + (define (sprintf* fmt lis) + (let loop ((num (length (irregex-extract "~[aA]" fmt))) + (lis (if (list? lis) lis (list lis))) + (out '())) + (cond + ((null? lis) + (apply sprintf fmt (reverse out))) + ((= 1 num) + (loop 0 '() (cons (string-join lis) out))) + (else + (loop (- num 1) + (cdr lis) + (cons (car lis) out)))))) + + (define-values (format-scope filter-scope) + (if (pair? scope) + (values (car scope) (cdr scope)) + (values scope scope))) + + (sprintf* (get-format el format-scope) + ((get-filter el filter-scope) text))) diff --git a/lib/html.scm b/lib/html.scm index 07cd921..26cdff4 100644 --- a/lib/html.scm +++ b/lib/html.scm @@ -3,7 +3,10 @@ (import scheme (chicken base) (chicken irregex) (jimmy emit) - (jimmy util)) + (jimmy util) + utf8-srfi-13) + +(output-type 'html) (define (escape-entities s) (irregex-replace/all "[&<>]" s @@ -24,7 +27,7 @@ (char->tag "_" "i") (char->tag "`" "code")) s)) -(formats +(set-formats! '((para (line . "~a~%") (stanza . "

~% ~a

~%")) (verb (line . "~a~%") @@ -43,7 +46,7 @@ (hdr3 (line . "~a") (stanza . "

~a

~%")))) -(filters +(set-filters! `((verb (line . ,identity) (stanza . ,join-lines)) (link (line . ,(lambda (ln) diff --git a/lib/read.scm b/lib/read.scm index 1b611bb..f84b3a5 100644 --- a/lib/read.scm +++ b/lib/read.scm @@ -26,7 +26,7 @@ (def (cdr (assoc 'default line-types)))) (cond ((null? lin) def) ; empty line - ((assoc (car lin) line-types) => cdr) ; a line type exists + ((assoc (car lin) line-types) => cdr) ; a known line type (else def)))) ; otherwise ... (define (parse-lines lines doc) @@ -48,10 +48,8 @@ ;;;; FIXME: I think this necessitates a special emit-verbatim ;;;; function. (parse-verbatim (cdr lines) doc '() - #; (if (< 1 (length words)) - (cons 'verb (cdr words)) - 'verb) - 'verb)) + ;;; FIXME + (cons 'verb (cdr words)))) (else ; another line type (apply parse-stanza lines doc '() (line-type words))))))) @@ -67,7 +65,7 @@ (define (parse-stanza lines doc stanza st-type #!optional (st-inlines '()) (st-words cdr)) - (define (close-stanza) (cons (cons st-type (reverse stanza)) doc)) + (define (close-stanza) (cons (cons (list st-type) (reverse stanza)) doc)) (if (null? lines) ; end of document (parse-lines lines (close-stanza)) (let* ((ln (car lines)) diff --git a/lib/util.scm b/lib/util.scm index c71c600..f42878b 100644 --- a/lib/util.scm +++ b/lib/util.scm @@ -2,8 +2,12 @@ (import scheme (chicken base) (chicken condition) - (only (chicken irregex) irregex-replace/all) - (chicken string)) + (chicken file) + (chicken irregex) + (chicken process-context) + (chicken string) + (srfi 1) + utf8-srfi-13) (define-syntax define-public (syntax-rules () @@ -34,9 +38,6 @@ ((list? (cdr kv)) (apply alist-walk (cdr kv) (cdr keys))))))) - (define (string-join ss #!optional (sep " ")) - (string-intersperse ss sep)) - (define (flush-lines-left lines) (irregex-replace/all '(: bol (* space)) (string-join lines) "")) @@ -44,6 +45,24 @@ (define (join-lines lines) (apply string-append lines)) + (define (find-command command . dirs) + (define (find-command-in-dir dir) + (and (directory-exists? dir) + (find-files dir + limit: 0 + test: `(: (* any) "/" ,command eos)))) + (define path+ + (append (string-split (get-environment-variable "PATH") ":") dirs)) + (define found + (filter file-executable? + (apply append (filter-map find-command-in-dir path+)))) + (if (pair? found) (car found) #f)) + + (define (ensure-newline str) + (if (string-suffix? "\n" str) + str + (string-append str "\n"))) + ) -- cgit 1.4.1-21-gabe81