chiark / gitweb /
Fixed problem cause by SB-UNIX:UNIX-FAST-SELECT returning NIL sometimes
[clg] / gtk / gtk.lisp
index 80725a4ab69a2c9a6f8d67acfea85b658accac56..844f41aad4d3ea4ffe1bc07658dea461ee1cd888 100644 (file)
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: gtk.lisp,v 1.73 2007-06-19 11:32:25 espen Exp $
+;; $Id: gtk.lisp,v 1.75 2007-06-20 14:28:48 espen Exp $
 
 
 (in-package "GTK")
@@ -74,7 +74,7 @@ (defun clg-init (&optional display multi-threading-p)
        (%init-async-event-handling display)
       #+sb-thread(%init-multi-threaded-event-handling display)
       #-sb-thread(error "Multi threading not supported on this platform")))
-  (gdk:find-display display))
+  (gdk:ensure-display display t))
 
 (defun clg-init-with-threading (&optional display)
   (clg-init display t))
@@ -88,12 +88,14 @@ (defun socket-status (socket seconds microseconds)
       (sb-unix:fd-zero read-fds)
       (sb-unix:fd-set fd read-fds)
 
-      (unless (zerop (sb-unix:unix-fast-select 
-                     (1+ fd) (sb-alien:addr read-fds) nil nil 
-                     seconds microseconds))
-       (if (peek-char nil (car socket) nil)
-           :input
-         :eof)))))
+      (let ((num-fds-changed
+            (sb-unix:unix-fast-select
+             (1+ fd) (sb-alien:addr read-fds) nil nil 
+             seconds microseconds)))
+       (unless (or (not num-fds-changed) (zerop num-fds-changed))
+         (if (peek-char nil (car socket) nil)
+             :input
+           :eof))))))
 
 (defun %init-async-event-handling (display)
   (let ((style #?(or (featurep :cmu) (sbcl< 1 0 6)) :fd-handler
@@ -1358,7 +1360,7 @@ (defmethod initialize-instance ((window window) &rest initargs
   (prog1
       (if display
          (apply #'call-next-method
-          window :screen (gdk:display-get-default-screen display) initargs)
+          window :screen (gdk:display-get-default-screen (gdk:ensure-display display)) initargs)
        (call-next-method))
     (initial-add window #'window-add-accel-group 
      initargs :accel-group :accel-groups)))