From 423ac382f9e73bf1ca7fc6b400f98db087cd7d22 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 5 Jun 2024 09:21:25 -0500 Subject: Write executable This involved moving `src' to `lib' and making `bin'. `bin' holds the program, which only imports `jimmy.main' from lib. --- src/emit.scm | 89 ------------------------------------------------------------ src/html.scm | 61 ----------------------------------------- src/read.scm | 88 ----------------------------------------------------------- src/util.scm | 49 --------------------------------- src/wrap.scm | 23 ---------------- 5 files changed, 310 deletions(-) delete mode 100644 src/emit.scm delete mode 100644 src/html.scm delete mode 100644 src/read.scm delete mode 100644 src/util.scm delete mode 100644 src/wrap.scm (limited to 'src') diff --git a/src/emit.scm b/src/emit.scm deleted file mode 100644 index 4c3581f..0000000 --- a/src/emit.scm +++ /dev/null @@ -1,89 +0,0 @@ -(declare (module (jimmy emit))) - -(import scheme (chicken base) - (chicken format) - (chicken irregex) - (chicken string) - (only utf8-srfi-13 string-join) - (jimmy util)) - -(define-public (emit doc) - (for-each display (map format-stanza doc))) - -(define-public formats - (make-parameter - ;; (TYPE (line . LINE-FMT) (stanza . STANZA-FMT) (inline . INLINE-FMT)) - '((para (line . "~A") - (stanza . "~A~%~%")) - (verb (line . "~A~%") - (stanza . "```~%~A```~%~%")) - (link (line . "=> ~A ~A~%") ; Note: link has 2 format arguments - (stanza . "~A~%") - (inline . "~%=> ~A ~A~%")) - (list (line . "* ~A~%") - (stanza . "~A~%")) - (quot (line . "~A") - (stanza . "> ~A~%~%")) - (hdr1 (line . "# ~A~%") - (stanza . "~A~%")) - (hdr2 (line . "## ~A~%") - (stanza . "~A~%")) - (hdr3 (line . "### ~A~%") - (stanza . "~A~%"))))) - -(define-public filters - (make-parameter - ;; (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 . ,join-lines)) - (default - (line . ,identity) - (stanza . ,flush-lines-left))))) - -(define (format-line line el) - (cond - ((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-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) - (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)))))) diff --git a/src/html.scm b/src/html.scm deleted file mode 100644 index 07cd921..0000000 --- a/src/html.scm +++ /dev/null @@ -1,61 +0,0 @@ -(declare (module (jimmy html))) - -(import scheme (chicken base) - (chicken irregex) - (jimmy emit) - (jimmy util)) - -(define (escape-entities s) - (irregex-replace/all "[&<>]" s - (lambda (m) - (let ((c (irregex-match-substring m))) - (cond - ((equal? c "&") "&") - ((equal? c "<") "<") - ((equal? c ">") ">")))))) - -(define (add-inline-markup s) - (define (char->tag ch tag) - (lambda (s) - (irregex-replace/all `(: ,ch ($ (* (~ ,ch))) ,ch) s - "<" tag ">" 1 ""))) - - ((o (char->tag "*" "b") - (char->tag "_" "i") - (char->tag "`" "code")) s)) - -(formats - '((para (line . "~a~%") - (stanza . "

~% ~a

~%")) - (verb (line . "~a~%") - (stanza . "
~a
~%")) - (link (line . "
  • ~a
    • ~%") - (stanza . "~%") - (inline . "~a~%")) - (list (line . "
  • ~a
    • ~%") - (stanza . "~%")) - (quot (line . "~a~%") - (stanza . "
    ~% ~a
    ~%")) - (hdr1 (line . "~a") - (stanza . "

    ~a

    ~%")) - (hdr2 (line . "~a") - (stanza . "

    ~a

    ~%")) - (hdr3 (line . "~a") - (stanza . "

    ~a

    ~%")))) - -(filters - `((verb (line . ,identity) - (stanza . ,join-lines)) - (link (line . ,(lambda (ln) - (cons (car ln) - ((o list - add-inline-markup - escape-entities - string-join) - (cdr ln)))))) - (default - (line . ,(o list - add-inline-markup - escape-entities - string-join)) - (stanza . ,string-join)))) diff --git a/src/read.scm b/src/read.scm deleted file mode 100644 index 1b611bb..0000000 --- a/src/read.scm +++ /dev/null @@ -1,88 +0,0 @@ -(declare (module (jimmy read))) - -(import scheme (chicken base) - (jimmy util) - (only (chicken io) read-lines) - (only (chicken string) string-split)) - -(define-public line-types - ;; (sigil type inlines word-select) - `((default para (link) ,identity) ; if nothing else matches - ("```" verb) - ("=>" link) - (">" quot) - ("#" hdr1) - ("##" hdr2) - ("###" hdr3) - ("*" list) - ;; extra! - (":" meta))) - -(define-public (parse #!optional port) - (parse-lines (read-lines (or port (current-input-port))) '())) - -(define (line-type line) - (let ((lin (if (string? line) (string-split line) line)) - (def (cdr (assoc 'default line-types)))) - (cond - ((null? lin) def) ; empty line - ((assoc (car lin) line-types) => cdr) ; a line type exists - (else def)))) ; otherwise ... - -(define (parse-lines lines doc) - (if (null? lines) (reverse doc) - (let ((words (string-split (car lines)))) - (cond - ((null? words) ; empty line - (parse-lines (cdr lines) doc)) - ((equal? (car words) "```") ; verbatim - ;; Format for verbatim header: - ;; ``` ?html | command ... - ;; -- only run command on block with html output. - ;; other outputs process the block normally - ;; ``` ?!html | command ... - ;; -- only run command on block when *not* outputting html. - ;; html processes the block normally - ;; ``` ?:html | command ... - ;; -- like ?html, but ignore the block in non-html outputs. - ;;;; 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)) - (else ; another line type - (apply parse-stanza lines doc '() (line-type words))))))) - -(define (parse-verbatim lines doc block bhead) - (define (close-verbatim) (cons (cons bhead (reverse block)) doc)) - (cond - ((null? lines) ; end of document - (parse-lines lines (close-verbatim))) - ((equal? (car lines) "```") ; end of verbatim block - (parse-lines (cdr lines) (close-verbatim))) - (else ; verbatim block continues - (parse-verbatim (cdr lines) doc (cons (list (car lines)) block) bhead)))) - -(define (parse-stanza lines doc stanza st-type - #!optional (st-inlines '()) (st-words cdr)) - (define (close-stanza) (cons (cons st-type (reverse stanza)) doc)) - (if (null? lines) ; end of document - (parse-lines lines (close-stanza)) - (let* ((ln (car lines)) - (ws (string-split ln)) - (lt (line-type ln))) - (cond - ((null? ws) ; end of stanza (blank line) - (parse-lines (cdr lines) (close-stanza))) - ((memq (car lt) st-inlines) ; in-line for *this* stanza - (parse-stanza (cdr lines) doc - (cons (cons (car lt) (cdr ws)) stanza) - st-type st-inlines st-words)) - ((not (eq? st-type (car (line-type ws)))) ; beginning of a new stanza - (parse-lines lines (close-stanza))) - (else ; continue this stanza - (parse-stanza (cdr lines) doc - (cons (st-words ws) stanza) - st-type st-inlines st-words)))))) diff --git a/src/util.scm b/src/util.scm deleted file mode 100644 index c71c600..0000000 --- a/src/util.scm +++ /dev/null @@ -1,49 +0,0 @@ -(module (jimmy util) * - - (import scheme (chicken base) - (chicken condition) - (only (chicken irregex) irregex-replace/all) - (chicken string)) - - (define-syntax define-public - (syntax-rules () - ((define-public (name . arg) forms ...) - (begin (export name) - (define (name . arg) forms ...))) - ((define-public (name args ...) forms ...) - (begin (export name) - (define (name args ...) forms ...))) - ((define-public name value) - (begin (export name) - (define name value))))) - - (define-syntax ignore-errors - (syntax-rules () - ((ignore-errors x) - (handle-exceptions e #f x)))) - - (define (alist-walk lis . keys) - (if (null? keys) - lis - (let ((kv (assoc (car keys) lis))) - (cond - ((not kv) #f) - ((atom? (cdr kv)) - (and (null? (cdr keys)) ; this shouldn't error... - (cdr kv))) - ((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) "")) - - (define (join-lines lines) - (apply string-append lines)) - - ) - - diff --git a/src/wrap.scm b/src/wrap.scm deleted file mode 100644 index aa077d8..0000000 --- a/src/wrap.scm +++ /dev/null @@ -1,23 +0,0 @@ -(declare (module (jimmy wrap))) - -(import scheme (chicken base) - (jimmy emit) - (jimmy util) - (only (chicken io) read-string) - (only (chicken port) with-output-to-string) - (only (chicken string) string-translate* string-intersperse)) - -;; templates are strings with variables interpolated with "{{variables}}" - -(define-public (wrap document template) - (let* ((meta (map (lambda (el) - (cons (string-append "{{" (car el) "}}") - (string-intersperse (cdr el) " "))) - (alist-walk document 'meta))) - (body (cons "{{body}}" - (with-output-to-string - (lambda () (emit document)))))) - (string-translate* template (cons body meta)))) - -(define-public (wrap-with document file) - (wrap document (with-input-from-file file read-string))) -- cgit 1.4.1-21-gabe81