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 +;; Copyright (C) 2008, 2010, 2011 Andy Wingo ;; 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)