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

16
tekuti/page.scm
View file

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

4
tekuti/post.scm
View file

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

2
tekuti/request.scm
View file

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

12
tekuti/template.scm
View file

@ -45,9 +45,9 @@
'("about" "software" "writings" "photos")) '("about" "software" "writings" "photos"))
" | "))) " | ")))
`(html `(html
(head (title ,(rref request 'title "wingolog")) (head (title ,(rref request 'title *title*))
(meta (@ (name "Generator") (meta (@ (name "Generator")
(content "The Guile SXML Toolkit"))) (content "An unholy concoction of parenthetical guile")))
(link (@ (rel "stylesheet") (link (@ (rel "stylesheet")
(type "text/css") (type "text/css")
(media "screen") (media "screen")
@ -55,9 +55,11 @@
(body (body
(div (@ (id "rap")) (div (@ (id "rap"))
(h1 (@ (id "header")) (h1 (@ (id "header"))
(a (@ ,(href "")) "wingolog")) (a (@ ,(href "")) ,*title*))
,(make-navbar) ,(make-navbar)
(div (@ (id "content")) (div (@ (id "content"))
,@(rref request 'body '((p "what")))) ,@(rref request 'body '((p "(missing content?)"))))
(div (@ (id "footer")) (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?) page-archives)
((GET archives year! month! day! post!) page-show-post) ((GET archives year! month! day! post!) page-show-post)
((POST archives year! month! day! post!) page-new-comment) ((POST archives year! month! day! post!) page-new-comment)
((GET feed) page-feed-rss2) ((GET feed) page-feed-atom)
((GET feed rss2) page-feed-rss2)
((GET feed atom) page-feed-atom) ((GET feed atom) page-feed-atom)
((GET tags) page-show-tags) ((GET tags) page-show-tags)
((GET tags tag!) page-show-tag) ((GET tags tag!) page-show-tag)