commit 63a29c9ab6b488b8c81fb9816fc5e09b4b1746c7
parent 7817e97a03724e188f2331281c7297a7b8ac5957
Author: tomas <tomas@logand.com>
Date: Thu, 22 Jul 2010 19:36:59 +0200
picowiki.l updated
Diffstat:
| M | picowiki.l | | | 131 | ++++++++++++++++++++++++++++++++++++++++++++++++------------------------------- |
1 file changed, 80 insertions(+), 51 deletions(-)
diff --git a/picowiki.l b/picowiki.l
@@ -60,14 +60,12 @@
(link @)
(skip))))
(char)))
-# ("#"
-# (char)
-# (when (= "{" (peek))
-# (_markupCmd 'a)))
-# (T
-# (case (till "{" T)
-# ("b" (cons 'b (till "}" T)))))
-))
+ (T
+ (cons (till "{ ^I^M^J" T)
+ (when (= "{" (peek))
+ (prog1
+ (till "}" T) # TODO \{ inside {}
+ (char)))))))
(de till2 (End Pack)
(let (X NIL
@@ -141,9 +139,8 @@
(link (car L))
(setq L (cdr L)))))))
-(de xref (L)
- (let? Tok (xtok L)
- (let Tok2 (pack Tok)
+(de ref (Tok)
+ (let Tok2 (pack Tok)
(when (member Tok2 *Xref)
(cons
Tok2
@@ -155,8 +152,12 @@
(chop "abcdefghijklmnopqrstuvwxyz"))
(uppc (car Tok)))
(T "_"))
- ".html#" Tok))))))
-
+ ".html#" Tok)))))
+
+(de xref (L)
+ (let? Tok (xtok L)
+ (ref Tok)))
+
(de markupLisp (B)
(let X (chop B)
(while X
@@ -177,6 +178,13 @@
(ht:Prin Page)
(<sup> (<href2> 'i "?" (pack Page "?e")))))
+(de pages ()
+ (let P NIL
+ (for F (sort (dir (pageFile)))
+ (when (match '(@F "." "t" "x" "t") (chop F))
+ (push 'P (pack @F))))
+ (reverse P)))
+
(de markup (Lst Par)
(for (I . P) Lst
(unless Par
@@ -193,13 +201,21 @@
(cond
((pre? "http://" (car B))
(<href2> 'e (or (glue " " (cdr B)) (car B)) (car B)))
+ ((pre? "ref:" (car B))
+ (let X (ref (tail -4 (chop (car B))))
+ (<href2> 'ref (or (glue " " (cdr B)) (car X))
+ (cdr X))))
(T
(<ilink> (glue " " B)))))
-# (a
-# (prinl "<a name=\"" (car B) "\" class=\"a\">"
-# (or (glue " " (cdr B)) (car B)) "</a>"))
(nbsp (<nbsp>))
(hr (<hr>))
+ ("pages"
+ (<ul> NIL
+ (for P (pages)
+ (<li> NIL (<ilink> P)))))
+# ("ref"
+# (let X (ref (cdr (chop B)))
+# (<href2> 'ref (car X) (cdr X))))
(("ul" "ol")
(prin "<" H ">")
(for Li (car B)
@@ -260,12 +276,17 @@
(de renderChanges (Page)
(<div> '((class . "page changes"))
- (<h1> NIL Page)
- (let F (pageFile Page)
+ (<h1> NIL
+ (if (= "Changes" Page)
+ (ht:Prin Page)
+ (ht:Prin "'" Page "' changes")))
+ (let F (pageFile "Changes")
(ifn (info F)
(<p> NIL "No changes have been made yet.")
(let L (readChanges F)
- (for D (group L)
+ (for D (group (if (= "Changes" Page)
+ L
+ (filter '((X) (= Page (cadddr X))) L)))
(<p> NIL
(ht:Prin (httpDate2 (strDat (car D))))
(<ul> NIL
@@ -335,7 +356,7 @@
(cadr (cddar DD))
(pack N " changes"))
(car DD)))))))))))))))
-
+
(de renderEdit (Page)
(<form> "post" (pageUrl Page 'edit)
(<h1> NIL (ht:Prin "Edit '" Page "' page"))
@@ -379,32 +400,38 @@
(<submit> "Save")
(<href> ,"View page" (pageUrl Page 'view)))))
-(de render (Page Edit Preview)
+(de nbsp (S)
+ (pack (replace (chop S) " " " ")))
+
+(de render (Page Mode)
(case Page
("rss" (rss))
(T
(let F (pageFile Page)
(html
- 0 # TODO allow caching (if Edit 0 (* 60 60 24 1)) # 1 day
+ NIL # TODO allow caching (if Edit 0 (* 60 60 24 1)) # 1 day
(pack "picoWiki: " Page)
(pack "http://" *Host "/picoWiki/picoWiki.css") NIL
#==
(<form> "post" (pageUrl Page 'search)
- (<div> NIL
- "picoWiki: the picoLisp Wiki"
- " | " (<href2> 'i "Home" (pageUrl "picoWiki" 'view))
+ (<p> 'menu
+ "picoWiki:"
+ " " (<href2> 'i "Home" (pageUrl "picoWiki" 'view))
" " (<href2> 'i "Changes" (pageUrl "Changes" 'view))
" " (<href2> 'i "Formatting" (pageUrl "Formatting" 'view))
" " (<href2> 'i "Sandbox" (pageUrl "Sandbox" 'view))
+ (when (and (info F) (editablePage Page))
+ (prin " | ") (<href> ,"Edit" (pageUrl Page 'edit))
+ (prin " ") (<href> ,"History" (pageUrl Page 'changes)))
" " (<field> 20 '*Q) (<submit> "Search")))
(<hr>)
(case Page
("Changes" (renderChanges Page))
- (T (if Edit
- (if Preview
- (renderPreview Page)
- (renderEdit Page))
- (renderView Page))))
+ (T (case Mode
+ (view (renderView Page))
+ (edit (renderEdit Page))
+ (preview (renderPreview Page))
+ (changes (renderChanges Page)))))
(<hr>)
(<p> NIL
"This page is linked from:"
@@ -412,13 +439,8 @@
(unless (= P Page)
(prin " ") (<href2> 'i P (pageUrl P 'view)))))
(<p> NIL
- (when (editablePage Page)
- (<href> ,"Edit page" (pageUrl Page 'edit)))
(when (info F)
- (when (editablePage Page)
- (prin " | "))
- (<href> ,"View source" (pageUrl Page 'source))
- (prin " | Revisions: ")
+ (prin "Revisions: ")
(let (V (latestVersion Page)
C V)
(for N '(9 8 7 6 5 4 3 2 1 0)
@@ -427,18 +449,22 @@
(prin " ")
(if (= W C)
(<b> W)
- (prin W)))))))
- (prin " | ")
+ (prin W))))))
+ (prin " ")
+ (<href> ,"View source" (pageUrl Page 'source))
+ (prin " XHTML")
+ (<sup>
+ (<href2> 'e "V"
+ (pack "http://validator.w3.org/check?uri="
+ "http://" *Host "/picoWiki/" (pageUrl Page 'view))))
+ (prin " | "))
+ (<ilink> "All")
+ " "
(<href> ,"RSS" (pageUrl "rss" 'view))
(<sup>
(<href2> 'e "V"
(pack "http://feedvalidator.org/check.cgi?url="
- "http://" *Host "/picoWiki/" (pageUrl "rss" 'view))))
- (prin " XHTML")
- (<sup>
- (<href2> 'e "V"
- (pack "http://validator.w3.org/check?uri="
- "http://" *Host "/picoWiki/" (pageUrl Page 'view)))))
+ "http://" *Host "/picoWiki/" (pageUrl "rss" 'view)))))
(<p> NIL
"picoWiki pages can be edited by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively"))))))
@@ -506,8 +532,9 @@
(case Mode
(source (pack "/picoWiki/pages/" Page ".txt"))
(view Page)
+ (search "?s")
(edit (pack Page "?e"))
- (search "?s")))
+ (changes (pack Page "?c"))))
(de cookies ()
(mapcar '((X) (mapcar pack (split (chop X) "=")))
@@ -515,18 +542,20 @@
(mapcar clip (split (chop (sys "HTTP_COOKIE")) ";")))))
# P (or (if (pre? "@" Q) (pack (cdr (chop Q))) Q) "picoWiki") #####
-# E (pre? "@" Q)) ###
(let (M (sys "REQUEST_METHOD")
Q (sys "QUERY_STRING")
C (cookies)
- P (or (pack (cdr (chop (sys "PATH_INFO")))) "picoWiki")
- E (= "e" Q))
+ P (or (pack (cdr (chop (sys "PATH_INFO")))) "picoWiki"))
(setq P (ht:Pack (chop P))) #(_htDecode (chop P)))
(let? N (cadr (find '((X) (= (car X) "picoWiki.n")) C))
(setq *N N)
(on *R))
(ifn (= "POST" M)
- (render P E)
+ (render P
+ (case Q
+ ("e" 'edit)
+ ("c" 'changes)
+ (T 'view)))
(for X (post)
(case (pack (car X))
("*T" (setq *T (_htDecode (cadr X))))
@@ -537,11 +566,11 @@
("*Q" (setq *Q (_htDecode (cadr X))))
("*P" (setq *P (_htDecode (cadr X))))))
(ifn (and *T *S (= "pico" *C) *N)
- (render P E)
+ (render P 'edit)
(ifn *P
(prog
(cookie "picoWiki.n" (when *R *N))
- (render P E T))
+ (render P 'preview))
(writePage P *T *S *N)
(redirect P)))))
