;;; -*- Lisp -*- mode

(in-package #:com.paskvil.uhttp)

(defun str-replace (str tr-rules)
  (with-output-to-string (new-str)
    (let (tr)
      (loop for c across str
		 do (if (setf tr (assoc c tr-rules))
				(write-string (cdr tr) new-str)
				(write-char c new-str))))))

(defun escape-html-chars (str)
  (with-output-to-string (new-str)
    (let ((pos1 0)
		  (pos2 -1))
      (loop for c across str
		 do (case c
			  (#\< (when (<= pos1 pos2)
					 (write-string (subseq str pos1 (1+ pos2)) new-str))
				   (write-string "&lt;" new-str)
				   (setf pos1 (+ pos2 2))
				   (incf pos2))
			  (#\> (when (<= pos1 pos2)
					 (write-string (subseq str pos1 (1+ pos2)) new-str))
				   (write-string "&gt;" new-str)
				   (setf pos1 (+ pos2 2))
				   (incf pos2))
			  (t (incf pos2))))
      (when (<= pos1 pos2)
		(write-string (subseq str pos1 (1+ pos2)) new-str)))))

(defparameter *html-tags*
  '(:a :applet :area :b :big :blockquote :body :br :button
    :caption :center :code :dd :del :div :em :font :form :frame
    :h1 :h2 :h3 :h4 :h5 :h6 :head :hr :html :i :iframe :img :input
    :labe :li :map :meta :noscript :object :ol :option
    :p :param :pre :s :script :select :small :span :strike
    :strong :style :sub :sup :table :tbody :td :textarea :tfoot
    :th :thead :title :tr :tt :u :ul :var))
(defparameter *html-single-tags*
  '(:a :area :br :frame :hr :img :input :meta :param))

(defun to-html-string (obj)
  (escape-html-chars (format nil "~a" obj)))

(defmacro html (forms)
  "Emits HTML code based on provided forms.

   If the form starts with a keyword that denotes HTML tag,
   appropriate HTML code is printed to *html-stream* stream.
   If it's any other designator, the whole form is considered
   to be a form to execute, potentially containing more html.

   Example usage:

   (html (:p \"hello\"))
   (html ((:p :style \"font-size: 12px;\") \"hello\"))
   (html (:img :src \"/images/img.jpg\"))
   (html (:body (:ul (dotimes (x 10) (html (:li x)))))"
  (labels ((is-html-tag (tag) (find tag *html-tags*))
		   (is-html-single-tag (tag) (find tag *html-single-tags*)))
    (cond ((atom forms) ; atom - presume it's contents to print
		   `(format t "~a" (to-html-string ,forms)))
		  ((and forms (listp forms)) ; list - either tag definition, or code
		   (let ((fhead (car forms))
				 (ftail (cdr forms)))
			 (cond ((and (listp fhead) ; starts with list - should be tag with attributes
						 (keywordp (car fhead))
						 (is-html-tag (car fhead)))
					`(progn
					   (format t "<~a" (car ',fhead))
					   ,@(do ((res '())
							  (att (cdr fhead) (cddr att)))
							 ((null att) (nreverse res))
							 (push `(format t " ~a='~a'" (car ',att) (to-html-string (cadr ',att))) res))
					   (format t ">")
					   ,@(loop for x in ftail collecting `(html ,x))
					   (format t "</~a>~%" (car ',fhead))))
				   ((and (atom fhead) ; single tag - followed by attributes
						 (keywordp fhead)
						 (is-html-single-tag fhead))
					`(progn
					   (format t "<~a" ,fhead)
					   ,@(do ((res '())
							  (att ftail (cddr att)))
							 ((null att) (nreverse res))
							 (push `(format t " ~a='~a'" (car ',att) (to-html-string (cadr ',att))) res))
					   (format t "/>~%")))
				   ((and (atom fhead) ; normal tag, followed by contents
						 (keywordp fhead)
						 (is-html-tag fhead))
					`(progn
					   (format t "<~a>" ,fhead)
					   ,@(loop for x in ftail collecting `(html ,x))
					   (format t "</~a>~%" ,fhead)))
				   (t ; presume it's a code to execute
					forms)))))))