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

[Helmut Eller]

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

Modified Files:
	swank-cmucl.lisp 
Log Message:
(fcntl): New function.
(add-sigio-handler, remove-sigio-handlers): Renamed.
(add-fd-handler,  remove-fd-handlers): Implement interface.
Date: Sat Feb 21 11:42:19 2004
Author: heller

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.67 slime/swank-cmucl.lisp:1.68
--- slime/swank-cmucl.lisp:1.67	Wed Feb 18 14:31:49 2004
+++ slime/swank-cmucl.lisp	Sat Feb 21 11:42:19 2004
@@ -60,36 +60,43 @@
 (defvar *sigio-handlers* '()
   "List of (key . (fn . args)) pairs to be called on SIGIO.")
 
-(defun add-sigio-handler (key fn)
-  (push (cons key fn) *sigio-handlers*))
-
-(defun remove-sigio-handler (key)
-  (setf *sigio-handlers* (delete key *sigio-handlers* :key #'car)))
-
 (defun sigio-handler (signal code scp)
   (declare (ignore signal code scp))
-  (mapc (lambda (handler) (funcall (cdr handler))) *sigio-handlers*)
-  )
+  (mapc (lambda (handler) (funcall (cdr handler))) *sigio-handlers*))
 
 (defun set-sigio-handler ()
   (sys:enable-interrupt unix:SIGIO (lambda (signal code scp)
 				     (sigio-handler signal code scp))))
-(set-sigio-handler)
 
-(defimplementation add-input-handler (socket fn)
+(defun fcntl (fd command arg)
+  (multiple-value-bind (ok error) (unix:unix-fcntl fd command arg)
+    (cond (ok)
+          (t (error "fcntl: ~A" (unix:get-unix-error-msg error))))))
+
+(defimplementation add-sigio-handler (socket fn)
+  (set-sigio-handler)
   (let ((fd (socket-fd socket)))
-    (format *debug-io* "Adding input handler: ~S ~%" fd)
-    ;; XXX error checking
-    (unix:unix-fcntl fd unix:f-setown (unix:unix-getpid))
-    (unix:unix-fcntl fd unix:f-setfl unix:FASYNC)
-    (add-sigio-handler fd fn)))
+    (format *debug-io* "; Adding input handler: ~S ~%" fd)
+    (fcntl fd unix:f-setown (unix:unix-getpid))
+    (fcntl fd unix:f-setfl unix:FASYNC)
+    (push (cons fd fn) *sigio-handlers*)))
 
-(defimplementation remove-input-handlers (socket)
+(defimplementation remove-sigio-handlers (socket)
   (let ((fd (socket-fd socket)))
-    (remove-sigio-handler fd)
-    (sys:invalidate-descriptor fd)) 
+    (setf *sigio-handlers* (delete fd *sigio-handlers* :key #'car))
+    (sys:invalidate-descriptor fd))
   (close socket))
 
+(defimplementation add-fd-handler (socket fn)
+  (let ((fd (socket-fd socket)))
+    (format *debug-io* "; Adding fd handler: ~S ~%" fd)
+    (sys:add-fd-handler fd :input (lambda (_) 
+                                    _
+                                    (funcall fn)))))
+
+(defimplementation remove-fd-handlers (socket)
+  (sys:invalidate-descriptor (socket-fd socket)))
+
 (defimplementation make-fn-streams (input-fn output-fn)
   (let* ((output (make-slime-output-stream output-fn))
          (input  (make-slime-input-stream input-fn output)))
@@ -336,6 +343,9 @@
                         (list :position *buffer-start-position*)))
         (*compile-file-truename*
          (make-location (list :file (namestring *compile-file-truename*))
+                        (list :position 0)))
+        (*compile-filename*
+         (make-location (list :file *compile-filename*)
                         (list :position 0)))
         (t 
          (list :error "No error location available"))))