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

Diff of /slime/swank.lisp

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

revision 1.700 by trittweiler, Thu Mar 18 11:52:34 2010 UTC revision 1.701 by trittweiler, Thu Mar 18 12:29:07 2010 UTC
# Line 471  to T unless you want to debug swank inte Line 471  to T unless you want to debug swank inte
471    (check-type msg string)    (check-type msg string)
472    `(call-with-retry-restart ,msg #'(lambda () ,@body)))    `(call-with-retry-restart ,msg #'(lambda () ,@body)))
473    
474    (defun call-with-gdb-restart (pid thunk)
475      (let ((process (format nil "~A-~A (pid ~D)"
476                             (lisp-implementation-type)
477                             (lisp-implementation-version)
478                             pid)))
479        (restart-bind
480            ((attach-gdb
481              #'(lambda ()
482                  (send-to-emacs `(:gdb-attach ,pid ,(gdb-initial-commands)))
483                  (format nil "GDB attached to ~A" process))
484               :report-function #'(lambda (s)
485                                    (format s "Attach GDB to ~A" process))
486               :test-function   #'(lambda (c)
487                                    (declare (ignore c))
488                                    ;; Do not show this restart if
489                                    ;; we're connected remotely.
490                                    (connection.inferior-lisp
491                                     *emacs-connection*)
492                                    t)))
493          (funcall thunk))))
494    
495    (defmacro with-gdb-restart (() &body body)
496      `(call-with-gdb-restart (getpid) #'(lambda () ,@body)))
497    
498  (defmacro with-struct* ((conc-name get obj) &body body)  (defmacro with-struct* ((conc-name get obj) &body body)
499    (let ((var (gensym)))    (let ((var (gensym)))
500      `(let ((,var ,obj))      `(let ((,var ,obj))
# Line 896  This is an optimized way for Lisp to del Line 920  This is an optimized way for Lisp to del
920  ;; Execute K if the restart is invoked.  ;; Execute K if the restart is invoked.
921  (defmacro with-top-level-restart ((connection k) &body body)  (defmacro with-top-level-restart ((connection k) &body body)
922    `(with-connection (,connection)    `(with-connection (,connection)
923       (restart-case       (with-gdb-restart ()
924           ;; We explicitly rebind (and do not look at user's         (restart-case
925           ;; customization), so sldb-quit will always be our restart             ;; We explicitly rebind (and do not look at user's
926           ;; for rex requests.             ;; customization), so sldb-quit will always be our restart
927           (let ((*sldb-quit-restart* (find-restart 'abort))             ;; for rex requests.
928                 (*toplevel-restart-available* t))             (let ((*sldb-quit-restart* (find-restart 'abort))
929             (declare (special *toplevel-restart-available*))                   (*toplevel-restart-available* t))
930             ,@body)               (declare (special *toplevel-restart-available*))
931         (abort (&optional v)               ,@body)
932           :report "Return to SLIME's top level."           (abort (&optional v)
933           (declare (ignore v))             :report "Return to SLIME's top level."
934           (force-user-output)             (declare (ignore v))
935           ,k))))             (force-user-output)
936               ,k)))))
937    
938  (defun top-level-restart-p ()  (defun top-level-restart-p ()
939    ;; FIXME: this could probably be done better; previously this used    ;; FIXME: this could probably be done better; previously this used
# Line 1094  The processing is done in the extent of Line 1119  The processing is done in the extent of
1119       (interrupt-worker-thread thread-id))       (interrupt-worker-thread thread-id))
1120      (((:write-string      (((:write-string
1121         :debug :debug-condition :debug-activate :debug-return :channel-send         :debug :debug-condition :debug-activate :debug-return :channel-send
1122           :gdb-attach
1123         :presentation-start :presentation-end         :presentation-start :presentation-end
1124         :new-package :new-features :ed :indentation-update         :new-package :new-features :ed :indentation-update
1125         :eval :eval-no-wait :background-message :inspect :ping         :eval :eval-no-wait :background-message :inspect :ping

Legend:
Removed from v.1.700  
changed lines
  Added in v.1.701

  ViewVC Help
Powered by ViewVC 1.1.5