96 lines
2.2 KiB
Plaintext
96 lines
2.2 KiB
Plaintext
; Blog tool example. 20 Jan 08, rev 21 May 09.
|
|
|
|
; To run:
|
|
; arc> (load "blog.arc")
|
|
; arc> (bsv)
|
|
; go to http://localhost:8080/blog
|
|
|
|
(= postdir* "arc/posts/" maxid* 0 posts* (table))
|
|
|
|
(= blogtitle* "A Blog")
|
|
|
|
(deftem post id nil title nil text nil)
|
|
|
|
(def load-posts ()
|
|
(each id (map int (dir postdir*))
|
|
(= maxid* (max maxid* id)
|
|
(posts* id) (temload 'post (string postdir* id)))))
|
|
|
|
(def save-post (p) (save-table p (string postdir* p!id)))
|
|
|
|
(def post (id) (posts* (errsafe:int id)))
|
|
|
|
(mac blogpage body
|
|
`(whitepage
|
|
(center
|
|
(widtable 600
|
|
(tag b (link blogtitle* "blog"))
|
|
(br 3)
|
|
,@body
|
|
(br 3)
|
|
(w/bars (link "archive")
|
|
(link "new post" "newpost"))))))
|
|
|
|
(defop viewpost req (blogop post-page req))
|
|
|
|
(def blogop (f req)
|
|
(aif (post (arg req "id"))
|
|
(f (get-user req) it)
|
|
(blogpage (pr "No such post."))))
|
|
|
|
(def permalink (p) (string "viewpost?id=" p!id))
|
|
|
|
(def post-page (user p) (blogpage (display-post user p)))
|
|
|
|
(def display-post (user p)
|
|
(tag b (link p!title (permalink p)))
|
|
(when user
|
|
(sp)
|
|
(link "[edit]" (string "editpost?id=" p!id)))
|
|
(br2)
|
|
(pr p!text))
|
|
|
|
(defopl newpost req
|
|
(whitepage
|
|
(aform [let u (get-user _)
|
|
(post-page u (addpost u (arg _ "t") (arg _ "b")))]
|
|
(tab (row "title" (input "t" "" 60))
|
|
(row "text" (textarea "b" 10 80))
|
|
(row "" (submit))))))
|
|
|
|
(def addpost (user title text)
|
|
(let p (inst 'post 'id (++ maxid*) 'title title 'text text)
|
|
(save-post p)
|
|
(= (posts* p!id) p)))
|
|
|
|
(defopl editpost req (blogop edit-page req))
|
|
|
|
(def edit-page (user p)
|
|
(whitepage
|
|
(vars-form user
|
|
`((string title ,p!title t t) (text text ,p!text t t))
|
|
(fn (name val) (= (p name) val))
|
|
(fn () (save-post p)
|
|
(post-page user p)))))
|
|
|
|
(defop archive req
|
|
(blogpage
|
|
(tag ul
|
|
(each p (map post (rev (range 1 maxid*)))
|
|
(tag li (link p!title (permalink p)))))))
|
|
|
|
(defop blog req
|
|
(let user (get-user req)
|
|
(blogpage
|
|
(for i 0 4
|
|
(awhen (posts* (- maxid* i))
|
|
(display-post user it)
|
|
(br 3))))))
|
|
|
|
(def bsv ()
|
|
(ensure-dir postdir*)
|
|
(load-posts)
|
|
(asv))
|
|
|
|
|