From heller at common-lisp.net  Sun Dec  2 08:43:30 2007
From: heller at common-lisp.net (heller)
Date: Sun,  2 Dec 2007 03:43:30 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071202084330.9FDFA2D172@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:
Add hook to customize the region used by C-c C-c.
Useful to recognize block declarations in CMUCL sources.

* slime.el (slime-region-for-defun-function): New variable.
(slime-region-for-defun-at-point): Use it.


--- /project/slime/cvsroot/slime/slime.el	2007/11/29 12:26:39	1.881
+++ /project/slime/cvsroot/slime/slime.el	2007/12/02 08:43:30	1.882
@@ -7694,7 +7694,7 @@
 
 (slime-define-keys slime-inspector-mode-map
   ([return] 'slime-inspector-operate-on-point)
-  ([(meta return)] 'slime-inspector-copy-down)
+  ((kbd "M-RET") 'slime-inspector-copy-down)
   ("\C-m"   'slime-inspector-operate-on-point)
   ([mouse-2] 'slime-inspector-operate-on-click)
   ("l" 'slime-inspector-pop)
@@ -9107,14 +9107,18 @@
   (apply #'buffer-substring-no-properties
          (slime-region-for-defun-at-point)))
 
+(defvar slime-region-for-defun-function nil)
+
 (defun slime-region-for-defun-at-point ()
   "Return the start and end position of the toplevel form at point."
-  (save-excursion
-    (save-match-data
-      (end-of-defun)
-      (let ((end (point)))
-        (beginning-of-sexp)
-        (list (point) end)))))
+  (or (and slime-region-for-defun-function
+           (funcall slime-region-for-defun-function))
+      (save-excursion
+        (save-match-data
+          (end-of-defun)
+          (let ((end (point)))
+            (beginning-of-sexp)
+            (list (point) end))))))
 
 (defun slime-beginning-of-symbol ()
   "Move point to the beginning of the current symbol."



From heller at common-lisp.net  Sun Dec  2 08:44:33 2007
From: heller at common-lisp.net (heller)
Date: Sun,  2 Dec 2007 03:44:33 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071202084433.C6B8944074@common-lisp.net>

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

Modified Files:
	swank.lisp ChangeLog 
Log Message:
Make it possible to close listening sockets.
Patch by Alan Caulkins <fatman at maxint.net>.

* swank.lisp (stop-server, restart-server): New functions.
(*listener-sockets*): New variable.
(setup-server): Store open sockets in *listener-sockets*.



--- /project/slime/cvsroot/slime/swank.lisp	2007/11/30 13:09:49	1.520
+++ /project/slime/cvsroot/slime/swank.lisp	2007/12/02 08:44:33	1.521
@@ -17,6 +17,8 @@
   (:export #:startup-multiprocessing
            #:start-server 
            #:create-server
+           #:stop-server
+           #:restart-server
            #:ed-in-emacs
            #:inspect-in-emacs
            #:print-indentation-lossage
@@ -583,6 +585,11 @@
 
 (defvar *coding-system* "iso-latin-1-unix")
 
+(defvar *listener-sockets* nil
+  "A property list of lists containing style, socket pairs used 
+   by swank server listeners, keyed on socket port number. They 
+   are used to close sockets on server shutdown or restart.")
+
 (defun start-server (port-file &key (style *communication-style*)
                                     (dont-close *dont-close*)
                                     (coding-system *coding-system*))
@@ -612,8 +619,8 @@
 (defun setup-server (port announce-fn style dont-close external-format)
   (declare (type function announce-fn))
   (let* ((socket (create-socket *loopback-interface* port))
-         (port (local-port socket)))
-    (funcall announce-fn port)
+         (local-port (local-port socket)))
+    (funcall announce-fn local-port)
     (flet ((serve ()
              (serve-connection socket style dont-close external-format)))
       (ecase style
@@ -622,11 +629,50 @@
           (lambda ()
             (spawn (lambda () 
                      (loop do (ignore-errors (serve)) while dont-close))
-                   :name "Swank"))))
+                   :name (concatenate 'string "Swank " 
+                                      (princ-to-string port))))))
         ((:fd-handler :sigio)
          (add-fd-handler socket (lambda () (serve))))
         ((nil) (loop do (serve) while dont-close)))
-      port)))
+      (setf (getf *listener-sockets* port) (list style socket))
+      local-port)))
+
+(defun stop-server (port)
+  "Stop server running on PORT."
+  (let* ((socket-description (getf *listener-sockets* port))
+         (style (first socket-description))
+         (socket (second socket-description)))
+    (ecase style
+      (:spawn
+       (let ((thread-position
+              (position-if 
+               (lambda (x) 
+                 (string-equal (first x)
+                               (concatenate 'string "Swank "
+                                            (princ-to-string port))))
+               (list-threads))))
+         (when thread-position
+           (kill-nth-thread thread-position)
+           (close-socket socket)
+           (remf *listener-sockets* port))))
+      ((:fd-handler :sigio)
+       (remove-fd-handlers socket)
+       (close-socket socket)
+       (remf *listener-sockets* port)))))
+
+(defun restart-server (&key (port default-server-port)
+                       (style *communication-style*)
+                       (dont-close *dont-close*) 
+                       (coding-system *coding-system*))
+  "Stop the server listening on PORT, then start a new SWANK server 
+on PORT running in STYLE. If DONT-CLOSE is true then the listen socket 
+will accept multiple connections, otherwise it will be closed after the 
+first."
+  (stop-server port)
+  (sleep 5)
+  (create-server :port port :style style :dont-close dont-close
+                 :coding-system coding-system))
+
 
 (defun serve-connection (socket style dont-close external-format)
   (let ((closed-socket-p nil))
@@ -2358,16 +2404,16 @@
 
 ;;;; Simple completion
 
-(defslimefun simple-completions (string buffer-package)
+(defslimefun simple-completions (string package)
   "Return a list of completions for the string STRING."
-  (let ((strings (all-completions string buffer-package #'prefix-match-p)))
+  (let ((strings (all-completions string package #'prefix-match-p)))
     (list strings (longest-common-prefix strings))))
 
-(defun all-completions (string buffer-package test)
+(defun all-completions (string package test)
   (multiple-value-bind (name pname intern) (tokenize-symbol string)
     (let* ((extern (and pname (not intern)))
 	   (pack (cond ((equal pname "") keyword-package)
-		       ((not pname) (guess-buffer-package buffer-package))
+		       ((not pname) (guess-buffer-package package))
 		       (t (guess-package pname))))
 	   (test (lambda (sym) (funcall test name (unparse-symbol sym))))
 	   (syms (and pack (matching-symbols pack extern test))))
--- /project/slime/cvsroot/slime/ChangeLog	2007/11/30 13:10:40	1.1253
+++ /project/slime/cvsroot/slime/ChangeLog	2007/12/02 08:44:33	1.1254
@@ -1,3 +1,19 @@
+2007-12-02  Alan Caulkins <fatman at maxint.net>
+
+	Make it possible to close listening sockets.
+
+	* swank.lisp (stop-server, restart-server): New functions.
+	(*listener-sockets*): New variable.
+	(setup-server): Store open sockets in *listener-sockets*.
+
+2007-12-02  Helmut Eller  <heller at common-lisp.net>
+	
+	Add hook to customize the region used by C-c C-c.
+	Useful to recognize block declarations in CMUCL sources.
+
+	* slime.el (slime-region-for-defun-function): New variable.
+	(slime-region-for-defun-at-point): Use it.
+
 2007-11-30  Helmut Eller  <heller at common-lisp.net>
 
 	Handle byte-functions without debug-info.



From heller at common-lisp.net  Thu Dec 13 15:05:01 2007
From: heller at common-lisp.net (heller)
Date: Thu, 13 Dec 2007 10:05:01 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071213150501.79BF53D00D@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
Fix markers if the listener uses :values.
    
* slime.el (slime-repl-insert-result): Use slime-repl-emit-result
since handling of markers has changed.
(slime-repl-emit-result): New argument: bol.


--- /project/slime/cvsroot/slime/slime.el	2007/12/02 08:43:30	1.882
+++ /project/slime/cvsroot/slime/slime.el	2007/12/13 15:05:00	1.883
@@ -2695,10 +2695,11 @@
      (when (< slime-repl-input-start-mark (point))
        (set-marker slime-repl-input-start-mark (point))))))
 
-(defun slime-repl-emit-result (string)
+(defun slime-repl-emit-result (string &optional bol)
   ;; insert STRING and mark it as evaluation result
   (with-current-buffer (slime-output-buffer)
     (goto-char slime-repl-input-start-mark)
+    (when (and bol (not (bolp))) (insert "\n"))
     (slime-insert-propertized `(face slime-repl-result-face
                                      rear-nonsticky (face)) 
                               string)
@@ -2945,14 +2946,11 @@
     (when result
       (destructure-case result
         ((:values &rest strings)
-         (unless (bolp) (insert "\n"))
          (cond ((null strings)
-                (insert "; No value\n"))
+                (slime-repl-emit-result "; No value\n" t))
                (t
-                (dolist (string strings)
-                  (slime-propertize-region `(face slime-repl-result-face)
-                    (insert string))
-                  (insert "\n")))))))
+                (dolist (s strings) 
+                  (slime-repl-emit-result s t)))))))
     (slime-repl-insert-prompt)))
 
 (defun slime-repl-show-abort ()
--- /project/slime/cvsroot/slime/ChangeLog	2007/12/02 08:44:33	1.1254
+++ /project/slime/cvsroot/slime/ChangeLog	2007/12/13 15:05:01	1.1255
@@ -1,3 +1,9 @@
+2007-12-04  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-repl-insert-result): Use slime-repl-emit-result
+	since handling of markers has changed.
+	(slime-repl-emit-result): New argument: bol.
+
 2007-12-02  Alan Caulkins <fatman at maxint.net>
 
 	Make it possible to close listening sockets.
@@ -7,7 +13,7 @@
 	(setup-server): Store open sockets in *listener-sockets*.
 
 2007-12-02  Helmut Eller  <heller at common-lisp.net>
-	
+
 	Add hook to customize the region used by C-c C-c.
 	Useful to recognize block declarations in CMUCL sources.
 



From heller at common-lisp.net  Thu Dec 13 15:06:51 2007
From: heller at common-lisp.net (heller)
Date: Thu, 13 Dec 2007 10:06:51 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071213150651.E055831041@common-lisp.net>

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

Modified Files:
	slime.el ChangeLog 
Log Message:
Fix slime-list-thread selector.
    
* slime.el (slime-list-threads): Wait for the result before
continuing.


--- /project/slime/cvsroot/slime/slime.el	2007/12/13 15:05:00	1.883
+++ /project/slime/cvsroot/slime/slime.el	2007/12/13 15:06:51	1.884
@@ -7272,19 +7272,17 @@
 (defun slime-list-threads ()
   "Display a list of threads."
   (interactive)
-  (slime-eval-async 
-   '(swank:list-threads)
-   (lambda (threads)
-      (with-current-buffer (get-buffer-create "*slime-threads*")
-       (slime-thread-control-mode)
-       (let ((inhibit-read-only t))
-         (erase-buffer)
-         (loop for idx from 0 
-               for (name status id) in threads
-               do (slime-thread-insert idx name status id))
-         (goto-char (point-min))
-         (setq buffer-read-only t)
-         (pop-to-buffer (current-buffer)))))))
+  (let ((threads (slime-eval '(swank:list-threads))))
+    (with-current-buffer (get-buffer-create "*slime-threads*")
+      (slime-thread-control-mode)
+      (let ((inhibit-read-only t))
+        (erase-buffer)
+        (loop for idx from 0 
+              for (name status id) in threads
+              do (slime-thread-insert idx name status id))
+        (goto-char (point-min))
+        (setq buffer-read-only t)
+        (pop-to-buffer (current-buffer))))))
 
 (defun slime-thread-insert (idx name summary id)
   (slime-propertize-region `(thread-id ,idx)
@@ -7813,7 +7811,6 @@
 (def-slime-selector-method ?t
   "SLIME threads buffer."
   (slime-list-threads)
-  (slime-eval `(cl:quote nil))          ;wait until slime-list-threads returns
   "*slime-threads*")
 
 (defun slime-recently-visited-buffer (mode)
--- /project/slime/cvsroot/slime/ChangeLog	2007/12/13 15:05:01	1.1255
+++ /project/slime/cvsroot/slime/ChangeLog	2007/12/13 15:06:51	1.1256
@@ -1,5 +1,12 @@
 2007-12-04  Helmut Eller  <heller at common-lisp.net>
 
+	Fix slime-list-thread selector.
+	
+	* slime.el (slime-list-threads): Wait for the result before
+	continuing.
+
+2007-12-04  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el (slime-repl-insert-result): Use slime-repl-emit-result
 	since handling of markers has changed.
 	(slime-repl-emit-result): New argument: bol.
@@ -13,7 +20,7 @@
 	(setup-server): Store open sockets in *listener-sockets*.
 
 2007-12-02  Helmut Eller  <heller at common-lisp.net>
-
+	
 	Add hook to customize the region used by C-c C-c.
 	Useful to recognize block declarations in CMUCL sources.
 



From heller at common-lisp.net  Thu Dec 13 15:09:47 2007
From: heller at common-lisp.net (heller)
Date: Thu, 13 Dec 2007 10:09:47 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071213150947.CEDEA5D169@common-lisp.net>

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

Modified Files:
	swank.lisp slime.el ChangeLog 
Log Message:
Simplify the inspector.

* swank.lisp (inspect-object): Ignore the title value returned
from backends.

* slime.el (slime-open-inspector): Updated accordingly.



--- /project/slime/cvsroot/slime/swank.lisp	2007/12/02 08:44:33	1.521
+++ /project/slime/cvsroot/slime/swank.lisp	2007/12/13 15:09:47	1.522
@@ -2967,11 +2967,10 @@
   (let ((*print-pretty* nil)            ; print everything in the same line
         (*print-circle* t)
         (*print-readably* nil))
-    (multiple-value-bind (title content) (inspect-for-emacs object inspector)
-      (list :title title
-            :string-representation
-            (with-output-to-string (stream)
-              (print-unreadable-object (object stream :type t :identity t)))
+    (multiple-value-bind (_ content) (inspect-for-emacs object inspector)
+      (declare (ignore _))
+      (list :title (with-output-to-string (s)
+                     (print-unreadable-object (object s :type t :identity t)))
             :id (assign-index object *inspectee-parts*)
             :content (inspector-content-for-emacs content)))))
 
--- /project/slime/cvsroot/slime/slime.el	2007/12/13 15:06:51	1.884
+++ /project/slime/cvsroot/slime/slime.el	2007/12/13 15:09:47	1.885
@@ -7498,16 +7498,14 @@
     (setq slime-buffer-connection (slime-current-connection))
     (let ((inhibit-read-only t))
       (erase-buffer)
-      (destructuring-bind (&key string-representation id title content) inspected-parts
+      (destructuring-bind (&key id title content) inspected-parts
         (macrolet ((fontify (face string) 
                             `(slime-inspector-fontify ,face ,string)))
           (slime-propertize-region
               (list 'slime-part-number id 
                  'mouse-face 'highlight
                  'face 'slime-inspector-value-face)
-            (insert string-representation))
-          (insert ":\n   ")
-          (insert (fontify topline title))
+            (insert title))
           (while (eq (char-before) ?\n)
             (backward-delete-char 1))
           (insert "\n" (fontify label "--------------------") "\n")
--- /project/slime/cvsroot/slime/ChangeLog	2007/12/13 15:06:51	1.1256
+++ /project/slime/cvsroot/slime/ChangeLog	2007/12/13 15:09:47	1.1257
@@ -1,7 +1,16 @@
 2007-12-04  Helmut Eller  <heller at common-lisp.net>
 
+	Simplify the inspector.
+
+	* swank.lisp (inspect-object): Ignore the title value returned
+	from backends.
+
+	* slime.el (slime-open-inspector): Updated accordingly.
+
+2007-12-04  Helmut Eller  <heller at common-lisp.net>
+
 	Fix slime-list-thread selector.
-	
+
 	* slime.el (slime-list-threads): Wait for the result before
 	continuing.
 
@@ -20,7 +29,7 @@
 	(setup-server): Store open sockets in *listener-sockets*.
 
 2007-12-02  Helmut Eller  <heller at common-lisp.net>
-	
+
 	Add hook to customize the region used by C-c C-c.
 	Useful to recognize block declarations in CMUCL sources.
 



From trittweiler at common-lisp.net  Fri Dec 14 08:46:49 2007
From: trittweiler at common-lisp.net (trittweiler)
Date: Fri, 14 Dec 2007 03:46:49 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071214084649.016881604D@common-lisp.net>

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

Modified Files:
	slime.el 
Log Message:

* slime.el (slime-insert-xref-location): New function. Tries to
  either insert the file name a function is defined in, or inserts
  information about the buffer a function was interactively 
  `C-c C-c'd from. Idea from Knut Olav B??hmer.
  (slime-insert-xrefs): Use it.


--- /project/slime/cvsroot/slime/slime.el	2007/12/13 15:09:47	1.885
+++ /project/slime/cvsroot/slime/slime.el	2007/12/14 08:46:49	1.886
@@ -6078,15 +6078,23 @@
                  (list 'slime-location location
                        'face 'font-lock-keyword-face)
                  "  " (slime-one-line-ify label))
-             do (insert " - " (if (and (eql :location (car location))
-                                       (assoc :file (cdr location)))
-                                  (second (assoc :file (cdr location)))
-                                  "file unknown")
-                          "\n"))))
+             do (insert " - " (slime-insert-xref-location location) "\n"))))
   ;; Remove the final newline to prevent accidental window-scrolling
   (backward-char 1)
   (delete-char 1))
 
+(defun slime-insert-xref-location (location)
+  (if (eql :location (car location))
+      (cond ((assoc :file (cdr location)) 
+             (second (assoc :file (cdr location))))
+            ((assoc :buffer (cdr location))
+             (let* ((name (second (assoc :buffer (cdr location))))
+                    (buffer (get-buffer name)))
+               (if buffer 
+                   (format "%S" buffer)
+                   (format "%s (previously existing buffer)" name)))))
+      "file unknown"))
+
 (defvar slime-next-location-function nil
   "Function to call for going to the next location.")
 



From trittweiler at common-lisp.net  Fri Dec 14 08:47:09 2007
From: trittweiler at common-lisp.net (trittweiler)
Date: Fri, 14 Dec 2007 03:47:09 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071214084709.596081B01C@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:

* slime.el (slime-insert-xref-location): New function. Tries to
  either insert the file name a function is defined in, or inserts
  information about the buffer a function was interactively 
  `C-c C-c'd from. Idea from Knut Olav B??hmer.
  (slime-insert-xrefs): Use it.


--- /project/slime/cvsroot/slime/ChangeLog	2007/12/13 15:09:47	1.1257
+++ /project/slime/cvsroot/slime/ChangeLog	2007/12/14 08:47:09	1.1258
@@ -1,3 +1,11 @@
+2007-12-14  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-insert-xref-location): New function. Tries to
+	either insert the file name a function is defined in, or inserts
+	information about the buffer a function was interactively 
+	`C-c C-c'd from. Idea from Knut Olav B?hmer.
+	(slime-insert-xrefs): Use it.
+
 2007-12-04  Helmut Eller  <heller at common-lisp.net>
 
 	Simplify the inspector.



From gcarncross at common-lisp.net  Sat Dec 15 03:25:26 2007
From: gcarncross at common-lisp.net (gcarncross)
Date: Fri, 14 Dec 2007 22:25:26 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071215032526.9EBD75E10A@common-lisp.net>

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

Modified Files:
	swank-ecl.lisp 
Log Message:
Add ECL threads implementation to swank

--- /project/slime/cvsroot/slime/swank-ecl.lisp	2007/05/17 11:49:40	1.8
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2007/12/15 03:25:26	1.9
@@ -244,3 +244,160 @@
 ;;;; Definitions
 
 (defimplementation find-definitions (name) nil)
+
+;;;; Threads
+
+#+threads
+(progn
+  (defvar *thread-id-counter* 0)
+
+  (defvar *thread-id-counter-lock*
+    (mp:make-lock :name "thread id counter lock"))
+
+  (defun next-thread-id ()
+    (mp:with-lock (*thread-id-counter-lock*)
+      (incf *thread-id-counter*)))
+
+  (defparameter *thread-id-map* (make-hash-table))
+
+  (defvar *thread-id-map-lock*
+    (mp:make-lock :name "thread id map lock"))
+
+  ; ecl doesn't have weak pointers
+  (defimplementation spawn (fn &key name)
+    (let ((thread (mp:make-process :name name))
+	  (id (next-thread-id)))
+      (mp:process-preset
+	thread
+	#'(lambda ()
+	    (unwind-protect
+	      (mp:with-lock (*thread-id-map-lock*)
+	        (setf (gethash id *thread-id-map*) thread))
+	      (funcall fn)
+	      (mp:with-lock (*thread-id-map-lock*)
+                (remhash id *thread-id-map*)))))
+      (mp:process-enable thread)))
+
+  (defimplementation thread-id (thread)
+    (block thread-id
+      (mp:with-lock (*thread-id-map-lock*)
+        (loop for id being the hash-key in *thread-id-map*
+              using (hash-value thread-pointer)
+              do (if (eq thread thread-pointer)
+		   (return-from thread-id id))))))
+
+  (defimplementation find-thread (id)
+    (mp:with-lock (*thread-id-map-lock*)
+      (gethash id *thread-id-map*)))
+
+  (defimplementation thread-name (thread)
+    (mp:process-name thread))
+
+  (defimplementation thread-status (thread)
+    (if (mp:process-active-p thread)
+        "RUNNING"
+        "STOPPED"))
+
+  (defimplementation make-lock (&key name)
+    (mp:make-lock :name name))
+
+  (defimplementation call-with-lock-held (lock function)
+    (declare (type function function))
+    (mp:with-lock (lock) (funcall function)))
+
+  (defimplementation make-recursive-lock (&key name)
+    (mp:make-lock :name name))
+
+  (defimplementation call-with-recursive-lock-held (lock function)
+    (declare (type function function))
+    (mp:with-lock (lock) (funcall function)))
+
+  (defimplementation current-thread ()
+    mp:*current-process*)
+
+  (defimplementation all-threads ()
+    (mp:all-processes))
+
+  (defimplementation interrupt-thread (thread fn)
+    (mp:interrupt-process thread fn))
+
+  (defimplementation kill-thread (thread)
+    (mp:process-kill thread))
+
+  (defimplementation thread-alive-p (thread)
+    (mp:process-active-p thread))
+
+  (defvar *mailbox-lock* (mp:make-lock :name "mailbox lock"))
+
+  (defstruct (mailbox (:conc-name mailbox.))
+    (mutex (mp:make-lock :name "process mailbox"))
+    (queue '() :type list))
+
+  (defun mailbox (thread)
+    "Return THREAD's mailbox."
+    (mp:with-lock (*mailbox-lock*)
+      (or (find thread *mailboxes* :key #'mailbox.thread)
+          (let ((mb (make-mailbox :thread thread)))
+            (push mb *mailboxes*)
+            mb))))
+
+  (defimplementation send (thread message)
+    (let* ((mbox (mailbox thread))
+           (mutex (mailbox.mutex mbox)))
+      (mp:interrupt-process
+	thread
+	(lambda ()
+	  (mp:with-lock (mutex)
+            (setf (mailbox.queue mbox)
+              (nconc (mailbox.queue mbox) (list message))))))))
+
+  (defimplementation receive ()
+    (block got-mail
+      (let* ((mbox (mailbox mp:*current-process*))
+             (mutex (mailbox.mutex mbox)))
+        (loop
+	  (mp:with-lock (mutex)
+            (if (mailbox.queue mbox)
+	      (return-from got-mail (pop (mailbox.queue mbox)))))
+          ;interrupt-process will halt this if it takes longer than 1sec
+          (sleep 1)))))
+
+  ;; Auto-flush streams
+  (defvar *auto-flush-interval* 0.15
+    "How often to flush interactive streams. This valu is passed
+    directly to cl:sleep.")
+
+  (defvar *auto-flush-lock* (make-recursive-lock :name "auto flush"))
+
+  (defvar *auto-flush-thread* nil)
+
+  (defvar *auto-flush-streams* '())
+
+  (defimplementation make-stream-interactive (stream)
+    (call-with-recursive-lock-held
+     *auto-flush-lock*
+     (lambda ()
+       (pushnew stream *auto-flush-streams*)
+       (unless *auto-flush-thread*
+         (setq *auto-flush-thread*
+               (spawn #'flush-streams
+		      :name "auto-flush-thread"))))))
+
+  (defmethod stream-finish-output ((stream stream))
+    (finish-output stream))
+
+  (defun flush-streams ()
+    (loop
+     (call-with-recursive-lock-held
+      *auto-flush-lock*
+      (lambda ()
+        (setq *auto-flush-streams*
+              (remove-if (lambda (x)
+                           (not (and (open-stream-p x)
+                                     (output-stream-p x))))
+                         *auto-flush-streams*))
+        (mapc #'stream-finish-output *auto-flush-streams*)))
+     (sleep *auto-flush-interval*)))
+
+  )
+



From trittweiler at common-lisp.net  Thu Dec 20 10:33:38 2007
From: trittweiler at common-lisp.net (trittweiler)
Date: Thu, 20 Dec 2007 05:33:38 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071220103338.29B0070EA@common-lisp.net>

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

Modified Files:
	swank.lisp 
Log Message:

* swank.lisp (read-softly-from-string): Now actually returns all
  three values as explained in its docstring.


--- /project/slime/cvsroot/slime/swank.lisp	2007/12/13 15:09:47	1.522
+++ /project/slime/cvsroot/slime/swank.lisp	2007/12/20 10:33:37	1.523
@@ -1581,7 +1581,7 @@
         compound forms like lists or vectors.)"
   (multiple-value-bind (symbol found? symbol-name package) (parse-symbol string)
     (if found?
-        (values symbol nil)
+        (values symbol (length string) nil)
         (multiple-value-bind (sexp pos) (read-from-string string)
           (values sexp pos
                   (when (symbolp sexp)



From trittweiler at common-lisp.net  Thu Dec 20 10:33:52 2007
From: trittweiler at common-lisp.net (trittweiler)
Date: Thu, 20 Dec 2007 05:33:52 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071220103352.325C58307F@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:

* swank.lisp (read-softly-from-string): Now actually returns all
  three values as explained in its docstring.


--- /project/slime/cvsroot/slime/ChangeLog	2007/12/14 08:47:09	1.1258
+++ /project/slime/cvsroot/slime/ChangeLog	2007/12/20 10:33:51	1.1259
@@ -1,3 +1,8 @@
+2007-12-20  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank.lisp (read-softly-from-string): Now actually returns all
+	three values as explained in its docstring.
+	
 2007-12-14  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* slime.el (slime-insert-xref-location): New function. Tries to



From gcarncross at common-lisp.net  Sat Dec 22 02:53:58 2007
From: gcarncross at common-lisp.net (gcarncross)
Date: Fri, 21 Dec 2007 21:53:58 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071222025358.420194B05C@common-lisp.net>

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

Modified Files:
	swank-ecl.lisp 
Log Message:
try to parse the Args: line in most ecl functions to make modelines more interesting

--- /project/slime/cvsroot/slime/swank-ecl.lisp	2007/12/15 03:25:26	1.9
+++ /project/slime/cvsroot/slime/swank-ecl.lisp	2007/12/22 02:53:58	1.10
@@ -157,6 +157,19 @@
       (typecase name 
         (generic-function
          (clos::generic-function-lambda-list name))
+        (compiled-function
+         ; most of the compiled functions have an Args: line in their docs
+         (with-input-from-string (s (or
+                                     (si::get-documentation
+                                      (si:compiled-function-name name) 'function)
+                                     ""))
+           (do ((line (read-line s nil) (read-line s nil)))
+               ((not line) :not-available)
+             (ignore-errors
+               (if (string= (subseq line 0 6) "Args: ")
+                   (return-from nil
+                     (read-from-string (subseq line 6))))))))
+         ;
         (function
          (let ((fle (function-lambda-expression name)))
            (case (car fle)



From dcrosher at common-lisp.net  Sat Dec 22 13:24:49 2007
From: dcrosher at common-lisp.net (dcrosher)
Date: Sat, 22 Dec 2007 08:24:49 -0500 (EST)
Subject: [slime-cvs] CVS slime
Message-ID: <20071222132449.E983E1F009@common-lisp.net>

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

Modified Files:
	ChangeLog swank-scl.lisp 
Log Message:
* Update for Scieneer CL 1.3.7.


--- /project/slime/cvsroot/slime/ChangeLog	2007/12/20 10:33:51	1.1259
+++ /project/slime/cvsroot/slime/ChangeLog	2007/12/22 13:24:49	1.1260
@@ -1,3 +1,8 @@
+2007-12-22  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* swank-scl.lisp (set-stream-timeout, make-socket-io-stream): update
+	for Scieneer CL 1.3.7.
+
 2007-12-20  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank.lisp (read-softly-from-string): Now actually returns all
--- /project/slime/cvsroot/slime/swank-scl.lisp	2007/08/23 19:03:37	1.13
+++ /project/slime/cvsroot/slime/swank-scl.lisp	2007/12/22 13:24:49	1.14
@@ -53,7 +53,8 @@
   (check-type timeout (or null real))
   (if (fboundp 'ext::stream-timeout)
       (setf (ext::stream-timeout stream) timeout)
-      (setf (slot-value (slot-value stream 'cl::stream) 'cl::timeout) timeout)))
+      (setf (slot-value (slot-value stream 'lisp::stream) 'lisp::timeout)
+            timeout)))
 
 ;;;;; Sockets
 
@@ -87,7 +88,8 @@
                                      :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) #\?)
+    (setf (lisp::character-conversion-stream-input-error-value stream) #\?)
+    (setf (lisp::character-conversion-stream-output-error-value stream) #\?)
     stream))
 
 



From trittweiler at common-lisp.net  Sun Dec 30 11:31:55 2007
From: trittweiler at common-lisp.net (trittweiler)
Date: Sun, 30 Dec 2007 06:31:55 -0500 (EST)
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <20071230113155.7C22C5E0FB@common-lisp.net>

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

Modified Files:
	swank-arglists.lisp 
Log Message:

* swank-arglists.lisp: Fix for `(cerror "FOO" 'type-error ...)'

  (*arglist-dummy*): Removed.
  (arglist-dummy): New structure. Wrapper around whatever could not
  be reliably read. The clue is that its printing function does only
  print the object this structure contains.
  (read-conversatively-for-autodoc): Return such a structure if
  conversative reading fails.


--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2007/11/29 12:38:01	1.15
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp	2007/12/30 11:31:55	1.16
@@ -72,7 +72,14 @@
   (let ((op-rawspec (nth (1+ position) raw-specs)))
     (first (parse-form-spec op-rawspec #'read-conversatively-for-autodoc))))
 
-(defvar *arglist-dummy* (cons :dummy nil))
+;; This is a wrapper object around anything that came from Slime and
+;; could not reliably be read. 
+(defstruct (arglist-dummy
+	     (:conc-name #:arglist-dummy.)
+	     (:print-object (lambda (struct stream)
+			      (with-struct (arglist-dummy. string-representation) struct
+				(write-string string-representation stream)))))
+  string-representation)
 
 (defun read-conversatively-for-autodoc (string)
   "Tries to find the symbol that's represented by STRING. 
@@ -83,8 +90,8 @@
 automatic arglist display stuff from Slime, interning freshly
 symbols is a big no-no.
 
-In such a case (that no symbol could be found), the object
-*ARGLIST-DUMMY* is returned instead, which works as a placeholder
+In such a case (that no symbol could be found), an object of type
+ARGLIST-DUMMY is returned instead, which works as a placeholder
 datum for subsequent logics to rely on."
   (let* ((string  (string-left-trim '(#\Space #\Tab #\Newline) string))
 	 (quoted? (eql (aref string 0) #\')))
@@ -92,7 +99,7 @@
 	(parse-symbol (if quoted? (subseq string 1) string))
       (if found?
 	  (if quoted? `(quote ,symbol) symbol)
-	  *arglist-dummy*))))
+	  (make-arglist-dummy :string-representation string)))))
 
 
 (defun parse-form-spec (raw-spec &optional reader)



From trittweiler at common-lisp.net  Sun Dec 30 11:32:06 2007
From: trittweiler at common-lisp.net (trittweiler)
Date: Sun, 30 Dec 2007 06:32:06 -0500 (EST)
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <20071230113206.E29037616C@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:

* swank-arglists.lisp: Fix for `(cerror "FOO" 'type-error ...)'

  (*arglist-dummy*): Removed.
  (arglist-dummy): New structure. Wrapper around whatever could not
  be reliably read. The clue is that its printing function does only
  print the object this structure contains.
  (read-conversatively-for-autodoc): Return such a structure if
  conversative reading fails.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2007/11/29 12:38:09	1.68
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2007/12/30 11:32:06	1.69
@@ -1,3 +1,14 @@
+2007-12-30  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-arglists.lisp: Fix for `(cerror "FOO" 'type-error ...)'
+
+	(*arglist-dummy*): Removed.
+	(arglist-dummy): New structure. Wrapper around whatever could not
+	be reliably read. The clue is that its printing function does only
+	print the object this structure contains.
+	(read-conversatively-for-autodoc): Return such a structure if
+	conversative reading fails.
+
 2007-11-27  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-arglists.lisp (arglist-dispatch 'defmethod): Use