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

Diff of /slime/swank.lisp

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

revision 1.566 by heller, Mon Aug 11 17:41:55 2008 UTC revision 1.567 by heller, Tue Aug 12 12:56:57 2008 UTC
# Line 1159  The processing is done in the extent of Line 1159  The processing is done in the extent of
1159    (add-fd-handler (connection.socket-io connection)    (add-fd-handler (connection.socket-io connection)
1160                    (lambda () (handle-or-process-requests connection)))                    (lambda () (handle-or-process-requests connection)))
1161    (setf (connection.saved-sigint-handler connection)    (setf (connection.saved-sigint-handler connection)
1162          (install-sigint-handler (lambda () (process-io-interrupt connection))))          (install-sigint-handler
1163             (lambda ()
1164               (invoke-or-queue-interrupt
1165                (lambda ()
1166                  (dispatch-event `(:emacs-interrupt ,(current-thread-id))))))))
1167    (handle-or-process-requests connection))    (handle-or-process-requests connection))
1168    
1169  (defun deinstall-fd-handler (connection)  (defun deinstall-fd-handler (connection)
# Line 1171  The processing is done in the extent of Line 1175  The processing is done in the extent of
1175  (defun simple-serve-requests (connection)  (defun simple-serve-requests (connection)
1176    (unwind-protect    (unwind-protect
1177         (call-with-user-break-handler         (call-with-user-break-handler
1178          (lambda () (process-io-interrupt connection))          (lambda ()
1179              (invoke-or-queue-interrupt
1180               (lambda ()
1181                 (dispatch-event `(:emacs-interrupt ,(current-thread-id))))))
1182          (lambda ()          (lambda ()
1183            (with-simple-restart (close-connection "Close SLIME connection")            (with-simple-restart (close-connection "Close SLIME connection")
1184              (handle-requests connection))))              (handle-requests connection))))
# Line 1762  Fall back to the the current if no such Line 1769  Fall back to the the current if no such
1769    "Bind *BUFFER-PACKAGE* to BUFFER-PACKAGE and evaluate FORM.    "Bind *BUFFER-PACKAGE* to BUFFER-PACKAGE and evaluate FORM.
1770  Return the result to the continuation ID.  Return the result to the continuation ID.
1771  Errors are trapped and invoke our debugger."  Errors are trapped and invoke our debugger."
1772    (call-with-debugger-hook    (let (ok result)
1773     #'swank-debugger-hook      (unwind-protect
1774     (lambda ()           (let ((*buffer-package* (guess-buffer-package buffer-package))
1775       (let (ok result)                 (*buffer-readtable* (guess-buffer-readtable buffer-package))
1776         (unwind-protect                 (*pending-continuations* (cons id *pending-continuations*)))
1777              (let ((*buffer-package* (guess-buffer-package buffer-package))             (check-type *buffer-package* package)
1778                    (*buffer-readtable* (guess-buffer-readtable buffer-package))             (check-type *buffer-readtable* readtable)
1779                    (*pending-continuations* (cons id *pending-continuations*)))             ;; APPLY would be cleaner than EVAL.
1780                (check-type *buffer-package* package)             ;;(setq result (apply (car form) (cdr form)))
1781                (check-type *buffer-readtable* readtable)             (setq result (with-slime-interrupts (eval form)))
1782                ;; APPLY would be cleaner than EVAL.             (run-hook *pre-reply-hook*)
1783                ;;(setq result (apply (car form) (cdr form)))             (setq ok t))
1784                (setq result (with-slime-interrupts (eval form)))        (send-to-emacs `(:return ,(current-thread)
1785                (run-hook *pre-reply-hook*)                                 ,(if ok
1786                (setq ok t))                                      `(:ok ,result)
1787           (send-to-emacs `(:return ,(current-thread)                                      `(:abort))
1788                                    ,(if ok                                 ,id)))))
                                        `(:ok ,result)  
                                        `(:abort))  
                                   ,id)))))))  
1789    
1790  (defvar *echo-area-prefix* "=> "  (defvar *echo-area-prefix* "=> "
1791    "A prefix that `format-values-for-echo-area' should use.")    "A prefix that `format-values-for-echo-area' should use.")
# Line 2027  after Emacs causes a restart to be invok Line 2031  after Emacs causes a restart to be invok
2031    
2032  (defun swank-debugger-hook (condition hook)  (defun swank-debugger-hook (condition hook)
2033    "Debugger function for binding *DEBUGGER-HOOK*."    "Debugger function for binding *DEBUGGER-HOOK*."
2034    (declare (ignore hook))    (restart-case
2035    (restart-case (invoke-slime-debugger condition)        (call-with-debugger-hook
2036           hook (lambda () (invoke-slime-debugger condition)))
2037      (default-debugger (&optional v)      (default-debugger (&optional v)
2038        :report "Use default debugger." (declare (ignore v))        :report "Use default debugger." (declare (ignore v))
2039        (invoke-default-debugger condition))))        (invoke-default-debugger condition))))

Legend:
Removed from v.1.566  
changed lines
  Added in v.1.567

  ViewVC Help
Powered by ViewVC 1.1.5