Commit 01251b1401df94a20cf55ab72c9e3cc57e909d26

Thomas de Grivel 2013-12-10T12:38:24

Implement ASSET-INCLUDE.

diff --git a/asset.lisp b/asset.lisp
index 822e345..6d369ee 100644
--- a/asset.lisp
+++ b/asset.lisp
@@ -35,7 +35,7 @@
 (defgeneric asset-url (asset))
 (defgeneric asset-path (asset))
 (defgeneric asset-source-path (asset))
-(defgeneric asset-include (context asset &rest params &key &allow-other-keys))
+(defgeneric asset-include (output context asset &key &allow-other-keys))
 (defgeneric compile-asset (asset output))
 
 ;;  Base implementation
@@ -62,10 +62,6 @@
     (ignore-errors (format stream "~S" (asset-path asset)))
     (ignore-errors (format stream " ~S" (asset-source-path asset)))))
 
-(defmethod asset-include ((asset-spec string) &rest args &key &allow-other-keys)
-  (let ((asset (find-assets-from-spec asset-spec)))
-    (apply #'asset-html-include asset args)))
-
 (defmethod compile-asset ((asset asset) (output stream))
   (let ((path (asset-source-path asset)))
     (msg "CP ~A" path)
@@ -80,6 +76,13 @@
     (copy-files path output :replace t :update t))
   nil)
 
+(defmethod asset-include ((output null)
+			  context
+			  asset
+			  &rest args &key &allow-other-keys)
+  (with-output-to-string (stream)
+    (apply #'asset-include stream context asset args)))
+
 ;;  Asset class -> extensions
 
 (defgeneric asset-class-extensions (asset-class))
diff --git a/css.lisp b/css.lisp
index ecfefc0..af4a0d2 100644
--- a/css.lisp
+++ b/css.lisp
@@ -28,11 +28,15 @@
 (defmethod asset-class-extensions ((class (eql 'css-asset)))
   (extensions #:css #:less))
 
-(defmethod asset-include ((context (eql :html))
+(defmethod asset-include ((output stream)
+			  (context (eql :html))
 			  (asset css-asset)
-			  &rest )
-  (format nil "<link rel=\"stylesheet\" href=\"~A\" type=\"text/css\" />"
-	  (asset-url asset)))
+			  &key &allow-other-keys)
+  (write-string "<link rel=\"stylesheet\" href=\"" output)
+  (write-string (quote-html (asset-url asset)) output)
+  (write-string "\" type=\"text/css\" />
+" output)
+  (values))
 
 ;;  Compile
 
diff --git a/find.lisp b/find.lisp
index 43bc1a4..7c394d9 100644
--- a/find.lisp
+++ b/find.lisp
@@ -151,9 +151,11 @@
 (defmethod asset-source-path ((spec string))
   (asset-source-path (find-asset spec)))
 
-(defmethod asset-include (context (spec string)
-			  &rest params &key &allow-other-keys)
-  (apply #'asset-include context (find-asset spec) params))
+(defmethod asset-include (output
+			  context
+			  (spec string)
+			  &rest args &key &allow-other-keys)
+  (apply #'asset-include output context (find-asset spec) args))
 
 (defmethod compile-asset ((spec string) output)
   (compile-asset (find-asset spec) output))
diff --git a/html.lisp b/html.lisp
new file mode 100644
index 0000000..099b589
--- /dev/null
+++ b/html.lisp
@@ -0,0 +1,88 @@
+;;
+;;  LowH Triangle Assets  -  Asset pipeline
+;;
+;;  Copyright 2012 Thomas de Grivel <billitch@gmail.com>
+;;
+;;  Permission to use, copy, modify, and distribute this software for any
+;;  purpose with or without fee is hereby granted, provided that the above
+;;  copyright notice and this permission notice appear in all copies.
+;;
+;;  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+;;  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+;;  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+;;  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+;;  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(in-package :lowh.triangle.assets)
+
+(defstruct (entity-table (:constructor make-entity-table (chars entities)))
+  chars
+  entities)
+
+(defvar *html-entities*
+  (make-entity-table "&<>\"'"
+		     (the (simple-array simple-base-string)
+		       #("&amp;" "&lt;" "&gt;" "&quot;" "&apos;"))))
+
+(defun char-entity (char &optional (table *html-entities*))
+  (with-slots (chars entities) table
+    (let ((i (position char chars)))
+      (when i
+	(svref entities i)))))
+
+(defun quote-html (string &key stream (start 0) (end (length string)))
+  (declare (optimize (safety 0) (debug 0) (speed 3))
+	   (type fixnum start end)
+	   (type string string))
+  (labels ((print-raw (raw i)
+	     (declare (type fixnum raw i))
+	     (when (< raw i)
+	       (write-string string stream :start raw :end i)))
+	   (chr (i)
+	     (typecase string
+	       (simple-array  (char string i))
+	       (simple-string (char string i))
+	       (string        (char string i))))
+	   (skip (raw i)
+	     (declare (type fixnum raw i))
+	     (cond ((= i end) (print-raw raw i))
+		   (t (let* ((char (chr i))
+			     (entity (char-entity char)))
+			(cond (entity (print-raw raw i)
+				      (write-string entity stream)
+				      (incf i)
+				      (skip i i))
+			      (t (skip raw (1+ i))))))))
+	   (stream-or-string (i)
+	     (declare (type fixnum i))
+	     (cond ((= i end) (if (and (= 0 start)
+				       (= end (length string)))
+				  string
+				  (subseq string start end)))
+		   (t (let* ((char (chr i))
+			     (entity (char-entity char)))
+			(cond (entity (with-output-to-string (out)
+					(setq stream out)
+					(print-raw start i)
+					(write-string entity stream)
+					(incf i)
+					(skip i i)))
+			      (t (stream-or-string (1+ i)))))))))
+    (if stream
+	(skip start start)
+	(stream-or-string start))))
+
+(define-compiler-macro quote-html (&whole whole string &key stream
+					  (start 0)
+					  (end nil end-p))
+  (if (and (null stream)
+	   (stringp string)
+	   (or (not end-p)
+	       (integerp end)))
+      (quote-html string
+		  :start start
+		  :end (if end-p end (length string)))
+      whole))
diff --git a/image.lisp b/image.lisp
index a41514c..23d0302 100644
--- a/image.lisp
+++ b/image.lisp
@@ -25,8 +25,14 @@
 (defmethod asset-class-extensions ((class (eql 'image-asset)))
   (extensions #:gif #:ico #:jpeg #:jpg #:png #:svg #:svgz))
 
-(defmethod asset-html-include ((asset image-asset) &rest args
-			       &key alt &allow-other-keys)
-  (format nil "<img src=\"~A\" alt=\"~A\"></script>"
-	  (asset-url asset)
-	  (or alt "")))
+(defmethod asset-include ((output stream)
+			  (context (eql :html))
+			  (asset image-asset)
+			  &key alt &allow-other-keys)
+  (write-string "<img src=\"" output)
+  (write-string (quote-html (asset-url asset)) output)
+  (write-string "\" alt=\"" output)
+  (when alt (write-string (quote-html alt) output))
+  (write-string "\"/>
+" output)
+  (values))
diff --git a/js.lisp b/js.lisp
index 842e718..bd9a96a 100644
--- a/js.lisp
+++ b/js.lisp
@@ -28,9 +28,15 @@
 (defmethod asset-class-extensions ((class (eql 'js-asset)))
   (extensions #:js))
 
-(defmethod asset-html-include ((asset js-asset))
-  (format nil "<script src=\"~A\" type=\"text/javascript\"></script>"
-	  (asset-url asset)))
+(defmethod asset-include ((output stream)
+			  (context (eql :html))
+			  (asset js-asset)
+			  &key &allow-other-keys)
+  (write-string "<script src=\"" output)
+  (write-string (quote-html (asset-url asset)) output)
+  (write-string "\" type=\"text/javascript\"></script>
+" output)
+  (values))
 
 ;;  Compile
 
@@ -52,7 +58,3 @@
 	(jsmin js output)))
   (force-output output)
   (values))
-
-(defmethod include-asset ((asset js-asset)
-			  (output stream))
-  (format output "triangle_include(~S);~%" (asset-url asset)))
diff --git a/lowh.triangle.assets.asd b/lowh.triangle.assets.asd
index e8ce620..5baab85 100644
--- a/lowh.triangle.assets.asd
+++ b/lowh.triangle.assets.asd
@@ -31,6 +31,7 @@
 	       "lowh.triangle.uri")
   :components
   ((:file "package")
+   (:file "html"       :depends-on ("package"))
    (:file "config"     :depends-on ("package"))
    (:file "lib"        :depends-on ("package"))
    (:file "extensions" :depends-on ("package"))
@@ -38,6 +39,6 @@
    (:file "find"       :depends-on ("asset"))
    (:file "font"       :depends-on ("asset"))
    (:file "preprocess" :depends-on ("find"))
-   (:file "css"        :depends-on ("preprocess"))
-   (:file "image"      :depends-on ("preprocess"))
-   (:file "js"         :depends-on ("preprocess"))))
+   (:file "css"        :depends-on ("preprocess" "html"))
+   (:file "image"      :depends-on ("preprocess" "html"))
+   (:file "js"         :depends-on ("preprocess" "html"))))
diff --git a/package.lisp b/package.lisp
index 4d8f54d..c2ef610 100644
--- a/package.lisp
+++ b/package.lisp
@@ -48,7 +48,7 @@
    ;;  Rendering
    #:process-asset
    #:preprocess-asset
-   #:asset-html-include
+   #:asset-include
    ;;  Precompile
    #:debug-msg
    #:msg