[slime-cvs] CVS slime
CVS User trittweiler
trittweiler at common-lisp.net
Thu Mar 18 18:24:25 UTC 2010
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv13571
Modified Files:
ChangeLog slime.el swank.lisp
Log Message:
Remove attach-gdb restart. Instead add SLDB shortcut `A'.
* slime.el (slime-dispatch-event): Remove :gdb-attach.
(slime-attach-gdb): Changed API. Takes connection not pid now and
lightweight &optional arg. If not lightweight, get the default gdb
config from the inferior Lisp.
(sldb-break-with-system-debugger): New command, bound to `A' in
sldb. Called this way to mimick
`sldb-break-with-default-debugger', and because it may make sense
to go beyond gdb in future, e.g. to invoke the Java Debugger for
ABCL.
* swank.lisp (call-with-gdb-restart, with-gdb-restart): Removed.
(with-top-level-restart): Remove use of with-gdb-restart.
(make-connection, start-server, create-server, setup-server):
Remove inferior-lisp flag again. Not needed anymore.
--- /project/slime/cvsroot/slime/ChangeLog 2010/03/18 15:59:57 1.2041
+++ /project/slime/cvsroot/slime/ChangeLog 2010/03/18 18:24:25 1.2042
@@ -1,5 +1,24 @@
2010-03-18 Tobias C. Rittweiler <tcr at freebits.de>
+ Remove attach-gdb restart. Instead add SLDB shortcut `A'.
+
+ * slime.el (slime-dispatch-event): Remove :gdb-attach.
+ (slime-attach-gdb): Changed API. Takes connection not pid now and
+ lightweight &optional arg. If not lightweight, get the default gdb
+ config from the inferior Lisp.
+ (sldb-break-with-system-debugger): New command, bound to `A' in
+ sldb. Called this way to mimick
+ `sldb-break-with-default-debugger', and because it may make sense
+ to go beyond gdb in future, e.g. to invoke the Java Debugger for
+ ABCL.
+
+ * swank.lisp (call-with-gdb-restart, with-gdb-restart): Removed.
+ (with-top-level-restart): Remove use of with-gdb-restart.
+ (make-connection, start-server, create-server, setup-server):
+ Remove inferior-lisp flag again. Not needed anymore.
+
+2010-03-18 Tobias C. Rittweiler <tcr at freebits.de>
+
Add M-x slime-attach-gdb as an interactive function.
The ATTACH-GDB restart is nice because it's convenient and the
--- /project/slime/cvsroot/slime/slime.el 2010/03/18 15:59:57 1.1287
+++ /project/slime/cvsroot/slime/slime.el 2010/03/18 18:24:25 1.1288
@@ -2290,9 +2290,6 @@
((:debug-condition thread message)
(assert thread)
(message "%s" message))
- ((:gdb-attach pid gdb-cmds)
- (message "Attaching gdb to pid %d..." pid)
- (slime-attach-gdb pid gdb-cmds))
((:ping thread tag)
(slime-send `(:emacs-pong ,thread ,tag)))
((:reader-error packet condition)
@@ -2306,23 +2303,6 @@
(remove* id (slime-rex-continuations) :key #'car))
(error "Invalid rpc: %s" message))))))
-(defun slime-attach-gdb (pid &optional commands)
- "Run `gud-gdb'on the connection with PID `pid'."
- (interactive
- (list (slime-pid (slime-read-connection "Attach gdb to: "
- (slime-connection)))))
- (gud-gdb (format "gdb -p %d" pid))
- (with-current-buffer gud-comint-buffer
- (dolist (cmd commands)
- ;; First wait until gdb was initialized, then wait until current
- ;; command was processed.
- (while (not (looking-back comint-prompt-regexp))
- (sit-for 0.01))
- ;; We do not use `gud-call' because we want the initial commands
- ;; to be displayed by the user so he knows what he's got.
- (insert cmd)
- (comint-send-input))))
-
(defun slime-send (sexp)
"Send SEXP directly over the wire on the current connection."
(slime-net-send sexp (slime-connection)))
@@ -5400,6 +5380,7 @@
("b" 'sldb-break-on-return)
("a" 'sldb-abort)
("q" 'sldb-quit)
+ ("A" 'sldb-break-with-system-debugger)
("B" 'sldb-break-with-default-debugger)
("P" 'sldb-print-condition)
("C" 'sldb-inspect-condition)
@@ -6093,6 +6074,37 @@
nil slime-current-thread)
((:abort))))
+(defun sldb-break-with-system-debugger (&optional lightweight)
+ "Enter system debugger (gdb)."
+ (interactive "P")
+ (slime-attach-gdb slime-buffer-connection lightweight))
+
+(defun slime-attach-gdb (connection &optional lightweight)
+ "Run `gud-gdb'on the connection with PID `pid'.
+
+If `lightweight' is given, do not send any request to the
+inferior Lisp (e.g. to obtain default gdb config) but only
+operate from the Emacs side; intended for cases where the Lisp is
+truly screwed up."
+ (interactive
+ (list (slime-read-connection "Attach gdb to: " (slime-connection)) "P"))
+ (let ((pid (slime-pid connection))
+ (commands (unless lightweight
+ (let ((slime-dispatching-connection connection))
+ (slime-eval `(swank:gdb-initial-commands))))))
+ (gud-gdb (format "gdb -p %d" pid))
+ (with-current-buffer gud-comint-buffer
+ (dolist (cmd commands)
+ ;; First wait until gdb was initialized, then wait until current
+ ;; command was processed.
+ (while (not (looking-back comint-prompt-regexp))
+ (sit-for 0.01))
+ ;; We do not use `gud-call' because we want the initial commands
+ ;; to be displayed by the user so he knows what he's got.
+ (insert cmd)
+ (comint-send-input)))))
+
+
(defun sldb-step ()
"Step to next basic-block boundary."
(interactive)
--- /project/slime/cvsroot/slime/swank.lisp 2010/03/18 12:37:34 1.703
+++ /project/slime/cvsroot/slime/swank.lisp 2010/03/18 18:24:25 1.704
@@ -51,6 +51,7 @@
;; These are re-exported directly from the backend:
#:buffer-first-change
#:frame-source-location
+ #:gdb-initial-commands
#:restart-frame
#:sldb-step
#:sldb-break
@@ -295,13 +296,11 @@
(communication-style nil :type (member nil :spawn :sigio :fd-handler))
;; The coding system for network streams.
coding-system
- ;; True if the connection belongs to a superior Emacs process.
- inferior-lisp
;; The SIGINT handler we should restore when the connection is
;; closed.
saved-sigint-handler)
-(defun make-connection (socket style coding-system inferiorp)
+(defun make-connection (socket style coding-system)
(multiple-value-bind (serve cleanup)
(ecase style
(:spawn
@@ -315,7 +314,6 @@
(%make-connection :socket socket
:communication-style style
:coding-system coding-system
- :inferior-lisp inferiorp
:serve-requests serve
:cleanup cleanup)))
@@ -471,29 +469,6 @@
(check-type msg string)
`(call-with-retry-restart ,msg #'(lambda () , at body)))
-(defun call-with-gdb-restart (pid thunk)
- (let ((process (format nil "~A-~A (pid ~D)"
- (lisp-implementation-type)
- (lisp-implementation-version)
- pid)))
- (restart-bind
- ((attach-gdb
- #'(lambda ()
- (send-to-emacs `(:gdb-attach ,pid ,(gdb-initial-commands)))
- (format nil "GDB attached to ~A" process))
- :report-function #'(lambda (s)
- (format s "Attach GDB to ~A" process))
- :test-function #'(lambda (c)
- (declare (ignore c))
- ;; Do not show this restart if
- ;; we're connected remotely.
- (connection.inferior-lisp
- *emacs-connection*))))
- (funcall thunk))))
-
-(defmacro with-gdb-restart (() &body body)
- `(call-with-gdb-restart (getpid) #'(lambda () , at body)))
-
(defmacro with-struct* ((conc-name get obj) &body body)
(let ((var (gensym)))
`(let ((,var ,obj))
@@ -694,7 +669,7 @@
This is the entry point for Emacs."
(setup-server 0
(lambda (port) (announce-server-port port-file port))
- style dont-close coding-system t))
+ style dont-close coding-system))
(defun create-server (&key (port default-server-port)
(style *communication-style*)
@@ -704,7 +679,7 @@
If DONT-CLOSE is true then the listen socket will accept multiple
connections, otherwise it will be closed after the first."
(setup-server port #'simple-announce-function
- style dont-close coding-system nil))
+ style dont-close coding-system))
(defun find-external-format-or-lose (coding-system)
(or (find-external-format coding-system)
@@ -712,13 +687,13 @@
(defparameter *loopback-interface* "127.0.0.1")
-(defun setup-server (port announce-fn style dont-close coding-system inferiorp)
+(defun setup-server (port announce-fn style dont-close coding-system)
(declare (type function announce-fn))
(init-log-output)
(let* ((external-format (find-external-format-or-lose coding-system))
(socket (create-socket *loopback-interface* port))
(local-port (local-port socket))
- (connection (make-connection socket style coding-system inferiorp)))
+ (connection (make-connection socket style coding-system)))
(funcall announce-fn local-port)
(flet ((serve ()
(serve-connection connection external-format dont-close)))
@@ -919,20 +894,19 @@
;; Execute K if the restart is invoked.
(defmacro with-top-level-restart ((connection k) &body body)
`(with-connection (,connection)
- (with-gdb-restart ()
- (restart-case
- ;; We explicitly rebind (and do not look at user's
- ;; customization), so sldb-quit will always be our restart
- ;; for rex requests.
- (let ((*sldb-quit-restart* (find-restart 'abort))
- (*toplevel-restart-available* t))
- (declare (special *toplevel-restart-available*))
- , at body)
- (abort (&optional v)
- :report "Return to SLIME's top level."
- (declare (ignore v))
- (force-user-output)
- ,k)))))
+ (restart-case
+ ;; We explicitly rebind (and do not look at user's
+ ;; customization), so sldb-quit will always be our restart
+ ;; for rex requests.
+ (let ((*sldb-quit-restart* (find-restart 'abort))
+ (*toplevel-restart-available* t))
+ (declare (special *toplevel-restart-available*))
+ , at body)
+ (abort (&optional v)
+ :report "Return to SLIME's top level."
+ (declare (ignore v))
+ (force-user-output)
+ ,k))))
(defun top-level-restart-p ()
;; FIXME: this could probably be done better; previously this used
@@ -1118,7 +1092,6 @@
(interrupt-worker-thread thread-id))
(((:write-string
:debug :debug-condition :debug-activate :debug-return :channel-send
- :gdb-attach
:presentation-start :presentation-end
:new-package :new-features :ed :indentation-update
:eval :eval-no-wait :background-message :inspect :ping
More information about the slime-cvs
mailing list