Hash :
160d346b
Author :
Thomas de Grivel
Date :
2017-06-21T11:12:40
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
;;
;; RoL-assets - Asset pipeline
;;
;; Copyright 2012-2015 Thomas de Grivel <thomas@lowh.net>
;;
;; 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 :RoL-assets)
(defstruct (entity-table (:constructor make-entity-table (chars entities)))
chars
entities)
(defvar *html-entities*
(make-entity-table "&<>\"'"
(the (simple-array simple-base-string)
#("&" "<" ">" """ "'"))))
(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))
(if (emptyp 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))