From 703e9e93087d32364087a0ebc9e315869b70ff7c Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sat, 15 Jun 2024 21:17:03 -0500 Subject: Update things --- .gitignore | 8 ++++- Makefile | 66 +++++++--------------------------------- README.gmi | 32 +++++++++++++++++--- bin/jimmy.scm | 2 +- lib/emit.scm | 96 ++++++++++++++++++++++++++++++++++++++++++----------------- lib/html.scm | 9 ++++-- lib/read.scm | 10 +++---- lib/util.scm | 29 ++++++++++++++---- repl.scm | 2 -- tests/run.scm | 46 ++++++++++++++-------------- 10 files changed, 173 insertions(+), 127 deletions(-) diff --git a/.gitignore b/.gitignore index d163863..1489dda 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,7 @@ -build/ \ No newline at end of file +*.build.sh +*.import.scm +*.install.sh +*.link +*.o +*.so +jimmy \ No newline at end of file diff --git a/Makefile b/Makefile index d2a1003..2e0612e 100644 --- a/Makefile +++ b/Makefile @@ -1,61 +1,17 @@ -# Automatically generated by scramble - NAME = jimmy -CSC = /usr/bin/csc -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 -BUILD = $(PWD)/build +CSI = csi -setup-mode -s TESTS = $(PWD)/tests -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 build/jimmy.main.so build/jimmy -test: all - cd $(BUILD) && $(TEST_ENV) $(TEST_ENV_EXTRA) $(CSI) -setup-mode -s $(TESTS)/run.scm $(NAME) +TEST_ENV = env BUILD=$(BUILD) TESTS=$(TESTS) TEST_USE_ANSI=0 +ARTEFACTS = *.build.sh *.install.sh *.import.scm *.so *.link *.o + +.PHONY: build test clean install uninstall +build: + chicken-install -n +test: build + $(TEST_ENV) $(CSI) $(TESTS)/run.scm $(NAME) clean: - -rm -rf $(BUILD) *.build.sh *.install.sh $(NAME) *.import.scm *.so *.link *.static.o + -rm -rf $(ARTEFACTS) $(NAME) install: chicken-install -s uninstall: - chicken-uninstall -s - -# jimmy - -build/jimmy.util.so: lib/util.scm - @mkdir -p $(BUILD) - $(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: lib/read.scm lib/util.scm - @mkdir -p $(BUILD) - $(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: lib/emit.scm lib/util.scm - @mkdir -p $(BUILD) - $(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: lib/html.scm lib/util.scm lib/emit.scm - @mkdir -p $(BUILD) - $(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: lib/wrap.scm lib/util.scm lib/emit.scm - @mkdir -p $(BUILD) - $(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 - + chicken-uninstall -s $(NAME) diff --git a/README.gmi b/README.gmi index a3e10fd..88dde93 100644 --- a/README.gmi +++ b/README.gmi @@ -38,12 +38,12 @@ offers a normalization function. tags do not stretch over source line breaks, and there is no check as to whether they're properly nested. -### Incompatible changes +### Incompatible changes (UNIMPLEMENTED) This section should be as short as possible, of course. They're incompatible in that a complying gemtext reader will interpret their meanings as different from -what jimmy text outputs. These changes are behind a flag (TODO!) and can be -disabled at run-time. +what jimmy text outputs. These changes are behind a flag and can be disabled at +run-time. * Lines beginning with two or more spaces are automatically joined with the previous line on output. @@ -52,6 +52,7 @@ disabled at run-time. Jimmy requires CHICKEN 5.3+ as well as the following eggs: +* args * module-declarations * utf8 @@ -59,7 +60,30 @@ To install, simply run `make install`. You can uninstall with `make uninstall`. ## Using jimmy -TODO +You can run jimmy on the command line as a filter or on a file. Run it like +this: + +``` +jimmy [OPTIONS...] [FILE] +``` + +FILE, if present, is the file to read; otherwise read standard input. + +The available options comprise + +* *-t, --to=FORMAT* --- Translate the input to FORMAT, one of `gemini`, `html`, + or a filename with format specifications in it (see OUTPUT FORMATS, below). +* *-n, --no-extensions* --- Don't enable any of the breaking extensions to + gemtext outlined above (NOT IMPLEMENTED) +* *-T, --template=TEMPLATE* --- Wrap the generated text in TEMPLATE using + metadata from the document (see TEMPLATES, below). +* -h, --help --- Show the help text and exit + +### Output Formats + + + +### Templates ## License diff --git a/bin/jimmy.scm b/bin/jimmy.scm index 17e12ba..07bad7a 100644 --- a/bin/jimmy.scm +++ b/bin/jimmy.scm @@ -23,7 +23,7 @@ (lambda () (print "Usage: " (car (argv)) " [OPTIONS...] [FILE]") (newline) - (print (args:usage options)) + (print (args:usage opts)) (print "Report bugs to acdw@acdw.net."))) (exit exit-code)) 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"))) + ) diff --git a/repl.scm b/repl.scm index 28c66b7..eb1c010 100644 --- a/repl.scm +++ b/repl.scm @@ -2,8 +2,6 @@ (import (chicken file)) -(for-each load (glob "build/*")) - (import (jimmy util) (jimmy emit) (jimmy read) diff --git a/tests/run.scm b/tests/run.scm index 49da815..cd5acba 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -21,29 +21,29 @@ (define test-file (make-pathname (list test-dir) "test" "gmi")) (define expected-doc - '((meta ("title" "a" "test" "document") - ("date" "2024-05-13T03:02:45Z") - ("uuid" "b3daebf1-440b-4828-a4d9-9089c7bd7c61")) - (hdr1 ("a" "test" "document" "of" "some" "kind")) - (para ("here" "is" "a" "test" "document.") - ("it" "has" "paragraphs") - (link "example.com" "with" "links!") - ("and" "other" "things.")) - (hdr2 ("a" "code" "example")) - (verb ("for (a=1;a<=4;a++) {") ("\tprintf(\"%d\\n\", a);") ("}")) - (hdr3 ("other" "examples")) - (quot ("a" "blockquote" "is" "a" "quote") ("that" "is" "blocky.")) - (list ("list" "1") ("list" "2") ("list" "3")) - (link ("example.com" "link" "list" "1") - ("example.com" "link" "list" "2") - ("example.com" "link" "list" "3")) - (para ("ok," "now" "for" "another" "test:") - ("will" "*strong*" "in-line" "text" "be" "converted?") - ("as" "well" "as" "`code`," "_emph_" "and" "such?") - ("what" "if" "*i" "_nest_" "them*") - ("what" "if" "*i" "_nest" "them*" "wrong_" "?") - ("what" "about" "*breaking" "them") - ("over" "two" "lines?*")))) + '(((meta) ("title" "a" "test" "document") + ("date" "2024-05-13T03:02:45Z") + ("uuid" "b3daebf1-440b-4828-a4d9-9089c7bd7c61")) + ((hdr1) ("a" "test" "document" "of" "some" "kind")) + ((para) ("here" "is" "a" "test" "document.") + ("it" "has" "paragraphs") + (link "example.com" "with" "links!") + ("and" "other" "things.")) + ((hdr2) ("a" "code" "example")) + ((verb) ("for (a=1;a<=4;a++) {") ("\tprintf(\"%d\\n\", a);") ("}")) + ((hdr3) ("other" "examples")) + ((quot) ("a" "blockquote" "is" "a" "quote") ("that" "is" "blocky.")) + ((list) ("list" "1") ("list" "2") ("list" "3")) + ((link) ("example.com" "link" "list" "1") + ("example.com" "link" "list" "2") + ("example.com" "link" "list" "3")) + ((para) ("ok," "now" "for" "another" "test:") + ("will" "*strong*" "in-line" "text" "be" "converted?") + ("as" "well" "as" "`code`," "_emph_" "and" "such?") + ("what" "if" "*i" "_nest_" "them*") + ("what" "if" "*i" "_nest" "them*" "wrong_" "?") + ("what" "about" "*breaking" "them") + ("over" "two" "lines?*")))) (define actual-doc (with-input-from-file test-file parse)) (test "read" expected-doc actual-doc) -- cgit 1.4.1-21-gabe81