summaryrefslogtreecommitdiffstatshomepage
diff options
context:
space:
mode:
authorGravatar Andy Wingo2011-02-18 23:31:42 +0100
committerGravatar Andy Wingo2011-02-18 23:31:42 +0100
commit9ec70ebff5188e55a2f0765b9f60be9ef0b3a22b (patch)
tree2d50febc942392245eca901aedd9fc7642eaf525
parent66e04753f651547b6ee31417be8e03a7c7f4cc66 (diff)
downloadtekuti-9ec70ebff5188e55a2f0765b9f60be9ef0b3a22b.tar.gz
tekuti-9ec70ebff5188e55a2f0765b9f60be9ef0b3a22b.zip
add support for deleting posts
-rw-r--r--tekuti/page-helpers.scm6
-rw-r--r--tekuti/page.scm8
-rw-r--r--tekuti/post.scm20
-rw-r--r--tekuti/web.scm1
4 files changed, 31 insertions, 4 deletions
diff --git a/tekuti/page-helpers.scm b/tekuti/page-helpers.scm
index feba568..7e7be48 100644
--- a/tekuti/page-helpers.scm
+++ b/tekuti/page-helpers.scm
@@ -188,7 +188,11 @@
(input (@ (type "submit") (name "status")
(value "draft"))))
,@(if post
- `((h2 "preview")
+ `((form (@ (method "POST")
+ (action ,(relurl `("admin" "delete-post" ,(post-key post)))))
+ " "
+ (input (@ (type "submit") (name "delete") (value "delete"))))
+ (h2 "preview")
,(show-post post #f))
'())))
diff --git a/tekuti/page.scm b/tekuti/page.scm
index 62ba56f..b2fa305 100644
--- a/tekuti/page.scm
+++ b/tekuti/page.scm
@@ -41,6 +41,7 @@
page-admin-post
page-admin-new-post
page-admin-modify-post
+ page-admin-delete-post
page-admin-changes
page-admin-change
page-admin-revert-change
@@ -125,6 +126,13 @@
(respond `((p "redirecting..."))
#:redirect (admin-post-url post))))))
+(define (page-admin-delete-post request body index key)
+ (with-authentication
+ request
+ (lambda ()
+ (delete-post key)
+ (respond `((p "redirecting...")) #:redirect (relurl `("admin"))))))
+
(define (page-admin-changes request body index)
(with-authentication
request
diff --git a/tekuti/post.scm b/tekuti/post.scm
index 6bc61ea..2e5abbc 100644
--- a/tekuti/post.scm
+++ b/tekuti/post.scm
@@ -1,5 +1,5 @@
;; Tekuti
-;; Copyright (C) 2008, 2010 Andy Wingo <wingo at pobox dot com>
+;; Copyright (C) 2008, 2010, 2011 Andy Wingo <wingo at pobox dot com>
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@@ -43,8 +43,8 @@
post-raw-content
post-title
- make-new-post modify-post
-
+ make-new-post modify-post delete-post
+
all-published-posts
reindex-posts))
@@ -201,6 +201,20 @@
(define (modify-post old-key post-data)
(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))
+ (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)
+ master message #f))
+ 5)))
+
(define (all-posts master)
(map (lambda (pair)
(post-from-tree (car pair) (cdr pair)))
diff --git a/tekuti/web.scm b/tekuti/web.scm
index f81b59a..d5d9fc9 100644
--- a/tekuti/web.scm
+++ b/tekuti/web.scm
@@ -42,6 +42,7 @@
((POST admin new-post) page-admin-new-post)
;; would be fine to have e.g. (DELETE admin posts posts-key!), but
;; 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)
((GET admin changes) page-admin-changes)
((GET admin changes sha1!) page-admin-change)