commit ab7cd9729a4c1776f54b50ee09f1909926282f8a parent ac7c244a1836e0cd1a59f17b3f91da59183a32a9 Author: tomas <tomas@logand.com> Date: Fri, 30 Jul 2010 09:23:40 +0200 additional markup changes Diffstat:
| M | picowiki.l | | | 164 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------------------- |
1 file changed, 121 insertions(+), 43 deletions(-)
diff --git a/picowiki.l b/picowiki.l @@ -271,14 +271,29 @@ (de markupLine (L) (when L (while L - (let W (eatWikiName 'L) - (if W - (if (cadr W) # at least 2 names - (markupLink W) - (xprin W) ) - (if (eatUrl 'L) - (markupUrl @) - (xprin (pop 'L)) ) ) ) ) ) ) + (ifn (= "=" (car L)) #(member (car L) '`(chop "=*/")) + (let W (eatWikiName 'L) + (if W + (if (cadr W) # at least 2 names + (markupLink W) + (xprin W) ) + (if (eatUrl 'L) + (markupUrl @) + (xprin (pop 'L)) ) ) ) + (case (pop 'L) # TODO these only starting outside words + ("=" + (<xml> code + (while (and (car L) (not (= "=" (car L)))) + (xprin (pop 'L)) ) ) ) + ("*" + (<xml> b + (while (and (car L) (not (= "*" (car L)))) + (xprin (pop 'L)) ) ) ) + ("/" + (<xml> i + (while (and (car L) (not (= "/" (car L)))) + (xprin (pop 'L)) ) ) ) ) + (pop 'L) ) ) ) ) (de eatLine (V N) # TODO w/o make (when N @@ -297,42 +312,105 @@ (inc 'N) ) N ) ) +## (de parseToc (L) +## (make +## (while L +## (cond +## ((head '("=" " ") L) +## (link (eatLine 'L 2)) +## (while (and (car L) (head '("=" " ") L)) +## (link (eatLine 'L 2)) ) +## ((head '("=" "=" " ") L) (link (eatLine 'L 3))) +## ((head '("=" "=" "=" " ") L) (link (eatLine 'L 4))) +## (T (eatLine 'L)) ) ) ) ) ) + (de markupText (L) - (while L - (cond - ((= "^J" (car L)) (pop 'L)) - ((head '("=" " ") L) (<xml> h2 (xprin (eatLine 'L 2)))) - ((head '("=" "=" " ") L) (<xml> h3 (xprin (eatLine 'L 3)))) - ((head '("=" "=" "=" " ") L) (<xml> h4 (xprin (eatLine 'L 4)))) - ((head '("=" "=" "=" "=" "=") L) (eatLine 'L) (<xml> hr)) - ((= " " (car L)) - (<xml> pre - (while (= " " (car L)) - (xprin (eatLine 'L) "^J") ) ) ) - ((= 1 (listLevel L)) - (let N 1 - (recur (N) - (let li '(() (if (listMarkup? (car L)) - (recurse (+ 1 N)) - (<xml> li (markupLine (eatLine 'L))) - (while (<= N (listLevel L)) - (if (= N (listLevel L)) - (<xml> li (markupLine (eatLine 'L N)) ) - (cut N 'L) - (recurse (+ 1 N)) ) ) ) ) - (if (= "-" (pop 'L)) - (<xml> ul (li)) - (<xml> ol (li)) ) ) ) ) ) - ((= ">" (car L)) (<xml> blockquote (xprin (eatLine 'L 1)))) - ((= "|" (car L)) # TODO table - (<xml> pre - (while (= "|" (car L)) - (xprin (eatLine 'L) "^J") ) ) ) - (T (<xml> p - (markupLine (eatLine 'L)) - (while (and (car L) (not (member (car L) '`(chop "= -+^J")))) - (<xml> br) - (markupLine (eatLine 'L)) ) ) ) ) ) ) + (let (Toc NIL H1 NIL Pre) + (while L + (cond + ((= "^J" (car L)) (pop 'L)) + ((head '("#" "+" "t" "o" "c" "^J") L) + (eatLine 'L) + (setq Toc '("one" "two" "three")) ) # TODO + ((or (head '`(chop "#+pre text") L) + (head '`(chop "#+pre java") L) ) + (setq Pre (pack (eatLine 'L 6))) ) + ((head '("=" " ") L) + (when (and Toc (not H1)) + (<xml> h2 (xprin "Contents ") + (<xml> a class "a" href "#0" NIL "⚓") ) # TODO anchor numbering + (<xml> ul + (for X Toc + (<xml> li (xprin X)) ) ) ) + (on H1) + (<xml> h2 (xprin (eatLine 'L 2) " ") + (<xml> a class "a" href "#0" NIL "⚓") ) ) + ((head '("=" "=" " ") L) + (<xml> h3 (xprin (eatLine 'L 3) " ") + (<xml> a class "a" href "#0" NIL "⚓") ) ) + ((head '("=" "=" "=" " ") L) + (<xml> h4 (xprin (eatLine 'L 4) " ") + (<xml> a class "a" href "#0" NIL "⚓") ) ) + ((head '("=" "=" "=" "=" "=") L) (eatLine 'L) (<xml> hr)) + ((= " " (car L)) + (<xml> pre style (case Pre + ("text" "background-color:#f7f5f3;border:1pt solid #ccbdae;padding:0.5em") + ("java" "background-color:#f3f5f7;border:1pt solid #aebdcc;padding:0.5em") ) + (let N 0 + (while (= " " (car L)) + (do N (xprin "^J")) + (xprin (eatLine 'L 1) "^J") + (setq N 0) + (while (= "^J" (car L)) + (pop 'L) + (inc 'N) ) ) ) ) ) + ((= 1 (listLevel L)) + (let N 1 + (recur (N) + (let (li '((N) + (markupLine (eatLine 'L N)) + (while (= "." (car L)) + (pop 'L) + (case (car L) + ((= "^J" (car L)) (pop 'L)) + ((= " " (car L)) + (<xml> pre style (case Pre + ("text" "background-color:#f7f5f3;border:1pt solid #ccbdae;padding:0.5em") + ("java" "background-color:#f3f5f7;border:1pt solid #aebdcc;padding:0.5em") ) + # TODO like pre above + (xprin (eatLine 'L 1) "^J") + (while (head '("." " ") L) + (xprin (eatLine 'L 2) "^J") ) ) ) + (T (<xml> p + (markupLine (eatLine 'L)) + (while (and (= "." (car L)) + (not (member (cadr L) + '`(chop " ^J") ) ) ) + (<xml> br) + (markupLine (eatLine 'L 1)) ) ) ) ) ) ) + lic '(() + (if (listMarkup? (car L)) + (recurse (+ 1 N)) + (<xml> li (li)) + (while (<= N (listLevel L)) + (if (= N (listLevel L)) + (<xml> li (li N)) + (cut N 'L) + (recurse (+ 1 N)) ) ) ) ) ) + (if (= "-" (pop 'L)) + (<xml> ul (lic)) + (<xml> ol (lic)) ) ) ) ) ) + ((= ">" (car L)) + (<xml> blockquote (xprin (markupLine (eatLine 'L 1)))) ) + ((= "|" (car L)) # TODO table + (<xml> pre + (while (= "|" (car L)) + (xprin (eatLine 'L) "^J") ) ) ) + (T (<xml> p + (markupLine (eatLine 'L)) + (while (and (car L) (not (member (car L) '`(chop "= -+^J")))) + (<xml> br) + (markupLine (eatLine 'L)) ) ) ) ) ) ) ) (de markupBlob (Blob) (when (info Blob)