fix uncaught bad window errors that caused focus to be given to nothi…

…ng and losing control of rwind

display.rkt

@@ -6,15 +6,17 @@
 (require rwind/base
          rwind/doc-string
          rwind/util
+         rwind/policy/base
          x11/x11
          racket/date
+         racket/match
          )
 
 ;; TODO: update when xrandr is invoked (ConfigureNotify)
 ;; But should better use the (head-infos)
 (define* (display-size [screen 0])
   "Returns the values of width and height of the given screen.
-Warning: These values may not reflect the current screen widths if they have changed?!"
+  Warning: These values may not reflect the current screen widths if they have changed?!"
   (values (XDisplayWidth (current-display) screen)
           (XDisplayHeight (current-display) screen)))
 
@@ -41,7 +43,6 @@ Warning: These values may not reflect the current screen widths if they have cha
     ; For debugging purposes only, because very slow!
     #;(XSynchronize (current-display) #t)
 
-    ; TODO: set _XDebug to #t !
     #;(XSetAfterFunction (current-display)
                          (λ(display) ; -> int
                            ; This function is called after each X function
@@ -50,13 +51,20 @@ Warning: These values may not reflect the current screen widths if they have cha
 
   ;; Errors and error-handlers:
   ;; http://tronche.com/gui/x/xlib/event-handling/protocol-errors/default-handlers.html
+  ;; https://github.com/SawfishWM/sawfish/blob/47e09a56bffb17e1deda7adff175ae67c9a48daa/src/display.c
   (XSetErrorHandler
    (λ(display err-ev)
      ;(printf "Error received: ~a\n" (XErrorEvent->list* err-ev))
-     (printf "*** Error: ~a\n" (XGetErrorText
-                                (XErrorEvent-display err-ev)
-                                (XErrorEvent-error-code err-ev)
-                                500)) ; Sufficient bytes?
+     (match-define
+       (XErrorEvent _ disp resourceid _ err-code request-code minor-code)
+       err-ev)
+     (printf "*** Error: ~a\n" (XGetErrorText disp err-code 500)) ; Sufficient bytes?
+
+     (when (eq? err-code 'BadWindow)
+       (unless (and (eq? request-code 'X_ConfigureWindow)
+                    (eq? minor-code 0))
+         (policy. on-bad-window resourceid)))
+
      1)) ; must return an _int
   )
 

events.rkt

@@ -227,4 +227,5 @@
                      (lambda (e)
                        (printf "INPUT ~a ~a\n" e (read-line e))))))
     (unless (exit-rwind?)
+      (policy. after-event)
       (loop))))

policy/base.rkt

@@ -117,11 +117,19 @@ add a stub method here and implement it in the adequate child class.
     ;; Called when a client message is received
     (define/public (on-client-message window atom fmt data)
      (void))
+
+    ;; Called after the process of one event in the event loop
+    (define/public (after-event)
+      (void))
 
     ;; Places the windows in way suitable way for the current policy
     (define/public (relayout)
       (void))
-
+
+    ;; Called when an Xlib BadWindow error is caught
+    (define/public (on-bad-window window)
+      (void))
+
     (super-new)))
 
 ; Use a fun box instead of a parameter so that 

policy/simple.rkt

@@ -24,6 +24,8 @@
                 [normal-border-color "DarkGreen"])
 
     (inherit relayout)
+
+    (define bad-windows '())
 
     (define/public (current-workspace)
       (or (focus-workspace)
@@ -118,5 +120,22 @@
                             (add-net-wm-state-property window at)
                             (maximize-window window)])]))
             (relayout)]))
+
+    (define/override (after-event)
+      ; bad-windows are removed between events to avoid infinite loops 
+      ; if removing them triggers a bad-window event
+      (for ([w bad-windows])
+        (define wk (find-window-workspace w))
+        (when wk
+          (dprintf "Removing bad window (~a) from its workspace\n" w)
+          (remove-window-from-workspace w)))
+      (set! bad-windows '()))
+
+    (define/override (on-bad-window window)
+      ; We just caught the error, but don't remove it now to avoid infinite loops
+      ; One one computer, I had some uncaught bad-window errors after waking up from sleep mode
+      ; (gnome-related problem?)
+      (unless (member window bad-windows window=?)
+        (set! bad-windows (cons window bad-windows))))
 
     (super-new)))

window.rkt

@@ -404,14 +404,15 @@
   "Returns a list of elements corresponding to `property', or #f if the property is not found or in case of error."
   (GetWindowProperty (current-display) window property))
 
-(define* (get-window-property-atoms window property)
+(define*/contract (get-window-property-atoms window property)
+  (window? atom? . -> . list?)
   "Returns a list of Atoms for the given property and window."
   (or (get-window-property window property) '()))
 
 (define*/contract (window-transient-for window)
   (window? . -> . (or/c #f window?))
   "Returns the window for which `window` is transient, or #f if `window` is not a transient window."
-  (get-window-property window WM_TRANSIENT_FOR))
+  (and=> (get-window-property window WM_TRANSIENT_FOR) first))
 
 ; For information on all the window types, see http://developer.gnome.org/wm-spec/#id2551529
 ; (use it with (map atom->string ...) for better reading)

workspace.rkt

@@ -348,7 +348,7 @@ http://stackoverflow.com/questions/2431535/top-level-window-on-x-window-system
 (define*/contract (remove-window-from-workspace window [wk (find-window-workspace window)])
   ([window?] [(or/c workspace? #f)] . ->* . any/c)
   "Removes the window from the workspace (by default the workspace of the window)
-if it is not #f."
+if the latter is not #f."
   (unless wk
     (dprintf "wk is #f in remove-window-from-workspace\n"))
   (when wk