[clfswm-cvs] r155 - in clfswm: . doc src

pbrochard at common-lisp.net pbrochard at common-lisp.net
Sun Aug 31 20:30:59 UTC 2008


Author: pbrochard
Date: Sun Aug 31 16:30:57 2008
New Revision: 155

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/doc/keys.html
   clfswm/doc/keys.txt
   clfswm/doc/menu.html
   clfswm/doc/menu.txt
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/clfswm-autodoc.lisp
   clfswm/src/clfswm-layout.lisp
   clfswm/src/clfswm-nw-hooks.lisp
   clfswm/src/menu-def.lisp
   clfswm/src/tools.lisp
Log:
Factorize layouts in menu. Allow comments in menu. Main window layout for top, bottom and left direction

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sun Aug 31 16:30:57 2008
@@ -1,3 +1,12 @@
+2008-08-31  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-menu.lisp (add-menu-comment): Add comments in menu.
+
+	* src/clfswm-layout.lisp (main-window-left-layout)
+	(main-window-bottom-layout, main-window-top-layout): New
+	functions.
+	Factorize layouts in menu.
+
 2008-08-30  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-layout.lisp (main-window-right-layout): A possible

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Sun Aug 31 16:30:57 2008
@@ -7,8 +7,6 @@
 ===============
 Should handle these soon.
 
-- Factorize layout
-
 - A Gimp layout example (a main window and all others on the left) [Philippe]
   + Alt-Tab cycle only on non-main windows
   + Focus policy to sloppy focus.
@@ -18,15 +16,13 @@
 - Ensure-unique-number/name (new function) [Philippe]
 
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]
-   A finir : remove src/test.lisp src/load-test.lisp
-   Dans ~/.clfswmrc:
+   TODO : remove src/test.lisp src/load-test.lisp
+   In ~/.clfswmrc:
       ;;;; AUTO-CONFIG - Do not edit those lines by hands: they are overwritten by CLFSWM
       (defparameter *ma-var* value)
       ...
       ;;;; AUTO-CONFIG End : You can add your configurations below this line.
 
-- Focus policy by frame
-
 
 MAYBE
 =====

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Sun Aug 31 16:30:57 2008
@@ -241,17 +241,6 @@
       </tr>
       <tr>
         <td align="right" style="color:#ff0000" nowrap>
-           Mod-1 
-        </td>
-        <td align="center" nowrap>
-            B
-        </td>
-        <td style="color:#0000ff" nowrap>
-          Move the pointer to the lower right corner of the screen
-        </td>
-      </tr>
-      <tr>
-        <td align="right" style="color:#ff0000" nowrap>
            Control  Shift 
         </td>
         <td align="center" nowrap>
@@ -296,10 +285,10 @@
       </tr>
       <tr>
         <td align="right" style="color:#ff0000" nowrap>
-           Mod-1 
+           Control 
         </td>
         <td align="center" nowrap>
-            T
+          Less
         </td>
         <td style="color:#0000ff" nowrap>
           Switch to editing mode
@@ -307,13 +296,13 @@
       </tr>
       <tr>
         <td align="right" style="color:#ff0000" nowrap>
-           Control 
+           Mod-1 
         </td>
         <td align="center" nowrap>
-          Less
+          Agrave
         </td>
         <td style="color:#0000ff" nowrap>
-          Switch to editing mode
+          Bind or jump to a slot
         </td>
       </tr>
       <tr>
@@ -321,7 +310,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |1|
+          Ccedilla
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -332,7 +321,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |2|
+          Underscore
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -343,7 +332,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |3|
+          Egrave
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -354,7 +343,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |4|
+          Minus
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -365,7 +354,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |5|
+          Parenleft
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -376,7 +365,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |6|
+          Quoteright
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -387,7 +376,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |7|
+          Quotedbl
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -398,7 +387,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |8|
+          Eacute
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -409,7 +398,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |9|
+          Ampersand
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -417,13 +406,13 @@
       </tr>
       <tr>
         <td align="right" style="color:#ff0000" nowrap>
-           Mod-1 
+          
         </td>
         <td align="center" nowrap>
-          |0|
+          Twosuperior
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Move the pointer to the lower right corner of the screen
         </td>
       </tr>
     </table>
@@ -755,7 +744,7 @@
           
         </td>
         <td align="center" nowrap>
-            T
+          T
         </td>
         <td style="color:#0000ff" nowrap>
           Tile with spaces the current frame
