/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.544 by trittweiler, Fri Jul 4 23:30:10 2008 UTC revision 1.545 by trittweiler, Sat Jul 5 11:48:11 2008 UTC
# Line 1316  NIL if streams are not globally redirect Line 1316  NIL if streams are not globally redirect
1316               (*terminal-io* io))               (*terminal-io* io))
1317          (funcall function))))          (funcall function))))
1318    
1319    (defun call-with-thread-description (description thunk)
1320      (let* ((thread (current-thread))
1321             (old-description (thread-description thread)))
1322        (set-thread-description thread description)
1323        (unwind-protect (funcall thunk)
1324          (set-thread-description thread old-description))))
1325    
1326    (defmacro with-thread-description (description &body body)
1327      `(call-with-thread-description ,description #'(lambda () ,@body)))
1328    
1329  (defun read-from-emacs ()  (defun read-from-emacs ()
1330    "Read and process a request from Emacs."    "Read and process a request from Emacs."
1331    (apply #'funcall (funcall (connection.read *emacs-connection*))))    (flet ((request-to-string (req)
1332               (remove #\Newline
1333                       (string-trim '(#\Space #\Tab)
1334                                    (prin1-to-string req))))
1335             (truncate-string (str n)
1336               (if (> (length str) n)
1337                   (format nil "~A..." (subseq str 0 n))
1338                   str)))
1339        (let ((request (funcall (connection.read *emacs-connection*))))
1340          (if (eq *communication-style* :spawn)
1341              ;; For `M-x slime-list-threads': Display what threads
1342              ;; created by swank are currently doing.
1343              (with-thread-description (truncate-string (request-to-string request) 55)
1344                (apply #'funcall request))
1345              (apply #'funcall request)))))
1346    
1347  (defun read-from-control-thread ()  (defun read-from-control-thread ()
1348    (receive))    (receive))
# Line 2878  synchronization issues (yet).  There can Line 2902  synchronization issues (yet).  There can
2902  a time.")  a time.")
2903    
2904  (defslimefun list-threads ()  (defslimefun list-threads ()
2905    "Return a list ((NAME DESCRIPTION) ...) of all threads."    "Return a list ((ID NAME STATUS DESCRIPTION) ...) of all threads."
2906    (setq *thread-list* (all-threads))    (setq *thread-list* (all-threads))
2907    (loop for thread in  *thread-list*    (loop for thread in  *thread-list*
2908         for name = (thread-name thread)         for name = (thread-name thread)
2909          collect (list (if (symbolp name) (symbol-name name) name)          collect (list (thread-id thread)
2910                          (if (symbolp name) (symbol-name name) name)
2911                        (thread-status thread)                        (thread-status thread)
2912                        (thread-id thread))))                        (thread-description thread)
2913                          )))
2914    
2915  (defslimefun quit-thread-browser ()  (defslimefun quit-thread-browser ()
2916    (setq *thread-list* nil))    (setq *thread-list* nil))

Legend:
Removed from v.1.544  
changed lines
  Added in v.1.545

  ViewVC Help
Powered by ViewVC 1.1.5