From sboukarev at common-lisp.net  Fri Jul  2 11:44:15 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 02 Jul 2010 07:44:15 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1OUefH-000665-FH@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv23438

Modified Files:
	ChangeLog swank-fancy-inspector.lisp 
Log Message:
* swank-fancy-inspector.lisp (docstring-ispec): Don't insert an
unnecessary space.
(emacs-inspect): Delete unnecessary "it" in [... it]
buttons.
Don't capitalize every word in some messages.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/06/15 08:50:29	1.393
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/02 11:44:15	1.394
@@ -1,3 +1,11 @@
+2010-07-02  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-fancy-inspector.lisp (docstring-ispec): Don't insert an
+	unnecessary space.
+	(emacs-inspect): Delete unnecessary "it" in [... it]
+	buttons.
+	Don't capitalize every word in some messages.
+
 2010-06-15  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-asdf.lisp (asdf-central-registry): Use an exported
--- /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp	2010/05/29 05:40:18	1.28
+++ /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp	2010/07/02 11:44:15	1.29
@@ -23,7 +23,7 @@
                                   (symbol-value symbol) :newline nil)
                 ;; unbinding constants might be not a good idea, but
                 ;; implementations usually provide a restart.
-                `(" " (:action "[unbind it]"
+                `(" " (:action "[unbind]"
                                ,(lambda () (makunbound symbol))))
                 '((:newline))))
 	      (t '("It is unbound." (:newline))))
@@ -40,21 +40,20 @@
 			  (:value ,(macro-function symbol)))
 			`("It is a function: " 
 			  (:value ,(symbol-function symbol))))
-		    `(" " (:action "[unbind it]"
+		    `(" " (:action "[unbind]"
 				   ,(lambda () (fmakunbound symbol))))
 		    `((:newline)))
 	    `("It has no function value." (:newline)))
-	(docstring-ispec "Function Documentation" symbol 'function)
+	(docstring-ispec "Function documentation" symbol 'function)
 	(when (compiler-macro-function symbol)
-          
 	    (append
              (label-value-line "It also names the compiler macro"
                                (compiler-macro-function symbol) :newline nil)
-             `(" " (:action "[remove it]"
+             `(" " (:action "[remove]"
                             ,(lambda ()
                                      (setf (compiler-macro-function symbol) nil)))
                    (:newline))))
-	(docstring-ispec "Compiler Macro Documentation" 
+	(docstring-ispec "Compiler macro documentation" 
 			 symbol 'compiler-macro)
 	;;
 	;; Package
@@ -64,10 +63,10 @@
                        (:value ,package ,(package-name package))
                        ,@(if (eq :internal status) 
                              `(" "
-                               (:action "[export it]"
+                               (:action "[export]"
                                         ,(lambda () (export symbol package)))))
                        " "
-                       (:action "[unintern it]"
+                       (:action "[unintern]"
                                 ,(lambda () (unintern symbol package)))
                        (:newline))
             '("It is a non-interned symbol." (:newline)))
@@ -97,7 +96,7 @@
 	      75)
 	   (list label ": " docstring '(:newline)))
 	  (t 
-	   (list label ": " '(:newline) "  " docstring '(:newline))))))
+	   (list label ":" '(:newline) "  " docstring '(:newline))))))
 
 (unless (find-method #'emacs-inspect '() (list (find-class 'function)) nil)
   (defmethod emacs-inspect ((f function))




From sboukarev at common-lisp.net  Sun Jul  4 15:55:29 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sun, 04 Jul 2010 11:55:29 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1OVRXV-0004Bc-8x@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv16093

Modified Files:
	ChangeLog swank-asdf.lisp 
Log Message:
* swank-asdf.lisp (asdf:operation-done-p): Fix reloading on
ASDF2. ASDF2 no longer has `asdf:around' method combination.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/02 11:44:15	1.394
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/04 15:55:29	1.395
@@ -1,3 +1,8 @@
+2010-07-04  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-asdf.lisp (asdf:operation-done-p): Fix reloading on
+	ASDF2. ASDF2 no longer has `asdf:around' method combination.
+
 2010-07-02  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-fancy-inspector.lisp (docstring-ispec): Don't insert an
--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2010/06/15 08:50:29	1.29
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2010/07/04 15:55:29	1.30
@@ -189,12 +189,14 @@
 
 (defvar *recompile-system* nil)
 
-#+#.(swank-backend:with-symbol 'around 'asdf)
-(defmethod asdf:operation-done-p asdf:around ((operation asdf:compile-op)
-                                              component)
-  (unless (eql *recompile-system*
-               (asdf:component-system component))
-    (call-next-method)))
+(defmethod asdf:operation-done-p
+    #+#.(swank-backend:with-symbol 'around 'asdf) asdf:around
+    #-#.(swank-backend:with-symbol 'around 'asdf) :around
+    ((operation asdf:compile-op)
+     component)
+    (unless (eql *recompile-system*
+                 (asdf:component-system component))
+      (call-next-method)))
 
 (defslimefun reload-system (name)
   (let ((*recompile-system* (asdf:find-system name)))




From heller at common-lisp.net  Tue Jul  6 12:09:20 2010
From: heller at common-lisp.net (CVS User heller)
Date: Tue, 06 Jul 2010 08:09:20 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1OW6xk-0005AI-5a@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv19836

Modified Files:
	ChangeLog swank-cmucl.lisp 
Log Message:
Find definition for (%primitive NAME ...)

* swank-cmucl.lisp (template-definitions, primitive-definitions):
New functions.
(find-definitions): Use them.

--- /project/slime/cvsroot/slime/ChangeLog	2010/06/22 10:02:49	1.2112
+++ /project/slime/cvsroot/slime/ChangeLog	2010/07/06 12:09:19	1.2113
@@ -1,3 +1,11 @@
+2010-07-06  Helmut Eller  <heller at common-lisp.net>
+
+	Find definition for (%primitive NAME ...)
+
+	* swank-cmucl.lisp (template-definitions, primitive-definitions):
+	New functions.
+	(find-definitions): Use them.
+
 2010-06-22  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-loader.lisp (*architecture-features*): ECL uses :x86_64.
--- /project/slime/cvsroot/slime/swank-cmucl.lisp	2010/05/27 14:47:56	1.224
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp	2010/07/06 12:09:20	1.225
@@ -898,7 +898,9 @@
           (compiler-macro-definitions name)
           (source-transform-definitions name)
           (function-info-definitions name)
-          (ir1-translator-definitions name)))
+          (ir1-translator-definitions name)
+          (template-definitions name)
+          (primitive-definitions name)))
 
 ;;;;; Functions, macros, generic functions, methods
 ;;;
@@ -1248,7 +1250,8 @@
                 (maybe-make-definition (c::function-info-ir2-convert info)
                                        'c::ir2-convert name)
                 (loop for template in (c::function-info-templates info)
-                      collect (list `(c::vop ,(c::template-name template))
+                      collect (list `(,(type-of template)
+                                       ,(c::template-name template))
                                     (function-location 
                                      (c::vop-info-generator-function 
                                       template))))))))
