Merge branch 'condition-transform'

slime.scm

@@ -21,6 +21,8 @@
                swank:swank-require
                swank:describe-symbol
                swank:documentation-symbol
+	       swank:inspect-frame-var
+	       swank:quit-inspector
 	       swank:frame-locals-and-catch-tags
                swank:apropos-list-for-emacs)
   (import scheme

swank-chicken.scm

@@ -19,13 +19,14 @@
 ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 ;;; DEALINGS IN THE SOFTWARE.
 ;;;
-
+(import chicken scheme)
 (require 'tcp)
 (require 'posix)
 (require-extension data-structures
 		   symbol-utils
                    apropos
                    chicken-doc
+		   extras
                    fmt)
 
 
@@ -145,7 +146,7 @@
                               ": " (fmt-join wrt (get-key 'arguments) " "))))
       (swank-write-packet
        `(:debug 0 0        ; Thread, level (dummy values)
-                (,first-line "" nil)                      ; Condition
+                (,first-line "[ inspect ]" nil) ; Condition
                 (("ABORT" "Return to SLIME's top level")) ; Restarts
                 ,(swank-call-chain chain)                 ; Frames
                 (,id))     ; Emacs continuations
@@ -389,25 +390,14 @@
 	 (data (##sys#slot callframe 2))
 	 (frameinfo (##sys#structure? data 'frameinfo))
 	 (counter (if frameinfo (##sys#slot frameinfo 1) data)))
-    (when frameinfo
-	  (debug-print (fmt #f
-			    "slot 0: " (##sys#slot data 0)
-			    " slot 1: " (##sys#slot data 1)
-			    " slot 2: " (##sys#slot data 2)
-			    " slot 3: " (##sys#slot data 3))))
     (if frameinfo
 	(let ((ev-list (fold append '()
 			     (map
 			      (lambda (e v)
-				(debug-print (fmt #f "E: " e " v: " v))
-				(do ((i 0 (+ i 1))
+				(do ((i 0 (add1 i))
 				     (be e (cdr be))
 				     (res '()))
 				    ((null? be) res)
-				  (debug-print (fmt #f "List: " (list ':name (car be)
-								      ':id i
-								      ':value (##sys#slot v i))
-						    " res: " res))
 				  (set! res (cons (list ':name (symbol->string (car be))
 							':id i
 							':value (->string (##sys#slot v i)))
@@ -417,10 +407,23 @@
 	  (if (null? ev-list) 'nil ev-list))
 	'nil)))
 
+
+(define (get-local frame index)
+  (and-let* ((vars (frame-info frame))
+	     (frame (and (> (length vars) index)
+			 (list-ref vars index))))
+    (fprintf (current-error-port) "~a -> ~a~%~!" vars frame)
+     frame))
+
+(define (variable-from-callchain frame-idx var-idx)
+  (and-let* ((chain *recent-call-chain*)
+	     (frame (and (> (length chain) frame-idx)
+			 (list-ref chain frame-idx))))
+	    (get-local frame var-idx)))
+
+
 (define (swank:frame-locals-and-catch-tags n . _)
   (let ((cc *recent-call-chain*))
-    (debug-print (fmt #f "Frame " n ": " (list-ref cc n)))
-    (debug-print (fmt #f "call chain length " (length cc)))
     (if (and cc
 	     (>= n 0)
 	     (< n (length cc)))
@@ -524,8 +527,35 @@
                       (slime-node-type node) (node-signature node)))
               (match-nodes (irregex str)))))
 
+
+(define (swank:inspect-frame-var frame index)
+;; an answer seems to be 
+;; (:ok (:id number :title "variable-name"
+;;       :content (( "type" (:value variable-value id))) begin end length))
+;; whereas begin and end are used to display a chunk out of a longer list of things
+;; the id in variable value can be used to further inquire a value
+;; The return of variable form callchain is (:name name :id id :value)
+;; TODO: Use csi's describe function for the content part
+  (and-let* ((var (variable-from-callchain frame index))
+	     (name (second var))
+	     (id (fourth var))
+	     (value (sixth var))
+	     (value-len (or 
+			 (and (list? value) (length value))
+			 1)))
+	    `(:ok (:id 0 
+		   :title ,(->string name)
+		   :content (("unknown type? " (:value ,(->string value) 1)) 0 0 ,value-len)))))
+
+(define (swank:quit-inspector)
+  '(:ok nil))
+
 ;; Unimplemented.
 (define (swank:buffer-first-change . _) '(:ok nil))
 (define (swank:filename-to-modulename . _) '(:ok nil))
 (define (swank:find-definitions-for-emacs . _) '(:ok nil))
 (define (swank:swank-require . _) '(:ok nil))
+
+
+
+