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

Diff of /slime/swank-lispworks.lisp

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

revision 1.110 by heller, Sat Aug 9 19:57:00 2008 UTC revision 1.111 by heller, Sat Aug 9 19:57:17 2008 UTC
# Line 32  Line 32 
32  (defun swank-mop:eql-specializer-object (eql-spec)  (defun swank-mop:eql-specializer-object (eql-spec)
33    (second eql-spec))    (second eql-spec))
34    
35  (when (fboundp 'dspec::define-dspec-alias)  (eval-when (:compile-toplevel :execute :load-toplevel)
36    (dspec::define-dspec-alias defimplementation (name args &rest body)    (defvar *original-defimplementation* (macro-function 'defimplementation))
37      `(defun ,name ,args ,@body)))    (defmacro defimplementation (&whole whole name args &body body
38                                   &environment env)
39        (declare (ignore args body))
40        `(progn
41           (dspec:record-definition '(defun ,name) (dspec:location)
42                                    :check-redefinition-p nil)
43           ,(funcall *original-defimplementation* whole env))))
44    
45  ;;; TCP server  ;;; TCP server
46    
# Line 212  Return NIL if the symbol is unbound." Line 218  Return NIL if the symbol is unbound."
218                   :io-bindings io-bindings                   :io-bindings io-bindings
219                   :debugger-hoook hook))                   :debugger-hoook hook))
220    
221  (defmethod env-internals:environment-display-notifier  (defmethod env-internals:environment-display-notifier
222      ((env slime-env) &key restarts condition)      ((env slime-env) &key restarts condition)
223    (declare (ignore restarts))    (declare (ignore restarts condition))
224    (funcall (slot-value env 'debugger-hook) condition *debugger-hook*))    ;;(funcall (swank-sym :swank-debugger-hook) condition *debugger-hook*)
225      (values t nil)
226      )
227    
228  (defmethod env-internals:environment-display-debugger ((env slime-env))  (defmethod env-internals:environment-display-debugger ((env slime-env))
229    *debug-io*)    *debug-io*)
230    
231    (defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args)
232      (apply (swank-sym :y-or-n-p-in-emacs) msg args))
233    
234  (defimplementation call-with-debugger-hook (hook fun)  (defimplementation call-with-debugger-hook (hook fun)
235    (let ((*debugger-hook* hook))    (let ((*debugger-hook* hook))
236      (env:with-environment ((slime-env hook '()))      (env:with-environment ((slime-env hook '()))
# Line 229  Return NIL if the symbol is unbound." Line 240  Return NIL if the symbol is unbound."
240    (setq *debugger-hook* function)    (setq *debugger-hook* function)
241    (setf (env:environment) (slime-env function '())))    (setf (env:environment) (slime-env function '())))
242    
 (defmethod env-internals:environment-display-notifier  
     ((env slime-env) &key restarts condition)  
   (declare (ignore restarts))  
   ;;(funcall (swank-sym :swank-debugger-hook) condition *debugger-hook*)  
   (values t nil)  
   )  
   
 (defmethod env-internals:environment-display-debugger ((env slime-env))  
   *debug-io*)  
   
 (defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args)  
   (apply (swank-sym :y-or-n-p-in-emacs) msg args))  
   
243  (defvar *sldb-top-frame*)  (defvar *sldb-top-frame*)
244    
245  (defun interesting-frame-p (frame)  (defun interesting-frame-p (frame)

Legend:
Removed from v.1.110  
changed lines
  Added in v.1.111

  ViewVC Help
Powered by ViewVC 1.1.5