From pbrochard at common-lisp.net  Tue Jun  3 12:27:47 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Tue,  3 Jun 2008 08:27:47 -0400 (EDT)
Subject: [clfswm-cvs] r140 - in clfswm: . src
Message-ID: <20080603122747.88EFA2B086@common-lisp.net>

Author: pbrochard
Date: Tue Jun  3 08:27:46 2008
New Revision: 140

Modified:
   clfswm/ChangeLog
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/config.lisp
   clfswm/src/tools.lisp
   clfswm/src/xlib-util.lisp
Log:
have-to-present-windows, have-to-present-all-windows: New functions to have an MaxOS expose like on mouse click in screen corner. Info-mode: Page_Down, Page_Up: Add boundaries.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Jun  3 08:27:46 2008
@@ -1,3 +1,11 @@
+2008-06-03  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (have-to-present-windows)
+	(have-to-present-all-windows): New functions to have an MaxOS
+	expose like on mouse click in screen corner.
+
+	* src/clfswm-info.lisp ("Page_Down", "Page_Up"): Add boundaries.
+
 2008-05-30  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (unhide-a-child-from-all-frames): Unhide a

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Tue Jun  3 08:27:46 2008
@@ -197,14 +197,22 @@
 
 ;;; Mouse action
 (defun sm-mouse-click-to-focus-and-move (window root-x root-y)
-  "Move and focus the current child - Create a new frame on the root window"
+  "Move and focus the current child - Create a new frame on the root window.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames."
   (declare (ignore window))
-  (mouse-focus-move/resize-generic root-x root-y #'move-frame nil))
+  (or (have-to-present-windows root-x root-y)
+      (have-to-present-all-windows root-x root-y)
+      (mouse-focus-move/resize-generic root-x root-y #'move-frame nil)))
 
 (defun sm-mouse-click-to-focus-and-resize (window root-x root-y)
-  "Resize and focus the current child - Create a new frame on the root window"
+  "Resize and focus the current child - Create a new frame on the root window.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames."
   (declare (ignore window))
-  (mouse-focus-move/resize-generic root-x root-y #'resize-frame nil))
+  (or (have-to-present-windows root-x root-y)
+      (have-to-present-all-windows root-x root-y)
+      (mouse-focus-move/resize-generic root-x root-y #'resize-frame nil)))
 
 
 

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Tue Jun  3 08:27:46 2008
@@ -110,13 +110,13 @@
 (define-info-key ("Page_Down")
     (defun info-next-ten-lines (info)
       "Move ten lines down"
-      (incf (info-y info) (* (info-ilh info) 10))
+      (setf (info-y info) (min (+ (info-y info) (* (info-ilh info) 10)) (info-max-y info)))
       (draw-info-window info)))
 
 (define-info-key ("Page_Up")
     (defun info-previous-ten-lines (info)
       "Move ten lines up"
-      (decf (info-y info) (* (info-ilh info) 10))
+      (setf (info-y info) (max (- (info-y info) (* (info-ilh info) 10)) 0))
       (draw-info-window info)))
 
 

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Tue Jun  3 08:27:46 2008
@@ -481,6 +481,46 @@
 
 
 ;;; Mouse utilities
+(defmacro present-windows-generic ((first-restore-frame) &body body)
+  `(progn
+     (with-all-frames (,first-restore-frame frame)
+       (setf (frame-data-slot frame :old-layout) (frame-layout frame)
+	     (frame-layout frame) #'tile-space-layout))
+     (show-all-children *current-root*)
+     (wait-no-key-or-button-press)
+     (wait-a-key-or-button-press )
+     (wait-no-key-or-button-press)
+     (multiple-value-bind (x y) (xlib:query-pointer *root*)
+       (let* ((child (find-child-under-mouse x y))
+	      (parent (find-parent-frame child *root-frame*)))
+	 (when (and child parent)
+	   , at body
+	   (focus-all-children child parent))))
+     (with-all-frames (,first-restore-frame frame)
+       (setf (frame-layout frame) (frame-data-slot frame :old-layout)
+	     (frame-data-slot frame :old-layout) nil))
+     (show-all-children *current-root*)))
+
+(defun have-to-present-windows (root-x root-y)
+  (when (and (frame-p *current-root*)
+	     (in-corner *present-windows-corner* root-x root-y))
+    (stop-button-event)
+    (present-windows-generic (*current-root*))
+    t))
+
+(defun have-to-present-all-windows (root-x root-y)
+  (when (and (frame-p *current-root*)
+	     (in-corner *present-all-windows-corner* root-x root-y))
+    (stop-button-event)
+    (switch-to-root-frame)
+    (present-windows-generic (*root-frame*)
+      (hide-all-children *root-frame*)
+      (setf *current-root* parent))
+    t))
+
+
+
+
 (defun move-frame (frame parent orig-x orig-y)
   (when frame
     (hide-all-children frame)
@@ -509,7 +549,7 @@
 	 (child window)
 	 (parent (find-parent-frame child *current-root*))
 	 (root-p (or (equal window *root*)
-		     (and (frame-p child)
+		     (and (frame-p *current-root*)
 			  (equal child (frame-window *current-root*))))))
     (when (or (not root-p) *create-frame-on-root*)
       (unless parent
@@ -533,12 +573,20 @@
 	(stop-button-event))))
 
 (defun mouse-click-to-focus-and-move (window root-x root-y)
-  "Move and focus the current frame or focus the current window parent"
-  (mouse-click-to-focus-generic window root-x root-y #'move-frame))
+  "Move and focus the current frame or focus the current window parent.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames."
+  (or (have-to-present-windows root-x root-y)
+      (have-to-present-all-windows root-x root-y)
+      (mouse-click-to-focus-generic window root-x root-y #'move-frame)))
 
 (defun mouse-click-to-focus-and-resize (window root-x root-y)
-  "Resize and focus the current frame or focus the current window parent"
-  (mouse-click-to-focus-generic window root-x root-y #'resize-frame))
+  "Resize and focus the current frame or focus the current window parent.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames."
+  (or (have-to-present-windows root-x root-y)
+      (have-to-present-all-windows root-x root-y)
+      (mouse-click-to-focus-generic window root-x root-y #'resize-frame)))
 
 
 

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Tue Jun  3 08:27:46 2008
@@ -47,6 +47,11 @@
 ;;  (values 100 100 800 600))
 
 
+(defparameter  *corner-size* 3
+  "The size of the corner square")
+
+
+
 
 ;;; Hook definitions
 ;;;
@@ -79,6 +84,19 @@
 on the root window in the main mode with the mouse")
 
 
+;;; CONFIG: Corner where to present windows (An expose like)
+(defparameter *present-windows-corner* :bottom-right
+  "Which corner enable the mouse present windows.
+One of :bottom-right :bottom-left :top-right :top-left")
+
+(defparameter *present-all-windows-corner* :bottom-left
+  "Which corner enable the mouse present all windows
+One of :bottom-right :bottom-left :top-right :top-left")
+
+
+
+
+
 ;;; CONFIG: Main mode colors
 (defparameter *color-selected* "Red")
 (defparameter *color-unselected* "Blue")

Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp	(original)
+++ clfswm/src/tools.lisp	Tue Jun  3 08:27:46 2008
@@ -35,6 +35,7 @@
 	   :dbg
 	   :dbgnl
 	   :setf/=
+	   :in-corner
 	   :create-symbol
 	   :split-string
 	   :expand-newline
@@ -82,10 +83,12 @@
 (in-package :tools)
 
 
+
 (setq *random-state* (make-random-state t))
 
 
 
+
 (defmacro awhen (test &body body)
   `(let ((it ,test))
      (when it
@@ -169,6 +172,8 @@
 	 (setf ,var ,gval)))))
 
 
+
+
 (defun create-symbol (&rest names)
   "Return a new symbol from names"
   (intern (string-upcase (apply #'concatenate 'string names))))

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Tue Jun  3 08:27:46 2008
@@ -95,6 +95,33 @@
 
 
 
+(defun in-corner (corner x y)
+  "Return t if (x, y) is in corner.
+Corner is one of :bottom-right :bottom-left :top-right :top-left"
+  (multiple-value-bind (xmin ymin xmax ymax)
+      (case corner
+	(:bottom-right (values (- (xlib:screen-width *screen*) *corner-size*)
+			       (- (xlib:screen-height *screen*) *corner-size*)
+			       (xlib:screen-width *screen*)
+			       (xlib:screen-height *screen*)))
+	(:bottom-left (values 0
+			      (- (xlib:screen-height *screen*) *corner-size*)
+			      *corner-size*
+			      (xlib:screen-height *screen*)))
+	(:top-left (values 0 0 *corner-size* *corner-size*))
+	(:top-right (values (- (xlib:screen-width *screen*) *corner-size*)
+			    0
+			    (xlib:screen-width *screen*)
+			    *corner-size*))
+	(t (values 10 10 0 0)))
+    (and (<= xmin x xmax)
+	 (<= ymin y ymax))))
+
+
+
+
+
+
 (defun window-state (win)
   "Get the state (iconic, normal, withdraw of a window."
   (first (xlib:get-property win :WM_STATE)))
@@ -626,20 +653,45 @@
 
 
 
+(defmacro with-grab-keyboard-and-pointer ((cursor mask old-cursor old-mask) &body body)
+  `(let ((pointer-grabbed (xgrab-pointer-p))
+	 (keyboard-grabbed (xgrab-keyboard-p)))
+     (xgrab-pointer *root* ,cursor ,mask)
+     (unless keyboard-grabbed
+       (xgrab-keyboard *root*))
+     , at body
+     (if pointer-grabbed
+	 (xgrab-pointer *root* ,old-cursor ,old-mask)
+	 (xungrab-pointer))
+     (unless keyboard-grabbed
+       (xungrab-keyboard))))
+     
 
 (defun wait-no-key-or-button-press ()
-  (loop
-     (let ((key (loop for k across (xlib:query-keymap *display*)
-		   unless (zerop k) return t))
-	   (button (plusp (nth-value 4 (xlib:query-pointer *root*)))))
-       (when (and (not key) (not button))
-	 (loop while (xlib:event-case (*display* :discard-p t :peek-p nil :timeout 0)
-		       (:motion-notify () t)
-		       (:key-press () t)
-		       (:button-press () t)
-		       (:button-release () t)
-		       (t nil)))
-	 (return-from wait-no-key-or-button-press nil)))))
+  (with-grab-keyboard-and-pointer (66 67 66 67)
+    (loop
+       (let ((key (loop for k across (xlib:query-keymap *display*)
+		     unless (zerop k) return t))
+	     (button (plusp (nth-value 4 (xlib:query-pointer *root*)))))
+	 (when (and (not key) (not button))
+	   (loop while (xlib:event-case (*display* :discard-p t :peek-p nil :timeout 0)
+			 (:motion-notify () t)
+			 (:key-press () t)
+			 (:key-release () t)
+			 (:button-press () t)
+			 (:button-release () t)
+			 (t nil)))
+	   (return))))))
+
+
+(defun wait-a-key-or-button-press ()
+  (with-grab-keyboard-and-pointer (24 25 66 67)
+    (loop
+       (let ((key (loop for k across (xlib:query-keymap *display*)
+		     unless (zerop k) return t))
+	     (button (plusp (nth-value 4 (xlib:query-pointer *root*)))))
+	 (when (or key button)
+	   (return))))))
 
 
 


From pbrochard at common-lisp.net  Tue Jun  3 21:20:55 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Tue,  3 Jun 2008 17:20:55 -0400 (EDT)
Subject: [clfswm-cvs] r141 - in clfswm: . doc src
Message-ID: <20080603212055.0932D74388@common-lisp.net>

Author: pbrochard
Date: Tue Jun  3 17:20:53 2008
New Revision: 141

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/doc/keys.html
   clfswm/doc/keys.txt
   clfswm/doc/menu.html
   clfswm/doc/menu.txt
   clfswm/src/bindings.lisp
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/package.lisp
   clfswm/src/xlib-util.lisp
Log:
frame-lower-child, frame-raise-child: New functions to raise/lower a child in its frame.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Jun  3 17:20:53 2008
@@ -1,5 +1,9 @@
 2008-06-03  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-internal.lisp (frame-lower-child)
+	(frame-raise-child): New functions to raise/lower a child in its
+	frame.
+
 	* src/clfswm-util.lisp (have-to-present-windows)
 	(have-to-present-all-windows): New functions to have an MaxOS
 	expose like on mouse click in screen corner.

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Tue Jun  3 17:20:53 2008
@@ -9,8 +9,6 @@
 
 - Use conpressed motion events for clisp. [Philippe]
 
-- Raise/lower child - this can be done with children order [Philippe]
-
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]
 
 - A Gimp layout example [Philippe]

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Tue Jun  3 17:20:53 2008
@@ -145,6 +145,28 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
+          Page_up
+        </td>
+        <td style="color:#0000ff" nowrap>
+          Lower the child in the current frame
+        </td>
+      </tr>
+      <tr>
+        <td align="right" style="color:#ff0000" nowrap>
+           Mod-1 
+        </td>
+        <td align="center" nowrap>
+          Page_down
+        </td>
+        <td style="color:#0000ff" nowrap>
+          Raise the child in the current frame
+        </td>
+      </tr>
+      <tr>
+        <td align="right" style="color:#ff0000" nowrap>
+           Mod-1 
+        </td>
+        <td align="center" nowrap>
           Home
         </td>
         <td style="color:#0000ff" nowrap>
@@ -408,7 +430,9 @@
           1
         </td>
         <td style="color:#0000ff" nowrap>
-          Move and focus the current frame or focus the current window parent
+          Move and focus the current frame or focus the current window parent.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames.
         </td>
       </tr>
       <tr>
@@ -419,7 +443,9 @@
           3
         </td>
         <td style="color:#0000ff" nowrap>
-          Resize and focus the current frame or focus the current window parent
+          Resize and focus the current frame or focus the current window parent.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames.
         </td>
       </tr>
       <tr>
@@ -1192,7 +1218,9 @@
           1
         </td>
         <td style="color:#0000ff" nowrap>
-          Move and focus the current child - Create a new frame on the root window
+          Move and focus the current child - Create a new frame on the root window.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames.
         </td>
       </tr>
       <tr>
@@ -1203,7 +1231,9 @@
           3
         </td>
         <td style="color:#0000ff" nowrap>
-          Resize and focus the current child - Create a new frame on the root window
+          Resize and focus the current child - Create a new frame on the root window.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames.
         </td>
       </tr>
       <tr>

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Tue Jun  3 17:20:53 2008
@@ -16,6 +16,8 @@
 Mod-1 Shift          Tab             Select the previous child
 Mod-1                Return          Enter in the selected frame - ie make it the root frame
 Mod-1 Shift          Return          Leave the selected frame - ie make its parent the root frame
+Mod-1                Page_up         Lower the child in the current frame
+Mod-1                Page_down       Raise the child in the current frame
 Mod-1                Home            Switch to the root frame
 Mod-1 Shift          Home            Switch and select the root frame
                      Menu            Show all frames info windows until a key is release
@@ -43,8 +45,12 @@
 Mouse buttons actions in main mode:
 ----------------------------------
 
-                     1               Move and focus the current frame or focus the current window parent
-                     3               Resize and focus the current frame or focus the current window parent
+                     1               Move and focus the current frame or focus the current window parent.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames.
+                     3               Resize and focus the current frame or focus the current window parent.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames.
 Mod-1                1               Move and focus the current child - Create a new frame on the root window
 Mod-1                3               Resize and focus the current child - Create a new frame on the root window
 Mod-1 Control        1               Move the window under the mouse cursor to another frame
@@ -121,8 +127,12 @@
 Mouse buttons actions in second mode:
 ------------------------------------
 
-                     1               Move and focus the current child - Create a new frame on the root window
-                     3               Resize and focus the current child - Create a new frame on the root window
+                     1               Move and focus the current child - Create a new frame on the root window.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames.
+                     3               Resize and focus the current child - Create a new frame on the root window.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames.
 Mod-1                1               Move and focus the current child - Create a new frame on the root window
 Mod-1                3               Resize and focus the current child - Create a new frame on the root window
 Mod-1 Control        1               Move the window under the mouse cursor to another frame

Modified: clfswm/doc/menu.html
==============================================================================
--- clfswm/doc/menu.html	(original)
+++ clfswm/doc/menu.html	Tue Jun  3 17:20:53 2008
@@ -18,6 +18,9 @@
       <a name="MAIN"></a><a href="#Top">Main</a>
     </h3>
     <p>
+      c: <a href="#CHILD-MENU">< Child menu ></a>
+    </p>
+    <p>
       f: <a href="#FRAME-MENU">< Frame menu ></a>
     </p>
     <p>
@@ -37,6 +40,31 @@
     </p>
     <hr>
     <h3>
+      <a name="CHILD-MENU"></a><a href="#MAIN">Child-Menu</a>
+    </h3>
+    <p>
+      r: Rename the current child
+    </p>
+    <p>
+      x: Remove the current child from the CLFSWM tree
+    </p>
+    <p>
+      Delete: Remove the current child from its parent frame
+    </p>
+    <p>
+      h: Hide the current child
+    </p>
+    <p>
+      u: Unhide a child in the current frame
+    </p>
+    <p>
+      f: Unhide a child from all frames in the current frame
+    </p>
+    <p>
+      a: Unhide all current frame hidden children
+    </p>
+    <hr>
+    <h3>
       <a name="FRAME-MENU"></a><a href="#MAIN">Frame-Menu</a>
     </h3>
     <p>
@@ -58,16 +86,7 @@
       w: <a href="#MANAGED-WINDOW-MENU">< Managed window type menu ></a>
     </p>
     <p>
-      i: <a href="#FRAME-INFO-MENU">< Frame info menu ></a>
-    </p>
-    <p>
-      r: Rename the current child
-    </p>
-    <p>
-      u: Renumber the current frame
-    </p>
-    <p>
-      x: Create a new frame for each window in frame
+      s: <a href="#FRAME-MISCELLANEOUS-MENU">< Frame miscallenous menu ></a>
     </p>
     <hr>
     <h3>
@@ -254,13 +273,25 @@
     </p>
     <hr>
     <h3>
-      <a name="FRAME-INFO-MENU"></a><a href="#FRAME-MENU">Frame-Info-Menu</a>
+      <a name="FRAME-MISCELLANEOUS-MENU"></a><a href="#FRAME-MENU">Frame-Miscellaneous-Menu</a>
     </h3>
     <p>
       s: Show all frames info windows
     </p>
     <p>
-      h: Hide all frames info windows
+      i: Hide all frames info windows
+    </p>
+    <p>
+      h: Hide the current frame window
+    </p>
+    <p>
+      w: Show the current frame window
+    </p>
+    <p>
+      u: Renumber the current frame
+    </p>
+    <p>
+      x: Create a new frame for each window in frame
     </p>
     <hr>
     <h3>

Modified: clfswm/doc/menu.txt
==============================================================================
--- clfswm/doc/menu.txt	(original)
+++ clfswm/doc/menu.txt	Tue Jun  3 17:20:53 2008
@@ -2,6 +2,7 @@
 (By default it is bound on second-mode + m)
 
 Main
+c: < Child menu >
 f: < Frame menu >
 w: < Window menu >
 s: < Selection menu >
@@ -9,6 +10,15 @@
 u: < Action by number menu >
 y: < Utility menu >
 
+Child-Menu
+r: Rename the current child
+x: Remove the current child from the CLFSWM tree
+Delete: Remove the current child from its parent frame
+h: Hide the current child
+u: Unhide a child in the current frame
+f: Unhide a child from all frames in the current frame
+a: Unhide all current frame hidden children
+
 Frame-Menu
 a: < Adding frame menu >
 l: < Frame layout menu >
@@ -16,10 +26,7 @@
 n: < Frame new window hook menu >
 m: < Frame movement menu >
 w: < Managed window type menu >
-i: < Frame info menu >
-r: Rename the current child
-u: Renumber the current frame
-x: Create a new frame for each window in frame
+s: < Frame miscallenous menu >
 
 Frame-Adding-Menu
 a: Add a default frame in the current frame
@@ -88,9 +95,13 @@
 n: Manage only normal window type
 u: Do not manage any window type
 
-Frame-Info-Menu
+Frame-Miscellaneous-Menu
 s: Show all frames info windows
-h: Hide all frames info windows
+i: Hide all frames info windows
+h: Hide the current frame window
+w: Show the current frame window
+u: Renumber the current frame
+x: Create a new frame for each window in frame
 
 Window-Menu
 i: Display information on the current window

Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp	(original)
+++ clfswm/src/bindings.lisp	Tue Jun  3 17:20:53 2008
@@ -51,6 +51,10 @@
 (define-main-key ("Return" :mod-1) 'enter-frame)
 (define-main-key ("Return" :mod-1 :shift) 'leave-frame)
 
+(define-main-key ("Page_Up" :mod-1) 'frame-lower-child)
+(define-main-key ("Page_Down" :mod-1) 'frame-raise-child)
+
+
 (define-main-key ("Home" :mod-1) 'switch-to-root-frame)
 (define-main-key ("Home" :mod-1 :shift) 'switch-and-select-root-frame)
 

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Tue Jun  3 17:20:53 2008
@@ -77,6 +77,19 @@
 
 
 
+
+
+(defun frame-selected-child (frame)
+  (when (frame-p frame)
+    (with-slots (child selected-pos) frame
+      (let ((len (length child)))
+	(cond ((minusp selected-pos) (setf selected-pos 0))
+	      ((>= selected-pos len) (setf selected-pos (max (1- len) 0)))))
+      (nth selected-pos child))))
+
+
+
+
 ;;; Frame data manipulation functions
 (defun frame-data-slot (frame slot)
   "Return the value associated to data slot"
@@ -446,14 +459,14 @@
 
 
 
-(defun raise-if-needed (window raise-p first-p)
+(defun raise-if-needed (window raise-p selected-p)
   (when (or (eql raise-p t)
-	    (and (eql raise-p :first-only) first-p))
+	    (and (eql raise-p :first-only) selected-p))
     (raise-window window)))
 
-(defgeneric show-child (child parent display-p raise-p first-p))
+(defgeneric show-child (child parent display-p raise-p selected-p))
 
-(defmethod show-child ((frame frame) parent display-p raise-p first-p)
+(defmethod show-child ((frame frame) parent display-p raise-p selected-p)
   (declare (ignore parent))
   (with-xlib-protect
     (with-slots (window show-window-p) frame
@@ -462,22 +475,22 @@
 	    (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)))
+	      (raise-if-needed window raise-p selected-p)))
 	  (hide-window window)))
     (display-frame-info frame)))
 
 
-(defmethod show-child ((window xlib:window) parent display-p raise-p first-p)
+(defmethod show-child ((window xlib:window) parent display-p raise-p selected-p)
   (with-xlib-protect
     (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))
+	  (raise-if-needed window raise-p selected-p))
 	(hide-window window))))
 
-(defmethod show-child (child parent display-p raise-p first-p)
-  (declare (ignore child parent display-p raise-p first-p))
+(defmethod show-child (child parent display-p raise-p selected-p)
+  (declare (ignore child parent display-p raise-p selected-p))
   ())
 
 
@@ -532,7 +545,7 @@
   (labels ((rec (child)
 	     (typecase child
 	       (xlib:window (focus-window child))
-	       (frame (rec (first (frame-child child)))))))
+	       (frame (rec (frame-selected-child child))))))
     (no-focus)
     (rec *current-child*)))
 
@@ -544,17 +557,17 @@
   "Show all children from *current-root*. Start the effective display
 only for display-child and its children"
   (let ((geometry-change nil))
-    (labels ((rec (root parent first-p first-parent display-p)
+    (labels ((rec (root parent selected-p selected-parent-p display-p)
 	       (multiple-value-bind (raise-p change)
 		   (adapt-child-to-parent root parent)
 		 (when change (setf geometry-change change))
-		 (show-child root parent display-p raise-p first-p))
+		 (show-child root parent display-p raise-p selected-p))
 	       (select-child root (if (equal root *current-child*) t
-				      (if (and first-p first-parent) :maybe nil)))
+				      (if (and selected-p selected-parent-p) :maybe nil)))
 	       (when (frame-p root)
-		 (let ((first-child (first (frame-child root))))
+		 (let ((selected-child (frame-selected-child root)))
 		   (dolist (child (reverse (frame-child root)))
-		     (rec child root (equal child first-child) (and first-p first-parent)
+		     (rec child root (equal child selected-child) (and selected-p selected-parent-p)
 			  (or display-p (equal root display-child))))))))
       (rec *current-root* nil t t (equal display-child *current-root*))
       (set-focus-to-current-child)
@@ -582,10 +595,10 @@
   "Focus child - Return true if something has change"
   (when (and (frame-p parent)
 	     (member child (frame-child parent)))
-    (when (not (equal child (first (frame-child parent))))
-      (loop until (equal child (first (frame-child parent)))
-	 do (setf (frame-child parent) (rotate-list (frame-child parent))))
-      t)))
+      (when (not (equal child (frame-selected-child parent)))
+	(loop until (equal child (frame-selected-child parent))
+	   do (setf (frame-child parent) (rotate-list (frame-child parent))))
+	t)))
 
 (defun focus-child-rec (child parent)
   "Focus child and its parents - Return true if something has change"
@@ -648,7 +661,7 @@
       (when (frame-p parent)
 	(with-slots (child) parent
 	  (setf child (funcall fun-rotate child))
-	  (setf *current-child* (first child)))))
+	  (setf *current-child* (frame-selected-child parent)))))
     (when frame-is-root?
       (setf *current-root* *current-child*))
     (show-all-children *current-root*)))
@@ -667,7 +680,7 @@
   "Select the next level in frame"
   (select-current-frame :maybe)
   (when (frame-p *current-child*)
-    (awhen (first (frame-child *current-child*))
+    (awhen (frame-selected-child *current-child*)
       (setf *current-child* it)))
   (show-all-children))
 
@@ -715,6 +728,32 @@
   (show-all-children *current-root*))
 
 
+
+
+(defun frame-lower-child ()
+  "Lower the child in the current frame"
+  (when (frame-p *current-child*)
+    (with-slots (child selected-pos) *current-child*
+      (unless (>= selected-pos (length child))
+	(when (nth (1+ selected-pos) child)
+	  (rotatef (nth selected-pos child)
+		   (nth (1+ selected-pos) child)))
+	(incf selected-pos)))
+    (show-all-children)))
+
+
+(defun frame-raise-child ()
+  "Raise the child in the current frame"
+  (when (frame-p *current-child*)
+    (with-slots (child selected-pos) *current-child*
+      (unless (< selected-pos 1)
+	(when (nth (1- selected-pos) child)
+	  (rotatef (nth selected-pos child)
+		   (nth (1- selected-pos) child)))
+	(decf selected-pos)))
+    (show-all-children)))
+
+
 (defun switch-to-root-frame (&key (show-later nil))
   "Switch to the root frame"
   (hide-all *current-root*)

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Tue Jun  3 17:20:53 2008
@@ -899,7 +899,7 @@
 (defun get-current-window ()
   (typecase *current-child*
     (xlib:window  *current-child*)
-    (frame (first (frame-child *current-child*)))))
+    (frame (frame-selected-child *current-child*))))
 
 (defmacro with-current-window (&body body)
   "Bind 'window' to the current window"

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Tue Jun  3 17:20:53 2008
@@ -102,8 +102,8 @@
    (show-window-p :initarg :show-window-p :accessor frame-show-window-p :initform t)
    (hidden-children :initarg :hidden-children :accessor frame-hidden-children :initform nil
 		    :documentation "A list of hidden children")
-   (n-focused-child :initarg :n-focused-child :accessor frame-n-focused-child :initform 0
-		    :documentation "A number to choose which child to focus")
+   (selected-pos :initarg :selected-pos :accessor frame-selected-pos :initform 0
+		 :documentation "The position in the child list of the selected child")
    (window :initarg :window :accessor frame-window :initform nil)
    (gc :initarg :gc :accessor frame-gc :initform nil)
    (child :initarg :child :accessor frame-child :initform nil)

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Tue Jun  3 17:20:53 2008
@@ -340,7 +340,6 @@
   "Give the window focus."
   (when window
     (with-xlib-protect
-      (raise-window window)
       (xlib:set-input-focus *display* window :parent))))
 
 


From pbrochard at common-lisp.net  Wed Jun  4 11:49:23 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Wed,  4 Jun 2008 07:49:23 -0400 (EDT)
Subject: [clfswm-cvs] r142 - in clfswm: . src
Message-ID: <20080604114923.BAF5649087@common-lisp.net>

Author: pbrochard
Date: Wed Jun  4 07:49:22 2008
New Revision: 142

Modified:
   clfswm/ChangeLog
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/bindings.lisp
   clfswm/src/clfswm-nw-hooks.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/clfswm.lisp
Log:
mouse-click-to-focus-and-move-window, mouse-click-to-focus-and-resize-window: Stop button event. This prevent a keyboard/pointer freeze.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed Jun  4 07:49:22 2008
@@ -1,3 +1,9 @@
+2008-06-04  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/bindings.lisp (mouse-click-to-focus-and-move-window)
+	(mouse-click-to-focus-and-resize-window): Stop button event. This
+	prevent a keyboard/pointer freeze.
+
 2008-06-03  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp (frame-lower-child)

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Wed Jun  4 07:49:22 2008
@@ -244,13 +244,25 @@
   (leave-frame))
 
 
+(defun sm-mouse-click-to-focus-and-move-window (window root-x root-y)
+  "Move and focus the current child - Create a new frame on the root window"
+  (declare (ignore window))
+  (mouse-focus-move/resize-generic root-x root-y #'move-frame t))
+
+
+(defun sm-mouse-click-to-focus-and-resize-window (window root-x root-y)
+  "Resize and focus the current child - Create a new frame on the root window"
+  (declare (ignore window))
+  (mouse-focus-move/resize-generic root-x root-y #'resize-frame t))
+
+
 
 
 (define-second-mouse (1) 'sm-mouse-click-to-focus-and-move)
 (define-second-mouse (3) 'sm-mouse-click-to-focus-and-resize)
 
-(define-second-mouse (1 :mod-1) 'mouse-click-to-focus-and-move-window)
-(define-second-mouse (3 :mod-1) 'mouse-click-to-focus-and-resize-window)
+(define-second-mouse (1 :mod-1) 'sm-mouse-click-to-focus-and-move-window)
+(define-second-mouse (3 :mod-1) 'sm-mouse-click-to-focus-and-resize-window)
 
 (define-second-mouse (1 :control :mod-1) 'mouse-move-window-over-frame)
 

Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp	(original)
+++ clfswm/src/bindings.lisp	Wed Jun  4 07:49:22 2008
@@ -117,11 +117,14 @@
 (defun mouse-click-to-focus-and-move-window (window root-x root-y)
   "Move and focus the current child - Create a new frame on the root window"
   (declare (ignore window))
+  (stop-button-event)
   (mouse-focus-move/resize-generic root-x root-y #'move-frame t))
 
+
 (defun mouse-click-to-focus-and-resize-window (window root-x root-y)
   "Resize and focus the current child - Create a new frame on the root window"
   (declare (ignore window))
+  (stop-button-event)
   (mouse-focus-move/resize-generic root-x root-y #'resize-frame t))
 
 

Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp	(original)
+++ clfswm/src/clfswm-nw-hooks.lisp	Wed Jun  4 07:49:22 2008
@@ -98,7 +98,7 @@
   "Open the next window in the current root"
   (leave-if-not-frame *current-root*)
   (pushnew window (frame-child *current-root*))
-  (setf *current-child* (first (frame-child *current-root*)))
+  (setf *current-child* (frame-selected-child *current-root*))
   (default-window-placement *current-root* window)
   (clear-nw-hook frame))
 

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Wed Jun  4 07:49:22 2008
@@ -522,7 +522,7 @@
 
 
 (defun move-frame (frame parent orig-x orig-y)
-  (when frame
+  (when (and frame parent)
     (hide-all-children frame)
     (with-slots (window) frame
       (move-window window orig-x orig-y #'display-frame-info (list frame))
@@ -532,7 +532,7 @@
 
 
 (defun resize-frame (frame parent orig-x orig-y)
-  (when frame
+  (when (and frame parent)
     (hide-all-children frame)
     (with-slots (window) frame
       (resize-window window orig-x orig-y #'display-frame-info (list frame))

Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp	(original)
+++ clfswm/src/clfswm.lisp	Wed Jun  4 07:49:22 2008
@@ -41,6 +41,7 @@
     (replay-button-event)))
 
 
+
 (defun handle-button-release (&rest event-slots &key code state window root-x root-y &allow-other-keys)
   (declare (ignore event-slots))
   (unless (funcall-button-from-code *main-mouse* code state window root-x root-y *fun-release*)


From pbrochard at common-lisp.net  Wed Jun  4 12:08:50 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Wed,  4 Jun 2008 08:08:50 -0400 (EDT)
Subject: [clfswm-cvs] r143 - in clfswm: . src
Message-ID: <20080604120850.6534E74441@common-lisp.net>

Author: pbrochard
Date: Wed Jun  4 08:08:44 2008
New Revision: 143

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-nw-hooks.lisp
Log:
leave-focus-frame-nw-hook: Adapt behaviour to the new raise/lower property.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed Jun  4 08:08:44 2008
@@ -1,5 +1,8 @@
 2008-06-04  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-nw-hooks.lisp (leave-focus-frame-nw-hook): Adapt
+	behaviour to the new raise/lower property.
+
 	* src/bindings.lisp (mouse-click-to-focus-and-move-window)
 	(mouse-click-to-focus-and-resize-window): Stop button event. This
 	prevent a keyboard/pointer freeze.

Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp	(original)
+++ clfswm/src/clfswm-nw-hooks.lisp	Wed Jun  4 08:08:44 2008
@@ -175,10 +175,9 @@
   "Open the next window in the current frame and leave the focus on the current child"
   (leave-if-not-frame *current-child*)
   (when (frame-p *current-child*)
-    (pushnew window (frame-child *current-child*))
-    (when (second (frame-child *current-child*))
-      (rotatef (first (frame-child *current-child*))
-	       (second (frame-child *current-child*)))))
+    (with-slots (child) *current-child*
+      (pushnew window child)
+      (setf child (rotate-list child))))
   (default-window-placement *current-child* window)
   (clear-nw-hook frame))
 


From pbrochard at common-lisp.net  Wed Jun  4 12:50:04 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Wed,  4 Jun 2008 08:50:04 -0400 (EDT)
Subject: [clfswm-cvs] r144 - in clfswm: . src
Message-ID: <20080604125004.7C35864048@common-lisp.net>

Author: pbrochard
Date: Wed Jun  4 08:50:03 2008
New Revision: 144

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-nw-hooks.lisp
Log:
leave-focus-frame-nw-hook: Call clear-nw-hook before the rest of the hook.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed Jun  4 08:50:03 2008
@@ -2,6 +2,7 @@
 
 	* src/clfswm-nw-hooks.lisp (leave-focus-frame-nw-hook): Adapt
 	behaviour to the new raise/lower property.
+	Call clear-nw-hook before the rest of the hook.
 
 	* src/bindings.lisp (mouse-click-to-focus-and-move-window)
 	(mouse-click-to-focus-and-resize-window): Stop button event. This

Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp	(original)
+++ clfswm/src/clfswm-nw-hooks.lisp	Wed Jun  4 08:50:03 2008
@@ -96,11 +96,11 @@
 ;;; Open new window in current root hook
 (defun open-in-current-root-nw-hook (frame window)
   "Open the next window in the current root"
+  (clear-nw-hook frame)
   (leave-if-not-frame *current-root*)
   (pushnew window (frame-child *current-root*))
   (setf *current-child* (frame-selected-child *current-root*))
-  (default-window-placement *current-root* window)
-  (clear-nw-hook frame))
+  (default-window-placement *current-root* window))
 
 (defun set-open-in-current-root-nw-hook ()
   "Open the next window in the current root"
@@ -112,13 +112,13 @@
 ;;; Open new window in a new frame in the current root hook
 (defun open-in-new-frame-in-current-root-nw-hook (frame window)
   "Open the next window in a new frame in the current root"
+  (clear-nw-hook frame)
   (leave-if-not-frame *current-root*)
   (let ((new-frame (create-frame)))
     (pushnew new-frame (frame-child *current-root*))
     (pushnew window (frame-child new-frame))
     (setf *current-child* new-frame)
-    (default-window-placement new-frame window))
-  (clear-nw-hook frame))
+    (default-window-placement new-frame window)))
 
 (defun set-open-in-new-frame-in-current-root-nw-hook ()
   "Open the next window in a new frame in the current root"
@@ -130,6 +130,7 @@
 ;;; Open new window in a new frame in the root frame hook
 (defun open-in-new-frame-in-root-frame-nw-hook (frame window)
   "Open the next window in a new frame in the root frame"
+  (clear-nw-hook frame)
   (let ((new-frame (create-frame)))
     (pushnew new-frame (frame-child *root-frame*))
     (pushnew window (frame-child new-frame))
@@ -137,8 +138,7 @@
     (setf *current-child* *current-root*)
     (set-tile-space-layout-once)
     (setf *current-child* new-frame)
-    (default-window-placement new-frame window))
-  (clear-nw-hook frame))
+    (default-window-placement new-frame window)))
 
 (defun set-open-in-new-frame-in-root-frame-nw-hook ()
   "Open the next window in a new frame in the root frame"
@@ -150,6 +150,7 @@
 ;;; Open new window in a new frame in the parent frame hook
 (defun open-in-new-frame-in-parent-frame-nw-hook (frame window)
   "Open the next window in a new frame in the parent frame"
+  (clear-nw-hook frame)
   (let ((new-frame (create-frame))
 	(parent (find-parent-frame frame)))
     (when parent
@@ -159,8 +160,8 @@
       (setf *current-root* parent)
       (setf *current-child* new-frame)
       (default-window-placement new-frame window)
-      (show-all-children *current-root*)))
-  (clear-nw-hook frame))
+      (show-all-children *current-root*))))
+
 
 (defun set-open-in-new-frame-in-parent-frame-nw-hook ()
   "Open the next window in a new frame in the parent frame"
@@ -173,13 +174,13 @@
 ;;; Open a new window but leave the focus on the current child
 (defun leave-focus-frame-nw-hook (frame window)
   "Open the next window in the current frame and leave the focus on the current child"
+  (clear-nw-hook frame)
   (leave-if-not-frame *current-child*)
   (when (frame-p *current-child*)
     (with-slots (child) *current-child*
       (pushnew window child)
       (setf child (rotate-list child))))
-  (default-window-placement *current-child* window)
-  (clear-nw-hook frame))
+  (default-window-placement *current-child* window))
 
 (defun set-leave-focus-frame-nw-hook ()
   "Open the next window in the current frame and leave the focus on the current child"


From pbrochard at common-lisp.net  Wed Jun  4 20:57:37 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Wed,  4 Jun 2008 16:57:37 -0400 (EDT)
Subject: [clfswm-cvs] r145 - in clfswm: . doc src
Message-ID: <20080604205737.47A841D14A@common-lisp.net>

Author: pbrochard
Date: Wed Jun  4 16:57:36 2008
New Revision: 145

Modified:
   clfswm/ChangeLog
   clfswm/doc/keys.html
   clfswm/doc/keys.txt
   clfswm/doc/menu.html
   clfswm/doc/menu.txt
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/menu-def.lisp
Log:
Add raise/lower keys on second mode and in a menu entry

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed Jun  4 16:57:36 2008
@@ -1,5 +1,11 @@
 2008-06-04  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/menu-def.lisp (child-menu): New menu entry on raise/lower
+	child in its frame.
+
+	* src/bindings-second-mode.lisp ("Page_Down", "Page_Up"): New
+	second mode binding on raise/lower child in its frame.
+
 	* src/clfswm-nw-hooks.lisp (leave-focus-frame-nw-hook): Adapt
 	behaviour to the new raise/lower property.
 	Call clear-nw-hook before the rest of the hook.

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Wed Jun  4 16:57:36 2008
@@ -834,6 +834,28 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
+          Page_up
+        </td>
+        <td style="color:#0000ff" nowrap>
+          Lower the child in the current frame
+        </td>
+      </tr>
+      <tr>
+        <td align="right" style="color:#ff0000" nowrap>
+           Mod-1 
+        </td>
+        <td align="center" nowrap>
+          Page_down
+        </td>
+        <td style="color:#0000ff" nowrap>
+          Raise the child in the current frame
+        </td>
+      </tr>
+      <tr>
+        <td align="right" style="color:#ff0000" nowrap>
+           Mod-1 
+        </td>
+        <td align="center" nowrap>
           Home
         </td>
         <td style="color:#0000ff" nowrap>

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Wed Jun  4 16:57:36 2008
@@ -89,6 +89,8 @@
 Mod-1 Shift          Tab             Select the previous child
 Mod-1                Return          Enter in the selected frame - ie make it the root frame
 Mod-1 Shift          Return          Leave the selected frame - ie make its parent the root frame
+Mod-1                Page_up         Lower the child in the current frame
+Mod-1                Page_down       Raise the child in the current frame
 Mod-1                Home            Switch to the root frame
 Mod-1 Shift          Home            Switch and select the root frame
                      Menu            Show all frames info windows until a key is release

Modified: clfswm/doc/menu.html
==============================================================================
--- clfswm/doc/menu.html	(original)
+++ clfswm/doc/menu.html	Wed Jun  4 16:57:36 2008
@@ -63,6 +63,12 @@
     <p>
       a: Unhide all current frame hidden children
     </p>
+    <p>
+      Page_Up: Lower the child in the current frame
+    </p>
+    <p>
+      Page_Down: Raise the child in the current frame
+    </p>
     <hr>
     <h3>
       <a name="FRAME-MENU"></a><a href="#MAIN">Frame-Menu</a>

Modified: clfswm/doc/menu.txt
==============================================================================
--- clfswm/doc/menu.txt	(original)
+++ clfswm/doc/menu.txt	Wed Jun  4 16:57:36 2008
@@ -18,6 +18,8 @@
 u: Unhide a child in the current frame
 f: Unhide a child from all frames in the current frame
 a: Unhide all current frame hidden children
+Page_Up: Lower the child in the current frame
+Page_Down: Raise the child in the current frame
 
 Frame-Menu
 a: < Adding frame menu >

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Wed Jun  4 16:57:36 2008
@@ -114,6 +114,11 @@
 (define-second-key ("Return" :mod-1) 'enter-frame)
 (define-second-key ("Return" :mod-1 :shift) 'leave-frame)
 
+
+(define-second-key ("Page_Up" :mod-1) 'frame-lower-child)
+(define-second-key ("Page_Down" :mod-1) 'frame-raise-child)
+
+
 (define-second-key ("Home" :mod-1) 'switch-to-root-frame)
 (define-second-key ("Home" :mod-1 :shift) 'switch-and-select-root-frame)
 

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Wed Jun  4 16:57:36 2008
@@ -79,6 +79,9 @@
 (add-menu-key 'child-menu "u" 'unhide-a-child)
 (add-menu-key 'child-menu "f" 'unhide-a-child-from-all-frames)
 (add-menu-key 'child-menu "a" 'unhide-all-children)
+(add-menu-key 'child-menu "Page_Up" 'frame-lower-child)
+(add-menu-key 'child-menu "Page_Down" 'frame-raise-child)
+
 
 
 (add-sub-menu 'frame-menu "a" 'frame-adding-menu "Adding frame menu")


From pbrochard at common-lisp.net  Fri Jun  6 21:43:35 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Fri,  6 Jun 2008 17:43:35 -0400 (EDT)
Subject: [clfswm-cvs] r146 - in clfswm: . src
Message-ID: <20080606214335.8ADC536140@common-lisp.net>

Author: pbrochard
Date: Fri Jun  6 17:43:34 2008
New Revision: 146

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-layout.lisp
Log:
show-all-children: Always raise all displayed children. Remove all references to raise-p.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Fri Jun  6 17:43:34 2008
@@ -1,3 +1,8 @@
+2008-06-06  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp (show-all-children): Always raise all
+	displayed children. Remove all references to raise-p.
+
 2008-06-04  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/menu-def.lisp (child-menu): New menu entry on raise/lower

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Fri Jun  6 17:43:34 2008
@@ -419,24 +419,24 @@
 
 (defmethod adapt-child-to-parent ((window xlib:window) parent)
   (with-xlib-protect
-    (if (managed-window-p window parent)
-	(multiple-value-bind (nx ny nw nh raise-p)
-	    (get-parent-layout window parent)
-	  (setf nw (max nw 1)  nh (max nh 1))
-	  (let ((change (or (/= (xlib:drawable-x window) nx)
-			    (/= (xlib:drawable-y window) ny)
-			    (/= (xlib:drawable-width window) nw)
-			    (/= (xlib:drawable-height window) nh))))
-	    (setf (xlib:drawable-x window) nx
-		  (xlib:drawable-y window) ny
-		  (xlib:drawable-width window) nw
-		  (xlib:drawable-height window) nh)
-	    (values raise-p change)))
-	(values nil nil))))
+    (when (managed-window-p window parent)
+      (multiple-value-bind (nx ny nw nh)
+	  (get-parent-layout window parent)
+	(setf nw (max nw 1)  nh (max nh 1))
+	(let ((change (or (/= (xlib:drawable-x window) nx)
+			  (/= (xlib:drawable-y window) ny)
+			  (/= (xlib:drawable-width window) nw)
+			  (/= (xlib:drawable-height window) nh))))
+	  (setf (xlib:drawable-x window) nx
+		(xlib:drawable-y window) ny
+		(xlib:drawable-width window) nw
+		(xlib:drawable-height window) nh)
+	  change)))))
+
 
 (defmethod adapt-child-to-parent ((frame frame) parent)
   (with-xlib-protect
-    (multiple-value-bind (nx ny nw nh raise-p)
+    (multiple-value-bind (nx ny nw nh)
 	(get-parent-layout frame parent)
       (with-slots (rx ry rw rh window) frame
 	(setf rx nx  ry ny
@@ -450,23 +450,18 @@
 		(xlib:drawable-y window) ry
 		(xlib:drawable-width window) rw
 		(xlib:drawable-height window) rh)
-	  (values raise-p change))))))
+	  change)))))
 
 (defmethod adapt-child-to-parent (child parent)
   (declare (ignore child parent))
-  (values nil nil))
-
+  nil)
 
 
 
-(defun raise-if-needed (window raise-p selected-p)
-  (when (or (eql raise-p t)
-	    (and (eql raise-p :first-only) selected-p))
-    (raise-window window)))
 
-(defgeneric show-child (child parent display-p raise-p selected-p))
+(defgeneric show-child (child parent display-p))
 
-(defmethod show-child ((frame frame) parent display-p raise-p selected-p)
+(defmethod show-child ((frame frame) parent display-p)
   (declare (ignore parent))
   (with-xlib-protect
     (with-slots (window show-window-p) frame
@@ -475,22 +470,22 @@
 	    (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 selected-p)))
+	      (raise-window window)))
 	  (hide-window window)))
     (display-frame-info frame)))
 
 
-(defmethod show-child ((window xlib:window) parent display-p raise-p selected-p)
+(defmethod show-child ((window xlib:window) parent display-p)
   (with-xlib-protect
     (if (or (managed-window-p window parent)
 	    (equal parent *current-child*))
 	(when display-p
 	  (xlib:map-window window)
-	  (raise-if-needed window raise-p selected-p))
+	  (raise-window window))
 	(hide-window window))))
 
-(defmethod show-child (child parent display-p raise-p selected-p)
-  (declare (ignore child parent display-p raise-p selected-p))
+(defmethod show-child (child parent display-p)
+  (declare (ignore child parent display-p))
   ())
 
 
@@ -558,10 +553,9 @@
 only for display-child and its children"
   (let ((geometry-change nil))
     (labels ((rec (root parent selected-p selected-parent-p display-p)
-	       (multiple-value-bind (raise-p change)
-		   (adapt-child-to-parent root parent)
-		 (when change (setf geometry-change change))
-		 (show-child root parent display-p raise-p selected-p))
+	       (when (adapt-child-to-parent root parent)
+		 (setf geometry-change t))
+	       (show-child root parent display-p)
 	       (select-child root (if (equal root *current-child*) t
 				      (if (and selected-p selected-parent-p) :maybe nil)))
 	       (when (frame-p root)
@@ -705,11 +699,11 @@
 
 (defun select-next-child ()
   "Select the next child"
-  (select-next/previous-child #'anti-rotate-list))
+  (select-next/previous-child #'rotate-list))
 
 (defun select-previous-child ()
   "Select the previous child"
-  (select-next/previous-child #'rotate-list))
+  (select-next/previous-child #'anti-rotate-list))
 
 
 

Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp	(original)
+++ clfswm/src/clfswm-layout.lisp	Fri Jun  6 17:43:34 2008
@@ -30,10 +30,9 @@
 ;;;
 ;;; To add a new layout:
 ;;;   1- define your own layout: a method returning the real size of the
-;;;      child in screen size (integer) as 5 values (rx, ry, rw, rh, raise-p).
+;;;      child in screen size (integer) as 5 values (rx, ry, rw, rh).
 ;;;      This method can use the float size of the child (x, y ,w , h).
 ;;;      It can be specialised for xlib:window or frame
-;;;      Raise-p is nil or :first-only or t
 ;;;   2- Define a seter function for your layout
 ;;;   3- Register your new layout with register-layout.
 
@@ -101,15 +100,13 @@
     (values (1+ rx)
 	    (1+ ry)
 	    (- rw 2)
-	    (- rh 2)
-	    :first-only)))
+	    (- rh 2))))
 
 (defmethod no-layout ((child frame) parent)
   (values (x-fl->px (frame-x child) parent)
 	  (y-fl->px (frame-y child) parent)
 	  (w-fl->px (frame-w child) parent)
-	  (h-fl->px (frame-h child) parent)
-	  t))
+	  (h-fl->px (frame-h child) parent)))
 
 
 
@@ -136,8 +133,7 @@
     (values (round (+ (frame-rx parent) (truncate (* (mod pos n) dx)) 1))
 	    (round (+ (frame-ry parent) (truncate (* (truncate (/ pos n)) dy)) 1))
 	    (round (- dx 2))
-	    (round (- dy 2))
-	    t)))
+	    (round (- dy 2)))))
 
 (defun set-tile-layout ()
   "Tile child in its frame"
@@ -162,13 +158,11 @@
 	      (values (1+ rx)
 		      (1+ ry)
 		      (- (round (* rw size)) 2)
-		      (- rh 2)
-		      t)
+		      (- rh 2))
 	      (values (1+ (round (+ rx (* rw size))))
 		      (1+ (round (+ ry (* dy (1- pos)))))
 		      (- (round (* rw (- 1 size))) 2)
-		      (- (round dy) 2)
-		      t))
+		      (- (round dy) 2)))
 	  (no-layout child parent)))))
 
 
@@ -197,13 +191,11 @@
 	      (values (1+ (round (+ rx (* rw (- 1 size)))))
 		      (1+ ry)
 		      (- (round (* rw size)) 2)
-		      (- rh 2)
-		      t)
+		      (- rh 2))
 	      (values (1+ rx)
 		      (1+ (round (+ ry (* dy (1- pos)))))
 		      (- (round (* rw (- 1 size))) 2)
-		      (- (round dy) 2)
-		      t))
+		      (- (round dy) 2)))
 	  (no-layout child parent)))))
 
 
@@ -234,13 +226,11 @@
 	      (values (1+ rx)
 		      (1+ ry)
 		      (- rw 2)
-		      (- (round (* rh size)) 2)
-		      t)
+		      (- (round (* rh size)) 2))
 	      (values (1+ (round (+ rx (* dx (1- pos)))))
 		      (1+ (round (+ ry (* rh size))))
 		      (- (round dx) 2)
-		      (- (round (* rh (- 1 size))) 2)
-		      t))
+		      (- (round (* rh (- 1 size))) 2)))
 	  (no-layout child parent)))))
 
 
@@ -269,13 +259,11 @@
 	      (values (1+ rx)
 		      (1+ (round (+ ry (* rh (- 1 size)))))
 		      (- rw 2)
-		      (- (round (* rh size)) 2)
-		      t)
+		      (- (round (* rh size)) 2))
 	      (values (1+ (round (+ rx (* dx (1- pos)))))
 		      (1+ ry)
 		      (- (round dx) 2)
-		      (- (round (* rh (- 1 size))) 2)
-		      t))
+		      (- (round (* rh (- 1 size))) 2)))
 	  (no-layout child parent)))))
 
 
@@ -309,8 +297,7 @@
       (values (round (+ rx (truncate (* (mod pos n) dx)) (* dx size) 1))
 	      (round (+ ry (truncate (* (truncate (/ pos n)) dy)) (* dy size) 1))
 	      (round (- dx (* dx size 2) 2))
-	      (round (- dy (* dy size 2) 2))
-	      t))))
+	      (round (- dy (* dy size 2) 2))))))
 
 (defun set-tile-space-layout ()
   "Tile Space: tile child in its frame leaving spaces between them"
@@ -350,20 +337,17 @@
 	      (values (+ rx space 1)
 		      (1+ ry)
 		      (- (round (* rw size)) 2 space)
-		      (- rh 2)
-		      t)
+		      (- rh 2))
 	      (values (1+ (round (+ rx (* rw size))))
 		      (1+ (round (+ ry (* dy (1- pos)))))
 		      (- (round (* rw (- 1 size))) 2)
-		      (- (round dy) 2)
-		      t))
+		      (- (round dy) 2)))
 	  (multiple-value-bind (rnx rny rnw rnh)
 	      (no-layout child parent)
 	    (values (+ rnx space)
 		    rny
 		    (- rnw space)
-		    rnh
-		    t))))))
+		    rnh))))))
 
 
 (defun set-tile-left-space-layout ()


From pbrochard at common-lisp.net  Sun Jun  8 20:08:14 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sun,  8 Jun 2008 16:08:14 -0400 (EDT)
Subject: [clfswm-cvs] r147 - in clfswm: . src
Message-ID: <20080608200814.CBC61D003@common-lisp.net>

Author: pbrochard
Date: Sun Jun  8 16:08:14 2008
New Revision: 147

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-internal.lisp
Log:
raise-p-list, show-all-children: Raise only viewable children.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sun Jun  8 16:08:14 2008
@@ -1,3 +1,8 @@
+2008-06-08  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp (raise-p-list, show-all-children):
+	Raise only viewable children.
+
 2008-06-06  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp (show-all-children): Always raise all

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Sun Jun  8 16:08:14 2008
@@ -459,9 +459,9 @@
 
 
 
-(defgeneric show-child (child parent display-p))
+(defgeneric show-child (child parent display-p raise-p))
 
-(defmethod show-child ((frame frame) parent display-p)
+(defmethod show-child ((frame frame) parent display-p raise-p)
   (declare (ignore parent))
   (with-xlib-protect
     (with-slots (window show-window-p) frame
@@ -470,22 +470,22 @@
 	    (when (or *show-root-frame-p* (not (equal frame *current-root*)))
 	      (setf (xlib:window-background window) (get-color "Black"))
 	      (xlib:map-window window)
-	      (raise-window window)))
+	      (when raise-p (raise-window window))))
 	  (hide-window window)))
     (display-frame-info frame)))
 
 
-(defmethod show-child ((window xlib:window) parent display-p)
+(defmethod show-child ((window xlib:window) parent display-p raise-p)
   (with-xlib-protect
     (if (or (managed-window-p window parent)
 	    (equal parent *current-child*))
 	(when display-p
 	  (xlib:map-window window)
-	  (raise-window window))
+	  (when raise-p (raise-window window)))
 	(hide-window window))))
 
-(defmethod show-child (child parent display-p)
-  (declare (ignore child parent display-p))
+(defmethod show-child (child parent display-p raise-p)
+  (declare (ignore child parent display-p raise-p))
   ())
 
 
@@ -506,6 +506,26 @@
 
 
 
+(defgeneric child-coordinates (child))
+
+(defmethod child-coordinates ((frame frame))
+  (values (frame-rx frame)
+	  (frame-ry frame)
+	  (+ (frame-rx frame) (frame-rw frame))
+	  (+ (frame-ry frame) (frame-rh frame))))
+
+(defmethod child-coordinates ((window xlib:window))
+  (values (xlib:drawable-x window)
+	  (xlib:drawable-y window)
+	  (+ (xlib:drawable-x window) (xlib:drawable-width window))
+	  (+ (xlib:drawable-y window) (xlib:drawable-height window))))
+
+(defmethod child-coordinates (child)
+  (declare (ignore child))
+  (values 0 0 1 1))
+
+
+
 (defgeneric select-child (child selected))
 
 (defmethod select-child ((frame frame) selected)
@@ -547,23 +567,47 @@
 
 
 
+(defun raise-p-list (children)
+  (let ((acc nil))
+    (labels ((rec (list)
+	       (when list
+		 (multiple-value-bind (xo1 yo1 xo2 yo2)
+		     (child-coordinates (first list))
+		   (push (not (dolist (c (rest list))
+				(multiple-value-bind (x1 y1 x2 y2)
+				    (child-coordinates c)
+				  (when (and (<= x1 xo1)
+					     (>= x2 xo2)
+					     (<= y1 yo1)
+					     (>= y2 yo2))
+				    (return t)))))
+			 acc))
+		 (rec (rest list)))))
+      (rec children)
+      (nreverse acc))))
+
+
 
 (defun show-all-children (&optional (display-child *current-child*))
   "Show all children from *current-root*. Start the effective display
 only for display-child and its children"
   (let ((geometry-change nil))
-    (labels ((rec (root parent selected-p selected-parent-p display-p)
+    (labels ((rec (root parent selected-p selected-parent-p display-p raise-p)
 	       (when (adapt-child-to-parent root parent)
 		 (setf geometry-change t))
-	       (show-child root parent display-p)
+	       (show-child root parent display-p raise-p)
 	       (select-child root (if (equal root *current-child*) t
 				      (if (and selected-p selected-parent-p) :maybe nil)))
 	       (when (frame-p root)
-		 (let ((selected-child (frame-selected-child root)))
-		   (dolist (child (reverse (frame-child root)))
-		     (rec child root (equal child selected-child) (and selected-p selected-parent-p)
-			  (or display-p (equal root display-child))))))))
-      (rec *current-root* nil t t (equal display-child *current-root*))
+		 (let ((selected-child (frame-selected-child root))
+		       (reversed-children (reverse (frame-child root))))
+		   (loop for child in reversed-children
+		      for raise-p in (raise-p-list reversed-children)
+		      do (rec child root (equal child selected-child)
+			      (and selected-p selected-parent-p)
+			      (or display-p (equal root display-child))
+			      raise-p))))))
+      (rec *current-root* nil t t (equal display-child *current-root*) t)
       (set-focus-to-current-child)
       geometry-change)))
 


From pbrochard at common-lisp.net  Thu Jun 12 11:21:47 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Thu, 12 Jun 2008 07:21:47 -0400 (EDT)
Subject: [clfswm-cvs] r148 - in clfswm: . src
Message-ID: <20080612112147.520BA18@common-lisp.net>

Author: pbrochard
Date: Thu Jun 12 07:21:46 2008
New Revision: 148

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-internal.lisp
   clfswm/src/tools.lisp
Log:
focus-child: Algorithm change to raise only the selected child.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Thu Jun 12 07:21:46 2008
@@ -1,3 +1,8 @@
+2008-06-12  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp (focus-child): Algorithm change to
+	raise only the selected child.
+
 2008-06-08  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp (raise-p-list, show-all-children):

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Thu Jun 12 07:21:46 2008
@@ -628,15 +628,14 @@
 
 
 
-
 (defun focus-child (child parent)
   "Focus child - Return true if something has change"
   (when (and (frame-p parent)
 	     (member child (frame-child parent)))
-      (when (not (equal child (frame-selected-child parent)))
-	(loop until (equal child (frame-selected-child parent))
-	   do (setf (frame-child parent) (rotate-list (frame-child parent))))
-	t)))
+    (when (not (equal child (frame-selected-child parent)))
+      (with-slots ((parent-child child) selected-pos) parent
+	(setf parent-child (nth-insert selected-pos child (remove child parent-child))))
+      t)))
 
 (defun focus-child-rec (child parent)
   "Focus child and its parents - Return true if something has change"

Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp	(original)
+++ clfswm/src/tools.lisp	Thu Jun 12 07:21:46 2008
@@ -37,6 +37,7 @@
 	   :setf/=
 	   :in-corner
 	   :create-symbol
+	   :nth-insert
 	   :split-string
 	   :expand-newline
 	   :ensure-list
@@ -179,6 +180,15 @@
   (intern (string-upcase (apply #'concatenate 'string names))))
 
 
+
+(defun nth-insert (n elem list)
+  "Insert elem in (nth n list)"
+  (nconc (subseq list 0 n)
+	 (list elem)
+	 (subseq list n)))
+
+
+
 (defun split-string (string &optional (separator #\Space))
   "Return a list from a string splited at each separators"
   (loop for i = 0 then (1+ j)


From pbrochard at common-lisp.net  Sat Jun 21 21:37:18 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sat, 21 Jun 2008 17:37:18 -0400 (EDT)
Subject: [clfswm-cvs] r149 - in clfswm: . src
Message-ID: <20080621213718.DE1C16D06C@common-lisp.net>

Author: pbrochard
Date: Sat Jun 21 17:37:15 2008
New Revision: 149

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/config.lisp
Log:
(show-all-children): Compute geometry and selection first and then show only necessary children. (show-child): remove unneeded display-p parameter. (get-fullscreen-size): Place the frame border outside the screen (this prevent the loose of 2 pixels per directions :)

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat Jun 21 17:37:15 2008
@@ -1,3 +1,13 @@
+2008-06-21  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp (show-all-children): Compute geometry
+	and selection first and then show only necessary children.
+	(show-child): remove unneeded display-p parameter.
+
+	* src/config.lisp (get-fullscreen-size): Place the frame border
+	outside the screen (this prevent the loose of 2 pixels per
+	directions :)
+
 2008-06-12  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp (focus-child): Algorithm change to

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Sat Jun 21 17:37:15 2008
@@ -7,11 +7,13 @@
 ===============
 Should handle these soon.
 
+- Raise Order when tile space layout
+
 - Use conpressed motion events for clisp. [Philippe]
 
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]
 
-- A Gimp layout example [Philippe]
+- A Gimp layout example (a main window and all others on the left) [Philippe]
 
 - Hook to open next window in named/numbered frame [Philippe]
 

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Sat Jun 21 17:37:15 2008
@@ -459,33 +459,32 @@
 
 
 
-(defgeneric show-child (child parent display-p raise-p))
+(defgeneric show-child (child parent raise-p))
 
-(defmethod show-child ((frame frame) parent display-p raise-p)
+(defmethod show-child ((frame frame) parent raise-p)
   (declare (ignore parent))
   (with-xlib-protect
     (with-slots (window show-window-p) frame
       (if show-window-p
-	  (when display-p
-	    (when (or *show-root-frame-p* (not (equal frame *current-root*)))
-	      (setf (xlib:window-background window) (get-color "Black"))
-	      (xlib:map-window window)
-	      (when raise-p (raise-window window))))
+	  (when (or *show-root-frame-p* (not (equal frame *current-root*)))
+	    (setf (xlib:window-background window) (get-color "Black"))
+	    (xlib:map-window window)
+	    (when raise-p (raise-window window)))
 	  (hide-window window)))
     (display-frame-info frame)))
 
 
-(defmethod show-child ((window xlib:window) parent display-p raise-p)
+(defmethod show-child ((window xlib:window) parent raise-p)
   (with-xlib-protect
     (if (or (managed-window-p window parent)
 	    (equal parent *current-child*))
-	(when display-p
+	(progn
 	  (xlib:map-window window)
 	  (when raise-p (raise-window window)))
 	(hide-window window))))
 
-(defmethod show-child (child parent display-p raise-p)
-  (declare (ignore child parent display-p raise-p))
+(defmethod show-child (child parent raise-p)
+  (declare (ignore child parent raise-p))
   ())
 
 
@@ -592,22 +591,25 @@
   "Show all children from *current-root*. Start the effective display
 only for display-child and its children"
   (let ((geometry-change nil))
-    (labels ((rec (root parent selected-p selected-parent-p display-p raise-p)
+    (labels ((rec-geom (root parent selected-p selected-parent-p)
 	       (when (adapt-child-to-parent root parent)
 		 (setf geometry-change t))
-	       (show-child root parent display-p raise-p)
-	       (select-child root (if (equal root *current-child*) t
-				      (if (and selected-p selected-parent-p) :maybe nil)))
+	       (select-child root (cond ((equal root *current-child*) t)
+					((and selected-p selected-parent-p) :maybe)
+					(t nil)))
 	       (when (frame-p root)
-		 (let ((selected-child (frame-selected-child root))
-		       (reversed-children (reverse (frame-child root))))
+		 (let ((selected-child (frame-selected-child root)))
+		   (dolist (child (reverse (frame-child root)))
+		     (rec-geom child root (equal child selected-child) (and selected-p selected-parent-p))))))
+	     (rec (root parent raise-p)
+	       (show-child root parent raise-p)
+	       (when (frame-p root)
+		 (let ((reversed-children (reverse (frame-child root))))
 		   (loop for child in reversed-children
 		      for raise-p in (raise-p-list reversed-children)
-		      do (rec child root (equal child selected-child)
-			      (and selected-p selected-parent-p)
-			      (or display-p (equal root display-child))
-			      raise-p))))))
-      (rec *current-root* nil t t (equal display-child *current-root*) t)
+		      do (rec child root raise-p))))))
+      (rec-geom *current-root* nil t t)
+      (rec display-child nil t)
       (set-focus-to-current-child)
       geometry-change)))
 

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Sat Jun 21 17:37:15 2008
@@ -512,7 +512,7 @@
   (when (and (frame-p *current-root*)
 	     (in-corner *present-all-windows-corner* root-x root-y))
     (stop-button-event)
-    (switch-to-root-frame)
+    (switch-to-root-frame :show-later t)
     (present-windows-generic (*root-frame*)
       (hide-all-children *root-frame*)
       (setf *current-root* parent))

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Sat Jun 21 17:37:15 2008
@@ -40,9 +40,10 @@
 
 ;;; CONFIG - Screen size
 (defun get-fullscreen-size ()
-  "Return the size of root child (values rx ry rw rh raise-p)
+  "Return the size of root child (values rx ry rw rh)
 You can tweak this to what you want"
-  (values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*) nil))
+  (values -2 -2 (+ (xlib:screen-width *screen*) 2) (+ (xlib:screen-height *screen*) 2)))
+  ;;(values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*)))
 ;; (values -1 -1 1024 768))
 ;;  (values 100 100 800 600))
 


From pbrochard at common-lisp.net  Sat Jun 28 20:08:29 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sat, 28 Jun 2008 16:08:29 -0400 (EDT)
Subject: [clfswm-cvs] r150 - in clfswm: . src
Message-ID: <20080628200829.ADF5E47005@common-lisp.net>

Author: pbrochard
Date: Sat Jun 28 16:08:28 2008
New Revision: 150

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-info.lisp
   clfswm/src/config.lisp
   clfswm/src/xlib-util.lisp
Log:
Compress motion events in event loop

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat Jun 28 16:08:28 2008
@@ -1,3 +1,15 @@
+2008-06-28  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/xlib-util.lisp (move-window, resize-window): Compress motion
+	events.
+
+	* src/clfswm.lisp (handle-motion-notify): Compress motion events.
+
+	* src/clfswm-second-mode.lisp (sm-handle-motion-notify): Compress
+	motion events.
+
+	* src/clfswm-info.lisp (info-mode): Compress motion events.
+
 2008-06-21  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp (show-all-children): Compute geometry

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Sat Jun 28 16:08:28 2008
@@ -7,10 +7,6 @@
 ===============
 Should handle these soon.
 
-- Raise Order when tile space layout
-
-- Use conpressed motion events for clisp. [Philippe]
-
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]
 
 - A Gimp layout example (a main window and all others on the left) [Philippe]

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Sat Jun 28 16:08:28 2008
@@ -212,8 +212,7 @@
 		 (funcall-key-from-code *info-keys* code state info))
 	       (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
 		 (declare (ignore event-slots))
-		 (unless (xlib:event-case (*display* :discard-p nil :peek-p t :timeout 0)
-			   (:motion-notify () t))
+		 (unless (compress-motion-notify)
 		   (funcall-button-from-code *info-mouse* 'motion 0 window root-x root-y *fun-press* (list info))))
 	       (handle-button-press (&rest event-slots &key window root-x root-y code state &allow-other-keys)
 		 (declare (ignore event-slots))

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Sat Jun 28 16:08:28 2008
@@ -32,7 +32,7 @@
 
 
 ;;; CONFIG - Compress motion notify ?
-(defparameter *have-to-compress-notify* nil
+(defparameter *have-to-compress-notify* t
   "This variable may be useful to speed up some slow version of CLX.
 It is particulary useful with CLISP/MIT-CLX.")
   

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Sat Jun 28 16:08:28 2008
@@ -490,10 +490,11 @@
 	(pointer-grabbed-p (xgrab-pointer-p)))
     (labels ((motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
 	       (declare (ignore event-slots))
-	       (setf (xlib:drawable-x window) (+ root-x dx)
-		     (xlib:drawable-y window) (+ root-y dy))
-	       (when additional-fn
-	       	 (apply additional-fn additional-arg)))
+	       (unless (compress-motion-notify)
+		 (setf (xlib:drawable-x window) (+ root-x dx)
+		       (xlib:drawable-y window) (+ root-y dy))
+		 (when additional-fn
+		   (apply additional-fn additional-arg))))
 	     (handle-event (&rest event-slots &key event-key &allow-other-keys)
 	       (case event-key
 		 (:motion-notify (apply #'motion-notify event-slots))
@@ -532,10 +533,11 @@
 	 (max-height (or (and hints (xlib:wm-size-hints-max-height hints)) most-positive-fixnum)))
     (labels ((motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
 	       (declare (ignore event-slots))
-	       (setf (xlib:drawable-width window) (min (max (+ orig-width (- root-x orig-x)) 10 min-width) max-width)
-		     (xlib:drawable-height window) (min (max (+ orig-height (- root-y orig-y)) 10 min-height) max-height))
-	       (when additional-fn
-	       	 (apply additional-fn additional-arg)))
+	       (unless (compress-motion-notify)
+		 (setf (xlib:drawable-width window) (min (max (+ orig-width (- root-x orig-x)) 10 min-width) max-width)
+		       (xlib:drawable-height window) (min (max (+ orig-height (- root-y orig-y)) 10 min-height) max-height))
+		 (when additional-fn
+		   (apply additional-fn additional-arg))))
 	     (handle-event (&rest event-slots &key event-key &allow-other-keys)
 	       (case event-key
 		 (:motion-notify (apply #'motion-notify event-slots))