aliens/tekuti
1
0
Fork 0
Code Activity

support for deleting post comments

Browse source
This commit is contained in:
Andy Wingo 2011-02-18 23:34:17 +01:00
parent 9ec70ebff5
commit a357b2a0dc
5 changed files with 43 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
tekuti/comment.scm
View file

@ -29,12 +29,14 @@
#:use-module (tekuti git)
#:use-module (tekuti util)
#:use-module (tekuti filters)
#:use-module (tekuti post)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (sxml transform)
#:use-module (tekuti match-bind)
#:export (blob->comment comment-sxml-content comment-timestamp
comment-readable-date bad-new-comment-post? make-new-comment))
comment-readable-date bad-new-comment-post?
make-new-comment delete-comment))
(define *comment-spec*
`((timestamp . ,string->number)))
@ -146,3 +148,15 @@
(list sha1 sha1 'blob))
master message #f))
5))))
(define (delete-comment post id)
(let ((key (post-key post))
(message (format #f "~a on \"~a\"" "comment deleted" (post-title post))))
(git-update-ref "refs/heads/master"
(lambda (master)
(git-commit-tree (munge-tree1 master
'delete
`(,key "comments")
`(,id))
master message #f))
5)))

16
tekuti/page-helpers.scm
View file

@ -192,6 +192,10 @@
(action ,(relurl `("admin" "delete-post" ,(post-key post)))))
" "
(input (@ (type "submit") (name "delete") (value "delete"))))
,@(let ((l (comments-sxml-content-edit post)))
(if (null? l) l
`((h2 "comments")
(ol (@ (class "commentlist")) ,@l))))
(h2 "preview")
,(show-post post #f))
'())))
@ -238,6 +242,18 @@
(p (input (@ (name "submit") (type "submit") (id "submit") (tabindex "5")
(value "Submit Comment"))))))
(define (comments-sxml-content-edit post)
(map
(lambda (comment)
(let ((id (assq-ref comment 'key)))
`(,(comment-sxml-content comment)
(form (@ (method "POST")
(action ,(relurl `("admin" "delete-comment"
,(post-key post) ,id))))
(input (@ (type "submit") (name "delete") (value "delete"))))
(br))))
(post-comments post)))
(define (post-sxml-comments post)
(let ((comments (post-comments post))
(comments-open? (post-comments-open? post)))

9
tekuti/page.scm
View file

@ -42,6 +42,7 @@
page-admin-new-post
page-admin-modify-post
page-admin-delete-post
page-admin-delete-comment
page-admin-changes
page-admin-change
page-admin-revert-change
@ -133,6 +134,14 @@
(delete-post key)
(respond `((p "redirecting...")) #:redirect (relurl `("admin"))))))
(define (page-admin-delete-comment request body index key comment-id)
(with-authentication
request
(lambda ()
(let ((post (post-from-key (assq-ref index 'master) key #t)))
(delete-comment post comment-id)
(respond `((p "redirecting...")) #:redirect (admin-post-url post))))))
(define (page-admin-changes request body index)
(with-authentication
request

9
tekuti/post.scm
View file

@ -202,16 +202,11 @@
(munge-post old-key (parse-post-data post-data)))
(define (delete-post key)
(define (maybe-delete ops)
(if (and old-key (not (equal? old-key key)))
(cons ops)
ops))
(let* ((ops `((delete () (,key))))
(post (post-from-key "refs/heads/master" key))
(let* ((post (post-from-key "refs/heads/master" key))
(message (format #f "~a: \"~a\"" "post deleted" (post-title post))))
(git-update-ref "refs/heads/master"
(lambda (master)
(git-commit-tree (munge-tree master ops)
(git-commit-tree (munge-tree1 master 'delete '() `(,key))
master message #f))
5)))

1
tekuti/web.scm
View file

@ -44,6 +44,7 @@
;; web browsers don't handle that
((POST admin delete-post post-key!) page-admin-delete-post)
((POST admin modify-post post-key!) page-admin-modify-post)
((POST admin delete-comment post-key! comment-id!) page-admin-delete-comment)
((GET admin changes) page-admin-changes)
((GET admin changes sha1!) page-admin-change)
((POST admin revert-change sha1!) page-admin-revert-change)