From 84b6d6c6a7e55a606373607c054906f95d0f4ad3 Mon Sep 17 00:00:00 2001 From: Duncan Wilkie Date: Mon, 18 Sep 2023 08:33:40 -0500 Subject: Emacs Lisp -> Scheme transpiler, implementing forms.el logic. --- dnw/forms.scm | 207 +++++++++++++++++++++++++++++++++++++++++++++++++++ dnw/static-pages.scm | 18 ++++- dnw/theme.scm | 2 +- 3 files changed, 222 insertions(+), 5 deletions(-) create mode 100644 dnw/forms.scm (limited to 'dnw') diff --git a/dnw/forms.scm b/dnw/forms.scm new file mode 100644 index 0000000..c163267 --- /dev/null +++ b/dnw/forms.scm @@ -0,0 +1,207 @@ +(define-module (dnw forms) + #:use-module (ice-9 peg) + #:use-module (ice-9 textual-ports) + #:use-module (ice-9 match) + #:use-module (ice-9 string-fun) + #:use-module (srfi srfi-1) + #:export (forms.el->sxml)) + + + +;; Idea: function that takes in a git repository link pointing to something containing a forms file pair, +;; and reads it in along with a mapping between whatever Elisp functions you use in forms-format-list +;; and equivalent Scheme implementations (bc I can't figure out how to programmatically use Guile's Elisp support). +;; It parses the .el file, creating a Scheme translation of your code, and then reimplements the forms.el logic, +;; but outputs an SHTML interface instead. +;; The necessary forms.el logic is basically: +;; - read in data from forms-file as lists based on field-separator value, +;; - filter out the list elements according to forms-read-file-filter, +;; - replace the multi-line character with newlines, +;; - iterate over the list elements, setting up a proper execution environment (defining forms-fields/forms-enumerate), +;; - map over forms-format-list, replacing numbers with the corresponding field in the list element and evaluating code blocks, +;; - put resulting string inside a corresponding display. + + + +(define-peg-string-patterns ;; An elisp "parser" that extracts relevant variables from the control file. + "form-control-file <- (setq/other-sexp/whitespace)+ +comment < ';' (!'\n' .)* '\n'? +whitespace < (comment/[\r\n\t ])* + +setq <- OPEN-PAREN whitespace SETQ (whitespace name-value-pair/other-pair)* whitespace CLOSE-PAREN +other-sexp < elisp-value + +name-value-pair <- whitespace name whitespace elisp-value +other-pair < whitespace symbol whitespace elisp-value + +name <-- 'forms-file'/'forms-format-list'/'forms-number-of-fields'/'forms-field-sep'\ +/'forms-read-only'/'forms-multi-line'/'forms-read-file-filter'/'forms-write-file-filter'\ +/'forms-new-record-filter'/'forms-insert-after'/'forms-check-number-of-fields' + +elisp-value <- literal/function-access/quoted/quasiquoted/sexp +sexp <-- OPEN-PAREN (whitespace elisp-value)* whitespace CLOSE-PAREN + +literal <- integer/float/character/string/symbol/vector +FUNCTION-ACCESS-PREFIX < '#' ['] +function-access <- FUNCTION-ACCESS-PREFIX symbol +quoted <-- QUOTE elisp-value +quasiquoted <-- BACKTICK OPEN-PAREN (whitespace elisp-value/whitespace unquoted)* whitespace CLOSE-PAREN +unquoted <-- COMMA whitespace elisp-value + +integer <-- decimal/binary/octal/hex +sign <- ('+'/'-') +digit <- [0-9] +decimal <- sign? digit+ [.]? +binary <- '#b' [01]+ +octdigit <- [0-7] +octal <- '#o' octdigit+ +hexdigit <- [0-9a-fA-F] +hex <- '#x' hexdigit+ + +float <-- sign? digit* [.]? digit* [eE] ((sign? digit+)/'+INF'/'+NaN') / sign? digit* [.] digit+ + +character <- control-character/named-character/hex-character/oct-character/self-character +SELF-START < '?' '\\'? +self-character <-- SELF-START . +NAME-START < '?\\N{' +NAME-END < '}' +named-character <-- NAME-START (!'}' .)+ NAME-END +HEX-START < '?\\x' +hex-character <-- HEX-START hexdigit+ +OCT-START < '?\\' +oct-character <-- OCT-START octdigit octdigit? octdigit? +CONTROL-START < '?\\^' +control-character <-- CONTROL-START alph + +string <- regular-string/propertized-string + +regular-string <-- '\"' ( '\\' '\"' / !'\"' .)* '\"' +PROPERTIZED-START < '#(' +propertized-string <-- PROPERTIZED-START whitespace regular-string (whitespace elisp-value)* whitespace CLOSE-PAREN + + +vector <-- OPEN-BRACKET (whitespace elisp-value)* whitespace CLOSE-BRACKET + +symbol <-- ((!digit symbol-char) symbol-char*) +symbol-char <- '-'/[0-9a-zA-Z+=*/_~!@$%^&:<>{}?.]/('\\' .) + +alph <- [a-zA-Z] + +OPEN-PAREN < '(' +CLOSE-PAREN < ')' +OPEN-BRACKET < '[' +CLOSE-BRACKET < ']' +QUOTE < ['] +BACKTICK < '`' +COMMA < ',' +QUESTION < '?' +SETQ < 'setq'") + +(define (walk tree symbol-remapping) + (define (recurse tree2) (walk tree2 symbol-remapping)) + (define (string1->character c) (car (string->list c))) + (define (read-string s) (call-with-input-string s read)) + + (match tree + (('sexp contents ...) (recurse contents)) + (('quoted contents ...) (apply list (cons 'quote (recurse contents)))) + (('quasiquoted contents ...) (apply list (cons 'quasiquote (recurse contents)))) + (('unquoted contents ...) (apply list (cons 'unquote (recurse contents)))) + (('vector contents ...) (list->vector (recurse contents))) + (('integer literal) (read-string literal)) + (('float literal) (cond + ((string=? literal "1.0e+INF") +inf.0) + ((string=? literal "-1.0e+INF") -inf.0) + ((string=? literal "0.0e+NaN") +nan.0) + ((string=? literal "0.0e-NaN") +nan.0) + (else (read-string literal)))) + (('self-character literal) (string1->character literal)) + (((or 'named-character 'oct-character) literal) (read-string (string-append "#\\" literal))) + (('hex-character literal) (read-string (string-append "#\\x" literal))) + (('control-character literal) (integer->char + (- (char->integer (char-upcase (string1->character literal))) + 64))) + (('regular-string literal) (read-string literal)) + (('propertized-string ('regular-string literal) (properties ...)) (read-string literal)) ;; Discard properties. + (('symbol literal) (let* ((symbol (string->symbol literal)) + (lookup (assq-ref symbol-remapping symbol))) + (if lookup + lookup + symbol))) + (('name literal) (string->symbol literal)) + ((other ...) (map recurse other)) + (other other))) + + +(define (forms.el->sxml control-file-contents data-file-contents extra-remapping) + (let* ((symbol-remapping (append extra-remapping + '((nil . ''()) + (consp . pair?) + (atom . (lambda (x) (not (pair? x)))) + (listp . list?) + (null . null?) + (nth . (lambda (x y) (list-ref y x))) + (stringp . string?) + (concat . string-append) + (split-string . string-split) + (string= . string=?) + (string-equal . string=?) + (t . #t)))) + (parse-alist (map (lambda (pair) (cons (car pair) (cadr pair))) + (walk (peg:tree (match-pattern form-control-file control-file-contents)) symbol-remapping))) + (forms-file (assq-ref parse-alist 'forms-file)) + (forms-format-list (cadr (assq-ref parse-alist 'forms-format-list))) + (forms-field-symbols (match (assq-ref parse-alist 'forms-number-of-fields) + (('forms-enumerate ('quote symbols)) (map (lambda (x y) (cons x y)) + symbols + (iota (length symbols)))) + (other '()))) + (forms-field-sep (if (assq-ref parse-alist 'forms-field-sep) + (car (string->list (assq-ref parse-alist 'forms-field-sep))) + #\tab)) + (forms-multi-line (if (assq-ref parse-alist 'forms-multi-line) + (assq-ref parse-alist 'forms-multi-line) + "\v")) + (split-data (filter (lambda (x) + (not (string-null? (apply string-append x)))) + (map (lambda (record) + (string-split (string-replace-substring record forms-multi-line " ") forms-field-sep)) + (string-split data-file-contents #\newline)))) + (textualized-data + (map (lambda (record) + (if (not (null? record)) + (fold-right (lambda (x y) + (if (integer? x) + (string-append (number->string x) y) + (string-append x y))) + "" + (map (lambda (format-entry) + (cond ((string? format-entry) format-entry) + ((integer? format-entry) (list-ref record + (- format-entry 1))) + ((symbol? format-entry) (list-ref record + (assq-ref forms-field-symbols format-entry))) + ((list? format-entry) + (module-define! (current-module) 'forms-fields record) + (for-each (lambda (x) + (module-define! (current-module) + (car x) + (cdr x))) + forms-field-symbols) + (eval format-entry (current-module))))) + forms-format-list)) + "")) + split-data))) + `(div (@ (class "forms-carousel")) + (ul + ,@(map (lambda (entry) + `(li (div (@ (class "form-entry")) + (p ,entry)))) + textualized-data))))) + +;; TODO: explain that no modified characters can be parsed within the non-thrown-away variable settings. +;; TODO: explain that octal string escape characters will be parsed improperly/naively. +;; TODO: explain circular lists not supported because Scheme doesn't have read syntax for it. +;; TODO: consider how to convert propertized string literals to HTML. +;; TODO: explain that check-number-of-fields must be set and each field the correct size. +;; TODO: add option for newline replacement character re-substitution. diff --git a/dnw/static-pages.scm b/dnw/static-pages.scm index ab51b02..eab7e46 100644 --- a/dnw/static-pages.scm +++ b/dnw/static-pages.scm @@ -4,9 +4,11 @@ #:use-module (ice-9 match) #:use-module (ice-9 rdelim) #:use-module (ice-9 popen) + #:use-module (ice-9 textual-ports) #:use-module (dnw utils) #:use-module (dnw theme) #:use-module (dnw tags) + #:use-module (dnw forms) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (sxml simple) @@ -28,7 +30,7 @@ (p "My name is Duncan. I live below the Mason-Dixon.") (p "I write down thoughts I think are interesting here; the content is mirrored to " ,(hyperlink "http://dnw.i2p" "I2P") " and " ,(hyperlink "gemini://functorial.xyz" "Gemini") - " . I couldn't make heads or tails of Tor onion services; email me if you know how to marry a torrc with an nginx.conf.")))) + ". I couldn't make heads or tails of Tor onion services; email me if you know how to marry a torrc with an nginx.conf.")))) (define (recents site posts) `(section (@ (id "recent")) @@ -59,7 +61,7 @@ (ul (p "Github: " ,(hyperlink "https://github.com/Antigravityd" "Antigravityd")))) ;; TODO: consider moving to Sourcehut. (section (@ (id "prose")) (h1 "About Me") - (p "My name is Duncan. I am 20, and have lived most of my life in rural Arkansas. I graduated in 2023 from LSU, cum laude, " + (p "My name is Duncan. I am 21, and have lived most of my life in rural Arkansas. I graduated in 2023 from LSU, cum laude, " "with dual degrees in math and physics, and have at various times been employed as a dishwasher, maintainence guy, tutor, " "data science intern, embedded developer, and research scientist. I am currently unemployed.") (p "Had I my druthers, I would like to be able to make a career out of decentralized science, " @@ -169,11 +171,19 @@ (define influences `((h1 "Influences") (p "Any and every third-party I can think of that's affected how I think. ") - (h2 "Blogs") - (h2 "Books and Monographs") + (h2 "My Library") + (p "The books I physically own, or want to own. I haven't quite digitized everything yet (just one moving box of like 4).") + ,(forms.el->sxml (get-string-all (open-input-file "assets/library/library.el")) + (get-string-all (open-input-file "assets/library/library.tsv")) + '()) + (h2 "Blogs and Podcasts") + (ul + (li "Not Related")) + (h2 "Scholarly Articles") (h2 "Videos and Talks"))) + (define (influences-page site posts) (make-page "/pages/influences.html" (base-template site influences #:title "Influences") diff --git a/dnw/theme.scm b/dnw/theme.scm index fd17cb0..7544e23 100644 --- a/dnw/theme.scm +++ b/dnw/theme.scm @@ -19,7 +19,7 @@ (define nav-bar-tabs '(("Me" "/pages/me.html") ("Friends" "/pages/friends.html") ("Influences" "/pages/influences.html") - ("Projects" "https://git.functorial.xyz/dnw"))) + ("Projects" "https://git.functorial.xyz"))) (define dnw-title "Through the Heart of Every Man") -- cgit v1.2.3