[slime-cvs] CVS slime/contrib

[CVS User heller]

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv22038/contrib

Modified Files:
	ChangeLog swank-mit-scheme.scm 
Log Message:
Some more MIT Scheme fixes.

* swank-mit-scheme.scm (swank:compile-string-for-emacs)
(swank:compile-file-for-emacs): Use new result format.
(swank:disassemble-form): Added with the needed kludgery for
quoted forms.
(swank:swank-require): Define this as nop.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/01/11 20:30:30	1.428
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/01/12 15:01:07	1.429
@@ -1,3 +1,13 @@
+2011-01-12  Helmut Eller  <heller at common-lisp.net>
+
+	Some more MIT Scheme fixes.
+
+	* swank-mit-scheme.scm (swank:compile-string-for-emacs)
+	(swank:compile-file-for-emacs): Use new result format.
+	(swank:disassemble-form): Added with the needed kludgery for
+	quoted forms.
+	(swank:swank-require): Define this as nop.
+
 2011-01-11  Helmut Eller  <heller at common-lisp.net>
 
 	Some upgrades for MIT Scheme backend.
--- /project/slime/cvsroot/slime/contrib/swank-mit-scheme.scm	2011/01/11 20:30:30	1.6
+++ /project/slime/cvsroot/slime/contrib/swank-mit-scheme.scm	2011/01/12 15:01:07	1.7
@@ -10,10 +10,10 @@
 
 1. You need MIT Scheme (version 7.7.0 and 7.7.90 seem to work).
 
-2. You also need the `netcat' program to create sockets.  MIT Scheme
-   has some socket functions built-in, but I couldn't figure out how
-   to access the locat port number of a server socket.  We shell out
-   to netcat to get us started.
+2. You also need the `netcat' program to create sockets 
+   (netcat-openbsd on Debian).  MIT Scheme has some socket functions
+   built-in, but I couldn't figure out how to access the locat port
+   number of a server socket.  We shell out to netcat to get us started.
 
 3. The Emacs side needs some fiddling.  I have the following in
    my .emacs:
@@ -48,6 +48,7 @@
 	   (match-string-no-properties 1)))))
 
 (setq slime-find-buffer-package-function 'find-mit-scheme-package)
+(add-hook 'scheme-mode-hook (lambda () (slime-mode 1)))
 
    The `mit-scheme-init' function first loads the SOS and FORMAT
    libraries, then creates a package "(swank)", and loads this file
@@ -76,6 +77,20 @@
 
 ;;;; Networking
 
+#|
+;; ### doesn't work because 1) open-tcp-server-socket doesn't set the
+;; SO_REUSEADDR option and 2) we can't read the port number of the
+;; created socket.
+(define (accept-connections port port-file)
+  (let ((sock (open-tcp-server-socket  port (host-address-loopback))))
+    (format #t "Listening on port: ~s~%" port)
+    (if port-file (write-port-file port port-file))
+    (dynamic-wind 
+	(lambda () #f)
+	(lambda () (serve (tcp-server-connection-accept sock #t #f)))
+	(lambda () (close-tcp-server-socket sock)))))
+|#
+
 (define (accept-connections port port-file)
   (let ((nc (netcat port)))
     (format #t "Listening on port: ~s~%" (cadr nc))
@@ -90,11 +105,7 @@
 	 (cmd (format #f "exec netcat -v -q 0 -l ~a 2>&1" port))
 	 (netcat (start-pipe-subprocess sh 
 					(vector sh "-c" cmd)
-					scheme-subprocess-environment))
-	 ;;(line (read-line (subprocess-input-port netcat)))
-	 ;;(match (re-string-match "^listening on \\[[^]]+\\] \\([0-9]+\\) ...$"
-	 ;; line)))
-	 )
+					scheme-subprocess-environment)))
     (list netcat port)))
 
 (define (netcat-accept nc)
@@ -330,13 +341,16 @@
 ;;;; Compilation
 
 (define (swank:compile-string-for-emacs _ string . x)
-  (call-compiler
-   (lambda ()
-     (let* ((sexps (snarf-string string))
-	    (env (user-env *buffer-package*))
-	    (scode (syntax `(begin , at sexps) env))
-	    (compiled-expression (compile-scode scode #t)))
-       (scode-eval compiled-expression env)))))
+  (apply 
+   (lambda (errors seconds)
+     `(:compilation-result ,errors t ,seconds nil nil))
+   (call-compiler
+    (lambda ()
+      (let* ((sexps (snarf-string string))
+	     (env (user-env *buffer-package*))
+	     (scode (syntax `(begin , at sexps) env))
+	     (compiled-expression (compile-scode scode #t)))
+	(scode-eval compiled-expression env))))))
 
 (define (snarf-string string)
   (with-input-from-string string
@@ -350,23 +364,32 @@
     (with-timings fun
       (lambda (run-time gc-time real-time)
 	(set! time real-time)))
-    (list 'nil (format #f "~a" (internal-time/ticks->seconds time)))))
+    (list 'nil (internal-time/ticks->seconds time))))
 
 (define (swank:compiler-notes-for-emacs _) nil)
 
 (define (swank:compile-file-for-emacs socket file load?)
-  (call-compiler
-   (lambda ()
-     (with-output-to-repl socket
-       (lambda () (compile-file file)))
-     (cond ((elisp-true? load?)
-	    (load (pathname-new-type file "com")
-		  (user-env *buffer-package*)))))))
+  (apply
+   (lambda (errors seconds)
+     (list ':compilation-result errors 't seconds load? 
+	   (->namestring (pathname-new-type file "com"))))
+   (call-compiler
+    (lambda () (with-output-to-repl socket (lambda () (compile-file file)))))))
 
 (define (swank:load-file socket file)
   (with-output-to-repl socket
     (lambda () (load file (user-env *buffer-package*)))))
 
+(define (swank:disassemble-form _ string)
+  (let ((sexp (let ((sexp (read-from-string string)))
+		(cond ((and (pair? sexp) (eq? (car sexp) 'quote))
+		       (cadr sexp))
+		      (#t sexp)))))
+    (with-output-to-string
+      (lambda () 
+	(compiler:disassemble
+	 (eval sexp (user-env *buffer-package*)))))))
+
 (define (swank:disassemble-symbol _ string)
   (with-output-to-string
       (lambda () 
@@ -408,6 +431,7 @@
 ;;; Some unimplemented stuff.
 (define (swank:buffer-first-change . _) nil)
 (define (swank:filename-to-modulename . _) nil)
+(define (swank:swank-require . _) nil)
 
 ;; M-. is beyond my capabilities.
 (define (swank:find-definitions-for-emacs . _) nil)