[slime-cvs] CVS update: slime/swank-backend.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv12177

Modified Files:
	swank-backend.lisp 
Log Message:
(import-swank-mop-symbols): New function. Useful if the implementation
has most of the mop symbols in the same package.

(sldb-break-on-return, sldb-break-at-start, condition-extras): New
functions.

Date: Sun Sep 19 07:52:49 2004
Author: heller

Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.68 slime/swank-backend.lisp:1.69
--- slime/swank-backend.lisp:1.68	Fri Sep 17 14:49:04 2004
+++ slime/swank-backend.lisp	Sun Sep 19 07:52:48 2004
@@ -81,14 +81,6 @@
    #:slot-definition-readers
    #:slot-definition-writers))
 
-(defun swank-backend::import-to-swank-mop (symbol-list)
-  (dolist (sym symbol-list)
-    (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
-      (when swank-mop-sym
-        (unintern swank-mop-sym :swank-mop))
-      (import sym :swank-mop)
-      (export sym :swank-mop))))
-
 (in-package :swank-backend)
 
 
@@ -138,6 +130,25 @@
   (warn "These Swank interfaces are unimplemented:~% ~A"
         (sort (copy-list *unimplemented-interfaces*) #'string<)))
 
+(defun import-to-swank-mop (symbol-list)
+  (dolist (sym symbol-list)
+    (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
+      (when swank-mop-sym
+        (unintern swank-mop-sym :swank-mop))
+      (import sym :swank-mop)
+      (export sym :swank-mop))))
+
+(defun import-swank-mop-symbols (package except)
+  "Import the mop symbols from PACKAGE to SWANK-MOP.
+EXCEPT is a list of symbol names which should be ignored."
+  (do-symbols (s :swank-mop)
+    (unless (member s except :test #'string=)
+      (let ((real-symbol (find-symbol (string s) package)))
+        (assert real-symbol)
+        (unintern s :swank-mop)
+        (import real-symbol :swank-mop)
+        (export real-symbol :swank-mop)))))
+
 
 ;;;; Utilities
 
@@ -490,8 +501,20 @@
   (:SBCL :NODE node-name)"
   '())
 
+(definterface condition-extras (condition)
+  "Return a list of extra for the debugger.
+The allowed elements are of the form:
+  (:SHOW-FRAME-SOURCE frame-number)"
+  '())
+
 (definterface sldb-step (frame-number)
-    "Step to the next code location in the frame FRAME-NUMBER.")
+  "Step to the next code location in the frame FRAME-NUMBER.")
+
+(definterface sldb-break-on-return (frame-number)
+  "Set a breakpoint in the frame FRAME-NUMBER.")
+
+(definterface sldb-break-at-start (symbol)
+  "Set a breakpoint on the beginning of the function for SYMBOL.")