use with-macro definer for with-transaction
Fri Jan 16 03:58:53 PST 2009 attila.lendvai@gmail.com
* use with-macro definer for with-transaction
Warning: CRC errors found. These are probably harmless but should be repaired.
See 'darcs gzcrcs --help' for more information.
diff -rN -u old-cl-rdbms/transaction.lisp new-cl-rdbms/transaction.lisp
--- old-cl-rdbms/transaction.lisp 2014-07-28 07:24:52.000000000 -0700
+++ new-cl-rdbms/transaction.lisp 2014-07-28 07:24:52.000000000 -0700
@@ -94,18 +94,10 @@
(mark-transaction-for-rollback-only)
,@body))
-(defmacro with-transaction (&body forms)
+(def (macro e) with-transaction (&body forms)
`(with-transaction* ()
,@forms))
-(defmacro with-transaction* ((&rest args &key database (default-terminal-action :commit) &allow-other-keys)
- &body forms)
- (declare (ignore database default-terminal-action))
- `(call-with-transaction
- (lambda ()
- ,@forms)
- ,@args))
-
(defgeneric call-in-transaction (database transaction function)
(:documentation "Extension point for with-transaction macro.")
@@ -113,10 +105,10 @@
(declare (ignore database transaction))
(funcall function)))
-(defun call-with-transaction (function &rest args &key (default-terminal-action :commit) database &allow-other-keys)
+(def (with-macro* e) with-transaction* (&rest args &key (default-terminal-action :commit) database &allow-other-keys)
(unless (or database (boundp '*database*))
(error "Cannot start transaction because database was not provided, either use with-database or provide a database to with-transaction*"))
- (let* ((*database* (or database *database*))
+ (bind ((*database* (or database *database*))
(*transaction* nil)
(body-finished? #f))
(iter restart-transaction-loop
@@ -125,12 +117,12 @@
(progn
(setf body-finished? #f)
(setf *transaction*
- (apply #'make-transaction *database*
+ (apply 'make-transaction *database*
:terminal-action default-terminal-action
- (remove-from-plistf args :database :default-terminal-action)))
+ (remove-from-plist args :database :default-terminal-action)))
(return-from restart-transaction-loop
(multiple-value-prog1
- (restart-case (call-in-transaction *database* *transaction* function)
+ (restart-case (call-in-transaction *database* *transaction* #'-body-)
(terminate-transaction ()
:report (lambda (stream)
(format stream "return (values) from the WITH-TRANSACTION block executing the current terminal action ~S" (terminal-action-of *transaction*)))