(chapter-start 'html

"Functions and macros for creating HTML output by cleverly mixing nydp interpolations with HTML and textile renderers.

Also provides percent-syntax for concise html-generation in nydp, for example

(%a.highlight(href \"http://github.com/\") \"Click\" (%b \"here\") \"for more information\")“)

(def default-format (arg)

; override this to ensure values are formatted
; as you desire it. By default, this returns its
; argument unchanged
arg)

(def interpolate (arg)

; override this to provide error handling, logging,
; profiling, or whatever it is you might desire.
; by default, this delegates to 'default-format
(default-format arg))

(def html-resplit (parts hsh)

(accum splot
       (each part parts
             (splot (or (hash-get hsh part)
                        part)))))

(def html-split-fn (seq sep hsh escapef piece-handler)

(fn (piece)
    (if (isa 'string piece)
        piece
        (let key (j "hsf:" (seq) ":hsf")
          (hash-set hsh key (piece-handler piece))
          (escapef:j sep key sep)))))

(def html-build-processor (converter)

(with (hsh (hash)
       sep (random-string 12))
      { method    converter.method
        processor (html-split-fn (seqf 0)
                                 sep
                                 hsh
                                 (or converter.esc x1)
                                 (or converter.interpolate interpolatify))
        hsh       hsh
        sep       sep }))

(def interpolatify (arg) `(interpolate ,arg))

(def html-process-parts (parts processor)

; 'parts a mixed list containing strings or uncompiled lisp forms - the cdr of 'string-pieces after parting a string with interpolations
; 'converter is a hash with the following keys
; * method - textile-to-html, haml-to-html, or strip-nydp-tags, or anything that takes a string and returns a string
; * esc - a function that takes a string and returns another string such that when 'method processes the result, the original string is returned. For example, if 'method is 'textile-to-html, then 'esc could be (fn (txt) "==~|txt|==") because "==" is used by textile to mark text not-to-be-processed.
; * interpolator - a function that takes an uncompiled lisp form and returns another uncompiled lisp form such that when executed in the context of 'string-pieces will give the desired result
; returns a mixed list containing strings or uncompiled lisp forms such that the concatenation of the list is html output by converter.method (the textile, haml, or other processor)
(html-resplit (string-split (processor.method (j:map processor.processor parts))
                            processor.sep)
              processor.hsh))

(def html-build-interpolator (pieces converter)

`(string-pieces ,@(html-process-parts pieces (html-build-processor converter))))

(def strip-nydp-tags (txt)

; remove <nydp> and </nydp> tags from given 'txt, some editing environments (ckeditor) may require such tags
; in order to protect active content from reformatting or other transformations
(string-replace "</?nydp>" "" txt))

(mac render-as-html (arg)

; produce code to convert 'arg to html using a null interpreter.
; in other words, assume input is already html. Normally, we would
; just return the argument, but it's useful to take advantage of the fact that
; each interpolation ~(foo) is replaced with ~(interpolate (foo)), and
; you may override 'interpolate for your own nefarious purposes.
;
; for example:
;
; (render-as-html "<p>hello world</p>")            ;=> "<p>hello world</p>"
; (render-as-html (get-some-text-from 'somewhere)) ;=> (x1 (get-some-text-from 'somewhere))
; (render-as-html "<p>hello ~|name|</p>")          ;=>  (string-pieces "<p>hello" (interpolate name) "<p>")
(if (isa 'string arg)
    arg
    (and (pair? arg)
         (eq? 'string-pieces (car arg)))
    (html-build-interpolator (cdr arg) { method strip-nydp-tags esc x1 })
    arg))

(mac render-as-haml (arg)

; produce code to convert 'arg to html using a haml interpreter
; for example:
;
; (render-as-haml "%p hello world")                ;=> "<p>hello world</p>"
; (render-as-haml (get-some-text-from 'somewhere)) ;=> (haml-to-html (get-some-text-from 'somewhere))
; (render-as-haml "%p hello ~name")                ;=>  (string-pieces "<p>hello" (interpolate name) "<p>")
(if (isa 'string arg)
    (haml-to-html arg)
    (and (pair? arg)
         (eq? 'string-pieces (car arg)))
    (html-build-interpolator (cdr arg) { method haml-to-html esc x1 })
    `(haml-to-html ,arg)))

(def notextile-esc (txt) “<notextile>~|txt|</notextile>”)

(mac render-as-textile (arg)

; produces code to convert 'arg to html using a textile interpreter
; for example:
;
; (render-as-textile "hello world")                   ;=>  "<p>hello world</p>"
; (render-as-textile (get-some-text-from 'somewhere)) ;=>  (textile-to-html (get-some-text-from 'somewhere))
; (render-as-textile "hello ~name")                   ;=> (string-pieces "<p>hello" (interpolate name) "<p>")
(if (isa 'string arg)
    (textile-to-html arg)
    (and (pair? arg)
         (eq?   'string-pieces (car arg)))
    (html-build-interpolator (cdr arg) { method textile-to-html esc notextile-esc })
    `(textile-to-html ,arg)))

(def textile-to-html-source (doc)

(if (isa 'string doc)
    (textile-to-html doc)
    (and (pair? arg)
         (eq?   'string-pieces (car arg)))
    (html-build-interpolator (cdr arg) { method textile-to-html esc notextile-esc })
    (error "can't convert doc to html: not a string")))

(def to-css-rule (prop val) (joinstr “” prop “:” val “;”))

(def to-css (hsh)

; convert given 'hsh to a CSS string. Keys of 'hsh are
; css properties; the corresponding values are css values.
;
; example:
; (to-css { background "black" font-size "12px" })
;
; produces
; "background:black;font-size:12px;"
;
(and hsh
     (joinstr "" (map (fn (k) (to-css-rule k hsh.,k))
                      (hash-keys hsh)))))

(def as-tag-attrs (attrs)

(let hsh (or attrs (hash))
  (j:map (fn (k) " ~|k|='~(joinstr " " hsh.,k)'")
     (hash-keys hsh))))

(def html-tag/ (name attrs) “<~|name|~(as-tag-attrs attrs)/>”) (def html-tag (name attrs . content)

(let formatted (map default-format content)
  "<~|name|~(as-tag-attrs attrs)>~(j formatted)</~|name|>"))

(def img (src) (html-tag/ “img” { src src })) (def link-to (txt path attrs) (html-tag “a” (hash-merge { href path } (or attrs (hash))) txt)) (def html-tag-fn (name attrs) (fn content (apply html-tag name attrs content)))

(def build-html-tag-fn (tagname attrs)

(if (string-match tagname ".+/$")
    `(curry html-tag/ ,(string-replace "/$" "" tagname) ,(if attrs `(brace-list ,@attrs)))
    `(curry html-tag ,tagname ,(if attrs `(brace-list ,@attrs)))))

(def html-percent-syntax (tagname attrs)

(if (caris 'dot-syntax tagname)
    (let dot-params (cdr tagname)
      (build-html-tag-fn (to-string:car dot-params)
                         (+ `(class ,(joinstr " " (cdr dot-params))) attrs)))
    (build-html-tag-fn (to-string tagname) attrs)))

(mac percent-syntax (empty . names)

(let name (car names)
  (if (caris 'colon-syntax name)
      `(colon-syntax ,(html-percent-syntax (cadr name) nil) ,@(cddr name))
      (html-percent-syntax name nil))))

(define-prefix-list-macro “^%.+” vars expr

; allows (%a(href "/fr/index") "click" name)
; as shortcut for (html-tag "a" { href "/fr/index" } "click " name)
(let tag-name (car:parse:j:cdr:string-split vars)
  (html-percent-syntax tag-name expr)))

(mac link-if-txt (txt path attrs)

(w/uniq link-txt
        `(let ,link-txt ,txt
           (if ,link-txt (link-to ,link-txt ,path ,attrs)))))

(dox-add-doc 'textile-to-html 'def '(“assumes 'arg is a string in Textile format, converts to html and returns the result”) '(arg)) (dox-add-doc 'haml-to-html 'def '(“assumes 'arg is a string in HAML format, converts to html and returns the result” ) '(arg))

(def to-url-params (hsh)

(joinstr "&" (map λk(joinstr "=" k hsh.,k) (hash-keys hsh))))

(def to-url (base params)

(joinstr "?" (reject !present? (list base (to-url-params params)))))

(def hesc (txt)

(string-replace ">" ">"
  (string-replace "<" "&lt;"
    (string-replace "&" "&amp;" txt))))

(def/cycler rowclass (oddrow evenrow))