[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. 04eb71e13410ef28f3ef8cf027cf50be4dae998a

[Philippe Brochard]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  04eb71e13410ef28f3ef8cf027cf50be4dae998a (commit)
      from  1272fcf1d0e74f0279b83b773bfe19f228137fb4 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 04eb71e13410ef28f3ef8cf027cf50be4dae998a
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed Jun 8 21:42:56 2011 +0200

    src/clfswm-internal.lisp (clean-windows-in-all-frames): New function to prevent xlib error when a window is deleted.

diff --git a/ChangeLog b/ChangeLog
index 14d2799..86ab774 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,7 @@
 2011-06-08  Philippe Brochard  <pbrochard at common-lisp.net>
 
-	* *: **** Release 1106 ****
+	* src/clfswm-internal.lisp (clean-windows-in-all-frames): New
+	function to prevent xlib error when a window is deleted.
 
 2011-06-08  Philippe Brochard  <pbrochard at common-lisp.net>
 
diff --git a/load.lisp b/load.lisp
index aa2baeb..094cb45 100644
--- a/load.lisp
+++ b/load.lisp
@@ -63,6 +63,9 @@
 
 (in-package :clfswm)
 
+(main-unprotected :read-conf-file-p t)
+(quit)
+
 #-:BUILD-DOC
 (ignore-errors
   (main :read-conf-file-p t))
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 24ddd3e..b50c937 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -690,6 +690,7 @@
 
 
 
+
 (defgeneric adapt-child-to-parent (child parent))
 
 (defmethod adapt-child-to-parent ((window xlib:window) parent)
@@ -1156,7 +1157,6 @@ Warning:frame window and gc are freeed."
     (setf *current-child* *current-root*))
   (delete-child-in-frames child *root-frame*))
 
-
 (defun delete-child-and-children-in-frames (child root)
   "Delete child and its children in the frame root and in all its children
 Warning:frame window and gc are freeed."
@@ -1177,6 +1177,19 @@ Warning:frame window and gc are freeed."
   (show-all-children))
 
 
+(defun clean-windows-in-all-frames ()
+  "Remove all xlib:windows present in *root-frame* and not in the xlib tree"
+  (let ((x-tree (xlib:query-tree *root*)))
+    (with-all-frames (*root-frame* frame)
+      (dolist (child (frame-child frame))
+        (when (xlib:window-p child)
+          (unless (member child x-tree :test #'xlib:window-equal)
+            (setf (frame-child frame)
+                  (child-remove child (frame-child frame)))))))))
+
+
+
+
 
 (defun place-window-from-hints (window)
   "Place a window from its hints"
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index 5772fee..6399eac 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -94,6 +94,7 @@
   (unless (and (not send-event-p)
 	       (not (xlib:window-equal window event-window)))
     (when (find-child window *root-frame*)
+      (clean-windows-in-all-frames)
       (delete-child-in-all-frames window)
       (show-all-children))))
 
@@ -102,6 +103,7 @@
   (unless (or send-event-p
 	      (xlib:window-equal window event-window))
     (when (find-child window *root-frame*)
+      (clean-windows-in-all-frames)
       (delete-child-in-all-frames window)
       (show-all-children))))
 

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog                |    3 ++-
 load.lisp                |    3 +++
 src/clfswm-internal.lisp |   15 ++++++++++++++-
 src/clfswm.lisp          |    2 ++
 4 files changed, 21 insertions(+), 2 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager