Change string handling, some debug stuff

src/main.lisp

@@ -53,7 +53,7 b''
 (defun parse-file (filename)
   (handler-case
       (p:parse 'txt2web-grammar
-               (alexandria:read-file-into-string filename))
+               (alexandria:read-file-into-string filename :external-format :utf-8))
     (p:esrap-parse-error (e)
       (format t "~A~%" e)
       (throw :terminate nil))))
@@ -132,11 +132,11 b''
       ;; Read in body
       (when body-file
         (setf body
-              (alexandria:read-file-into-string body-file)))
+              (alexandria:read-file-into-string body-file :external-format :utf-8)))
       ;; Include js files
       (dolist (js-file js-files)
         (push (format nil "////// Included file ~A~%~A" js-file
-                      (alexandria:read-file-into-string js-file))
+                      (alexandria:read-file-into-string js-file :external-format :utf-8))
               js))
       ;; Include css files
       (when css-files
@@ -144,7 +144,7 b''
         (setf css nil)
         (dolist (css-file css-files)
           (push (format nil "////// Included file ~A~%~A" css-file
-                        (alexandria:read-file-into-string css-file))
+                        (alexandria:read-file-into-string css-file :external-format :utf-8))
                 css))))))
 
 (defmethod write-compiled-file ((compiler compiler))

src/parser.lisp

@@ -69,6 +69,24 b''
                  (do-binop% left-op
                    (mapcar #'binop-rest rest-ops)))))
 
+(defun maybe-text (list)
+  "Leaves lists in place and applies esrap:text to everything else"
+  (let ((parts nil)
+        (part (list 'text)))
+    (loop :for token :in list
+       :do (cond ((listp token)
+                  (push (nreverse part) parts)
+                  (setf part (list 'text))
+                  (push token parts))
+                 (t (push token part))))
+    (push (nreverse part) parts)
+    (remove ""
+            (loop :for part :in (nreverse parts)
+               :collect (case (first part)
+                          ('text (p:text (rest part)))
+                          (t part)))
+            :test #'equal)))
+
 (p:defrule line-continuation (and #\_ #\newline)
   (:constant nil))
 
@@ -101,15 +119,11 b''
   (:lambda (list)
     (p:text (elt list 0))))
 
-(p:defrule sstring-chars (+ (and (and (p:! "<<") (p:! (p:~ "\"exec:")))
-                                 (or squote-esc (not-quote character))))
-  (:lambda (list)
-    (p:text (mapcar #'second list))))
+(p:defrule sstring-char (or squote-esc (not-quote character))
+  (:text t))
 
-(p:defrule dstring-chars (+ (and (and (p:! "<<") (p:! (p:~ "'exec:")))
-                                 (or dquote-esc (not-doublequote character))))
-  (:lambda (list)
-    (p:text (mapcar #'second list))))
+(p:defrule dstring-char (or dquote-esc (not-doublequote character))
+  (:text t))
 
 ;;; Identifiers
 
@@ -141,42 +155,59 b''
 
 (p:defrule qsp-string (or normal-string brace-string))
 
+(p:defrule brace-string (and #\{ before-statement block-body #\})
+  (:lambda (list)
+    (list* 'lib:qspblock (third list))))
+
 (p:defrule normal-string (or sstring dstring)
   (:lambda (str)
     (list* 'lib:str (or str (list "")))))
 
-(p:defrule sstring (and #\' (* (or string-interpol
+(p:defrule sstring (and #\' (* (or sstring-interpol
                                    sstring-exec
-                                   sstring-chars))
+                                   sstring-char))
                         #\')
-  (:function second))
+  (:lambda (list)
+    (maybe-text (second list))))
 
-(p:defrule dstring (and #\" (* (or string-interpol
+(p:defrule dstring (and #\" (* (or dstring-interpol
                                    dstring-exec
-                                   dstring-chars))
+                                   dstring-char))
                         #\")
-  (:function second))
+  (:lambda (list)
+    (maybe-text (second list))))
 
-(p:defrule string-interpol (and "<<" expression ">>")
-  (:function second))
+(defun parse-interpol (list)
+  (p:parse 'expression (p:text (mapcar 'second (second list)))))
+
+(defun parse-exec (list)
+  (list* 'lib:exec (p:parse 'exec-body (p:text (second list)))))
 
-(p:defrule sstring-exec-body (+ (or squote-esc (not-doublequote character)))
-  (:text t))
+(p:defrule sstring-interpol (and "<<" (+ (and (p:! ">>")
+                                              sstring-char))
+                                 ">>")
+  (:function parse-interpol))
 
-(p:defrule dstring-exec-body (+ (or dquote-esc (not-quote character)))
-  (:text t))
+(p:defrule dstring-interpol (and "<<" (+ (and (p:! ">>")
+                                              dstring-char))
+                                 ">>")
+  (:function parse-interpol))
 
-(p:defrule sstring-exec (and (p:~ "\"exec:") sstring-exec-body #\")
-  (:lambda (list)
-    (list* 'lib:exec (p:parse 'exec-body (second list)))))
+(p:defrule sstring-exec (or (and (p:~ "\"exec:")
+                                 (+ (and (p:& (not-doublequote character)) sstring-char))
+                                 #\")
+                            (and (p:~ "''exec:")
+                                 (+ (not-quote character))
+                                 "''"))
+  (:function parse-exec))
 
-(p:defrule dstring-exec (and (p:~ "'exec:") dstring-exec-body #\')
-  (:lambda (list)
-    (list* 'lib:exec (p:parse 'exec-body (second list)))))
-
-(p:defrule brace-string (and #\{ before-statement block-body #\})
-  (:lambda (list)
-    (list* 'lib:qspblock (third list))))
+(p:defrule dstring-exec (or (and (p:~ "'exec:")
+                                 (+ (and (p:& (not-quote character)) dstring-char))
+                                 #\')
+                            (and (p:~ "\"\"exec")
+                                 (+ (not-doublequote character))
+                                 "\"\""))
+  (:function parse-exec))
 
 ;;; Location
 

src/patches.lisp

@@ -1,3 +1,5 b''
+
+;;;; Parenscript
 
 (in-package parenscript)
 
@@ -73,7 +75,10 b''
 (export '<<)
 (export '>>)
 
+;;;; Esrap
+
 (in-package esrap)
+
 (defmethod print-object :around ((condition esrap-error) stream)
   (when (not txt2web::*delivered*)
     (return-from print-object

src/utils.lisp

@@ -23,4 +23,29 b''
          :collect form))))
 
 (defun load-src (filename)
-  (alexandria:read-file-into-string (src-file filename)))
+  (alexandria:read-file-into-string (src-file filename) :external-format :utf-8))
+
+;;;; For testing
+
+(defvar *dont-expand* '(setf))
+
+(defun should-expand (form)
+  (cond ((not (listp form))
+         nil)
+        ((listp (car form))
+         t)
+        ((member (car form) *dont-expand*)
+         nil)
+        ((not (symbolp (car form)))
+         nil)
+        ((not (eq (symbol-package (car form))
+                  (find-package :parenscript)))
+         t)))
+
+(defun ps-macroexpand-all (form)
+  (if (should-expand form)
+      (let ((form (ps::ps-macroexpand form)))
+        (if (listp form)
+            (mapcar #'ps-macroexpand-all form)
+            form))
+      form))