[slime-cvs] CVS update: slime/swank-sbcl.lisp slime/swank-lispworks.lisp slime/swank-cmucl.lisp

Luke Gorrie lgorrie at common-lisp.net
Mon Jan 19 20:14:35 UTC 2004


Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv10176

Modified Files:
	swank-sbcl.lisp swank-lispworks.lisp swank-cmucl.lisp 
Log Message:
Updated to use `defimplementation'.

Date: Mon Jan 19 15:14:35 2004
Author: lgorrie

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.53 slime/swank-sbcl.lisp:1.54
--- slime/swank-sbcl.lisp:1.53	Sun Jan 18 02:59:00 2004
+++ slime/swank-sbcl.lisp	Mon Jan 19 15:14:35 2004
@@ -60,7 +60,7 @@
 
 (setq *swank-in-background* :fd-handler)
 
-(defmethod create-socket (port)
+(defimplementation create-socket (port)
   (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
 			       :type :stream
 			       :protocol :tcp)))
@@ -69,22 +69,22 @@
     (sb-bsd-sockets:socket-listen socket 5)
     socket))
 
-(defmethod local-port (socket)
+(defimplementation local-port (socket)
   (nth-value 1 (sb-bsd-sockets:socket-name socket)))
 
-(defmethod close-socket (socket)
+(defimplementation close-socket (socket)
   (sb-bsd-sockets:socket-close socket))
 
-(defmethod accept-connection (socket)
+(defimplementation accept-connection (socket)
   (make-socket-io-stream (accept socket)))
 
-(defmethod add-input-handler (socket fn)
+(defimplementation add-input-handler (socket fn)
   (sb-sys:add-fd-handler (socket-fd  socket)
                          :input (lambda (fd)
                                   (declare (ignore fd))
                                   (funcall fn))))
 
-(defmethod remove-input-handlers (socket)
+(defimplementation remove-input-handlers (socket)
   (sb-sys:invalidate-descriptor (socket-fd socket))
   (close socket))
 
@@ -106,6 +106,14 @@
             (return (sb-bsd-sockets:socket-accept socket))
           (sb-bsd-sockets:interrupted-error ()))))
 
+(defimplementation make-fn-streams (input-fn output-fn)
+  (let* ((output (make-instance 'slime-output-stream
+                                :output-fn output-fn))
+         (input  (make-instance 'slime-input-stream
+                                :input-fn input-fn
+                                :output-stream output)))
+    (values input output)))
+
 (defmethod call-without-interrupts (fn)
   (sb-sys:without-interrupts (funcall fn)))
 
@@ -121,7 +129,7 @@
   (setf *default-pathname-defaults* (merge-pathnames directory))
   (namestring *default-pathname-defaults*))
 
-(defmethod arglist-string (fname)
+(defimplementation arglist-string (fname)
   (format-arglist fname #'sb-introspect:function-arglist))
 
 (defvar *buffer-name* nil)
@@ -225,25 +233,25 @@
          (reverse
           (sb-c::compiler-error-context-original-source-path context)))))
 
-(defmethod call-with-compilation-hooks (function)
+(defimplementation call-with-compilation-hooks (function)
   (handler-bind ((sb-c:compiler-error  #'handle-notification-condition)
                  (sb-ext:compiler-note #'handle-notification-condition)
                  (style-warning        #'handle-notification-condition)
                  (warning              #'handle-notification-condition))
     (funcall function)))
 
-(defmethod compile-file-for-emacs (filename load-p)
+(defimplementation compile-file-for-emacs (filename load-p)
   (with-compilation-hooks ()
     (multiple-value-bind (fasl-file w-p f-p) (compile-file filename)
       (cond ((and fasl-file (not f-p) load-p)
              (load fasl-file))
             (t fasl-file)))))
 
-(defmethod compile-system-for-emacs (system-name)
+(defimplementation compile-system-for-emacs (system-name)
   (with-compilation-hooks ()
     (asdf:operate 'asdf:load-op system-name)))
 
-(defmethod compile-string-for-emacs (string &key buffer position)
+(defimplementation compile-string-for-emacs (string &key buffer position)
   (with-compilation-hooks ()
     (let ((*package* *buffer-package*)
           (*buffer-name* buffer)
@@ -301,7 +309,7 @@
                       (or (and name (string name))
                           (sb-kernel:%fun-name function)))))))))
                                 
-(defmethod find-function-locations (fname-string)
+(defimplementation find-function-locations (fname-string)
   (let* ((symbol (from-string fname-string)))
     (labels ((finder (fun)
                (cond ((and (symbolp fun) (macro-function fun))
@@ -327,7 +335,7 @@
             (error (e) 
               (list (list :error (format nil "Error: ~A" e)))))))))
 
-(defmethod describe-symbol-for-emacs (symbol)
+(defimplementation describe-symbol-for-emacs (symbol)
   "Return a plist describing SYMBOL.
 Return NIL if the symbol is unbound."
   (let ((result '()))
@@ -354,19 +362,21 @@
 		 (doc 'type)))
       result)))
 
-(defslimefun describe-setf-function (symbol-name)
-  (print-description-to-string `(setf ,(from-string symbol-name))))
-
-(defslimefun describe-type (symbol-name)
-  (print-description-to-string
-   (sb-kernel:values-specifier-type (from-string symbol-name))))
-
-(defslimefun describe-class (symbol-name)
-  (print-description-to-string (find-class (from-string symbol-name) nil)))
+(defimplementation describe-definition (symbol-name type)
+  (case type
+    (:variable
+     (describe-symbol symbol-name))
+    (:setf
+     (print-description-to-string `(setf ,(from-string symbol-name))))
+    (:class
+     (print-description-to-string (find-class (from-string symbol-name) nil)))
+    (:type
+     (print-description-to-string
+      (sb-kernel:values-specifier-type (from-string symbol-name))))))
 
 ;;; macroexpansion
 
-(defmethod macroexpand-all (form)
+(defimplementation macroexpand-all (form)
   (let ((sb-walker:*walk-form-expand-macros-p* t))
     (sb-walker:walk-form form)))
 
@@ -376,7 +386,7 @@
 (defvar *sldb-stack-top*)
 (defvar *sldb-restarts*)
 
-(defmethod call-with-debugging-environment (debugger-loop-fn)
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
   (let* ((*sldb-stack-top* (or sb-debug:*stack-top-hint* (sb-di:top-frame)))
 	 (*sldb-restarts* (compute-restarts *swank-debugger-condition*))
 	 (sb-debug:*stack-top-hint* nil)
@@ -422,11 +432,11 @@
 	  while f
 	  collect (cons i f))))
 
-(defmethod backtrace (start end)
+(defimplementation backtrace (start end)
   (loop for (n . frame) in (compute-backtrace start end)
         collect (list n (format-frame-for-emacs n frame))))
 
-(defmethod debugger-info-for-emacs (start end)
+(defimplementation debugger-info-for-emacs (start end)
   (list (debugger-condition-for-emacs)
 	(format-restarts-for-emacs)
 	(backtrace start end)))
@@ -487,15 +497,15 @@
   (handler-case (source-location-for-emacs code-location)
     (error (c) (list :error (format nil "~A" c)))))
                                                
-(defmethod frame-source-location-for-emacs (index)
+(defimplementation frame-source-location-for-emacs (index)
   (safe-source-location-for-emacs 
    (sb-di:frame-code-location (nth-frame index))))
 
 #+nil
-(defmethod eval-in-frame (form index)
+(defimplementation eval-in-frame (form index)
   (sb-di:eval-in-frame (nth-frame index) string))
 
-(defmethod frame-locals (index)
+(defimplementation frame-locals (index)
   (let* ((frame (nth-frame index))
 	 (location (sb-di:frame-code-location frame))
 	 (debug-function (sb-di:frame-debug-fun frame))
@@ -510,7 +520,7 @@
                        (to-string (sb-di:debug-var-value v frame))
                        "<not-available>")))))
 
-(defmethod frame-catch-tags (index)
+(defimplementation frame-catch-tags (index)
   (loop for (tag . code-location) in (sb-di:frame-catches (nth-frame index))
 	collect `(,tag . ,(safe-source-location-for-emacs code-location))))
 
@@ -524,23 +534,23 @@
 
 #+SB-THREAD
 (progn
-  (defmethod spawn (fn &key name)
+  (defimplementation spawn (fn &key name)
     (declare (ignore name))
     (sb-thread:make-thread fn))
 
-  (defmethod startup-multiprocessing ()
+  (defimplementation startup-multiprocessing ()
     (setq *swank-in-background* :spawn))
 
-  (defmethod thread-id ()
+  (defimplementation thread-id ()
     (sb-thread:current-thread-id))
 
-  (defmethod thread-name (thread-id)
+  (defimplementation thread-name (thread-id)
     (format nil "Thread ~S" thread-id))
 
-  (defmethod make-lock (&key name)
+  (defimplementation make-lock (&key name)
     (sb-thread:make-mutex :name name))
 
-  (defmethod call-with-lock-held (lock function)
+  (defimplementation call-with-lock-held (lock function)
     (sb-thread:with-mutex (lock) (funcall function)))
 )
 


Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.16 slime/swank-lispworks.lisp:1.17
--- slime/swank-lispworks.lisp:1.16	Sun Jan 18 15:01:44 2004
+++ slime/swank-lispworks.lisp	Mon Jan 19 15:14:35 2004
@@ -1,4 +1,4 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
 ;;;
 ;;; swank-lispworks.lisp --- LispWorks specific code for SLIME. 
 ;;;
@@ -7,7 +7,7 @@
 ;;; This code has been placed in the Public Domain.  All warranties
 ;;; are disclaimed.
 ;;;
-;;;   $Id: swank-lispworks.lisp,v 1.16 2004/01/18 20:01:44 heller Exp $
+;;;   $Id: swank-lispworks.lisp,v 1.17 2004/01/19 20:14:35 lgorrie Exp $
 ;;;
 
 (in-package :swank)
@@ -34,7 +34,7 @@
     (fixnum socket)
     (comm:socket-stream (comm:socket-stream-socket socket))))
 
-(defmethod create-socket (port)
+(defimplementation create-socket (port)
   (multiple-value-bind (socket where errno)
       (comm::create-tcp-socket-for-service port :address "localhost")
     (cond (socket socket)
@@ -44,22 +44,22 @@
                                       (list #+unix (lw:get-unix-error errno))
                                       errno))))))
 
-(defmethod local-port (socket)
+(defimplementation local-port (socket)
   (nth-value 1 (comm:get-socket-address (socket-fd socket))))
 
-(defmethod close-socket (socket)
+(defimplementation close-socket (socket)
   (comm::close-socket (socket-fd socket)))
 
-(defmethod accept-connection (socket)
+(defimplementation accept-connection (socket)
   (let ((fd (comm::get-fd-from-socket socket)))
     (assert (/= fd -1))
     (make-instance 'comm:socket-stream :socket fd :direction :io 
                    :element-type 'base-char)))
 
-(defmethod spawn (fn &key name)
+(defimplementation spawn (fn &key name)
   (mp:process-run-function name () fn))
 
-(defmethod emacs-connected ()
+(defimplementation emacs-connected ()
   ;; Set SIGINT handler on Swank request handler thread.
   (sys:set-signal-handler +sigint+ #'sigint-handler))
 
@@ -76,15 +76,14 @@
 (defmethod getpid ()
   (system::getpid))
 
-;;;
 
-(defmethod arglist-string (fname)
+(defimplementation arglist-string (fname)
   (format-arglist fname #'lw:function-lambda-list))
 
-(defmethod macroexpand-all (form)
+(defimplementation macroexpand-all (form)
   (walker:walk-form form))
 
-(defmethod describe-symbol-for-emacs (symbol)
+(defimplementation describe-symbol-for-emacs (symbol)
   "Return a plist describing SYMBOL.
 Return NIL if the symbol is unbound."
   (let ((result '()))
@@ -111,7 +110,13 @@
       (if result
           (list* :designator (to-string symbol) result)))))
 
-(defslimefun describe-function (symbol-name)
+(defimplementation describe-definition (symbol-name type)
+  (case type
+    ;; FIXME: This should cover all types returned by
+    ;; DESCRIBE-SYMBOL-FOR-EMACS.
+    (:function (describe-function symbol-name))))
+
+(defun describe-function (symbol-name)
   (with-output-to-string (*standard-output*)
     (let ((sym (from-string symbol-name)))
       (cond ((fboundp sym)
@@ -124,7 +129,7 @@
             (t (format t "~S is not fbound" sym))))))
 
 #+(or)
-(defmethod describe-object ((sym symbol) *standard-output*)
+(defimplementation describe-object ((sym symbol) *standard-output*)
   (format t "~A is a symbol in package ~A." sym (symbol-package sym))
   (when (boundp sym)
     (format t "~%~%Value: ~A" (symbol-value sym)))
@@ -146,7 +151,7 @@
 (defslimefun sldb-abort ()
   (invoke-restart (find 'abort *sldb-restarts* :key #'restart-name)))
 
-(defmethod call-with-debugging-environment (fn)
+(defimplementation call-with-debugging-environment (fn)
   (dbg::with-debugger-stack ()
     (let ((*sldb-restarts* (compute-restarts *swank-debugger-condition*)))
       (funcall fn))))
@@ -177,7 +182,7 @@
 	(incf i)
 	(push frame backtrace)))))
 
-(defmethod backtrace (start end)
+(defimplementation backtrace (start end)
   (flet ((format-frame (f i)
            (print-with-frame-label
             i (lambda (s)
@@ -190,7 +195,7 @@
 	  for f in (compute-backtrace start end)
 	  collect (list i (format-frame f i)))))
 
-(defmethod debugger-info-for-emacs (start end)
+(defimplementation debugger-info-for-emacs (start end)
   (list (debugger-condition-for-emacs)
         (format-restarts-for-emacs)
         (backtrace start end)))
@@ -201,7 +206,7 @@
 (defslimefun invoke-nth-restart (index)
   (invoke-restart-interactively (nth-restart index)))
 
-(defmethod frame-locals (n)
+(defimplementation frame-locals (n)
   (let ((frame (nth-frame n)))
     (if (dbg::call-frame-p frame)
 	(destructuring-bind (vars with)
@@ -211,11 +216,11 @@
 		collect (list :name (to-string symbol) :id 0
 			      :value-string (princ-to-string value)))))))
 
-(defmethod frame-catch-tags (index)
+(defimplementation frame-catch-tags (index)
   (declare (ignore index))
   nil)
 
-(defmethod frame-source-location-for-emacs (frame)
+(defimplementation frame-source-location-for-emacs (frame)
   (let ((frame (nth-frame frame)))
     (if (dbg::call-frame-p frame)
 	(let ((func (dbg::call-frame-function-name frame)))
@@ -234,20 +239,10 @@
            (loop for (dspec location) in locations
                  collect (make-dspec-location dspec location))))))
 
-(defmethod find-function-locations (fname)
+(defimplementation find-function-locations (fname)
   (dspec-source-locations (from-string fname)))
 
-;;; callers
-
-(defun stringify-function-name-list (list)
-  (let ((*print-pretty* nil)) (mapcar #'to-string list)))
-
-(defslimefun list-callers (symbol-name)
-  (stringify-function-name-list (hcl:who-calls (from-string symbol-name))))
-
-;;; Compilation
-
-(defmethod compile-file-for-emacs (filename load-p)
+(defimplementation compile-file-for-emacs (filename load-p)
   (let ((compiler::*error-database* '()))
     (with-compilation-unit ()
       (compile-file filename :load load-p)
@@ -333,7 +328,7 @@
 		nil)))
 	   htab))
 
-(defmethod compile-string-for-emacs (string &key buffer position)
+(defimplementation compile-string-for-emacs (string &key buffer position)
   (assert buffer)
   (assert position)
   (let ((*package* *buffer-package*)
@@ -352,16 +347,16 @@
 (defun lookup-xrefs (finder name)
   (xref-results-for-emacs (funcall finder (from-string name))))
 
-(defslimefun who-calls (function-name)
+(defimplementation who-calls (function-name)
   (lookup-xrefs #'hcl:who-calls function-name))
 
-(defslimefun who-references (variable)
+(defimplementation who-references (variable)
   (lookup-xrefs #'hcl:who-references variable))
 
-(defslimefun who-binds (variable)
+(defimplementation who-binds (variable)
   (lookup-xrefs #'hcl:who-binds variable))
 
-(defslimefun who-sets (variable)
+(defimplementation who-sets (variable)
   (lookup-xrefs #'hcl:who-sets variable))
 
 (defun xref-results-for-emacs (dspecs)
@@ -373,10 +368,10 @@
                      xrefs)))
     (group-xrefs xrefs)))
 
-(defslimefun list-callers (symbol-name)
+(defimplementation list-callers (symbol-name)
   (lookup-xrefs #'hcl:who-calls symbol-name))
 
-(defslimefun list-callees (symbol-name)
+(defimplementation list-callees (symbol-name)
   (lookup-xrefs #'hcl:calls-who symbol-name))
 
 ;;; Multithreading


Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.55 slime/swank-cmucl.lisp:1.56
--- slime/swank-cmucl.lisp:1.55	Sun Jan 18 02:39:56 2004
+++ slime/swank-cmucl.lisp	Mon Jan 19 15:14:35 2004
@@ -9,7 +9,7 @@
 
 (setq *swank-in-background* :fd-handler)
 
-(defmethod create-socket (port)
+(defimplementation create-socket (port)
   (let ((fd (ext:create-inet-listener port :stream
                                       :reuse-address t
                                       :host (resolve-hostname "localhost"))))
@@ -18,28 +18,28 @@
       (set-fd-non-blocking fd))
     fd))
 
-(defmethod local-port (socket)
+(defimplementation local-port (socket)
   (nth-value 1 (ext::get-socket-host-and-port (socket-fd socket))))
 
-(defmethod close-socket (socket)
+(defimplementation close-socket (socket)
   (ext:close-socket (socket-fd socket)))
 
-(defmethod accept-connection (socket)
+(defimplementation accept-connection (socket)
   #+MP (when *multiprocessing-enabled*
          (mp:process-wait-until-fd-usable socket :input))
   (make-socket-io-stream (ext:accept-tcp-connection socket)))
 
-(defmethod add-input-handler (socket fn)
+(defimplementation add-input-handler (socket fn)
   (flet ((callback (fd)
            (declare (ignore fd))
            (funcall fn)))
     (system:add-fd-handler (socket-fd socket) :input #'callback)))
 
-(defmethod remove-input-handlers (socket)
+(defimplementation remove-input-handlers (socket)
   (sys:invalidate-descriptor (socket-fd socket))
   (close socket))
 
-(defmethod make-fn-streams (input-fn output-fn)
+(defimplementation make-fn-streams (input-fn output-fn)
   (let* ((output (make-slime-output-stream output-fn))
          (input  (make-slime-input-stream input-fn output)))
     (values input output)))
@@ -286,7 +286,7 @@
         (t 
          (list :error "No error location available"))))
 
-(defmethod call-with-compilation-hooks (function)
+(defimplementation call-with-compilation-hooks (function)
   (let ((*previous-compiler-condition* nil)
         (*previous-context* nil)
         (*print-readably* nil))
@@ -295,7 +295,7 @@
                    (c::warning        #'handle-notification-condition))
       (funcall function))))
 
-(defmethod compile-file-for-emacs (filename load-p)
+(defimplementation compile-file-for-emacs (filename load-p)
   (clear-xref-info filename)
   (with-compilation-hooks ()
     (let ((*buffer-name* nil)
@@ -306,7 +306,7 @@
         (when (and load-p (not failure-p))
           (load fasl-file))))))
 
-(defmethod compile-string-for-emacs (string &key buffer position)
+(defimplementation compile-string-for-emacs (string &key buffer position)
   (with-compilation-hooks ()
     (let ((*package* *buffer-package*)
           (*compile-filename* nil)
@@ -320,7 +320,7 @@
                         :emacs-buffer-offset ,position
                         :emacs-buffer-string ,string))))))
 
-(defmethod compile-system-for-emacs (system-name)
+(defimplementation compile-system-for-emacs (system-name)
   (with-compilation-hooks ()
     (cond ((ext:featurep :asdf)
            (let ((operate (find-symbol (string :operate) :asdf))
@@ -664,7 +664,7 @@
   (destructuring-bind (first) (function-source-locations function)
     first))
 
-(defmethod find-function-locations (symbol-name)
+(defimplementation find-function-locations (symbol-name)
   "Return a list of source-locations for SYMBOL-NAME's functions."
   (multiple-value-bind (symbol foundp) (find-symbol-designator symbol-name)
     (cond ((not foundp)
@@ -682,7 +682,7 @@
 
 ;;;; Documentation.
 
-(defmethod describe-symbol-for-emacs (symbol)
+(defimplementation describe-symbol-for-emacs (symbol)
   (let ((result '()))
     (flet ((doc (kind)
              (or (documentation symbol kind) :not-documented))
@@ -728,44 +728,45 @@
 		       (doc nil)))
       result)))
 
-(defslimefun describe-setf-function (symbol-name)
-  (print-description-to-string
-   (or (ext:info setf inverse (from-string symbol-name))
-       (ext:info setf expander (from-string symbol-name)))))
-
-(defslimefun describe-type (symbol-name)
-  (print-description-to-string
-   (kernel:values-specifier-type (from-string symbol-name))))
-
-(defslimefun describe-class (symbol-name)
-  (print-description-to-string (find-class (from-string symbol-name) nil)))
-
-(defslimefun describe-alien-type (symbol-name)
-  (let ((name (from-string symbol-name)))
-    (ecase (ext:info :alien-type :kind name)
-      (:primitive
-       (print-description-to-string
-	(let ((alien::*values-type-okay* t))
-	  (funcall (ext:info :alien-type :translator name) (list name)))))
-      ((:defined)
-       (print-description-to-string (ext:info :alien-type :definition name)))
-      (:unknown
-       (format nil "Unkown alien type: ~A" symbol-name)))))
-
 (defmacro %describe-alien (symbol-name namespace)
   `(print-description-to-string
     (ext:info :alien-type ,namespace (from-string ,symbol-name))))
 
-(defslimefun describe-alien-struct (symbol-name)
-  (%describe-alien symbol-name :struct))
-
-(defslimefun describe-alien-union (symbol-name)
-  (%describe-alien symbol-name :union))
-
-(defslimefun describe-alien-enum (symbol-name)
-  (%describe-alien symbol-name :enum))
+(defimplementation describe-definition (symbol-name type)
+  (case type
+    (:variable
+     (describe-symbol symbol-name))
+    ((:function :generic-function)
+     (describe-function symbol-name))
+    (:setf
+     (print-description-to-string
+      (or (ext:info setf inverse (from-string symbol-name))
+          (ext:info setf expander (from-string symbol-name)))))
+    (:type
+     (print-description-to-string
+      (kernel:values-specifier-type (from-string symbol-name))))
+    (:class
+     (print-description-to-string (find-class (from-string symbol-name) nil)))
+    (:alien-type
+     (let ((name (from-string symbol-name)))
+       (ecase (ext:info :alien-type :kind name)
+         (:primitive
+          (print-description-to-string
+           (let ((alien::*values-type-okay* t))
+             (funcall (ext:info :alien-type :translator name) (list name)))))
+         ((:defined)
+          (print-description-to-string (ext:info :alien-type
+                                                 :definition name)))
+         (:unknown
+          (format nil "Unkown alien type: ~A" symbol-name)))))
+    (:alien-struct
+     (%describe-alien symbol-name :struct))
+    (:alien-union
+     (%describe-alien symbol-name :union))
+    (:alien-enum
+     (%describe-alien symbol-name :enum))))
 
-(defmethod arglist-string (fname)
+(defimplementation arglist-string (fname)
   "Return a string describing the argument list for FNAME.
 The result has the format \"(...)\"."
   (declare (type string fname))
@@ -799,7 +800,7 @@
 
 ;;;; Miscellaneous.
 
-(defmethod macroexpand-all (form)
+(defimplementation macroexpand-all (form)
   (walker:macroexpand-all form))
 
 (in-package :c)
@@ -906,7 +907,7 @@
 (defvar *sldb-stack-top*)
 (defvar *sldb-restarts*)
 
-(defmethod call-with-debugging-environment (debugger-loop-fn)
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
   (unix:unix-sigsetmask 0)
   (let* ((*sldb-stack-top* (or debug:*stack-top-hint* (di:top-frame)))
 	 (*sldb-restarts* (compute-restarts *swank-debugger-condition*))
@@ -953,19 +954,19 @@
 	  while f
 	  collect (cons i f))))
 
-(defmethod backtrace (start end)
+(defimplementation backtrace (start end)
   (loop for (n . frame) in (compute-backtrace start end)
         collect (list n (format-frame-for-emacs n frame))))
 
-(defmethod debugger-info-for-emacs (start end)
+(defimplementation debugger-info-for-emacs (start end)
   (list (debugger-condition-for-emacs)
 	(format-restarts-for-emacs)
 	(backtrace start end)))
 
-(defmethod frame-source-location-for-emacs (index)
+(defimplementation frame-source-location-for-emacs (index)
   (code-location-source-location (di:frame-code-location (nth-frame index))))
 
-(defmethod eval-in-frame (form index)
+(defimplementation eval-in-frame (form index)
   (di:eval-in-frame (nth-frame index) form))
 
 (defslimefun pprint-eval-string-in-frame (string index)
@@ -977,7 +978,7 @@
   (reset-inspector)
   (inspect-object (di:eval-in-frame (nth-frame index) (from-string string))))
 
-(defmethod frame-locals (index)
+(defimplementation frame-locals (index)
   (let* ((frame (nth-frame index))
 	 (location (di:frame-code-location frame))
 	 (debug-function (di:frame-debug-function frame))
@@ -991,7 +992,7 @@
                                 ((:invalid :unknown) 
                                  "<not-available>"))))))
 
-(defmethod frame-catch-tags (index)
+(defimplementation frame-catch-tags (index)
   (loop for (tag . code-location) in (di:frame-catches (nth-frame index))
 	collect `(,tag . ,(code-location-source-location code-location))))
 
@@ -1176,7 +1177,7 @@
     "List of processes that have been assigned IDs.
      The ID is the position in the list.")
 
-  (defmethod startup-multiprocessing ()
+  (defimplementation startup-multiprocessing ()
     (setq *swank-in-background* :spawn)
     ;; Threads magic: this never returns! But top-level becomes
     ;; available again.
@@ -1199,13 +1200,13 @@
     (or (nth thread-id *known-processes*)
         (error "Unknown Thread-ID: ~S" thread-id)))
 
-  (defmethod thread-name (thread-id)
+  (defimplementation thread-name (thread-id)
     (mp:process-name (lookup-thread thread-id)))
 
-  (defmethod make-lock (&key name)
+  (defimplementation make-lock (&key name)
     (mp:make-lock name))
 
-  (defmethod call-with-lock-held (lock function)
+  (defimplementation call-with-lock-held (lock function)
     (mp:with-lock-held (lock)
       (funcall function)))
 )





More information about the slime-cvs mailing list