[slime-cvs] CVS slime/contrib

[heller]

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

Modified Files:
	ChangeLog swank-kawa.scm 
Log Message:
Update Kawa backend to the changed inspector protocol.

* swank-kawa.scm (inspect-object): Return a list (content len
start end).
(<inspector-state>): New field: content.
(content-range, subseq): New functions.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/02/15 17:35:19	1.92
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/02/20 22:05:24	1.93
@@ -1,3 +1,12 @@
+2008-02-18  Helmut Eller  <heller at common-lisp.net>
+
+	Update Kawa backend to the changed inspector protocol.
+
+	* swank-kawa.scm (inspect-object): Return a list (content len
+	start end).
+	(<inspector-state>): New field: content.
+	(content-range, subseq): New functions.
+
 2008-02-15  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
 
 	* slime-presentations.el (slime-previous-presentation)
--- /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2008/01/19 14:08:27	1.1
+++ /project/slime/cvsroot/slime/contrib/swank-kawa.scm	2008/02/20 22:05:24	1.2
@@ -916,7 +916,8 @@
 (define-simple-class <inspector-state> () 
   (object :init #!null) 
   (parts :: <java.util.ArrayList> :init (<java.util.ArrayList>) )
-  (stack :: <list> :init '()))
+  (stack :: <list> :init '())
+  (content :: <list> :init '()))
 
 (df make-inspector (env (vm <vm>) => <chan>)
   (car (spawn/chan (fun (c) (inspector c env vm)))))
@@ -950,14 +951,16 @@
   (set (@ object state) obj)
   (set (@ parts state) (<java.util.ArrayList>))
   (pushf obj (@ stack state))
+  (set (@ content state) (inspector-content 
+                          `("class: " (:value ,(! getClass obj)) "\n" 
+                            ,@(inspect obj vm))
+                          state))
   (cond ((nul? obj) (list :title "#!null" :id 0 :content `()))
         (#t
          (list :title (pprint-to-string obj) 
                :id (assign-index obj state)
-               :content (inspector-content
-                         `("class: " (:value ,(! getClass obj)) "\n" 
-                           ,@(inspect obj vm))
-                         state)))))
+               :content (let ((c (@ content state)))
+                          (content-range  c 0 (len c)))))))
 
 (df inspect (obj vm)
   (let* ((obj (as <obj-ref> (vm-mirror vm obj))))
@@ -996,6 +999,10 @@
   (! add (@ parts state) obj)
   (1- (! size  (@ parts state))))
 
+(df content-range (l start end)
+  (let* ((len (length l)) (end (min len end)))
+    (list (subseq l start end) len start end)))
+
 (df inspector-pop ((state <inspector-state>) vm)
   (cond ((<= 2 (len (@ stack state)))
          (let ((obj (cadr (@ stack state))))
@@ -1840,6 +1847,12 @@
 (df mappend (f list)
   (apply append (map f list)))
 
+(df subseq (s from to)
+  (typecase s
+    (<list> (apply list (! sub-list s from to)))
+    (<vector> (apply vector (! sub-list s from to)))
+    (<str> (! substring s from to))))
+
 (df to-string (obj => <string>)
   (cond ((instance? obj <str>) (<gnu.lists.FString> (as <str> obj)))
         ((string? obj) obj)