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. --- Makefile | 44 +++++++++++++++++----------- bin/jimmy.scm | 48 ++++++++++++++++++++++++++++++ jimmy.egg | 25 ++++++++++++---- lib/emit.scm | 94 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ lib/html.scm | 61 ++++++++++++++++++++++++++++++++++++++ lib/main.scm | 19 ++++++++++++ lib/read.scm | 88 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ lib/util.scm | 49 +++++++++++++++++++++++++++++++ lib/wrap.scm | 21 +++++++++++++ src/emit.scm | 89 ------------------------------------------------------- src/html.scm | 61 -------------------------------------- src/read.scm | 88 ------------------------------------------------------- src/util.scm | 49 ------------------------------- src/wrap.scm | 23 --------------- 14 files changed, 426 insertions(+), 333 deletions(-) create mode 100644 bin/jimmy.scm create mode 100644 lib/emit.scm create mode 100644 lib/html.scm create mode 100644 lib/main.scm create mode 100644 lib/read.scm create mode 100644 lib/util.scm create mode 100644 lib/wrap.scm 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 diff --git a/Makefile b/Makefile index 8eead3a..d2a1003 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ NAME = jimmy CSC = /usr/bin/csc -CSC_OPTIONS = -setup-mode -host -I $(PWD) -C -I$(PWD) +CSC_OPTIONS = -setup-mode -host -I $(PWD) -C -I$(BUILD) CSC_LIB_OPTIONS = -D compiling-extension -emit-all-import-libraries -dynamic -regenerate-import-libraries CSC_OPTIONS_EXTRA = -X utf8 -X module-declarations CSI = /usr/bin/csi @@ -12,7 +12,7 @@ TEST_ENV = env BUILD=$(BUILD) TESTS=$(TESTS) TEST_ENV_EXTRA = TEST_USE_ANSI=0 .PHONY: all test clean install uninstall -all: build/jimmy.util.so build/jimmy.read.so build/jimmy.emit.so build/jimmy.html.so build/jimmy.wrap.so +all: build/jimmy.util.so build/jimmy.read.so build/jimmy.emit.so build/jimmy.html.so build/jimmy.wrap.so build/jimmy.main.so build/jimmy test: all cd $(BUILD) && $(TEST_ENV) $(TEST_ENV_EXTRA) $(CSI) -setup-mode -s $(TESTS)/run.scm $(NAME) clean: @@ -24,28 +24,38 @@ uninstall: # jimmy -build/jimmy.util.so: src/util.scm +build/jimmy.util.so: lib/util.scm @mkdir -p $(BUILD) - cd $(BUILD) && \ - $(CSC) $(CSC_OPTIONS) $(CSC_LIB_OPTIONS) $(CSC_OPTIONS_EXTRA) ../$< -o $(@F) + $(CSC) $(CSC_OPTIONS) $(CSC_LIB_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@ @test -f jimmy.util.import.scm &&mv jimmy.util.import.scm $(BUILD)/||true -build/jimmy.read.so: src/read.scm src/util.scm + +build/jimmy.read.so: lib/read.scm lib/util.scm @mkdir -p $(BUILD) - cd $(BUILD) && \ - $(CSC) $(CSC_OPTIONS) $(CSC_LIB_OPTIONS) $(CSC_OPTIONS_EXTRA) ../$< -o $(@F) + $(CSC) $(CSC_OPTIONS) $(CSC_LIB_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@ @test -f jimmy.read.import.scm &&mv jimmy.read.import.scm $(BUILD)/||true -build/jimmy.emit.so: src/emit.scm src/util.scm + +build/jimmy.emit.so: lib/emit.scm lib/util.scm @mkdir -p $(BUILD) - cd $(BUILD) && \ - $(CSC) $(CSC_OPTIONS) $(CSC_LIB_OPTIONS) $(CSC_OPTIONS_EXTRA) ../$< -o $(@F) + $(CSC) $(CSC_OPTIONS) $(CSC_LIB_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@ @test -f jimmy.emit.import.scm &&mv jimmy.emit.import.scm $(BUILD)/||true -build/jimmy.html.so: src/html.scm src/util.scm src/emit.scm + +build/jimmy.html.so: lib/html.scm lib/util.scm lib/emit.scm @mkdir -p $(BUILD) - cd $(BUILD) && \ - $(CSC) $(CSC_OPTIONS) $(CSC_LIB_OPTIONS) $(CSC_OPTIONS_EXTRA) ../$< -o $(@F) + $(CSC) $(CSC_OPTIONS) $(CSC_LIB_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@ @test -f jimmy.html.import.scm &&mv jimmy.html.import.scm $(BUILD)/||true -build/jimmy.wrap.so: src/wrap.scm src/util.scm src/emit.scm + +build/jimmy.wrap.so: lib/wrap.scm lib/util.scm lib/emit.scm @mkdir -p $(BUILD) - cd $(BUILD) && \ - $(CSC) $(CSC_OPTIONS) $(CSC_LIB_OPTIONS) $(CSC_OPTIONS_EXTRA) ../$< -o $(@F) + $(CSC) $(CSC_OPTIONS) $(CSC_LIB_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@ @test -f jimmy.wrap.import.scm &&mv jimmy.wrap.import.scm $(BUILD)/||true + +build/jimmy.main.so: lib/main.scm lib/util.scm lib/emit.scm lib/read.scm lib/wrap.scm + @mkdir -p $(BUILD) + $(CSC) $(CSC_OPTIONS) $(CSC_LIB_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@ + @test -f jimmy.main.import.scm &&mv jimmy.main.import.scm $(BUILD)/||true + +build/jimmy: bin/jimmy.scm lib/main.scm + @mkdir -p $(BUILD) + $(CSC) $(CSC_OPTIONS) $(CSC_OPTIONS_EXTRA) $< -o $@ + @test -f jimmy.import.scm &&mv jimmy.import.scm $(BUILD)/||true + diff --git a/bin/jimmy.scm b/bin/jimmy.scm new file mode 100644 index 0000000..17e12ba --- /dev/null +++ b/bin/jimmy.scm @@ -0,0 +1,48 @@ +;;; (jimmy main) --- the program + +(import (chicken file) + (chicken port) + (chicken process-context) + (jimmy main) + args) + +(define opts + (list (args:make-option (t to) (required: "FORMAT") + (string-append "Translate input to FORMAT." + " One of `gemini', `html', or" + " a filename.")) + (args:make-option (n no-extensions) #:none + "Don't use gemtext extensions.") + (args:make-option (T template) (required: "TEMPLATE") + "Wrap the generated text in TEMPLATE.") + (args:make-option (h help) #:none "Display this text" + (usage 0)))) + +(define (usage #!optional (exit-code 1)) + (with-output-to-port (current-error-port) + (lambda () + (print "Usage: " (car (argv)) " [OPTIONS...] [FILE]") + (newline) + (print (args:usage options)) + (print "Report bugs to acdw@acdw.net."))) + (exit exit-code)) + +(define (main args) + (receive (options operands) (args:parse args opts) + (let ((to (alist-ref 'to options)) + (template (alist-ref 'template options))) + + (cond + ((not to)) ; default: gemini + ((equal? to "html") + (import (jimmy html))) + ((file-exists? to) + (load to)) + (else (error "File does not exist" to))) + + (print (apply jimmy (list (car operands) template)))))) + +(cond-expand + (compiling + (main (command-line-arguments))) + (else)) diff --git a/jimmy.egg b/jimmy.egg index 84bf83c..be5b680 100644 --- a/jimmy.egg +++ b/jimmy.egg @@ -2,6 +2,7 @@ (synopsis "The ssg king") (license "BSD-3-clause") (dependencies (chicken "5.3.0") + args ; for (jimmy main) module-declarations utf8) (test-dependencies test) @@ -10,22 +11,34 @@ (components ;; Utility library (extension jimmy.util - (source src/util.scm)) + (source lib/util.scm)) ;; Read gemini files into internal format (extension jimmy.read - (source src/read.scm) + (source lib/read.scm) (component-dependencies jimmy.util)) ;; Emit the output format (includes gemini) (extension jimmy.emit - (source src/emit.scm) + (source lib/emit.scm) (component-dependencies jimmy.util)) ;; Emit HTML -- import this *after* emit (is this the best way?) (extension jimmy.html - (source src/html.scm) + (source lib/html.scm) (component-dependencies jimmy.util jimmy.emit)) ;; Wrap output in templates (extension jimmy.wrap - (source src/wrap.scm) + (source lib/wrap.scm) (component-dependencies jimmy.util - jimmy.emit)))) + jimmy.emit)) + ;; Main entry point (for command line) + (extension jimmy.main + (source lib/main.scm) + (component-dependencies jimmy.util + jimmy.emit + jimmy.read + jimmy.wrap)) + ;; Command-line program + (program jimmy + (csc-options -static) + (source bin/jimmy.scm) + (component-dependencies jimmy.main)))) diff --git a/lib/emit.scm b/lib/emit.scm new file mode 100644 index 0000000..2a8ab97 --- /dev/null +++ b/lib/emit.scm @@ -0,0 +1,94 @@ +(declare (module (jimmy emit))) + +(import scheme (chicken base) + (chicken format) + (chicken irregex) + (chicken port) + (chicken string) + (only utf8-srfi-13 string-join) + (jimmy util)) + +(define-public (emit doc) + (for-each display (map format-stanza doc))) + +(define-public (emit-string doc) + (with-output-to-string + (lambda () (emit 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/lib/html.scm b/lib/html.scm new file mode 100644 index 0000000..07cd921 --- /dev/null +++ b/lib/html.scm @@ -0,0 +1,61 @@ +(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/lib/main.scm b/lib/main.scm new file mode 100644 index 0000000..b97d66a --- /dev/null +++ b/lib/main.scm @@ -0,0 +1,19 @@ +(declare (module (jimmy main))) + +(import scheme (chicken base) + (chicken port) + (jimmy util) + (jimmy read) + (jimmy emit) + (jimmy wrap)) + +(define-public (jimmy #!optional file template) + (parameterize ((current-input-port + (if file + (open-input-file file) + (current-input-port)))) + (let ((doc (parse)) + (post-proc (if template + (cut wrap-with <> template) + emit-string))) + (post-proc doc)))) diff --git a/lib/read.scm b/lib/read.scm new file mode 100644 index 0000000..1b611bb --- /dev/null +++ b/lib/read.scm @@ -0,0 +1,88 @@ +(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/lib/util.scm b/lib/util.scm new file mode 100644 index 0000000..c71c600 --- /dev/null +++ b/lib/util.scm @@ -0,0 +1,49 @@ +(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/lib/wrap.scm b/lib/wrap.scm new file mode 100644 index 0000000..f801029 --- /dev/null +++ b/lib/wrap.scm @@ -0,0 +1,21 @@ +(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}}" (emit-string document)))) + (string-translate* template (cons body meta)))) + +(define-public (wrap-with document file) + (wrap document (with-input-from-file file read-string))) 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