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

[Helmut Eller]

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

Modified Files:
	swank-cmucl.lisp 
Log Message:
(compile-system-for-emacs): Add method for CMUCL.
Date: Sun Dec 14 02:48:43 2003
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.40 slime/swank-cmucl.lisp:1.41
--- slime/swank-cmucl.lisp:1.40	Fri Dec 12 17:52:02 2003
+++ slime/swank-cmucl.lisp	Sun Dec 14 02:48:43 2003
@@ -26,10 +26,6 @@
          (address (car (ext:host-entry-addr-list hostent))))
     (ext:htonl address)))
 
-(defvar *start-swank-in-background* t)
-(defvar *close-swank-socket-after-setup* t)
-(defvar *use-dedicated-output-stream* t)
-
 (defun create-swank-server (port &key (reuse-address t)
                             (address "localhost")
                             (announce #'simple-announce-function)
@@ -343,6 +339,14 @@
                         :emacs-buffer-offset ,position
                         :emacs-buffer-string ,string))))))
 
+(defmethod compile-system-for-emacs (system-name)
+  (with-compilation-hooks ()
+    (cond ((ext:featurep :asdf)
+           (let ((operate (find-symbol (string :operate) :asdf))
+                 (load-op (find-symbol (string :load-op) :asdf)))
+             (funcall operate load-op system-name)))
+          (t (error "ASDF not loaded")))))
+
 
 ;;;; XREF
 
@@ -860,19 +864,6 @@
 (defslimefun print-ir1-converted-blocks (form)
   (with-output-to-string (*standard-output*)
     (c::print-all-blocks (expand-ir1-top-level (from-string form)))))
-
-(defun tracedp (fname)
-  (gethash (debug::trace-fdefinition fname)
-	   debug::*traced-functions*))
-
-(defslimefun toggle-trace-fdefinition (fname-string)
-  (let ((fname (from-string fname-string)))
-    (cond ((tracedp fname)
-	   (debug::untrace-1 fname)
-	   (format nil "~S is now untraced." fname))
-	  (t
-	   (debug::trace-1 fname (debug::make-trace-info))
-	   (format nil "~S is now traced." fname)))))
 
 (defslimefun set-default-directory (directory)
   (setf (ext:default-directory) (namestring directory))