From mkoeppe at common-lisp.net  Sat Apr  1 22:54:30 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sat,  1 Apr 2006 17:54:30 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20060401225430.DF76A43001@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
(slime-fontify-string): Use set-text-properties, not
propertize, for Emacs 20 compatibility.  Patch by Matthew D. Swank


--- /project/slime/cvsroot/slime/slime.el	2006/03/30 16:41:52	1.614
+++ /project/slime/cvsroot/slime/slime.el	2006/04/01 22:54:30	1.615
@@ -5267,7 +5267,9 @@
       (font-lock-fontify-buffer))
     (goto-char (point-min))
     (when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t)
-      (let ((highlight (propertize (match-string 1) 'face 'highlight)))
+      (let ((highlight (copy-sequence (match-string 1))))
+        ;;maintain compatibility with emacs 20.x
+        (set-text-properties 0 (length highlight) '(face highlight) highlight)
         ;; Can't use (replace-match highlight) here -- broken in Emacs 21
         (delete-region (match-beginning 0) (match-end 0))
         (insert highlight)))



From mkoeppe at common-lisp.net  Sat Apr  1 22:55:29 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sat,  1 Apr 2006 17:55:29 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20060401225529.2928845030@common-lisp.net>

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

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

--- /project/slime/cvsroot/slime/ChangeLog	2006/03/30 16:42:14	1.878
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/01 22:55:28	1.879
@@ -1,3 +1,8 @@
+2006-04-01  Matthew D. Swank <akopa at charter.net>
+
+	* slime.el (slime-fontify-string): Use set-text-properties, not
+	propertize, for Emacs 20 compatibility.
+
 2006-03-30  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-init-command): Don't translate filenames since



From mkoeppe at common-lisp.net  Sun Apr  2 18:26:48 2006
From: mkoeppe at common-lisp.net (mkoeppe)
Date: Sun,  2 Apr 2006 14:26:48 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060402182648.7C6534F008@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
(slime-fontify-string): Use slime-insert-propertized rather than
set-text-properties or propertize.


--- /project/slime/cvsroot/slime/slime.el	2006/04/01 22:54:30	1.615
+++ /project/slime/cvsroot/slime/slime.el	2006/04/02 18:26:47	1.616
@@ -5267,13 +5267,11 @@
       (font-lock-fontify-buffer))
     (goto-char (point-min))
     (when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t)
-      (let ((highlight (copy-sequence (match-string 1))))
-        ;;maintain compatibility with emacs 20.x
-        (set-text-properties 0 (length highlight) '(face highlight) highlight)
+      (let ((highlight (match-string 1)))
         ;; Can't use (replace-match highlight) here -- broken in Emacs 21
         (delete-region (match-beginning 0) (match-end 0))
-        (insert highlight)))
-    (buffer-substring (point-min) (point-max))))    
+	(slime-insert-propertized '(face highlight) highlight)))
+    (buffer-substring (point-min) (point-max))))
 
 (defun slime-echo-arglist ()
   "Display the arglist of the current form in the echo area."



From nsiivola at common-lisp.net  Wed Apr 12 08:43:56 2006
From: nsiivola at common-lisp.net (nsiivola)
Date: Wed, 12 Apr 2006 04:43:56 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060412084356.40E6864009@common-lisp.net>

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

Modified Files:
	ChangeLog swank-backend.lisp swank-gray.lisp swank-sbcl.lisp 
Log Message:
Stream locking patch from Robert Macomber

--- /project/slime/cvsroot/slime/ChangeLog	2006/04/01 22:55:28	1.879
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/12 08:43:55	1.880
@@ -1,3 +1,16 @@
+2006-04-12  Robert Macomber <slime at rojoma.com>
+	* swank-backend.lisp (make-recursive-lock): New interface
+	function.
+	(call-with-recursive-lock-held): New interface function. 
+	
+	* swank-grey.lisp (class slime-output-stream): Added recursive
+	locking to class and generic functions specialized on it.
+	(clss slime-input-stream): Added recursive locking to class and
+	generic functions specialized on it.
+
+	* swank-sbcl.lisp (make-recursive-lock): Implement the new interface.
+	(call-with-recursive-lock): Implement the new interface.
+		
 2006-04-01  Matthew D. Swank <akopa at charter.net>
 
 	* slime.el (slime-fontify-string): Use set-text-properties, not
--- /project/slime/cvsroot/slime/swank-backend.lisp	2006/03/22 16:40:01	1.97
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2006/04/12 08:43:55	1.98
@@ -836,6 +836,24 @@
             (type function function))
    (funcall function))
 
+(definterface make-recursive-lock (&key name)
+  "Make a lock for thread synchronization.
+Only one thread may hold the lock (via CALL-WITH-RECURSIVE-LOCK-HELD)
+at a time, but that thread may hold it more than once."
+  (cons nil (make-lock :name name)))
+
+(definterface call-with-recursive-lock-held (lock function)
+  "Call FUNCTION with LOCK held, queueing if necessary."
+  (if (eql (car lock) (current-thread))
+      (funcall function)
+      (call-with-lock-held (cdr lock)
+                           (lambda ()
+                             (unwind-protect
+                                  (progn
+                                    (setf (car lock) (current-thread))
+                                    (funcall function))
+                               (setf (car lock) nil))))))
+
 (definterface current-thread ()
   "Return the currently executing thread."
   0)
--- /project/slime/cvsroot/slime/swank-gray.lisp	2005/09/22 20:15:11	1.9
+++ /project/slime/cvsroot/slime/swank-gray.lisp	2006/04/12 08:43:55	1.10
@@ -15,86 +15,115 @@
    (buffer :initform (make-string 8000))
    (fill-pointer :initform 0)
    (column :initform 0)
