[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-ccl.lisp 
Log Message:
* swank-ccl.lisp (frame-package): Implemented.

--- /project/slime/cvsroot/slime/ChangeLog	2013/01/05 08:50:12	1.2379
+++ /project/slime/cvsroot/slime/ChangeLog	2013/01/05 08:50:24	1.2380
@@ -1,5 +1,9 @@
 2013-01-05  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-ccl.lisp (frame-package): Implemented.
+
+2013-01-05  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-loader.lisp (init): Add a :quiet argument.
 
 2012-12-27  Stas Boukarev  <stassats at gmail.com>
--- /project/slime/cvsroot/slime/swank-ccl.lisp	2012/12/03 03:43:16	1.29
+++ /project/slime/cvsroot/slime/swank-ccl.lisp	2013/01/05 08:50:24	1.30
@@ -407,6 +407,20 @@
         (pc-source-location lfun pc)
         (function-source-location lfun)))))
 
+(defimplementation frame-package (frame-number)
+  (with-frame (p context) frame-number
+    (let* ((lfun (ccl:frame-function p context))
+           (name (ccl:function-name lfun)))
+      (labels ((name-package (name)
+                 (etypecase name
+                   (null nil)
+                   (symbol (symbol-package name))
+                   ((cons (eql setf) symbol) (symbol-package (cadr name)))
+                   ((cons (eql :internal)) (name-package (car (last name))))
+                   ((cons (and symbol (not keyword)) (cons list null))
+                    (symbol-package (car name))))))
+        (name-package name)))))
+
 (defimplementation eval-in-frame (form index)
   (with-frame (p context) index
     (let ((vars (ccl:frame-named-variables p context)))