picowiki

commit 7817e97a03724e188f2331281c7297a7b8ac5957
parent 856d71f5b17c58c2a7cb662480d0c4cb0a6affb3
Author: tomas <tomas@logand.com>
Date:   Thu, 22 Jul 2010 19:36:21 +0200

picowiki.l updated

Diffstat:
M
picowiki.l
 | 
31
++++++++++++++++++++++++-------

1 file changed, 24 insertions(+), 7 deletions(-)
diff --git a/picowiki.l b/picowiki.l
@@ -42,8 +42,7 @@
                (zero S))))
       (cons N S)))
 
-(de _markupCmd ()
-   (char)
+(de _markupCmd (Type)
    (case (peek)
       ("\\" (char))
       ("\<" (char))
@@ -55,24 +54,37 @@
       ("{"
          (char)
          (prog1
-            (cons 'lnk
+            (cons (or Type 'lnk)
                (make
                   (while (till "} ^I^M^J" T)
                      (link @)
                      (skip))))
             (char)))
+#      ("#"
+#         (char)
+#         (when (= "{" (peek))
+#            (_markupCmd 'a)))
 #      (T
 #       (case (till "{" T)
 #          ("b" (cons 'b (till "}" T)))))
 ))
 
+(de till2 (End Pack)
+   (let (X NIL
+         E (flip (chop End))
+         N (length E))
+      (until (or (eof) (= (head N X) E))
+         (push 'X (char)))
+      (setq X (flip (nth X (+ N 1))))
+      (if Pack (pack X) X)))
+
 (de _markupXml (End)
    (char)
    (let? C (till ">" T)
       (char)
       (unless (= C End)
          (if (member C '("pre" "lisp"))
-            (cons C (prog1 (till "<" T) (till ">") (char)))
+            (cons C (till2 (pack "</" C ">")))
             (cons C (_markup (pack "/" C)))))))
                
 (de _markup (End)
@@ -85,6 +97,7 @@
                         (while (and (not Eop)
                                     (case (peek)
                                        ("\\"
+                                          (char)
                                           (let? X (_markupCmd)
                                              (when Space (link NIL))
                                              (link X)))
@@ -162,7 +175,7 @@
    (if (info (pageFile Page))
       (<href2> 'i Page Page)
       (ht:Prin Page)
-      (<href2> 'i "?" (pack Page "?e"))))
+      (<sup> (<href2> 'i "?" (pack Page "?e")))))
             
 (de markup (Lst Par)
    (for (I . P) Lst
@@ -182,6 +195,9 @@
                          (<href2> 'e (or (glue " " (cdr B)) (car B)) (car B)))
                         (T
                          (<ilink> (glue " " B)))))
+#                  (a
+#                     (prinl "<a name=\"" (car B) "\" class=\"a\">"
+#                        (or (glue " " (cdr B)) (car B)) "</a>"))
                   (nbsp (<nbsp>))
                   (hr (<hr>))
                   (("ul" "ol")
@@ -495,7 +511,8 @@
 
 (de cookies ()
    (mapcar '((X) (mapcar pack (split (chop X) "=")))
-      (mapcar pack (split (chop (sys "HTTP_COOKIE")) ";"))))
+      (mapcar pack
+         (mapcar clip (split (chop (sys "HTTP_COOKIE")) ";")))))
 
 #      P (or (if (pre? "@" Q) (pack (cdr (chop Q))) Q) "picoWiki") #####
 #      E (pre? "@" Q)) ###
@@ -504,7 +521,7 @@
       C (cookies)
       P (or (pack (cdr (chop (sys "PATH_INFO")))) "picoWiki")
       E (= "e" Q))
-   (setq P (_htDecode (chop P)))
+   (setq P (ht:Pack (chop P))) #(_htDecode (chop P)))
    (let? N (cadr (find '((X) (= (car X) "picoWiki.n")) C))
       (setq *N N)
       (on *R))