@@ -1151,7 +1140,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |1|
+          Agrave
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -1162,7 +1151,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |2|
+          Ccedilla
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -1173,7 +1162,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |3|
+          Underscore
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -1184,7 +1173,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |4|
+          Egrave
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -1195,7 +1184,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |5|
+          Minus
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -1206,7 +1195,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |6|
+          Parenleft
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -1217,7 +1206,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |7|
+          Quoteright
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -1228,7 +1217,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |8|
+          Quotedbl
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -1239,7 +1228,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |9|
+          Eacute
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot
@@ -1250,7 +1239,7 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |0|
+          Ampersand
         </td>
         <td style="color:#0000ff" nowrap>
           Bind or jump to a slot

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Sun Aug 31 16:30:57 2008
@@ -25,23 +25,22 @@
   Mod-1                Menu            Show all frames info windows until a key is release
   Shift                Menu            Show all frames info windows
   Control              Menu            Show/Hide the root frame
-  Mod-1                B               Move the pointer to the lower right corner of the screen
   Control Shift        Escape          Close focus window: Delete the focus window in all frames and workspaces
   Mod-1 Control Shift  Escape          Kill focus window: Destroy the focus window in all frames and workspaces
   Control              Escape          Remove the focus window in the current frame
   Shift                Escape          Unhide all hidden windows into the current child
-  Mod-1                T               Switch to editing mode
   Control              Less            Switch to editing mode
-  Mod-1                |1|             Bind or jump to a slot
-  Mod-1                |2|             Bind or jump to a slot
-  Mod-1                |3|             Bind or jump to a slot
-  Mod-1                |4|             Bind or jump to a slot
-  Mod-1                |5|             Bind or jump to a slot
-  Mod-1                |6|             Bind or jump to a slot
-  Mod-1                |7|             Bind or jump to a slot
-  Mod-1                |8|             Bind or jump to a slot
-  Mod-1                |9|             Bind or jump to a slot
-  Mod-1                |0|             Bind or jump to a slot
+  Mod-1                Agrave          Bind or jump to a slot
+  Mod-1                Ccedilla        Bind or jump to a slot
+  Mod-1                Underscore      Bind or jump to a slot
+  Mod-1                Egrave          Bind or jump to a slot
+  Mod-1                Minus           Bind or jump to a slot
+  Mod-1                Parenleft       Bind or jump to a slot
+  Mod-1                Quoteright      Bind or jump to a slot
+  Mod-1                Quotedbl        Bind or jump to a slot
+  Mod-1                Eacute          Bind or jump to a slot
+  Mod-1                Ampersand       Bind or jump to a slot
+                       Twosuperior     Move the pointer to the lower right corner of the screen
 
 
 Mouse buttons actions in main mode:
@@ -116,16 +115,16 @@
                        H               start an xclock
   Shift                Menu            Show all frames info windows
   Control              Menu            Show/Hide the root frame
-  Mod-1                |1|             Bind or jump to a slot
-  Mod-1                |2|             Bind or jump to a slot
-  Mod-1                |3|             Bind or jump to a slot
-  Mod-1                |4|             Bind or jump to a slot
-  Mod-1                |5|             Bind or jump to a slot
-  Mod-1                |6|             Bind or jump to a slot
-  Mod-1                |7|             Bind or jump to a slot
-  Mod-1                |8|             Bind or jump to a slot
-  Mod-1                |9|             Bind or jump to a slot
-  Mod-1                |0|             Bind or jump to a slot
+  Mod-1                Agrave          Bind or jump to a slot
+  Mod-1                Ccedilla        Bind or jump to a slot
+  Mod-1                Underscore      Bind or jump to a slot
+  Mod-1                Egrave          Bind or jump to a slot
+  Mod-1                Minus           Bind or jump to a slot
+  Mod-1                Parenleft       Bind or jump to a slot
+  Mod-1                Quoteright      Bind or jump to a slot
+  Mod-1                Quotedbl        Bind or jump to a slot
+  Mod-1                Eacute          Bind or jump to a slot
+  Mod-1                Ampersand       Bind or jump to a slot
 
 
 Mouse buttons actions in second mode:

Modified: clfswm/doc/menu.html
==============================================================================
--- clfswm/doc/menu.html	(original)
+++ clfswm/doc/menu.html	Sun Aug 31 16:30:57 2008
@@ -80,16 +80,16 @@
       l: <a href="#FRAME-LAYOUT-MENU">< Frame layout menu ></a>
     </p>
     <p>
-      o: <a href="#FRAME-LAYOUT-ONCE-MENU">< Frame layout menu (Only once) ></a>
-    </p>
-    <p>
       n: <a href="#FRAME-NW-HOOK-MENU">< Frame new window hook menu ></a>
     </p>
     <p>
       m: <a href="#FRAME-MOVEMENT-MENU">< Frame movement menu ></a>
     </p>
     <p>
-      w: <a href="#MANAGED-WINDOW-MENU">< Managed window type menu ></a>
+      f: <a href="#FRAME-FOCUS-POLICY">< Frame focus policy menu ></a>
+    </p>
+    <p>
+      w: <a href="#FRAME-MANAGED-WINDOW-MENU">< Managed window type menu ></a>
     </p>
     <p>
       s: <a href="#FRAME-MISCELLANEOUS-MENU">< Frame miscallenous menu ></a>
