Skip to content

Instantly share code, notes, and snippets.

Created Feb 7, 2011
What would you like to do?
An increasingly complete version of Textile for Arc. Works, but still todo: links, images, footnotes, span attributes, lists.
; Textile for Arc, version 0.1
; by David Kendal
; still todo as of this version: links, images, lists, span attributes, footnotes
; also: internal preflight routine to normalise line endings, strip BOM, etc.
; known bugs: subscript not working due to use of tilde sign in function name
(load "lib/re.arc")
(= txt-block-names* (list "h[1-6]" "bq" "fn[0-9]+" "p" "bc" "pre")
txt-block-re* (string "(" (joinstr txt-block-names* "|") ")")
txt-blocktag-re* (string "^" txt-block-re* "(.*?)" #\\ ".(" #\\ ".?)" #\\ "s+")
txt-attr-lang* (string #\\ "[([a-zA-Z-]{1,5})" #\\ "]")
txt-attr-class* (string #\\ "((.+?)" #\\ ")")
txt-attr-style* (string #\\ "{(.+?)" #\\ "}")
txt-std-spans* (obj "**" "b" "__" "i"
"*" "strong" "_" "em"
"-" "del" "+" "ins" "??" "cite"
"^" "sup" ; "~" "sub" -- tilde causes problems -- special case needs to be made.
"%" "span" "@" "code"))
(def textile (text)
(trim (joinstr (txt-block
(txt-spans text)) "\n\n") 'both))
(def txt-block (text)
(flat ; some shorthand features require splicing
(= ext? nil tag "p" xattrs "" content "") ; todo -- fixme so not to use globals
txt-html-block (str-split text "\n\n"))))
(def txt-html-block (text)
(with (bname (cadr (re-match-pat (string "^" txt-block-re*) text)) retcon "")
(if bname ; if there's a tag name...
(let (_ _ txtattrs txtext?) (re-match-pat txt-blocktag-re* text)
(when ext? ; when the previous tag is an extended block
(= retcon (string (txt-do-tag content tag (txt-pa xattrs)) "\n\n")
ext? nil tag "p" content "" xattrs "" tag))
(with (txtcontent (re-replace txt-blocktag-re* text "") battr (txt-pa txtattrs))
(if (not (empty txtext?))
(do (= ext? t tag bname xattrs txtattrs content txtcontent) nil)
(string retcon (if
(re-match-pat "^h([1-6])$" bname)
(txt-h txtcontent bname battr)
(re-match-pat "^fn([0-9]+)$" bname)
(txt-fn txtcontent bname battr)
(txt-do-tag txtcontent bname battr))))))
ext? ; else, if there's no tag name and we're in an extended block
(do (= content (string content "\n\n" text)) nil)
(txt-p text "p" "") ; otherwise, do an ordinary paragraph tag
(def txt-pa (attr) ; "Parse Attributes"
(with (class nil id "" lang "" style nil)
(while (re-match (string "^(?:" txt-attr-lang* "|" txt-attr-class* "|" txt-attr-style* ")") attr)
(re-match-pat (string "^" txt-attr-lang*) attr)
(= lang (txt-lang attr)
attr (re-replace (string "^" txt-attr-lang*) attr ""))
(re-match-pat (string "^" txt-attr-class*) attr)
(= class (cons (txt-class attr) class)
attr (re-replace (string "^" txt-attr-class*) attr ""))
(re-match-pat (string "^" txt-attr-style*) attr)
(= style (cons (txt-style attr) style)
attr (re-replace (string "^" txt-attr-style*) attr ""))
; (= class
; (flat (map [tokens _] class)))
; assemble html attributes
(when (isnt "" lang) (string " lang=\"" lang "\""))
(when class (string " class=\"" (joinstr class " ") "\""))
(when style (string " style=\"" (joinstr style ";") "\""))
(def txt-simple-block (text) ; todo
(string "<p>" (joinstr (str-split text "\n\n") "</p>\n\n<p>") "</p>"))
(def txt-spans (text)
(each (span tag) txt-std-spans*
(= text (eval `(,(sym (string "txt-" span)) ,text)))) text)
(def txt-span (text st et tag) ; st = start textile; et = end textile -- todo: support span attributes
(re-replace (string (txt-re-quote st) "(\\S.*?\\S?)" (txt-re-quote et)) text (string "<" tag ">" #\\ 1 "</" tag ">")))
(def txt-re-quote (text)
(re-replace "(\\.|\\\\|\\+|\\*|\\?|\\[|\\]|\\$|\\(|\\)|\\{|\\}|\\=|\\!|\\<|\\>|\\||\\:|-)" text (string #\\ #\\ #\\ 1)))
(def txt-html-chars (text)
(multisubst '(("&" "&amp;") ("<" "&lt;") (">" "&gt;") ("\"" "&quot;")) text)) ; "&amp; must go before all others
(def txt-lang (attr)
(cadr (re-match-pat (string "^" txt-attr-lang*) attr)))
(def txt-class (attr)
(cadr (re-match-pat (string "^" txt-attr-class*) attr)))
(def txt-style (attr)
(cadr (re-match-pat (string "^" txt-attr-style*) attr)))
(each (txt html) txt-std-spans*
(eval `(def ,(sym (string "txt-" txt)) (text)
(txt-span text ,txt ,txt ,html))))
(def txt-do-tag (text bname battr)
(eval `(,(sym (string "txt-" bname)) ,text ,bname ,battr)))
(def txt-h (text bname battr)
(string "<" bname battr ">" text "</" bname ">"))
(def txt-p (text bname battr)
(string "<p" battr ">" text "</p>"))
(def txt-bq (text bname battr)
(string "<blockquote" battr ">" (txt-simple-block text) "</blockquote>"))
(def txt-bc (text bname battr)
(string "<pre" battr "><code" battr ">" (txt-html-chars text) "</code></pre>"))
(def txt-pre (text bname battr)
(string "<pre" battr ">" (txt-html-chars text) "</pre>"))
(def str-split (blob delim) ; hacky
(subst "\x01" delim blob) #\u0001))
(def not (what) (if what nil t))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment