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

Diff of /slime/swank-backend.lisp

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

revision 1.94 by heller, Sun Nov 20 23:25:38 2005 UTC revision 1.99 by heller, Wed Aug 9 16:34:15 2006 UTC
# Line 84  Line 84 
84     #:slot-definition-type     #:slot-definition-type
85     #:slot-definition-readers     #:slot-definition-readers
86     #:slot-definition-writers     #:slot-definition-writers
87       #:slot-boundp-using-class
88       #:slot-value-using-class
89     ;; generic function protocol     ;; generic function protocol
90     #:compute-applicable-methods-using-classes     #:compute-applicable-methods-using-classes
91     #:finalize-inheritance))     #:finalize-inheritance))
# Line 111  implementation. Line 113  implementation.
113  Backends implement these functions using DEFIMPLEMENTATION."  Backends implement these functions using DEFIMPLEMENTATION."
114    (check-type documentation string "a documentation string")    (check-type documentation string "a documentation string")
115    (flet ((gen-default-impl ()    (flet ((gen-default-impl ()
116             `(defmethod ,name ,args ,@default-body)))             `(defmethod no-applicable-method ((_gf (eql #',name)) &rest _rargs)
117                  (declare (ignore _))
118                  (destructuring-bind ,args rargs
119                    ,@default-body))))
120      `(progn (defgeneric ,name ,args (:documentation ,documentation))      `(progn (defgeneric ,name ,args (:documentation ,documentation))
121              (pushnew ',name *interface-functions*)              (pushnew ',name *interface-functions*)
122              ,(if (null default-body)              ,(if (null default-body)
# Line 123  Backends implement these functions using Line 128  Backends implement these functions using
128              ',name)))              ',name)))
129    
130  (defmacro defimplementation (name args &body body)  (defmacro defimplementation (name args &body body)
131    `(progn (defmethod ,name ,args ,@body)    `(progn
132            (if (member ',name *interface-functions*)       (defmethod ,name ,args ,@body)
133                (setq *unimplemented-interfaces*       (if (member ',name *interface-functions*)
134                      (remove ',name *unimplemented-interfaces*))           (setq *unimplemented-interfaces*
135                (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))                 (remove ',name *unimplemented-interfaces*))
136            ',name))           (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
137         ',name))
138    
139  (defun warn-unimplemented-interfaces ()  (defun warn-unimplemented-interfaces ()
140    "Warn the user about unimplemented backend features.    "Warn the user about unimplemented backend features.
# Line 212  EXCEPT is a list of symbol names which s Line 218  EXCEPT is a list of symbol names which s
218    "Close the socket SOCKET.")    "Close the socket SOCKET.")
219    
220  (definterface accept-connection (socket &key external-format  (definterface accept-connection (socket &key external-format
221                                          buffering)                                          buffering timeout)
222     "Accept a client connection on the listening socket SOCKET.     "Accept a client connection on the listening socket SOCKET.
223  Return a stream for the new connection.")  Return a stream for the new connection.")
224    
# Line 232  Return a stream for the new connection." Line 238  Return a stream for the new connection."
238    "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."    "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
239    nil)    nil)
240    
241    (definterface set-stream-timeout (stream timeout)
242      "Set the 'stream 'timeout.  The timeout is either the real number
243      specifying the timeout in seconds or 'nil for no timeout."
244      (declare (ignore stream timeout))
245      nil)
246    
247  ;;; Base condition for networking errors.  ;;; Base condition for networking errors.
248  (define-condition network-error (simple-error) ())  (define-condition network-error (simple-error) ())
249    
# Line 313  Example: Line 325  Example:
325    (unless (member :asdf *features*)    (unless (member :asdf *features*)
326      (error "ASDF is not loaded."))      (error "ASDF is not loaded."))
327    (with-compilation-hooks ()    (with-compilation-hooks ()
328      (let ((operate (find-symbol "OPERATE" :asdf))      (let ((operate (find-symbol (symbol-name '#:operate) :asdf))
329            (operation (find-symbol operation-name :asdf)))            (operation (find-symbol operation-name :asdf)))
330        (when (null operation)        (when (null operation)
331          (error "Couldn't find ASDF operation ~S" operation-name))          (error "Couldn't find ASDF operation ~S" operation-name))
# Line 716  inspect-for-emacs method.")) Line 728  inspect-for-emacs method."))
728  (definterface make-default-inspector ()  (definterface make-default-inspector ()
729    "Return an inspector object suitable for passing to inspect-for-emacs.")    "Return an inspector object suitable for passing to inspect-for-emacs.")
730    
731  (definterface inspect-for-emacs (object inspector)  (defgeneric inspect-for-emacs (object inspector)
732     "Explain to Emacs how to inspect OBJECT.     "Explain to Emacs how to inspect OBJECT.
733    
734  The argument INSPECTOR is an object representing how to get at  The argument INSPECTOR is an object representing how to get at
# Line 828  Only one thread may hold the lock (via C Line 840  Only one thread may hold the lock (via C
840              (type function function))              (type function function))
841     (funcall function))     (funcall function))
842    
843    (definterface make-recursive-lock (&key name)
844      "Make a lock for thread synchronization.
845    Only one thread may hold the lock (via CALL-WITH-RECURSIVE-LOCK-HELD)
846    at a time, but that thread may hold it more than once."
847      (cons nil (make-lock :name name)))
848    
849    (definterface call-with-recursive-lock-held (lock function)
850      "Call FUNCTION with LOCK held, queueing if necessary."
851      (if (eql (car lock) (current-thread))
852          (funcall function)
853          (call-with-lock-held (cdr lock)
854                               (lambda ()
855                                 (unwind-protect
856                                      (progn
857                                        (setf (car lock) (current-thread))
858                                        (funcall function))
859                                   (setf (car lock) nil))))))
860    
861  (definterface current-thread ()  (definterface current-thread ()
862    "Return the currently executing thread."    "Return the currently executing thread."
863    0)    0)

Legend:
Removed from v.1.94  
changed lines
  Added in v.1.99

  ViewVC Help
Powered by ViewVC 1.1.5