Show More
@@ -53,7 +53,7 b'' | |||
|
53 | 53 | (defun parse-file (filename) |
|
54 | 54 | (handler-case |
|
55 | 55 | (p:parse 'txt2web-grammar |
|
56 | (alexandria:read-file-into-string filename)) | |
|
56 | (alexandria:read-file-into-string filename :external-format :utf-8)) | |
|
57 | 57 | (p:esrap-parse-error (e) |
|
58 | 58 | (format t "~A~%" e) |
|
59 | 59 | (throw :terminate nil)))) |
@@ -132,11 +132,11 b'' | |||
|
132 | 132 | ;; Read in body |
|
133 | 133 | (when body-file |
|
134 | 134 | (setf body |
|
135 | (alexandria:read-file-into-string body-file))) | |
|
135 | (alexandria:read-file-into-string body-file :external-format :utf-8))) | |
|
136 | 136 | ;; Include js files |
|
137 | 137 | (dolist (js-file js-files) |
|
138 | 138 | (push (format nil "////// Included file ~A~%~A" js-file |
|
139 | (alexandria:read-file-into-string js-file)) | |
|
139 | (alexandria:read-file-into-string js-file :external-format :utf-8)) | |
|
140 | 140 | js)) |
|
141 | 141 | ;; Include css files |
|
142 | 142 | (when css-files |
@@ -144,7 +144,7 b'' | |||
|
144 | 144 | (setf css nil) |
|
145 | 145 | (dolist (css-file css-files) |
|
146 | 146 | (push (format nil "////// Included file ~A~%~A" css-file |
|
147 | (alexandria:read-file-into-string css-file)) | |
|
147 | (alexandria:read-file-into-string css-file :external-format :utf-8)) | |
|
148 | 148 | css)))))) |
|
149 | 149 | |
|
150 | 150 | (defmethod write-compiled-file ((compiler compiler)) |
@@ -69,6 +69,24 b'' | |||
|
69 | 69 | (do-binop% left-op |
|
70 | 70 | (mapcar #'binop-rest rest-ops))))) |
|
71 | 71 | |
|
72 | (defun maybe-text (list) | |
|
73 | "Leaves lists in place and applies esrap:text to everything else" | |
|
74 | (let ((parts nil) | |
|
75 | (part (list 'text))) | |
|
76 | (loop :for token :in list | |
|
77 | :do (cond ((listp token) | |
|
78 | (push (nreverse part) parts) | |
|
79 | (setf part (list 'text)) | |
|
80 | (push token parts)) | |
|
81 | (t (push token part)))) | |
|
82 | (push (nreverse part) parts) | |
|
83 | (remove "" | |
|
84 | (loop :for part :in (nreverse parts) | |
|
85 | :collect (case (first part) | |
|
86 | ('text (p:text (rest part))) | |
|
87 | (t part))) | |
|
88 | :test #'equal))) | |
|
89 | ||
|
72 | 90 | (p:defrule line-continuation (and #\_ #\newline) |
|
73 | 91 | (:constant nil)) |
|
74 | 92 | |
@@ -101,15 +119,11 b'' | |||
|
101 | 119 | (:lambda (list) |
|
102 | 120 | (p:text (elt list 0)))) |
|
103 | 121 | |
|
104 | (p:defrule sstring-chars (+ (and (and (p:! "<<") (p:! (p:~ "\"exec:"))) | |
|
105 | (or squote-esc (not-quote character)))) | |
|
106 | (:lambda (list) | |
|
107 | (p:text (mapcar #'second list)))) | |
|
122 | (p:defrule sstring-char (or squote-esc (not-quote character)) | |
|
123 | (:text t)) | |
|
108 | 124 | |
|
109 | (p:defrule dstring-chars (+ (and (and (p:! "<<") (p:! (p:~ "'exec:"))) | |
|
110 | (or dquote-esc (not-doublequote character)))) | |
|
111 | (:lambda (list) | |
|
112 | (p:text (mapcar #'second list)))) | |
|
125 | (p:defrule dstring-char (or dquote-esc (not-doublequote character)) | |
|
126 | (:text t)) | |
|
113 | 127 | |
|
114 | 128 | ;;; Identifiers |
|
115 | 129 | |
@@ -141,42 +155,59 b'' | |||
|
141 | 155 | |
|
142 | 156 | (p:defrule qsp-string (or normal-string brace-string)) |
|
143 | 157 | |
|
158 | (p:defrule brace-string (and #\{ before-statement block-body #\}) | |
|
159 | (:lambda (list) | |
|
160 | (list* 'lib:qspblock (third list)))) | |
|
161 | ||
|
144 | 162 | (p:defrule normal-string (or sstring dstring) |
|
145 | 163 | (:lambda (str) |
|
146 | 164 | (list* 'lib:str (or str (list ""))))) |
|
147 | 165 | |
|
148 | (p:defrule sstring (and #\' (* (or string-interpol | |
|
166 | (p:defrule sstring (and #\' (* (or sstring-interpol | |
|
149 | 167 | sstring-exec |
|
150 |
sstring-char |
|
|
168 | sstring-char)) | |
|
151 | 169 | #\') |
|
152 | (:function second)) | |
|
170 | (:lambda (list) | |
|
171 | (maybe-text (second list)))) | |
|
153 | 172 | |
|
154 | (p:defrule dstring (and #\" (* (or string-interpol | |
|
173 | (p:defrule dstring (and #\" (* (or dstring-interpol | |
|
155 | 174 | dstring-exec |
|
156 |
dstring-char |
|
|
175 | dstring-char)) | |
|
157 | 176 | #\") |
|
158 | (:function second)) | |
|
177 | (:lambda (list) | |
|
178 | (maybe-text (second list)))) | |
|
159 | 179 | |
|
160 | (p:defrule string-interpol (and "<<" expression ">>") | |
|
161 | (:function second)) | |
|
180 | (defun parse-interpol (list) | |
|
181 | (p:parse 'expression (p:text (mapcar 'second (second list))))) | |
|
182 | ||
|
183 | (defun parse-exec (list) | |
|
184 | (list* 'lib:exec (p:parse 'exec-body (p:text (second list))))) | |
|
162 | 185 | |
|
163 | (p:defrule sstring-exec-body (+ (or squote-esc (not-doublequote character))) | |
|
164 | (:text t)) | |
|
186 | (p:defrule sstring-interpol (and "<<" (+ (and (p:! ">>") | |
|
187 | sstring-char)) | |
|
188 | ">>") | |
|
189 | (:function parse-interpol)) | |
|
165 | 190 | |
|
166 | (p:defrule dstring-exec-body (+ (or dquote-esc (not-quote character))) | |
|
167 | (:text t)) | |
|
191 | (p:defrule dstring-interpol (and "<<" (+ (and (p:! ">>") | |
|
192 | dstring-char)) | |
|
193 | ">>") | |
|
194 | (:function parse-interpol)) | |
|
168 | 195 | |
|
169 |
(p:defrule sstring-exec (and (p:~ "\"exec:") |
|
|
170 | (:lambda (list) | |
|
171 | (list* 'lib:exec (p:parse 'exec-body (second list))))) | |
|
196 | (p:defrule sstring-exec (or (and (p:~ "\"exec:") | |
|
197 | (+ (and (p:& (not-doublequote character)) sstring-char)) | |
|
198 | #\") | |
|
199 | (and (p:~ "''exec:") | |
|
200 | (+ (not-quote character)) | |
|
201 | "''")) | |
|
202 | (:function parse-exec)) | |
|
172 | 203 | |
|
173 |
(p:defrule dstring-exec (and (p:~ "'exec:") |
|
|
174 | (:lambda (list) | |
|
175 | (list* 'lib:exec (p:parse 'exec-body (second list))))) | |
|
176 | ||
|
177 | (p:defrule brace-string (and #\{ before-statement block-body #\}) | |
|
178 | (:lambda (list) | |
|
179 | (list* 'lib:qspblock (third list)))) | |
|
204 | (p:defrule dstring-exec (or (and (p:~ "'exec:") | |
|
205 | (+ (and (p:& (not-quote character)) dstring-char)) | |
|
206 | #\') | |
|
207 | (and (p:~ "\"\"exec") | |
|
208 | (+ (not-doublequote character)) | |
|
209 | "\"\"")) | |
|
210 | (:function parse-exec)) | |
|
180 | 211 | |
|
181 | 212 | ;;; Location |
|
182 | 213 |
@@ -1,3 +1,5 b'' | |||
|
1 | ||
|
2 | ;;;; Parenscript | |
|
1 | 3 | |
|
2 | 4 | (in-package parenscript) |
|
3 | 5 | |
@@ -73,7 +75,10 b'' | |||
|
73 | 75 | (export '<<) |
|
74 | 76 | (export '>>) |
|
75 | 77 | |
|
78 | ;;;; Esrap | |
|
79 | ||
|
76 | 80 | (in-package esrap) |
|
81 | ||
|
77 | 82 | (defmethod print-object :around ((condition esrap-error) stream) |
|
78 | 83 | (when (not txt2web::*delivered*) |
|
79 | 84 | (return-from print-object |
@@ -23,4 +23,29 b'' | |||
|
23 | 23 | :collect form)))) |
|
24 | 24 | |
|
25 | 25 | (defun load-src (filename) |
|
26 | (alexandria:read-file-into-string (src-file filename))) | |
|
26 | (alexandria:read-file-into-string (src-file filename) :external-format :utf-8)) | |
|
27 | ||
|
28 | ;;;; For testing | |
|
29 | ||
|
30 | (defvar *dont-expand* '(setf)) | |
|
31 | ||
|
32 | (defun should-expand (form) | |
|
33 | (cond ((not (listp form)) | |
|
34 | nil) | |
|
35 | ((listp (car form)) | |
|
36 | t) | |
|
37 | ((member (car form) *dont-expand*) | |
|
38 | nil) | |
|
39 | ((not (symbolp (car form))) | |
|
40 | nil) | |
|
41 | ((not (eq (symbol-package (car form)) | |
|
42 | (find-package :parenscript))) | |
|
43 | t))) | |
|
44 | ||
|
45 | (defun ps-macroexpand-all (form) | |
|
46 | (if (should-expand form) | |
|
47 | (let ((form (ps::ps-macroexpand form))) | |
|
48 | (if (listp form) | |
|
49 | (mapcar #'ps-macroexpand-all form) | |
|
50 | form)) | |
|
51 | form)) |
General Comments 0
You need to be logged in to leave comments.
Login now