[slime-cvs] CVS slime

[CVS User sboukarev]

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

Modified Files:
	ChangeLog swank-sbcl.lisp swank.lisp 
Log Message:
* swank-sbcl.lisp (thread-description): Remove it and supporting code,
because it didn't really work.

* swank.lisp (with-thread-description): Remove unused macro.


--- /project/slime/cvsroot/slime/ChangeLog	2009/10/19 23:13:27	1.1876
+++ /project/slime/cvsroot/slime/ChangeLog	2009/10/19 23:23:45	1.1877
@@ -1,5 +1,10 @@
 2009-10-19  Stas Boukarev  <stassats at gmail.com>
 
+	* swank-sbcl.lisp (thread-description): Remove it and supporting code,
+	because it didn't really work.
+
+	* swank.lisp (with-thread-description): Remove unused macro.
+
 	* slime.el (slime-list-threads): Update information before
 	setting the mode, otherwise it messes up current connection.
 
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/09/26 23:24:50	1.252
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/10/19 23:23:45	1.253
@@ -1380,43 +1380,9 @@
 
   (defimplementation thread-status (thread)
     (if (sb-thread:thread-alive-p thread)
-        "RUNNING"
-        "STOPPED"))
-  #+#.(swank-backend::sbcl-with-weak-hash-tables)
-  (progn
-    (defparameter *thread-description-map*
-      (make-weak-key-hash-table))
-
-    (defvar *thread-descr-map-lock*
-      (sb-thread:make-mutex :name "thread description map lock"))
-    
-    (defimplementation thread-description (thread)
-      (sb-thread:with-mutex (*thread-descr-map-lock*)
-        (or (gethash thread *thread-description-map*)
-            (short-backtrace thread 6 10))))
-
-    (defimplementation set-thread-description (thread description)
-      (sb-thread:with-mutex (*thread-descr-map-lock*)
-        (setf (gethash thread *thread-description-map*) description)))
-
-    (defun short-backtrace (thread start count)
-      (let ((self (current-thread))
-            (tag (get-internal-real-time)))
-        (sb-thread:interrupt-thread
-         thread
-         (lambda ()
-           (let* ((frames (nthcdr start (sb-debug:backtrace-as-list count))))
-             (send self (cons tag frames)))))
-        (handler-case
-            (sb-ext:with-timeout 0.1
-              (let ((frames (cdr (receive-if (lambda (msg) 
-                                               (eq (car msg) tag)))))
-                    (*print-pretty* nil))
-                (format nil "~{~a~^ <- ~}" (mapcar #'car frames))))
-          (sb-ext:timeout () ""))))
-
-    )
-
+        "Running"
+        "Stopped"))
+  
   (defimplementation make-lock (&key name)
     (sb-thread:make-mutex :name name))
 
--- /project/slime/cvsroot/slime/swank.lisp	2009/10/19 10:01:50	1.664
+++ /project/slime/cvsroot/slime/swank.lisp	2009/10/19 23:23:45	1.665
@@ -1593,8 +1593,6 @@
 
 ;;; Channels
 
-(progn
-
 (defvar *channels* '())
 (defvar *channel-counter* 0)
 
@@ -1705,30 +1703,7 @@
            (unless ok
              (send-to-remote-channel remote `(:read-aborted ,tag)))))))))
 
-)
-
-(defun call-with-thread-description (description thunk)
-  ;; For `M-x slime-list-threads': Display what threads
-  ;; created by swank are currently doing.
-  (flet ((request-to-string (req)
-           (remove #\Newline
-                   (string-trim '(#\Space #\Tab)
-                                (prin1-to-string req))))
-         (truncate-string (str n)
-           (format nil "~A..." (subseq str 0 (min (length str) n)))))
-    (let* ((thread (current-thread))
-           (old-description (thread-description thread)))
-      (set-thread-description thread 
-                              (truncate-string (request-to-string description)
-                                               55))
-      (unwind-protect (funcall thunk)
-        (set-thread-description thread old-description)))))
-
-
-
-
-(defmacro with-thread-description (description &body body)
-  `(call-with-thread-description ,description #'(lambda () , at body)))
+
 
 (defun decode-message (stream)
   "Read an S-expression from STREAM using the SLIME protocol."