1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
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.
|