@@ -1257,6 +1260,22 @@
   (maybe-make-definition (ext:info :function :ir1-convert name)
                          'c:def-ir1-translator name))
 
+(defun template-definitions (name)
+  (let* ((templates (c::backend-template-names c::*backend*))
+         (template (gethash name templates)))
+    (etypecase template
+      (null)
+      (c::vop-info
+       (maybe-make-definition (c::vop-info-generator-function template)
+                              (type-of template) name)))))
+
+;; for cases like: (%primitive NAME ...)
+(defun primitive-definitions (name)
+  (let ((csym (find-symbol (string name) 'c)))
+    (and csym
+         (not (eq csym name))
+         (template-definitions csym))))
+
 
 ;;;; Documentation.
 




From sboukarev at common-lisp.net  Fri Jul 16 07:34:23 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Fri, 16 Jul 2010 03:34:23 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1OZfR9-000204-V4@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv7689

Modified Files:
	ChangeLog slime-repl.el 
Log Message:
* slime-repl.el (slime-call-defun): Handle setf-functions.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/04 15:55:29	1.395
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/16 07:34:23	1.396
@@ -1,3 +1,7 @@
+2010-07-16  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-repl.el (slime-call-defun): Handle setf-functions.
+
 2010-07-04  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-asdf.lisp (asdf:operation-done-p): Fix reloading on
--- /project/slime/cvsroot/slime/contrib/slime-repl.el	2010/05/28 14:15:30	1.46
+++ /project/slime/cvsroot/slime/contrib/slime-repl.el	2010/07/16 07:34:23	1.47
@@ -1437,9 +1437,16 @@
 (defun slime-call-defun ()
   "Insert a call to the toplevel form defined around point into the REPL."
   (interactive)
-  (flet ((insert-call (symbol &key (function t)
-                              defclass)
-           (let* ((qualified-symbol-name (slime-qualify-cl-symbol-name symbol))
+  (flet ((insert-call (name &key (function t)
+                            defclass)
+           (let* ((setf (and function
+                               (consp name)
+                               (= (length name) 2)
+                               (eql (car name) 'setf)))
+                  (symbol (if setf
+                              (cadr name)
+                              name))
+                  (qualified-symbol-name (slime-qualify-cl-symbol-name symbol))
                   (symbol-name (slime-cl-symbol-name qualified-symbol-name))
                   (symbol-package (slime-cl-symbol-package qualified-symbol-name))
                   (call (if (equalp (slime-lisp-package) symbol-package)
@@ -1450,12 +1457,17 @@
              (insert (if function
                          "("
                          " "))
+             (when setf
+               (insert "setf ("))
              (if defclass
                  (insert "make-instance '"))
              (insert call)
-             (when function
-               (insert " ")
-               (save-excursion (insert ")")))
+             (cond (setf
+                    (insert " ")
+                    (save-excursion (insert ") )")))
+                   (function
+                    (insert " ")
+                    (save-excursion (insert ")"))))
              (unless function
                (goto-char slime-repl-input-start-mark)))))           
     (let ((toplevel (slime-parse-toplevel-form)))




From sboukarev at common-lisp.net  Wed Jul 21 13:40:32 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 21 Jul 2010 09:40:32 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1ObZXE-0004jn-Py@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv17035

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp (quit-lisp): Use sb-thread:terminate-thread
instead of sb-ext:quit :recklessly-p t. This way
sb-ext:*exit-hooks* will be run.
Reported by Lorenz M??senlechner.


--- /project/slime/cvsroot/slime/ChangeLog	2010/07/06 12:09:19	1.2113
+++ /project/slime/cvsroot/slime/ChangeLog	2010/07/21 13:40:32	1.2114
@@ -1,3 +1,10 @@
+2010-07-21  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-sbcl.lisp (quit-lisp): Use sb-thread:terminate-thread
+	instead of sb-ext:quit :recklessly-p t. This way
+	sb-ext:*exit-hooks* will be run.
+	Reported by Lorenz M?senlechner.
+
 2010-07-06  Helmut Eller  <heller at common-lisp.net>
 
 	Find definition for (%primitive NAME ...)
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2010/04/22 05:47:35	1.271
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2010/07/21 13:40:32	1.272
@@ -1487,8 +1487,7 @@
 (defimplementation quit-lisp ()
   #+sb-thread
   (dolist (thread (remove (current-thread) (all-threads)))
-    (ignore-errors (sb-thread:interrupt-thread
-                    thread (lambda () (sb-ext:quit :recklessly-p t)))))
+    (ignore-errors (sb-thread:terminate-thread thread)))
   (sb-ext:quit))
 
 




From sboukarev at common-lisp.net  Thu Jul 22 13:45:47 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 22 Jul 2010 09:45:47 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1Obw5r-0008Rz-0S@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv32481

Modified Files:
	ChangeLog swank-lispworks.lisp 
Log Message:
* swank-lispworks.lisp (list-callers-internal): Fix for LW6.
(list-callees-internal): New function, use it.


--- /project/slime/cvsroot/slime/ChangeLog	2010/07/21 13:40:32	1.2114
+++ /project/slime/cvsroot/slime/ChangeLog	2010/07/22 13:45:46	1.2115
@@ -1,3 +1,8 @@
+2010-07-22  Vitaly Mayatskikh  <v.mayatskih at gmail.com>
+
+	* swank-lispworks.lisp (list-callers-internal): Fix for LW6.
+	(list-callees-internal): New function, use it.
+
 2010-07-21  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-sbcl.lisp (quit-lisp): Use sb-thread:terminate-thread
--- /project/slime/cvsroot/slime/swank-lispworks.lisp	2010/03/02 12:38:07	1.136
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp	2010/07/22 13:45:46	1.137
@@ -697,8 +697,10 @@
 (defxref who-macroexpands hcl:who-calls) ; macros are in the calls table too
 (defxref calls-who      hcl:calls-who)
 (defxref list-callers   list-callers-internal)
-;; (defxref list-callees   list-callees-internal)
+#+lispworks6
+(defxref list-callees   list-callees-internal)
 
+#-lispworks6
 (defun list-callers-internal (name)
   (let ((callers (make-array 100
                              :fill-pointer 0
@@ -716,6 +718,24 @@
 		      (list 'function object)
                       (or (dspec:object-dspec object) object)))))
 
+#+lispworks6
+(defun list-callers-internal (name)
+    ;; Delay dspec:object-dspec until after sweep-all-objects
+    ;; to reduce allocation problems.
+    (loop for object in (hcl::who-calls name)
+          collect (if (symbolp object)
+		      (list 'function object)
+                      (or (dspec:object-dspec object) object))))
+
+#+lispworks6
+(defun list-callees-internal (name)
+    ;; Delay dspec:object-dspec until after sweep-all-objects
+    ;; to reduce allocation problems.
+    (loop for object in (hcl::calls-who name)
+          collect (if (symbolp object)
+		      (list 'function object)
+                      (or (dspec:object-dspec object) object))))
+
 ;; only for lispworks 4.2 and above
 #-lispworks4.1
 (progn




From sboukarev at common-lisp.net  Fri Jul 23 01:41:27 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 22 Jul 2010 21:41:27 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1Oc7GR-0005NV-DJ@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv20672

Modified Files:
	ChangeLog slime-fancy-inspector.el 
Log Message:
* slime-fancy-inspector.el (slime-fancy-inspector): Add
slime-parse dependency.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/16 07:34:23	1.396
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/23 01:41:27	1.397
@@ -1,3 +1,8 @@
+2010-07-23  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-fancy-inspector.el (slime-fancy-inspector): Add
+	slime-parse dependency.
+
 2010-07-16  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-repl.el (slime-call-defun): Handle setf-functions.
--- /project/slime/cvsroot/slime/contrib/slime-fancy-inspector.el	2010/05/28 14:15:30	1.7
+++ /project/slime/cvsroot/slime/contrib/slime-fancy-inspector.el	2010/07/23 01:41:27	1.8
@@ -3,9 +3,9 @@
   "Fancy inspector for CLOS objects."
   (:authors "Marco Baringer <mb at bese.it> and others")
   (:license "GPL")
+  (:slime-dependencies slime-parse)
   (:swank-dependencies swank-fancy-inspector))
 
-
 (defun slime-inspect-definition ()
   "Inspect definition at point"
   (interactive)
@@ -17,4 +17,4 @@
   (slime-eval-describe `(swank:disassemble-form
                          ,(slime-definition-at-point t))))
 
-(provide 'slime-fancy-inspector)
\ No newline at end of file
+(provide 'slime-fancy-inspector)




From sboukarev at common-lisp.net  Fri Jul 23 01:46:34 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 22 Jul 2010 21:46:34 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1Oc7LO-0005lO-5f@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv22153

Modified Files:
	ChangeLog swank-arglists.lisp 
Log Message:
* swank-arglists.lisp (arglist-dispatch): Export it, so it may be
extended more easily.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/23 01:41:27	1.397
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/23 01:46:34	1.398
@@ -1,5 +1,8 @@
 2010-07-23  Stas Boukarev  <stassats at gmail.com>
 
+	* swank-arglists.lisp (arglist-dispatch): Export it, so it may be
+	extended more easily.
+
 	* slime-fancy-inspector.el (slime-fancy-inspector): Add
 	slime-parse dependency.
 
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2010/05/16 06:11:45	1.67
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2010/07/23 01:46:34	1.68
@@ -963,6 +963,7 @@
       :not-available
       (arglist-dispatch (car form) (cdr form))))
 
+(export 'arglist-dispatch)
 (defgeneric arglist-dispatch (operator arguments)
   ;; Default method
   (:method (operator arguments)




From sboukarev at common-lisp.net  Sat Jul 24 12:15:13 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sat, 24 Jul 2010 08:15:13 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1OcddJ-0006yt-LS@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv26829

Modified Files:
	ChangeLog slime-package-fu.el swank-package-fu.lisp 
Log Message:
* slime-package-fu.el (slime-export-structure): New function,
export all constructors, accessors, etc.
* swank-package-fu.lisp (export-structure): Lisp side of the above
function, works only on SBCL for now.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/23 01:46:34	1.398
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/24 12:15:13	1.399
@@ -1,3 +1,10 @@
+2010-07-24  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-package-fu.el (slime-export-structure): New function,
+	export all constructors, accessors, etc.
+	* swank-package-fu.lisp (export-structure): Lisp side of the above
+	function, works only on SBCL for now.
+
 2010-07-23  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-arglists.lisp (arglist-dispatch): Export it, so it may be
--- /project/slime/cvsroot/slime/contrib/slime-package-fu.el	2010/05/28 14:15:30	1.10
+++ /project/slime/cvsroot/slime/contrib/slime-package-fu.el	2010/07/24 12:15:13	1.11
@@ -208,4 +208,13 @@
 	       (message "Symbol `%s' already exported from `%s'" symbol package))
 	   (slime-export-symbol symbol package)))))
 
+(defun slime-export-structure (name)
+  (interactive (list (slime-read-from-minibuffer "Export structure named: "
+                                                 (slime-symbol-at-point))))
+  (let* ((package (slime-current-package))
+         (symbols (slime-eval `(swank:export-structure ,name ,package))))
+    (dolist (symbol symbols)
+      (slime-frob-defpackage-form package :export symbol))
+    (message "%s symbols exported from `%s'" (length symbols) package)))
+
 (provide 'slime-package-fu)
--- /project/slime/cvsroot/slime/contrib/swank-package-fu.lisp	2008/07/23 14:27:36	1.1
+++ /project/slime/cvsroot/slime/contrib/swank-package-fu.lisp	2010/07/24 12:15:13	1.2
@@ -8,7 +8,7 @@
 
 (defslimefun export-symbol-for-emacs (symbol-str package-str)
   (let ((package (guess-package package-str)))
-    (when package
+    (when packagep
       (let ((*buffer-package* package))
 	(export `(,(from-string symbol-str)) package)))))
 
@@ -18,6 +18,17 @@
       (let ((*buffer-package* package))
 	(unexport `(,(from-string symbol-str)) package)))))
 
+#+sbcl
+(defslimefun export-structure (name package)
+  (let ((*package* (guess-package package)))
+    (when *package*
+     (let* ((dd (sb-kernel:find-defstruct-description (from-string name)))
+            (symbols (list* (sb-kernel:dd-default-constructor dd)
+                            (sb-kernel:dd-predicate-name dd)
+                            (sb-kernel::dd-copier-name dd)
+                            (mapcar #'sb-kernel:dsd-accessor-name
+                                    (sb-kernel:dd-slots dd)))))
+       (export symbols)
+       symbols))))
 
-
-(provide :swank-package-fu)
\ No newline at end of file
+(provide :swank-package-fu)




From sboukarev at common-lisp.net  Sat Jul 24 20:40:55 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sat, 24 Jul 2010 16:40:55 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1OclWh-0007vj-8m@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv30327

Modified Files:
	ChangeLog slime-sprof.el swank-sprof.lisp 
Log Message:
* slime-sprof.el (slime-sprof-start-alloc)
(slime-sprof-start-time): New functions to start profiling in
:alloc and :time mode. The default slime-sprof-start is :cpu.
* swank-sprof.lisp (swank-sprof-start): Accept :mode keyword.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/24 12:15:13	1.399
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/24 20:40:55	1.400
@@ -1,5 +1,12 @@
 2010-07-24  Stas Boukarev  <stassats at gmail.com>
 
+	* slime-sprof.el (slime-sprof-start-alloc)
+	(slime-sprof-start-time): New functions to start profiling in
+	:alloc and :time mode. The default slime-sprof-start is :cpu.
+	* swank-sprof.lisp (swank-sprof-start): Accept :mode keyword.
+
+2010-07-24  Stas Boukarev  <stassats at gmail.com>
+
 	* slime-package-fu.el (slime-export-structure): New function,
 	export all constructors, accessors, etc.
 	* swank-package-fu.lisp (export-structure): Lisp side of the above
--- /project/slime/cvsroot/slime/contrib/slime-sprof.el	2010/05/28 19:13:17	1.11
+++ /project/slime/cvsroot/slime/contrib/slime-sprof.el	2010/07/24 20:40:55	1.12
@@ -37,9 +37,17 @@
 
 ;; Start / stop profiling
 
-(defun slime-sprof-start ()
+(defun slime-sprof-start (&optional (mode :cpu))
   (interactive)
-  (slime-eval `(swank:swank-sprof-start)))
+  (slime-eval `(swank:swank-sprof-start :mode ,mode)))
+
+(defun slime-sprof-start-alloc ()
+  (interactive)
+  (slime-sprof-start :alloc))
+
+(defun slime-sprof-start-time ()
+  (interactive)
+  (slime-sprof-start :time))
 
 (defun slime-sprof-stop ()
   (interactive)
--- /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2009/10/09 14:57:45	1.3
+++ /project/slime/cvsroot/slime/contrib/swank-sprof.lisp	2010/07/24 20:40:55	1.4
@@ -130,12 +130,12 @@
               (find-source-location function))))
         `(:error "No source location available"))))
 
-(defslimefun swank-sprof-start ()
-  (sb-sprof:start-profiling))
+(defslimefun swank-sprof-start (&key (mode :cpu))
+  (sb-sprof:start-profiling :mode mode))
 
 (defslimefun swank-sprof-stop ()
   (sb-sprof:stop-profiling))
 
 )
 
-(provide :swank-sprof)
\ No newline at end of file
+(provide :swank-sprof)




From sboukarev at common-lisp.net  Sat Jul 24 22:37:29 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sat, 24 Jul 2010 18:37:29 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1OcnLV-00007F-IL@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv446

Modified Files:
	ChangeLog swank-package-fu.lisp 
Log Message:
* swank-package-fu.lisp (export-symbol-for-emacs): Fix typo.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/24 20:40:55	1.400
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/24 22:37:29	1.401
@@ -1,5 +1,7 @@
 2010-07-24  Stas Boukarev  <stassats at gmail.com>
 
+	* swank-package-fu.lisp (export-symbol-for-emacs): Fix typo.
+
 	* slime-sprof.el (slime-sprof-start-alloc)
 	(slime-sprof-start-time): New functions to start profiling in
 	:alloc and :time mode. The default slime-sprof-start is :cpu.
--- /project/slime/cvsroot/slime/contrib/swank-package-fu.lisp	2010/07/24 12:15:13	1.2
+++ /project/slime/cvsroot/slime/contrib/swank-package-fu.lisp	2010/07/24 22:37:29	1.3
@@ -8,7 +8,7 @@
 
 (defslimefun export-symbol-for-emacs (symbol-str package-str)
   (let ((package (guess-package package-str)))
-    (when packagep
+    (when package
       (let ((*buffer-package* package))
 	(export `(,(from-string symbol-str)) package)))))
 




From sboukarev at common-lisp.net  Sat Jul 24 23:39:25 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Sat, 24 Jul 2010 19:39:25 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1OcoJR-0004Ix-0e@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv16548

Modified Files:
	ChangeLog slime-package-fu.el swank-package-fu.lisp 
Log Message:
* slime-package-fu.el (slime-frob-defpackage-form): Accept a
symbol or a list of symbols. Optimize inserting several symbols at
a time.
(slime-search-exports-in-defpackage): Search forward until nothing
is found, otherwise it searching for FOO will stop after encountering
FOO-B.
(slime-export-class): Rename from slime-export-structure.

* swank-package-fu.lisp (export-symbol-for-emacs): Fix typo.
(export-structure): Add support for CCL and for exporting
standard-class accessors using MOP.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/24 22:37:29	1.401
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/24 23:39:24	1.402
@@ -1,6 +1,16 @@
 2010-07-24  Stas Boukarev  <stassats at gmail.com>
 
+	* slime-package-fu.el (slime-frob-defpackage-form): Accept a
+	symbol or a list of symbols. Optimize inserting several symbols at
+	a time.
+	(slime-search-exports-in-defpackage): Search forward until nothing
+	is found, otherwise it searching for FOO will stop after encountering
+	FOO-B.
+	(slime-export-class): Rename from slime-export-structure.
+
 	* swank-package-fu.lisp (export-symbol-for-emacs): Fix typo.
+	(export-structure): Add support for CCL and for exporting
+	standard-class accessors using MOP.
 
 	* slime-sprof.el (slime-sprof-start-alloc)
 	(slime-sprof-start-time): New functions to start profiling in
--- /project/slime/cvsroot/slime/contrib/slime-package-fu.el	2010/07/24 12:15:13	1.11
+++ /project/slime/cvsroot/slime/contrib/slime-package-fu.el	2010/07/24 23:39:24	1.12
@@ -124,56 +124,81 @@
       (block nil
         (while (ignore-errors (slime-goto-next-export-clause) t)
           (let ((clause-end (save-excursion (forward-sexp) (point))))
-            (when (and (search-forward symbol-name clause-end t)
-                       (target-symbol-p (slime-symbol-at-point)))
-              (return (point)))))))))
+            (save-excursion
+              (while (search-forward symbol-name clause-end t)
+                (when (target-symbol-p (slime-symbol-at-point))
+                  (return (point)))))))))))
 
-(defun slime-frob-defpackage-form (current-package do-what symbol)
+(defun slime-defpackage-exports ()
+  "Return a list of symbols inside :export clause of a defpackage."
+  ;; Assumes we're inside the beginning of a DEFPACKAGE form.
+  (flet ((normalize-name (name)
+           (replace-regexp-in-string "^\\(\\(#:\\)\\|:\\)"
+                                     "" name)))
+   (save-excursion
+     (loop while (ignore-errors (slime-goto-next-export-clause) t)
+           do (down-list) (forward-sexp)
+           append
+           (loop while (ignore-errors (forward-sexp) t)
+                 collect (normalize-name (slime-symbol-at-point)))
+           do (up-list) (backward-sexp)))))
+
+(defun slime-symbol-exported-p (name symbols)
+  (member* name symbols :test 'equalp))
+
+(defun slime-frob-defpackage-form (current-package do-what symbols)
   "Adds/removes `symbol' from the DEFPACKAGE form of `current-package'
 depending on the value of `do-what' which can either be `:export',
 or `:unexport'.
 
 Returns t if the symbol was added/removed. Nil if the symbol was
 already exported/unexported."
-  (let ((symbol-name (slime-cl-symbol-name symbol)))
-    (save-excursion
-      (slime-goto-package-source-definition current-package)
-      (down-list 1)			; enter DEFPACKAGE form
-      (forward-sexp)			; skip DEFPACKAGE symbol
-      (forward-sexp)			; skip package name
-      (let ((already-exported-p (slime-search-exports-in-defpackage symbol-name)))
-	(ecase do-what
-	  (:export
-	   (if already-exported-p
-	       nil
-	       (prog1 t (slime-insert-export symbol-name))))
-	  (:unexport
-	   (if already-exported-p
-	       (prog1 t (slime-remove-export symbol-name))
-	       nil)))))))
+  (save-excursion
+    (slime-goto-package-source-definition current-package)
+    (down-list 1)			; enter DEFPACKAGE form
+    (forward-sexp)			; skip DEFPACKAGE symbol
+    (forward-sexp)			; skip package name
+    (let ((exported-symbols (slime-defpackage-exports))
+          (symbols (if (consp symbols)
+                       symbols
+                       (list symbols)))
+          (number-of-actions 0))
+      (ecase do-what
+        (:export
+         (slime-add-export)
+         (dolist (symbol symbols)
+           (let ((symbol-name (slime-cl-symbol-name symbol)))
+             (unless (slime-symbol-exported-p symbol-name exported-symbols)
+               (incf number-of-actions)
+               (slime-insert-export symbol-name)))))
+        (:unexport
+         (dolist (symbol symbols)
+           (let ((symbol-name (slime-cl-symbol-name symbol)))
+             (when (slime-symbol-exported-p symbol-name exported-symbols)
+               (slime-remove-export symbol-name)
+               (incf number-of-actions))))))
+      number-of-actions)))
 
+(defun slime-add-export ()
+    (let (point)
+      (save-excursion
+        (while (ignore-errors (slime-goto-next-export-clause) t)
+          (setq point (point))))
+      (cond (point
+             (goto-char point)
+             (down-list)
+             (slime-end-of-list))
+            (t
+             (insert "(:export ")
+             (save-excursion (insert ")"))))))
 
 (defun slime-insert-export (symbol-name)
-  ;; Assumes we're inside the beginning of a DEFPACKAGE form.
-  (flet ((goto-last-export-clause ()
-	   (let (point)
-	     (save-excursion
-	       (while (ignore-errors (slime-goto-next-export-clause) t)
-		 (setq point (point))))
-	     (when point (goto-char point))
-	     point)))
-    (let ((defpackage-point (point))
-	  (symbol-name (funcall slime-export-symbol-representation-function
-				symbol-name)))
-      (cond ((goto-last-export-clause)
-	     (down-list) (slime-end-of-list)
-	     (unless (looking-back "^\\s-*")
-	       (newline-and-indent))
-	     (insert symbol-name))
-	    (t
-	     (slime-end-of-list)
-	     (newline-and-indent)
-	     (insert (format "(:export %s)" symbol-name)))))))
+  ;; Assumes we're at the inside :export after the last symbol
+  (let ((symbol-name (funcall slime-export-symbol-representation-function
+                              symbol-name)))
+    (unless (looking-back "^\\s-*")
+      (newline-and-indent))
+    (insert symbol-name)))
 
 (defun slime-remove-export (symbol-name)
   ;; Assumes we're inside the beginning of a DEFPACKAGE form.
@@ -187,7 +212,6 @@
 	(when (looking-at "^\\s-*$")
 	  (join-line))))))
 
-
 (defun slime-export-symbol-at-point ()
   "Add the symbol at point to the defpackage source definition
 belonging to the current buffer-package. With prefix-arg, remove
@@ -198,23 +222,26 @@
 	(symbol (slime-symbol-at-point)))
     (unless symbol (error "No symbol at point."))
     (cond (current-prefix-arg
-	   (if (slime-frob-defpackage-form package :unexport symbol)
+	   (if (plusp (slime-frob-defpackage-form package :unexport symbol))
 	       (message "Symbol `%s' no longer exported form `%s'" symbol package)
 	       (message "Symbol `%s' is not exported from `%s'" symbol package))
 	   (slime-unexport-symbol symbol package))
 	  (t
-	   (if (slime-frob-defpackage-form package :export symbol)
+	   (if (plusp (slime-frob-defpackage-form package :export symbol))
 	       (message "Symbol `%s' now exported from `%s'" symbol package)
 	       (message "Symbol `%s' already exported from `%s'" symbol package))
 	   (slime-export-symbol symbol package)))))
 
-(defun slime-export-structure (name)
+(defun slime-export-class (name)
+  "Export acessors, constructors, etc. associated with a structure or a class"
   (interactive (list (slime-read-from-minibuffer "Export structure named: "
                                                  (slime-symbol-at-point))))
   (let* ((package (slime-current-package))
          (symbols (slime-eval `(swank:export-structure ,name ,package))))
-    (dolist (symbol symbols)
-      (slime-frob-defpackage-form package :export symbol))
-    (message "%s symbols exported from `%s'" (length symbols) package)))
+    (message "%s symbols exported from `%s'"
+             (slime-frob-defpackage-form package :export symbols)
+             package)))
+
+(defalias 'slime-export-structure 'slime-export-class)
 
 (provide 'slime-package-fu)
--- /project/slime/cvsroot/slime/contrib/swank-package-fu.lisp	2010/07/24 22:37:29	1.3
+++ /project/slime/cvsroot/slime/contrib/swank-package-fu.lisp	2010/07/24 23:39:24	1.4
@@ -19,16 +19,44 @@
 	(unexport `(,(from-string symbol-str)) package)))))
 
 #+sbcl
+(defun list-structure-symbols (name)
+  (let ((dd (sb-kernel:find-defstruct-description name )))
+    (list* (sb-kernel:dd-default-constructor dd)
+           (sb-kernel:dd-predicate-name dd)
+           (sb-kernel::dd-copier-name dd)
+           (mapcar #'sb-kernel:dsd-accessor-name
+                   (sb-kernel:dd-slots dd)))))
+
+#+ccl
+(defun list-structure-symbols (name)
+  (let ((definition (gethash name ccl::%defstructs%)))
+    (list* (ccl::sd-constructor definition)
+           (ccl::sd-refnames definition))))
+
+(defun list-class-symbols (name)
+  (let* ((class (find-class name))
+         (slots (swank-mop:class-direct-slots class)))
+    (labels ((extract-symbol (name)
+               (if (and (consp name) (eql (car name) 'setf))
+                   (cadr name)
+                   name))
+             (slot-accessors (slot)
+               (nintersection (copy-list (swank-mop:slot-definition-readers slot))
+                              (copy-list (swank-mop:slot-definition-readers slot))
+                              :key #'extract-symbol)))
+      (list* (class-name class)
+             (mapcan #'slot-accessors slots)))))
+
 (defslimefun export-structure (name package)
   (let ((*package* (guess-package package)))
     (when *package*
-     (let* ((dd (sb-kernel:find-defstruct-description (from-string name)))
-            (symbols (list* (sb-kernel:dd-default-constructor dd)
-                            (sb-kernel:dd-predicate-name dd)
-                            (sb-kernel::dd-copier-name dd)
-                            (mapcar #'sb-kernel:dsd-accessor-name
-                                    (sb-kernel:dd-slots dd)))))
-       (export symbols)
-       symbols))))
+      (let* ((name (from-string name))
+             (symbols (cond ((or (not (find-class name nil))
+                                 (subtypep name 'structure-object))
+                             (list-structure-symbols name))
+                            (t
+                             (list-class-symbols name)))))
+        (export symbols)
+        symbols))))
 
 (provide :swank-package-fu)




From sboukarev at common-lisp.net  Tue Jul 27 05:10:04 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Tue, 27 Jul 2010 01:10:04 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1OdcQW-00067H-0G@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv23510

Modified Files:
	ChangeLog slime-sprof.el 
Log Message:
* slime-sprof.el (slime-sprof-start): change defun to defun*,
elisp doesn't understand default values for &optional.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/24 23:39:24	1.402
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/27 05:10:03	1.403
@@ -1,3 +1,8 @@
+2010-07-27  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-sprof.el (slime-sprof-start): change defun to defun*,
+	elisp doesn't understand default values for &optional.
+
 2010-07-24  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-package-fu.el (slime-frob-defpackage-form): Accept a
--- /project/slime/cvsroot/slime/contrib/slime-sprof.el	2010/07/24 20:40:55	1.12
+++ /project/slime/cvsroot/slime/contrib/slime-sprof.el	2010/07/27 05:10:03	1.13
@@ -37,7 +37,7 @@
 
 ;; Start / stop profiling
 
-(defun slime-sprof-start (&optional (mode :cpu))
+(defun* slime-sprof-start (&optional (mode :cpu))
   (interactive)
   (slime-eval `(swank:swank-sprof-start :mode ,mode)))
 




From sboukarev at common-lisp.net  Wed Jul 28 15:28:21 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Wed, 28 Jul 2010 11:28:21 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1Oe8YP-0000w3-Tt@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv3596

Modified Files:
	ChangeLog slime-presentations.el 
Log Message:
* slime-presentations.el (slime-copy-presentation-to-repl): Limit
looking-back to one character before point. Solves long freeze on a
large buffer.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/27 05:10:03	1.403
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/28 15:28:21	1.404
@@ -1,3 +1,9 @@
+2010-07-28  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-presentations.el (slime-copy-presentation-to-repl): Limit
+	looking-back to one character before point. Solves long freeze on a
+	large buffer.
+
 2010-07-27  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-sprof.el (slime-sprof-start): change defun to defun*,
--- /project/slime/cvsroot/slime/contrib/slime-presentations.el	2010/05/28 14:15:30	1.36
+++ /project/slime/cvsroot/slime/contrib/slime-presentations.el	2010/07/28 15:28:21	1.37
@@ -435,7 +435,7 @@
     (unless (eql major-mode 'slime-repl-mode)
       (slime-switch-to-output-buffer))
     (flet ((do-insertion ()
-	     (unless (looking-back "\\s-")
+	     (unless (looking-back "\\s-" (- (point) 1))
 	       (insert " "))
 	     (insert presentation-text)
 	     (unless (or (eolp) (looking-at "\\s-"))
@@ -841,4 +841,4 @@
    (in-sldb-face local-value value)
    `(:frame-var ,slime-current-thread ,(car frame) ,index) t))
 
-(provide 'slime-presentations)
\ No newline at end of file
+(provide 'slime-presentations)




From sboukarev at common-lisp.net  Thu Jul 29 08:05:22 2010
From: sboukarev at common-lisp.net (CVS User sboukarev)
Date: Thu, 29 Jul 2010 04:05:22 -0400
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1OeO7G-0002Wz-AK@common-lisp.net>

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv9727

Modified Files:
	ChangeLog slime-c-p-c.el 
Log Message:
* slime-c-p-c.el (slime-complete-form): Limit `looking-back' too.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/28 15:28:21	1.404
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2010/07/29 08:05:22	1.405
@@ -1,3 +1,7 @@
+2010-07-29  Stas Boukarev  <stassats at gmail.com>
+
+	* slime-c-p-c.el (slime-complete-form): Limit `looking-back' too.
+
 2010-07-28  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-presentations.el (slime-copy-presentation-to-repl): Limit
--- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2010/05/28 14:15:30	1.25
+++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el	2010/07/29 08:05:22	1.26
@@ -160,7 +160,9 @@
       (if (eq result :not-available)
           (error "Could not generate completion for the form `%s'" buffer-form)
           (progn
-            (just-one-space (if (looking-back "\\s(") 0 1))
+            (just-one-space (if (looking-back "\\s(" (1- (point)))
+                                0
+                                1))
             (save-excursion
               (insert result)
               (let ((slime-close-parens-limit 1))




From heller at common-lisp.net  Fri Jul 30 16:14:41 2010
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 30 Jul 2010 12:14:41 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1OesEL-0008BB-Nk@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv31427

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (print-part-to-string): Bind *print-readably* to nil.
Useful when debugging broken printer methods.

--- /project/slime/cvsroot/slime/ChangeLog	2010/07/22 13:45:46	1.2115
+++ /project/slime/cvsroot/slime/ChangeLog	2010/07/30 16:14:41	1.2116
@@ -1,3 +1,8 @@
+2010-07-30  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (print-part-to-string): Bind *print-readably* to nil.
+	Useful when debugging broken printer methods.
+
 2010-07-22  Vitaly Mayatskikh  <v.mayatskih at gmail.com>
 
 	* swank-lispworks.lisp (list-callers-internal): Fix for LW6.
--- /project/slime/cvsroot/slime/swank.lisp	2010/06/04 07:30:37	1.720
+++ /project/slime/cvsroot/slime/swank.lisp	2010/07/30 16:14:41	1.721
@@ -3437,7 +3437,8 @@
     index))
 
 (defun print-part-to-string (value)
-  (let* ((string (to-line value))
+  (let* ((*print-readably* nil)
+         (string (to-line value))
          (pos (position value *inspector-history*)))
     (if pos
         (format nil "@~D=~A" pos string)




From heller at common-lisp.net  Fri Jul 30 16:14:50 2010
From: heller at common-lisp.net (CVS User heller)
Date: Fri, 30 Jul 2010 12:14:50 -0400
Subject: [slime-cvs] CVS slime
Message-ID: <E1OesEU-0008CC-Ug@common-lisp.net>

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv31474

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
Don't get confused by END-OF-FILE on unrelated streams.
Fixes bug "slime connection broken on trivial condition..."
Reported by Pascal J. Bourguignon.

* swank.lisp (end-of-repl-input): New condition.
(simple-repl, read-non-blocking): Use it.
* slime.el ([test] end-of-file): Test it.

--- /project/slime/cvsroot/slime/ChangeLog	2010/07/30 16:14:41	1.2116
+++ /project/slime/cvsroot/slime/ChangeLog	2010/07/30 16:14:50	1.2117
@@ -1,5 +1,15 @@
 2010-07-30  Helmut Eller  <heller at common-lisp.net>
 
+	Don't get confused by END-OF-FILE on unrelated streams.
+	Fixes bug "slime connection broken on trivial condition..."
+	Reported by Pascal J. Bourguignon.
+
+	* swank.lisp (end-of-repl-input): New condition.
+	(simple-repl, read-non-blocking): Use it.
+	* slime.el ([test] end-of-file): Test it.
+
+2010-07-30  Helmut Eller  <heller at common-lisp.net>
+
 	* swank.lisp (print-part-to-string): Bind *print-readably* to nil.
 	Useful when debugging broken printer methods.
 
--- /project/slime/cvsroot/slime/slime.el	2010/06/18 12:31:54	1.1329
+++ /project/slime/cvsroot/slime/slime.el	2010/07/30 16:14:50	1.1330
@@ -8082,7 +8082,24 @@
                         3)
   (slime-sync-to-top-level 5))
 
-
+(def-slime-test end-of-file 
+    (expr)
+    "Signalling END-OF-FILE should invoke the debugger."
+    '(((cl:read-from-string ""))
+      ((cl:error 'cl:end-of-file)))
+  (let ((value (slime-eval 
+                `(cl:let ((condition nil))
+                         (cl:with-simple-restart 
+                          (cl:continue "continue")
+                          (cl:let ((cl:*debugger-hook* 
+                                    (cl:lambda (c h)
+                                               (cl:setq condition c)
+                                               (cl:continue))))
+                                  ,expr))
+                         (cl:and (cl:typep condition 'cl:condition)
+                                 (cl:string (cl:type-of condition)))))))
+    (slime-test-expect "Debugger invoked" "END-OF-FILE" value)))
+                      
 (def-slime-test interrupt-at-toplevel
     ()
     "Let's see what happens if we send a user interrupt at toplevel."
--- /project/slime/cvsroot/slime/swank.lisp	2010/07/30 16:14:41	1.721
+++ /project/slime/cvsroot/slime/swank.lisp	2010/07/30 16:14:50	1.722
@@ -1383,12 +1383,16 @@
                      (simple-repl))))))))
     (close-connection connection nil (safe-backtrace))))
 
+;; this is signalled when our custom stream thinks the end-of-file is reached.
+;; (not when the end-of-file on the socket is reached)
+(define-condition end-of-repl-input (end-of-file) ())
+
 (defun simple-repl ()
   (loop
    (format t "~a> " (package-string-for-prompt *package*))
    (force-output)
    (let ((form (handler-case (read)
-                 (end-of-file () (return)))))
+                 (end-of-repl-input () (return)))))
      (let ((- form)
            (values (multiple-value-list (eval form))))
        (setq *** **  ** *  * (car values)
@@ -1423,9 +1427,12 @@
 
 (defun read-non-blocking (stream)
   (with-output-to-string (str)
-    (loop (let ((c (read-char-no-hang stream)))
-            (unless c (return))
-            (write-char c str)))))
+    (handler-case 
+        (loop (let ((c (read-char-no-hang stream)))
+                (unless c (return))
+                (write-char c str)))
+      (end-of-file () (error 'end-of-repl-input :stream stream)))))
+
 
 ;;;; IO to Emacs
 ;;;