[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-lispworks.lisp 
Log Message:
* swank-lispworks.lisp (frame-package): Implemented.
(function-name-package): New.

--- /project/slime/cvsroot/slime/ChangeLog	2013/02/08 14:11:23	1.2391
+++ /project/slime/cvsroot/slime/ChangeLog	2013/02/08 14:11:34	1.2392
@@ -1,5 +1,10 @@
 2013-02-08  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-lispworks.lisp (frame-package): Implemented.
+	(function-name-package): New.
+
+2013-02-08  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-allegro.lisp (handle-compiler-warning): Ignore "Closure
 	will be stack allocated" notes.  Those are harmless and there are
 	too many of them.
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2013/02/02 10:11:16	1.152
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2013/02/08 14:11:34	1.153
@@ -459,10 +459,26 @@
   (let ((frame (nth-frame frame-number)))
     (dbg::dbg-eval form frame)))
 
+(defun function-name-package (name)
+  (typecase name
+    (null nil)
+    (symbol (symbol-package name))
+    ((cons (eql hcl:subfunction))
+     (destructuring-bind (name parent) (cdr name)
+       (declare (ignore name))
+       (function-name-package parent)))
+    ((cons (eql lw:top-level-form)) nil)
+    (t nil)))
+
+(defimplementation frame-package (frame-number)
+  (let ((frame (nth-frame frame-number)))
+    (if (dbg::call-frame-p frame)
+        (function-name-package (dbg::call-frame-function-name frame)))))
+
 (defimplementation return-from-frame (frame-number form)
   (let* ((frame (nth-frame frame-number))
          (return-frame (dbg::find-frame-for-return frame)))
-    (dbg::dbg-return-from-call-frame frame form return-frame 
+    (dbg::dbg-return-from-call-frame frame form return-frame
                                      dbg::*debugger-stack*)))
 
 (defimplementation restart-frame (frame-number)