Adding a generic function layer inside OPERATE

Hello,

At present, there's no obvious way to run code :before or :around
system-level actions other than wrapping operate/oos [1].  Would
anybody object to adding a generic function layer between
instantiation of the operation and system and the carrying out of the
perform calls?  A patch to that effect follows, though the generic
function name in the patch is pretty lousy.

Thanks,
RmK

[1] So far, I have only thought of two cases where I wanted such
methods: (a) an :around method to determine what packages were created
by a system (and its dependencies) by comparing the list of packages
before and after compile-op'ing, (b) a :before method to check for
emacs auto-save files before starting to compile-op a system.  rpg on
#lisp mentioned wanting to wrap system-level actions, too, a couple
weeks ago.

diff -u /home/kreuter/lsp/pkg/cclan/asdf/asdf.lisp.\~1.98.\~ /home/kreuter/lsp/pkg/cclan/asdf/asdf.lisp
--- /home/kreuter/lsp/pkg/cclan/asdf/asdf.lisp.~1.98.~	2006-05-30 14:14:40.000000000 -0400
+++ /home/kreuter/lsp/pkg/cclan/asdf/asdf.lisp	2006-06-04 23:33:22.000000000 -0400
@@ -40,7 +40,7 @@
 (defpackage #:asdf
   (:export #:defsystem #:oos #:operate #:find-system #:run-shell-command
 	   #:system-definition-pathname #:find-component ; miscellaneous
-	   #:hyperdocumentation #:hyperdoc
+	   #:hyperdocumentation #:hyperdoc #:conduct-system-operation
 	   
 	   #:compile-op #:load-op #:load-source-op #:test-system-version
 	   #:test-op
@@ -837,33 +837,38 @@
 	 (system (if (typep system 'component) system (find-system system))))
     (unless (version-satisfies system version)
       (error 'missing-component :requires system :version version))
-    (let ((steps (traverse op system)))
+    (conduct-system-operation op system)))
+
+(defun oos (&rest args)
+  "Alias of OPERATE function"
+  (apply #'operate args))
+
+(defgeneric conduct-system-operation (operation component))
+
+(defgeneric conduct-system-operation (operation (system system))
+  (let ((steps (traverse operation system)))
       (with-compilation-unit ()
-	(loop for (op . component) in steps do
+	(loop for (operation . component) in steps do
 	     (loop
 		(restart-case 
-		    (progn (perform op component)
+		    (progn (perform operation component)
 			   (return))
 		  (retry ()
 		    :report
 		    (lambda (s)
 		      (format s "~@<Retry performing ~S on ~S.~@:>"
-			      op component)))
+			      operation component)))
 		  (accept ()
 		    :report
 		    (lambda (s)
 		      (format s
 			      "~@<Continue, treating ~S on ~S as ~
                                having been successful.~@:>"
-			      op component))
-		    (setf (gethash (type-of op)
+			      operation component))
+		    (setf (gethash (type-of operation)
 				   (component-operation-times component))
 			  (get-universal-time))
-		    (return)))))))))
-
-(defun oos (&rest args)
-  "Alias of OPERATE function"
-  (apply #'operate args))
+		    (return))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; syntax

Diff finished.  Sun Jun  4 23:33:33 2006