[Transaction extensions
clinton@unknownlamer.org**20110207224240
 Ignore-this: 93a3465d4f1abffe5a6d8728e76de6e1
 * `with-transaction*' binds `rofl::*current-transaction*'
 * `ensure-transaction' permits joining an active transaction (this
   probably should optionall establish a savepoint)
] {
hunk ./rofl.asd 36
+				     (:file "transaction")
hunk ./src/packages.lisp 44
+   ;; extensions to postmodern
+   #:with-transaction*
+   #:ensure-transaction
+
addfile ./src/transaction.lisp
hunk ./src/transaction.lisp 1
+(in-package #:rofl)
hunk ./src/transaction.lisp 3
+;;; Extensions of postmodern transaction macros to permit saner
+;;; nesting of transactions
+
+(defvar *current-transaction*)
+
+(defun call-with-transaction (fun transaction)
+  (let ((*current-transaction* transaction))
+    (funcall fun transaction)))
+
+(defmacro with-transaction* ((&optional name) &body body)
+  "Equivalent to `postmodern:with-transaction' except that it also
+binds `*current-transaction*'."
+  (let ((name (or name (gensym))))
+    `(with-transaction (,name)
+       (let ((*current-transaction* ,name))
+	 ,@body))))
+
+(defmacro ensure-transaction ((&optional name) &body body)
+  "Either begins a new transaction, or joins an existing transaction
+started by `with-transaction*'. When provided, `name' is bound to the
+transaction."
+  (let ((name (or name (gensym)))
+	(fun (gensym)))
+    `(let ((,fun (lambda (,name)
+		   (declare (ignorable ,name))
+		   ,@body)))
+       (if (boundp '*current-transaction*)
+	   (funcall ,fun *current-transaction*)
+	   (with-transaction* (,name)
+	     (funcall ,fun ,name))))))
}