-   (last-flush-time :initform (get-internal-real-time))))
+   (last-flush-time :initform (get-internal-real-time))
+   (lock :initform (make-recursive-lock :name "buffer write lock"))))
 
 (defmethod stream-write-char ((stream slime-output-stream) char)
-  (with-slots (buffer fill-pointer column) stream
-    (setf (schar buffer fill-pointer) char)
-    (incf fill-pointer)
-    (incf column)
-    (when (char= #\newline char)
-      (setf column 0)
-      (force-output stream))
-    (when (= fill-pointer (length buffer))
-      (finish-output stream)))
+  (call-with-recursive-lock-held
+   (slot-value stream 'lock)
+   (lambda ()
+     (with-slots (buffer fill-pointer column) stream
+       (setf (schar buffer fill-pointer) char)
+       (incf fill-pointer)
+       (incf column)
+       (when (char= #\newline char)
+         (setf column 0)
+         (force-output stream))
+       (when (= fill-pointer (length buffer))
+         (finish-output stream)))))
   char)
 
 (defmethod stream-line-column ((stream slime-output-stream))
-  (slot-value stream 'column))
+  (call-with-recursive-lock-held
+   (slot-value stream 'lock)
+   (lambda ()
+     (slot-value stream 'column))))
 
 (defmethod stream-line-length ((stream slime-output-stream))
   75)
 
 (defmethod stream-finish-output ((stream slime-output-stream))
-  (with-slots (buffer fill-pointer output-fn last-flush-time) stream
-    (let ((end fill-pointer))
-      (unless (zerop end)
-        (funcall output-fn (subseq buffer 0 end))
-        (setf fill-pointer 0)))
-    (setf last-flush-time (get-internal-real-time)))
+  (call-with-recursive-lock-held
+   (slot-value stream 'lock)
+   (lambda ()
+     (with-slots (buffer fill-pointer output-fn last-flush-time) stream
+       (let ((end fill-pointer))
+         (unless (zerop end)
+           (funcall output-fn (subseq buffer 0 end))
+           (setf fill-pointer 0)))
+       (setf last-flush-time (get-internal-real-time)))))
   nil)
 
 (defmethod stream-force-output ((stream slime-output-stream))
-  (with-slots (last-flush-time fill-pointer) stream
-    (let ((now (get-internal-real-time)))
-      (when (> (/ (- now last-flush-time)
-                  (coerce internal-time-units-per-second 'double-float))
-               0.2)
-        (finish-output stream))))
+  (call-with-recursive-lock-held
+   (slot-value stream 'lock)
+   (lambda ()
+     (with-slots (last-flush-time fill-pointer) stream
+       (let ((now (get-internal-real-time)))
+         (when (> (/ (- now last-flush-time)
+                     (coerce internal-time-units-per-second 'double-float))
+                  0.2)
+           (finish-output stream))))))
   nil)
 
 (defmethod stream-fresh-line ((stream slime-output-stream))
-  (with-slots (column) stream
-    (cond ((zerop column) nil)
-          (t (terpri stream) t))))
+  (call-with-recursive-lock-held
+   (slot-value stream 'lock)
+   (lambda ()
+     (with-slots (column) stream
+       (cond ((zerop column) nil)
+             (t (terpri stream) t))))))
 
 (defclass slime-input-stream (fundamental-character-input-stream)
   ((output-stream :initarg :output-stream)
    (input-fn :initarg :input-fn)
-   (buffer :initform "") (index :initform 0)))
+   (buffer :initform "") (index :initform 0)
+   (lock :initform (make-lock :name "buffer read lock"))))
 
 (defmethod stream-read-char ((s slime-input-stream))
-  (with-slots (buffer index output-stream input-fn) s
-    (when (= index (length buffer))
-      (when output-stream
-        (finish-output output-stream))
-      (let ((string (funcall input-fn)))
-        (cond ((zerop (length string))
-               (return-from stream-read-char :eof))
-              (t
-               (setf buffer string)
-               (setf index 0)))))
-    (assert (plusp (length buffer)))
-    (prog1 (aref buffer index) (incf index))))
+  (call-with-lock-held
+   (slot-value s 'lock)
+   (lambda ()
+     (with-slots (buffer index output-stream input-fn) s
+       (when (= index (length buffer))
+         (when output-stream
+           (finish-output output-stream))
+         (let ((string (funcall input-fn)))
+           (cond ((zerop (length string))
+                  (return-from stream-read-char :eof))
+                 (t
+                  (setf buffer string)
+                  (setf index 0)))))
+       (assert (plusp (length buffer)))
+       (prog1 (aref buffer index) (incf index))))))
 
 (defmethod stream-listen ((s slime-input-stream))
-  (with-slots (buffer index) s
-    (< index (length buffer))))
+  (call-with-lock-held
+   (slot-value s 'lock)
+   (lambda ()
+     (with-slots (buffer index) s
+       (< index (length buffer))))))
 
 (defmethod stream-unread-char ((s slime-input-stream) char)
-  (with-slots (buffer index) s
-    (decf index)
-    (cond ((eql (aref buffer index) char)
-           (setf (aref buffer index) char))
-          (t
-           (warn "stream-unread-char: ignoring ~S (expected ~S)"
-                 char (aref buffer index)))))
+  (call-with-lock-held
+   (slot-value s 'lock)
+   (lambda ()
+     (with-slots (buffer index) s
+       (decf index)
+       (cond ((eql (aref buffer index) char)
+              (setf (aref buffer index) char))
+             (t
+              (warn "stream-unread-char: ignoring ~S (expected ~S)"
+                    char (aref buffer index)))))))
   nil)
 
 (defmethod stream-clear-input ((s slime-input-stream))
-  (with-slots (buffer index) s 
-    (setf buffer ""  
-	  index 0))
+  (call-with-lock-held
+   (slot-value s 'lock)
+   (lambda ()
+     (with-slots (buffer index) s 
+       (setf buffer ""  
+             index 0))))
   nil)
 
 (defmethod stream-line-column ((s slime-input-stream))
@@ -113,9 +142,12 @@
 ;; We could make do with either of the two methods below.
 
 (defmethod stream-read-char-no-hang ((s slime-input-stream))
-  (with-slots (buffer index) s
-    (when (< index (length buffer))
-      (prog1 (aref buffer index) (incf index)))))
+  (call-with-lock-held
+   (slot-value s 'lock)
+   (lambda ()
+     (with-slots (buffer index) s
+       (when (< index (length buffer))
+         (prog1 (aref buffer index) (incf index)))))))
 
 ;; This CLISP extension is what listen_char actually calls.  The
 ;; default method would call STREAM-READ-CHAR-NO-HANG, so it is a bit
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2006/03/22 16:40:01	1.153
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2006/04/12 08:43:55	1.154
@@ -1136,6 +1136,13 @@
     (declare (type function function))
     (sb-thread:with-mutex (lock) (funcall function)))
 
+  (defimplementation make-recursive-lock (&key name)
+    (sb-thread:make-mutex :name name))
+
+  (defimplementation call-with-recursive-lock-held (lock function)
+    (declare (type function function))
+    (sb-thread:with-recursive-lock (lock) (funcall function)))
+
   (defimplementation current-thread ()
     sb-thread:*current-thread*)
 



From dcrosher at common-lisp.net  Thu Apr 13 04:26:32 2006
From: dcrosher at common-lisp.net (dcrosher)
Date: Thu, 13 Apr 2006 00:26:32 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060413042632.207DA4E006@common-lisp.net>

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

Modified Files:
	ChangeLog swank-scl.lisp 
Log Message:
* Update the Scieneer CL backend.


--- /project/slime/cvsroot/slime/ChangeLog	2006/04/12 08:43:55	1.880
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/13 04:26:31	1.881
@@ -1,3 +1,20 @@
+2006-04-13  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* swank-scl (make-socket-io-stream): set the stream to ignore
+	character conversion errors, and to substitute the character #\?.
+	Without this the communication channel is prone to lockup when a
+	conversion error occurs.
+
+	* swank-scl (inspect-for-emacs function): correct the index into the
+	closure environment; it was reading off the end of the closure
+	environment and picking up a corrupting value.
+
+	* swank-scl (mailbox): rework the mailbox implementation to better
+	handle interruption.  Use a polling loop rather than condition
+	variables because interrupting a condition variable wait leaves the
+	thread with the condition variable lock held and leads to a deadlock
+	error.
+
 2006-04-12  Robert Macomber <slime at rojoma.com>
 	* swank-backend.lisp (make-recursive-lock): New interface
 	function.
--- /project/slime/cvsroot/slime/swank-scl.lisp	2006/03/22 16:40:01	1.6
+++ /project/slime/cvsroot/slime/swank-scl.lisp	2006/04/13 04:26:31	1.7
@@ -12,26 +12,10 @@
 
 ;;; swank-mop
 
-(import-swank-mop-symbols :clos '(:slot-definition-documentation
-                                  :eql-specializer
-                                  :eql-specializer-object))
+(import-swank-mop-symbols :clos '(:slot-definition-documentation))
 
 (defun swank-mop:slot-definition-documentation (slot)
-  (slot-value slot 'documentation))
-
-(defun swank-mop:specializer-direct-methods (obj)
-  (declare (ignore obj))
-  nil)
-
-(deftype swank-mop:eql-specializer ()
-  '(or kernel:member-type kernel:numeric-type))
-
-(defun swank-mop:eql-specializer-object (obj)
-  (etypecase obj
-    (kernel:numeric-type
-     (kernel:type-specifier obj))
-    (kernel:member-type
-     (first (kernel:member-type-members obj)))))
+  (documentation slot t))
 
 
 ;;;; TCP server
@@ -94,10 +78,15 @@
 
 (defun make-socket-io-stream (fd external-format buffering)
   "Create a new input/output fd-stream for 'fd."
-  (let ((external-format (find-external-format external-format)))
-    (sys:make-fd-stream fd :input t :output t :element-type 'base-char
-                        :buffering buffering
-                        :external-format external-format)))
+  (let* ((external-format (find-external-format external-format))
+         (stream (sys:make-fd-stream fd :input t :output t
+                                     :element-type 'base-char
+                                     :buffering buffering
+                                     :external-format external-format)))
+    ;; Ignore character conversion errors.  Without this the communication
+    ;; channel is prone to lockup if a character conversion error occurs.
+    (setf (cl::stream-character-conversion-error-value stream) #\?)
+    stream))
 
 
 ;;;; Stream handling
@@ -1762,23 +1751,6 @@
 	(t
          (scl-inspect o))))
 
-(defimplementation inspect-for-emacs ((o standard-object)
-                                      (inspector scl-inspector))
-  (declare (ignore inspector))
-  (let ((c (class-of o)))
-    (values "An object."
-            `("Class: " (:value ,c) (:newline)
-              "Slots:" (:newline)
-              ,@(loop for slotd in (clos:class-slots c)
-                      for name = (clos:slot-definition-name slotd)
-                      collect `(:value ,slotd ,(string name))
-                      collect " = "
-                      collect (if (clos:slot-boundp-using-class c o name)
-                                  `(:value ,(clos:slot-value-using-class 
-                                             c o name))
-                                  "#<unbound>")
-                      collect '(:newline))))))
-
 (defun scl-inspect (o)
   (destructuring-bind (text labeledp . parts)
       (inspect::describe-parts o)
@@ -1809,7 +1781,8 @@
                    (append 
                     (label-value-line "Function" (kernel:%closure-function o))
                     `("Environment:" (:newline))
-                    (loop for i from 0 below (1- (kernel:get-closure-length o))
+                    (loop for i from 0 below (- (kernel:get-closure-length o)
+                                                (1- vm:closure-info-offset))
                           append (label-value-line 
                                   i (kernel:%closure-index-ref o i))))))
           ((eval::interpreted-function-p o)
@@ -1999,9 +1972,9 @@
 (defvar *mailbox-lock* (thread:make-lock "Mailbox lock"))
   
 (defstruct (mailbox)
-  (lock (thread:make-lock "Thread mailbox" :type :error-check)
+  (lock (thread:make-lock "Thread mailbox" :type :error-check
+                          :interruptible nil)
         :type thread:error-check-lock)
-  (cond-var (thread:make-cond-var "Thread mailbox") :type thread:cond-var)
   (queue '() :type list))
 
 (defun mailbox (thread)
@@ -2012,22 +1985,31 @@
   
 (defimplementation send (thread message)
   (let* ((mbox (mailbox thread))
-         (lock (mailbox-lock mbox))
-         (cond-var (mailbox-cond-var mbox)))
-    (thread:with-lock-held (lock "Mailbox Send")
-      (setf (mailbox-queue mbox) (nconc (mailbox-queue mbox) (list message)))
-      (thread:cond-var-broadcast cond-var))
+         (lock (mailbox-lock mbox)))
+    (sys:without-interrupts
+      (thread:with-lock-held (lock "Mailbox Send")
+        (setf (mailbox-queue mbox) (nconc (mailbox-queue mbox)
+                                          (list message)))))
+    (mp:process-wakeup thread)
     message))
   
 (defimplementation receive ()
   (let* ((mbox (mailbox thread:*thread*))
-         (lock (mailbox-lock mbox))
-         (cond-var (mailbox-cond-var mbox)))
-    (thread:with-lock-held (lock "Mailbox Receive")
-      (loop
-       (when (mailbox-queue mbox)
-         (return (pop (mailbox-queue mbox))))
-       (thread:cond-var-timedwait cond-var lock 10 "Mailbox receive wait")))))
+         (lock (mailbox-lock mbox)))
+    (loop
+     (mp:process-wait-with-timeout "Mailbox read wait" 1
+                                   #'(lambda () (mailbox-queue mbox)))
+     (multiple-value-bind (message winp)
+	 (sys:without-interrupts
+           (mp:with-lock-held (lock "Mailbox read")
+             (let ((queue (mailbox-queue mbox)))
+               (cond (queue
+                      (setf (mailbox-queue mbox) (cdr queue))
+                      (values (car queue) t))
+                     (t
+                      (values nil nil))))))
+       (when winp
+         (return message))))))
 
 
 



From heller at common-lisp.net  Thu Apr 13 05:51:33 2006
From: heller at common-lisp.net (heller)
Date: Thu, 13 Apr 2006 01:51:33 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060413055133.B88024814D@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
(slime-find-filename-translators): Use assof-if instead
of assoc-default for XEmacs compatibility.

(slime-show-note-counts): Don't show the highlighting bit as it
spills of the screen.
(slime-highlight-notes): Use with-temp-message.
(with-temp-message): Define it for XEmacs.

(slime-beginning-of-symbol): Use eq instead of char-equal as
char-equal signals an error at the beginning of a buffer.


--- /project/slime/cvsroot/slime/slime.el	2006/04/02 18:26:47	1.616
+++ /project/slime/cvsroot/slime/slime.el	2006/04/13 05:51:33	1.617
@@ -1266,7 +1266,8 @@
            filename))
 
 (defun slime-find-filename-translators (hostname)
-  (or (assoc-default hostname slime-filename-translations #'string-match)
+  (or (cdr (assoc-if (lambda (regexp) (string-match regexp hostname))
+                     slime-filename-translations))
       (error "No filename-translations for hostname: %s" hostname)))
 
 (defun slime-make-tramp-file-name (username remote-host lisp-filename)
@@ -4382,16 +4383,11 @@
      ,(if (buffer-file-name) (file-name-directory (buffer-file-name))))
    (slime-compilation-finished-continuation)))
 
-(defvar slime-hide-style-warning-count-if-zero t)
-
 (defun slime-note-count-string (severity count &optional suppress-if-zero)
   (cond ((and (zerop count) suppress-if-zero)
          "")
         (t (format "%2d %s%s " count severity (if (= count 1) "" "s")))))
 
-(defvar slime-note-counts-message ""
-  "A string that contains a summary of the compilation notes.")
-
 (defun slime-show-note-counts (notes &optional secs)
   (let ((nerrors 0) (nwarnings 0) (nstyle-warnings 0) (nnotes 0))
     (dolist (note notes)
@@ -4400,15 +4396,12 @@
         (:warning             (incf nwarnings))
         (:style-warning       (incf nstyle-warnings))
         (:note                (incf nnotes))))
-    (setq slime-note-counts-message
-          (format "Compilation finished:%s%s%s%s%s"
-                  (slime-note-count-string "error" nerrors)
-                  (slime-note-count-string "warning" nwarnings)
-                  (slime-note-count-string "style-warning" nstyle-warnings 
-                                           slime-hide-style-warning-count-if-zero)
-                  (slime-note-count-string "note" nnotes)
-                  (if secs (format "[%s secs]" secs) "")))
-    (message "%s" slime-note-counts-message)))
+    (message "Compilation finished:%s%s%s%s%s"
+             (slime-note-count-string "error" nerrors)
+             (slime-note-count-string "warning" nwarnings)
+             (slime-note-count-string "style-warning" nstyle-warnings t)
+             (slime-note-count-string "note" nnotes)
+             (if secs (format "[%s secs]" secs) ""))))
 
 (defun slime-xrefs-for-notes (notes)
   (let ((xrefs))
@@ -4460,11 +4453,10 @@
 (defun slime-highlight-notes (notes)
   "Highlight compiler notes, warnings, and errors in the buffer."
   (interactive (list (slime-compiler-notes)))
-  (message "%s.  Highlighting notes..." slime-note-counts-message)
-  (save-excursion
-    (slime-remove-old-overlays)
-    (mapc #'slime-overlay-note (slime-merge-notes-for-display notes)))
-  (message "%s.  Highlighting notes...done." slime-note-counts-message))
+  (with-temp-message "Highlighting notes..."
+    (save-excursion
+      (slime-remove-old-overlays)
+      (mapc #'slime-overlay-note (slime-merge-notes-for-display notes)))))
 
 (defun slime-compiler-notes ()
   "Return all compiler notes, warnings, and errors."
@@ -4559,22 +4551,20 @@
 (defun slime-list-compiler-notes (&optional notes)
   "Show the compiler notes NOTES in tree view."
   (interactive)
-  (message "%s.  Preparing compiler note tree..." 
-           slime-note-counts-message)
-  (let ((notes (or notes (slime-compiler-notes))))
-    (with-current-buffer
-        (slime-get-temp-buffer-create "*compiler notes*"
-                                      :mode 'slime-compiler-notes-mode)
-      (let ((inhibit-read-only t))
-        (erase-buffer)
-        (when (null notes)
-          (insert "[no notes]"))
-        (dolist (tree (slime-compiler-notes-to-tree notes))
-          (slime-tree-insert tree "")
-          (insert "\n")))
-      (setq buffer-read-only t)
-      (goto-char (point-min))))
-  (message "%s" slime-note-counts-message))
+  (with-temp-message "Preparing compiler note tree..."
+    (let ((notes (or notes (slime-compiler-notes))))
+      (with-current-buffer
+          (slime-get-temp-buffer-create "*compiler notes*"
+                                        :mode 'slime-compiler-notes-mode)
+        (let ((inhibit-read-only t))
+          (erase-buffer)
+          (when (null notes)
+            (insert "[no notes]"))
+          (dolist (tree (slime-compiler-notes-to-tree notes))
+            (slime-tree-insert tree "")
+            (insert "\n")))
+        (setq buffer-read-only t)
+        (goto-char (point-min))))))
 
 (defun slime-alistify (list key test)
   "Partition the elements of LIST into an alist.  KEY extracts the key
@@ -9974,7 +9964,7 @@
   (when (slime-point-moves-p
           (while (slime-point-moves-p 
                    (skip-syntax-backward "w_")
-                   (when (char-equal (char-before) ?|)
+                   (when (eq (char-before) ?|)
                      (backward-sexp)))))
     (when (eq (char-before) ?#) ; special case for things like "#<foo"
       (forward-char))))
@@ -10328,6 +10318,21 @@
             (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
     "The directory for writing temporary files."))
 
+(unless (fboundp 'with-temp-message)
+  (defmacro with-temp-message (message &rest body)
+    (let ((current-message (make-symbol "current-message"))
+          (temp-message (make-symbol "with-temp-message")))
+      `(let ((,temp-message ,message)
+             (,current-message))
+         (unwind-protect
+             (progn
+               (when ,temp-message
+                 (setq ,current-message (current-message))
+                 (message "%s" ,temp-message))
+               , at body)
+           (and ,temp-message ,current-message
+                (message "%s" ,current-message)))))))
+
 (defun slime-emacs-20-p ()
   (and (not (featurep 'xemacs))
        (= emacs-major-version 20)))



From heller at common-lisp.net  Thu Apr 13 05:51:45 2006
From: heller at common-lisp.net (heller)
Date: Thu, 13 Apr 2006 01:51:45 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060413055145.AB48548151@common-lisp.net>

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

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

--- /project/slime/cvsroot/slime/ChangeLog	2006/04/13 04:26:31	1.881
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/13 05:51:45	1.882
@@ -1,3 +1,14 @@
+2006-04-13  Helmut Eller  <helmut at common-lisp.net>
+
+	* slime.el (slime-find-filename-translators): Use assoc-if instead
+	of assoc-default for XEmacs compatibility.
+	(slime-show-note-counts): Don't show the highlighting bit as it
+	spills of the screen.
+	(slime-highlight-notes): Use with-temp-message.
+	(with-temp-message): Define it for XEmacs.
+	(slime-beginning-of-symbol): Use eq instead of char-equal as
+	char-equal signals an error at the beginning of a buffer.
+	
 2006-04-13  Douglas Crosher <dcrosher at common-lisp.net>
 
 	* swank-scl (make-socket-io-stream): set the stream to ignore
@@ -16,6 +27,7 @@
 	error.
 
 2006-04-12  Robert Macomber <slime at rojoma.com>
+
 	* swank-backend.lisp (make-recursive-lock): New interface
 	function.
 	(call-with-recursive-lock-held): New interface function. 



From msimmons at common-lisp.net  Thu Apr 13 10:41:59 2006
From: msimmons at common-lisp.net (msimmons)
Date: Thu, 13 Apr 2006 06:41:59 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060413104159.F2A4C2012@common-lisp.net>

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

Modified Files:
	swank-loader.lisp 
Log Message:

(load-site-init-file, swank-source-files): Fix
pathname construction to take all unspecified components from the
directory pathname, in particular the drive letter on Windows.


--- /project/slime/cvsroot/slime/swank-loader.lisp	2006/03/16 17:26:27	1.58
+++ /project/slime/cvsroot/slime/swank-loader.lisp	2006/04/13 10:41:59	1.59
@@ -175,13 +175,13 @@
 
 (defun load-site-init-file (directory)
   (load (make-pathname :name "site-init" :type "lisp"
-                       :directory (pathname-directory directory))
+                       :defaults directory)
         :if-does-not-exist nil))
 
 (defun swank-source-files (source-directory)
   (mapcar (lambda (name)
             (make-pathname :name name :type "lisp"
-                           :directory (pathname-directory source-directory)))
+                           :defaults source-directory))
           `("swank-backend" ,@*sysdep-files* "swank")))
 
 (defvar *fasl-directory* (default-fasl-directory)



From msimmons at common-lisp.net  Thu Apr 13 10:44:26 2006
From: msimmons at common-lisp.net (msimmons)
Date: Thu, 13 Apr 2006 06:44:26 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060413104426.0BC7C2012@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:


--- /project/slime/cvsroot/slime/ChangeLog	2006/04/13 05:51:45	1.882
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/13 10:44:25	1.883
@@ -1,3 +1,9 @@
+2006-04-13  Martin Simmons <martin at lispworks.com>
+
+	* swank-loader.lisp (load-site-init-file, swank-source-files): Fix
+	pathname construction to take all unspecified components from the
+	directory pathname, in particular the drive letter on Windows.
+
 2006-04-13  Helmut Eller  <helmut at common-lisp.net>
 
 	* slime.el (slime-find-filename-translators): Use assoc-if instead



From heller at common-lisp.net  Fri Apr 14 16:06:56 2006
From: heller at common-lisp.net (heller)
Date: Fri, 14 Apr 2006 12:06:56 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060414160656.593D242000@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
* slime.el (slime-autodoc): Fix reference to unbound variable.

--- /project/slime/cvsroot/slime/slime.el	2006/04/13 05:51:33	1.617
+++ /project/slime/cvsroot/slime/slime.el	2006/04/14 16:06:56	1.618
@@ -5355,29 +5355,26 @@
   (if slime-autodoc-mode
       (progn 
         (slime-autodoc-start-timer)
-        (add-hook 'pre-command-hook 'slime-autodoc-pre-command-refresh-echo-area t))
+        (add-hook 'pre-command-hook 
+                  'slime-autodoc-pre-command-refresh-echo-area t))
     (slime-autodoc-stop-timer)))
 
 (defvar slime-autodoc-last-message "")
 
 (defun slime-autodoc ()
   "Print some apropos information about the code at point, if applicable."
-  (multiple-value-bind (cache-key retrieve-form)
-      (slime-autodoc-thing-at-point)
-    (unless
-        (when-let (documentation (slime-get-cached-autodoc cache-key))
-          (slime-autodoc-message documentation)
-          t)
-      ;; Asynchronously fetch, cache, and display documentation
-      (slime-eval-async 
-       retrieve-form 
-       (with-lexical-bindings (cache-key name)
-         (lambda (doc)
-           (if (null doc)
-               (setq doc "")
-             (setq doc (slime-fontify-string doc)))
-           (slime-update-autodoc-cache cache-key doc)
-           (slime-autodoc-message doc)))))))
+  (destructuring-bind (cache-key retrieve-form) (slime-autodoc-thing-at-point)
+    (let ((cached (slime-get-cached-autodoc cache-key)))
+      (if cached 
+          (slime-autodoc-message cached)
+        ;; Asynchronously fetch, cache, and display documentation
+        (slime-eval-async 
+         retrieve-form
+         (with-lexical-bindings (cache-key)
+           (lambda (doc)
+             (let ((doc (if doc (slime-fontify-string doc) "")))
+               (slime-update-autodoc-cache cache-key doc)
+               (slime-autodoc-message doc)))))))))
 
 (defcustom slime-autodoc-use-multiline-p nil
   "If non-nil, allow long autodoc messages to resize echo area display."



From heller at common-lisp.net  Fri Apr 14 16:07:10 2006
From: heller at common-lisp.net (heller)
Date: Fri, 14 Apr 2006 12:07:10 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060414160710.713A77D001@common-lisp.net>

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

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

--- /project/slime/cvsroot/slime/ChangeLog	2006/04/13 10:44:25	1.883
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/14 16:07:10	1.884
@@ -1,3 +1,7 @@
+2006-04-14  Gerd Flaig <gefla at pond.sub.org>
+
+	* slime.el (slime-autodoc): Fix reference to unbound variable.
+
 2006-04-13  Martin Simmons <martin at lispworks.com>
 
 	* swank-loader.lisp (load-site-init-file, swank-source-files): Fix



From asimon at common-lisp.net  Sun Apr 16 23:33:38 2006
From: asimon at common-lisp.net (asimon)
Date: Sun, 16 Apr 2006 19:33:38 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060416233338.CDF504200D@common-lisp.net>

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

Modified Files:
	swank-abcl.lisp 
Log Message:
(accept-connection): New argument: timeout.

--- /project/slime/cvsroot/slime/swank-abcl.lisp	2006/02/02 02:45:11	1.34
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2006/04/16 23:33:38	1.35
@@ -113,8 +113,8 @@
   (ext:server-socket-close socket))
 
 (defimplementation accept-connection (socket 
-                                      &key (external-format :iso-latin-1-unix) buffering)
-  (declare (ignore buffering))
+                                      &key (external-format :iso-latin-1-unix) buffering timeout)
+  (declare (ignore buffering timeout))
   (assert (eq external-format :iso-latin-1-unix))
   (ext:get-socket-stream (ext:socket-accept socket)))
 



From asimon at common-lisp.net  Sun Apr 16 23:34:20 2006
From: asimon at common-lisp.net (asimon)
Date: Sun, 16 Apr 2006 19:34:20 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060416233420.054B04200D@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:


--- /project/slime/cvsroot/slime/ChangeLog	2006/04/14 16:07:10	1.884
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/16 23:34:19	1.885
@@ -1,3 +1,7 @@
+2005-04-17  Andras Simon <andras at renyi.hu>
+
+	* swank-abcl.lisp: (accept-connection): New argument: timeout.
+
 2006-04-14  Gerd Flaig <gefla at pond.sub.org>
 
 	* slime.el (slime-autodoc): Fix reference to unbound variable.



From ewiborg at common-lisp.net  Tue Apr 18 07:47:09 2006
From: ewiborg at common-lisp.net (ewiborg)
Date: Tue, 18 Apr 2006 03:47:09 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060418074709.4960F4814D@common-lisp.net>

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

Modified Files:
	ChangeLog swank-corman.lisp 
Log Message:
Define a class file-stream to let swank.lisp
load.


--- /project/slime/cvsroot/slime/ChangeLog	2006/04/16 23:34:19	1.885
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/18 07:47:08	1.886
@@ -1,3 +1,8 @@
+2006-04-18  Espen Wiborg  <espenhw at grumblesmurf.org>
+
+	* swank-corman.lisp: Define a class file-stream to let swank.lisp
+	load.
+
 2005-04-17  Andras Simon <andras at renyi.hu>
 
 	* swank-abcl.lisp: (accept-connection): New argument: timeout.
--- /project/slime/cvsroot/slime/swank-corman.lisp	2006/03/22 16:40:01	1.6
+++ /project/slime/cvsroot/slime/swank-corman.lisp	2006/04/18 07:47:09	1.7
@@ -387,6 +387,9 @@
 
 ;;;; Inspecting
 
+;; Hack to make swank.lisp load, at least
+(defclass file-stream ())
+
 (defclass corman-inspector (inspector)
   ())
 



From crhodes at common-lisp.net  Wed Apr 19 09:18:53 2006
From: crhodes at common-lisp.net (crhodes)
Date: Wed, 19 Apr 2006 05:18:53 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060419091853.CC0F932007@common-lisp.net>

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
Use the NIL communication style for sbcl/win32 (and document it, too)


--- /project/slime/cvsroot/slime/ChangeLog	2006/04/18 07:47:08	1.886
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/19 09:18:53	1.887
@@ -1,3 +1,10 @@
+2006-04-19  Christophe Rhodes <csr21 at cam.ac.uk>
+
+	* swank-sbcl.lisp (preferred-communication-style): Make it nil
+	under win32, for now.
+
+	* doc/slime.texi: document nil *communication-style*
+
 2006-04-18  Espen Wiborg  <espenhw at grumblesmurf.org>
 
 	* swank-corman.lisp: Define a class file-stream to let swank.lisp
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2006/04/12 08:43:55	1.154
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2006/04/19 09:18:53	1.155
@@ -32,11 +32,15 @@
 ;;; TCP Server
 
 (defimplementation preferred-communication-style ()
-  (if (and (member :sb-thread *features*)
-           #+linux
-           (not (sb-alien:extern-alien "linux_no_threads_p" sb-alien:boolean)))
-      :spawn
-      :fd-handler))
+  (cond
+    ;; fixme: when SBCL/win32 gains better select() support, remove
+    ;; this.
+    ((member :win32 *features*) nil)
+    ((and (member :sb-thread *features*)
+          #+linux
+          (not (sb-alien:extern-alien "linux_no_threads_p" sb-alien:boolean)))
+      :spawn)
+    (t :fd-handler)))
         
 (defun resolve-hostname (name)
   (car (sb-bsd-sockets:host-ent-addresses



From crhodes at common-lisp.net  Wed Apr 19 09:18:54 2006
From: crhodes at common-lisp.net (crhodes)
Date: Wed, 19 Apr 2006 05:18:54 -0400 (EDT)
Subject: [slime-cvs] CVS slime/doc
Message-ID: <20060419091854.126263401E@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
Use the NIL communication style for sbcl/win32 (and document it, too)


--- /project/slime/cvsroot/slime/doc/slime.texi	2006/03/03 15:03:31	1.44
+++ /project/slime/cvsroot/slime/doc/slime.texi	2006/04/19 09:18:53	1.45
@@ -46,7 +46,7 @@
 @end macro
 
 @set EDITION 1.2
- at set UPDATED @code{$Date: 2006/03/03 15:03:31 $}
+ at set UPDATED @code{$Date: 2006/04/19 09:18:53 $}
 
 @titlepage
 @title SLIME User Manual
@@ -1415,6 +1415,12 @@
 The available communication styles are:
 
 @table @code
+ at item NIL
+This style simply loops reading input from the communication socket
+and serves @SLIME{} protocol events as they arise. The simplicity
+means that the Lisp cannot do any other processing while under
+ at SLIME{}'s control.
+
 @item :FD-HANDLER
 This style uses the classical Unix-style ``@code{select()}-loop.''
 Swank registers the communication socket with an event-dispatching
@@ -1446,11 +1452,11 @@
 
 The default request handling style is chosen according to the
 capabilities your Lisp system. The general order of preference is
- at code{:SPAWN}, then @code{:SIGIO}, then @code{:FD-HANDLER}. You can
-check the default style by calling
- at code{SWANK-BACKEND:PREFERRED-COMMUNICATION-STYLE}. You can also
-override the default by setting @code{SWANK:*COMMUNICATION-STYLE*} in
-your Swank init file.
+ at code{:SPAWN}, then @code{:SIGIO}, then @code{:FD-HANDLER}, with
+ at code{NIL} as a last resort. You can check the default style by
+calling @code{SWANK-BACKEND:PREFERRED-COMMUNICATION-STYLE}. You can
+also override the default by setting
+ at code{SWANK:*COMMUNICATION-STYLE*} in your Swank init file.
 
 @node Other configurables,  , Communication style, Lisp-side
 @subsection Other configurables



From crhodes at common-lisp.net  Wed Apr 19 15:13:05 2006
From: crhodes at common-lisp.net (crhodes)
Date: Wed, 19 Apr 2006 11:13:05 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060419151305.2D6051D006@common-lisp.net>

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
Fixes/improvements to the make-instance highlighting.
* shared-initialize and allocate-instance keywords

Also fixes to general keyword argument list handling: notably getting 
the keyword and variable the right way round.


--- /project/slime/cvsroot/slime/ChangeLog	2006/04/19 09:18:53	1.887
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/19 15:13:04	1.888
@@ -1,5 +1,23 @@
 2006-04-19  Christophe Rhodes <csr21 at cam.ac.uk>
 
+	* swank.lisp (decoded-arglist-to-string): if the keyword and the
+	variable are different, print the keyword name with escapes.
+	(encode-keyword-arg): get the keyword and the arg-name the same
+	way round as in lambda lists.
+	(appliable-methods-keywords): use
+	swank-mop:compute-applicable-methods-using-classes and
+	compute-applicable-methods in the AMOP-friendly way, to get EQL
+	specializers right.
+	(class-from-class-name-form, extra-keywords/slots): new.
+	(extra-keywords/make-instance): use new functions.  Also get
+	keywords from SHARED-INITIALIZE (after Dan Barlow) and
+	ALLOCATE-INSTANCE.
+	(extra-keywords/change-class): new.
+	(extra-keywords (eql 'change-class)): new.  Won't work at present,
+	just as the CERROR case doesn't work.
+	
+2006-04-19  Christophe Rhodes <csr21 at cam.ac.uk>
+
 	* swank-sbcl.lisp (preferred-communication-style): Make it nil
 	under win32, for now.
 
--- /project/slime/cvsroot/slime/swank.lisp	2006/03/28 20:41:53	1.375
+++ /project/slime/cvsroot/slime/swank.lisp	2006/04/19 15:13:05	1.376
@@ -1462,6 +1462,24 @@
                    (print-with-space (obj)
                      (print-space)
                      (print-arg obj))
+                   (print-keyword-arg-with-space (arg)
+                     (print-space)
+                     (etypecase arg
+                       (symbol (princ arg))
+                       ((cons symbol) 
+                        (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+                          (princ (car arg))
+                          (write-char #\space)
+                          (pprint-fill *standard-output* (cdr arg) nil)))
+                       ((cons cons)
+                        (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+                          (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+                            (prin1 (caar arg))
+                            (write-char #\space)
+                            (princ (cadar arg)))
+                          (unless (null (cdr arg))
+                            (write-char #\space))
+                          (pprint-fill *standard-output* (cdr arg) nil)))))
                    (print-with-highlight (arg &optional (index-ok-p #'=))
                      (print-space)
                      (cond 
@@ -1484,7 +1502,7 @@
                               (arglist.optional-args arglist))))
               (when (arglist.key-p arglist)
                 (print-with-space '&key)
-                (mapc #'print-with-space
+                (mapc #'print-keyword-arg-with-space
                       (mapcar #'encode-keyword-arg 
                               (arglist.keyword-args arglist))))
               (when (arglist.allow-other-keys-p arglist)
@@ -1542,8 +1560,8 @@
           (list (keyword-arg.arg-name arg)
                 (keyword-arg.default-arg arg))
           (keyword-arg.arg-name arg))
-      (let ((keyword/name (list (keyword-arg.arg-name arg)
-                                (keyword-arg.keyword arg))))
+      (let ((keyword/name (list (keyword-arg.keyword arg)
+                                (keyword-arg.arg-name arg))))
         (if (keyword-arg.default-arg arg)
             (list keyword/name
                   (keyword-arg.default-arg arg))
@@ -1698,13 +1716,17 @@
   (methods-keywords 
    (swank-mop:generic-function-methods generic-function)))
 
-(defun applicable-methods-keywords (generic-function classes)
+(defun applicable-methods-keywords (generic-function arguments)
   "Collect all keywords in the methods of GENERIC-FUNCTION that are
 applicable for argument of CLASSES.  As a secondary value, return
 whether &allow-other-keys appears somewhere."
-  (methods-keywords 
-   (swank-mop:compute-applicable-methods-using-classes 
-    generic-function classes)))
+  (methods-keywords
+   (multiple-value-bind (amuc okp)
+       (swank-mop:compute-applicable-methods-using-classes
+        generic-function (mapcar #'class-of arguments))
+     (if okp
+         amuc
+         (compute-applicable-methods generic-function arguments)))))
 
 (defun decoded-arglist-to-template-string (decoded-arglist package &key (prefix "(") (suffix ")"))
   (with-output-to-string (*standard-output*)
@@ -1759,45 +1781,81 @@
         (generic-function-keywords symbol-function)
         nil)))
 
+(defun class-from-class-name-form (class-name-form)
+  (when (and (listp class-name-form)
+             (= (length class-name-form) 2)
+             (eq (car class-name-form) 'quote))
+    (let* ((class-name (cadr class-name-form))
+           (class (find-class class-name nil)))
+      (when (and class
+                 (not (swank-mop:class-finalized-p class)))
+        ;; Try to finalize the class, which can fail if
+        ;; superclasses are not defined yet
+        (handler-case (swank-mop:finalize-inheritance class)
+          (program-error (c)
+            (declare (ignore c)))))
+      class)))
+    
+(defun extra-keywords/slots (class)
+  (multiple-value-bind (slots allow-other-keys-p)
+      (if (swank-mop:class-finalized-p class)
+          (values (swank-mop:class-slots class) nil)
+          (values (swank-mop:class-direct-slots class) t))
+    (let ((slot-init-keywords
+           (loop for slot in slots append 
+                 (mapcar (lambda (initarg)
+                           (make-keyword-arg 
+                            initarg
+                            (swank-mop:slot-definition-name slot)
+                            (swank-mop:slot-definition-initform slot)))
+                         (swank-mop:slot-definition-initargs slot)))))
+      (values slot-init-keywords allow-other-keys-p))))
+
 (defun extra-keywords/make-instance (operator &rest args)
   (declare (ignore operator))
   (unless (null args)
-    (let ((class-name-form (car args)))
-      (when (and (listp class-name-form)
-                 (= (length class-name-form) 2)
-                 (eq (car class-name-form) 'quote))
-        (let* ((class-name (cadr class-name-form))
-               (class (find-class class-name nil)))
-          (when (and class
-                     (not (swank-mop:class-finalized-p class)))
-            ;; Try to finalize the class, which can fail if
-            ;; superclasses are not defined yet
-            (handler-case (swank-mop:finalize-inheritance class)
-              (program-error (c)
-                (declare (ignore c)))))
-          (when class
-            ;; We have the case (make-instance 'CLASS ...)
-            ;; with a known CLASS.
-            (multiple-value-bind (slots allow-other-keys-p)
-                (if (swank-mop:class-finalized-p class)
-                    (values (swank-mop:class-slots class) nil)
-                    (values (swank-mop:class-direct-slots class) t))
-              (let ((slot-init-keywords
-                     (loop for slot in slots append 
-                           (mapcar (lambda (initarg)
-                                     (make-keyword-arg 
-                                      initarg
-                                      initarg ; FIXME
-                                      (swank-mop:slot-definition-initform slot)))
-                                   (swank-mop:slot-definition-initargs slot))))
-                    (initialize-instance-keywords
-                     (applicable-methods-keywords #'initialize-instance 
-                                                  (list class))))
-                (return-from extra-keywords/make-instance
-                  (values (append slot-init-keywords 
-                                  initialize-instance-keywords)
-                          allow-other-keys-p
-                          (list class-name-form)))))))))))
+    (let* ((class-name-form (car args))
+           (class (class-from-class-name-form class-name-form)))
+      (when class
+        (multiple-value-bind (slot-init-keywords class-aokp)
+            (extra-keywords/slots class)
+          (multiple-value-bind (allocate-instance-keywords ai-aokp)
+              (applicable-methods-keywords 
+               #'allocate-instance (list class))
+            (multiple-value-bind (initialize-instance-keywords ii-aokp)
+                (applicable-methods-keywords 
+                 #'initialize-instance (list (swank-mop:class-prototype class)))
+              (multiple-value-bind (shared-initialize-keywords si-aokp)
+                  (applicable-methods-keywords 
+                   #'shared-initialize (list (swank-mop:class-prototype class) t))
+                (values (append slot-init-keywords 
+                                allocate-instance-keywords
+                                initialize-instance-keywords
+                                shared-initialize-keywords)
+                        (or class-aokp ai-aokp ii-aokp si-aokp)
+                        (list class-name-form))))))))))
+
+(defun extra-keywords/change-class (operator &rest args)
+  (declare (ignore operator))
+  (unless (null args)
+    (let* ((class-name-form (car args))
+           (class (class-from-class-name-form class-name-form)))
+      (when class
+        (multiple-value-bind (slot-init-keywords class-aokp)
+            (extra-keywords/slots class)
+          (declare (ignore class-aokp))
+          (multiple-value-bind (shared-initialize-keywords si-aokp)
+              (applicable-methods-keywords
+               #'shared-initialize (list (swank-mop:class-prototype class) t))
+            ;; FIXME: much as it would be nice to include the
+            ;; applicable keywords from
+            ;; UPDATE-INSTANCE-FOR-DIFFERENT-CLASS, I don't really see
+            ;; how to do it: so we punt, always declaring
+            ;; &ALLOW-OTHER-KEYS.
+            (declare (ignore si-aokp))
+            (values (append slot-init-keywords shared-initialize-keywords)
+                    t
+                    (list class-name-form))))))))
 
 (defmacro multiple-value-or (&rest forms)
   (if (null forms)
@@ -1835,12 +1893,20 @@
   (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)))
 
+(defmethod extra-keywords ((operator (eql 'change-class)) 
+                           &rest args)
+  (multiple-value-or (apply #'extra-keywords/change-class operator (cdr args))
+                     (call-next-method)))
+
 (defun enrich-decoded-arglist-with-extra-keywords (decoded-arglist form)
   "Determine extra keywords from the function call FORM, and modify
 DECODED-ARGLIST to include them.  As a secondary return value, return



From crhodes at common-lisp.net  Wed Apr 19 16:00:25 2006
From: crhodes at common-lisp.net (crhodes)
Date: Wed, 19 Apr 2006 12:00:25 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060419160025.6C9113064@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
Small manual fixes.


--- /project/slime/cvsroot/slime/ChangeLog	2006/04/19 15:13:04	1.888
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/19 16:00:23	1.889
@@ -1,5 +1,16 @@
 2006-04-19  Christophe Rhodes <csr21 at cam.ac.uk>
 
+	* doc/Makefile (contributors.texi): use texinfo macros for
+	accented characters.
+
+	* ChangeLog: canonize Gabor Melis' spelling, otherwise he appears
+	twice in the "Hackers of the good Hack table"
+
+	* doc/slime.texi (nyorsko): delete
+	(EDITION): make it say 2.0
+	
+2006-04-19  Christophe Rhodes <csr21 at cam.ac.uk>
+
 	* swank.lisp (decoded-arglist-to-string): if the keyword and the
 	variable are different, print the keyword name with escapes.
 	(encode-keyword-arg): get the keyword and the arg-name the same
@@ -836,7 +847,7 @@
 	* slime.el (slime-repl-history-size, slime-repl-history-file): Use
 	defcustom to declare the variables.
 	
-2005-10-23  Gabor Melis  <mega at hotpop.com>
+2005-10-23  G?bor Melis  <mega at hotpop.com>
  
 	* swank-backend.lisp (install-debugger-globally): new interface
 	function
@@ -1829,12 +1840,12 @@
 	(slime-repl-compile-and-load): Use save-some-lisp-buffers.
 	(slime-oos): Use save-some-lisp-buffers.
 
-2005-07-01  Gabor Melis  <mega at hotpop.com>
+2005-07-01  G?bor Melis  <mega at hotpop.com>
 
 	* swank-sbcl.lisp (threaded stuff): make SBCL 0.9.2.9+ work while
 	retaining support for 0.9.2
 
-2005-06-28  Gabor Melis <mega at hotpop.com>
+2005-06-28  G?bor Melis <mega at hotpop.com>
 
 	* swank-sbcl.lisp (threaded stuff): horrible hack to make threaded
 	SBCL 0.9.2 work.  (also, Happy Birthday Christophe!)



From crhodes at common-lisp.net  Wed Apr 19 16:00:25 2006
From: crhodes at common-lisp.net (crhodes)
Date: Wed, 19 Apr 2006 12:00:25 -0400 (EDT)
Subject: [slime-cvs] CVS slime/doc
Message-ID: <20060419160025.ADF923064@common-lisp.net>

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

Modified Files:
	Makefile slime.texi 
Log Message:
Small manual fixes.


--- /project/slime/cvsroot/slime/doc/Makefile	2005/03/09 05:17:36	1.6
+++ /project/slime/cvsroot/slime/doc/Makefile	2006/04/19 16:00:25	1.7
@@ -48,7 +48,11 @@
 	sort -nr| \
 	sed -e 's/^[^A-Z]*//' | \
 	awk -f texinfo-tabulate.awk | \
-	sed -e 's/\o370/@norsko{}/g' \
+	sed -e "s/\o341/@'a/g" | \
+        sed -e "s/\o355/@'{@dotless{i}}/g" | \
+	sed -e "s/\o351/@'e/g" | \
+	sed -e "s/\o361/@~n/g" | \
+	sed -e 's/\o370/@o{}/g' \
 	> $@
 
 #.INTERMEDIATE: contributors.texi
--- /project/slime/cvsroot/slime/doc/slime.texi	2006/04/19 09:18:53	1.45
+++ /project/slime/cvsroot/slime/doc/slime.texi	2006/04/19 16:00:25	1.46
@@ -28,25 +28,13 @@
 @acronym{CVS}
 @end macro
 
- at c O with a slash through it (norwegian)
- at macro norsko
- at iftex
- at tex
-\\o
- at end tex
- at end iftex
- at ifnottex
-o at c this comment prevents a newline!
- at end ifnottex
- at end macro
-
 @macro kbditem{key, command}
 @item \key\
 @code{\command\}@*
 @end macro
 
- at set EDITION 1.2
- at set UPDATED @code{$Date: 2006/04/19 09:18:53 $}
+ at set EDITION 2.0
+ at set UPDATED @code{$Date: 2006/04/19 16:00:25 $}
 
 @titlepage
 @title SLIME User Manual



From heller at common-lisp.net  Thu Apr 20 05:46:50 2006
From: heller at common-lisp.net (heller)
Date: Thu, 20 Apr 2006 01:46:50 -0400 (EDT)
Subject: [slime-cvs] CVS slime
Message-ID: <20060420054650.5C83A2200A@common-lisp.net>

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

Modified Files:
	swank.lisp ChangeLog 
Log Message:
(*use-dedicated-output-stream*): Disable it by default to avoid race
conditions.



--- /project/slime/cvsroot/slime/swank.lisp	2006/04/19 15:13:05	1.376
+++ /project/slime/cvsroot/slime/swank.lisp	2006/04/20 05:46:49	1.377
@@ -373,7 +373,7 @@
 
 ;;;; TCP Server
 
-(defvar *use-dedicated-output-stream* t
+(defvar *use-dedicated-output-stream* nil
   "When T swank will attempt to create a second connection to
   Emacs which is used just to send output.")
 
--- /project/slime/cvsroot/slime/ChangeLog	2006/04/19 16:00:23	1.889
+++ /project/slime/cvsroot/slime/ChangeLog	2006/04/20 05:46:49	1.890
@@ -1,3 +1,8 @@
+2006-04-20  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (*use-dedicated-output-stream*): Make it nil by
+	default to avoid race conditions.
+
 2006-04-19  Christophe Rhodes <csr21 at cam.ac.uk>
 
 	* doc/Makefile (contributors.texi): use texinfo macros for



From heller at common-lisp.net  Thu Apr 20 05:46:50 2006
From: heller at common-lisp.net (heller)
Date: Thu, 20 Apr 2006 01:46:50 -0400 (EDT)
Subject: [slime-cvs] CVS slime/doc
Message-ID: <20060420054650.91B7023000@common-lisp.net>

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

Modified Files:
	slime.texi 
Log Message:
(*use-dedicated-output-stream*): Disable it by default to avoid race
conditions.



--- /project/slime/cvsroot/slime/doc/slime.texi	2006/04/19 16:00:25	1.46
+++ /project/slime/cvsroot/slime/doc/slime.texi	2006/04/20 05:46:50	1.47
@@ -34,7 +34,7 @@
 @end macro
 
 @set EDITION 2.0
- at set UPDATED @code{$Date: 2006/04/19 16:00:25 $}
+ at set UPDATED @code{$Date: 2006/04/20 05:46:50 $}
 
 @titlepage
 @title SLIME User Manual
@@ -1487,11 +1487,11 @@
 
 @item SWANK:*USE-DEDICATED-OUTPUT-STREAM*
 This variable controls an optimization for sending printed output from
-Lisp to Emacs. When @code{t} (the default) a separate socket is
-established solely for Lisp to send printed output to Emacs
-through. Without the optimization it is necessary to send output in
-protocol-messages to Emacs which must then be decoded, and this
-doesn't always keep up if Lisp starts ``spewing'' copious output.
+Lisp to Emacs. When @code{t} a separate socket is established solely for
+Lisp to send printed output to Emacs through. Without the optimization
+it is necessary to send output in protocol-messages to Emacs which must
+then be decoded, and this doesn't always keep up if Lisp starts
+``spewing'' copious output.
 
 @item SWANK:*DEDICATED-OUTPUT-STREAM-PORT*
 When @code{*USE-DEDICATED-OUTPUT-STREAM*} is @code{t} the stream will



From mbaringer at common-lisp.net  Thu Apr 20 09:10:36 2006
From: mbaringer at common-lisp.net (mbaringer)
Date: Thu, 20 Apr 2006 05:10:36 -0400 (EDT)
Subject: [slime-cvs] CVS /slime
Message-ID: <20060420091036.683452F008@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:


--- /project/slime/cvsroot//slime/ChangeLog	2006/04/20 05:46:49	1.890
+++ /project/slime/cvsroot//slime/ChangeLog	2006/04/20 09:10:36	1.891
@@ -1,3 +1,10 @@
+2006-04-20  Marco Baringer  <mb at bese.it>
+
+	* swank-openmcl.lisp (toggle-trace): Implemented. Currently only
+	provides 'best effort' support, :labels and :flet are ignored,
+	:defmethod and :call are treated like a normal trace of the
+	operator.
+
 2006-04-20  Helmut Eller  <heller at common-lisp.net>
 
 	* swank.lisp (*use-dedicated-output-stream*): Make it nil by



From mbaringer at common-lisp.net  Thu Apr 20 09:11:11 2006
From: mbaringer at common-lisp.net (mbaringer)
Date: Thu, 20 Apr 2006 05:11:11 -0400 (EDT)
Subject: [slime-cvs] CVS /slime
Message-ID: <20060420091111.C70CF431B8@common-lisp.net>

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

Modified Files:
	swank-openmcl.lisp 
Log Message:
(toggle-trace): Implemented. Currently only provides 'best effort'
support, :labels and :flet are ignored, :defmethod and :call are
treated like a normal trace of the operator.


--- /project/slime/cvsroot//slime/swank-openmcl.lisp	2006/03/22 16:40:01	1.107
+++ /project/slime/cvsroot//slime/swank-openmcl.lisp	2006/04/20 09:11:11	1.108
@@ -686,6 +686,23 @@
     (:class
      (describe (find-class symbol)))))
 
+(defimplementation toggle-trace (spec)
+  "We currently ignore just about everything."
+  (ecase (car spec)
+    (setf
+     (ccl::%trace spec))
+    (:defmethod
+     (ccl::%trace (second spec)))
+    (:defgeneric
+     (ccl::%trace (second spec)))
+    (:call
+     (toggle-trace (third spec)))
+    ;; mb: FIXME: shouldn't we warn that we're not doing anything for
+    ;; these two?
+    (:labels nil)
+    (:flet nil))
+  t)
+
 ;;; XREF
 
 (defimplementation list-callers (symbol)