@@ -109,75 +109,96 @@
       <a name="FRAME-LAYOUT-MENU"></a><a href="#FRAME-MENU">Frame-Layout-Menu</a>
     </h3>
     <p>
-      *: <a href="#FRAME-FAST-LAYOUT-MENU">< Frame fast layout menu ></a>
+      a: <a href="#FRAME-FAST-LAYOUT-MENU">< Frame fast layout menu ></a>
     </p>
     <p>
-      a: Maximize windows in there frame - leave frame to there size (no layout)
+      b: No layout: Maximize windows in there frame - Leave frame to there size
     </p>
     <p>
-      b: Tile child in its frame (vertical)
+      c: <a href="#FRAME-TILE-LAYOUT-MENU">< Frame tile layout menu ></a>
     </p>
     <p>
-      c:  Tile child in its frame (horizontal)
+      d: <a href="#FRAME-TILE-DIR-LAYOUT-MENU">< Tile in one direction layout menu ></a>
     </p>
     <p>
-      d: Tile Space: tile child in its frame leaving spaces between them
+      e: <a href="#FRAME-TILE-SPACE-LAYOUT-MENU">< Tile with some space on one side menu ></a>
     </p>
     <p>
-      e: Tile Left: main child on left and others on right
+      f: <a href="#FRAME-MAIN-WINDOW-LAYOUT-MENU">< Main window layout menu ></a>
+    </p>
+    <hr>
+    <h3>
+      <a name="FRAME-FAST-LAYOUT-MENU"></a><a href="#FRAME-LAYOUT-MENU">Frame-Fast-Layout-Menu</a>
+    </h3>
+    <p>
+      s: Switch between two layouts
     </p>
     <p>
-      f:   Tile Right: main child on right and others on left
+      p: Push the current layout in the fast layout list
     </p>
+    <hr>
+    <h3>
+      <a name="FRAME-TILE-LAYOUT-MENU"></a><a href="#FRAME-LAYOUT-MENU">Frame-Tile-Layout-Menu</a>
+    </h3>
     <p>
-      g:   Tile Top: main child on top and others on bottom
+      v: Tile child in its frame (vertical)
     </p>
     <p>
-      h:   Tile Bottom: main child on bottom and others on top
+      h: Tile child in its frame (horizontal)
     </p>
     <p>
-      i: Tile Left Space: main child on left and others on right. Leave some space on the left.
+      s: Tile Space: tile child in its frame leaving spaces between them
     </p>
     <hr>
     <h3>
-      <a name="FRAME-FAST-LAYOUT-MENU"></a><a href="#FRAME-LAYOUT-MENU">Frame-Fast-Layout-Menu</a>
+      <a name="FRAME-TILE-DIR-LAYOUT-MENU"></a><a href="#FRAME-LAYOUT-MENU">Frame-Tile-Dir-Layout-Menu</a>
     </h3>
     <p>
-      a: Switch between two layouts
+      l: Tile Left: main child on left and others on right
     </p>
     <p>
-      b: Define the two fast layouts
+      r: Tile Right: main child on right and others on left
+    </p>
+    <p>
+      t: Tile Top: main child on top and others on bottom
+    </p>
+    <p>
+      b: Tile Bottom: main child on bottom and others on top
     </p>
     <hr>
     <h3>
-      <a name="FRAME-LAYOUT-ONCE-MENU"></a><a href="#FRAME-MENU">Frame-Layout-Once-Menu</a>
+      <a name="FRAME-TILE-SPACE-LAYOUT-MENU"></a><a href="#FRAME-LAYOUT-MENU">Frame-Tile-Space-Layout-Menu</a>
     </h3>
     <p>
-      a: Maximize windows in there frame - leave frame to there size (no layout)
+      a: Tile Left Space: main child on left and others on right. Leave some space on the left.
     </p>
+    <hr>
+    <h3>
+      <a name="FRAME-MAIN-WINDOW-LAYOUT-MENU"></a><a href="#FRAME-LAYOUT-MENU">Frame-Main-Window-Layout-Menu</a>
+    </h3>
     <p>
-      b: Tile child in its frame (vertical)
+      r: Main window right: Main windows on the right. Others on the left.
     </p>
     <p>
-      c:  Tile child in its frame (horizontal)
+      l: Main window left: Main windows on the left. Others on the right.
     </p>
     <p>
-      d: Tile Space: tile child in its frame leaving spaces between them
+      t: Main window top: Main windows on the top. Others on the bottom.
     </p>
     <p>
-      e: Tile Left: main child on left and others on right
+      b: Main window bottom: Main windows on the bottom. Others on the top.
     </p>
     <p>
-      f:   Tile Right: main child on right and others on left
+      -=- Actions on main windows list -=-
     </p>
     <p>
-      g:   Tile Top: main child on top and others on bottom
+      a: Add the current window in the main window list
     </p>
     <p>
