[slime-cvs] CVS update: slime/swank.lisp slime/swank-sbcl.lisp
Helmut Eller
heller at common-lisp.net
Sat Jan 31 20:17:19 UTC 2004
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv12786
Modified Files:
swank.lisp swank-sbcl.lisp
Log Message:
Add more type declarations and detect missing initargs for the connection struct. Patch by Robert E. Brown.
Date: Sat Jan 31 15:17:19 2004
Author: heller
Index: slime/swank.lisp
diff -u slime/swank.lisp:1.112 slime/swank.lisp:1.113
--- slime/swank.lisp:1.112 Sat Jan 31 06:50:25 2004
+++ slime/swank.lisp Sat Jan 31 15:17:19 2004
@@ -47,6 +47,10 @@
(error "Backend function ~A not implemented." ',fun))
(export ',fun :swank)))
+(declaim (ftype (function () nil) missing-arg))
+(defun missing-arg ()
+ (error "A required &KEY or &OPTIONAL argument was not supplied."))
+
;;;; Connections
;;;
@@ -91,7 +95,7 @@
;; (:print-function %print-connection)
)
;; Raw I/O stream of socket connection.
- (socket-io nil :type stream :read-only t)
+ (socket-io (missing-arg) :type stream :read-only t)
;; Optional dedicated output socket (backending `user-output' slot).
;; Has a slot so that it can be closed with the connection.
(dedicated-output nil :type (or stream null))
@@ -103,10 +107,10 @@
;;
(control-thread nil :read-only t)
(reader-thread nil :read-only t)
- read
- send
- serve-requests
- cleanup
+ (read (missing-arg) :type function)
+ (send (missing-arg) :type function)
+ (serve-requests (missing-arg) :type function)
+ (cleanup nil :type (or null function))
)
(defvar *emacs-connection* nil
@@ -178,7 +182,7 @@
(defvar *use-dedicated-output-stream* t)
(defvar *swank-in-background* nil)
-(defvar *log-events* t)
+(defvar *log-events* nil)
(defun start-server (port-file)
(setup-server 0 (lambda (port) (announce-server-port port-file port))
@@ -287,8 +291,9 @@
(defun close-connection (c &optional condition)
(when condition
(format *debug-io* "~&;; Connection to Emacs lost.~%;; [~A]~%" condition))
- (when (connection.cleanup c)
- (funcall (connection.cleanup c) c))
+ (let ((cleanup (connection.cleanup c)))
+ (when cleanup
+ (funcall cleanup c)))
(close (connection.socket-io c))
(when (connection.dedicated-output c)
(close (connection.dedicated-output c))))
@@ -313,6 +318,7 @@
(defun drop&find (item list key test)
"Return LIST where item is removed together with the removed
element."
+ (declare (type function key test))
(do ((stack '() (cons (car l) stack))
(l list (cdr l)))
((null l) (values (nreverse stack) nil))
@@ -402,22 +408,22 @@
:user-input in :user-output out :user-io io
:control-thread control-thread
:reader-thread reader-thread
- :read 'read-from-control-thread
- :send 'send-to-control-thread
+ :read #'read-from-control-thread
+ :send #'send-to-control-thread
:serve-requests (lambda (c) c))))
(:sigio
(make-connection :socket-io socket-io :dedicated-output dedicated
:user-input in :user-output out :user-io io
- :read 'read-from-socket-io
- :send 'send-to-socket-io
- :serve-requests 'install-sigio-handler
- :cleanup 'remove-sigio-handler))
+ :read #'read-from-socket-io
+ :send #'send-to-socket-io
+ :serve-requests #'install-sigio-handler
+ :cleanup #'remove-sigio-handler))
((nil)
(make-connection :socket-io socket-io :dedicated-output dedicated
:user-input in :user-output out :user-io io
- :read 'read-from-socket-io
- :send 'send-to-socket-io
- :serve-requests 'simple-serve-requests)))))
+ :read #'read-from-socket-io
+ :send #'send-to-socket-io
+ :serve-requests #'simple-serve-requests)))))
(defun install-sigio-handler (connection)
(let ((client (connection.socket-io connection)))
@@ -447,10 +453,13 @@
(log-event "DISPATCHING: ~S~%" event)
(destructure-case event
((:emacs-rex string package thread id)
+ (declare (ignore thread))
`(eval-string ,string ,package ,id))
((:emacs-interrupt thread)
+ (declare (ignore thread))
'(simple-break))
((:emacs-return-string thread tag string)
+ (declare (ignore thread))
`(take-input ,tag ,string)))))
(defun send-to-socket-io (event)
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.59 slime/swank-sbcl.lisp:1.60
--- slime/swank-sbcl.lisp:1.59 Sat Jan 31 06:50:25 2004
+++ slime/swank-sbcl.lisp Sat Jan 31 15:17:19 2004
@@ -1,4 +1,4 @@
-<;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
;;; swank-sbcl.lisp --- SLIME backend for SBCL.
;;;
@@ -39,6 +39,7 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(require 'sb-bsd-sockets)
(require 'sb-introspect)
+ (require 'sb-posix)
)
(declaim (optimize (debug 3)))
@@ -83,7 +84,10 @@
"List of (key . fn) pairs to be called on SIGIO.")
(defun sigio-handler (signal code scp)
- (mapc (lambda (handler) (funcall (cdr handler))) *sigio-handlers*))
+ (declare (ignore signal code scp))
+ (mapc (lambda (handler)
+ (funcall (the function (cdr handler))))
+ *sigio-handlers*))
(defun set-sigio-handler ()
@@ -109,6 +113,13 @@
(sb-alien:alien-funcall fcntl fd +f_setown+ (sb-unix:unix-getpid))
(push (cons fd fn) *sigio-handlers*))))
+;;(defimplementation add-input-handler (socket fn)
+;; (let ((fd (socket-fd socket)))
+;; (format *debug-io* "Adding sigio handler: ~S ~%" fd)
+;; (sb-posix:fcntl fd sb-posix::f-setfl sb-posix::o-async)
+;; (sb-posix:fcntl fd sb-posix::f-setown (sb-unix:unix-getpid))
+;; (push (cons fd fn) *sigio-handlers*)))
+
(defimplementation remove-input-handlers (socket)
(let ((fd (socket-fd socket)))
(setf *sigio-handlers* (delete fd *sigio-handlers* :key #'car))
@@ -634,6 +645,7 @@
(defvar *mailbox-lock* (sb-thread:make-mutex :name "mailbox lock"))
(defvar *mailboxes* (list))
+ (declaim (type list *mailboxes*))
(defstruct (mailbox (:conc-name mailbox.))
thread
More information about the slime-cvs
mailing list