[slime-cvs] CVS update: slime/swank-cmucl.lisp slime/swank-openmcl.lisp slime/swank-sbcl.lisp slime/swank.lisp
Dan Barlow
dbarlow at common-lisp.net
Wed Oct 15 22:02:50 UTC 2003
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv23193
Modified Files:
swank-cmucl.lisp swank-openmcl.lisp swank-sbcl.lisp swank.lisp
Log Message:
Second iteration refactoring common bits:
server-port *swank-debug-p* start-server *emacs-io* *slime-output*
read-next-form read-form *redirect-output* read-from-emacs
send-to-emacs prin1-to-string-for-emacs defslimefun *buffer-package*
from-string to-string guess-package-from-string eval-string
interactive-eval defslimefun-unimplemented
*swank-io-package*
Date: Wed Oct 15 18:02:50 2003
Author: dbarlow
Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.1 slime/swank-cmucl.lisp:1.2
--- slime/swank-cmucl.lisp:1.1 Wed Oct 15 17:24:33 2003
+++ slime/swank-cmucl.lisp Wed Oct 15 18:02:49 2003
@@ -3,20 +3,8 @@
(in-package :swank)
-(defconstant server-port 4005
- "Default port for the swank TCP server.")
-
-(defvar *swank-debug-p* t
- "When true extra debug printouts are enabled.")
-
;;; Setup and hooks.
-(defun start-server (&optional (port server-port))
- (create-swank-server port :reuse-address t)
- (setf c:*record-xref-info* t)
- (when *swank-debug-p*
- (format *debug-io* "~&;; Swank ready.~%")))
-
(defun set-fd-non-blocking (fd)
(flet ((fcntl (fd cmd arg)
(multiple-value-bind (flags errno) (unix:unix-fcntl fd cmd arg)
@@ -29,9 +17,6 @@
;;; TCP Server.
-(defvar *emacs-io* nil
- "Bound to a TCP stream to Emacs during request processing.")
-
(defstruct (slime-output-stream
(:include lisp::string-output-stream
(lisp::misc #'slime-out-misc)))
@@ -57,9 +42,6 @@
(return count))))
(t (lisp::string-out-misc stream operation arg1 arg2))))
-(defvar *slime-output* nil
- "Bound to a slime-output-stream during request processing.")
-
(defun create-swank-server (port &key reuse-address (address "localhost"))
"Create a SWANK TCP server."
(let* ((hostent (ext:lookup-host-entry address))
@@ -100,79 +82,6 @@
(sys:invalidate-descriptor (sys:fd-stream-fd *emacs-io*))
(close *emacs-io*)))))
-(defun read-next-form ()
- (handler-case
- (let* ((length (logior (ash (read-byte *emacs-io*) 16)
- (ash (read-byte *emacs-io*) 8)
- (read-byte *emacs-io*)))
- (string (make-string length)))
- (sys:read-n-bytes *emacs-io* string 0 length)
- (read-form string))
- (condition (c)
- (throw 'serve-request-catcher c))))
-
-(defun read-form (string)
- (with-standard-io-syntax
- (let ((*package* *swank-io-package*))
- (read-from-string string))))
-
-(defparameter *redirect-output* t)
-
-(defun read-from-emacs ()
- "Read and process a request from Emacs."
- (let ((form (read-next-form)))
- (if *redirect-output*
- (let ((*standard-output* *slime-output*)
- (*error-output* *slime-output*)
- (*trace-output* *slime-output*)
- (*debug-io* *slime-output*)
- (*query-io* *slime-output*))
- (apply #'funcall form))
- (apply #'funcall form))))
-
-(defun send-to-emacs (object)
- "Send OBJECT to Emacs."
- (let* ((string (prin1-to-string-for-emacs object))
- (length (1+ (length string))))
- (loop for position from 16 downto 0 by 8
- do (write-byte (ldb (byte 8 position) length) *emacs-io*))
- (write-string string *emacs-io*)
- (terpri *emacs-io*)
- (force-output *emacs-io*)))
-
-(defun prin1-to-string-for-emacs (object)
- (with-standard-io-syntax
- (let ((*print-case* :downcase)
- (*print-readably* t)
- (*print-pretty* nil)
- (*package* *swank-io-package*))
- (prin1-to-string object))))
-
-;;; Functions for Emacs to call.
-
-(defmacro defslimefun (fun &rest rest)
- `(progn
- (defun ,fun , at rest)
- (export ',fun :swank)))
-
-;;; Utilities.
-
-(defvar *buffer-package*)
-(setf (documentation '*buffer-package* 'symbol)
- "Package corresponding to slime-buffer-package.
-
-EVAL-STRING binds *buffer-package*. Strings originating from a slime
-buffer are best read in this package. See also FROM-STRING and TO-STRING.")
-
-(defun from-string (string)
- "Read string in the *BUFFER-PACKAGE*"
- (let ((*package* *buffer-package*))
- (read-from-string string)))
-
-(defun to-string (string)
- "Write string in the *BUFFER-PACKAGE*"
- (let ((*package* *buffer-package*))
- (prin1-to-string string)))
(defun read-symbol/package (symbol-name package-name)
(let ((package (find-package package-name)))
@@ -184,12 +93,6 @@
;;; Asynchronous eval
-(defun guess-package-from-string (name)
- (or (and name
- (or (find-package name)
- (find-package (string-upcase name))))
- *package*))
-
(defvar *swank-debugger-condition*)
(defvar *swank-debugger-hook*)
@@ -198,23 +101,6 @@
(*swank-debugger-hook* hook))
(sldb-loop)))
-(defslimefun eval-string (string buffer-package)
- (let ((*debugger-hook* #'swank-debugger-hook))
- (let (ok result)
- (unwind-protect
- (let ((*buffer-package* (guess-package-from-string buffer-package)))
- (assert (packagep *buffer-package*))
- (setq result (eval (read-form string)))
- (force-output)
- (setq ok t))
- (send-to-emacs (if ok `(:ok ,result) '(:aborted)))))))
-
-(defslimefun interactive-eval (string)
- (let ((*package* *buffer-package*))
- (let ((values (multiple-value-list (eval (read-from-string string)))))
- (force-output)
- (format nil "~{~S~^, ~}" values))))
-
(defslimefun interactive-eval-region (string)
(let ((*package* *buffer-package*))
(with-input-from-string (stream string)
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.2 slime/swank-openmcl.lisp:1.3
--- slime/swank-openmcl.lisp:1.2 Wed Oct 15 17:24:33 2003
+++ slime/swank-openmcl.lisp Wed Oct 15 18:02:49 2003
@@ -13,7 +13,7 @@
;;; The LLGPL is also available online at
;;; http://opensource.franz.com/preamble.html
;;;
-;;; $Id: swank-openmcl.lisp,v 1.2 2003/10/15 21:24:33 dbarlow Exp $
+;;; $Id: swank-openmcl.lisp,v 1.3 2003/10/15 22:02:49 dbarlow Exp $
;;;
;;;
@@ -46,33 +46,13 @@
;;; run correctly (it hangs upon entering the debugger).
;;;
-;;; Administrivia
-
(in-package :swank)
-(defconstant server-port 4005
- "Default port for the Swank TCP server.")
-
-(defvar *swank-debug-p* t
- "When true, print extra debugging information.")
-
-;;; Setup and Hooks
-
-(defun start-server (&optional (port server-port))
- "Start the Slime backend on TCP port `port'."
- (create-swank-server port :reuse-address t))
-
;;; TCP Server
;; In OpenMCL, the Swank backend runs in a separate thread and simply
;; blocks on its TCP port while waiting for forms to evaluate.
-(defvar *emacs-io* nil
- "Bound to a TCP stream to Emacs during request processing.")
-
-(defvar *slime-output* nil
- "Bound to a slime-output-stream during request processing.")
-
(defun create-swank-server (port &key reuse-address)
"Create a Swank TCP server on `port'."
(ccl:process-run-function "Swank Request Processor" #'swank-main-loop
@@ -112,53 +92,6 @@
(format *terminal-io* "~&;; Swank: Closed connection: ~A~%" *emacs-io*)
(close *emacs-io*)))
-(defun read-from-emacs ()
- "Read and process a request from Emacs."
- (let ((form (read-next-form)))
- (let ((*standard-output* *slime-output*)
- (*error-output* *slime-output*)
- (*trace-output* *slime-output*)
- (*debug-io* *slime-output*)
- (*query-io* *slime-output*))
- (apply #'funcall form))))
-
-(defun read-next-form ()
- "Read the next Slime request from *EMACS-IO* and return an
-S-expression to be evaulated to handle the request. If an error
-occurs during parsing, it will be noted and control will be tranferred
-back to the main request handling loop."
- (handler-case
- (let* ((length (logior (ash (read-byte *emacs-io*) 16)
- (ash (read-byte *emacs-io*) 8)
- (read-byte *emacs-io*)))
- (string (make-string length)))
- (read-sequence string *emacs-io*)
- (read-form string))
- (condition (c)
- (throw 'serve-request-catcher c))))
-
-(defun read-form (string)
- (with-standard-io-syntax
- (let ((*package* *swank-io-package*))
- (read-from-string string))))
-
-(defun send-to-emacs (object)
- "Send `object' to Emacs."
- (let* ((string (prin1-to-string-for-emacs object))
- (length (1+ (length string))))
- (loop for position from 16 downto 0 by 8
- do (write-byte (ldb (byte 8 position) length) *emacs-io*))
- (write-string string *emacs-io*)
- (terpri *emacs-io*)
- (force-output *emacs-io*)))
-
-(defun prin1-to-string-for-emacs (object)
- (let ((*print-case* :downcase)
- (*print-readably* nil)
- (*print-pretty* nil)
- (*package* *swank-io-package*))
- (prin1-to-string object)))
-
;;; Redirecting Output to Emacs
;; This buffering is done via a Gray stream instead of the CMU-specific
@@ -178,32 +111,6 @@
(slime-output-stream-buffer stream))))
(setf (slime-output-stream-buffer stream) (make-string-output-stream)))
-;;; Utilities
-
-(defvar *buffer-package*)
-
-(defun from-string (string)
- "Read string in the *BUFFER-PACKAGE*"
- (let ((*package* *buffer-package*))
- (read-from-string string)))
-
-(defun to-string (string)
- "Write string in the *BUFFER-PACKAGE*."
- (let ((*package* *buffer-package*))
- (prin1-to-string string)))
-
-(defmacro defslimefun (fun &rest rest)
- `(progn
- (defun ,fun , at rest)
- (export ',fun :swank)))
-
-(defmacro defslimefun-unimplemented (fun args)
- `(progn
- (defun ,fun ,args
- (declare (ignore , at args))
- (error "Backend function ~A not implemented." ',fun))
- (export ',fun :swank)))
-
;;; Evaluation
(defvar *swank-debugger-condition*)
@@ -219,28 +126,6 @@
(let ((*swank-debugger-condition* condition)
(*swank-debugger-hook* hook))
(sldb-loop)))
-
-(defun guess-package-from-string (name)
- (or (and name
- (or (find-package name)
- (find-package (string-upcase name))))
- *package*))
-
-(defslimefun eval-string (string buffer-package)
- (let ((*debugger-hook* #'swank-debugger-hook))
- (let (ok result)
- (unwind-protect
- (let ((*buffer-package* (guess-package-from-string buffer-package)))
- (assert (packagep *buffer-package*))
- (setq result (eval (read-form string)))
- (force-output)
- (setq ok t))
- (send-to-emacs (if ok `(:ok ,result) '(:aborted)))))))
-
-(defslimefun interactive-eval (string)
- (let ((values (multiple-value-list (eval (from-string string)))))
- (force-output)
- (format nil "~{~S~^, ~}" values)))
(defslimefun-unimplemented interactive-eval-region (string))
(defslimefun-unimplemented pprint-eval (string))
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.2 slime/swank-sbcl.lisp:1.3
--- slime/swank-sbcl.lisp:1.2 Wed Oct 15 17:24:33 2003
+++ slime/swank-sbcl.lisp Wed Oct 15 18:02:49 2003
@@ -48,29 +48,11 @@
(declaim (optimize (debug 3)))
(in-package :swank)
-(defconstant server-port 4005
- "Default port for the Swank TCP server.")
-
-(defvar *swank-debug-p* t
- "When true, print extra debugging information.")
-
-;;; Setup and Hooks
-
-(defun start-server (&optional (port server-port))
- "Start the Slime backend on TCP port `port'."
- (create-swank-server port :reuse-address t))
-
;;; TCP Server
;; The Swank backend runs in a separate thread and simply blocks on
;; its TCP port while waiting for forms to evaluate.
-(defvar *emacs-io* nil
- "Bound to a TCP stream to Emacs during request processing.")
-
-(defvar *slime-output* nil
- "Bound to a slime-output-stream during request processing.")
-
(defun create-swank-server (port &key reuse-address)
"Create a Swank TCP server on `port'."
(sb-thread:make-thread
@@ -128,62 +110,6 @@
(format *terminal-io* "~&;; Swank: Closed connection: ~A~%" *emacs-io*)
(close *emacs-io*)))
-(defun read-from-emacs ()
- "Read and process a request from Emacs."
- (let ((form (read-next-form)))
- (let ((*standard-output* *slime-output*)
- (*error-output* *slime-output*)
- (*trace-output* *slime-output*)
- (*debug-io* *slime-output*)
- (*query-io* *slime-output*))
- (apply #'funcall form))))
-
-(defun read-next-form ()
- "Read the next Slime request from *EMACS-IO* and return an
-S-expression to be evaulated to handle the request. If an error
-occurs during parsing, it will be noted and control will be tranferred
-back to the main request handling loop."
- (handler-case
- (let* ((length (logior (ash (read-byte *emacs-io*) 16)
- (ash (read-byte *emacs-io*) 8)
- (read-byte *emacs-io*)))
- (string (make-string length)))
- (read-sequence string *emacs-io*)
- (read-form string))
- (condition (c)
- (throw 'serve-request-catcher c))))
-
-(defvar *swank-io-package*
- (let ((package (make-package "SWANK-IO-PACKAGE")))
- ;; my suspicion is that this package is not intended to use any other
- ;; at all, hence the import of NIL. However, make-package with no
- ;; :use option (as was here) in CMUCL defaults to using the CL package
- ;; and there are other symbols (most notably QUOTE) which swank needs
- (import '(nil t quote) package)
- package))
-
-(defun read-form (string)
- (with-standard-io-syntax
- (let ((*package* *swank-io-package*))
- (read-from-string string))))
-
-(defun send-to-emacs (object)
- "Send `object' to Emacs."
- (let* ((string (prin1-to-string-for-emacs object))
- (length (1+ (length string))))
- (loop for position from 16 downto 0 by 8
- do (write-byte (ldb (byte 8 position) length) *emacs-io*))
- (write-string string *emacs-io*)
- (terpri *emacs-io*)
- (force-output *emacs-io*)))
-
-(defun prin1-to-string-for-emacs (object)
- (let ((*print-case* :downcase)
- (*print-readably* nil)
- (*print-pretty* nil)
- (*package* *swank-io-package*))
- (prin1-to-string object)))
-
;;; Redirecting Output to Emacs
;; This buffering is done via a Gray stream instead of the CMU-specific
@@ -205,32 +131,6 @@
;;; Utilities
-(defvar *buffer-package*)
-
-(defun from-string (string)
- "Read string in the *BUFFER-PACKAGE*"
- (let ((*package* *buffer-package*))
- (read-from-string string)))
-
-(defun to-string (string)
- "Write string in the *BUFFER-PACKAGE*."
- (let ((*package* *buffer-package*))
- (prin1-to-string string)))
-
-(defmacro defslimefun (fun &rest rest)
- `(progn
- (defun ,fun , at rest)
- (export ',fun :swank)))
-
-(defmacro defslimefun-unimplemented (fun args)
- `(progn
- (defun ,fun ,args
- (declare (ignore , at args))
- (error "Backend function ~A not implemented." ',fun))
- (export ',fun :swank)))
-
-
-
(defvar *swank-debugger-condition*)
(defvar *swank-debugger-hook*)
(defvar *swank-debugger-stack-frame*)
@@ -239,32 +139,7 @@
(let ((*swank-debugger-condition* condition)
(*swank-debugger-hook* hook))
(sldb-loop)))
-
-(defun guess-package-from-string (name)
- (or (and name
- (or (find-package name)
- (find-package (string-upcase name))))
- *package*))
-
-;;; common to all backends
-(defslimefun eval-string (string buffer-package)
- (let ((*debugger-hook* #'swank-debugger-hook))
- (let (ok result)
- (unwind-protect
- (let ((*buffer-package* (guess-package-from-string buffer-package)))
- (assert (packagep *buffer-package*))
- (setq result (eval (read-form string)))
- (force-output)
- (setq ok t))
- (send-to-emacs (if ok `(:ok ,result) '(:aborted)))))))
-
-;;; following five functions from cmucl
-(defslimefun interactive-eval (string)
- (let ((*package* *buffer-package*))
- (let ((values (multiple-value-list (eval (read-from-string string)))))
- (force-output)
- (format nil "~{~S~^, ~}" values))))
-
+
(defslimefun interactive-eval-region (string)
(let ((*package* *buffer-package*))
(with-input-from-string (stream string)
Index: slime/swank.lisp
diff -u slime/swank.lisp:1.27 slime/swank.lisp:1.28
--- slime/swank.lisp:1.27 Wed Oct 15 17:24:33 2003
+++ slime/swank.lisp Wed Oct 15 18:02:49 2003
@@ -10,6 +10,7 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(defpackage :swank
(:use :common-lisp)
+ (:nicknames "SWANK-IMPL")
(:export #:start-server)))
(eval-when (:compile-toplevel :load-toplevel :execute)
@@ -27,6 +28,141 @@
package))
(declaim (optimize (debug 3)))
+
+(defconstant server-port 4005
+ "Default port for the Swank TCP server.")
+
+(defvar *swank-debug-p* t
+ "When true, print extra debugging information.")
+
+;;; Setup and Hooks
+
+(defun start-server (&optional (port server-port))
+ "Start the Slime backend on TCP port `port'."
+ (swank-impl:create-swank-server port :reuse-address t)
+ #+xref (setf c:*record-xref-info* t)
+ (when *swank-debug-p*
+ (format *debug-io* "~&;; Swank ready.~%")))
+
+;;; IO to emacs
+
+(defvar *emacs-io* nil
+ "Bound to a TCP stream to Emacs during request processing.")
+
+(defvar *slime-output* nil
+ "Bound to a slime-output-stream during request processing.")
+
+(defparameter *redirect-output* t)
+
+(defun read-from-emacs ()
+ "Read and process a request from Emacs."
+ (let ((form (read-next-form)))
+ (if *redirect-output*
+ (let ((*standard-output* *slime-output*)
+ (*error-output* *slime-output*)
+ (*trace-output* *slime-output*)
+ (*debug-io* *slime-output*)
+ (*query-io* *slime-output*))
+ (apply #'funcall form))
+ (apply #'funcall form))))
+
+(defun read-next-form ()
+ "Read the next Slime request from *EMACS-IO* and return an
+S-expression to be evaulated to handle the request. If an error
+occurs during parsing, it will be noted and control will be tranferred
+back to the main request handling loop."
+ (handler-case
+ (let* ((length (logior (ash (read-byte *emacs-io*) 16)
+ (ash (read-byte *emacs-io*) 8)
+ (read-byte *emacs-io*)))
+ (string (make-string length)))
+ (read-sequence string *emacs-io*)
+ (read-form string))
+ (condition (c)
+ (throw 'serve-request-catcher c))))
+
+(defun read-form (string)
+ (with-standard-io-syntax
+ (let ((*package* *swank-io-package*))
+ (read-from-string string))))
+
+(defun send-to-emacs (object)
+ "Send `object' to Emacs."
+ (let* ((string (prin1-to-string-for-emacs object))
+ (length (1+ (length string))))
+ (loop for position from 16 downto 0 by 8
+ do (write-byte (ldb (byte 8 position) length) *emacs-io*))
+ (write-string string *emacs-io*)
+ (terpri *emacs-io*)
+ (force-output *emacs-io*)))
+
+(defun prin1-to-string-for-emacs (object)
+ (let ((*print-case* :downcase)
+ (*print-readably* nil)
+ (*print-pretty* nil)
+ (*package* *swank-io-package*))
+ (prin1-to-string object)))
+
+;;; The Reader
+
+(defvar *buffer-package*)
+(setf (documentation '*buffer-package* 'symbol)
+ "Package corresponding to slime-buffer-package.
+
+EVAL-STRING binds *buffer-package*. Strings originating from a slime
+buffer are best read in this package. See also FROM-STRING and TO-STRING.")
+
+
+(defun from-string (string)
+ "Read string in the *BUFFER-PACKAGE*"
+ (let ((*package* *buffer-package*))
+ (read-from-string string)))
+
+(defun to-string (string)
+ "Write string in the *BUFFER-PACKAGE*."
+ (let ((*package* *buffer-package*))
+ (prin1-to-string string)))
+
+(defun guess-package-from-string (name)
+ (or (and name
+ (or (find-package name)
+ (find-package (string-upcase name))))
+ *package*))
+
+
+;;; public interface. slimefuns are the things that emacs is allowed
+;;; to call
+
+(defmacro defslimefun (fun &rest rest)
+ `(progn
+ (defun ,fun , at rest)
+ (export ',fun :swank)))
+
+(defmacro defslimefun-unimplemented (fun args)
+ `(progn
+ (defun ,fun ,args
+ (declare (ignore , at args))
+ (error "Backend function ~A not implemented." ',fun))
+ (export ',fun :swank)))
+
+(defslimefun eval-string (string buffer-package)
+ (let ((*debugger-hook* #'swank-debugger-hook))
+ (let (ok result)
+ (unwind-protect
+ (let ((*buffer-package* (guess-package-from-string buffer-package)))
+ (assert (packagep *buffer-package*))
+ (setq result (eval (read-form string)))
+ (force-output)
+ (setq ok t))
+ (send-to-emacs (if ok `(:ok ,result) '(:aborted)))))))
+
+(defslimefun interactive-eval (string)
+ (let ((values (multiple-value-list (eval (from-string string)))))
+ (force-output)
+ (format nil "~{~S~^, ~}" values)))
+
+
+
(eval-when (:compile-toplevel) (compile-file swank::*sysdep-pathname*))
(eval-when (:load-toplevel :execute) (load swank::*sysdep-pathname*))
More information about the slime-cvs
mailing list