-      h:   Tile Bottom: main child on bottom and others on top
+      v: Remove the current window from the main window list
     </p>
     <p>
-      i: Tile Left Space: main child on left and others on right. Leave some space on the left.
+      c: Clear the main window list
     </p>
     <hr>
     <h3>
@@ -282,7 +303,17 @@
     </p>
     <hr>
     <h3>
-      <a name="MANAGED-WINDOW-MENU"></a><a href="#FRAME-MENU">Managed-Window-Menu</a>
+      <a name="FRAME-FOCUS-POLICY"></a><a href="#FRAME-MENU">Frame-Focus-Policy</a>
+    </h3>
+    <p>
+      c: Set a click focus policy for the current frame
+    </p>
+    <p>
+      s: Set a sloppy focus policy for the current frame
+    </p>
+    <hr>
+    <h3>
+      <a name="FRAME-MANAGED-WINDOW-MENU"></a><a href="#FRAME-MENU">Frame-Managed-Window-Menu</a>
     </h3>
     <p>
       m: Change window types to be managed by a frame

Modified: clfswm/doc/menu.txt
==============================================================================
--- clfswm/doc/menu.txt	(original)
+++ clfswm/doc/menu.txt	Sun Aug 31 16:30:57 2008
@@ -24,9 +24,9 @@
 Frame-Menu
 a: < Adding frame menu >
 l: < Frame layout menu >
-o: < Frame layout menu (Only once) >
 n: < Frame new window hook menu >
 m: < Frame movement menu >
+f: < Frame focus policy menu >
 w: < Managed window type menu >
 s: < Frame miscallenous menu >
 
@@ -35,31 +35,40 @@
 p: Add a placed frame in the current frame
 
 Frame-Layout-Menu
-*: < Frame fast layout menu >
-a: Maximize windows in there frame - leave frame to there size (no layout)
-b: Tile child in its frame (vertical)
-c:  Tile child in its frame (horizontal)
-d: Tile Space: tile child in its frame leaving spaces between them
-e: Tile Left: main child on left and others on right
-f:   Tile Right: main child on right and others on left
-g:   Tile Top: main child on top and others on bottom
-h:   Tile Bottom: main child on bottom and others on top
-i: Tile Left Space: main child on left and others on right. Leave some space on the left.
+a: < Frame fast layout menu >
+b: No layout: Maximize windows in there frame - Leave frame to there size
+c: < Frame tile layout menu >
+d: < Tile in one direction layout menu >
+e: < Tile with some space on one side menu >
+f: < Main window layout menu >
 
 Frame-Fast-Layout-Menu
-a: Switch between two layouts
-b: Define the two fast layouts
+s: Switch between two layouts
+p: Push the current layout in the fast layout list
 
-Frame-Layout-Once-Menu
-a: Maximize windows in there frame - leave frame to there size (no layout)
-b: Tile child in its frame (vertical)
-c:  Tile child in its frame (horizontal)
-d: Tile Space: tile child in its frame leaving spaces between them
-e: Tile Left: main child on left and others on right
-f:   Tile Right: main child on right and others on left
-g:   Tile Top: main child on top and others on bottom
-h:   Tile Bottom: main child on bottom and others on top
-i: Tile Left Space: main child on left and others on right. Leave some space on the left.
+Frame-Tile-Layout-Menu
+v: Tile child in its frame (vertical)
+h: Tile child in its frame (horizontal)
+s: Tile Space: tile child in its frame leaving spaces between them
+
+Frame-Tile-Dir-Layout-Menu
+l: Tile Left: main child on left and others on right
+r: Tile Right: main child on right and others on left
+t: Tile Top: main child on top and others on bottom
+b: Tile Bottom: main child on bottom and others on top
+
+Frame-Tile-Space-Layout-Menu
+a: Tile Left Space: main child on left and others on right. Leave some space on the left.
+
+Frame-Main-Window-Layout-Menu
+r: Main window right: Main windows on the right. Others on the left.
+l: Main window left: Main windows on the left. Others on the right.
+t: Main window top: Main windows on the top. Others on the bottom.
+b: Main window bottom: Main windows on the bottom. Others on the top.
+-=- Actions on main windows list -=-
+a: Add the current window in the main window list
+v: Remove the current window from the main window list
+c: Clear the main window list
 
 Frame-Nw-Hook-Menu
 a: Open the next window in the current frame
@@ -98,7 +107,11 @@
 d: Resize down the current frame
 a: Resize down the current frame to its minimal size
 
