[slime-cvs] CVS slime

[mbaringer]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv11483

Modified Files:
	swank-backend.lisp 
Log Message:
(request-abort): New condition.
(abort-request): Convenience function for signaling request-abort
conditions.
(operate-on-system): Use abort-request instead of error
(:swank-backend): Export the symbols abort-request and request-abort.


--- /project/slime/cvsroot/slime/swank-backend.lisp	2006/08/10 11:53:35	1.101
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2006/09/18 21:27:04	1.102
@@ -15,6 +15,8 @@
   (:export #:sldb-condition
            #:original-condition
            #:compiler-condition
+           #:abort-request
+           #:request-abort
            #:message
            #:short-message
            #:condition
@@ -159,6 +161,20 @@
          (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
      ',name))
 
+(define-condition request-abort (error)
+  ((reason  :initarg :reason :reader reason))
+  (:report (lambda (condition stream)
+             (princ (reason condition) stream)))
+  (:documentation "Condition signalled when SLIME wasn't able to
+complete a user request due to bad data. This condition is not
+for real errors but for situations where SLIME has to give up and
+return control back to the user."))
+
+(defun abort-request (reason-control &rest reason-args)
+  "Abort whatever swank is currently do and send a message to the
+user."
+  (error 'request-abort :reason (apply #'format nil reason-control reason-args)))
+
 (defun warn-unimplemented-interfaces ()
   "Warn the user about unimplemented backend features.
 The portable code calls this function at startup."
@@ -346,12 +362,12 @@
 Example:
 \(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
   (unless (member :asdf *features*)
-    (error "ASDF is not loaded."))
+    (abort-request "ASDF is not loaded."))
   (with-compilation-hooks ()
     (let ((operate (find-symbol (symbol-name '#:operate) :asdf))
           (operation (find-symbol operation-name :asdf)))
       (when (null operation)
-        (error "Couldn't find ASDF operation ~S" operation-name))
+        (abort-request "Couldn't find ASDF operation ~S" operation-name))
       (apply operate operation system-name keyword-args))))
 
 (definterface swank-compile-file (filename load-p &optional external-format)