gdritter repos when-computer / 714c590
Updated source files to work with Guile instead Getty Ritter 8 years ago
3 changed file(s) with 34 addition(s) and 41 deletion(s). Collapse all Expand all
+13
-18
generator/generate.scm less more
1 (declare (uses libs))
2 (declare (uses telml))
3 (declare (uses match-case-simple))
1 (load "telml.scm")
2 (load "libs.scm")
3 (use-modules (ice-9 match))
44
5 ; (load "libs.scm")
6 ; (load "telml.scm")
7 ; this is just Oleg's pattern matcher
8 ; (load "match-case-simple.scm")
9
10 ;(define (pairs lst)
11 ; (match-case-simple lst
12 ; [(,x . (,y . ,xs)) () (cons (list x y) (pairs xs))]
13 ; [__ () '()]))
5 (define (pairs lst)
6 (match lst
7 ((x . (y . xs)) (cons (list x y) (pairs xs)))
8 (__ '())))
149
1510 ;; template-ey things and style things
1611
3530 (define stylesheet
3631 '((body
3732 (font-family "Palatino, \"Palatino Linotype\", \"Palatino LT STD\", \"Book Antiqua\", Georgia, serif")
38 ; (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
3933 (font-size 15pt)
4034 (background-color "#eeeeee")
4135 (counter-reset sidenote-counter))
136130 (h1 "what happens when computer"))
137131 (div (@ (class "nav")) ,menu)
138132 (div (@ (class "main")) ,content)
139 (div (@ (class "footer")) "© 2015 getty ritter"))))
133 (div (@ (class "footer")) "© 2015 getty ritter"))))
140134
141135 (define (archive)
142136 (let* ((metadata (read-file "site.scm")))
151145 (let* ((page-source (translate-file file))
152146 (telml (cdr page-source))
153147 (meta (car page-source))
154 (title (if meta (cadr meta) pg)))
155 (display (serialize-sxml (page title telml)))))
148 (title (if (not (null? meta)) (cadr meta) pg))
149 (display (serialize-sxml (page title telml))))
150 (format #t "~a\n" display)))
156151
157152 (define (dispatch pg files)
158153 (cond ((equal? pg "index")
171166 (with-output-to-file "output/about/index.html"
172167 (lambda () (main "about" "pages/about.telml"))))))
173168
174 (define args (command-line-arguments))
169 (define args (cdr (command-line)))
175170 (cond ((= (length args) 0)
176 (format #t "Usage: generate [page] [files]"))
171 (format #t "Usage: generate [page] [files]\n"))
177172 (else (dispatch (car args) (cdr args))))
+9
-12
generator/libs.scm less more
11 ;; some library stuff
22
3 (define (++ . args)
4 (define (go ls)
5 (if (null? ls) ""
6 (string-append (car ls) (go (cdr ls)))))
7 (go args))
3 (define (++ . args) (apply string-append args))
4
5 (define (as-string s)
6 (if (symbol? s) (symbol->string s) s))
87
98 (define (intercalate x xs)
109 (define (go ls)
3433 (intercalate "," (map mk-selector (cdr selector))))
3534 (else "...")))
3635 (define (mk-line line)
37 (++ (car line) ": " (cadr line) "; "))
36 (++ (as-string (car line)) ": " (as-string (cadr line)) "; "))
3837 (define (mk-clause clause)
3938 (++
4039 (mk-selector (car clause))
5150
5251 (define (serialize-sxml sxml)
5352 (define (mk-prop prop)
54 (let ((key (car prop)) (val (cadr prop)))
55 (++ " "
56 key
57 "="
58 (if (string? val) (++ "\"" val "\"") val))))
53 (let ((key (as-string (car prop))) (val (as-string (cadr prop))))
54 (++ " " key "="
55 (if (string? val) (++ "\"" val "\"") (as-string val)))))
5956 (cond ((null? sxml) "")
6057 ((string? sxml) sxml)
6158 ((symbol? sxml) (symbol->string sxml))
6259 ((not (symbol? (car sxml)))
6360 (apply string-append (map serialize-sxml sxml)))
6461 (else
65 (let ((tag (car sxml))
62 (let ((tag (symbol->string (car sxml)))
6663 (props (if (and (cadr? sxml) (eq? (caadr sxml) '@))
6764 (cdadr sxml) '()))
6865 (vals (if (and (cadr? sxml) (eq? (caadr sxml) '@))
+12
-11
generator/telml.scm less more
1 (import (owl io))
2 (import (owl string))
3 (import (owl sexp))
1 (use-modules (ice-9 rdelim))
2 (use-modules (ice-9 regex))
43
54 (define (mk-stream s)
65 (let ((lst (string->list s)))
115114 `(a (@ (href ,(apply string-append url))) ,name)))
116115 (cons 'sidenote (lambda (arg) `(span (@ (class sidenote)) ,arg)))
117116 (cons 'ref (lambda (name)
118 `(label (@ (for ,name) (class "sidenote-number"))))))))
117 `(label (@ (for ,(car name)) (class "sidenote-number"))))))))
119118
120119 (define (partition doc lst)
121120 (cond ((null? doc) (reverse lst))
129128
130129 (define (string-drop str i)
131130 (let ((l (string-length str)))
132 (substring str i (- l i))))
131 (substring str i l)))
133132
134133 (define (gather-para document)
135134 (define (split-string text)
136 (let ((i (string-ref text "\n\n")))
137 (if (not i) (list text)
138 (cons (string-take text i)
139 (cons #f (split-string (string-drop text (+ i 2))))))))
135 (let ((m (string-match "\n\n" text)))
136 (if (not m) (list text)
137 (let ((i (match:start m)))
138 (cons (string-take text i)
139 (cons #f (split-string (string-drop text (+ i 2)))))))))
140140 (define (go doc)
141141 (cond ((null? doc) '())
142142 ((not (string? (car doc)))
167167 (eq? (caar telml) 'meta))
168168 (cdr telml)
169169 telml)))
170 (cons (if meta (string->sexp meta) '())
170 (cons (if #f (string->sexp meta) '())
171171 (map (lambda (x)
172172 (cons 'p (rec x)))
173173 (gather-para body)))))
174174
175175 (define (translate-file filename)
176 (telml->sxml (parse (list->string (file->list filename))) basic-tag-list))
176 (let ((body (with-input-from-file filename read-string)))
177 (telml->sxml (parse body) basic-tag-list)))