-Managed-Window-Menu
+Frame-Focus-Policy
+c: Set a click focus policy for the current frame
+s: Set a sloppy focus policy for the current frame
+
+Frame-Managed-Window-Menu
 m: Change window types to be managed by a frame
 a: Manage all window type
 n: Manage only normal window type

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Sun Aug 31 16:30:57 2008
@@ -95,10 +95,10 @@
 (defun tile-space-current-frame ()
   "Tile with spaces the current frame"
   (explode-frame *current-child*)
-  (set-tile-space-layout-once)
+  (set-layout-once #'tile-space-layout)
   (leave-second-mode))
 
-(define-second-key (#\t) 'tile-space-current-frame)
+(define-second-key ("t") 'tile-space-current-frame)
 
 (define-second-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
 

Modified: clfswm/src/clfswm-autodoc.lisp
==============================================================================
--- clfswm/src/clfswm-autodoc.lisp	(original)
+++ clfswm/src/clfswm-autodoc.lisp	Sun Aug 31 16:30:57 2008
@@ -139,10 +139,12 @@
 	     (dolist (item (menu-item base))
 	       (typecase item
 		 (menu (format stream "~A: ~A~%" (menu-name item) (menu-doc item)))
-		 (menu-item (format stream "~A: ~A~%" (menu-item-key item)
-				    (typecase (menu-item-value item)
-				      (menu (format nil "< ~A >" (menu-doc (menu-item-value item))))
-				      (t (documentation (menu-item-value item) 'function)))))))
+		 (menu-item (aif (menu-item-key item)
+				 (format stream "~A: ~A~%" it
+					 (typecase (menu-item-value item)
+					   (menu (format nil "< ~A >" (menu-doc (menu-item-value item))))
+					   (t (documentation (menu-item-value item) 'function))))
+				 (format stream "~A~%" (menu-item-value item))))))
 	     (dolist (item (menu-item base))
 	       (typecase item
 		 (menu (rec item))
@@ -182,12 +184,14 @@
 	       (dolist (item (menu-item base))
 		 (typecase item
 		   (menu (push `(p ,(format nil "~A: ~A" (menu-name item) (menu-doc item))) menu-list))
-		   (menu-item (push `(p ,(format nil "~A: ~A" (menu-item-key item)
-						 (typecase (menu-item-value item)
-						   (menu (format nil "<a href=\"#~A\">< ~A ></a>"
-								 (menu-name (menu-item-value item))
-								 (menu-doc (menu-item-value item))))
-						   (t (documentation (menu-item-value item) 'function)))))
+		   (menu-item (push `(p ,(aif (menu-item-key item)
+					      (format nil "~A: ~A" it
+						      (typecase (menu-item-value item)
+							(menu (format nil "<a href=\"#~A\">< ~A ></a>"
+								      (menu-name (menu-item-value item))
+								      (menu-doc (menu-item-value item))))
+							(t (documentation (menu-item-value item) 'function))))
+					      (format nil "~A" (menu-item-value item))))
 				    menu-list))))
 	       (push '<hr> menu-list)
 	       (dolist (item (menu-item base))

Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp	(original)
+++ clfswm/src/clfswm-layout.lisp	Sun Aug 31 16:30:57 2008
@@ -34,7 +34,8 @@
 ;;;      This method can use the float size of the child (x, y ,w , h).
 ;;;      It can be specialised for xlib:window or frame
 ;;;   2- Define a seter function for your layout
-;;;   3- Register your new layout with register-layout.
+;;;   3- Register your new layout with register-layout or create
+;;;      a sub menu for it with register-layout-sub-menu.
 
 
 
@@ -53,6 +54,12 @@
   (when (frame-p *current-child*)
     (setf (frame-layout *current-child*) layout)))
 
+(defun set-layout-once (layout-name)
+  (set-layout-dont-leave layout-name)
+  (show-all-children *current-root*)
+  (fixe-real-size-current-child)
+  (set-layout-dont-leave #'no-layout))
+
 
 (defun get-managed-child (parent)
   "Return only the windows that are managed for tiling"
@@ -62,20 +69,22 @@
 	       (frame-child parent))))
 
 
+(defun next-layout-key ()
+  (code-char (incf *layout-current-key*)))
 
 
 (defun register-layout (layout)
-  (let ((once-name (intern (format nil "~A-ONCE" layout) :clfswm)))
-    (setf (symbol-function once-name)
-	  (lambda ()
-	    (set-layout-dont-leave (intern (subseq (format nil "~A" layout) 4) :clfswm))
-	    (show-all-children *current-root*)
-	    (fixe-real-size-current-child)
-	    (set-layout-dont-leave #'no-layout)))
-    (setf (documentation once-name 'function) (documentation layout 'function))
-    (add-menu-key 'frame-layout-menu (code-char (incf *layout-current-key*)) layout)
-    (add-menu-key 'frame-layout-once-menu (code-char *layout-current-key*) once-name)))
+  (add-menu-key 'frame-layout-menu (next-layout-key) layout))
+
 
+(defun register-layout-sub-menu (name doc layout-list)
+  (add-sub-menu 'frame-layout-menu (next-layout-key) name doc)
+  (loop :for item :in layout-list
+     :for i :from 0
+     :do (typecase item
+	   (cons (add-menu-key name (first item) (second item)))
+	   (string (add-menu-comment name item))
+	   (t (add-menu-key name (number->char i) item)))))
 
 
 
@@ -95,48 +104,33 @@
   (when (frame-p *current-child*)
     (with-slots (layout) *current-child*
       (let* ((layout-list (frame-data-slot *current-child* :fast-layout))
-	     (first-layout (symbol-function (first layout-list)))
-	     (second-layout (symbol-function (second layout-list))))
+	     (first-layout (ensure-function (first layout-list)))
+	     (second-layout (ensure-function (second layout-list))))
 	(setf layout (if (eql layout first-layout)
 			 second-layout
 			 first-layout))
 	(leave-second-mode)))))
 
-(defun define-fast-layout-switch ()
-  "Define the two fast layouts"
+
+(defun push-in-fast-layout-list ()
+  "Push the current layout in the fast layout list"
   (when (frame-p *current-child*)
-    (labels ((ask-new-layout (msg)
-	       (let* ((new-layout nil)
-		      (menu-list (loop :for item :in (rest (menu-item (find-menu 'frame-layout-menu)))
-				    :for i :from 0
-				    :as fun-name = (intern (subseq (format nil "~A" (menu-item-value item)) 4) :clfswm)
-				    :as fun = (let ((nl fun-name))
-						(lambda () (setf new-layout nl)))
-				    :collect (list (code-char (+ (char-code #\a) i)) fun (documentation fun-name 'function)))))
-		 (push msg menu-list)
-		 (info-mode-menu menu-list)
-		 new-layout)))
-      (let* ((layout-list (frame-data-slot *current-child* :fast-layout))
-	     (first-layout (first layout-list))
-	     (second-layout (second layout-list)))
-	(awhen (ask-new-layout (format nil "Please, choose the first layout (last: ~:(~A~))" first-layout))
-	  (setf first-layout it))
-	(awhen (ask-new-layout (format nil "Please, choose the second layout (last: ~:(~A~))" second-layout))
-	  (setf second-layout it))
-	(setf (frame-data-slot *current-child* :fast-layout)
-	      (list first-layout second-layout))))
+    (setf (frame-data-slot *current-child* :fast-layout)
+	  (list (frame-layout *current-child*)
+		(first (frame-data-slot *current-child* :fast-layout))))
     (leave-second-mode)))
 
 
-(add-sub-menu 'frame-layout-menu #\* 'frame-fast-layout-menu "Frame fast layout menu")
-(add-menu-key 'frame-fast-layout-menu "a" 'fast-layout-switch)
-(add-menu-key 'frame-fast-layout-menu "b" 'define-fast-layout-switch)
+
+(register-layout-sub-menu 'frame-fast-layout-menu "Frame fast layout menu"
+			  '(("s" fast-layout-switch)
+			    ("p" push-in-fast-layout-list)))
 
 
 
 ;;; No layout
 (defgeneric no-layout (child parent)
-  (:documentation "Maximize windows in there frame - leave frame to there size (no layout)"))
+  (:documentation "No layout: Maximize windows in there frame - Leave frame to there size"))
 
 (defmethod no-layout ((child xlib:window) parent)
   (with-slots (rx ry rw rh) parent
@@ -154,7 +148,7 @@
 
 
 (defun set-no-layout ()
-  "Maximize windows in there frame - leave frame to there size (no layout)"
+  "No layout: Maximize windows in there frame - Leave frame to there size"
   (set-layout #'no-layout))
 
 (register-layout 'set-no-layout)
@@ -182,8 +176,6 @@
   "Tile child in its frame (vertical)"
   (set-layout #'tile-layout))
 
-(register-layout 'set-tile-layout)
-
 
 (defgeneric tile-horizontal-layout (child parent)
   (:documentation "Tile child in its frame (horizontal)"))
@@ -201,15 +193,9 @@
 	    (round (- dy 2)))))
 
 (defun set-tile-horizontal-layout ()
-  " Tile child in its frame (horizontal)"
+  "Tile child in its frame (horizontal)"
   (set-layout #'tile-horizontal-layout))
 
-(register-layout 'set-tile-horizontal-layout)
-
-
-
-
-
 ;;; Space layout
 (defun tile-space-layout (child parent)
   "Tile Space: tile child in its frame leaving spaces between them"
@@ -227,12 +213,20 @@
 	      (round (- dx (* dx size 2) 2))
 	      (round (- dy (* dy size 2) 2))))))
 
+
+
+
 (defun set-tile-space-layout ()
   "Tile Space: tile child in its frame leaving spaces between them"
   (layout-ask-size "Space size in percent (%)" :tile-space-size 10)
   (set-layout #'tile-space-layout))
 
-(register-layout 'set-tile-space-layout)
+
+
+(register-layout-sub-menu 'frame-tile-layout-menu "Frame tile layout menu"
+			  '(("v" set-tile-layout)
+			    ("h" set-tile-horizontal-layout)
+			    ("s" set-tile-space-layout)))
 
 
 
@@ -263,8 +257,6 @@
   (layout-ask-size "Tile size in percent (%)" :tile-size)
   (set-layout #'tile-left-layout))
 
-(register-layout 'set-tile-left-layout)
-
 
 
 ;;; Tile right
@@ -290,12 +282,11 @@
 
 
 (defun set-tile-right-layout ()
-  " Tile Right: main child on right and others on left"
+  "Tile Right: main child on right and others on left"
   (layout-ask-size "Tile size in percent (%)" :tile-size)
   (set-layout #'tile-right-layout))
 
 
-(register-layout 'set-tile-right-layout)
 
 
 
@@ -323,11 +314,10 @@
 
 
 (defun set-tile-top-layout ()
-  " Tile Top: main child on top and others on bottom"
+  "Tile Top: main child on top and others on bottom"
   (layout-ask-size "Tile size in percent (%)" :tile-size)
   (set-layout #'tile-top-layout))
 
-(register-layout 'set-tile-top-layout)
 
 
 
@@ -355,13 +345,16 @@
 
 
 (defun set-tile-bottom-layout ()
-  " Tile Bottom: main child on bottom and others on top"
+  "Tile Bottom: main child on bottom and others on top"
   (layout-ask-size "Tile size in percent (%)" :tile-size)
   (set-layout #'tile-bottom-layout))
 
 
-(register-layout 'set-tile-bottom-layout)
-
+(register-layout-sub-menu 'frame-tile-dir-layout-menu "Tile in one direction layout menu"
+			  '(("l" set-tile-left-layout)
+			    ("r" set-tile-right-layout)
+			    ("t" set-tile-top-layout)
+			    ("b" set-tile-bottom-layout)))
 
 
 
@@ -371,7 +364,7 @@
 ;;; Left and space layout: like left layout but leave a space on the left
 (defun layout-ask-space (msg slot &optional (default 100))
   (when (frame-p *current-child*)
-    (let ((new-space (or (query-number msg (frame-data-slot *current-child* slot)) default)))
+    (let ((new-space (or (query-number msg (or (frame-data-slot *current-child* slot) default)) default)))
       (setf (frame-data-slot *current-child* slot) new-space))))
 
 
@@ -408,7 +401,8 @@
   (layout-ask-space "Tile space" :tile-left-space)
   (set-layout #'tile-left-space-layout))
 
-(register-layout 'set-tile-left-space-layout)
+(register-layout-sub-menu 'frame-tile-space-layout-menu "Tile with some space on one side menu"
+			  '(set-tile-left-space-layout))
 
 
 
@@ -442,6 +436,91 @@
   (set-layout #'main-window-right-layout))
 
 
+
+
+(defun main-window-left-layout (child parent)
+  "Main window left: Main windows on the left. Others on the right."
+  (with-slots (rx ry rw rh) parent
+    (let* ((main-windows (frame-data-slot parent :main-window-list))
+	   (len (length main-windows))
+	   (size (or (frame-data-slot parent :tile-size) 0.8)))
+      (if (zerop len)
+	  (no-layout child parent)
+	  (if (member child main-windows)
+	      (let* ((dy (/ rh len))
+		     (pos (position child main-windows)))
+		(values (1+ rx)
+			(1+ (round (+ ry (* dy pos))))
+			(- (round (* rw size)) 2)
+			(- (round dy) 2)))
+	      (values (1+ (round (+ rx (* rw size))))
+		      (1+ ry)
+		      (- (round (* rw (- 1 size))) 2)
+		      (- rh 2)))))))
+	  
+(defun set-main-window-left-layout ()
+  "Main window left: Main windows on the left. Others on the right."
+  (layout-ask-size "Split size in percent (%)" :tile-size)
+  (set-layout #'main-window-left-layout))
+
+
+
+(defun main-window-top-layout (child parent)
+  "Main window top: Main windows on the top. Others on the bottom."
+  (with-slots (rx ry rw rh) parent
+    (let* ((main-windows (frame-data-slot parent :main-window-list))
+	   (len (length main-windows))
+	   (size (or (frame-data-slot parent :tile-size) 0.8)))
+      (if (zerop len)
+	  (no-layout child parent)
+	  (if (member child main-windows)
+	      (let* ((dx (/ rw len))
+		     (pos (position child main-windows)))
+		(values (1+ (round (+ rx (* dx pos))))
+			(1+ ry)
+			(- (round dx) 2)
+			(- (round (* rh size)) 2)))
+	      (values (1+ rx)
+		      (1+ (round (+ ry (* rh size))))
+		      (- rw 2)
+		      (- (round (* rh (- 1 size))) 2)))))))
+	  
+(defun set-main-window-top-layout ()
+  "Main window top: Main windows on the top. Others on the bottom."
+  (layout-ask-size "Split size in percent (%)" :tile-size)
+  (set-layout #'main-window-top-layout))
+
+
+
+(defun main-window-bottom-layout (child parent)
+  "Main window bottom: Main windows on the bottom. Others on the top."
+  (with-slots (rx ry rw rh) parent
+    (let* ((main-windows (frame-data-slot parent :main-window-list))
+	   (len (length main-windows))
+	   (size (or (frame-data-slot parent :tile-size) 0.8)))
+      (if (zerop len)
+	  (no-layout child parent)
+	  (if (member child main-windows)
+	      (let* ((dx (/ rw len))
+		     (pos (position child main-windows)))
+		(values (1+ (round (+ rx (* dx pos))))
+			(1+ (round (+ ry (* rh (- 1 size)))))
+			(- (round dx) 2)
+			(- (round (* rh size)) 2)))
+	      (values (1+ rx)
+		      (1+ ry)
+		      (- rw 2)
+		      (- (round (* rh (- 1 size))) 2)))))))
+	  
+(defun set-main-window-bottom-layout ()
+  "Main window bottom: Main windows on the bottom. Others on the top."
+  (layout-ask-size "Split size in percent (%)" :tile-size)
+  (set-layout #'main-window-bottom-layout))
+
+
+
+
+
 (defun add-in-main-window-list ()
   "Add the current window in the main window list"
   (when (frame-p *current-child*)
@@ -466,16 +545,12 @@
     (setf (frame-data-slot *current-child* :main-window-list) nil))
   (leave-second-mode))
 
-
-(add-sub-menu 'frame-layout-menu (code-char (incf *layout-current-key*))
-	      'frame-main-window-layout-menu "Main window layout menu")
-
-
-(add-menu-key 'frame-main-window-layout-menu "r" 'set-main-window-right-layout)
-(add-menu-key 'frame-main-window-layout-menu "l" 'set-main-window-right-layout)
-(add-menu-key 'frame-main-window-layout-menu "t" 'set-main-window-right-layout)
-(add-menu-key 'frame-main-window-layout-menu "b" 'set-main-window-right-layout)
-(add-menu-comment 'frame-main-window-layout-menu "-=- Actions on main windows list -=-")
-(add-menu-key 'frame-main-window-layout-menu "a" 'add-in-main-window-list)
-(add-menu-key 'frame-main-window-layout-menu "v" 'remove-in-main-window-list)
-(add-menu-key 'frame-main-window-layout-menu "c" 'clear-main-window-list)
+(register-layout-sub-menu 'frame-main-window-layout-menu "Main window layout menu"
+			  '(("r" set-main-window-right-layout)
+			    ("l" set-main-window-left-layout)
+			    ("t" set-main-window-top-layout)
+			    ("b" set-main-window-bottom-layout)
+			    "-=- Actions on main windows list -=-"
+			    ("a" add-in-main-window-list)
+			    ("v" remove-in-main-window-list)
+			    ("c" clear-main-window-list)))

Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp	(original)
+++ clfswm/src/clfswm-nw-hooks.lisp	Sun Aug 31 16:30:57 2008
@@ -134,7 +134,7 @@
     (pushnew window (frame-child new-frame))
     (switch-to-root-frame :show-later t)
     (setf *current-child* *current-root*)
-    (set-tile-space-layout-once)
+    (set-layout-once #'tile-space-layout)
     (setf *current-child* new-frame)
     (default-window-placement new-frame window)))
 

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Sun Aug 31 16:30:57 2008
@@ -73,7 +73,6 @@
 
 (add-sub-menu 'frame-menu "a" 'frame-adding-menu "Adding frame menu")
 (add-sub-menu 'frame-menu "l" 'frame-layout-menu "Frame layout menu")
-(add-sub-menu 'frame-menu "o" 'frame-layout-once-menu "Frame layout menu (Only once)")
 (add-sub-menu 'frame-menu "n" 'frame-nw-hook-menu "Frame new window hook menu")
 (add-sub-menu 'frame-menu "m" 'frame-movement-menu "Frame movement menu")
 (add-sub-menu 'frame-menu "f" 'frame-focus-policy "Frame focus policy menu")

Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp	(original)
+++ clfswm/src/tools.lisp	Sun Aug 31 16:30:57 2008
@@ -37,6 +37,7 @@
 	   :with-all-internal-symbols
 	   :export-all-functions :export-all-variables
 	   :export-all-functions-and-variables
+	   :ensure-function
 	   :empty-string-p
 	   :is-config-p :config-documentation :config-group
 	   :setf/=
@@ -204,6 +205,12 @@
 
 
 
+(defun ensure-function (object)
+  (if (functionp object)
+      object
+      (symbol-function object)))
+
+
 
 
 (defun empty-string-p (string)



More information about the clfswm-cvs mailing list