From aruttenberg at common-lisp.net  Sat Jun 10 03:27:03 2006
From: aruttenberg at common-lisp.net (aruttenberg)
Date: Fri,  9 Jun 2006 23:27:03 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060610032703.8623770210@common-lisp.net>

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

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
2006-06-09  Alan Ruttenberg <alanr-l at mumble.net>
	* swank-abcl: Update to cvs version of abcl and warnings errors
	when compiling in a buffer will now be properly caught by slime vs
	current behavior of always saying 0 errors 0 warnings and printing
	them in the repl instead


--- /project/slime/cvsroot/slime/ChangeLog	2006/05/31 19:27:31	1.904
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/10 03:27:03	1.905
@@ -1,3 +1,9 @@
+2006-06-09  Alan Ruttenberg <alanr-l at mumble.net>
+	* swank-abcl: Update to cvs version of abcl and warnings errors
+	when compiling in a buffer will now be properly caught by slime vs
+	current behavior of always saying 0 errors 0 warnings and printing
+	them in the repl instead
+	
 2006-05-31  Nathan Bird <nathan at acceleration.net>
 
 	* swank.lisp (*sldb-quit-restart*): New variable.
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2006/05/27 04:18:13	1.37
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2006/06/10 03:27:03	1.38
@@ -277,46 +277,55 @@
 (defvar *buffer-string*)
 (defvar *compile-filename*)
 
