more cleanups
This commit is contained in:
Andy Wingo
parent
a9141efbe6
commit
c2446d0f7f
5 changed files with 91 additions and 102 deletions
|
|
@ -20,7 +20,7 @@
|
|||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This is the main script that will launch tekuti.
|
||||
;; Comments -- pulling them out of the database, and making new ones.
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -63,11 +63,21 @@
|
|||
(assq-ref comment 'raw-content))
|
||||
|
||||
(define (comment-sxml-content comment)
|
||||
(let ((format (or (assq-ref comment 'format) 'wordpress)))
|
||||
`(li (@ (class "alt") (id ,(assq-ref comment 'key)))
|
||||
(cite ,(let ((url (assq-ref comment 'author_url))
|
||||
(name (assq-ref comment 'author)))
|
||||
(if (and url (not (string-null? url)))
|
||||
`(a (@ (href ,url) (rel "external nofollow")) ,name)
|
||||
name)))
|
||||
" says:" (br)
|
||||
(small (@ (class "commentmetadata"))
|
||||
(a (@ (href ,(string-append "#" (assq-ref comment 'key))))
|
||||
,(comment-readable-date comment)))
|
||||
,(let ((format (or (assq-ref comment 'format) 'wordpress)))
|
||||
((case format
|
||||
((wordpress) wordpress->sxml)
|
||||
(else (lambda (text) `(pre ,text))))
|
||||
(comment-raw-content comment))))
|
||||
(comment-raw-content comment)))))
|
||||
|
||||
(define (comment-timestamp comment-alist)
|
||||
(or (assq-ref comment-alist 'timestamp) #f))
|
||||
|
|
|
|||
|
|
@ -42,8 +42,8 @@
|
|||
show-post
|
||||
atom-header atom-entry))
|
||||
|
||||
(define (relurl path)
|
||||
(string-append *public-url-base* path))
|
||||
(define (relurl . paths)
|
||||
(apply string-append *public-url-base* paths))
|
||||
|
||||
(define (rellink path . body)
|
||||
`(a (@ (href ,(relurl path)))
|
||||
|
|
@ -59,7 +59,7 @@
|
|||
`(form (@ (method "POST")
|
||||
(action ,(relurl (if post
|
||||
(string-append "admin/modify-post/"
|
||||
(url:encode (assq-ref post 'key)))
|
||||
(url:encode (post-key post)))
|
||||
"admin/new-post"))))
|
||||
(p "title: "
|
||||
(input (@ (name "title") (type "text")
|
||||
|
|
@ -75,13 +75,58 @@
|
|||
|
||||
;; double-encoding is a hack to trick apache
|
||||
(define (admin-post-link post)
|
||||
(rellink (string-append "admin/posts/"
|
||||
(url:encode (post-key post)))
|
||||
(assq-ref post 'title)))
|
||||
(rellink (string-append "admin/posts/" (url:encode (post-key post)))
|
||||
(post-title 'title)))
|
||||
|
||||
(define (post-link post)
|
||||
(rellink (string-append "archives/" (url:decode (post-key post)))
|
||||
(assq-ref post 'title)))
|
||||
(define (post-url post . tail)
|
||||
(apply relurl "archives/" (url:decode (post-key post)) tail))
|
||||
|
||||
(define (post-link post . tail)
|
||||
`(a (@ (href ,(apply post-url post tail))) ,(post-title post)))
|
||||
|
||||
(define (comment-form post author email url comment)
|
||||
`(form
|
||||
(@ (action ,(post-url post)) (method "POST"))
|
||||
(p (input (@ (type "text") (name "author") (value ,author)
|
||||
(size "22") (tabindex "1")))
|
||||
" " (label (@ (for "author")) (small "Name")))
|
||||
(p (input (@ (type "text") (name "email") (value ,email)
|
||||
(size "22") (tabindex "2")))
|
||||
" " (label (@ (for "email")) (small "Mail (will not be published)")))
|
||||
(p (input (@ (type "text") (name "url") (value ,url)
|
||||
(size "22") (tabindex "3")))
|
||||
" " (label (@ (for "url")) (small "Website")))
|
||||
;(p (small "allowed tags: "))
|
||||
(p (textarea (@ (name "comment") (id "comment") (cols "65")
|
||||
(rows "10") (tabindex "4"))
|
||||
,comment))
|
||||
(p (input (@ (name "submit") (type "submit") (id "submit") (tabindex "5")
|
||||
(value "Submit Comment"))))))
|
||||
|
||||
(define (post-sxml-comments post)
|
||||
(let ((comments (post-comments post))
|
||||
(comments-open? (post-comments-open? post)))
|
||||
(define (n-comments-header)
|
||||
(and (or (not (null? comments)) comments-open?)
|
||||
`(h3 (@ (id "comments"))
|
||||
,(let ((len (length comments)))
|
||||
(case len
|
||||
((0) "No responses")
|
||||
((1) "One response")
|
||||
(else (format #f "~d responses" len)))))))
|
||||
`(div
|
||||
,@(or (and=> (n-comments-header) list) '())
|
||||
,@(let ((l (map comment-sxml-content comments)))
|
||||
(if (null? l) l
|
||||
`((ol (@ (class "commentlist")) ,@l))))
|
||||
,(if (not comments-open?)
|
||||
`(p (@ (id "nocomments")) "Comments are closed.")
|
||||
`(div (h3 "Leave a Reply")
|
||||
,(comment-form post "" "" "" ""))))))
|
||||
|
||||
(define (tag-link tagname)
|
||||
(rellink (string-append "tags/" (url:encode tagname))
|
||||
tagname))
|
||||
|
||||
(define (show-post post comments?)
|
||||
`((h2 (@ (class "storytitle"))
|
||||
|
|
@ -89,18 +134,22 @@
|
|||
(div (@ (class "post"))
|
||||
(h3 (@ (class "meta"))
|
||||
,(post-readable-date post)
|
||||
" (" ,@(list-intersperse (post-tag-links post)
|
||||
" (" ,@(list-intersperse
|
||||
(map tag-link (post-tags post))
|
||||
" | ")
|
||||
")")
|
||||
(div (@ (class "storycontent"))
|
||||
,(post-sxml-content post))
|
||||
,@(if comments? '()
|
||||
(list (post-sxml-n-comments post))))
|
||||
,@(if comments?
|
||||
'()
|
||||
`((div (@ (class "feedback"))
|
||||
(a (@ (href ,(post-url post "#comments")))
|
||||
"(" ,(post-n-comments post) ")")))))
|
||||
,@(if comments?
|
||||
(list (post-sxml-comments post))
|
||||
'())))
|
||||
|
||||
;; fixme: borks in the no-tags case
|
||||
;; fixme: borks in the no-tags case; ugly code
|
||||
(define (tag-cloud index)
|
||||
(define (determine-sizes counts)
|
||||
(let ((maxcount (apply max counts)))
|
||||
|
|
@ -117,9 +166,7 @@
|
|||
`(ul (li (@ (style "line-height: 150%"))
|
||||
,@(list-intersperse
|
||||
(map (lambda (name size)
|
||||
`(a (@ (href ,(string-append
|
||||
*public-url-base* "tags/"
|
||||
(url:encode name)))
|
||||
`(a (@ (href ,(relurl "tags/" (url:encode name)))
|
||||
(rel "tag")
|
||||
(style ,(format #f "font-size: ~d%" size)))
|
||||
,name))
|
||||
|
|
@ -135,9 +182,7 @@
|
|||
(img (@ (src ,(relurl "wp-content/feed-icon-14x14.png"))
|
||||
(alt "subscribe to this feed")))
|
||||
)))
|
||||
(li (h2 "tags "
|
||||
(a (@ (href ,(string-append *public-url-base* "tags/")))
|
||||
">>"))
|
||||
(li (h2 "tags " ,(rellink "tags/" ">>"))
|
||||
,(tag-cloud index)))))
|
||||
|
||||
(define (atom-header server-name last-modified)
|
||||
|
|
|
|||
|
|
@ -233,7 +233,7 @@
|
|||
(define (page-feed-atom request index)
|
||||
(let ((last-modified (let ((posts (published-posts index 1)))
|
||||
(and (pair? posts)
|
||||
(assq-ref (car posts) 'timestamp))))
|
||||
(post-timestamp (car posts)))))
|
||||
(server-name (request-server-name request)))
|
||||
(cond
|
||||
((let ((since (assoc-ref (rref request 'headers '())
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This is the main script that will launch tekuti.
|
||||
;; Posts -- pulling them out of git, and, later, putting them in.
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -38,8 +38,9 @@
|
|||
#:export (post-from-tree post-from-key
|
||||
|
||||
post-tags post-timestamp post-key post-published?
|
||||
post-sxml-content post-raw-content post-readable-date post-tag-links post-sxml-n-comments
|
||||
post-sxml-comments post-title
|
||||
post-comments-open? post-comments
|
||||
post-sxml-content post-readable-date post-n-comments
|
||||
post-title
|
||||
|
||||
all-published-posts
|
||||
|
||||
|
|
@ -94,6 +95,9 @@
|
|||
(define (post-title post)
|
||||
(assq-ref post 'title))
|
||||
|
||||
(define (post-comments-open? post)
|
||||
(equal? (assq-ref post 'comment_status) "open"))
|
||||
|
||||
(define (post-raw-content post)
|
||||
(git "show" (string-append (assq-ref post 'sha1) ":content")))
|
||||
|
||||
|
|
@ -106,18 +110,9 @@
|
|||
|
||||
(define (post-readable-date post)
|
||||
(let ((date (time-utc->date
|
||||
(make-time time-utc 0 (assq-ref post 'timestamp)))))
|
||||
(make-time time-utc 0 (post-timestamp post)))))
|
||||
(date->string date "~e ~B ~Y ~l:~M ~p")))
|
||||
|
||||
;; hack :-/
|
||||
(define (tag-link tagname)
|
||||
`(a (@ (href ,(string-append *public-url-base* "tags/"
|
||||
(url:encode tagname))))
|
||||
,tagname))
|
||||
|
||||
(define (post-tag-links post)
|
||||
(map tag-link (post-tags post)))
|
||||
|
||||
(define (post-comments post)
|
||||
(dsu-sort
|
||||
(map (lambda (pair)
|
||||
|
|
@ -126,70 +121,9 @@
|
|||
comment-timestamp
|
||||
<))
|
||||
|
||||
(define (comment-form post author email url comment)
|
||||
`(form
|
||||
(@ (action ,(string-append *public-url-base* "archives/"
|
||||
(url:decode (assq-ref post 'key))))
|
||||
(method "POST"))
|
||||
(p (input (@ (type "text") (name "author") (value ,author)
|
||||
(size "22") (tabindex "1")))
|
||||
" " (label (@ (for "author")) (small "Name")))
|
||||
(p (input (@ (type "text") (name "email") (value ,email)
|
||||
(size "22") (tabindex "2")))
|
||||
" " (label (@ (for "email")) (small "Mail (will not be published)")))
|
||||
(p (input (@ (type "text") (name "url") (value ,url)
|
||||
(size "22") (tabindex "3")))
|
||||
" " (label (@ (for "url")) (small "Website")))
|
||||
;(p (small "allowed tags: "))
|
||||
(p (textarea (@ (name "comment") (id "comment") (cols "65")
|
||||
(rows "10") (tabindex "4"))
|
||||
,comment))
|
||||
(p (input (@ (name "submit") (type "submit") (id "submit") (tabindex "5")
|
||||
(value "Submit Comment"))))))
|
||||
|
||||
(define (post-sxml-comments post)
|
||||
(let ((comments (post-comments post))
|
||||
(comment-status (assq-ref post 'comment_status)))
|
||||
(define (n-comments-header)
|
||||
(and (or (not (null? comments)) (equal? comment-status "open"))
|
||||
`(h3 (@ (id "comments"))
|
||||
,(let ((len (length comments)))
|
||||
(case len
|
||||
((0) "No responses")
|
||||
((1) "One response")
|
||||
(else (format #f "~d responses" len)))))))
|
||||
(define (show-comment comment)
|
||||
`(li (@ (class "alt") (id ,(assq-ref comment 'key)))
|
||||
(cite ,(let ((url (assq-ref comment 'author_url))
|
||||
(name (assq-ref comment 'author)))
|
||||
(if (and url (not (string-null? url)))
|
||||
`(a (@ (href ,url) (rel "external nofollow")) ,name)
|
||||
name)))
|
||||
" says:" (br)
|
||||
(small (@ (class "commentmetadata"))
|
||||
(a (@ (href ,(string-append "#" (assq-ref comment 'key))))
|
||||
,(comment-readable-date comment)))
|
||||
,(comment-sxml-content comment)))
|
||||
`(div
|
||||
,@(or (and=> (n-comments-header) list) '())
|
||||
,@(let ((l (map show-comment comments)))
|
||||
(if (null? l) l
|
||||
`((ol (@ (class "commentlist")) ,@l))))
|
||||
,(if (equal? comment-status "closed")
|
||||
`(p (@ (id "nocomments")) "Comments are closed.")
|
||||
`(div (h3 "Leave a Reply")
|
||||
,(comment-form post "" "" "" ""))))))
|
||||
|
||||
(define (post-n-comments post)
|
||||
(length (git-ls-tree (string-append (assq-ref post 'sha1) ":comments") #f)))
|
||||
|
||||
(define (post-sxml-n-comments post)
|
||||
`(div (@ (class "feedback"))
|
||||
(a (@ (href ,(string-append *public-url-base* "archives/"
|
||||
(url:decode (assq-ref post 'key))
|
||||
"#comments")))
|
||||
"(" ,(post-n-comments post) ")")))
|
||||
|
||||
(define (all-posts master)
|
||||
(map (lambda (pair)
|
||||
(post-from-tree (car pair) (cdr pair)))
|
||||
|
|
|
|||
|
|
@ -77,7 +77,7 @@ def write_post(post, categories, comments):
|
|||
for k, v in post.items():
|
||||
if k not in ('content', 'content_filtered'):
|
||||
out += '%s: %s\n' % (k, v)
|
||||
out += 'categories: %s\n' % ', '.join(categories)
|
||||
out += 'tags: %s\n' % ', '.join(categories)
|
||||
out += 'timestamp: %s\n' % int(time.mktime(post['date'].timetuple()))
|
||||
return out
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue