Update things

10 files changed, 173 insertions, 127 deletions

@@ -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
@@ -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)
@@ -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
 
@@ -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))
 
@@ -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) #;<TODO:JIMMY_PATH>)
+                (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)))
@@ -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 . "<p>~% ~a</p>~%"))
     (verb (line . "~a~%")
@@ -43,7 +46,7 @@
     (hdr3 (line . "~a")
           (stanza . "<h3>~a</h3>~%"))))
 
-(filters
+(set-filters!
   `((verb (line . ,identity)
           (stanza . ,join-lines))
     (link (line . ,(lambda (ln)
@@ -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))
@@ -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")))
+
   )
 
 
@@ -2,8 +2,6 @@
 
 (import (chicken file))
 
-(for-each load (glob "build/*"))
-
 (import (jimmy util)
         (jimmy emit)
         (jimmy read)
@@ -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)