diff --git a/src/main.lisp b/src/main.lisp --- a/src/main.lisp +++ b/src/main.lisp @@ -53,7 +53,7 @@ (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 @@ ;; 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 @@ (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)) diff --git a/src/parser.lisp b/src/parser.lisp --- a/src/parser.lisp +++ b/src/parser.lisp @@ -69,6 +69,24 @@ (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 @@ (: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 @@ (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 diff --git a/src/patches.lisp b/src/patches.lisp --- a/src/patches.lisp +++ b/src/patches.lisp @@ -1,3 +1,5 @@ + +;;;; Parenscript (in-package parenscript) @@ -73,7 +75,10 @@ (export '<<) (export '>>) +;;;; Esrap + (in-package esrap) + (defmethod print-object :around ((condition esrap-error) stream) (when (not txt2web::*delivered*) (return-from print-object diff --git a/src/utils.lisp b/src/utils.lisp --- a/src/utils.lisp +++ b/src/utils.lisp @@ -23,4 +23,29 @@ :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))