aliens/tekuti
1
0
Fork 0
Code Activity

Merge branch 'bootstrap' into personal

Browse source
This commit is contained in:
Tom Willemsen 2012-09-10 11:08:48 +02:00
commit 5c7f24773c
2 changed files with 124 additions and 79 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

173
tekuti/page-helpers.scm
View file

@ -42,7 +42,7 @@
relurl rellink relurl rellink
post-url post-url
post-editing-form post-editing-form
sidebar-ul top-tags tag-cloud top-tags tag-cloud
main-sidebar post-sidebar related-tag-cloud main-sidebar post-sidebar related-tag-cloud
post-link admin-post-url admin-post-link post-link admin-post-url admin-post-link
show-post with-authentication show-post with-authentication
@ -154,47 +154,70 @@
(form (@ (method "POST") (form (@ (method "POST")
(action ,(if post (action ,(if post
(relurl `("admin" "modify-post" ,(post-key post))) (relurl `("admin" "modify-post" ,(post-key post)))
(relurl '("admin" "new-post"))))) (relurl '("admin" "new-post"))))
(p (input (@ (name "title") (type "text") (class "form-horizontal"))
(value ,(if post (post-title post) "")))) (div (@ (class "control-group"))
(label (@ (for "title")) " <- title")) (label (@ (class "control-label") (for "title")) "Title")
(p (input (@ (name "tags") (type "text") (div (@ (class "controls"))
(value ,(if post (input (@ (type "text") (name "title") (id "title")
(string-join (post-tags post) ", ") (value ,(if post (post-title post) ""))
"")))) (class "span6")
(label (@ (for "tags")) " <- tags, comma-separated")) (placeholder "New post")))))
(p (input (@ (name "date") (type "text") (div (@ (class "control-group"))
(value ,(if (and=> post post-published?) (label (@ (class "control-label") (for "tags"))
(timestamp->rfc822-date (post-timestamp post)) "Tags, comma-separated")
"")))) (div (@ (class "controls"))
(label (@ (for "date")) " <- date (empty == now)")) (input (@ (type "text") (name "tags") (id "tags")
(p (input (@ (name "comments") (type "checkbox") (value ,(if post
,@(if (or (not post) (post-comments-open? post)) (string-join (post-tags post)
`((checked "checked")) '()))) ", ")
(label (@ (for "comments")) " comments open?")) ""))
(div (textarea (@ (name "body") (rows "20") (cols "60")) (class "span6")))))
,(if post (post-raw-content post) ""))) (div (@ (class "control-group"))
(input (@ (type "submit") (name "status") (label (@ (class "control-label") (for "date"))
(value "publish"))) "Date (empty == now)")
" " (div (@ (class "controls"))
(input (@ (type "submit") (name "status") (input (@ (type "text") (name "date") (id "date")
(value "draft")))) (value ,(if (and=> post post-published?)
(timestamp->rfc822-date
(post-timestamp post))
""))
(class "span6") (placeholder "Now")))))
(div (@ (class "control-group"))
(div (@ (class "controls"))
(label (@ (class "checkbox"))
(input (@ (type "checkbox") (name "comments")
,@(if
(or (not post)
(post-comments-open? post))
`((checked "checked")) '())))
" comments open?")))
(div (@ (class "control-group"))
(div (@ (class "controls"))
(textarea (@ (name "body") (rows "20") (cols "60")
(class "span6"))
,(if post (post-raw-content post) ""))))
(div (@ (class "control-group"))
(div (@ (class "controls"))
(input (@ (type "submit") (name "status")
(value "publish")
(class "btn btn-primary")))
" "
(input (@ (type "submit") (name "status")
(value "draft") (class "btn"))))))
,@(if post ,@(if post
`((form (@ (method "POST") `((form (@ (method "POST")
(action ,(relurl `("admin" "delete-post" ,(post-key post))))) (action ,(relurl `("admin" "delete-post" ,(post-key post)))))
" " " "
(input (@ (type "submit") (name "delete") (value "delete")))) ,@(let ((l (comments-sxml-content-edit post)))
,@(let ((l (comments-sxml-content-edit post))) (if (null? l) l
(if (null? l) l `((h2 "comments")
`((h2 "comments") (ol (@ (class "commentlist")) ,@l))))
(ol (@ (class "commentlist")) ,@l)))) (h2 "preview")
(h2 "preview") ,(show-post post #f)
,(show-post post #f)) (input (@ (type "submit") (name "delete")
'()))) (value "delete") (class "btn btn-primary")))))
'())))
(define (sidebar-ul body)
`(div (@ (id "menu"))
(ul ,@body)))
(define (admin-post-url post) (define (admin-post-url post)
(relurl `("admin" "posts" ,(post-key post)))) (relurl `("admin" "posts" ,(post-key post))))
@ -214,25 +237,43 @@
(define (comment-form post author email url comment) (define (comment-form post author email url comment)
`(form `(form
(@ (action ,(post-url post)) (method "POST")) (@ (action ,(post-url post)) (method "POST")
(p (input (@ (type "text") (name "author") (value ,author) (class "form-horizontal"))
(size "22") (tabindex "1"))) (div (@ (class "control-group"))
" " (label (@ (for "author")) (small "Name"))) (label (@ (class "control-label") (for "author")) "Name")
(p (input (@ (type "text") (name "email") (value ,email) (div (@ (class "controls"))
(size "22") (tabindex "2"))) (input (@ (type "text") (name "author") (id "author")
" " (label (@ (for "email")) (small "Mail (will not be published)"))) (value ,author) (tabindex "1") (class "span6")
(p (input (@ (type "text") (name "url") (value ,url) (placeholder "Your Name")))))
(size "22") (tabindex "3"))) (div (@ (class "control-group"))
" " (label (@ (for "url")) (small "Website"))) (label (@ (class "control-label") (for "email"))
(p (input (@ (type "text") (name "x") (value "") "Mail (will not be published)")
(size "22") (tabindex "3"))) (div (@ (class "controls"))
" " (label (@ (for "x")) (small "What's your favorite number?"))) (input (@ (type "text") (name "email") (id "email")
;(p (small "allowed tags: ")) (value ,email) (tabindex "2") (class "span6")
(p (textarea (@ (name "comment") (id "comment") (cols "65") (placeholder "you@somehost.com")))))
(rows "10") (tabindex "4")) (div (@ (class "control-group"))
,comment)) (label (@ (class "control-label") (for "url")) "Website")
(p (input (@ (name "submit") (type "submit") (id "submit") (tabindex "5") (div (@ (class "controls"))
(value "Submit Comment")))))) (input (@ (type "text") (name "url") (id "url")
(value ,url) (tabindex "3") (class "span6")
(placeholder "http://your.website.com")))))
(div (@ (class "control-group"))
(label (@ (class "control-label") (for "x"))
"What's your favorite number?")
(div (@ (class "controls"))
(input (@ (type "text") (name "x") (id "x") (value "")
(tabindex "3") (class "span6")))))
(div (@ (class "control-group"))
(div (@ (class "controls"))
(textarea (@ (name "comment") (id "comment") (cols "65")
(rows "10") (tabindex "4") (class "span6"))
,comment)))
(div (@ (class "control-group"))
(div (@ (class "controls"))
(button (@ (type "submit") (class "btn btn-primary")
(name "submit") (id "submit") (tabindex "5"))
"Submit Comment")))))
(define (comments-sxml-content-edit post) (define (comments-sxml-content-edit post)
(map (map
@ -336,17 +377,13 @@
,@(tag-cloud (top-tags index 30)))) ,@(tag-cloud (top-tags index 30))))
(define (post-sidebar post index) (define (post-sidebar post index)
(sidebar-ul `((h2 (a (@ (href ,(relurl '("feed" "atom"))))
`((li (h2 (a (@ (href ,(relurl '("feed" "atom")))) "subscribe "))
"subscribe " (h2 "related")
(img (@ (src ,(relurl '("wp-content" "feed-icon-14x14.png"))) (ul ,@(map (lambda (post-and-tags)
(alt "[feed]"))) `(li (@ (style "margin-top: 5px"))
))) ,(post-link (car post-and-tags))))
(li (h2 "related") (take-max (compute-related-posts post index) 10)))))
(ul ,@(map (lambda (post-and-tags)
`(li (@ (style "margin-top: 5px"))
,(post-link (car post-and-tags))))
(take-max (compute-related-posts post index) 10)))))))
(define (related-tag-cloud tag index) (define (related-tag-cloud tag index)
`(div (@ (id "tag-cloud")) `(div (@ (id "tag-cloud"))

30
tekuti/page.scm
View file

@ -84,14 +84,17 @@
`(li ,(rellink `("admin" "changes" ,(car rev)) `(li ,(rellink `("admin" "changes" ,(car rev))
(caddr rev)))) (caddr rev))))
(git-rev-list "refs/heads/master" n))) (git-rev-list "refs/heads/master" n)))
(respond `(,(sidebar-ul `((li (h2 "posts " ,(rellink '("admin" "posts") (respond `((div (@ (class "row"))
">>")) (div (@ (class "span9"))
(ul ,@(post-links 5))) (h2 "new post")
(li (h2 "changes" ,(rellink '("admin" "changes") ,(post-editing-form #f))
">>")) (div (@ (class "span3"))
(ul ,(recent-changes 5))))) (h2 "posts " ,(rellink '("admin" "posts")
(h2 "new post") ">>"))
,(post-editing-form #f)))))) (ul ,@(post-links 5))
(h2 "changes " ,(rellink '("admin" "changes")
">>"))
(ul ,(recent-changes 5)))))))))
(define (page-admin-posts request body index) (define (page-admin-posts request body index)
(with-authentication (with-authentication
@ -174,7 +177,9 @@
(pre ,(git "diff-tree" "-M" "-p" sha1)) (pre ,(git "diff-tree" "-M" "-p" sha1))
(form (@ (action ,(relurl `("admin" "revert-change" ,sha1))) (form (@ (action ,(relurl `("admin" "revert-change" ,sha1)))
(method "POST")) (method "POST"))
(input (@ (type "submit") (value "Undo this change")))))))))) (input (@ (type "submit")
(class "btn btn-primary")
(value "Undo this change"))))))))))
(define (page-admin-revert-change request body index sha1) (define (page-admin-revert-change request body index sha1)
@ -202,8 +207,11 @@
(cond (cond
((post-from-key index (make-post-key year month day post)) ((post-from-key index (make-post-key year month day post))
=> (lambda (post) => (lambda (post)
(respond `(,(post-sidebar post index) (respond `((div (@ (class "row"))
,(show-post post #t)) (div (@ (class "span9"))
,(show-post post #t))
(div (@ (class "span3"))
,(post-sidebar post index))))
#:title (string-append (post-title post) " -- " *title*) #:title (string-append (post-title post) " -- " *title*)
#:etag (assq-ref index 'master)))) #:etag (assq-ref index 'master))))
(else (else