From gcarncross at common-lisp.net  Thu May  1 02:47:32 2008
From: gcarncross at common-lisp.net (gcarncross)
Date: Wed, 30 Apr 2008 22:47:32 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20080501024732.8E0A47C07F@common-lisp.net>

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

Modified Files:
	ChangeLog swank-ecl.lisp 
Log Message:
Remove frames from the backtrace that are in a swank package as those are misleading. Fixup locals display.


--- /project/slime/cvsroot/slime/ChangeLog	2008/04/30 02:10:49	1.1350
+++ /project/slime/cvsroot/slime/ChangeLog	2008/05/01 02:47:32	1.1351
@@ -1,3 +1,10 @@
+2008-04-30  Geo Carncross  <geocar at geocar-laptop>
+
+	* swank-ecl.lisp (call-with-debugging-environment)
+	(in-swank-package-p): Remove frames from the backtrace that are
+	in a swank package as those are misleading. Fixup locals
+	display.
+
 2008-04-29  Geo Carncross  <geocar at gmail.com>
 
 	* swank-ecl.lisp: Backtrace and frame/eval improvements
--- /project/slime/cvsroot/slime/swank-ecl.lisp	2008/04/30 02:10:49	1.20
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2008/05/01 02:47:32	1.21
@@ -226,6 +226,17 @@
 
 (defvar *backtrace* '())
 
+(defun in-swank-package-p (x)
+  (if (consp x) (setf x (frame-name x)))
+  (when (symbolp x)
+    (and
+     (member (symbol-package x)
+             (list #.(find-package :swank)
+                   #.(find-package :swank-backend)
+                   #.(ignore-errors (find-package :swank-mop))
+                   #.(ignore-errors (find-package :swank-loader))))
+     t)))
+
 (defimplementation call-with-debugging-environment (debugger-loop-fn)
   (declare (type function debugger-loop-fn))
   (let* ((*tpl-commands* si::tpl-commands)
@@ -236,7 +247,7 @@
 	 (*read-suppress* nil)
 	 (*tpl-level* (1+ *tpl-level*))
          (*backtrace* (loop for ihs from *ihs-base* below *ihs-top*
-                            collect (list (si::ihs-fun (1+ ihs))
+                            collect (list (si::ihs-fun ihs)
                                           (si::ihs-env ihs)
                                           nil))))
     (loop for f from *frs-base* until *frs-top*
@@ -246,7 +257,7 @@
                         (name (si::frs-tag f)))
                    (unless (fixnump name)
                      (push name (third x)))))))
-    (setf *backtrace* (nreverse *backtrace*))
+    (setf *backtrace* (remove-if #'in-swank-package-p (nreverse *backtrace*)))
     (set-break-env)
     (set-current-ihs)
     (let ((*ihs-base* *ihs-top*))



From gcarncross at common-lisp.net  Fri May  2 01:42:39 2008
From: gcarncross at common-lisp.net (gcarncross)
Date: Thu,  1 May 2008 21:42:39 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20080502014239.215F03C005@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
Trim swank sources from the ECL backtrace.


--- /project/slime/cvsroot/slime/ChangeLog	2008/05/01 02:47:32	1.1351
+++ /project/slime/cvsroot/slime/ChangeLog	2008/05/02 01:42:38	1.1352
@@ -1,4 +1,10 @@
-2008-04-30  Geo Carncross  <geocar at geocar-laptop>
+2008-05-01  Geo Carncross  <geocar at gmail.com>
+
+	* swank-ecl.lisp (call-with-debugging-environment)
+	(is-ignorable-fun-p, is-swank-source-p, in-swank-package-p):
+	Trim swank sources from the ECL backtrace.
+
+2008-04-30  Geo Carncross  <geocar at gmail.com>
 
 	* swank-ecl.lisp (call-with-debugging-environment)
 	(in-swank-package-p): Remove frames from the backtrace that are



From gcarncross at common-lisp.net  Fri May  2 01:43:23 2008
From: gcarncross at common-lisp.net (gcarncross)
Date: Thu,  1 May 2008 21:43:23 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20080502014323.366784406D@common-lisp.net>

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

Modified Files:
	swank-ecl.lisp 
Log Message:
Trim swank sources from the ECL backtrace.


--- /project/slime/cvsroot/slime/swank-ecl.lisp	2008/05/01 02:47:32	1.21
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2008/05/02 01:43:23	1.22
@@ -227,15 +227,31 @@
 (defvar *backtrace* '())
 
 (defun in-swank-package-p (x)
-  (if (consp x) (setf x (frame-name x)))
-  (when (symbolp x)
-    (and
-     (member (symbol-package x)
-             (list #.(find-package :swank)
-                   #.(find-package :swank-backend)
-                   #.(ignore-errors (find-package :swank-mop))
-                   #.(ignore-errors (find-package :swank-loader))))
-     t)))
+  (and
+   (symbolp x)
+   (member (symbol-package x)
+           (list #.(find-package :swank)
+                 #.(find-package :swank-backend)
+                 #.(ignore-errors (find-package :swank-mop))
+                 #.(ignore-errors (find-package :swank-loader))))
+   t))
+
+(defun is-swank-source-p (name)
+  (setf name (pathname name))
+  (pathname-match-p
+   name
+   (make-pathname :defaults swank-loader::*source-directory*
+                  :name (pathname-name name)
+                  :type (pathname-type name)
+                  :version (pathname-version name))))
+
+(defun is-ignorable-fun-p (x)
+  (or
+   (in-swank-package-p (frame-name x))
+   (multiple-value-bind (file position)
+       (ignore-errors (si::bc-file (car x)))
+     (declare (ignore position))
+     (if file (is-swank-source-p file)))))
 
 (defimplementation call-with-debugging-environment (debugger-loop-fn)
   (declare (type function debugger-loop-fn))
@@ -257,7 +273,8 @@
                         (name (si::frs-tag f)))
                    (unless (fixnump name)
                      (push name (third x)))))))
-    (setf *backtrace* (remove-if #'in-swank-package-p (nreverse *backtrace*)))
+    (setf *backtrace* (remove-if #'is-ignorable-fun-p (nreverse *backtrace*)))
+    (Setf *tmp* *backtrace*)
     (set-break-env)
     (set-current-ihs)
     (let ((*ihs-base* *ihs-top*))



From gcarncross at common-lisp.net  Thu May  8 22:54:54 2008
From: gcarncross at common-lisp.net (gcarncross)
Date: Thu,  8 May 2008 18:54:54 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20080508225454.E905271123@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
Bugfix: qualify fixnump


--- /project/slime/cvsroot/slime/ChangeLog	2008/05/02 01:42:38	1.1352
+++ /project/slime/cvsroot/slime/ChangeLog	2008/05/08 22:54:54	1.1353
@@ -1,3 +1,8 @@
+2008-05-08  Geo Carncross  <geocar at gmail.com>
+
+	* swank-ecl.lisp (call-with-debugging-environment)
+	(frame-decode-env): Bugfix: qualify fixnump
+
 2008-05-01  Geo Carncross  <geocar at gmail.com>
 
 	* swank-ecl.lisp (call-with-debugging-environment)



From gcarncross at common-lisp.net  Thu May  8 22:55:02 2008
From: gcarncross at common-lisp.net (gcarncross)
Date: Thu,  8 May 2008 18:55:02 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20080508225502.BDAC13105@common-lisp.net>

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

Modified Files:
	swank-ecl.lisp 
Log Message:
Bugfix: qualify fixnump

--- /project/slime/cvsroot/slime/swank-ecl.lisp	2008/05/02 01:43:23	1.22
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2008/05/08 22:55:02	1.23
@@ -271,7 +271,7 @@
                (when (plusp i)
                  (let* ((x (elt *backtrace* i))
                         (name (si::frs-tag f)))
-                   (unless (fixnump name)
+                   (unless (si::fixnump name)
                      (push name (third x)))))))
     (setf *backtrace* (remove-if #'is-ignorable-fun-p (nreverse *backtrace*)))
     (Setf *tmp* *backtrace*)
@@ -320,7 +320,7 @@
 	     (record1 (cdr record)))
 	(cond ((symbolp record0)
 	       (setq variables (acons record0 record1 variables)))
-	      ((not (fixnump record0))
+	      ((not (si::fixnump record0))
 	       (push record1 functions))
 	      ((symbolp record1)
 	       (push record1 blocks))



From heller at common-lisp.net  Sat May 17 11:03:19 2008
From: heller at common-lisp.net (heller)
Date: Sat, 17 May 2008 07:03:19 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20080517110319.0A5C0330CD@common-lisp.net>

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

Modified Files:
	ChangeLog slime.el 
Log Message:
* slime.el (slime-prin1-to-string): Bind print-length and
print-level.

* slime.el (slime-inspector-limit): New variable.
(slime-inspector-insert-content): Use it.
(slime-inspector-fetch-chunk, slime-inspector-fetch)
(slime-inspector-next-range, slime-inspector-join-chunks): New.



--- /project/slime/cvsroot/slime/ChangeLog	2008/05/08 22:54:54	1.1353
+++ /project/slime/cvsroot/slime/ChangeLog	2008/05/17 11:03:19	1.1354
@@ -1,3 +1,15 @@
+2008-05-17  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-prin1-to-string): Bind print-length and
+	print-level.
+
+2008-05-17  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-inspector-limit): New variable.
+	(slime-inspector-insert-content): Use it.
+	(slime-inspector-fetch-chunk, slime-inspector-fetch)
+	(slime-inspector-next-range, slime-inspector-join-chunks): New.
+
 2008-05-08  Geo Carncross  <geocar at gmail.com>
 
 	* swank-ecl.lisp (call-with-debugging-environment)
--- /project/slime/cvsroot/slime/slime.el	2008/04/17 14:56:43	1.938
+++ /project/slime/cvsroot/slime/slime.el	2008/05/17 11:03:19	1.939
@@ -1664,8 +1664,10 @@
   "Like `prin1-to-string' but don't octal-escape non-ascii characters.
 This is more compatible with the CL reader."
   (with-temp-buffer
-    (let ((print-escape-nonascii nil)
-          (print-escape-newlines nil))
+    (let (print-escape-nonascii
+          print-escape-newlines
+          print-length 
+          print-level)
       (prin1 sexp (current-buffer))
       (buffer-string))))
 
@@ -7413,21 +7415,24 @@
               (goto-line (car point))
               (move-to-column (cdr point)))))))))
 
-(defun slime-inspector-insert-content (content)
-  (destructuring-bind (ispecs len start end) content
-    (slime-inspector-insert-range ispecs len start end t t)))
+(defvar slime-inspector-limit 500)
 
-(defun slime-inspector-insert-range (ispecs len start end prev next)
-  "Insert ISPECS at point.
-LEN is the length of the entire content on the Lisp side.
-START and END are the positions of the subsequnce that ISPECS represents.
-If PREV resp. NEXT are true insert range-buttons as needed."
-  (let ((limit 2000))
+(defun slime-inspector-insert-content (content)
+  (slime-inspector-fetch-chunk
+   content nil 
+   (lambda (chunk)
+     (let ((inhibit-read-only t))
+       (slime-inspector-insert-chunk chunk t t)))))
+
+(defun slime-inspector-insert-chunk (chunk prev next)
+  "Insert CHUNK at point.
+If PREV resp. NEXT are true insert more-buttons as needed."
+  (destructuring-bind (ispecs len start end) chunk
     (when (and prev (> start 0))
-      (slime-inspector-insert-range-button (max 0 (- start limit)) start t))
+      (slime-inspector-insert-more-button start t))
     (mapc #'slime-inspector-insert-ispec ispecs)
     (when (and next (< end len))
-      (slime-inspector-insert-range-button end (min len (+ end limit)) nil))))
+      (slime-inspector-insert-more-button end nil))))
 
 (defun slime-inspector-insert-ispec (ispec)
   (if (stringp ispec)
@@ -7478,7 +7483,7 @@
                              opener)
            (push (slime-inspector-position) slime-inspector-mark-stack))
           (range-button
-           (slime-inspector-fetch-range range-button))
+           (slime-inspector-fetch-more range-button))
           (action-number 
            (slime-eval-async `(swank::inspector-call-nth-action ,action-number)
                              opener))
@@ -7603,24 +7608,56 @@
                       (lambda (parts)
                         (slime-open-inspector parts point)))))
 
-(defun slime-inspector-insert-range-button (start end previous)
+(defun slime-inspector-insert-more-button (index previous)
   (slime-insert-propertized 
-   (list 'slime-range-button (list start end previous)
+   (list 'slime-range-button (list index previous)
          'mouse-face 'highlight
          'face 'slime-inspector-action-face)
    (if previous " [--more--]\n" " [--more--]")))
 
-(defun slime-inspector-fetch-range (button)
-  (destructuring-bind (start end previous) button
-    (slime-eval-async 
-     `(swank:inspector-range ,start ,end)
-     (slime-rcurry
-      (lambda (content prev)
+(defun slime-inspector-fetch-more (button)
+  (destructuring-bind (index prev) button
+    (slime-inspector-fetch-chunk 
+     (list '() (1+ index) index index) prev
+     (slime-rcurry 
+      (lambda (chunk prev)
         (let ((inhibit-read-only t))
           (apply #'delete-region (slime-property-bounds 'slime-range-button))
-          (destructuring-bind (i l s e) content
-            (slime-inspector-insert-range i l s e prev (not prev)))))
-      previous))))
+          (slime-inspector-insert-chunk chunk prev (not prev))))
+      prev))))
+
+(defun slime-inspector-fetch-chunk (chunk prev cont)
+  (slime-inspector-fetch chunk slime-inspector-limit prev cont))
+
+(defun slime-inspector-fetch (chunk limit prev cont)
+  (destructuring-bind (from to) (slime-inspector-next-range chunk limit prev)
+    (cond ((and from to)
+           (slime-eval-async 
+            `(swank:inspector-range ,from ,to)
+            (slime-rcurry (lambda (chunk2 chunk1 limit prev cont)
+                            (slime-inspector-fetch 
+                             (slime-inspector-join-chunks chunk1 chunk2)
+                             limit prev cont))
+                          chunk limit prev cont)))
+          (t (funcall cont chunk)))))
+
+(defun slime-inspector-next-range (chunk limit prev)
+  (destructuring-bind (_ len start end) chunk
+    (let ((count (- end start)))
+      (cond ((and prev (< 0 start) (or (not limit) (< count limit)))
+             (list (if limit (max (- end limit) 0) 0) start))
+            ((and (not prev) (< end len) (or (not limit) (< count limit)))
+             (list end (if limit (+ start limit) most-positive-fixnum)))
+            (t '(nil nil))))))
+
+(defun slime-inspector-join-chunks (chunk1 chunk2)
+  (destructuring-bind (i1 l1 s1 e1) chunk1
+    (destructuring-bind (i2 l2 s2 e2) chunk2
+      (cond ((= e1 s2)
+             (list (append i1 i2) l2 s1 e2))
+            ((= e2 s1)
+             (list (append i2 i1) l2 s2 e1))
+            (t (error "Invalid chunks"))))))
 
 (slime-define-keys slime-inspector-mode-map
   ([return] 'slime-inspector-operate-on-point)



From gcarncross at common-lisp.net  Mon May 19 12:08:24 2008
From: gcarncross at common-lisp.net (gcarncross)
Date: Mon, 19 May 2008 08:08:24 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20080519120824.255432B1EA@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
Load asdf when loading swank asdf

--- /project/slime/cvsroot/slime/ChangeLog	2008/05/17 11:03:19	1.1354
+++ /project/slime/cvsroot/slime/ChangeLog	2008/05/19 12:08:19	1.1355
@@ -1,3 +1,7 @@
+2008-05-19  Geo Carncross  <geocar at gmail.com>
+
+	* contrib/swank-asdf.lisp: Require asdf.
+
 2008-05-17  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-prin1-to-string): Bind print-length and



From gcarncross at common-lisp.net  Mon May 19 12:08:27 2008
From: gcarncross at common-lisp.net (gcarncross)
Date: Mon, 19 May 2008 08:08:27 -0400 (EDT)
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <20080519120827.42FCE601C5@common-lisp.net>

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

Modified Files:
	swank-asdf.lisp 
Log Message:
Load asdf when loading swank asdf

--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2007/09/04 10:32:07	1.1
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2008/05/19 12:08:25	1.2
@@ -9,6 +9,8 @@
 
 (in-package :swank)
 
+(require :asdf)
+
 (defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
   "Compile and load SYSTEM using ASDF.
 Record compiler notes signalled as `compiler-condition's."



From heller at common-lisp.net  Mon May 19 13:12:56 2008
From: heller at common-lisp.net (heller)
Date: Mon, 19 May 2008 09:12:56 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20080519131256.48E4542010@common-lisp.net>

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp: Don't require asdf.

(swank-compile-string): Add reader-conditionals for
sb-ext::restrict-compiler-policy.



--- /project/slime/cvsroot/slime/ChangeLog	2008/05/19 12:08:19	1.1355
+++ /project/slime/cvsroot/slime/ChangeLog	2008/05/19 13:12:52	1.1356
@@ -1,3 +1,12 @@
+2008-05-19  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp: Don't require asdf.
+
+2008-05-19  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (swank-compile-string): Add reader-conditionals
+	for sb-ext::restrict-compiler-policy.
+
 2008-05-19  Geo Carncross  <geocar at gmail.com>
 
 	* contrib/swank-asdf.lisp: Require asdf.
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/04/17 14:56:43	1.195
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2008/05/19 13:12:52	1.196
@@ -14,13 +14,15 @@
 (in-package :swank-backend)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (require 'asdf)
   (require 'sb-bsd-sockets)
   (require 'sb-introspect)
   (require 'sb-posix)
   (require 'sb-cltl2))
 
-(declaim (optimize (debug 2) (sb-c:insert-step-conditions 0)))
+(declaim (optimize (debug 2) 
+                   (sb-c::insert-step-conditions 0)
+                   (sb-c::insert-debug-catch 0)
+                   (sb-c::merge-tail-calls 2)))
 
 (import-from :sb-gray *gray-stream-symbols* :swank-backend)
 
@@ -47,7 +49,12 @@
   (defun sbcl-with-restart-frame ()
     (if (find-symbol "FRAME-HAS-DEBUG-TAG-P" "SB-DEBUG")
         '(:and)
-        '(:or))))
+        '(:or)))
+  (defun sbcl-with-symbol (name package)
+    (if (find-symbol (string name) (string package))
+        '(:and)
+        '(:or)))
+  )
 
 ;;; swank-mop
 
@@ -448,7 +455,10 @@
         (*buffer-offset* position)
         (*buffer-substring* string)
         (filename (temp-file-name))
-        (old-min-debug (assoc 'debug (sb-ext:restrict-compiler-policy))))
+        #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext)
+        (old-min-debug (assoc 'debug (sb-ext:restrict-compiler-policy)))
+        )
+    #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext)
     (when debug
       (sb-ext:restrict-compiler-policy 'debug 3))
     (flet ((compile-it (fn)
@@ -466,6 +476,8 @@
                (compile-it #'load)
                (load (compile-it #'identity)))
         (ignore-errors
+          #+#.(swank-backend::sbcl-with-symbol
+               'restrict-compiler-policy 'sb-ext)
           (sb-ext:restrict-compiler-policy 'debug (or old-min-debug 0))
           (delete-file filename)
           (delete-file (compile-file-pathname filename)))))))



From heller at common-lisp.net  Mon May 19 13:12:56 2008
From: heller at common-lisp.net (heller)
Date: Mon, 19 May 2008 09:12:56 -0400 (EDT)
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <20080519131256.01A8C7E0AD@common-lisp.net>

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

Modified Files:
	swank-asdf.lisp 
Log Message:
* swank-sbcl.lisp: Don't require asdf.

(swank-compile-string): Add reader-conditionals for
sb-ext::restrict-compiler-policy.



--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2008/05/19 12:08:25	1.2
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2008/05/19 13:12:56	1.3
@@ -9,7 +9,8 @@
 
 (in-package :swank)
 
-(require :asdf)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (require :asdf))
 
 (defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
   "Compile and load SYSTEM using ASDF.