[slime-cvs] CVS update: slime/ChangeLog slime/slime.el slime/swank-backend.lisp slime/swank-openmcl.lisp slime/swank.lisp
Marco Baringer
mbaringer at common-lisp.net
Fri Feb 27 12:32:07 UTC 2004
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv22592
Modified Files:
ChangeLog slime.el swank-backend.lisp swank-openmcl.lisp
swank.lisp
Log Message:
See ChangeLog entry "2004-02-27 Macro Baringer"
Date: Fri Feb 27 07:32:06 2004
Author: mbaringer
Index: slime/ChangeLog
diff -u slime/ChangeLog:1.271 slime/ChangeLog:1.272
--- slime/ChangeLog:1.271 Thu Feb 26 17:31:13 2004
+++ slime/ChangeLog Fri Feb 27 07:32:06 2004
@@ -1,3 +1,25 @@
+2004-02-27 Marco Baringer <mb at bese.it>
+
+ * slime.el (slime-read-port-and-connect,
+ slime-read-port-and-connect-to-running-swank): Refactor
+ slime-read-port-and-connect into two functions so that
+ slime-thread-attach can use the logic in
+ slime-read-port-and-connect.
+ (slime-thread-control-mode-map): Added key bindings for
+ slime-thread-kill, slime-thread-attach, slime-thread-debug and
+ slime-list-threads.
+ (slime-thread-kill, slime-thread-attach, slime-thread-debug): New
+ functions.
+
+ * swank-backend.lisp (kill-thread): Added to swank interface.
+
+ * swank-openmcl.lisp (kill-thread): Implement.
+
+ * swank.lisp (start-server): Add optional background argument,
+ defaults to *swank-background*.
+ (lookup-thread-by-id): New function.
+ (debug-thread): New function.
+
2004-02-26 Peter Seibel <peter at javamonkey.com>
* slime.el (slime-draw-connection-list): Use text-properties to
Index: slime/slime.el
diff -u slime/slime.el:1.222 slime/slime.el:1.223
--- slime/slime.el:1.222 Thu Feb 26 17:31:13 2004
+++ slime/slime.el Fri Feb 27 07:32:06 2004
@@ -985,6 +985,9 @@
(defun slime-read-port-and-connect (&optional retries)
"Connect to a running Swank server."
(slime-start-swank-server)
+ (slime-read-port-and-connect-to-running-swank retries))
+
+(defun slime-read-port-and-connect-to-running-swank (retries)
(lexical-let ((retries (or retries slime-swank-connection-retries))
(attempt 0))
(labels
@@ -4683,12 +4686,38 @@
(set (make-local-variable 'truncate-lines) t)))
(slime-define-keys slime-thread-control-mode-map
+ ("a" 'slime-thread-attach)
+ ("d" 'slime-thread-debug)
+ ("g" 'slime-list-threads)
+ ("k" 'slime-thread-kill)
((kbd "RET") 'slime-thread-goahead)
("q" 'slime-thread-quit))
(defun slime-thread-quit ()
(interactive)
(kill-buffer (current-buffer)))
+
+(defun slime-thread-kill ()
+ (interactive)
+ (slime-eval `(swank::kill-thread (swank::lookup-thread-by-id ,(get-text-property (point) 'thread-id))))
+ (call-interactively 'slime-list-threads))
+
+(defun slime-thread-attach ()
+ (interactive)
+ (slime-eval-async `(swank::interrupt-thread
+ (swank::lookup-thread-by-id ,(get-text-property (point) 'thread-id))
+ (cl:lambda ()
+ (swank::start-server ,(slime-swank-port-file) nil)))
+ (slime-buffer-package)
+ (lambda (v)
+ nil))
+ (slime-read-port-and-connect-to-running-swank nil))
+
+(defun slime-thread-debug ()
+ (interactive)
+ (slime-eval-async `(swank::debug-thread ,(get-text-property (point) 'thread-id))
+ (slime-buffer-package)
+ (lambda (v) nil)))
;;;;; Connection listing
Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.33 slime/swank-backend.lisp:1.34
--- slime/swank-backend.lisp:1.33 Thu Feb 26 02:17:10 2004
+++ slime/swank-backend.lisp Fri Feb 27 07:32:06 2004
@@ -587,6 +587,11 @@
(definterface interrupt-thread (thread fn)
"Cause THREAD to execute FN.")
+(definterface kill-thread (thread)
+ "Kill THREAD."
+ (declare (ignore thread))
+ nil)
+
(definterface send (thread object)
"Send OBJECT to thread THREAD.")
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.65 slime/swank-openmcl.lisp:1.66
--- slime/swank-openmcl.lisp:1.65 Thu Feb 26 13:38:00 2004
+++ slime/swank-openmcl.lisp Fri Feb 27 07:32:06 2004
@@ -627,6 +627,9 @@
(defimplementation all-threads ()
(ccl:all-processes))
+(defimplementation kill-thread (thread)
+ (ccl:process-kill thread))
+
(defimplementation interrupt-thread (thread fn)
(ccl:process-interrupt thread fn))
Index: slime/swank.lisp
diff -u slime/swank.lisp:1.127 slime/swank.lisp:1.128
--- slime/swank.lisp:1.127 Thu Feb 26 02:13:01 2004
+++ slime/swank.lisp Fri Feb 27 07:32:06 2004
@@ -156,9 +156,9 @@
(defvar *swank-in-background* nil)
(defvar *log-events* nil)
-(defun start-server (port-file)
+(defun start-server (port-file &optional (background *swank-in-background*))
(setup-server 0 (lambda (port) (announce-server-port port-file port))
- *swank-in-background*))
+ background))
(defun create-swank-server (&optional (port +server-port+)
(background *swank-in-background*)
@@ -1518,6 +1518,32 @@
(defslimefun quit-thread-browser ()
(setq *thread-list* nil))
+
+(defun lookup-thread-by-id (id)
+ (nth id (all-threads)))
+
+(defun debug-thread (thread-id)
+ (interrupt-thread (lookup-thread-by-id thread-id)
+ (let ((pack *package*))
+ (lambda ()
+ (catch 'slime-toplevel
+ (let ((*debugger-hook* (lambda (c h)
+ (declare (ignore h))
+ ;; cut 'n paste from swank-debugger-hook
+ (let ((*swank-debugger-condition* c)
+ (*buffer-package* pack)
+ (*package* pack)
+ (*sldb-level* (1+ *sldb-level*))
+ (*swank-state-stack* (cons :swank-debugger-hook *swank-state-stack*)))
+ (force-user-output)
+ (call-with-debugging-environment
+ (lambda () (sldb-loop *sldb-level*)))))))
+ (restart-case
+ (error (make-condition 'simple-error
+ :format-control "Interrupt from Emacs"))
+ (un-interrupt ()
+ :report "Abandon control of this thread."
+ nil))))))))
;;; Local Variables:
;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)" (1 font-lock-keyword-face) (2 font-lock-function-name-face))))
More information about the slime-cvs
mailing list