[clfswm-cvs] r101 - in clfswm: . src

[pbrochard at common-lisp.net]

Author: pbrochard
Date: Tue Apr 29 16:11:34 2008
New Revision: 101

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-internal.lisp
   clfswm/src/xlib-util.lisp
Log:
Display unmanaged windows only when its window parent is the current child.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Apr 29 16:11:34 2008
@@ -1,3 +1,8 @@
+2008-04-29  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp (show-all-children): Display unmanaged
+	windows only when its window parent is the current child.
+
 2008-04-28  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (manage-current-window)

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Tue Apr 29 16:11:34 2008
@@ -7,16 +7,15 @@
 ===============
 Should handle these soon.
 
-- forced-managed-window/forced-unmanaged-window: new frame parameter [Philippe]
-
 - Move window over frame (Alt+Control+B1) [Philippe]
 
-LESS URGENT TODO
-================
-
 - Move the autodoc in its own file (clfswm-autodoc.lisp) and make the autodoc
   for the menu system.
 
+
+LESS URGENT TODO
+================
+
 - Hook to open next window in named/numbered frame [Philippe]
 
 - Ensure-unique-number/name (new function) [Philippe]
@@ -29,7 +28,6 @@
 
 - Add boundaries in the info window [Philippe]
 
-- Show unmanaged windows only for *current-child* [Philippe]
 
 MAYBE
 =====

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Tue Apr 29 16:11:34 2008
@@ -418,22 +418,29 @@
 	    (and (eql raise-p :first-only) first-p))
     (raise-window window)))
 
-(defgeneric show-child (child raise-p first-p))
+(defgeneric show-child (child parent display-p raise-p first-p))
 
-(defmethod show-child ((frame frame) raise-p first-p)
-  (with-xlib-protect
-    (with-slots (window) frame
-      (when (or *show-root-frame-p* (not (equal frame *current-root*)))
-	(setf (xlib:window-background window) (get-color "Black"))
-	(xlib:map-window window)
-	(raise-if-needed window raise-p first-p)
-	(display-frame-info frame)))))
+(defmethod show-child ((frame frame) parent display-p raise-p first-p)
+  (declare (ignore parent))
+  (when display-p
+    (with-xlib-protect
+      (with-slots (window) frame
+	(when (or *show-root-frame-p* (not (equal frame *current-root*)))
+	  (setf (xlib:window-background window) (get-color "Black"))
+	  (xlib:map-window window)
+	  (raise-if-needed window raise-p first-p)
+	  (display-frame-info frame))))))
 
 
-(defmethod show-child ((window xlib:window) raise-p first-p)
+(defmethod show-child ((window xlib:window) parent display-p raise-p first-p)
   (with-xlib-protect
-    (xlib:map-window window)
-    (raise-if-needed window raise-p first-p)))
+    (if (or (managed-window-p window parent)
+	    (equal parent *current-child*))
+	(when display-p
+	  (xlib:map-window window)
+	  (raise-if-needed window raise-p first-p))
+	(hide-window window))))
+
 
 
 (defgeneric hide-child (child))
@@ -497,8 +504,7 @@
 	       (multiple-value-bind (raise-p change)
 		   (adapt-child-to-parent root parent)
 		 (when change (setf geometry-change change))
-		 (when display-p
-		   (show-child root raise-p first-p)))
+		 (show-child root parent display-p raise-p first-p))
 	       (select-child root (if (equal root *current-child*) t
 				      (if (and first-p first-parent) :maybe nil)))
 	       (when (frame-p root)
@@ -615,7 +621,7 @@
   (when (frame-p *current-child*)
     (awhen (first (frame-child *current-child*))
       (setf *current-child* it)))
-  (select-current-frame t))
+  (show-all-children))
 
 (defun select-previous-level ()
   "Select the previous level in frame"
@@ -623,7 +629,7 @@
     (select-current-frame :maybe)
     (awhen (find-parent-frame *current-child*)
       (setf *current-child* it))
-    (select-current-frame t)))
+    (show-all-children)))
 
 
 

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Tue Apr 29 16:11:34 2008
@@ -475,6 +475,8 @@
 	       t))
       (unless pointer-grabbed-p
 	(xgrab-pointer *root* nil nil))
+      (when additional-fn
+	(apply additional-fn additional-arg))
       (loop until done
 	 do (with-xlib-protect
 	      (xlib:display-finish-output *display*)
@@ -520,6 +522,8 @@
 	       t))
       (unless pointer-grabbed-p
 	(xgrab-pointer *root* nil nil))
+      (when additional-fn
+	(apply additional-fn additional-arg))
       (loop until done
 	 do (with-xlib-protect
 	      (xlib:display-finish-output *display*)