add support for deleting posts

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))
           '())))
 

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

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)))

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)