/[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.75 by heller, Fri Nov 19 19:05:25 2004 UTC revision 1.76 by heller, Wed Nov 24 19:57:10 2004 UTC
# Line 107  Backends implement these functions using Line 107  Backends implement these functions using
107    (check-type documentation string "a documentation string")    (check-type documentation string "a documentation string")
108    (flet ((gen-default-impl ()    (flet ((gen-default-impl ()
109             `(defmethod ,name ,args ,@default-body)))             `(defmethod ,name ,args ,@default-body)))
110       `(progn (defgeneric ,name ,args (:documentation ,documentation))      `(progn (defgeneric ,name ,args (:documentation ,documentation))
111               (pushnew ',name *interface-functions*)              (pushnew ',name *interface-functions*)
112               ,(if (null default-body)              ,(if (null default-body)
113                  `(pushnew ',name *unimplemented-interfaces*)                   `(pushnew ',name *unimplemented-interfaces*)
114                  (gen-default-impl))                   (gen-default-impl))
115               ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>              ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
116               (eval-when (:compile-toplevel :load-toplevel :execute)              (eval-when (:compile-toplevel :load-toplevel :execute)
117                 (export ',name :swank-backend))                (export ',name :swank-backend))
118               ',name)))              ',name)))
119    
120  (defmacro defimplementation (name args &body body)  (defmacro defimplementation (name args &body body)
121    `(progn (defmethod ,name ,args ,@body)    `(progn (defmethod ,name ,args ,@body)
# Line 145  EXCEPT is a list of symbol names which s Line 145  EXCEPT is a list of symbol names which s
145    (do-symbols (s :swank-mop)    (do-symbols (s :swank-mop)
146      (unless (member s except :test #'string=)      (unless (member s except :test #'string=)
147        (let ((real-symbol (find-symbol (string s) package)))        (let ((real-symbol (find-symbol (string s) package)))
148          (assert real-symbol)          (assert real-symbol () "Symbol ~A not found in package ~A" s package)
149          (unintern s :swank-mop)          (unintern s :swank-mop)
150          (import real-symbol :swank-mop)          (import real-symbol :swank-mop)
151          (export real-symbol :swank-mop)))))          (export real-symbol :swank-mop)))))

Legend:
Removed from v.1.75  
changed lines
  Added in v.1.76

  ViewVC Help
Powered by ViewVC 1.1.5