+(in-package :swank-backend)
+
 (defun handle-compiler-warning (condition)
-  #+nil
-  (let ((loc (getf (slot-value condition 'excl::plist) :loc)))
-    (signal (make-condition
-             'compiler-condition
-             :original-condition condition
-             :severity :warning
-             :message (format nil "~A" condition)
-             :location (cond (*buffer-name*
-                              (make-location 
-                               (list :buffer *buffer-name*)
-                               (list :position *buffer-start-position*)))
-                             (loc
-                              (destructuring-bind (file . pos) loc
+  (let ((loc nil));(getf (slot-value condition 'excl::plist) :loc)))
+    (unless (member condition *abcl-signaled-conditions*) ; filter condition signaled more than once.
+      (push condition *abcl-signaled-conditions*) 
+      (signal (make-condition
+               'compiler-condition
+               :original-condition condition
+               :severity :warning
+               :message (format nil "~A" condition)
+               :location (cond (*buffer-name*
+                                (make-location 
+                                 (list :buffer *buffer-name*)
+                                 (list :position *buffer-start-position*)))
+                               (loc
+                                (destructuring-bind (file . pos) loc
+                                  (make-location
+                                   (list :file (namestring (truename file)))
+                                   (list :position (1+ pos)))))
+                               (t  
                                 (make-location
-                                 (list :file (namestring (truename file)))
-                                 (list :position (1+ pos)))))
-                             (t  
-                              (make-location
-                               (list :file *compile-filename*)
-                               (list :position 1))))))))
+                                 (list :file *compile-filename*)
+                                 (list :position 1)))))))))
+
+(defvar *abcl-signaled-conditions*)
 
 (defimplementation swank-compile-file (filename load-p
                                        &optional external-format)
   (declare (ignore external-format))
-  (handler-bind ((warning #'handle-compiler-warning))
-    (let ((*buffer-name* nil)
-          (*compile-filename* filename))
-      (multiple-value-bind (fn warn fail) (compile-file filename)
-        (when (and load-p (not fail))
-          (load fn))))))
+  (let ((jvm::*resignal-compiler-warnings* t)
+        (*abcl-signaled-conditions* nil))
+    (handler-bind ((warning #'handle-compiler-warning))
+      (let ((*buffer-name* nil)
+            (*compile-filename* filename))
+        (multiple-value-bind (fn warn fail) (compile-file filename)
+          (when (and load-p (not fail))
+            (load fn)))))))
 
 (defimplementation swank-compile-string (string &key buffer position directory)
   (declare (ignore directory))
-  (handler-bind ((warning #'handle-compiler-warning))
-    (let ((*buffer-name* buffer)
-          (*buffer-start-position* position)
-          (*buffer-string* string))
-      (funcall (compile nil (read-from-string
-                             (format nil "(~S () ~A)" 'lambda string)))))))
+  (let ((jvm::*resignal-compiler-warnings* t)
+        (*abcl-signaled-conditions* nil))
+    (handler-bind ((warning #'handle-compiler-warning))                 
+      (let ((*buffer-name* buffer)
+            (*buffer-start-position* position)
+            (*buffer-string* string))
+        (funcall (compile nil (read-from-string
+                               (format nil "(~S () ~A)" 'lambda string))))))))
 
 #|
 ;;;; Definition Finding



From dcrosher at common-lisp.net  Sun Jun 11 11:02:08 2006
From: dcrosher at common-lisp.net (dcrosher)
Date: Sun, 11 Jun 2006 07:02:08 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060611110208.B954B3A007@common-lisp.net>

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

Modified Files:
	ChangeLog swank-scl.lisp 
Log Message:
Update for the Scieneer CL 1.3.


--- /project/slime/cvsroot/slime/ChangeLog	2006/06/10 03:27:03	1.905
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/11 11:02:08	1.906
@@ -1,4 +1,9 @@
+2006-06-11  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* swank-scl (ext:stream-write-chars): update for SCL 1.3.
+
 2006-06-09  Alan Ruttenberg <alanr-l at mumble.net>
+
 	* swank-abcl: Update to cvs version of abcl and warnings errors
 	when compiling in a buffer will now be properly caught by slime vs
 	current behavior of always saying 0 errors 0 warnings and printing
--- /project/slime/cvsroot/slime/swank-scl.lisp	2006/04/13 04:26:31	1.7
+++ /project/slime/cvsroot/slime/swank-scl.lisp	2006/06/11 11:02:08	1.8
@@ -305,9 +305,11 @@
 ;;; usage this reduces consing.  As the string grows larger then grow to
 ;;; reduce the cost of copying strings around.
 ;;;
-(defmethod ext:stream-write-chars ((stream slime-output-stream) string start end)
+(defmethod ext:stream-write-chars ((stream slime-output-stream)
+                                   string start end waitp)
   (declare (simple-string string)
-	   (type kernel:index start end))
+	   (type kernel:index start end)
+           (ignore waitp))
   (declare (optimize (speed 3)))
   (unless (ext:stream-open-p stream)
     (error 'kernel:simple-stream-error
@@ -334,7 +336,7 @@
                   (let ((column (slot-value stream 'column)))
                     (declare (type kernel:index column))
                     (+ column (- end start))))))))
-  string)
+  (- end start))
 
 ;;;
 



From mkoeppe at common-lisp.net  Wed Jun 14 14:58:27 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Wed, 14 Jun 2006 10:58:27 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060614145827.1FD74111E7@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
(slime-goto-definition): If all definitions of a name have the same
location, go there directly rather than presenting an xref buffer.


--- /project/slime/cvsroot/slime/slime.el	2006/05/29 23:39:47	1.625
+++ /project/slime/cvsroot/slime/slime.el	2006/06/14 14:58:26	1.626
@@ -6331,23 +6331,31 @@
 
 (defun slime-goto-definition (name definitions &optional where)
   (slime-push-definition-stack)
-  (if (slime-length> definitions 1)
-      (slime-show-definitions name definitions)
-    (let ((def (car definitions)))
-      (destructure-case (slime-definition.location def)
-        ;; Take care of errors before switching any windows/buffers.
-        ((:error message)
-         (error "%s" message))
-        (t
-         (cond ((equal where 'window)
-                (slime-goto-definition-other-window (car definitions)))
-               ((equal where 'frame)
-                (let ((pop-up-frames t))
-                  (slime-goto-definition-other-window (car definitions))))
-               (t
-                (slime-goto-source-location (slime-definition.location
-                                             (car definitions)))
-                (switch-to-buffer (current-buffer)))))))))
+  (let ((all-locations-equal
+         (or (null definitions)
+             (let ((first-location (slime-definition.location (first definitions))))
+               (every (lambda (definition)
+                        (equal (slime-definition.location definition)
+                               first-location))
+                      (rest definitions))))))
+    (if (and (slime-length> definitions 1)
+             (not all-locations-equal))
+        (slime-show-definitions name definitions)
+      (let ((def (car definitions)))
+        (destructure-case (slime-definition.location def)
+          ;; Take care of errors before switching any windows/buffers.
+          ((:error message)
+           (error "%s" message))
+          (t
+           (cond ((equal where 'window)
+                  (slime-goto-definition-other-window (car definitions)))
+                 ((equal where 'frame)
+                  (let ((pop-up-frames t))
+                    (slime-goto-definition-other-window (car definitions))))
+                 (t
+                  (slime-goto-source-location (slime-definition.location
+                                               (car definitions)))
+                  (switch-to-buffer (current-buffer))))))))))
 
 (defun slime-goto-definition-other-window (definition)
   (slime-pop-to-other-window)



From mkoeppe at common-lisp.net  Wed Jun 14 14:58:37 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Wed, 14 Jun 2006 10:58:37 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060614145837.B24AF13005@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/ChangeLog	2006/06/11 11:02:08	1.906
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/14 14:58:37	1.907
@@ -1,3 +1,9 @@
+2006-06-14  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-goto-definition): If all definitions of a name
+	have the same location, go there directly rather than presenting
+	an xref buffer.
+
 2006-06-11  Douglas Crosher <dcrosher at common-lisp.net>
 
 	* swank-scl (ext:stream-write-chars): update for SCL 1.3.



From mkoeppe at common-lisp.net  Fri Jun 16 16:33:02 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Fri, 16 Jun 2006 12:33:02 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060616163302.5861F720B0@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
(slime-parse-extended-operator-name) 
(slime-parse-extended-operator-name/make-instance) 
(slime-parse-extended-operator-name/defmethod): New functions,
factored out from slime-enclosing-operator-names.
(slime-parse-extended-operator-name/cerror): New function.
(slime-extended-operator-name-parser-alist): New variable.
(slime-enclosing-operator-names): Use them here.


--- /project/slime/cvsroot/slime/slime.el	2006/06/14 14:58:26	1.626
+++ /project/slime/cvsroot/slime/slime.el	2006/06/16 16:33:01	1.627
@@ -10075,6 +10075,49 @@
   (or (slime-sexp-at-point)
       (error "No expression at point.")))
 
+(defun slime-parse-extended-operator-name (name)
+  "Assume that point is behind the operator call to NAME in the
+current buffer.  If NAME is MAKE-INSTANCE or another operator in
+`slime-extendeded-operator-name-parser-alist', collect additional
+information from the operator call and encode it as an extended
+operator name like (MAKE-INSTANCE CLASS \"make-instance\").  Return
+NAME or the extended operator name."
+  (ignore-errors
+    (let* ((symbol-name (upcase (slime-cl-symbol-name name)))
+           (assoc (assoc symbol-name slime-extended-operator-name-parser-alist)))
+      (when assoc
+        (setq name (funcall (cdr assoc) name)))))
+  name)
+
+(defvar slime-extended-operator-name-parser-alist
+  '(("MAKE-INSTANCE" . slime-parse-extended-operator-name/make-instance)
+    ("MAKE-CONDITION" . slime-parse-extended-operator-name/make-instance)
+    ("ERROR" . slime-parse-extended-operator-name/make-instance)
+    ("SIGNAL" . slime-parse-extended-operator-name/make-instance)
+    ("WARN" . slime-parse-extended-operator-name/make-instance)
+    ("CERROR" . slime-parse-extended-operator-name/cerror)
+    ("DEFMETHOD" . slime-parse-extended-operator-name/defmethod)))
+
+(defun slime-parse-extended-operator-name/make-instance (name)
+  (let ((str (slime-sexp-at-point)))
+    (when (= (aref str 0) ?')
+      (setq name (list :make-instance (substring str 1)
+                       name))))
+  name)
+
+(defun slime-parse-extended-operator-name/cerror (name)
+  (let ((continue-string-sexp (slime-sexp-at-point))
+        (class-sexp  (progn (forward-sexp) (forward-char 1) (slime-sexp-at-point))))
+    (when (= (aref class-sexp 0) ?')
+      (setq name (list :cerror 
+                       continue-string-sexp
+                       (substring class-sexp 1)))))
+  name)
+
+(defun slime-parse-extended-operator-name/defmethod (name)
+  (let ((str (slime-sexp-at-point)))
+    (setq name (list :defmethod str))))
+
 (defun slime-enclosing-operator-names (&optional max-levels)
   "Return the list of operator names of the forms containing point.
 As a secondary value, return the indices of the respective argument to
@@ -10108,26 +10151,9 @@
                 (incf level)
                 (forward-char 1)
                 (when-let (name (slime-symbol-name-at-point))
-                  ;; Detect MAKE-INSTANCE forms and collect the class-name
-                  ;; if exists and is a quoted symbol.
-                  (let ((symbol-name (upcase (slime-cl-symbol-name name))))
-                    (ignore-errors
-                      (cond
-                       ((member symbol-name
-                                '("MAKE-INSTANCE" "MAKE-CONDITION"
-                                  "ERROR" "SIGNAL" "WARN"))
-                        (forward-char (1+ (length name)))
-                        (slime-forward-blanks)
-                        (let ((str (slime-sexp-at-point)))
-                          (when (= (aref str 0) ?')
-                            (setq name (list :make-instance (substring str 1)
-                                             name)))))
-                       ((member symbol-name '("DEFMETHOD"))
-                        (forward-char (1+ (length name))) 
-                        (slime-forward-blanks)
-                        (let ((str (slime-sexp-at-point)))
-                          (setq name (list :defmethod str)))))))
-                  (push name result)
+                  (forward-char (1+ (length name)))
+                  (slime-forward-blanks)
+                  (push (slime-parse-extended-operator-name name) result)
                   (push arg-index arg-indices))
                 (backward-up-list 1)))))))
     (values 



From mkoeppe at common-lisp.net  Fri Jun 16 16:34:14 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Fri, 16 Jun 2006 12:34:14 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060616163414.98C61102E@common-lisp.net>

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

Modified Files:
	swank.lisp 
Log Message:
(operator-designator-to-form): Handle :cerror.
(extra-keywords cerror): Make it work.


--- /project/slime/cvsroot/slime/swank.lisp	2006/05/31 19:27:13	1.380
+++ /project/slime/cvsroot/slime/swank.lisp	2006/06/16 16:34:14	1.381
@@ -1412,6 +1412,9 @@
         (let ((parsed-operator-name (parse-symbol operator-name)))
           (values `(,parsed-operator-name ',(parse-symbol class-name))
                   operator-name)))
+       ((:cerror continue-string class-name)
+        (values `(cerror ,continue-string ',(parse-symbol class-name))
+                'cerror))
        ((:defmethod generic-name)
         (values `(defmethod ,(parse-symbol generic-name))
                 'defmethod))))
@@ -1893,15 +1896,19 @@
   (multiple-value-or (apply #'extra-keywords/make-instance operator args)
                      (call-next-method)))
 
-;;; FIXME: these two don't work yet: they need extra support from
-;;; slime.el (slime-enclosing-operator-names) and swank.lisp
-;;; (OPERATOR-DESIGNATOR-TO-FORM).
 (defmethod extra-keywords ((operator (eql 'cerror))
                            &rest args)
-  (multiple-value-or (apply #'extra-keywords/make-instance operator
-                            (cdr args))
-                     (call-next-method)))
+  (multiple-value-bind (keywords aok determiners)
+      (apply #'extra-keywords/make-instance operator
+             (cdr args))
+    (if keywords
+        (values keywords aok
+                (cons (car args) determiners))
+        (call-next-method))))
 
+;;; FIXME: this one doesn't work yet:  it needs extra support from
+;;; slime.el (slime-extended-operator-name-parser-alist) and swank.lisp
+;;; (OPERATOR-DESIGNATOR-TO-FORM).
 (defmethod extra-keywords ((operator (eql 'change-class)) 
                            &rest args)
   (multiple-value-or (apply #'extra-keywords/change-class operator (cdr args))



From mkoeppe at common-lisp.net  Fri Jun 16 16:35:46 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Fri, 16 Jun 2006 12:35:46 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060616163546.6538277006@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/ChangeLog	2006/06/14 14:58:37	1.907
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/16 16:35:46	1.908
@@ -1,3 +1,16 @@
+2006-06-16  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (operator-designator-to-form): Handle :cerror.
+	(extra-keywords cerror): Make it work.
+
+	* slime.el (slime-parse-extended-operator-name) 
+	(slime-parse-extended-operator-name/make-instance) 
+	(slime-parse-extended-operator-name/defmethod): New functions,
+	factored out from slime-enclosing-operator-names.
+	(slime-parse-extended-operator-name/cerror): New function.
+	(slime-extended-operator-name-parser-alist): New variable.
+	(slime-enclosing-operator-names): Use them here.
+
 2006-06-14  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
 
 	* slime.el (slime-goto-definition): If all definitions of a name



From mkoeppe at common-lisp.net  Sat Jun 17 15:03:59 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sat, 17 Jun 2006 11:03:59 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060617150359.428603301C@common-lisp.net>

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

Modified Files:
	swank.lisp 
Log Message:
(operator-designator-to-form): Handle cerror and change-class with
:make-instance.


--- /project/slime/cvsroot/slime/swank.lisp	2006/06/16 16:34:14	1.381
+++ /project/slime/cvsroot/slime/swank.lisp	2006/06/17 15:03:58	1.382
@@ -1408,13 +1408,10 @@
   (etypecase name
     (cons
      (destructure-case name
-       ((:make-instance class-name operator-name)
+       ((:make-instance class-name operator-name &rest args)
         (let ((parsed-operator-name (parse-symbol operator-name)))
-          (values `(,parsed-operator-name ',(parse-symbol class-name))
+          (values `(,parsed-operator-name , at args ',(parse-symbol class-name))
                   operator-name)))
-       ((:cerror continue-string class-name)
-        (values `(cerror ,continue-string ',(parse-symbol class-name))
-                'cerror))
        ((:defmethod generic-name)
         (values `(defmethod ,(parse-symbol generic-name))
                 'defmethod))))



From mkoeppe at common-lisp.net  Sat Jun 17 15:06:36 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sat, 17 Jun 2006 11:06:36 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060617150636.0247B46121@common-lisp.net>

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

Modified Files:
	swank.lisp 
Log Message:
Remove FIXME.


--- /project/slime/cvsroot/slime/swank.lisp	2006/06/17 15:03:58	1.382
+++ /project/slime/cvsroot/slime/swank.lisp	2006/06/17 15:06:36	1.383
@@ -1903,9 +1903,6 @@
                 (cons (car args) determiners))
         (call-next-method))))
 
-;;; FIXME: this one doesn't work yet:  it needs extra support from
-;;; slime.el (slime-extended-operator-name-parser-alist) and swank.lisp
-;;; (OPERATOR-DESIGNATOR-TO-FORM).
 (defmethod extra-keywords ((operator (eql 'change-class)) 
                            &rest args)
   (multiple-value-or (apply #'extra-keywords/change-class operator (cdr args))



From mkoeppe at common-lisp.net  Sat Jun 17 15:07:09 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sat, 17 Jun 2006 11:07:09 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060617150709.C842146122@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
(slime-parse-extended-operator-name/cerror): Handle cerror and
change-class with :make-instance.
(slime-extended-operator-name-parser-alist): Handle change-class.


--- /project/slime/cvsroot/slime/slime.el	2006/06/16 16:33:01	1.627
+++ /project/slime/cvsroot/slime/slime.el	2006/06/17 15:07:09	1.628
@@ -10096,6 +10096,7 @@
     ("SIGNAL" . slime-parse-extended-operator-name/make-instance)
     ("WARN" . slime-parse-extended-operator-name/make-instance)
     ("CERROR" . slime-parse-extended-operator-name/cerror)
+    ("CHANGE-CLASS" . slime-parse-extended-operator-name/cerror)
     ("DEFMETHOD" . slime-parse-extended-operator-name/defmethod)))
 
 (defun slime-parse-extended-operator-name/make-instance (name)
@@ -10109,9 +10110,9 @@
   (let ((continue-string-sexp (slime-sexp-at-point))
         (class-sexp  (progn (forward-sexp) (forward-char 1) (slime-sexp-at-point))))
     (when (= (aref class-sexp 0) ?')
-      (setq name (list :cerror 
-                       continue-string-sexp
-                       (substring class-sexp 1)))))
+      (setq name (list :make-instance (substring class-sexp 1)
+                       name
+                       continue-string-sexp))))
   name)
 
 (defun slime-parse-extended-operator-name/defmethod (name)



From mkoeppe at common-lisp.net  Sat Jun 17 15:09:43 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sat, 17 Jun 2006 11:09:43 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060617150943.52BAF4904B@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/ChangeLog	2006/06/16 16:35:46	1.908
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/17 15:09:43	1.909
@@ -1,3 +1,12 @@
+2006-06-17  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-parse-extended-operator-name/cerror): Handle
+	cerror and change-class with :make-instance.
+	(slime-extended-operator-name-parser-alist): Handle change-class.
+
+	* swank.lisp (operator-designator-to-form): Handle cerror and
+	change-class with :make-instance.
+
 2006-06-16  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
 
 	* swank.lisp (operator-designator-to-form): Handle :cerror.



From mkoeppe at common-lisp.net  Sat Jun 17 16:10:54 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sat, 17 Jun 2006 12:10:54 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060617161054.AA1D164017@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
(slime-parse-extended-operator-name)
(slime-enclosing-operator-names): Fix the case when point is
within the operator.


--- /project/slime/cvsroot/slime/slime.el	2006/06/17 15:07:09	1.628
+++ /project/slime/cvsroot/slime/slime.el	2006/06/17 16:10:54	1.629
@@ -10076,13 +10076,15 @@
       (error "No expression at point.")))
 
 (defun slime-parse-extended-operator-name (name)
-  "Assume that point is behind the operator call to NAME in the
+  "Assume that point is at the operator NAME in the
 current buffer.  If NAME is MAKE-INSTANCE or another operator in
 `slime-extendeded-operator-name-parser-alist', collect additional
 information from the operator call and encode it as an extended
 operator name like (MAKE-INSTANCE CLASS \"make-instance\").  Return
 NAME or the extended operator name."
   (ignore-errors
+    (forward-char (1+ (length name)))
+    (slime-forward-blanks)
     (let* ((symbol-name (upcase (slime-cl-symbol-name name)))
            (assoc (assoc symbol-name slime-extended-operator-name-parser-alist)))
       (when assoc
@@ -10152,8 +10154,6 @@
                 (incf level)
                 (forward-char 1)
                 (when-let (name (slime-symbol-name-at-point))
-                  (forward-char (1+ (length name)))
-                  (slime-forward-blanks)
                   (push (slime-parse-extended-operator-name name) result)
                   (push arg-index arg-indices))
                 (backward-up-list 1)))))))



From mkoeppe at common-lisp.net  Sat Jun 17 16:11:04 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sat, 17 Jun 2006 12:11:04 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060617161104.DC5F1640A3@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/ChangeLog	2006/06/17 15:09:43	1.909
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/17 16:11:04	1.910
@@ -3,6 +3,9 @@
 	* slime.el (slime-parse-extended-operator-name/cerror): Handle
 	cerror and change-class with :make-instance.
 	(slime-extended-operator-name-parser-alist): Handle change-class.
+	(slime-parse-extended-operator-name)
+	(slime-enclosing-operator-names): Fix the case when point is
+	within the operator.
 
 	* swank.lisp (operator-designator-to-form): Handle cerror and
 	change-class with :make-instance.



From mkoeppe at common-lisp.net  Sun Jun 18 14:53:28 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sun, 18 Jun 2006 10:53:28 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060618145328.0ECA578011@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
(slime-parse-extended-operator-name): Don't move point; fixes infinite
loop.


--- /project/slime/cvsroot/slime/slime.el	2006/06/17 16:10:54	1.629
+++ /project/slime/cvsroot/slime/slime.el	2006/06/18 14:53:27	1.630
@@ -10082,13 +10082,14 @@
 information from the operator call and encode it as an extended
 operator name like (MAKE-INSTANCE CLASS \"make-instance\").  Return
 NAME or the extended operator name."
-  (ignore-errors
-    (forward-char (1+ (length name)))
-    (slime-forward-blanks)
-    (let* ((symbol-name (upcase (slime-cl-symbol-name name)))
-           (assoc (assoc symbol-name slime-extended-operator-name-parser-alist)))
-      (when assoc
-        (setq name (funcall (cdr assoc) name)))))
+  (save-excursion
+    (ignore-errors
+      (forward-char (1+ (length name)))
+      (slime-forward-blanks)
+      (let* ((symbol-name (upcase (slime-cl-symbol-name name)))
+             (assoc (assoc symbol-name slime-extended-operator-name-parser-alist)))
+        (when assoc
+          (setq name (funcall (cdr assoc) name))))))
   name)
 
 (defvar slime-extended-operator-name-parser-alist



From mkoeppe at common-lisp.net  Sun Jun 18 14:53:41 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sun, 18 Jun 2006 10:53:41 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060618145341.E97DE1800B@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/ChangeLog	2006/06/17 16:11:04	1.910
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/18 14:53:41	1.911
@@ -1,3 +1,8 @@
+2006-06-18  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-parse-extended-operator-name): Don't move
+	point; fixes infinite loop.
+
 2006-06-17  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
 
 	* slime.el (slime-parse-extended-operator-name/cerror): Handle



From mkoeppe at common-lisp.net  Sun Jun 18 17:53:23 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sun, 18 Jun 2006 13:53:23 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060618175323.3AD7B1D006@common-lisp.net>

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

Modified Files:
	swank.lisp 
Log Message:
(arglist): Distinguish between provided actual args
and required formal args using the new slot provided-args.
(form-completion): Likewise.
(decoded-arglist-to-string): Use it here to display the argument
list (make-instance 'CLASS-NAME ...) rather
than (make-instance (quote CLASS-NAME) ...).


--- /project/slime/cvsroot/slime/swank.lisp	2006/06/17 15:06:36	1.383
+++ /project/slime/cvsroot/slime/swank.lisp	2006/06/18 17:53:23	1.384
@@ -1480,19 +1480,23 @@
                           (unless (null (cdr arg))
                             (write-char #\space))
                           (pprint-fill *standard-output* (cdr arg) nil)))))
-                   (print-with-highlight (arg &optional (index-ok-p #'=))
+                   (print-with-highlight (arg &optional (index-ok-p #'=)
+                                              (print-fun #'print-arg))
                      (print-space)
                      (cond 
                        ((and highlight (funcall index-ok-p index highlight))
                         (princ "===> ")
-                        (print-arg arg)
+                        (funcall print-fun arg)
                         (princ " <==="))
                        (t
-                        (print-arg arg)))
+                        (funcall print-fun arg)))
                      (incf index)))
             (pprint-logical-block (nil nil :prefix "(" :suffix ")")
               (when operator
                 (print-with-highlight operator))
+              (mapc (lambda (arg)
+                      (print-with-highlight arg #'= #'princ))
+                    (arglist.provided-args arglist))
               (mapc #'print-with-highlight
                     (arglist.required-args arglist))
               (when (arglist.optional-args arglist)
@@ -1603,6 +1607,7 @@
                   (make-optional-arg 'x t))))
 
 (defstruct (arglist (:conc-name arglist.))
+  provided-args         ; list of the provided actual arguments
   required-args         ; list of the required arguments
   optional-args         ; list of the optional arguments
   key-p                 ; whether &key appeared
@@ -1995,9 +2000,8 @@
                (t
                 ;; replace some formal args by determining actual args
                 (remove-actual-args decoded-arglist determining-args)
-                (setf (arglist.required-args decoded-arglist)
-                      (append determining-args
-                              (arglist.required-args decoded-arglist)))))
+                (setf (arglist.provided-args decoded-arglist)
+                      determining-args)))
              (return-from form-completion 
                (values decoded-arglist any-enrichment))))))))
   :not-available)
@@ -2019,9 +2023,10 @@
 	    ((member :not-available))
 	    (list
 	     (return-from form-completion
-               (values (make-arglist :required-args (if remove-args
-                                                        (list arglist)
-                                                        (list gf-name arglist))
+               (values (make-arglist :provided-args (if remove-args
+                                                        nil
+                                                        (list gf-name))
+                                     :required-args (list arglist)
                                      :rest "body" :body-p t)
                        t))))))))
   (call-next-method))



From mkoeppe at common-lisp.net  Sun Jun 18 17:53:33 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sun, 18 Jun 2006 13:53:33 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060618175333.1885D1F009@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/ChangeLog	2006/06/18 14:53:41	1.911
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/18 17:53:32	1.912
@@ -1,5 +1,12 @@
 2006-06-18  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
 
+	* swank.lisp (arglist): Distinguish between provided actual args
+	and required formal args using the new slot provided-args.
+	(form-completion): Likewise.
+	(decoded-arglist-to-string): Use it here to display the argument
+	list (make-instance 'CLASS-NAME ...) rather
+	than (make-instance (quote CLASS-NAME) ...).
+
 	* slime.el (slime-parse-extended-operator-name): Don't move
 	point; fixes infinite loop.
 



From mkoeppe at common-lisp.net  Sun Jun 18 18:21:27 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sun, 18 Jun 2006 14:21:27 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060618182127.2DFC13300A@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
(slime-echo-arglist): Simplify, just use slime-autodoc.


--- /project/slime/cvsroot/slime/slime.el	2006/06/18 14:53:27	1.630
+++ /project/slime/cvsroot/slime/slime.el	2006/06/18 18:21:26	1.631
@@ -5297,17 +5297,7 @@
 
 (defun slime-echo-arglist ()
   "Display the arglist of the current form in the echo area."
-  (multiple-value-bind (names arg-indices)
-      (slime-enclosing-operator-names)
-    (when names
-      (slime-eval-async
-       `(swank:arglist-for-echo-area (quote ,names)
-                                     :arg-indices (quote ,arg-indices))
-       (lexical-let ((buffer (current-buffer)))
-         (lambda (message)
-           (if message
-               (with-current-buffer buffer
-                 (slime-message "%s" (slime-fontify-string message))))))))))
+  (slime-autodoc))
 
 (defun slime-arglist (name)
   "Show the argument list for NAME."



From mkoeppe at common-lisp.net  Sun Jun 18 18:21:54 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sun, 18 Jun 2006 14:21:54 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060618182154.32C683301D@common-lisp.net>

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

Modified Files:
	swank.lisp 
Log Message:
(extra-keywords change-class): Don't drop the first argument.


--- /project/slime/cvsroot/slime/swank.lisp	2006/06/18 17:53:23	1.384
+++ /project/slime/cvsroot/slime/swank.lisp	2006/06/18 18:21:54	1.385
@@ -1910,8 +1910,12 @@
 
 (defmethod extra-keywords ((operator (eql 'change-class)) 
                            &rest args)
-  (multiple-value-or (apply #'extra-keywords/change-class operator (cdr args))
-                     (call-next-method)))
+  (multiple-value-bind (keywords aok determiners)
+      (apply #'extra-keywords/change-class operator (cdr args))
+    (if keywords
+        (values keywords aok
+                (cons (car args) determiners))
+        (call-next-method))))
 
 (defun enrich-decoded-arglist-with-extra-keywords (decoded-arglist form)
   "Determine extra keywords from the function call FORM, and modify



From mkoeppe at common-lisp.net  Sun Jun 18 18:22:30 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sun, 18 Jun 2006 14:22:30 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060618182230.CB6693301E@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:


--- /project/slime/cvsroot/slime/ChangeLog	2006/06/18 17:53:32	1.912
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/18 18:22:30	1.913
@@ -1,11 +1,16 @@
 2006-06-18  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
 
+	* slime.el (slime-echo-arglist): Simplify, just use slime-autodoc.
+
 	* swank.lisp (arglist): Distinguish between provided actual args
 	and required formal args using the new slot provided-args.
 	(form-completion): Likewise.
 	(decoded-arglist-to-string): Use it here to display the argument
 	list (make-instance 'CLASS-NAME ...) rather
 	than (make-instance (quote CLASS-NAME) ...).
+	
+	* swank.lisp (extra-keywords change-class): Don't drop the first
+	argument.
 
 	* slime.el (slime-parse-extended-operator-name): Don't move
 	point; fixes infinite loop.



From heller at common-lisp.net  Sun Jun 25 08:33:16 2006
From: heller at common-lisp.net (heller)
Date: Sun, 25 Jun 2006 04:33:16 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060625083316.7543F7071@common-lisp.net>

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

Modified Files:
	swank-source-path-parser.lisp 
Log Message:
(suppress-sharp-dot): Return a unique symbol to avoid nil entries at
toplevel in the source-map.


--- /project/slime/cvsroot/slime/swank-source-path-parser.lisp	2005/11/07 08:24:32	1.16
+++ /project/slime/cvsroot/slime/swank-source-path-parser.lisp	2006/06/25 08:33:16	1.17
@@ -64,7 +64,10 @@
     (let ((sharp-dot (get-dispatch-macro-character #\# #\. readtable)))
       (set-dispatch-macro-character #\# #\. (lambda (&rest args)
 					      (let ((*read-suppress* t))
-						(apply sharp-dot args)))
+						(apply sharp-dot args))
+					      (if *read-suppress*
+						  (values)
+						  (list (gensym "#."))))
 				    readtable))))
 
 (defun read-and-record-source-map (stream)



From heller at common-lisp.net  Sun Jun 25 08:41:58 2006
From: heller at common-lisp.net (heller)
Date: Sun, 25 Jun 2006 04:41:58 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060625084158.241641E007@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
(test compile-defun): Add a test for #. reader macro at toplevel.
(slime-run-one-test): New command.
(sldb-activate): Recreate the sldb buffer if it doesn't exits. (Can 
happen if someone kills the buffer manually.)
(slime-wait-condition): Add a dummy to slime-stack-eval-tags while waiting
so that the SLDB enters a recursive edit.


--- /project/slime/cvsroot/slime/slime.el	2006/06/18 18:21:26	1.631
+++ /project/slime/cvsroot/slime/slime.el	2006/06/25 08:41:57	1.632
@@ -7771,12 +7771,12 @@
         (recursive-edit)))))
 
 (defun sldb-activate (thread level)
-  (with-current-buffer (sldb-find-buffer thread)
-    (unless (equal sldb-level level)
-      (with-lexical-bindings (thread level)
-        (slime-eval-async `(swank:debugger-info-for-emacs 0 10)
-                          (lambda (result)
-                            (apply #'sldb-setup thread level result)))))))
+  (unless (let ((b (sldb-find-buffer thread)))
+            (and b (with-current-buffer b (equal sldb-level level))))
+    (with-lexical-bindings (thread level)
+      (slime-eval-async `(swank:debugger-info-for-emacs 0 10)
+                        (lambda (result)
+                          (apply #'sldb-setup thread level result))))))
 
 (defun sldb-exit (thread level &optional stepping)
   (when-let (sldb (sldb-find-buffer thread))
@@ -9278,6 +9278,20 @@
         (goto-char (overlay-start o))
         (show-subtree)))))
 
+(defun slime-run-one-test (name)
+  "Ask for the name of a test and then execute the test."
+  (interactive (list (slime-read-test-name)))
+  (let ((test (find name slime-tests :key #'slime-test.name)))
+    (assert test)
+    (let ((slime-tests (list test)))
+      (slime-run-tests))))
+
+(defun slime-read-test-name ()
+  (let ((alist (mapcar (lambda (test) 
+                         (list (symbol-name (slime-test.name test))))
+                       slime-tests)))
+    (read (completing-read "Test: " alist nil t))))
+
 (defun slime-test-should-fail-p (test)
   (member (slime-lisp-implementation-name)
           (slime-test.fails-for test)))
@@ -9474,9 +9488,11 @@
       (cond ((time-less-p end (current-time))
              (error "Timeout waiting for condition: %S" name))
             (t
-             ;; XXX if a process-filter enters a recursive-edit, we
-             ;; hang forever
-             (accept-process-output nil 0 100000))))))
+             ;; tell the debugger to enter recursive edits
+             (let ((slime-stack-eval-tags (cons 'wait slime-stack-eval-tags)))
+               ;; XXX if a process-filter enters a recursive-edit, we
+               ;; hang forever
+               (accept-process-output nil 0 10000)))))))
 
 (defun slime-sync-to-top-level (timeout)
   (slime-wait-condition "top-level" #'slime-at-top-level-p timeout))
@@ -9608,15 +9624,21 @@
           #.*log-events*
           (cl-user::bar))"
        (cl-user::bar))
+      ("#.'(defun x () (/ 1 0))
+        (defun foo () 
+           (cl-user::bar))
+        
+        "
+       (cl-user::bar))
       )
   (slime-check-top-level)
   (with-temp-buffer 
     (lisp-mode)
     (insert program)
     (setq slime-buffer-package ":swank")
-    (slime-compile-defun)
+    (slime-compile-string (buffer-string) 1)
     (setq slime-buffer-package ":cl-user")
-    (slime-sync)
+    (slime-sync-to-top-level 15)
     (goto-char (point-max))
     (slime-previous-note)
     (slime-check error-location-correct



From heller at common-lisp.net  Sun Jun 25 08:45:43 2006
From: heller at common-lisp.net (heller)
Date: Sun, 25 Jun 2006 04:45:43 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060625084543.B26F22D010@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:


--- /project/slime/cvsroot/slime/ChangeLog	2006/06/18 18:22:30	1.913
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/25 08:45:43	1.914
@@ -1,3 +1,17 @@
+2006-06-25  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-source-path-parser.lisp (suppress-sharp-dot): Return a
+	unique symbol to avoid multiple entries for nil at toplevel in the
+	source-map.
+
+	* slime.el (test compile-defun): Add a test for #. reader macro at
+	toplevel.
+	(slime-run-one-test): New command.
+	(sldb-activate): Recreate the sldb buffer if it doesn't
+	exist. (Can happen if someone kills the buffer manually.)
+	(slime-wait-condition): Add a dummy to slime-stack-eval-tags while
+	waiting so that the SLDB enters a recursive edit.
+
 2006-06-18  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
 
 	* slime.el (slime-echo-arglist): Simplify, just use slime-autodoc.



From heller at common-lisp.net  Mon Jun 26 06:24:24 2006
From: heller at common-lisp.net (heller)
Date: Mon, 26 Jun 2006 02:24:24 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060626062424.9577A42051@common-lisp.net>

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

Modified Files:
	swank-sbcl.lisp 
Log Message:
(swank-compile-string): Create temporary file with the string and
compile-file it instead of compiling an anonymous lambda, as before,
in order to better handle eval-when forms.

(tmpnam, temp-file-name): New functions.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2006/04/19 09:18:53	1.155
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2006/06/26 06:24:24	1.156
@@ -291,7 +291,7 @@
       (list :error "No error location available")))
 
 (defun locate-compiler-note (file source-path source)
-  (cond ((and (eq file :lisp)
+  (cond ((and ;;(eq file :lisp)
               *buffer-name*)
          ;; Compiling from a buffer
          (let ((position (+ *buffer-offset*
@@ -377,24 +377,41 @@
 
 ;;;; compile-string
 
+;;; We copy the string to a temporary file in order to get adequate
+;;; semantics for :COMPILE-TOPLEVEL and :LOAD-TOPLEVEL EVAL-WHEN forms
+;;; which the previous approach using
+;;;     (compile nil `(lambda () ,(read-from-string string)))
+;;; did not provide.
+
+(sb-alien:define-alien-routine "tmpnam" sb-alien:c-string
+  (dest (* sb-alien:c-string)))
+
+(defun temp-file-name ()
+  "Return a temporary file name to compile strings into."
+  (concatenate 'string (tmpnam nil) ".lisp"))
+
 (defimplementation swank-compile-string (string &key buffer position directory)
   (declare (ignore directory))
-  (flet ((compileit (cont)
-           (let ((*buffer-name* buffer)
-                 (*buffer-offset* position)
-                 (*buffer-substring* string))
+  (let ((*buffer-name* buffer)
+        (*buffer-offset* position)
+        (*buffer-substring* string)
+        (filename (temp-file-name)))
+    (flet ((compile-it (fn) 
              (with-compilation-hooks ()
-               (with-compilation-unit (:source-plist
-                                       (list :emacs-buffer buffer 
-                                             :emacs-string string
-                                             :emacs-position position))
-                 (funcall cont (compile nil
-                                        `(lambda ()
-                                          ,(read-from-string string)))))))))
-    (if *trap-load-time-warnings*
-        (compileit #'funcall)
-        (funcall (compileit #'identity)))))
-
+               (with-compilation-unit
+                   (:source-plist (list :emacs-buffer buffer
+                                        :emacs-string string
+                                        :emacs-position position))
+                 (funcall fn (compile-file filename))))))
+      (with-open-file (s filename :direction :output :if-exists :error)
+        (write-string string s))
+      (unwind-protect
+           (if *trap-load-time-warnings*
+               (compile-it #'load)
+               (load (compile-it #'identity)))
+        (ignore-errors
+          (delete-file filename)
+          (delete-file (compile-file-pathname filename)))))))
 
 ;;;; Definitions
 



From heller at common-lisp.net  Mon Jun 26 06:28:06 2006
From: heller at common-lisp.net (heller)
Date: Mon, 26 Jun 2006 02:28:06 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060626062806.882C746120@common-lisp.net>

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

Modified Files:
	swank-sbcl.lisp 
Log Message:
(find-definitions): Remove backward compatibly code.


--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2006/06/26 06:24:24	1.156
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2006/06/26 06:28:06	1.157
@@ -419,19 +419,6 @@
   "When true don't handle errors while looking for definitions.
 This is useful when debugging the definition-finding code.")
 
-;;; As of SBCL 0.9.7 most of the gritty details of source location handling
-;;; are supported reasonably well by SB-INTROSPECT.
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun new-definition-source-p ()
-    (if (find-symbol "FIND-DEFINITION-SOURCES-BY-NAME" "SB-INTROSPECT")
-           '(and)
-        '(or))))
-
-;;; SBCL > 0.9.6
-#+#.(swank-backend::new-definition-source-p)
-(progn
-
 (defparameter *definition-types*
   '(:variable defvar
     :constant defconstant
@@ -528,164 +515,6 @@
       (handler-case (function-source-location fun name)
         (error (e)
           (list :error (format nil "Error: ~A" e))))))
-) ;; End >0.9.6
-
-;;; Support for SBCL 0.9.6 and earlier. Feel free to delete this
-;;; after January 2006.
-#-#.(swank-backend::new-definition-source-p)
-(progn
-(defimplementation find-definitions (name)
-  (append (function-definitions name)
-          (compiler-definitions name)))
-
-;;;;; Function definitions
-
-(defun function-definitions (name)
-  (flet ((loc (fn name) (safe-function-source-location fn name)))
-    (append
-     (cond ((and (symbolp name) (macro-function name))
-            (list (list `(defmacro ,name) 
-                        (loc (macro-function name) name))))
-           ((fboundp name)
-            (let ((fn (fdefinition name)))
-              (typecase fn
-                (generic-function
-                 (cons (list `(defgeneric ,name) (loc fn name))
-                       (method-definitions fn)))
-                (t
-                 (list (list `(function ,name) (loc fn name))))))))
-     (when (compiler-macro-function name)
-       (list (list `(define-compiler-macro ,name)
-                   (loc (compiler-macro-function name) name)))))))
-
-;;;; function -> soucre location translation
-
-;;; Here we try to find the source locations for function objects.  We
-;;; have to special case functions which were compiled with C-c C-c.
-;;; For the other functions we used the toplevel form number as
-;;; returned by the sb-introspect package to find the offset in the
-;;; source file.  (If the function has debug-blocks, we should search
-;;; the position of the first code-location; for some reason, that
-;;; doesn't seem to work.)
-
-(defun function-source-location (function &optional name)
-  "Try to find the canonical source location of FUNCTION."
-  (declare (type function function)
-           (ignore name))
-  (find-function-source-location function))
-
-(defun safe-function-source-location (fun name)
-  (if *debug-definition-finding*
-      (function-source-location fun name)
-      (handler-case (function-source-location fun name)
-        (error (e) 
-          (list :error (format nil "Error: ~A" e))))))
-
-(defun find-function-source-location (function)
-  (with-struct (sb-introspect::definition-source- form-path character-offset plist)
-      (sb-introspect:find-definition-source function)
-    (destructuring-bind (&key emacs-buffer emacs-position emacs-string) plist
-      (if emacs-buffer
-          (let ((pos (if form-path 
-                         (with-debootstrapping 
-                           (source-path-string-position
-                            form-path emacs-string))
-                         character-offset)))
-            (make-location `(:buffer ,emacs-buffer)
-                           `(:position ,(+ pos emacs-position))
-                           `(:snippet ,emacs-string)))
-          (cond #+(or) 
-                ;; doesn't work for unknown reasons
-                ((function-has-start-location-p function)
-                 (code-location-source-location (function-start-location function)))
-                ((not (function-source-filename function))
-                 (error "Source filename not recorded for ~A" function))
-                (t
-                 (let* ((pos (function-source-position function))
-                        (snippet (function-hint-snippet function pos)))
-                   (make-location `(:file ,(function-source-filename function))
-                                  `(:position ,pos)
-                                  `(:snippet ,snippet)))))))))
-
-(defun function-source-position (function)
-  ;; We only consider the toplevel form number here.
-  (let* ((tlf (function-toplevel-form-number function))
-         (filename (function-source-filename function))
-         (*readtable* (guess-readtable-for-filename filename)))
-    (with-debootstrapping 
-      (source-path-file-position (list tlf) filename))))
-
-(defun function-source-filename (function)
-  (ignore-errors
-    (namestring 
-     (truename
-      (sb-introspect:definition-source-pathname
-       (sb-introspect:find-definition-source function))))))
-
-(defun function-source-write-date (function)
-  (sb-introspect:definition-source-file-write-date
-      (sb-introspect:find-definition-source function)))
-
-(defun function-toplevel-form-number (function)
-  (car
-   (sb-introspect:definition-source-form-path 
-    (sb-introspect:find-definition-source function))))
-
-(defun function-hint-snippet (function position)
-  (let ((source (get-source-code (function-source-filename function)
-                                 (function-source-write-date function))))
-    (with-input-from-string (s source)
-      (read-snippet s position))))
-
-(defun function-has-start-location-p (function)
-  (ignore-errors (function-start-location function)))
-
-(defun function-start-location (function)
-  (let ((dfun (sb-di:fun-debug-fun function)))
-    (and dfun (sb-di:debug-fun-start-location dfun))))
-
-(defun method-definitions (gf)
-  (let ((methods (sb-mop:generic-function-methods gf))
-        (name (sb-mop:generic-function-name gf)))
-    (loop for method in methods 
-          collect (list `(method ,name ,@(method-qualifiers method)
-                          ,(sb-pcl::unparse-specializers method))
-                        (method-source-location method)))))
-
-(defun method-source-location (method)
-  (safe-function-source-location (or (sb-pcl::method-fast-function method)
-                                     (sb-pcl:method-function method))
-                                 nil))
-  
-;;;;; Compiler definitions
-
-(defun compiler-definitions (name)
-  (let ((fun-info (sb-int:info :function :info name)))
-    (when fun-info
-      (append (transform-definitions fun-info name)
-              (optimizer-definitions fun-info name)))))
-
-(defun transform-definitions (fun-info name)
-  (loop for xform in (sb-c::fun-info-transforms fun-info)
-        for loc = (safe-function-source-location
-                   (sb-c::transform-function xform) name)
-        for typespec = (sb-kernel:type-specifier (sb-c::transform-type xform))
-        for note = (sb-c::transform-note xform)
-        for spec = (if (consp typespec)
-                       `(sb-c:deftransform ,(second typespec) ,note)
-                       `(sb-c:deftransform ,note))
-        collect `(,spec ,loc)))
-
-(defun optimizer-definitions (fun-info fun-name)
-  (let ((otypes '((sb-c::fun-info-derive-type . sb-c:derive-type)
-                  (sb-c::fun-info-ltn-annotate . sb-c:ltn-annotate)
-                  (sb-c::fun-info-ltn-annotate . sb-c:ltn-annotate)
-                  (sb-c::fun-info-optimizer . sb-c:optimizer))))
-    (loop for (reader . name) in otypes
-          for fn = (funcall reader fun-info)
-          when fn collect `((sb-c:defoptimizer ,name)
-                            ,(safe-function-source-location fn fun-name)))))
-) ;; End SBCL <= 0.9.6 compability
 
 (defimplementation describe-symbol-for-emacs (symbol)
   "Return a plist describing SYMBOL.



From heller at common-lisp.net  Mon Jun 26 06:29:15 2006
From: heller at common-lisp.net (heller)
Date: Mon, 26 Jun 2006 02:29:15 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060626062915.C75A14713E@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
*** empty log message ***

--- /project/slime/cvsroot/slime/ChangeLog	2006/06/25 08:45:43	1.914
+++ /project/slime/cvsroot/slime/ChangeLog	2006/06/26 06:29:15	1.915
@@ -1,3 +1,15 @@
+2006-06-26  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (find-definitions): Remove backward
+	compatibility code.
+
+2006-06-26  Lu?s Oliveira <loliveira at common-lisp.net>
+
+	* swank-sbcl.lisp (tmpnam, temp-file-name): New functions.
+	(swank-compile-string): Create temporary file with the string and
+	compile-file it instead of compiling an anonymous lambda, as
+	before, in order to better handle eval-when forms.
+
 2006-06-25  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-source-path-parser.lisp (suppress-sharp-dot): Return a