aliens/tekuti
1
0
Fork 0
Code Activity

minor tweaks

Browse source
This commit is contained in:
Andy Wingo 2008-02-28 00:29:23 +01:00
parent 93605cf634
commit 384132878a
6 changed files with 20 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
tekuti/filters.scm
View file

@ -84,7 +84,7 @@
(let ((sxml (cadr (with-input-from-string (string-append "<div>" text "</div>")
xml->sxml))))
(pre-post-order
(pk sxml)
sxml
`((*default* . ,(lambda (tag . body)
(if (can-contain-p? tag)
(wpautop tag body)

16
tekuti/page.scm
View file

@ -234,7 +234,6 @@
(define (page-index request index)
(rcons* request
'title "my bloggidy blog"
'body `(,(main-sidebar request index)
,@(map (lambda (post)
(show-post post #f))
@ -248,7 +247,8 @@
=> (lambda (tree)
(let ((post (post-from-tree slug tree)))
(rcons* request
'title (assq-ref post 'title)
'title (string-append (assq-ref post 'title)
" -- " *title*)
'body (show-post post #t)))))
(else
(page-not-found request index)))))
@ -269,7 +269,9 @@
(else
(let ((comment (make-new-comment (post-from-tree slug tree) data)))
(rcons* request
'body `((p "hey hey hey like fat albert" ,comment))))))))
'title "comment posted"
'body `((p "Comment, posted, thanks.")
(p "Back to the post: " (post-link post)))))))))
(else
(page-not-found request index)))))
@ -317,10 +319,9 @@
(lambda (x) #f))
(let lp ((posts (assq-ref index 'posts)))
(pk 'foo (or (null? posts) (car posts)))
(cond ((or (null? posts) (too-early? (car posts)))
(rcons* request
'title "no posts found"
'title *title*
'body `((h1 "No posts found")
(p "No posts were found in the specified period."))))
((early-enough? (car posts))
@ -328,7 +329,7 @@
(cond
((or (null? posts) (too-early? (car posts)))
(rcons* request
'title "archives"
'title (string-append "archives -- " *title*)
'body (reverse out)))
((new-header (car posts))
=> (lambda (sxml)
@ -346,7 +347,7 @@
(define (page-debug request index)
(rcons* request
'title "hello"
'title "debug"
'body `((p "hello world!")
(table
(tr (th "header") (th "value"))
@ -427,4 +428,3 @@
(div (@ (xmlns "http://www.w3.org/1999/xhtml"))
,(post-sxml-content post)))))
(take-max (assq-ref index 'posts) 10))))))))

4
tekuti/post.scm
View file

@ -126,7 +126,7 @@
(size "22") (tabindex "3")))
" " (label (@ (for "url")) (small "Website")))
;(p (small "allowed tags: "))
(p (textarea (@ (name "comment") (id "comment") (cols "100%")
(p (textarea (@ (name "comment") (id "comment") (cols "65")
(rows "10") (tabindex "4"))
,comment))
(p (input (@ (name "submit") (type "submit") (id "submit") (tabindex "5")
@ -147,7 +147,7 @@
`(li (@ (class "alt") (id ,(assq-ref comment 'key)))
(cite ,(let ((url (assq-ref comment 'author_url))
(name (assq-ref comment 'author)))
(if url
(if (and url (not (string-null? url)))
`(a (@ (href ,url) (rel "external nofollow")) ,name)
name)))
" says:" (br)

2
tekuti/request.scm
View file

@ -157,7 +157,7 @@
(nreq (if req (- (length req) nopt) 0)))
(lambda (path)
(let ((pathtail (list-head-match pat path (- npat ntail))))
(pk pat npat ntail req opt nopt nreq path pathtail)
;(pk pat npat ntail req opt nopt nreq path pathtail)
(if (and pathtail (>= (length pathtail) nreq)
(<= (length pathtail) (+ nreq nopt)))
(append pathtail

12
tekuti/template.scm
View file

@ -45,9 +45,9 @@
'("about" "software" "writings" "photos"))
" | ")))
`(html
(head (title ,(rref request 'title "wingolog"))
(head (title ,(rref request 'title *title*))
(meta (@ (name "Generator")
(content "The Guile SXML Toolkit")))
(content "An unholy concoction of parenthetical guile")))
(link (@ (rel "stylesheet")
(type "text/css")
(media "screen")
@ -55,9 +55,11 @@
(body
(div (@ (id "rap"))
(h1 (@ (id "header"))
(a (@ ,(href "")) "wingolog"))
(a (@ ,(href "")) ,*title*))
,(make-navbar)
(div (@ (id "content"))
,@(rref request 'body '((p "what"))))
,@(rref request 'body '((p "(missing content?)"))))
(div (@ (id "footer"))
"powered by sxml")))))
"powered by "
(a (@ (href "http://wingolog.org/software/tekuti/"))
"parentheses"))))))

3
tekuti/web.scm
View file

@ -94,8 +94,7 @@
((GET archives year? month? day?) page-archives)
((GET archives year! month! day! post!) page-show-post)
((POST archives year! month! day! post!) page-new-comment)
((GET feed) page-feed-rss2)
((GET feed rss2) page-feed-rss2)
((GET feed) page-feed-atom)
((GET feed atom) page-feed-atom)
((GET tags) page-show-tags)
((GET tags tag!) page-show-tag)