From pbrochard at common-lisp.net  Thu May  1 15:20:54 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Thu,  1 May 2008 11:20:54 -0400 (EDT)
Subject: [clfswm-cvs] r107 - in clfswm: . doc src
Message-ID: <20080501152054.65D7F2E2CE@common-lisp.net>

Author: pbrochard
Date: Thu May  1 11:20:47 2008
New Revision: 107

Added:
   clfswm/src/menu-def.lisp
Modified:
   clfswm/ChangeLog
   clfswm/clfswm.asd
   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-layout.lisp
   clfswm/src/clfswm-nw-hooks.lisp
   clfswm/src/clfswm.lisp
Log:
menu-def.lisp: New file

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Thu May  1 11:20:47 2008
@@ -1,3 +1,11 @@
+2008-05-01  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/menu-def.lisp: New file: move all menu definition in
+	menu-def.lisp.
+
+	* src/clfswm-layout.lisp (register-layout): Use a function instead
+	of a macro.
+
 2008-04-30  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-autodoc.lisp (produce-menu-doc,

Modified: clfswm/clfswm.asd
==============================================================================
--- clfswm/clfswm.asd	(original)
+++ clfswm/clfswm.asd	Thu May  1 11:20:47 2008
@@ -39,23 +39,25 @@
 			 (:file "clfswm-second-mode"
 			  :depends-on ("package" "clfswm" "clfswm-internal"))
 			 (:file "clfswm-info"
-			  :depends-on ("package" "version" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal"))
+			  :depends-on ("package" "version" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal" "clfswm-autodoc"))
 			 (:file "clfswm-menu"
 			  :depends-on ("package" "clfswm-info"))
+			 (:file "menu-def"
+			  :depends-on ("clfswm-menu"))
 			 (:file "clfswm-util"
-			  :depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode" "clfswm-query" "clfswm-menu"))
+			  :depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode" "clfswm-query" "clfswm-menu" "clfswm-autodoc"))
 			 (:file "clfswm-query"
 			  :depends-on ("package" "config"))
 			 (:file "clfswm-layout"
-			  :depends-on ("package" "clfswm-internal" "clfswm-util" "clfswm-info"))
+			  :depends-on ("package" "clfswm-internal" "clfswm-util" "clfswm-info" "menu-def"))
 			 (:file "clfswm-pack"
 			  :depends-on ("clfswm" "clfswm-util" "clfswm-second-mode"))
 			 (:file "clfswm-nw-hooks"
-			  :depends-on ("package" "clfswm-util" "clfswm-info"))
+			  :depends-on ("package" "clfswm-util" "clfswm-info" "clfswm-layout" "menu-def"))
 			 (:file "bindings"
 			  :depends-on ("clfswm" "clfswm-internal" "clfswm-util"))
 			 (:file "bindings-second-mode"
-			  :depends-on ("clfswm" "clfswm-util" "clfswm-query" "bindings" "clfswm-pack" "clfswm-menu"))))))
+			  :depends-on ("clfswm" "clfswm-util" "clfswm-query" "bindings" "clfswm-pack" "clfswm-menu" "menu-def"))))))
 
 
 

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Thu May  1 11:20:47 2008
@@ -1456,7 +1456,7 @@
           
         </td>
         <td align="center" nowrap>
-          Clfswm  motion
+          Motion
         </td>
         <td style="color:#0000ff" nowrap>
           Grab text

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Thu May  1 11:20:47 2008
@@ -152,5 +152,5 @@
                      2               Leave the info mode
                      4               Move one line up
                      5               Move one line down
-                     Clfswm::motion   Grab text
+                     Motion          Grab text
 

Modified: clfswm/doc/menu.html
==============================================================================
--- clfswm/doc/menu.html	(original)
+++ clfswm/doc/menu.html	Thu May  1 11:20:47 2008
@@ -43,13 +43,13 @@
       a: <a href="#FRAME-ADDING-MENU">< Adding frame menu ></a>
     </p>
     <p>
-      l: < Frame layout menu >
+      l: <a href="#FRAME-LAYOUT-MENU">< Frame layout menu ></a>
     </p>
     <p>
-      o: < Frame layout menu (Set only once) >
+      o: <a href="#FRAME-LAYOUT-ONCE-MENU">< Frame layout menu (Only once) ></a>
     </p>
     <p>
-      n: < Frame new window hook menu >
+      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>
@@ -81,6 +81,78 @@
     </p>
     <hr>
     <h3>
+      <a name="FRAME-LAYOUT-MENU"></a><a href="#FRAME-MENU">Frame-Layout-Menu</a>
+    </h3>
+    <p>
+      a: Maximize windows in there frame - leave frame to there size (no layout)
+    </p>
+    <p>
+      b: Tile child in its frame
+    </p>
+    <p>
+      c: Tile Left: main child on left and others on right
+    </p>
+    <p>
+      d: Tile Right: main child on right and others on left
+    </p>
+    <p>
+      e: Tile Top: main child on top and others on bottom
+    </p>
+    <p>
+      f: Tile Bottom: main child on bottom and others on top
+    </p>
+    <p>
+      g: Tile Space: tile child in its frame leaving spaces between them
+    </p>
+    <hr>
+    <h3>
+      <a name="FRAME-LAYOUT-ONCE-MENU"></a><a href="#FRAME-MENU">Frame-Layout-Once-Menu</a>
+    </h3>
+    <p>
+      a: Maximize windows in there frame - leave frame to there size (no layout)
+    </p>
+    <p>
+      b: Tile child in its frame
+    </p>
+    <p>
+      c: Tile Left: main child on left and others on right
+    </p>
+    <p>
+      d: Tile Right: main child on right and others on left
+    </p>
+    <p>
+      e: Tile Top: main child on top and others on bottom
+    </p>
+    <p>
+      f: Tile Bottom: main child on bottom and others on top
+    </p>
+    <p>
+      g: Tile Space: tile child in its frame leaving spaces between them
+    </p>
+    <hr>
+    <h3>
+      <a name="FRAME-NW-HOOK-MENU"></a><a href="#FRAME-MENU">Frame-Nw-Hook-Menu</a>
+    </h3>
+    <p>
+      a: Open the next window in the current frame
+    </p>
+    <p>
+      b: Open the next window in the current root
+    </p>
+    <p>
+      c: Open the next window in a new frame in the current root
+    </p>
+    <p>
+      d: Open the next window in a new frame in the root frame
+    </p>
+    <p>
+      e: Open the next window in a new frame in the parent frame
+    </p>
+    <p>
+      f: Open the next window in the current frame and leave the focus on the current child
+    </p>
+    <hr>
+    <h3>
       <a name="FRAME-MOVEMENT-MENU"></a><a href="#FRAME-MENU">Frame-Movement-Menu</a>
     </h3>
     <p>

Modified: clfswm/doc/menu.txt
==============================================================================
--- clfswm/doc/menu.txt	(original)
+++ clfswm/doc/menu.txt	Thu May  1 11:20:47 2008
@@ -12,7 +12,7 @@
 Frame-Menu
 a: < Adding frame menu >
 l: < Frame layout menu >
-o: < Frame layout menu (Set only once) >
+o: < Frame layout menu (Only once) >
 n: < Frame new window hook menu >
 m: < Frame movement menu >
 w: < Managed window type menu >
@@ -25,6 +25,32 @@
 a: Add a default frame
 p: Add a placed frame
 
+Frame-Layout-Menu
+a: Maximize windows in there frame - leave frame to there size (no layout)
+b: Tile child in its frame
+c: Tile Left: main child on left and others on right
+d: Tile Right: main child on right and others on left
+e: Tile Top: main child on top and others on bottom
+f: Tile Bottom: main child on bottom and others on top
+g: Tile Space: tile child in its frame leaving spaces between them
+
+Frame-Layout-Once-Menu
+a: Maximize windows in there frame - leave frame to there size (no layout)
+b: Tile child in its frame
+c: Tile Left: main child on left and others on right
+d: Tile Right: main child on right and others on left
+e: Tile Top: main child on top and others on bottom
+f: Tile Bottom: main child on bottom and others on top
+g: Tile Space: tile child in its frame leaving spaces between them
+
+Frame-Nw-Hook-Menu
+a: Open the next window in the current frame
+b: Open the next window in the current root
+c: Open the next window in a new frame in the current root
+d: Open the next window in a new frame in the root frame
+e: Open the next window in a new frame in the parent frame
+f: Open the next window in the current frame and leave the focus on the current child
+
 Frame-Movement-Menu
 p: < Frame pack menu >
 f: < Frame fill menu >

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Thu May  1 11:20:47 2008
@@ -36,148 +36,6 @@
 
 (define-second-key ("F1" :mod-1) 'help-on-second-mode)
 
-;;;;;;;;;;;;;;;;;
-;;;; Menu entry
-;;;;;;;;;;;;;;;;;
-
-;;; Here is a small example of menu manipulation:
-
-;;(add-menu-key 'main "a" 'help-on-second-mode)
-;;(add-menu-key 'main "c" 'help-on-clfswm)
-;;
-;;(add-sub-menu 'main "p" 'plop "A sub menu")
-;;
-;;(add-menu-key 'plop "a" 'help-on-clfswm)
-;;(add-menu-key 'plop "b" 'help-on-second-mode)
-;;(add-menu-key 'plop "d" 'help-on-second-mode)
-
-
-;;(del-menu-key 'main "p")
-;;(del-menu-value 'plop 'help-on-main-mode)
-;;(del-sub-menu 'main 'plop)
-
-;;(define-second-key ("a") 'open-menu)
-
-
-
-(defun frame-layout-menu ()
-  "< Frame layout menu >"
-  (info-mode-menu (keys-from-list *layout-list*)))
-
-(defun frame-layout-once-menu ()
-  "< Frame layout menu (Set only once) >"
-  (info-mode-menu (keys-from-list (loop :for l :in *layout-list*
-				     :collect (create-symbol (format nil "~A" l) "-ONCE")))))
-
-(defun frame-nw-hook-menu ()
-  "< Frame new window hook menu >"
-  (info-mode-menu (keys-from-list *nw-hook-list*)))
-
-
-
-(add-sub-menu 'main "f" 'frame-menu "Frame menu")
-(add-sub-menu 'main "w" 'window-menu "Window menu")
-(add-sub-menu 'main "s" 'selection-menu "Selection menu")
-(add-sub-menu 'main "n" 'action-by-name-menu "Action by name menu")
-(add-sub-menu 'main "u" 'action-by-number-menu "Action by number menu")
-(add-sub-menu 'main "y" 'utility-menu "Utility menu")
-
-
-
-(add-sub-menu 'frame-menu "a" 'frame-adding-menu "Adding frame menu")
-(add-menu-key 'frame-menu "l" 'frame-layout-menu)
-(add-menu-key 'frame-menu "o" 'frame-layout-once-menu)
-(add-menu-key 'frame-menu "n" 'frame-nw-hook-menu)
-(add-sub-menu 'frame-menu "m" 'frame-movement-menu "Frame movement menu")
-(add-sub-menu 'frame-menu "w" 'managed-window-menu "Managed window type menu")
-(add-sub-menu 'frame-menu "i" 'frame-info-menu "Frame info menu")
-(add-menu-key 'frame-menu "r" 'rename-current-child)
-(add-menu-key 'frame-menu "u" 'renumber-current-frame)
-(add-menu-key 'frame-menu "x" 'explode-current-frame)
-
-
-(add-menu-key 'frame-adding-menu "a" 'add-default-frame)
-(add-menu-key 'frame-adding-menu "p" 'add-placed-frame)
-
-
-(add-sub-menu 'frame-movement-menu "p" 'frame-pack-menu "Frame pack menu")
-(add-sub-menu 'frame-movement-menu "f" 'frame-fill-menu "Frame fill menu")
-(add-sub-menu 'frame-movement-menu "r" 'frame-resize-menu "Frame resize menu")
-(add-menu-key 'frame-movement-menu "c" 'center-current-frame)
-
-
-(add-menu-key 'frame-pack-menu "Up" 'current-frame-pack-up)
-(add-menu-key 'frame-pack-menu "Down" 'current-frame-pack-down)
-(add-menu-key 'frame-pack-menu "Left" 'current-frame-pack-left)
-(add-menu-key 'frame-pack-menu "Right" 'current-frame-pack-right)
-
-
-(add-menu-key 'frame-fill-menu "Up" 'current-frame-fill-up)
-(add-menu-key 'frame-fill-menu "Down" 'current-frame-fill-down)
-(add-menu-key 'frame-fill-menu "Left" 'current-frame-fill-left)
-(add-menu-key 'frame-fill-menu "Right" 'current-frame-fill-right)
-(add-menu-key 'frame-fill-menu #\a 'current-frame-fill-all-dir)
-(add-menu-key 'frame-fill-menu #\v 'current-frame-fill-vertical)
-(add-menu-key 'frame-fill-menu #\h 'current-frame-fill-horizontal)
-
-(add-menu-key 'frame-resize-menu "Up" 'current-frame-resize-up)
-(add-menu-key 'frame-resize-menu "Down" 'current-frame-resize-down)
-(add-menu-key 'frame-resize-menu "Left" 'current-frame-resize-left)
-(add-menu-key 'frame-resize-menu "Right" 'current-frame-resize-right)
-(add-menu-key 'frame-resize-menu #\d 'current-frame-resize-all-dir)
-(add-menu-key 'frame-resize-menu #\a 'current-frame-resize-all-dir-minimal)
-
-
-(add-menu-key 'managed-window-menu "m" 'current-frame-manage-window-type)
-(add-menu-key 'managed-window-menu "a" 'current-frame-manage-all-window-type)
-(add-menu-key 'managed-window-menu "n" 'current-frame-manage-only-normal-window-type)
-(add-menu-key 'managed-window-menu "u" 'current-frame-manage-no-window-type)
-
-
-(add-menu-key 'frame-info-menu "s" 'show-all-frames-info)
-(add-menu-key 'frame-info-menu "h" 'hide-all-frames-info)
-
-
-(add-menu-key 'window-menu "i" 'display-current-window-info)
-(add-menu-key 'window-menu "f" 'force-window-in-frame)
-(add-menu-key 'window-menu "c" 'force-window-center-in-frame)
-(add-menu-key 'window-menu "m" 'manage-current-window)
-(add-menu-key 'window-menu "u" 'unmanage-current-window)
-(add-menu-key 'window-menu "a" 'adapt-current-frame-to-window-hints)
-(add-menu-key 'window-menu "w" 'adapt-current-frame-to-window-width-hint)
-(add-menu-key 'window-menu "h" 'adapt-current-frame-to-window-height-hint)
-
-
-
-(add-menu-key 'selection-menu "x" 'cut-current-child)
-(add-menu-key 'selection-menu "c" 'copy-current-child)
-(add-menu-key 'selection-menu "v" 'paste-selection)
-(add-menu-key 'selection-menu "p" 'paste-selection-no-clear)
-(add-menu-key 'selection-menu "Delete" 'remove-current-child)
-(add-menu-key 'selection-menu "z" 'clear-selection)
-
-
-
-(add-menu-key 'action-by-name-menu "f" 'focus-frame-by-name)
-(add-menu-key 'action-by-name-menu "o" 'open-frame-by-name)
-(add-menu-key 'action-by-name-menu "d" 'delete-frame-by-name)
-(add-menu-key 'action-by-name-menu "m" 'move-current-child-by-name)
-(add-menu-key 'action-by-name-menu "c" 'copy-current-child-by-name)
-
-(add-menu-key 'action-by-number-menu "f" 'focus-frame-by-number)
-(add-menu-key 'action-by-number-menu "o" 'open-frame-by-number)
-(add-menu-key 'action-by-number-menu "d" 'delete-frame-by-number)
-(add-menu-key 'action-by-number-menu "m" 'move-current-child-by-number)
-(add-menu-key 'action-by-number-menu "c" 'copy-current-child-by-number)
-
-
-(add-menu-key 'utility-menu "i" 'identify-key)
-(add-menu-key 'utility-menu "colon" 'eval-from-query-string)
-(add-menu-key 'utility-menu "exclam" 'run-program-from-query-string)
-
-
-
-
 (defun open-frame-menu ()
   "Open the frame menu"
   (open-menu (find-menu 'frame-menu)))

Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp	(original)
+++ clfswm/src/clfswm-layout.lisp	Thu May  1 11:20:47 2008
@@ -39,6 +39,8 @@
 
 
 
+(defparameter *layout-current-key* (char-code #\a))
+
 
 ;;; Generic functions
 (defun set-layout (layout)
@@ -63,20 +65,19 @@
 
 
 
-(defmacro register-layout (layout)
-  `(progn
-     (setf *layout-list* (append *layout-list* (list ',layout)))
-     (defun ,(intern (format nil "~A-ONCE" layout)) ()
-       (set-layout-dont-leave #',(intern (subseq (format nil "~A" layout) 4)))
-       (show-all-children *current-root*)
-       (fixe-real-size-current-child)
-       (set-layout-dont-leave #'no-layout))))
-
+(defun register-layout (layout)
+  (let ((once-name (create-symbol (format nil "~A" layout) "-ONCE")))
+    (setf (symbol-function once-name)
+	  (lambda ()
+	    (set-layout-dont-leave (intern (subseq (format nil "~A" layout) 4)))
+	    (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 *layout-current-key*) layout)
+    (add-menu-key 'frame-layout-once-menu (code-char *layout-current-key*) once-name)
+    (incf *layout-current-key*)))
 
-(defun set-layout-once-documentation ()
-  (loop :for l :in *layout-list*
-     :do (setf (documentation (create-symbol (format nil "~A" l) "-ONCE") 'function)
-	       (documentation l 'function))))
 
 
 
@@ -114,7 +115,7 @@
   "Maximize windows in there frame - leave frame to there size (no layout)"
   (set-layout #'no-layout))
 
-(register-layout set-no-layout)
+(register-layout 'set-no-layout)
 
 
 
@@ -140,7 +141,7 @@
   "Tile child in its frame"
   (set-layout #'tile-layout))
 
-(register-layout set-tile-layout)
+(register-layout 'set-tile-layout)
 
 
 ;;; Tile Left
@@ -172,7 +173,7 @@
   (layout-ask-size "Tile size in percent (%)" :tile-size)
   (set-layout #'tile-left-layout))
 
-(register-layout set-tile-left-layout)
+(register-layout 'set-tile-left-layout)
 
 
 
@@ -206,7 +207,7 @@
   (set-layout #'tile-right-layout))
 
 
-(register-layout set-tile-right-layout)
+(register-layout 'set-tile-right-layout)
 
 
 
@@ -240,7 +241,7 @@
   (layout-ask-size "Tile size in percent (%)" :tile-size)
   (set-layout #'tile-top-layout))
 
-(register-layout set-tile-top-layout)
+(register-layout 'set-tile-top-layout)
 
 
 
@@ -275,7 +276,7 @@
   (set-layout #'tile-bottom-layout))
 
 
-(register-layout set-tile-bottom-layout)
+(register-layout 'set-tile-bottom-layout)
 
 
 
@@ -306,4 +307,4 @@
   (layout-ask-size "Space size in percent (%)" :tile-space-size 10)
   (set-layout #'tile-space-layout))
 
-(register-layout set-tile-space-layout)
+(register-layout 'set-tile-space-layout)

Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp	(original)
+++ clfswm/src/clfswm-nw-hooks.lisp	Thu May  1 11:20:47 2008
@@ -37,6 +37,8 @@
 ;;;   3- Register your new hook with register-nw-hook.
 
 
+(defparameter *nw-hook-current-key* (char-code #\a))
+
 
 (defun set-nw-hook (hook)
   "Set the hook of the current child"
@@ -47,7 +49,9 @@
     (leave-second-mode)))
 
 (defun register-nw-hook (hook)
-  (setf *nw-hook-list* (append *nw-hook-list* (list hook))))
+  (setf *nw-hook-list* (append *nw-hook-list* (list hook)))
+  (add-menu-key 'frame-nw-hook-menu (code-char *nw-hook-current-key*) hook)
+  (incf *nw-hook-current-key*))
 
 
 (defun default-window-placement (frame window)

Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp	(original)
+++ clfswm/src/clfswm.lisp	Thu May  1 11:20:47 2008
@@ -213,7 +213,6 @@
 							      :pointer-motion))
   ;;(intern-atoms *display*)
   (netwm-set-properties)
-  (set-layout-once-documentation)
   (xlib:display-force-output *display*)
   (setf *child-selection* nil)
   (setf *root-frame* (create-frame :name "Root" :number 0) ;; :layout #'tile-space-layout)

Added: clfswm/src/menu-def.lisp
==============================================================================
--- (empty file)
+++ clfswm/src/menu-def.lisp	Thu May  1 11:20:47 2008
@@ -0,0 +1,164 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Menu definitions
+;;;
+;;; Note: Mod-1 is the Alt or Meta key, Mod-2 is the Numlock key.
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+;;; Here is a small example of menu manipulation:
+
+;;(add-menu-key 'main "a" 'help-on-second-mode)
+;;(add-menu-key 'main "c" 'help-on-clfswm)
+;;
+;;(add-sub-menu 'main "p" 'plop "A sub menu")
+;;
+;;(add-menu-key 'plop "a" 'help-on-clfswm)
+;;(add-menu-key 'plop "b" 'help-on-second-mode)
+;;(add-menu-key 'plop "d" 'help-on-second-mode)
+
+
+;;(del-menu-key 'main "p")
+;;(del-menu-value 'plop 'help-on-main-mode)
+;;(del-sub-menu 'main 'plop)
+
+;;(define-second-key ("a") 'open-menu)
+
+
+
+;;(defun frame-layout-menu ()
+;;  "< Frame layout menu >"
+;;  (info-mode-menu (keys-from-list *layout-list*)))
+;;
+;;(defun frame-layout-once-menu ()
+;;  "< Frame layout menu (Set only once) >"
+;;  (info-mode-menu (keys-from-list (loop :for l :in *layout-list*
+;;				     :collect (create-symbol (format nil "~A" l) "-ONCE")))))
+;;
+;;(defun frame-nw-hook-menu ()
+;;  "< Frame new window hook menu >"
+;;  (info-mode-menu (keys-from-list *nw-hook-list*)))
+
+
+
+(add-sub-menu 'main "f" 'frame-menu "Frame menu")
+(add-sub-menu 'main "w" 'window-menu "Window menu")
+(add-sub-menu 'main "s" 'selection-menu "Selection menu")
+(add-sub-menu 'main "n" 'action-by-name-menu "Action by name menu")
+(add-sub-menu 'main "u" 'action-by-number-menu "Action by number menu")
+(add-sub-menu 'main "y" 'utility-menu "Utility menu")
+
+
+
+(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 "w" 'managed-window-menu "Managed window type menu")
+(add-sub-menu 'frame-menu "i" 'frame-info-menu "Frame info menu")
+(add-menu-key 'frame-menu "r" 'rename-current-child)
+(add-menu-key 'frame-menu "u" 'renumber-current-frame)
+(add-menu-key 'frame-menu "x" 'explode-current-frame)
+
+
+(add-menu-key 'frame-adding-menu "a" 'add-default-frame)
+(add-menu-key 'frame-adding-menu "p" 'add-placed-frame)
+
+
+(add-sub-menu 'frame-movement-menu "p" 'frame-pack-menu "Frame pack menu")
+(add-sub-menu 'frame-movement-menu "f" 'frame-fill-menu "Frame fill menu")
+(add-sub-menu 'frame-movement-menu "r" 'frame-resize-menu "Frame resize menu")
+(add-menu-key 'frame-movement-menu "c" 'center-current-frame)
+
+
+(add-menu-key 'frame-pack-menu "Up" 'current-frame-pack-up)
+(add-menu-key 'frame-pack-menu "Down" 'current-frame-pack-down)
+(add-menu-key 'frame-pack-menu "Left" 'current-frame-pack-left)
+(add-menu-key 'frame-pack-menu "Right" 'current-frame-pack-right)
+
+
+(add-menu-key 'frame-fill-menu "Up" 'current-frame-fill-up)
+(add-menu-key 'frame-fill-menu "Down" 'current-frame-fill-down)
+(add-menu-key 'frame-fill-menu "Left" 'current-frame-fill-left)
+(add-menu-key 'frame-fill-menu "Right" 'current-frame-fill-right)
+(add-menu-key 'frame-fill-menu #\a 'current-frame-fill-all-dir)
+(add-menu-key 'frame-fill-menu #\v 'current-frame-fill-vertical)
+(add-menu-key 'frame-fill-menu #\h 'current-frame-fill-horizontal)
+
+(add-menu-key 'frame-resize-menu "Up" 'current-frame-resize-up)
+(add-menu-key 'frame-resize-menu "Down" 'current-frame-resize-down)
+(add-menu-key 'frame-resize-menu "Left" 'current-frame-resize-left)
+(add-menu-key 'frame-resize-menu "Right" 'current-frame-resize-right)
+(add-menu-key 'frame-resize-menu #\d 'current-frame-resize-all-dir)
+(add-menu-key 'frame-resize-menu #\a 'current-frame-resize-all-dir-minimal)
+
+
+(add-menu-key 'managed-window-menu "m" 'current-frame-manage-window-type)
+(add-menu-key 'managed-window-menu "a" 'current-frame-manage-all-window-type)
+(add-menu-key 'managed-window-menu "n" 'current-frame-manage-only-normal-window-type)
+(add-menu-key 'managed-window-menu "u" 'current-frame-manage-no-window-type)
+
+
+(add-menu-key 'frame-info-menu "s" 'show-all-frames-info)
+(add-menu-key 'frame-info-menu "h" 'hide-all-frames-info)
+
+
+(add-menu-key 'window-menu "i" 'display-current-window-info)
+(add-menu-key 'window-menu "f" 'force-window-in-frame)
+(add-menu-key 'window-menu "c" 'force-window-center-in-frame)
+(add-menu-key 'window-menu "m" 'manage-current-window)
+(add-menu-key 'window-menu "u" 'unmanage-current-window)
+(add-menu-key 'window-menu "a" 'adapt-current-frame-to-window-hints)
+(add-menu-key 'window-menu "w" 'adapt-current-frame-to-window-width-hint)
+(add-menu-key 'window-menu "h" 'adapt-current-frame-to-window-height-hint)
+
+
+
+(add-menu-key 'selection-menu "x" 'cut-current-child)
+(add-menu-key 'selection-menu "c" 'copy-current-child)
+(add-menu-key 'selection-menu "v" 'paste-selection)
+(add-menu-key 'selection-menu "p" 'paste-selection-no-clear)
+(add-menu-key 'selection-menu "Delete" 'remove-current-child)
+(add-menu-key 'selection-menu "z" 'clear-selection)
+
+
+
+(add-menu-key 'action-by-name-menu "f" 'focus-frame-by-name)
+(add-menu-key 'action-by-name-menu "o" 'open-frame-by-name)
+(add-menu-key 'action-by-name-menu "d" 'delete-frame-by-name)
+(add-menu-key 'action-by-name-menu "m" 'move-current-child-by-name)
+(add-menu-key 'action-by-name-menu "c" 'copy-current-child-by-name)
+
+(add-menu-key 'action-by-number-menu "f" 'focus-frame-by-number)
+(add-menu-key 'action-by-number-menu "o" 'open-frame-by-number)
+(add-menu-key 'action-by-number-menu "d" 'delete-frame-by-number)
+(add-menu-key 'action-by-number-menu "m" 'move-current-child-by-number)
+(add-menu-key 'action-by-number-menu "c" 'copy-current-child-by-number)
+
+
+(add-menu-key 'utility-menu "i" 'identify-key)
+(add-menu-key 'utility-menu "colon" 'eval-from-query-string)
+(add-menu-key 'utility-menu "exclam" 'run-program-from-query-string)
+


From pbrochard at common-lisp.net  Thu May  1 20:16:50 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Thu,  1 May 2008 16:16:50 -0400 (EDT)
Subject: [clfswm-cvs] r108 - in clfswm: . src
Message-ID: <20080501201650.E5FCA7C071@common-lisp.net>

Author: pbrochard
Date: Thu May  1 16:16:48 2008
New Revision: 108

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-internal.lisp
Log:
Add boundaries in the info mode window.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Thu May  1 16:16:48 2008
@@ -1,5 +1,7 @@
 2008-05-01  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-info.lisp (info-mode): Add boundaries in the info mode window.
+
 	* src/menu-def.lisp: New file: move all menu definition in
 	menu-def.lisp.
 

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Thu May  1 16:16:48 2008
@@ -7,12 +7,9 @@
 ===============
 Should handle these soon.
 
-- Produce the autodoc menu for Frame layout menu, Frame layout menu (Set only once)
-  and Frame new window hook menu
-
 - Ensure-unique-number/name (new function) [Philippe]
 
-- Add boundaries in the info window [Philippe]
+- Double buffering for all text windows. [Philippe]
 
 
 MAYBE
@@ -46,8 +43,6 @@
 
 - Undo/redo (any idea to implement this is welcome)
 
-- Double buffering for all text windows.
-
 - Raise/lower frame - this can be done with children order [Philippe]
 
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Thu May  1 16:16:48 2008
@@ -25,7 +25,7 @@
 
 (in-package :clfswm)
 
-(defstruct info window gc font list ilw ilh x y)
+(defstruct info window gc font list ilw ilh x y max-x max-y)
 
 
 (defun leave-info-mode (info)
@@ -94,25 +94,25 @@
 (define-info-key ("Down")
     (defun info-next-line (info)
       "Move one line down"
-      (incf (info-y info) (info-ilh info))
+      (setf (info-y info) (min (+ (info-y info) (info-ilh info)) (info-max-y info)))
       (draw-info-window info)))
 
 (define-info-key ("Up")
     (defun info-previous-line (info)
       "Move one line up"
-      (decf (info-y info) (info-ilh info))
+      (setf (info-y info) (max (- (info-y info) (info-ilh info)) 0))
       (draw-info-window info)))
 
 (define-info-key ("Left")
     (defun info-previous-char (info)
       "Move one char left"
-      (decf (info-x info) (info-ilw info))
+      (setf (info-x info) (max (- (info-x info) (info-ilw info)) 0))
       (draw-info-window info)))
 
 (define-info-key ("Right")
     (defun info-next-char (info)
       "Move one char right"
-      (incf (info-x info) (info-ilw info))
+      (setf (info-x info) (min (+ (info-x info) (info-ilw info)) (info-max-x info)))
       (draw-info-window info)))
 
 
@@ -153,15 +153,15 @@
 (defun info-begin-grab (window root-x root-y info)
   "Begin grab text"
   (declare (ignore window))
-  (setf *info-start-grab-x* (+ root-x (info-x info))
-	*info-start-grab-y* (+ root-y (info-y info)))
+  (setf *info-start-grab-x* (min (max (+ root-x (info-x info)) 0) (info-max-x info))
+	*info-start-grab-y* (min (max (+ root-y (info-y info)) 0) (info-max-y info)))
   (draw-info-window info))
 
 (defun info-end-grab (window root-x root-y info)
   "End grab"
   (declare (ignore window))
-  (setf (info-x info) (- *info-start-grab-x* root-x)
-	(info-y info) (- *info-start-grab-y* root-y)
+  (setf (info-x info) (min (max (- *info-start-grab-x* root-x) 0) (info-max-x info))
+	(info-y info) (min (max (- *info-start-grab-y* root-y) 0) (info-max-y info))
 	*info-start-grab-x* nil
 	*info-start-grab-y* nil)
   (draw-info-window info))
@@ -183,8 +183,8 @@
   "Grab text"
   (declare (ignore window))
   (when (and *info-start-grab-x* *info-start-grab-y*)
-    (setf (info-x info) (- *info-start-grab-x* root-x)
-	  (info-y info) (- *info-start-grab-y* root-y))
+    (setf (info-x info) (min (max (- *info-start-grab-x* root-x) 0) (info-max-x info))
+	  (info-y info) (min (max (- *info-start-grab-y* root-y) 0) (info-max-y info)))
     (draw-info-window-partial info)))
 
 
@@ -229,7 +229,9 @@
 				     :font font
 				     :line-style :solid))
 	   (info (make-info :window window :gc gc :x 0 :y 0 :list info-list
-							    :font font :ilw ilw :ilh ilh)))
+							    :font font :ilw ilw :ilh ilh
+							    :max-x (* (loop for l in info-list maximize (length l)) ilw)
+							    :max-y (* (length info-list) ilh))))
       (labels ((handle-key (&rest event-slots &key root code state &allow-other-keys)
 		 (declare (ignore event-slots root))
 		 (funcall-key-from-code *info-keys* code state info))

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Thu May  1 16:16:48 2008
@@ -363,7 +363,7 @@
 							 (aif (frame-name child) it "")))))))))
 	(dolist (ch child)
 	  (when (xlib:window-p ch)
-	    (xlib:draw-glyphs window gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch)))))))))
+	    (xlib:draw-image-glyphs window gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch)))))))))
 
 
 


From pbrochard at common-lisp.net  Thu May  1 20:40:23 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Thu,  1 May 2008 16:40:23 -0400 (EDT)
Subject: [clfswm-cvs] r109 - clfswm/src
Message-ID: <20080501204023.2B8AD3C0C9@common-lisp.net>

Author: pbrochard
Date: Thu May  1 16:40:22 2008
New Revision: 109

Modified:
   clfswm/src/clfswm-info.lisp
Log:
Info mode: Add boundaries with mouse wheel movement

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Thu May  1 16:40:22 2008
@@ -169,13 +169,13 @@
 (defun info-mouse-next-line (window root-x root-y info)
   "Move one line down"
   (declare (ignore window root-x root-y))
-  (incf (info-y info) (info-ilh info))
+  (setf (info-y info) (min (+ (info-y info) (info-ilh info)) (info-max-y info)))
   (draw-info-window info))
 
 (defun info-mouse-previous-line (window root-x root-y info)
   "Move one line up"
   (declare (ignore window root-x root-y))
-  (decf (info-y info) (info-ilh info))
+  (setf (info-y info) (max (- (info-y info) (info-ilh info)) 0))
   (draw-info-window info))
 
 


From pbrochard at common-lisp.net  Fri May  2 14:13:45 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Fri,  2 May 2008 10:13:45 -0400 (EDT)
Subject: [clfswm-cvs] r110 - in clfswm: . src
Message-ID: <20080502141345.724125204D@common-lisp.net>

Author: pbrochard
Date: Fri May  2 10:13:43 2008
New Revision: 110

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-query.lisp
   clfswm/src/clfswm-second-mode.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/clfswm.lisp
   clfswm/src/package.lisp
   clfswm/src/xlib-util.lisp
Log:
Display all texts with a double buffering method

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Fri May  2 10:13:43 2008
@@ -1,3 +1,17 @@
+2008-05-02  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (identify-key): Use a double buffer to
+	display text.
+
+	* src/clfswm-query.lisp (query-string): Use a double buffer to
+	display text.
+
+	* src/clfswm-info.lisp (draw-info-window): Use a double buffer to
+	display text.
+
+	* src/xlib-util.lisp (clear-pixmap-buffer, copy-pixmap-buffer):
+	New functions.
+
 2008-05-01  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-info.lisp (info-mode): Add boundaries in the info mode window.

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Fri May  2 10:13:43 2008
@@ -9,9 +9,6 @@
 
 - Ensure-unique-number/name (new function) [Philippe]
 
-- Double buffering for all text windows. [Philippe]
-
-
 MAYBE
 =====
 

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Fri May  2 10:13:43 2008
@@ -54,6 +54,9 @@
 
 
 (define-second-key ("m") 'open-menu)
+(define-second-key (#\<) 'open-menu)
+(define-second-key (#\< :control) 'open-menu)
+
 (define-second-key ("f") 'open-frame-menu)
 (define-second-key ("w") 'open-window-menu)
 (define-second-key ("n") 'open-action-by-name-menu)
@@ -73,10 +76,6 @@
 (define-second-key ("Escape") 'leave-second-mode)
 
 
-(define-second-key (#\< :control) 'leave-second-mode)
-
-
-
 
 (define-second-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
 

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Fri May  2 10:13:43 2008
@@ -40,40 +40,17 @@
 
 
 
+
+
 (defun draw-info-window (info)
-  (xlib:clear-area (info-window info))
-  (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-foreground*))
+  (clear-pixmap-buffer (info-window info) (info-gc info))
   (loop for line in (info-list info)
      for y from 0 do
-     (xlib:draw-image-glyphs (info-window info) (info-gc info)
-			     (- (info-ilw info) (info-x info))
-			     (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info))
-			     (format nil "~A" line))))
-
-
-(defun draw-info-window-partial (info)
-  (let ((last-y (info-y info)))
-    (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
-    (xlib:draw-rectangle (info-window info) (info-gc info) 0 0
-			 (xlib:drawable-width (info-window info))
-			 (max (+ (- (info-y info)) (xlib:max-char-ascent (info-font info))) 0) t)
-    (loop for line in (info-list info)
-       for y from 0 do
-       (setf last-y (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info)))
-       (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
-       (xlib:draw-rectangle (info-window info) (info-gc info)
-			    0 (+ last-y (- (info-ilh info)) (xlib:max-char-descent (info-font info)))
-			    (xlib:drawable-width (info-window info)) (info-ilh info) t)
-       (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-foreground*))
-       (xlib:draw-image-glyphs (info-window info) (info-gc info)
-			       (- (info-ilw info) (info-x info))
-			       last-y
-			       (format nil "~A" line)))
-    (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
-    (xlib:draw-rectangle (info-window info) (info-gc info) 0 last-y
-			 (xlib:drawable-width (info-window info))
-			 (xlib:drawable-height (info-window info))
-			 t)))
+     (xlib:draw-glyphs *pixmap-buffer* (info-gc info)
+		       (- (info-ilw info) (info-x info))
+		       (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info))
+		       (format nil "~A" line)))
+  (copy-pixmap-buffer (info-window info) (info-gc info)))
 
 
 ;;;,-----
@@ -185,8 +162,7 @@
   (when (and *info-start-grab-x* *info-start-grab-y*)
     (setf (info-x info) (min (max (- *info-start-grab-x* root-x) 0) (info-max-x info))
 	  (info-y info) (min (max (- *info-start-grab-y* root-y) 0) (info-max-y info)))
-    (draw-info-window-partial info)))
-
+    (draw-info-window info)))
 
 
 

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Fri May  2 10:13:43 2008
@@ -335,37 +335,34 @@
 
 
 
-
-;;; TODO: Double buffering for frame window
 (defun display-frame-info (frame)
   (let ((dy (+ (xlib:max-char-ascent *default-font*) (xlib:max-char-descent *default-font*))))
     (with-slots (name number gc window child) frame
-      (xlib:clear-area window)
+      (clear-pixmap-buffer window gc)
       (setf (xlib:gcontext-foreground gc) (get-color (if (and (equal frame *current-root*)
 							      (equal frame *current-child*))
 							 "Red" "Green")))
-      (xlib:draw-image-glyphs window gc 5 dy		 
-			      (format nil "Frame: ~A~A"
-				      number
-				      (if name  (format nil " - ~A" name) "")))
+      (xlib:draw-glyphs *pixmap-buffer* gc 5 dy		 
+			(format nil "Frame: ~A~A"
+				number
+				(if name  (format nil " - ~A" name) "")))
       (let ((pos dy))
 	(when (equal frame *current-root*)
-	  (xlib:draw-image-glyphs window gc 5 (incf pos dy)
-				  (format nil "~A hidden windows" (length (get-hidden-windows))))
+	  (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy)
+			    (format nil "~A hidden windows" (length (get-hidden-windows))))
 	  (when *child-selection*
-	    (xlib:draw-image-glyphs window gc 5 (incf pos dy)
-				    (with-output-to-string (str)
-				      (format str "Selection: ")
-				      (dolist (child *child-selection*)
-					(typecase child
-					  (xlib:window (format str "~A " (xlib:wm-name child)))
-					  (frame (format str "frame:~A[~A] " (frame-number child)
-							 (aif (frame-name child) it "")))))))))
+	    (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy)
+			      (with-output-to-string (str)
+				(format str "Selection: ")
+				(dolist (child *child-selection*)
+				  (typecase child
+				    (xlib:window (format str "~A " (xlib:wm-name child)))
+				    (frame (format str "frame:~A[~A] " (frame-number child)
+						   (aif (frame-name child) it "")))))))))
 	(dolist (ch child)
 	  (when (xlib:window-p ch)
-	    (xlib:draw-image-glyphs window gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch)))))))))
-
-
+	    (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch))))))
+      (copy-pixmap-buffer window gc))))
 
 
 

Modified: clfswm/src/clfswm-query.lisp
==============================================================================
--- clfswm/src/clfswm-query.lisp	(original)
+++ clfswm/src/clfswm-query.lisp	Fri May  2 10:13:43 2008
@@ -84,13 +84,14 @@
       (labels ((add-cursor (string)
 		 (concatenate 'string (subseq string 0 pos) "|" (subseq string pos)))
 	       (print-string ()
-		 (xlib:clear-area window)
+		 (clear-pixmap-buffer window gc)
 		 (setf (xlib:gcontext-foreground gc) (get-color *query-foreground*))
-		 (xlib:draw-image-glyphs window gc 5 (+ (xlib:max-char-ascent font) 5) msg)
+		 (xlib:draw-glyphs *pixmap-buffer* gc 5 (+ (xlib:max-char-ascent font) 5) msg)
 		 (when (< pos 0) (setf pos 0))
 		 (when (> pos (length result-string)) (setf pos (length result-string)))
-		 (xlib:draw-image-glyphs window gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
-					 (add-cursor (query-show-paren result-string pos))))
+		 (xlib:draw-glyphs *pixmap-buffer* gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
+				   (add-cursor (query-show-paren result-string pos)))
+		 (copy-pixmap-buffer window gc))
 	       (call-backspace (modifiers)
 		 (let ((del-pos (if (member :control modifiers)
 				    (or (position #\Space result-string :from-end t :end pos) 0)

Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp	(original)
+++ clfswm/src/clfswm-second-mode.lisp	Fri May  2 10:13:43 2008
@@ -55,13 +55,14 @@
 
 (defun draw-second-mode-window ()
   (raise-window *sm-window*)
-  (xlib:clear-area *sm-window*)
+  (clear-pixmap-buffer *sm-window* *sm-gc*)
   (let* ((text (format nil "Second mode"))
 	 (len (length text)))
-    (xlib:draw-image-glyphs *sm-window* *sm-gc*
-			    (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2))
-			    (truncate (/ (+ *sm-height* (- (xlib:font-ascent *sm-font*) (xlib:font-descent *sm-font*))) 2))
-			    text)))
+    (xlib:draw-glyphs *pixmap-buffer* *sm-gc*
+		      (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2))
+		      (truncate (/ (+ *sm-height* (- (xlib:font-ascent *sm-font*) (xlib:font-descent *sm-font*))) 2))
+		      text))
+  (copy-pixmap-buffer *sm-window* *sm-gc*))
 
 
 

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Fri May  2 10:13:43 2008
@@ -223,19 +223,20 @@
     (labels ((print-doc (msg hash-table-key pos code state)
 	       (let ((function (find-key-from-code hash-table-key code state)))
 		 (when (and function (fboundp (first function)))
-		   (xlib:draw-image-glyphs window gc 10 (+ (* pos (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
-					   (format nil "~A ~A" msg (documentation (first function) 'function))))))
+		   (xlib:draw-glyphs *pixmap-buffer* gc 10 (+ (* pos (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
+				     (format nil "~A ~A" msg (documentation (first function) 'function))))))
 	     (print-key (code state keysym key modifiers)
-	       (xlib:clear-area window)
+	       (clear-pixmap-buffer window gc)
 	       (setf (xlib:gcontext-foreground gc) (get-color *identify-foreground*))
-	       (xlib:draw-image-glyphs window gc 5 (+ (xlib:max-char-ascent font) 5)
-				       (format nil "Press a key to identify. Press 'q' to stop the identify loop."))
+	       (xlib:draw-glyphs *pixmap-buffer* gc 5 (+ (xlib:max-char-ascent font) 5)
+				 (format nil "Press a key to identify. Press 'q' to stop the identify loop."))
 	       (when code
-		 (xlib:draw-image-glyphs window gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
-					 (format nil "Code=~A  KeySym=~S  Key=~S  Modifiers=~A"
-						 code keysym key modifiers))
+		 (xlib:draw-glyphs *pixmap-buffer* gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
+				   (format nil "Code=~A  KeySym=~S  Key=~S  Modifiers=~A"
+					   code keysym key modifiers))
 		 (print-doc "Main mode  : " *main-keys* 3 code state)
-		 (print-doc "Second mode: " *second-keys* 4 code state)))
+		 (print-doc "Second mode: " *second-keys* 4 code state))
+	       (copy-pixmap-buffer window gc))
 	     (handle-identify-key (&rest event-slots &key root code state &allow-other-keys)
 	       (declare (ignore event-slots root))
 	       (let* ((modifiers (state->modifiers state))
@@ -839,7 +840,7 @@
 (defmacro with-current-window (&body body)
   "Bind 'window' to the current window"
   `(let ((window (get-current-window)))
-      (when window
+      (when (xlib:window-p window)
 	, at body)))
 
 
@@ -848,7 +849,7 @@
 
 ;;; Force window functions
 (defun force-window-in-frame ()
-  "Force the current window to move in the frame (Useful only for transient windows)"
+  "Force the current window to move in the frame (Useful only for unmanaged windows)"
   (with-current-window
     (let ((parent (find-parent-frame window)))
       (with-xlib-protect
@@ -858,7 +859,7 @@
 
 
 (defun force-window-center-in-frame ()
-  "Force the current window to move in the center of the frame (Useful only for transient windows)"
+  "Force the current window to move in the center of the frame (Useful only for unmanaged windows)"
   (with-current-window
     (let ((parent (find-parent-frame window)))
       (with-xlib-protect

Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp	(original)
+++ clfswm/src/clfswm.lisp	Fri May  2 10:13:43 2008
@@ -199,7 +199,11 @@
 					:foreground (get-color *color-unselected*)
 					:background (get-color "Black")
 					:line-style :solid)
-	*default-font* (xlib:open-font *display* *default-font-string*))
+	*default-font* (xlib:open-font *display* *default-font-string*)
+	*pixmap-buffer* (xlib:create-pixmap :width (xlib:screen-width *screen*)
+					    :height (xlib:screen-height *screen*)
+					    :depth (xlib:screen-root-depth *screen*)
+					    :drawable *root*))
   (xgrab-init-pointer)
   (xgrab-init-keyboard)
   (xlib:map-window *no-focus-window*)
@@ -274,6 +278,7 @@
 	 (main-loop))
     (ungrab-main-keys)
     (xlib:destroy-window *no-focus-window*)
+    (xlib:free-pixmap *pixmap-buffer*)
     (xlib:close-display *display*)))
       
 

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Fri May  2 10:13:43 2008
@@ -39,6 +39,8 @@
 (defparameter *no-focus-window* nil)
 (defparameter *root-gc* nil)
 
+(defparameter *pixmap-buffer* nil)
+
 (defparameter *contrib-dir* "")
 
 (defparameter *default-font* nil)

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Fri May  2 10:13:43 2008
@@ -540,7 +540,6 @@
 	(pointer-grabbed-p (xgrab-pointer-p)))
     (labels ((handle-event (&rest event-slots &key event-key &allow-other-keys)
 	       (case event-key
-		 ;;(:motion-notify (apply #'motion-notify event-slots))
 		 (:button-release (setf done t))
 		 (:configure-request (call-hook *configure-request-hook* event-slots))
 		 (:configure-notify (call-hook *configure-notify-hook* event-slots))
@@ -654,3 +653,20 @@
        (dbg i)
        (sleep display-time)
        (xungrab-pointer)))
+
+
+
+
+;;; Double buffering tools
+(defun clear-pixmap-buffer (window gc)
+  (rotatef (xlib:gcontext-foreground gc) (xlib:gcontext-background gc))
+  (xlib:draw-rectangle *pixmap-buffer* gc
+		       0 0 (xlib:drawable-width window) (xlib:drawable-height window)
+		       t)
+  (rotatef (xlib:gcontext-foreground gc) (xlib:gcontext-background gc)))
+
+(defun copy-pixmap-buffer (window gc)
+  (xlib:copy-area *pixmap-buffer* gc
+		  0 0 (xlib:drawable-width window) (xlib:drawable-height window)
+		  window 0 0))
+  


From pbrochard at common-lisp.net  Fri May  2 19:56:10 2008
From: pbrochard at common-lisp.net (pbrochard)
Date: Fri,  2 May 2008 15:56:10 -0400 (EDT)
Subject: [clfswm-cvs] CVS clfswm
Message-ID: <20080502195610.92BA67C04F@common-lisp.net>

Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv1964

Modified Files:
	ChangeLog bindings-pager.lisp bindings-second-mode.lisp 
	bindings.lisp clfswm-info.lisp clfswm-internal.lisp 
	clfswm-keys.lisp clfswm-pack.lisp clfswm-second-mode.lisp 
	clfswm-util.lisp clfswm.asd clfswm.lisp config.lisp 
	dot-clfswmrc keysyms.lisp load.lisp netwm-util.lisp 
	package.lisp tools.lisp xlib-util.lisp 
Log Message:
Revert to the 0801 version. See the SVN or GIT repository for new update

--- /project/clfswm/cvsroot/clfswm/ChangeLog	2008/02/27 22:34:55	1.17
+++ /project/clfswm/cvsroot/clfswm/ChangeLog	2008/05/02 19:56:08	1.18
@@ -1,34 +1,3 @@
-2008-02-27  Philippe Brochard  <hocwp at free.fr>
-
-	* clfswm-layout.lisp (*-layout): Add an optional raise-p
-	parameter in each layout.
-
-2008-02-26  Philippe Brochard  <hocwp at free.fr>
-
-	* clfswm-util.lisp (copy/cut-current-child): Does not affect the
-	root group.
-	(copy/move-current-child-by-name/number): new functions
-	(focus-group-by-name/number): new functions
-	(delete-group-by-name/number): new functions
-
-2008-02-24  Philippe Brochard  <hocwp at free.fr>
-
-	* *: Major update - No more reference  to workspaces. The main
-	structure is a tree of groups or application windows.
-
-2008-02-07  Philippe Brochard  <hocwp at free.fr>
-
-	* clfswm.lisp (read-conf-file): Read configuration in
-	$HOME/.clfswmrc or in /etc/clfswmrc or in
-	$XDG_CONFIG_HOME/clfswm/clfswmrc.
-	(xdg-config-home): Return the content of $XDG-CONFIG-HOME (default
-	to $HOME/.config/).
-
-2008-01-18  Philippe Brochard  <hocwp at free.fr>
-
-	* clfswm-internal.lisp (show-all-group): Use *root* and *root-gc*
-	by default.
-
 2008-01-03  Philippe Brochard  <hocwp at free.fr>
 
 	* clfswm-internal.lisp (find-window-group): New function.
--- /project/clfswm/cvsroot/clfswm/bindings-pager.lisp	2008/02/24 20:53:37	1.9
+++ /project/clfswm/cvsroot/clfswm/bindings-pager.lisp	2008/05/02 19:56:08	1.10
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 12 14:02:07 2008
+;;; #Date#: Fri Jan  4 23:56:09 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse for pager mode
@@ -253,9 +253,9 @@
 (defmacro define-pager-focus-workspace-by-number (key number)
   "Define a pager key to focus a workspace by its number"
   `(define-pager-key ,key
-       (defun ,(create-symbol (format nil "b-pager-focus-workspace-~A" number)) ()
-	 ,(format nil "Focus workspace ~A" number)
-	 (pager-select-workspace-by-number ,number))))
+    (defun ,(create-symbol (format nil "b-pager-focus-workspace-~A" number)) ()
+      ,(format nil "Focus workspace ~A" number)
+      (pager-select-workspace-by-number ,number))))
 
 
 (define-pager-focus-workspace-by-number (#\1 :mod-1) 1)
--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/29 23:05:56	1.16
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/05/02 19:56:08	1.17
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Feb 28 21:38:00 2008
+;;; #Date#: Thu Jan  3 23:13:40 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse for second mode
@@ -34,698 +34,553 @@
 ;;;|
 ;;;| CONFIG - Second mode bindings
 ;;;`-----
+(defun leave-second-mode-maximize ()
+  "Leave second mode and maximize current group"
+  (maximize-group (current-group))
+  (banish-pointer)
+  (show-all-windows-in-workspace (current-workspace))
+  (throw 'exit-second-loop nil))
+
+(defun leave-second-mode ()
+  "Leave second mode"
+  (banish-pointer)
+  (show-all-windows-in-workspace (current-workspace))
+  (throw 'exit-second-loop nil))
 
 
+(define-second-key ("F1" :mod-1) 'help-on-second-mode)
 
-;;;;;;;;;;;;;;;
-;; Menu entry
-;;;;;;;;;;;;;;;
-(defun group-adding-menu ()
-  "Adding group menu"
-  (info-mode-menu '((#\a add-default-group)
-		    (#\p add-placed-group))))
+(define-second-key (#\g :control) 'stop-all-pending-actions)
 
-(defun group-layout-menu ()
-  "Group layout menu"
-  (info-mode-menu (loop for l in *layout-list*
-		     for i from 0
-		     collect (list (code-char (+ (char-code #\a) i)) l))))
+(define-second-key (#\i) 'identify-key)
 
+(define-second-key (#\:) 'eval-from-query-string)
 
-  
 
+(defun run-program-from-query-string ()
+  "Run a program from the query input"
+  (let ((program (query-string "Run:")))
+    (when (and program (not (equal program "")))
+      (setf *second-mode-program* program)
+      (leave-second-mode))))
 
-(defun group-pack-menu ()
-  "Group pack menu"
-  (info-mode-menu '(("Up" group-pack-up)
-		    ("Down" group-pack-down))))
+(define-second-key (#\!) 'run-program-from-query-string)
 
 
-(defun group-movement-menu ()
-  "Group movement menu"
-  (info-mode-menu '((#\p group-pack-menu)
-		    (#\f group-fill-menu)
-		    (#\r group-resize-menu))))
+(define-second-key (#\t) 'leave-second-mode-maximize)
+(define-second-key ("Return") 'leave-second-mode-maximize)
+(define-second-key ("Escape") 'leave-second-mode)
 
 
-(defun group-pack-up ()
-  "Pack group up"
-  (print 'pack-up)
-  (group-movement-menu))
+(define-second-key (#\< :control) 'leave-second-mode)
+(define-second-key ("Return" :control) 'leave-second-mode)
 
-(defun group-pack-down ()
-  "Pack group down"
-  (print 'pack-down)
-  (group-movement-menu))
+;; Escape
+(define-second-key ("Escape" :control :shift) 'delete-current-window)
+(define-second-key ("Escape" :mod-1 :control :shift) 'destroy-current-window)
+(define-second-key ("Escape" :control) 'remove-current-window)
+(define-second-key ("Escape" :shift) 'unhide-all-windows-in-current-group)
 
 
+;; Up
+(define-second-key ("Up" :mod-1) 'circulate-group-up)
+(define-second-key ("Up" :mod-1 :shift) 'circulate-group-up-move-window)
+(define-second-key ("Up" :mod-1 :shift :control) 'circulate-group-up-copy-window)
 
 
+;; Down
+(define-second-key ("Down" :mod-1) 'circulate-group-down)
+(define-second-key ("Down" :mod-1 :shift) 'circulate-group-down-move-window)
+(define-second-key ("Down" :mod-1 :shift :control) 'circulate-group-down-copy-window)
 
 
+;; Right
+(define-second-key ("Right" :mod-1) 'circulate-workspace-up)
+(define-second-key ("Right" :mod-1 :shift) 'circulate-workspace-up-move-group)
+(define-second-key ("Right" :mod-1 :shift :control) 'circulate-workspace-up-copy-group)
 
-(defun action-by-name-menu ()
-  "Actions by name menu"
-  (info-mode-menu '((#\f focus-group-by-name)
-		    (#\o open-group-by-name)
-		    (#\d delete-group-by-name)
-		    (#\m move-current-child-by-name)
-		    (#\c copy-current-child-by-name))))
 
-(defun action-by-number-menu ()
-  "Actions by number menu"
-  (info-mode-menu '((#\f focus-group-by-number)
-		    (#\o open-group-by-number)
-		    (#\d delete-group-by-number)
-		    (#\m move-current-child-by-number)
-		    (#\c copy-current-child-by-number))))
+;; Left
+(define-second-key ("Left" :mod-1) 'circulate-workspace-down)
+(define-second-key ("Left" :mod-1 :shift) 'circulate-workspace-down-move-group)
+(define-second-key ("Left" :mod-1 :shift :control) 'circulate-workspace-down-copy-group)
 
 
-(defun group-menu ()
-  "Group menu"
-  (info-mode-menu '((#\a group-adding-menu)
-		    (#\l group-layout-menu)
-		    (#\m group-movement-menu))))
+(defmacro define-second-focus-workspace-by-number (key number)
+  "Define a second key to focus a workspace by its number"
+  `(define-second-key ,key
+    (defun ,(create-symbol (format nil "b-second-focus-workspace-~A" number)) ()
+      ,(format nil "Focus workspace ~A" number)
+      (circulate-workspace-by-number ,number))))
 
+(define-second-focus-workspace-by-number (#\1 :mod-1) 1)
+(define-second-focus-workspace-by-number (#\2 :mod-1) 2)
+(define-second-focus-workspace-by-number (#\3 :mod-1) 3)
+(define-second-focus-workspace-by-number (#\4 :mod-1) 4)
+(define-second-focus-workspace-by-number (#\5 :mod-1) 5)
+(define-second-focus-workspace-by-number (#\6 :mod-1) 6)
+(define-second-focus-workspace-by-number (#\7 :mod-1) 7)
+(define-second-focus-workspace-by-number (#\8 :mod-1) 8)
+(define-second-focus-workspace-by-number (#\9 :mod-1) 9)
+(define-second-focus-workspace-by-number (#\0 :mod-1) 10)
 
+(define-second-key (#\1 :control :mod-1) 'renumber-workspaces)
+(define-second-key (#\2 :control :mod-1) 'sort-workspaces)
 
-(defun selection-menu ()
-  "Selection menu"
-  (info-mode-menu '((#\x cut-current-child)
-		    (#\c copy-current-child)
-		    (#\v paste-selection)
-		    (#\p paste-selection-no-clear)
-		    ("Delete" remove-current-child)
-		    (#\z clear-selection))))
 
 
-(defun utility-menu ()
-  "Utility menu"
-  (info-mode-menu '((#\i identify-key)
-		    (#\: eval-from-query-string)
-		    (#\! run-program-from-query-string))))
-  
-(defun main-menu ()
-  "Open the main menu"
-  (info-mode-menu '((#\g group-menu)
-		    ;;(#\w window-menu)
-		    (#\s selection-menu)
-		    (#\n action-by-name-menu)
-		    (#\u action-by-number-menu)
-		    (#\y utility-menu))))
 
 
+(define-second-key ("Tab" :mod-1) 'rotate-window-up)
+(define-second-key ("Tab" :mod-1 :shift) 'rotate-window-down)
 
+(define-second-key (#\b) 'banish-pointer)
 
+(define-second-key (#\b :mod-1) 'toggle-maximize-current-group)
 
+(define-second-key (#\x) 'pager-mode)
 
-(define-second-key ("F1" :mod-1) 'help-on-second-mode)
 
-(define-second-key ("m") 'main-menu)
-(define-second-key ("g") 'group-menu)
-(define-second-key ("n") 'action-by-name-menu)
-(define-second-key ("u") 'action-by-number-menu)
+(define-second-key (#\k :mod-1) 'destroy-current-window)
+(define-second-key (#\k) 'remove-current-window)
 
 
-;;(define-second-key (#\g :control) 'stop-all-pending-actions)
+(define-second-key (#\g) 'create-new-default-group)
+(define-second-key (#\g :mod-1) 'remove-current-group)
 
-(define-second-key (#\i) 'identify-key)
-(define-second-key (#\:) 'eval-from-query-string)
+(define-second-key (#\w) 'create-new-default-workspace)
+(define-second-key (#\w :mod-1) 'remove-current-workspace)
 
-(define-second-key (#\!) 'run-program-from-query-string)
+(define-second-key (#\o)
+    (defun b-open-next-window-in-new-workspace ()
+      "Open the next window in a new workspace"
+      (setf *open-next-window-in-new-workspace* t)
+      (leave-second-mode)))
 
+(define-second-key (#\o :control)
+    (defun b-open-next-window-in-workspace-numbered ()
+      "Open the next window in a numbered workspace"
+      (let ((number (parse-integer (or (query-string "Open next window in workspace:") "")
+				   :junk-allowed t)))
+	(when (numberp number)
+	  (setf *open-next-window-in-new-workspace* number)))
+      (leave-second-mode)))
+
+
+(define-second-key (#\o :mod-1)
+    (defun b-open-next-window-in-new-group-once ()
+      "Open the next window in a new group and all others in the same group"
+      (setf *open-next-window-in-new-group* :once)
+      (leave-second-mode)))
+
+(define-second-key (#\o :mod-1 :control)
+    (defun b-open-next-window-in-new-group ()
+      "Open each next window in a new group"
+      (setf *open-next-window-in-new-group* t)
+      (leave-second-mode)))
+
+
+
+(defmacro define-shell (key name docstring cmd)
+  "Define a second key to start a shell command"
+  `(define-second-key ,key
+    (defun ,name ()
+      ,docstring
+      (setf *second-mode-program* ,cmd)
+      (leave-second-mode))))
+
+(define-shell (#\c) b-start-xterm "start an xterm" "exec xterm")
+(define-shell (#\e) b-start-emacs "start emacs" "exec emacs")
+(define-shell (#\e :control) b-start-emacsremote
+  "start an emacs for another user"
+  "exec emacsremote-Eterm")
+(define-shell (#\h) b-start-xclock "start an xclock" "exec xclock -d")
+
+
+(define-second-key (#\a) 'force-window-center-in-group)
+(define-second-key (#\a :mod-1) 'force-window-in-group)
+
+
+(define-second-key (#\d :mod-1)
+    (defun b-show-debuging-info ()
+      "Show debuging info"
+      (dbg *workspace-list*)
+      (dbg *screen*)
+      (dbg (query-tree *root*))))
+
+(define-second-key (#\t :control) 'tile-current-workspace-vertically)
+(define-second-key (#\t :shift :control) 'tile-current-workspace-horizontally)
+
+(define-second-key (#\y) 'tile-current-workspace-to)
+(define-second-key (#\y :mod-1) 'reconfigure-tile-workspace)
+(define-second-key (#\y :control) 'explode-current-group)
+(define-second-key (#\y :control :shift) 'implode-current-group)
+    
+;;;,-----
+;;;| Moving/Resizing groups
+;;;`-----
+(define-second-key (#\p)
+    (defun b-pack-group-on-next-arrow ()
+      "Pack group on next arrow action"
+      (setf *arrow-action* :pack)))
+
+
+(defun fill-group-in-all-directions ()
+  "Fill group in all directions"
+  (fill-current-group-up)
+  (fill-current-group-left)
+  (fill-current-group-right)
+  (fill-current-group-down))
+
+
+(define-second-key (#\f)
+    (defun b-fill-group ()
+      "Fill group on next arrow action (fill in all directions on second f keypress)"
+      (case *arrow-action*
+	(:fill (fill-group-in-all-directions)
+	       (setf *arrow-action* nil))
+	(t (setf *arrow-action* :fill)))))
+
+(define-second-key (#\f :mod-1) 'fill-group-in-all-directions)
+
+(define-second-key (#\f :shift)
+    (defun b-fill-group-vert ()
+      "Fill group vertically"
+      (fill-current-group-up)
+      (fill-current-group-down)))
+
+(define-second-key (#\f :control)
+    (defun b-fill-group-horiz ()
+      "Fill group horizontally"
+      (fill-current-group-left)
+      (fill-current-group-right)))
+
+
+(define-second-key (#\r)
+    (defun b-resize-half ()
+      "Resize group to its half width or heigth on next arraw action"
+      (setf *arrow-action* :resize-half)))
+
+
+(define-second-key (#\l) 'resize-minimal-current-group)
+(define-second-key (#\l :mod-1) 'resize-down-current-group)
+
+
+(define-second-key (#\m) 'center-current-group)
+   
+
+(define-second-key ("Up")
+    (defun b-move-or-pack-up ()
+      "Move, pack, fill or resize group up"
+      (case *arrow-action*
+	(:pack (pack-current-group-up))
+	(:fill (fill-current-group-up))
+	(:resize-half (resize-half-height-up-current-group))
+	(t (move-group (current-group) 0 -10)))
+      (setf *arrow-action* nil)))
+
+(define-second-key ("Down")
+    (defun b-move-or-pack-down ()
+      "Move, pack, fill or resize group down"
+      (case *arrow-action*
+	(:pack (pack-current-group-down))
+	(:fill (fill-current-group-down))
+	(:resize-half (resize-half-height-down-current-group))
+	(t (move-group (current-group) 0 +10)))
+      (setf *arrow-action* nil)))
+
+(define-second-key ("Right")
+    (defun b-move-or-pack-right ()
+      "Move, pack, fill or resize group right"
+      (case *arrow-action*
+	(:pack (pack-current-group-right))
+	(:fill (fill-current-group-right))
+	(:resize-half (resize-half-width-right-current-group))
+	(t (move-group (current-group) +10 0)))
+      (setf *arrow-action* nil)))
+
+(define-second-key ("Left")
+    (defun b-move-or-pack-left ()
+      "Move, pack, fill or resize group left"
+      (case *arrow-action*
+	(:pack (pack-current-group-left))
+	(:fill (fill-current-group-left))
+	(:resize-half (resize-half-width-left-current-group))
+	(t (move-group (current-group) -10 0)))
+      (setf *arrow-action* nil)))
+
+
+(define-second-key ("Up" :shift)
+    (defun b-resize-up ()
+      "Resize group up"
+      (resize-group (current-group) 0 -10)))
+
+(define-second-key ("Down" :shift)
+    (defun b-resize-down ()
+      "Resize group down"
+      (resize-group (current-group) 0 +10)))
+
+(define-second-key ("Right" :shift)
+    (defun b-resize-right ()
+      "Resize group right"
+      (resize-group (current-group) +10 0)))
+
+(define-second-key ("Left" :shift)
+    (defun b-resize-left ()
+      "Resize group left"
+      (resize-group (current-group) -10 0)))
+
+
+;;;,-----
+;;;| Mouse second mode functions
+;;;`-----
+(defun select-group-under-mouse (root-x root-y)
+  (let ((group (find-group-under-mouse root-x root-y)))
+    (when group
+      (no-focus)
+      (focus-group group (current-workspace))

[809 lines skipped]
--- /project/clfswm/cvsroot/clfswm/bindings.lisp	2008/02/24 20:53:37	1.7
+++ /project/clfswm/cvsroot/clfswm/bindings.lisp	2008/05/02 19:56:08	1.8
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sun Feb 24 21:34:48 2008
+;;; #Date#: Thu Jan  3 19:23:24 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse
@@ -33,141 +33,72 @@
 ;;;| CONFIG - Bindings main mode
 ;;;`-----
 
-
 (define-main-key ("F1" :mod-1) 'help-on-clfswm)
 
 (defun quit-clfswm ()
   "Quit clfswm"
-  (throw 'exit-main-loop nil))
+  (throw 'quit-main-loop nil))
+
+
 
 (define-main-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
 
-(define-main-key ("Right" :mod-1) 'select-next-brother)
-(define-main-key ("Left" :mod-1) 'select-previous-brother)
+(define-main-key (#\t :mod-1) 'second-key-mode)
+(define-main-key ("less" :control) 'second-key-mode)
+
+(define-main-key ("Tab" :mod-1) 'rotate-window-up)
+(define-main-key ("Tab" :mod-1 :shift) 'rotate-window-down)
 
-(define-main-key ("Down" :mod-1) 'select-next-level)
-(define-main-key ("Up" :mod-1) 'select-previous-level)
+(define-main-key (#\b :mod-1) 'banish-pointer)
+(define-main-key (#\b :mod-1 :control) 'toggle-maximize-current-group)
 
-(define-main-key ("Tab" :mod-1) 'select-next-child)
-(define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
+;; Escape
+(define-main-key ("Escape" :control :shift) 'delete-current-window)
+(define-main-key ("Escape" :mod-1 :control :shift) 'destroy-current-window)
+(define-main-key ("Escape" :control) 'remove-current-window)
+(define-main-key ("Escape" :shift) 'unhide-all-windows-in-current-group)
 
-(define-main-key ("Return" :mod-1) 'enter-group)
-(define-main-key ("Return" :mod-1 :shift) 'leave-group)
 
-(define-main-key ("Home" :mod-1) 'switch-to-root-group)
-(define-main-key ("Home" :mod-1 :shift) 'switch-and-select-root-group)
+;; Up
+(define-main-key ("Up" :mod-1) 'circulate-group-up)
+(define-main-key ("Up" :mod-1 :shift) 'circulate-group-up-move-window)
+(define-main-key ("Up" :mod-1 :shift :control) 'circulate-group-up-copy-window)
 
-(define-main-key ("Menu") 'toggle-show-root-group)
 
-(define-main-key (#\b :mod-1) 'banish-pointer)
+;; Down
+(define-main-key ("Down" :mod-1) 'circulate-group-down)
+(define-main-key ("Down" :mod-1 :shift) 'circulate-group-down-move-window)
+(define-main-key ("Down" :mod-1 :shift :control) 'circulate-group-down-copy-window)
 
 
-;;;; Escape
-(define-main-key ("Escape" :control :shift) 'delete-focus-window)
-(define-main-key ("Escape" :mod-1 :control :shift) 'destroy-focus-window)
-(define-main-key ("Escape" :control) 'remove-focus-window)
-(define-main-key ("Escape" :shift) 'unhide-all-windows-in-current-child)
+;; Right
+(define-main-key ("Right" :mod-1) 'circulate-workspace-up)
+(define-main-key ("Right" :mod-1 :shift) 'circulate-workspace-up-move-group)
+(define-main-key ("Right" :mod-1 :shift :control) 'circulate-workspace-up-copy-group)
+
+
+;; Left
+(define-main-key ("Left" :mod-1) 'circulate-workspace-down)
+(define-main-key ("Left" :mod-1 :shift) 'circulate-workspace-down-move-group)
+(define-main-key ("Left" :mod-1 :shift :control) 'circulate-workspace-down-copy-group)
 
 
-(define-main-key (#\t :mod-1) 'second-key-mode)
-(define-main-key ("less" :control) 'second-key-mode)
 
+(defmacro define-main-focus-workspace-by-number (key number)
+  "Define a main key to focus a workspace by its number"
+  `(define-main-key ,key
+    (defun ,(create-symbol (format nil "b-main-focus-workspace-~A" number)) ()
+      ,(format nil "Focus workspace ~A" number)
+      (circulate-workspace-by-number ,number))))
 
-;;(define-main-key ("a") (lambda ()
-;;			 (dbg 'key-a)
-;;			 (show-all-childs *root-group*)))
-;;
-;;(define-main-key ("b") (lambda ()
-;;			 (dbg 'key-b)
-;;			   (let* ((window (xlib:create-window :parent *root*
-;;							 :x 300
-;;							 :y 200
-;;							 :width 400
-;;							 :height 300
-;;							 :background (get-color "Black")
-;;							 :colormap (xlib:screen-default-colormap *screen*)
-;;							 :border-width 1
-;;							 :border (get-color "Red")
-;;							 :class :input-output
-;;							 :event-mask '(:exposure)))
-;;				  (gc (xlib:create-gcontext :drawable window
-;;						       :foreground (get-color "Green")
-;;						       :background (get-color "Red")
-;;						       :font *default-font*
-;;						       :line-style :solid)))
-;;			     (xlib:map-window window)
-;;			     (draw-line window gc 10 10 200 200)
-;;			     (xlib:display-finish-output *display*)
-;;			     (xlib:draw-glyphs window gc 10 10 (format nil "~A" 10))
-;;			     (dbg 'ici))))
-;;    
-;;
-;;;;(define-main-key ("F1" :mod-1) 'help-on-clfswm)
-;;;;
-;;(defun quit-clfswm ()
-;;  "Quit clfswm"
-;;  (throw 'exit-main-loop nil))
-;;
-;;
-;;
-;;(define-main-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
-;;
-;;(define-main-key (#\t :mod-1) 'second-key-mode)
-;;(define-main-key ("less" :control) 'second-key-mode)
-;;
-;;(define-main-key ("Tab" :mod-1) 'rotate-window-up)
-;;(define-main-key ("Tab" :mod-1 :shift) 'rotate-window-down)
-;;
-;;(define-main-key (#\b :mod-1) 'banish-pointer)
-;;(define-main-key (#\b :mod-1 :control) 'toggle-maximize-current-group)
-;;
-;;;; Escape
-;;(define-main-key ("Escape" :control :shift) 'delete-current-window)
-;;(define-main-key ("Escape" :mod-1 :control :shift) 'destroy-current-window)
-;;(define-main-key ("Escape" :control) 'remove-current-window)
-;;(define-main-key ("Escape" :shift) 'unhide-all-windows-in-current-group)
-;;
-;;
-;;;; Up
-;;(define-main-key ("Up" :mod-1) 'circulate-group-up)
-;;(define-main-key ("Up" :mod-1 :shift) 'circulate-group-up-move-window)
-;;(define-main-key ("Up" :mod-1 :shift :control) 'circulate-group-up-copy-window)
-;;
-;;
-;;;; Down
-;;(define-main-key ("Down" :mod-1) 'circulate-group-down)
-;;(define-main-key ("Down" :mod-1 :shift) 'circulate-group-down-move-window)
-;;(define-main-key ("Down" :mod-1 :shift :control) 'circulate-group-down-copy-window)
-;;
-;;
-;;;; Right
-;;(define-main-key ("Right" :mod-1) 'circulate-workspace-up)
-;;(define-main-key ("Right" :mod-1 :shift) 'circulate-workspace-up-move-group)
-;;(define-main-key ("Right" :mod-1 :shift :control) 'circulate-workspace-up-copy-group)
-;;
-;;
-;;;; Left
-;;(define-main-key ("Left" :mod-1) 'circulate-workspace-down)
-;;(define-main-key ("Left" :mod-1 :shift) 'circulate-workspace-down-move-group)
-;;(define-main-key ("Left" :mod-1 :shift :control) 'circulate-workspace-down-copy-group)
-;;
-;;
-;;
-;;(defmacro define-main-focus-workspace-by-number (key number)
-;;  "Define a main key to focus a workspace by its number"
-;;  `(define-main-key ,key
-;;    (defun ,(create-symbol (format nil "b-main-focus-workspace-~A" number)) ()
-;;      ,(format nil "Focus workspace ~A" number)
-;;      (circulate-workspace-by-number ,number))))
-;;
-;;(define-main-focus-workspace-by-number (#\1 :mod-1) 1)
-;;(define-main-focus-workspace-by-number (#\2 :mod-1) 2)
-;;(define-main-focus-workspace-by-number (#\3 :mod-1) 3)
-;;(define-main-focus-workspace-by-number (#\4 :mod-1) 4)
-;;(define-main-focus-workspace-by-number (#\5 :mod-1) 5)
-;;(define-main-focus-workspace-by-number (#\6 :mod-1) 6)
-;;(define-main-focus-workspace-by-number (#\7 :mod-1) 7)
-;;(define-main-focus-workspace-by-number (#\8 :mod-1) 8)
-;;(define-main-focus-workspace-by-number (#\9 :mod-1) 9)
-;;(define-main-focus-workspace-by-number (#\0 :mod-1) 10)
+(define-main-focus-workspace-by-number (#\1 :mod-1) 1)
+(define-main-focus-workspace-by-number (#\2 :mod-1) 2)
+(define-main-focus-workspace-by-number (#\3 :mod-1) 3)
+(define-main-focus-workspace-by-number (#\4 :mod-1) 4)
+(define-main-focus-workspace-by-number (#\5 :mod-1) 5)
+(define-main-focus-workspace-by-number (#\6 :mod-1) 6)
+(define-main-focus-workspace-by-number (#\7 :mod-1) 7)
+(define-main-focus-workspace-by-number (#\8 :mod-1) 8)
+(define-main-focus-workspace-by-number (#\9 :mod-1) 9)
+(define-main-focus-workspace-by-number (#\0 :mod-1) 10)
 
--- /project/clfswm/cvsroot/clfswm/clfswm-info.lisp	2008/02/24 20:53:37	1.5
+++ /project/clfswm/cvsroot/clfswm/clfswm-info.lisp	2008/05/02 19:56:08	1.6
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 19 21:43:15 2008
+;;; #Date#: Fri Dec 21 23:00:04 2007
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Info function (see the end of this file for user definition
@@ -33,49 +33,49 @@
 (defun leave-info-mode (info)
   "Leave the info mode"
   (declare (ignore info))
-  (throw 'exit-info-loop nil))
+  (throw 'exit-info nil))
 
 (defun mouse-leave-info-mode (root-x root-y info)
   "Leave the info mode"
   (declare (ignore root-x root-y info))
-  (throw 'exit-info-loop nil))
+  (throw 'exit-info nil))
 
 
 
 (defun draw-info-window (info)
-  (xlib:clear-area (info-window info))
-  (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-foreground*))
+  (clear-area (info-window info))
+  (setf (gcontext-foreground (info-gc info)) (get-color *info-foreground*))
   (loop for line in (info-list info)
-     for y from 0 do
-     (xlib:draw-image-glyphs (info-window info) (info-gc info)
-			     (- (info-ilw info) (info-x info))
-			     (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info))
-			     (format nil "~A" line))))
+	for y from 0 do
+	(draw-image-glyphs (info-window info) (info-gc info)
+			   (- (info-ilw info) (info-x info))
+			   (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info))
+			   (format nil "~A" line))))
 
 
 (defun draw-info-window-partial (info)
   (let ((last-y (info-y info)))
-    (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
-    (xlib:draw-rectangle (info-window info) (info-gc info) 0 0
-			 (xlib:drawable-width (info-window info))
-			 (max (+ (- (info-y info)) (xlib:max-char-ascent (info-font info))) 0) t)
+    (setf (gcontext-foreground (info-gc info)) (get-color *info-background*))
+    (draw-rectangle (info-window info) (info-gc info) 0 0
+		    (drawable-width (info-window info))
+		    (max (+ (- (info-y info)) (max-char-ascent (info-font info))) 0) t)
     (loop for line in (info-list info)
-       for y from 0 do
-       (setf last-y (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info)))
-       (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
-       (xlib:draw-rectangle (info-window info) (info-gc info)
-			    0 (+ last-y (- (info-ilh info)) (xlib:max-char-descent (info-font info)))
-			    (xlib:drawable-width (info-window info)) (info-ilh info) t)
-       (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-foreground*))
-       (xlib:draw-image-glyphs (info-window info) (info-gc info)
-			       (- (info-ilw info) (info-x info))
-			       last-y
-			       (format nil "~A" line)))
-    (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-background*))
-    (xlib:draw-rectangle (info-window info) (info-gc info) 0 last-y
-			 (xlib:drawable-width (info-window info))
-			 (xlib:drawable-height (info-window info))
-			 t)))
+	  for y from 0 do
+	  (setf last-y (- (+ (* (info-ilh info) y) (info-ilh info)) (info-y info)))
+	  (setf (gcontext-foreground (info-gc info)) (get-color *info-background*))
+	  (draw-rectangle (info-window info) (info-gc info)
+			  0 (+ last-y (- (info-ilh info)) (max-char-descent (info-font info)))
+			  (drawable-width (info-window info)) (info-ilh info) t)
+	  (setf (gcontext-foreground (info-gc info)) (get-color *info-foreground*))
+	  (draw-image-glyphs (info-window info) (info-gc info)
+			     (- (info-ilw info) (info-x info))
+			     last-y
+			     (format nil "~A" line)))
+    (setf (gcontext-foreground (info-gc info)) (get-color *info-background*))
+    (draw-rectangle (info-window info) (info-gc info) 0 last-y
+		    (drawable-width (info-window info))
+		    (drawable-height (info-window info))
+		    t)))
 
 
 ;;;,-----
@@ -129,7 +129,7 @@
     (defun info-end-line (info)
       "Move to last line"
       (setf (info-x info) 0
-	    (info-y info) (- (* (length (info-list info)) (info-ilh info)) (xlib:drawable-height (info-window info))))
+	    (info-y info) (- (* (length (info-list info)) (info-ilh info)) (drawable-height (info-window info))))
       (draw-info-window info)))
 
 
@@ -206,35 +206,35 @@
   (when info-list
     (let* ((pointer-grabbed (xgrab-pointer-p))
 	   (keyboard-grabbed (xgrab-keyboard-p))
-	   (font (xlib:open-font *display* *info-font-string*))
-	   (ilw (xlib:max-char-width font))
-	   (ilh (+ (xlib:max-char-ascent font) (xlib:max-char-descent font) 1))
-	   (window (xlib:create-window :parent *root*
-				       :x x :y y
-				       :width (or width
-						  (min (* (+ (loop for l in info-list maximize (length l)) 2) ilw)
-						       (- (xlib:screen-width *screen*) 2 x)))
-				       :height (or height
-						   (min (+ (* (length info-list) ilh) (/ ilh 2))
-							(- (xlib:screen-height *screen*) 2 y)))
-				       :background (get-color *info-background*)
-				       :colormap (xlib:screen-default-colormap *screen*)
-				       :border-width 1
-				       :border (get-color *info-border*)
-				       :event-mask '(:exposure)))
-	   (gc (xlib:create-gcontext :drawable window
-				     :foreground (get-color *info-foreground*)
-				     :background (get-color *info-background*)
-				     :font font
-				     :line-style :solid))
+	   (font (open-font *display* *info-font-string*))
+	   (ilw (max-char-width font))
+	   (ilh (+ (max-char-ascent font) (max-char-descent font) 1))
+	   (window (create-window :parent *root*
+				  :x x :y y
+				  :width (or width
+					     (min (* (+ (loop for l in info-list maximize (length l)) 2) ilw)
+						  (- (screen-width *screen*) 2 x)))
+				  :height (or height
+					      (min (+ (* (length info-list) ilh) (/ ilh 2))
+						   (- (screen-height *screen*) 2 y)))
+				  :background (get-color *info-background*)
+				  :colormap (screen-default-colormap *screen*)
+				  :border-width 1
+				  :border (get-color *info-border*)
+				  :event-mask '(:exposure)))
+	   (gc (create-gcontext :drawable window
+				:foreground (get-color *info-foreground*)
+				:background (get-color *info-background*)
+				:font font
+				:line-style :solid))
 	   (info (make-info :window window :gc gc :x 0 :y 0 :list info-list
-							    :font font :ilw ilw :ilh ilh)))
+			    :font font :ilw ilw :ilh ilh)))
       (labels ((handle-key (&rest event-slots &key root code state &allow-other-keys)
 		 (declare (ignore event-slots root))
 		 (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)
+		 (unless (event-case (*display* :discard-p nil :peek-p t :timeout 0)
 			   (:motion-notify () t))
 		   (funcall-button-from-code *info-mouse-action* 'motion 0 root-x root-y #'first info)))
 	       (handle-button-press (&rest event-slots &key root-x root-y code state &allow-other-keys)
@@ -243,12 +243,18 @@
 	       (handle-button-release (&rest event-slots &key root-x root-y code state &allow-other-keys)
 		 (declare (ignore event-slots))
 		 (funcall-button-from-code *info-mouse-action* code state root-x root-y #'third info))
-	       (info-handle-unmap-notify (&rest event-slots)
-		 (apply #'handle-unmap-notify event-slots)
-		 (draw-info-window info))
-	       (info-handle-destroy-notify (&rest event-slots)
-		 (apply #'handle-destroy-notify event-slots)
-		 (draw-info-window info))
+	       (handle-unmap-notify (&rest event-slots &key send-event-p event-window window &allow-other-keys)
+		 (declare (ignore event-slots))
+		 (unless (and (not send-event-p)
+			      (not (window-equal window event-window)))
+		   (remove-window-in-all-workspace window)
+		   (draw-info-window info)))
+	       (handle-destroy-notify (&rest event-slots &key send-event-p event-window window &allow-other-keys)
+		 (declare (ignore event-slots))
+		 (unless (or send-event-p
+			     (window-equal event-window window))
+		   (remove-window-in-all-workspace window)
+		   (draw-info-window info)))
 	       (handle-events (&rest event-slots &key display event-key &allow-other-keys)
 		 (declare (ignore display))
 		 (case event-key
@@ -257,33 +263,33 @@
 		   (:button-release (apply #'handle-button-release event-slots) t)
 		   (:motion-notify (apply #'handle-motion-notify event-slots) t)
 		   (:map-request nil)
-		   (:unmap-notify (apply #'info-handle-unmap-notify event-slots) t)
-		   (:destroy-notify (apply #'info-handle-destroy-notify event-slots) t)
+		   (:unmap-notify (apply #'handle-unmap-notify event-slots) t)
+		   (:destroy-notify (apply #'handle-destroy-notify event-slots) t)
 		   (:mapping-notify nil)
 		   (:property-notify nil)
 		   (:create-notify nil)
 		   (:enter-notify nil)
 		   (:exposure (draw-info-window info)))
 		 t))
-	(xlib:map-window window)
+	(map-window window)
 	(draw-info-window info)
 	(xgrab-pointer *root* 68 69)
 	(unless keyboard-grabbed
 	  (xgrab-keyboard *root*))
 	(unwind-protect
-	     (catch 'exit-info-loop
+	     (catch 'exit-info
 	       (loop
-		  (xlib:display-finish-output *display*)
-		  (xlib:process-event *display* :handler #'handle-events)))
+		(display-finish-output *display*)
+		(process-event *display* :handler #'handle-events)))
 	  (if pointer-grabbed
 	      (xgrab-pointer *root* 66 67)
 	      (xungrab-pointer))
 	  (unless keyboard-grabbed
 	    (xungrab-keyboard))
-	  (xlib:free-gcontext gc)
-	  (xlib:destroy-window window)
-	  (xlib:close-font font)
-	  (show-all-childs)
+	  (free-gcontext gc)
+	  (destroy-window window)
+	  (close-font font)
+	  (show-all-group (current-workspace))
 	  (wait-no-key-or-button-press))))))
 
 
@@ -305,12 +311,12 @@
 	    (lambda (&optional args)
 	      (declare (ignore args))
 	      (setf action function)
-	      (throw 'exit-info-loop nil)))))
+	      (throw 'exit-info nil)))))
     (info-mode (nreverse info-list) :x x :y y :width width :height height)
     (dolist (item item-list)
       (let ((key (first item)))
 	(undefine-info-key-fun (list key 0))))
-    (when (fboundp action)
+    (when action
       (funcall action))))
 
 
@@ -324,9 +330,9 @@
   "Append spaces before Newline on each line"
   (with-output-to-string (stream)
     (loop for c across string do
-	 (when (equal c #\Newline)
-	   (princ " " stream))
-	 (princ c stream))))
+	  (when (equal c #\Newline)
+	    (princ " " stream))
+	  (princ c stream))))
 
 
 (defun show-key-binding (&rest hash-table-key)
@@ -340,6 +346,7 @@
 (defun show-global-key-binding ()
   "Show all key binding"
   (show-key-binding *main-keys* *second-keys* *mouse-action*
+		    *pager-keys* *pager-mouse-action*
 		    *info-keys* *info-mouse-action*))
 
 (defun show-main-mode-key-binding ()
@@ -351,6 +358,12 @@
   (show-key-binding *second-keys* *mouse-action*))
 
 
+(defun show-pager-key-binding ()
+  "Show the pager mode key binding"
+  (show-key-binding *pager-keys* *pager-mouse-action*))
+
+
+
 (let ((days '("Lundi" "Mardi" "Mercredi" "Jeudi" "Vendredi" "Samedi" "Dimanche"))
       (months '("Janvier" "Fevrier" "Mars" "Avril" "Mai" "Juin" "Juillet"
 		"Aout" "Septembre" "Octobre" "Novembre" "Decembre")))
@@ -367,15 +380,18 @@
   (info-mode (list (date-string))))
 
 
-
+(defun show-date-pager ()
+  "Show the current time and date"
+  (pager-draw-display)
+  (info-mode (list (date-string))))
 
 
 
 (defun info-on-shell (program)
   (let ((lines (do-shell program nil t)))
     (info-mode (loop for line = (read-line lines nil nil)
-		  while line
-		  collect line))))
+		     while line
+		     collect line))))
 
 
 (defun show-cpu-proc ()
@@ -440,5 +456,11 @@
 
 
 
+(defun help-on-pager ()
+  "Open the help and info window"
+  (info-mode-menu '((#\h show-global-key-binding)
+		    (#\b show-pager-key-binding)
+		    (#\t show-date-pager)))
+  (pager-draw-display))
 
 
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/29 23:05:56	1.18
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/05/02 19:56:08	1.19
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sat Mar  1 00:03:14 2008
+;;; #Date#: Thu Jan  3 23:09:04 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -29,7 +29,7 @@
 
 
 ;;; Minimal hook
-(defun call-hook (hook &optional args)
+(defun call-hook (hook args)
   "Call a hook (a function, a symbol or a list of function)"
   (typecase hook
     (list (dolist (h hook)
@@ -37,540 +37,265 @@
     (t (apply hook args))))
 
 
-;;; Group data manipulation functions
-(defun group-data-slot (group slot)
-  "Return the value associated to data slot"
-  (when (group-p group)
-    (second (assoc slot (group-data group)))))
 
-(defun set-group-data-slot (group slot value)
-  "Set the value associated to data slot"
-  (when (group-p group)
-    (with-slots (data) group
-      (setf data (remove (assoc slot data) data))
-      (push (list slot value) data))
-    value))
+;;; CLFSWM internal functions
+(defun create-default-workspace (&optional number)
+  (make-workspace :number (or number (incf *current-workspace-number*))))
+
+
+(defun get-group-size (group)
+  (if (group-fullscreenp group)
+      (destructuring-bind (x y width height) *fullscreen*
+	(values x y width height))
+      (values (group-x group)
+	      (group-y group)
+	      (group-width group)
+	      (group-height group))))
+
+
+(defun select-minimum-workspace ()
+  "Rotate the workspace list until the smallest workspace is selected"
+  (let ((min-number (loop for w in *workspace-list*
+			  minimize (workspace-number w))))
+      (when min-number
+	(loop while (and (workspace-p (first *workspace-list*))
+			 (/= (workspace-number (first *workspace-list*)) min-number))
+	      do (setf *workspace-list* (rotate-list *workspace-list*))))))
+
+
+       
+(defun adapt-window-to-group (window group)
+  (handler-case
+      (when (and window group)
+	(unhide-window window)
+	(multiple-value-bind (x y width height)
+	    (get-group-size group)
+	  (case (window-type window)
+	    (:normal
+	     (setf/= (drawable-x window) x)
+	     (setf/= (drawable-y window) y)
+	     (setf/= (drawable-width window) width)
+	     (setf/= (drawable-height window) height)))))
+    ((or match-error window-error drawable-error) (c)
+      (declare (ignore c)))))
+  ;;(dbg "Adapt error" c))))
 
-(defsetf group-data-slot set-group-data-slot)
 
+  
 
+(defun adapt-all-window-in-group (group)
+  (when group
+    (dolist (window (group-window-list group))
+      (adapt-window-to-group window group))))
 
-(defgeneric group-p (group))
-(defmethod group-p ((group group))
-  (declare (ignore group))
-  t)
-(defmethod group-p (group)
-  (declare (ignore group))
-  nil)
+(defun adapt-all-window-in-workspace (workspace)
+  "Adapt all window to groups in workspace"
+  (dolist (group (workspace-group-list workspace))
+    (adapt-all-window-in-group group)))
 
 
+(defun add-window-in-group (window group)
+  (when (and window group)
+    (pushnew window (group-window-list group))
+    (adapt-window-to-group window group)
+    window))
 
-(defgeneric child-name (child))
+(defun add-group-in-workspace (group workspace)
+  (when group
+    (pushnew group (workspace-group-list workspace))
+    group))
 
-(defmethod child-name ((child xlib:window))
-  (xlib:wm-name child))
 
-(defmethod child-name ((child group))
-  (group-name child))
 
-(defmethod child-name (child)
-  (declare (ignore child))
-  "???")
+(defun add-workspace (workspace)
+  (when workspace
+    (select-minimum-workspace)
+    (setf *workspace-list* (anti-rotate-list (append *workspace-list* (list workspace))))
+    (netwm-update-desktop-property)
+    workspace))
 
 
 
-;; (with-all-childs (*root-group* child) (typecase child (xlib:window (print child)) (group (print (group-number child)))))
-(defmacro with-all-childs ((root child) &body body)
-  (let ((rec (gensym))
-	(sub-child (gensym)))
-    `(labels ((,rec (,child)
-		, at body
-		(when (group-p ,child)
-		  (dolist (,sub-child (group-child ,child))
-		    (,rec ,sub-child)))))
-       (,rec ,root))))
+(defun remove-window-in-group (window group)
+  (setf (group-window-list group)
+	(remove window (group-window-list group))))
 
+(defun remove-window-in-workspace (window workspace)
+  (dolist (group (workspace-group-list workspace))
+    (remove-window-in-group window group)))
 
-;; (with-all-group (*root-group* group) (print (group-number group)))
-(defmacro with-all-groups ((root group) &body body)
-  (let ((rec (gensym))
-	(child (gensym)))
-    `(labels ((,rec (,group)
-		(when (group-p ,group)
-		  , at body
-		  (dolist (,child (group-child ,group))
-		    (,rec ,child)))))
-       (,rec ,root))))
+(defun remove-window-in-all-workspace (window)
+  (dolist (workspace *workspace-list*)
+    (remove-window-in-workspace window workspace))
+  (netwm-remove-in-client-list window))
 
 
-;; (with-all-windows (*root-group* window) (print window))
-(defmacro with-all-windows ((root window) &body body)
-  (let ((rec (gensym))
-	(child (gensym)))
-    `(labels ((,rec (,window)
-		(when (xlib:window-p ,window)
-		  , at body)
-		(when (group-p ,window)
-		  (dolist (,child (group-child ,window))
-		    (,rec ,child)))))
-       (,rec ,root))))
+(defun remove-group-in-workspace (group workspace)
+  (setf (workspace-group-list workspace)
+	(remove group (workspace-group-list workspace))))
 
+(defun remove-group-in-all-workspace (group)
+  (dolist (workspace *workspace-list*)
+    (remove-group-in-workspace group workspace)))
 
+(defun remove-workspace (workspace)
+  (setf *workspace-list* (remove workspace *workspace-list*))
+  (netwm-update-desktop-property))
 
-;; (with-all-groups-windows (*root-group* child) (print child) (print (group-number child)))
-(defmacro with-all-windows-groups ((root child) body-window body-group)
-  (let ((rec (gensym))
-	(sub-child (gensym)))
-    `(labels ((,rec (,child)
-		(typecase ,child
-		  (xlib:window ,body-window)
-		  (group ,body-group
-			 (dolist (,sub-child (group-child ,child))
-			   (,rec ,sub-child))))))
-       (,rec ,root))))
 
+(defun current-workspace ()
+  (if (consp *workspace-list*)
+      (first *workspace-list*)
+      (add-workspace (create-default-workspace))))
 
 
-(defun group-find-free-number ()
-  (let ((all-numbers nil))
-    (with-all-groups (*root-group* group)
-      (push (group-number group) all-numbers))
-    (find-free-number all-numbers)))
+(defun current-group ()
+  (let ((current-workspace (current-workspace)))
+    (when current-workspace
+      (let ((group-list (workspace-group-list current-workspace)))
+	(if (consp group-list)
+	    (first group-list)
+	    (add-group-in-workspace (copy-group *default-group*) current-workspace))))))
 
+(defun current-window ()
+  (let ((current-group (current-group)))
+    (when current-group
+      (let ((window-list (group-window-list current-group)))
+	(when (consp window-list)
+	  (first window-list))))))
 
 
-(defun create-group (&key name (number (group-find-free-number)) (x 0.1) (y 0.1) (w 0.8) (h 0.8) layout)
-  (let* ((window (xlib:create-window :parent *root*
-				     :x 0
-				     :y 0
-				     :width 200
-				     :height 200
-				     :background (get-color "Black")
-				     :colormap (xlib:screen-default-colormap *screen*)
-				     :border-width 1
-				     :border (get-color "Red")
-				     :event-mask '(:exposure :button-press)))
-	 (gc (xlib:create-gcontext :drawable window
-				   :foreground (get-color "Green")
-				   :background (get-color "Black")
-				   :font *default-font*
-				   :line-style :solid)))
-    (make-instance 'group :name name :number number
-		   :x x :y y :w w :h h :window window :gc gc :layout layout)))
 
 
-(defun add-group (group father)
-  (push group (group-child father)))
 
 
+(defun hide-group (root group)
+  (multiple-value-bind (x y width height)
+      (get-group-size group)
+    (clear-area root :x (1- x) :y (1- y) :width (+ width 2) :height (+ height 2))))
 
 
 
+(defun show-group (root gc group)
+  (when (and gc group)
+    (handler-case
+	(multiple-value-bind (x y width height)
+	    (get-group-size group)
+	  (setf (gcontext-foreground gc)
+		(get-color (if (eql group (current-group))
+			       *color-selected*
+			       *color-unselected*)))
+	  (draw-rectangle root gc (1- x) (1- y) (1+ width) (1+ height))
+	  (draw-line root gc x y (+ x width) (+ y height))
+	  (draw-line root gc x (+ y height) (+ x width) y))
+      ((or match-error window-error drawable-error) (c)
+	(declare (ignore c))))))
 
-(defun get-current-child ()
-  "Return the current focused child"
-  (unless (equal *current-child* *root-group*)
-    (typecase *current-child*
-      (xlib:window *current-child*)
-      (group (if (xlib:window-p (first (group-child *current-child*)))
-		 (first (group-child *current-child*))
-		 *current-child*)))))
 
 
-(defun find-child (to-find root)
-  "Find to-find in root or in its childs"
-  (with-all-childs (root child)
-    (when (equal child to-find)
-      (return-from find-child t))))
+(defun show-all-group (workspace &optional (root *root*) (gc *root-gc*) (clear-all :hide-each))
+  "Show all groups in workspace
+clear-all: nil=do not clear; t=clear all root window; :hide-each=clear each group before redrawing"
+  (handler-case
+      (progn
+	(when clear-all
+	  (clear-area root))
+	(dolist (group (reverse (workspace-group-list workspace)))
+	  (when (eql clear-all :hide-each)
+	    (hide-group root group))
+	  (show-group root gc group)))
+    ((or match-error window-error drawable-error) (c)
+      (declare (ignore c)))))
+;;(dbg "Show all group" c))))
 
 
 
-(defun find-father-group (to-find &optional (root *root-group*))
-  "Return the father group of to-find"
-  (with-all-groups (root group)
-    (when (member to-find (group-child group))
-      (return-from find-father-group group))))
 
-  
+(defun hide-all-windows-in-workspace (workspace)
+  "Hide all windows in a workspace"
+  (no-focus)
+  (setf *open-next-window-in-new-workspace* nil)
+  (dolist (group (workspace-group-list workspace))
+    (dolist (window (group-window-list group))
+      (hide-window window))))
 
-(defun find-group-window (window &optional (root *root-group*))
-  "Return the group with the window window"
-  (with-all-groups (root group)
-    (when (xlib:window-equal window (group-window group))
-      (return-from find-group-window group))))
 
+(defun show-all-windows-in-workspace (workspace)
+  "Show all windows in a workspace"
+  (dolist (group (workspace-group-list workspace))
+    (dolist (window (group-window-list group))
+      (unhide-window window)
+      (adapt-window-to-group window group))
+    (raise-window (first (group-window-list group))))
+  (adapt-window-to-group (current-window) (current-group))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
 
-(defun find-group-by-name (name)
-  "Find a group from its name"
-  (when name
-    (with-all-groups (*root-group* group)
-      (when (string-equal name (group-name group))
-	(return-from find-group-by-name group)))))
 
-(defun find-group-by-number (number)
-  "Find a group from its number"
-  (when (numberp number)
-    (with-all-groups (*root-group* group)
-      (when (= number (group-number group))
-	(return-from find-group-by-number group)))))
 
+(defun find-window-group (window workspace)
+  "Find the group where the window window is"
+  (dolist (group (workspace-group-list workspace))
+    (when (member window (group-window-list group))
+      (return-from find-window-group group))))
 
 
+(defun get-all-windows ()
+  "Return a list with all known windows in all workspace"
+  (let ((acc nil))
+    (dolist (workspace *workspace-list*)
+      (dolist (group (workspace-group-list workspace))
+	(dolist (window (group-window-list group))
+	  (pushnew window acc))))
+    (reverse acc)))
 
-(defun get-all-windows (&optional (root *root-group*))
-  "Return all windows in root and in its childs"
+(defun get-all-windows-in-workspace (workspace)
+  "Return a list with all known windows in workspace"
   (let ((acc nil))
-    (with-all-windows (root window)
-      (push window acc))
+    (dolist (group (workspace-group-list workspace))
+      (dolist (window (group-window-list group))
+	(pushnew window acc)))
     acc))
 
 
-(defun get-hidden-windows ()
-  "Return all hiddens windows"
-  (let ((all-windows (get-all-windows))
-	(hidden-windows (remove-if-not #'window-hidden-p
-				       (copy-list (xlib:query-tree *root*)))))
-    (set-difference hidden-windows all-windows)))
-
-
-
-
-(defun display-group-info (group)
-  (let ((dy (+ (xlib:max-char-ascent *default-font*) (xlib:max-char-descent *default-font*))))
-    (with-slots (name number gc window child) group
-      (when (equal group *current-root*)
-	(xlib:clear-area window))
-      (xlib:with-gcontext (gc :foreground (get-color (if (and (equal group *current-root*)
-							      (equal group *current-child*))
-							 "Red" "Green")))
-	(xlib:draw-image-glyphs window gc 5 dy		 
-				(format nil "Group: ~A~A                                                  "

[522 lines skipped]
--- /project/clfswm/cvsroot/clfswm/clfswm-keys.lisp	2008/02/24 20:53:37	1.6
+++ /project/clfswm/cvsroot/clfswm/clfswm-keys.lisp	2008/05/02 19:56:08	1.7
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 12 19:23:14 2008
+;;; #Date#: Thu Jan  3 19:24:00 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Keys functions definition
@@ -47,20 +47,20 @@
 	(undefine-name (create-symbol "undefine-" name "-key"))
 	(undefine-multi-name (create-symbol "undefine-" name "-multi-keys")))
     `(progn
-       (defun ,name-key-fun (key function &optional keystring)
-	 "Define a new key, a key is '(char '(modifier list))"
-	 (setf (gethash key ,hashtable) (list function keystring)))
+      (defun ,name-key-fun (key function &optional keystring)
+	"Define a new key, a key is '(char '(modifier list))"
+	(setf (gethash key ,hashtable) (list function keystring)))
       
-       (defmacro ,name-key ((key &rest modifiers) function &optional keystring)
-	 `(,',name-key-fun (list ,key ,(modifiers->state modifiers)) ,function ,keystring))
+      (defmacro ,name-key ((key &rest modifiers) function &optional keystring)
+	`(,',name-key-fun (list ,key ,(modifiers->state modifiers)) ,function ,keystring))
       
-       (defmacro ,undefine-name ((key &rest modifiers))
-	 `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable))
+      (defmacro ,undefine-name ((key &rest modifiers))
+	`(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable))
 
-       (defmacro ,undefine-multi-name (&rest keys)
-	 `(progn
-	    ,@(loop for k in keys
-		 collect `(,',undefine-name ,k)))))))
+      (defmacro ,undefine-multi-name (&rest keys)
+	`(progn
+	   ,@(loop for k in keys
+		collect `(,',undefine-name ,k)))))))
 
 
 (defmacro define-define-mouse (name hashtable)
@@ -68,15 +68,15 @@
 	(name-mouse (create-symbol "define-" name))
 	(undefine-name (create-symbol "undefine-" name)))
     `(progn
-       (defun ,name-mouse-fun (button function-press &optional keystring function-release)
-	 "Define a new mouse button action, a button is '(button number '(modifier list))"
-	 (setf (gethash button ,hashtable) (list function-press keystring function-release)))
+      (defun ,name-mouse-fun (button function-press &optional keystring function-release)
+	"Define a new mouse button action, a button is '(button number '(modifier list))"
+	(setf (gethash button ,hashtable) (list function-press keystring function-release)))
       
-       (defmacro ,name-mouse ((button &rest modifiers) function-press &optional function-release keystring)
-	 `(,',name-mouse-fun (list ,button ,(modifiers->state modifiers)) ,function-press ,keystring ,function-release))
+      (defmacro ,name-mouse ((button &rest modifiers) function-press &optional function-release keystring)
+	`(,',name-mouse-fun (list ,button ,(modifiers->state modifiers)) ,function-press ,keystring ,function-release))
 
-       (defmacro ,undefine-name ((key &rest modifiers))
-	 `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable)))))
+      (defmacro ,undefine-name ((key &rest modifiers))
+	`(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable)))))
 
 
 
@@ -105,77 +105,27 @@
 
 (defmacro define-ungrab/grab (name function hashtable)
   `(defun ,name ()
-     (maphash #'(lambda (k v)
-		  (declare (ignore v))
-		  (when (consp k)
-		    (handler-case 
-			(let* ((key (first k))
-			       (keycode (typecase key
-					  (character (char->keycode key))
-					  (number key)
-					  (string (let ((keysym (keysym-name->keysym key)))
-						    (and keysym (xlib:keysym->keycodes *display* keysym)))))))
-			  (if keycode
-			      (,function *root* keycode :modifiers (second k))
-			      (format t "~&Grabbing error: Can't find key '~A'~%" key)))
-		      (error (c)
-			;;(declare (ignore c))
-			(format t "~&Grabbing error: Can't grab key '~A' (~A)~%" k c)))
-		    (force-output)))
-	      ,hashtable)))
-
-(define-ungrab/grab grab-main-keys xlib:grab-key *main-keys*)
-(define-ungrab/grab ungrab-main-keys xlib:ungrab-key *main-keys*)
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-(defun funcall-key-from-code (hash-table-key code state &optional args)
-  (labels ((funcall-from (key)
-	     (multiple-value-bind (function foundp)
-		 (gethash (list key state) hash-table-key)
-	       (when (and foundp (first function))
-		 (if args
-		     (funcall (first function) args)
-		     (funcall (first function)))
-		 t)))
-	   (from-code ()
-	     (funcall-from code))
-	   (from-char ()
-	     (let ((char (keycode->char code state)))
-	       (funcall-from char)))
-	   (from-string ()
-	     (let ((string (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
-	       (funcall-from string))))
-    (cond ((from-code))
-	  ((from-char))
-	  ((from-string)))))
-
-
-
-(defun funcall-button-from-code (hash-table-key code state root-x root-y
-				 &optional (action #'first) args)
-  "Action: first=press third=release"
-  (let ((state (modifiers->state (set-difference (state->modifiers state)
-						 '(:button-1 :button-2 :button-3 :button-4 :button-5)))))
-    (multiple-value-bind (function foundp)
-	(gethash (list code state) hash-table-key)
-      (if (and foundp (funcall action function))
-	  (if args
-	      (funcall (funcall action function) root-x root-y args)
-	      (funcall (funcall action function) root-x root-y))
-	  t))))
+    (maphash #'(lambda (k v)
+		 (declare (ignore v))
+		 (when (consp k)
+		   (handler-case 
+		       (let* ((key (first k))
+			      (keycode (typecase key
+					 (character (char->keycode key))
+					 (number key)
+					 (string (let ((keysym (keysym-name->keysym key)))
+						   (and keysym (keysym->keycodes *display* keysym)))))))
+			 (if keycode
+			     (,function *root* keycode :modifiers (second k))
+			     (format t "~&Grabbing error: Can't find key '~A'~%" key)))
+		     (error (c)
+		       ;;(declare (ignore c))
+		       (format t "~&Grabbing error: Can't grab key '~A' (~A)~%" k c)))
+		   (force-output)))
+     ,hashtable)))
 
+(define-ungrab/grab grab-main-keys grab-key *main-keys*)
+(define-ungrab/grab ungrab-main-keys ungrab-key *main-keys*)
 
 
 
@@ -195,8 +145,8 @@
 	   (produce-keys (hk)
 	     `("table class=\"ex\" cellspacing=\"5\" border=\"0\" width=\"100%\""
 	       (tr ("th align=\"right\" width=\"10%\"" "Modifiers")
-		   ("th align=\"center\" width=\"10%\"" "Key/Button")
-		   ("th align=\"left\"" "Function"))
+		("th align=\"center\" width=\"10%\"" "Key/Button")
+		("th align=\"left\"" "Function"))
 	       ,@(let ((acc nil))
 		      (maphash #'(lambda (k v)
 				   (when (consp k)
--- /project/clfswm/cvsroot/clfswm/clfswm-pack.lisp	2008/02/24 20:53:37	1.5
+++ /project/clfswm/cvsroot/clfswm/clfswm-pack.lisp	2008/05/02 19:56:08	1.6
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 12 14:02:45 2008
+;;; #Date#: Fri Dec 28 22:13:42 2007
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Tile, pack and fill functions
@@ -34,14 +34,14 @@
   "Tile a workspace vertically"
   (let* ((len (max (length (workspace-group-list workspace)) 1))
 	 (n (ceiling (sqrt len)))
-	 (dx (/ (xlib:screen-width *screen*) n))
-	 (dy (/ (xlib:screen-height *screen*) (ceiling (/ len n)))))
+	 (dx (/ (screen-width *screen*) n))
+	 (dy (/ (screen-height *screen*) (ceiling (/ len n)))))
     (loop for group in (workspace-group-list workspace)
-       for i from 0 do
-       (setf (group-x group) (1+ (truncate (* (mod i n) dx)))
-	     (group-y group) (1+ (truncate (* (truncate (/ i n)) dy)))
-	     (group-width group) (- (truncate dx) 2)
-	     (group-height group) (- (truncate dy) 2)))))
+	  for i from 0 do
+	  (setf (group-x group) (1+ (truncate (* (mod i n) dx)))
+	  	(group-y group) (1+ (truncate (* (truncate (/ i n)) dy)))
+	  	(group-width group) (- (truncate dx) 2)
+	  	(group-height group) (- (truncate dy) 2)))))
 
 
 (defun tile-current-workspace-vertically ()
@@ -56,14 +56,14 @@
   "Tile a workspace horizontally"
   (let* ((len (max (length (workspace-group-list workspace)) 1))
 	 (n (ceiling (sqrt len)))
-	 (dx (/ (xlib:screen-width *screen*) (ceiling (/ len n))))
-	 (dy (/ (xlib:screen-height *screen*) n)))
+	 (dx (/ (screen-width *screen*) (ceiling (/ len n))))
+	 (dy (/ (screen-height *screen*) n)))
     (loop for group in (workspace-group-list workspace)
-       for i from 0 do
-       (setf (group-x group) (1+ (truncate (* (truncate (/ i n)) dx)))
-	     (group-y group) (1+ (truncate (* (mod i n) dy)))
-	     (group-width group) (- (truncate dx) 2)
-	     (group-height group) (- (truncate dy) 2)))))
+	  for i from 0 do
+	  (setf (group-x group) (1+ (truncate (* (truncate (/ i n)) dx)))
+	  	(group-y group) (1+ (truncate (* (mod i n) dy)))
+	  	(group-width group) (- (truncate dx) 2)
+	  	(group-height group) (- (truncate dy) 2)))))
 
 
 (defun tile-current-workspace-horizontally ()
@@ -80,19 +80,19 @@
     (if (<= len 1)
 	(setf (group-x group) 0
 	      (group-y group) 0
-	      (group-width group) (xlib:screen-width *screen*)
-	      (group-height group) (xlib:screen-height *screen*))
-	(let ((dy (/ (xlib:screen-height *screen*) (1- len))))
+	      (group-width group) (screen-width *screen*)
+	      (group-height group) (screen-height *screen*))
+	(let ((dy (/ (screen-height *screen*) (1- len))))
 	  (setf (group-x group) 1
 		(group-y group) 1
-		(group-width group) (- (xlib:screen-width *screen*) *tile-border-size* 1)
-		(group-height group) (- (xlib:screen-height *screen*) 1))
+		(group-width group) (- (screen-width *screen*) *tile-border-size* 1)
+		(group-height group) (- (screen-height *screen*) 1))
 	  (loop :for i :from 0
-	     :for g :in (rest (workspace-group-list workspace))
-	     :do (setf (group-x g) (- (xlib:screen-width *screen*) *tile-border-size* -1)
-		       (group-y g) (truncate (* i dy))
-		       (group-width g) (- *tile-border-size* 2)
-		       (group-height g) (truncate (- dy 1))))))))
+		:for g :in (rest (workspace-group-list workspace))
+		:do (setf (group-x g) (- (screen-width *screen*) *tile-border-size* -1)
+			  (group-y g) (truncate (* i dy))
+			  (group-width g) (- *tile-border-size* 2)
+			  (group-height g) (truncate (- dy 1))))))))
 
 (defun tile-workspace-left (workspace)
   "Tile workspace with the current window on the right and others on the left"
@@ -101,19 +101,19 @@
     (if (<= len 1)
 	(setf (group-x group) 0
 	      (group-y group) 0
-	      (group-width group) (xlib:screen-width *screen*)
-	      (group-height group) (xlib:screen-height *screen*))
-	(let ((dy (/ (xlib:screen-height *screen*) (1- len))))
+	      (group-width group) (screen-width *screen*)
+	      (group-height group) (screen-height *screen*))
+	(let ((dy (/ (screen-height *screen*) (1- len))))
 	  (setf (group-x group) *tile-border-size*
 		(group-y group) 1
-		(group-width group) (- (xlib:screen-width *screen*) *tile-border-size* 1)
-		(group-height group) (- (xlib:screen-height *screen*) 1))
+		(group-width group) (- (screen-width *screen*) *tile-border-size* 1)
+		(group-height group) (- (screen-height *screen*) 1))
 	  (loop :for i :from 0
-	     :for g :in (rest (workspace-group-list workspace))
-	     :do (setf (group-x g) 0
-		       (group-y g) (truncate (* i dy))
-		       (group-width g) (- *tile-border-size* 2)
-		       (group-height g) (truncate (- dy 1))))))))
+		:for g :in (rest (workspace-group-list workspace))
+		:do (setf (group-x g) 0
+			  (group-y g) (truncate (* i dy))
+			  (group-width g) (- *tile-border-size* 2)
+			  (group-height g) (truncate (- dy 1))))))))
 
 
 (defun tile-workspace-top (workspace)
@@ -123,19 +123,19 @@
     (if (<= len 1)
 	(setf (group-x group) 0
 	      (group-y group) 0
-	      (group-width group) (xlib:screen-width *screen*)
-	      (group-height group) (xlib:screen-height *screen*))
-	(let ((dx (/ (xlib:screen-width *screen*) (1- len))))
+	      (group-width group) (screen-width *screen*)
+	      (group-height group) (screen-height *screen*))
+	(let ((dx (/ (screen-width *screen*) (1- len))))
 	  (setf (group-x group) 1
 		(group-y group) *tile-border-size*
-		(group-width group) (- (xlib:screen-width *screen*) 1)
-		(group-height group) (- (xlib:screen-height *screen*) *tile-border-size* 1))
+		(group-width group) (- (screen-width *screen*) 1)
+		(group-height group) (- (screen-height *screen*) *tile-border-size* 1))
 	  (loop :for i :from 0
-	     :for g :in (rest (workspace-group-list workspace))
-	     :do (setf (group-x g) (truncate (* i dx))
-		       (group-y g) 0
-		       (group-width g) (truncate (- dx 1))
-		       (group-height g) (- *tile-border-size* 2)))))))
+		:for g :in (rest (workspace-group-list workspace))
+		:do (setf (group-x g) (truncate (* i dx))
+			  (group-y g) 0
+			  (group-width g) (truncate (- dx 1))
+			  (group-height g) (- *tile-border-size* 2)))))))
 
 (defun tile-workspace-bottom (workspace)
   "Tile workspace with the current window on the top and others on the bottom"
@@ -144,19 +144,19 @@
     (if (<= len 1)
 	(setf (group-x group) 0
 	      (group-y group) 0
-	      (group-width group) (xlib:screen-width *screen*)
-	      (group-height group) (xlib:screen-height *screen*))
-	(let ((dx (/ (xlib:screen-width *screen*) (1- len))))
+	      (group-width group) (screen-width *screen*)
+	      (group-height group) (screen-height *screen*))
+	(let ((dx (/ (screen-width *screen*) (1- len))))
 	  (setf (group-x group) 1
 		(group-y group) 1
-		(group-width group) (- (xlib:screen-width *screen*) 1)
-		(group-height group) (- (xlib:screen-height *screen*) *tile-border-size* 1))
+		(group-width group) (- (screen-width *screen*) 1)
+		(group-height group) (- (screen-height *screen*) *tile-border-size* 1))
 	  (loop :for i :from 0
-	     :for g :in (rest (workspace-group-list workspace))
-	     :do (setf (group-x g) (truncate (* i dx))
-		       (group-y g) (- (xlib:screen-height *screen*) *tile-border-size* -1)
-		       (group-width g) (truncate (- dx 1))
-		       (group-height g) (- *tile-border-size* 2)))))))
+		:for g :in (rest (workspace-group-list workspace))
+		:do (setf (group-x g) (truncate (* i dx))
+			  (group-y g) (- (screen-height *screen*) *tile-border-size* -1)
+			  (group-width g) (truncate (- dx 1))
+			  (group-height g) (- *tile-border-size* 2)))))))
 
 
 (defun tile-current-workspace-to ()
@@ -170,11 +170,11 @@
   (let ((method (loop :for m = (intern (string-upcase
 					(query-string "Workspace tiling method (R)ight, (L)eft, (T)op, (B)ottom:"))
 				       :keyword)
-		   :when (member m '(:r :l :t :b)) :return m))
+		      :when (member m '(:r :l :t :b)) :return m))
 	(size (loop :for s = (parse-integer (query-string "Workspace tiling border size"
 							  (format nil "~A" *tile-border-size*))
 					    :junk-allowed t)
-		 :when (numberp s) :return s)))
+		    :when (numberp s) :return s)))
     (setf *tile-workspace-function* (case method
 				      (:r 'tile-workspace-right)
 				      (:l 'tile-workspace-left)
@@ -206,7 +206,7 @@
     y-found))
 	     
 (defun find-edge-down (current-group workspace)
-  (let ((y-found (xlib:screen-height *screen*)))
+  (let ((y-found (screen-height *screen*)))
     (dolist (group (workspace-group-list workspace))
       (when (and (not (equal group current-group))
 		 (>= (group-y group) (group-y2 current-group))
@@ -216,7 +216,7 @@
     y-found))
 	     
 (defun find-edge-right (current-group workspace)
-  (let ((x-found (xlib:screen-width *screen*)))
+  (let ((x-found (screen-width *screen*)))
     (dolist (group (workspace-group-list workspace))
       (when (and (not (equal group current-group))
 		 (>= (group-x group) (group-x2 current-group))
@@ -294,8 +294,8 @@
 
 (defun center-group (group)
   "Center group"
-  (setf (group-x group) (truncate (/ (- (xlib:screen-width *screen*) (group-width group)) 2))
-	(group-y group) (truncate (/ (- (xlib:screen-height *screen*) (group-height group)) 2))))
+  (setf (group-x group) (truncate (/ (- (screen-width *screen*) (group-width group)) 2))
+	(group-y group) (truncate (/ (- (screen-height *screen*) (group-height group)) 2))))
 
 (defun center-current-group ()
   "Center the current group"
@@ -375,11 +375,11 @@
 (defun resize-minimal-group (group)
   "Resize down a group to its minimal size"
   (loop while (> (group-width group) 100) do
-       (setf (group-x group) (+ (group-x group) 10)
-	     (group-width group) (max (- (group-width group) 20))))
+	(setf (group-x group) (+ (group-x group) 10)
+	      (group-width group) (max (- (group-width group) 20))))
   (loop while (> (group-height group) 100) do
-       (setf (group-y group) (+ (group-y group) 10)
-	     (group-height group) (max (- (group-height group) 20)))))
+	(setf (group-y group) (+ (group-y group) 10)
+	      (group-height group) (max (- (group-height group) 20)))))
 
 
 
--- /project/clfswm/cvsroot/clfswm/clfswm-second-mode.lisp	2008/02/24 20:53:37	1.11
+++ /project/clfswm/cvsroot/clfswm/clfswm-second-mode.lisp	2008/05/02 19:56:08	1.12
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Fri Feb 22 21:38:53 2008
+;;; #Date#: Thu Jan  3 00:14:39 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Second mode functions
@@ -34,35 +34,24 @@
 (defparameter *second-mode-program* nil
   "Execute the program string if not nil")
 
-
-;;(defun draw-second-mode-window ()
-;;  (xlib:clear-area *sm-window*)
-;;  (let* ((text (format nil "Workspace ~A ~:(~A~) ~A ~A ~A"
-;;		       (workspace-number (current-workspace))
-;;		       (if *arrow-action* *arrow-action* "")
-;;		       (if *motion-action* *motion-action* "")
-;;		       (cond ((numberp *open-next-window-in-new-workspace*)
-;;			      (format nil ">W:~A" *open-next-window-in-new-workspace*))
-;;			     (*open-next-window-in-new-workspace* ">W")
-;;			     (t ""))
-;;		       (cond ((equal *open-next-window-in-new-group* :once) ">G")
-;;			     (*open-next-window-in-new-group* ">G+")
-;;			     (t ""))))
-;;	 (len (length text)))
-;;    (xlib:draw-image-glyphs *sm-window* *sm-gc*
-;;			    (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2))
-;;			    (truncate (/ (+ *sm-height* (- (font-ascent *sm-font*) (font-descent *sm-font*))) 2))
-;;			    text)))
-
-
 (defun draw-second-mode-window ()
-  (xlib:clear-area *sm-window*)
-  (let* ((text (format nil "Second mode"))
+  (clear-area *sm-window*)
+  (let* ((text (format nil "Workspace ~A ~:(~A~) ~A ~A ~A"
+		       (workspace-number (current-workspace))
+		       (if *arrow-action* *arrow-action* "")
+		       (if *motion-action* *motion-action* "")
+		       (cond ((numberp *open-next-window-in-new-workspace*)
+			      (format nil ">W:~A" *open-next-window-in-new-workspace*))
+			     (*open-next-window-in-new-workspace* ">W")
+			     (t ""))
+		       (cond ((equal *open-next-window-in-new-group* :once) ">G")
+			     (*open-next-window-in-new-group* ">G+")
+			     (t ""))))
 	 (len (length text)))
-    (xlib:draw-image-glyphs *sm-window* *sm-gc*
-			    (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2))
-			    (truncate (/ (+ *sm-height* (- (xlib:font-ascent *sm-font*) (xlib:font-descent *sm-font*))) 2))
-			    text)))
+    (draw-image-glyphs *sm-window* *sm-gc*
+		       (truncate (/ (- *sm-width* (* (max-char-width *sm-font*) len)) 2))
+		       (truncate (/ (+ *sm-height* (- (font-ascent *sm-font*) (font-descent *sm-font*))) 2))
+		       text)))
 
 
 
@@ -74,8 +63,8 @@
   (draw-second-mode-window))
 
 (defun sm-handle-enter-notify (&rest event-slots &key root-x root-y &allow-other-keys)
-  (declare (ignore event-slots root-x root-y))
-  ;;  (focus-group-under-mouse root-x root-y)
+  (declare (ignore event-slots))
+  (focus-group-under-mouse root-x root-y)
   (draw-second-mode-window))
 
 (defun sm-handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
@@ -122,7 +111,7 @@
 
 
 ;;(defun sm-handle-property-notify (&rest event-slots &key window &allow-other-keys)
-;;  ;;(dbg (xlib:wm-name window))
+;;  ;;(dbg (wm-name window))
 ;;  (draw-second-mode-window))
 
 
@@ -146,22 +135,24 @@
 (defun sm-handle-event (&rest event-slots &key display event-key &allow-other-keys)
   (declare (ignore display))
   ;;(dbg event-key)
-  (with-xlib-protect
-    (case event-key
-      (:button-press (call-hook *sm-button-press-hook* event-slots))
-      (:button-release (call-hook *sm-button-release-hook* event-slots))
-      (:motion-notify (call-hook *sm-motion-notify-hook* event-slots))
-      (:key-press (call-hook *sm-key-press-hook* event-slots))
-      (:configure-request (call-hook *sm-configure-request-hook* event-slots))
-      (:configure-notify (call-hook *sm-configure-notify-hook* event-slots))
-      (:map-request (call-hook *sm-map-request-hook* event-slots))
-      (:unmap-notify (call-hook *sm-unmap-notify-hook* event-slots))
-      (:destroy-notify (call-hook *sm-destroy-notify-hook* event-slots))
-      (:mapping-notify (call-hook *sm-mapping-notify-hook* event-slots))
-      (:property-notify (call-hook *sm-property-notify-hook* event-slots))
-      (:create-notify (call-hook *sm-create-notify-hook* event-slots))
-      (:enter-notify (call-hook *sm-enter-notify-hook* event-slots))
-      (:exposure (call-hook *sm-exposure-hook* event-slots))))
+  (handler-case
+      (case event-key
+	(:button-press (call-hook *sm-button-press-hook* event-slots))
+	(:button-release (call-hook *sm-button-release-hook* event-slots))
+	(:motion-notify (call-hook *sm-motion-notify-hook* event-slots))
+	(:key-press (call-hook *sm-key-press-hook* event-slots))
+	(:configure-request (call-hook *sm-configure-request-hook* event-slots))
+	(:configure-notify (call-hook *sm-configure-notify-hook* event-slots))
+	(:map-request (call-hook *sm-map-request-hook* event-slots))
+	(:unmap-notify (call-hook *sm-unmap-notify-hook* event-slots))
+	(:destroy-notify (call-hook *sm-destroy-notify-hook* event-slots))
+	(:mapping-notify (call-hook *sm-mapping-notify-hook* event-slots))
+	(:property-notify (call-hook *sm-property-notify-hook* event-slots))
+	(:create-notify (call-hook *sm-create-notify-hook* event-slots))
+	(:enter-notify (call-hook *sm-enter-notify-hook* event-slots))
+	(:exposure (call-hook *sm-exposure-hook* event-slots)))
+    ((or drawable-error window-error) (c)
+      (declare (ignore c))))
   ;;(dbg "Ignore handle event" c event-slots)))
   t)
 
@@ -170,22 +161,23 @@
 (defun second-key-mode ()
   "Switch to editing mode"
   ;;(dbg "Second key ignore" c)))))
-  (setf *sm-window* (xlib:create-window :parent *root*
-					:x (truncate (/ (- (xlib:screen-width *screen*) *sm-width*) 2))
-					:y 0
-					:width *sm-width* :height *sm-height*
-					:background (get-color *sm-background-color*)
-					:border-width 1
-					:border (get-color *sm-border-color*)
-					:colormap (xlib:screen-default-colormap *screen*)
-					:event-mask '(:exposure))
-	*sm-font* (xlib:open-font *display* *sm-font-string*)
-	*sm-gc* (xlib:create-gcontext :drawable *sm-window*
-				      :foreground (get-color *sm-foreground-color*)
-				      :background (get-color *sm-background-color*)
-				      :font *sm-font*
-				      :line-style :solid))
-  (xlib:map-window *sm-window*)
+  (minimize-group (current-group))
+  (setf *sm-window* (create-window :parent *root*
+				   :x (truncate (/ (- (screen-width *screen*) *sm-width*) 2))
+				   :y 0
+				   :width *sm-width* :height *sm-height*
+				   :background (get-color *sm-background-color*)
+				   :border-width 1
+				   :border (get-color *sm-border-color*)
+				   :colormap (screen-default-colormap *screen*)
+				   :event-mask '(:exposure))
+	*sm-font* (open-font *display* *sm-font-string*)
+	*sm-gc* (create-gcontext :drawable *sm-window*
+				 :foreground (get-color *sm-foreground-color*)
+				 :background (get-color *sm-background-color*)
+				 :font *sm-font*
+				 :line-style :solid))
+  (map-window *sm-window*)
   (draw-second-mode-window)
   (no-focus)
   (ungrab-main-keys)
@@ -195,16 +187,18 @@
        (catch 'exit-second-loop
 	 (loop
 	    (raise-window *sm-window*)
-	    (xlib:display-finish-output *display*)
-	    (xlib:process-event *display* :handler #'sm-handle-event)
-	    (xlib:display-finish-output *display*)))
-    (xlib:free-gcontext *sm-gc*)
-    (xlib:close-font *sm-font*)
-    (xlib:destroy-window *sm-window*)
+	    (display-finish-output *display*)
+	    (process-event *display* :handler #'sm-handle-event)
+	    (display-finish-output *display*)))
+    (free-gcontext *sm-gc*)
+    (close-font *sm-font*)
+    (destroy-window *sm-window*)
     (xungrab-keyboard)
     (xungrab-pointer)
-    (grab-main-keys)
-    (show-all-childs))
+    (grab-main-keys))
+  (adapt-window-to-group (current-window) (current-group))
+  (focus-window (current-window))
+  (show-all-group (current-workspace))
   (wait-no-key-or-button-press)
   (when *second-mode-program*
     (do-shell *second-mode-program*)
@@ -212,11 +206,229 @@
 
 
 
-(defun leave-second-mode ()
-  "Leave second mode"
-  (banish-pointer)
-  (throw 'exit-second-loop nil))
-
 
 
 
+;;;;; Alternative - Second mode with dashed screen
+;;(let ((num 5)
+;;      (line-color "Green"))
+;;  (defun draw-second-mode-window (window gc)
+;;    (show-all-windows-in-workspace (current-workspace))
+;;    (sleep 0.1)
+;;    (display-finish-output *display*)
+;;    (raise-window window)
+;;    (setf (gcontext-foreground gc) (get-color line-color)
+;;	  (gcontext-line-style gc) :dash)
+;;    (let ((dx (/ (drawable-width window) num))
+;;	  (dy (/ (drawable-height window) num)))
+;;      (loop for i from 1 below num do
+;;	    (draw-line window gc (truncate (* i dx)) 0 0 (truncate (* i dy)))
+;;	    (draw-line window gc (truncate (* i dx)) (drawable-height window) (drawable-width window) (truncate (* i dy)))
+;;	    (draw-line window gc (truncate (* i dx)) 0 (drawable-width window) (truncate (* (- num i) dy)))
+;;	    (draw-line window gc (truncate (* (- num i) dx)) (drawable-height window) 0 (truncate (* i dy)))))
+;;    (draw-line window gc 0 (drawable-height window) (drawable-width window) 0)
+;;    (draw-line window gc 0 0 (drawable-width window) (drawable-height window))
+;;    (setf (gcontext-line-style gc) :solid)
+;;    (show-all-group (current-workspace) window gc)
+;;    (no-focus)))
+;;
+;;(defmacro with-draw-second-mode-window ((hide show) &body body)
+;;  (cond ((and hide show) `(progn
+;;			   (hide-window sm-window)
+;;			   , at body
+;;			   (draw-second-mode-window sm-window sm-gc)
+;;			   (display-force-output *display*)))
+;;	(hide `(progn
+;;		(hide-window sm-window)
+;;		, at body
+;;		(display-force-output *display*)))
+;;	(show `(progn
+;;		, at body
+;;		(draw-second-mode-window sm-window sm-gc)
+;;		(display-force-output *display*)))
+;;	(t `(progn
+;;	     , at body
+;;	     (display-force-output *display*)))))
+;;
+;;
+;;(defun second-key-mode ()
+;;  "Switch to editing mode"
+;;  (let* ((sm-window (create-window :parent *root* :x 0 :y 0
+;;				   :width (screen-width *screen*) :height (screen-height *screen*)
+;;				   :colormap (screen-default-colormap *screen*)
+;;				   :event-mask '()))
+;;	 (sm-gc (create-gcontext :drawable sm-window
+;;				 :foreground (get-color "Red")
+;;				 :background (get-color "Black")
+;;				 :line-style :solid)))
+;;    (labels ((handle-key-press (&rest event-slots &key root code state &allow-other-keys)
+;;	       (declare (ignore event-slots root))
+;;	       (funcall-key-from-code *second-keys* code state))
+;;	     (sm-handle-enter-notify (&rest event-slots &key window root-x root-y &allow-other-keys)
+;;	       (declare (ignore event-slots))
+;;	       (unless (or (window-equal sm-window window)
+;;			   (window-equal window *root*))
+;;		 (with-draw-second-mode-window (t t)
+;;		   (focus-group-under-mouse root-x root-y))))
+;;	     (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+;;	       (declare (ignore event-slots))
+;;	       (unless (event-case (*display* :discard-p nil :peek-p t :timeout 0)
+;;			 (:motion-notify () t))
+;;		 (funcall-button-from-code *mouse-action* 'motion 0 root-x root-y #'first)
+;;		 (show-all-group (current-workspace) sm-window sm-gc)
+;;		 (no-focus)))
+;;	     (handle-button-press (&rest event-slots &key root-x root-y code state &allow-other-keys)
+;;	       (declare (ignore event-slots))
+;;	       (funcall-button-from-code *mouse-action* code state root-x root-y #'first))
+;;	     (handle-button-release (&rest event-slots &key root-x root-y code state &allow-other-keys)
+;;	       (declare (ignore event-slots))
+;;	       (funcall-button-from-code *mouse-action* code state root-x root-y #'third))
+;;	     (sm-handle-configure-request (&rest event-slots &key window &allow-other-keys)
+;;	       (unless (window-equal sm-window window)
+;;		 (with-draw-second-mode-window (t t)
+;;		   (apply #'handle-configure-request event-slots))))
+;;	     (sm-handle-map-request (&rest event-slots &key window &allow-other-keys)
+;;	       (unless (window-equal sm-window window)
+;;		 (with-draw-second-mode-window (t t)
+;;		   (apply #'handle-map-request event-slots))))
+;;	     (sm-handle-unmap-notify (&rest event-slots &key window &allow-other-keys)
+;;	       (unless (window-equal sm-window window)
+;;		 (with-draw-second-mode-window (t t)
+;;		   (apply #'handle-unmap-notify event-slots))))
+;;	     (sm-handle-destroy-notify (&rest event-slots &key window &allow-other-keys)
+;;	       (unless (window-equal sm-window window)
+;;		 (with-draw-second-mode-window (t t)
+;;		   (apply #'handle-destroy-notify event-slots))))
+;;	     (handle-event (&rest event-slots &key display event-key &allow-other-keys)
+;;	       (declare (ignore display))
+;;	       (handler-case 
+;;		   (case event-key
+;;		     (:key-press (with-draw-second-mode-window (t t)
+;;				   (apply #'handle-key-press event-slots)))
+;;		     (:enter-notify nil)
+;;		     (:motion-notify (apply #'handle-motion-notify event-slots))
+;;		     (:button-press (with-draw-second-mode-window (t nil)
+;;				      (apply #'handle-button-press event-slots)))
+;;		     (:button-release (with-draw-second-mode-window (nil t)
+;;					(apply #'handle-button-release event-slots)))
+;;		     (:configure-request (apply #'sm-handle-configure-request event-slots))
+;;		     (:map-request (apply #'sm-handle-map-request event-slots))
+;;		     (:unmap-notify (apply #'sm-handle-unmap-notify event-slots))
+;;		     (:destroy-notify (apply #'sm-handle-destroy-notify event-slots))
+;;		     (:mapping-notify nil)
+;;		     (:property-notify nil)
+;;		     (:create-notify nil))
+;;		 ((or drawable-error window-error) (c)
+;;		   (declare (ignore c))))
+;;	       t))
+;;      ;;(dbg "Second key ignore" c)))))
+;;      (minimize-group (current-group))
+;;      (map-window sm-window)
+;;      (raise-window sm-window)
+;;      (draw-second-mode-window sm-window sm-gc)
+;;      (no-focus)
+;;      (ungrab-main-keys)
+;;      (xgrab-keyboard *root*)
+;;      (xgrab-pointer *root* 66 67)
+;;      (unwind-protect
+;;	   (catch 'exit-second-loop
+;;	     (loop
+;;	      (process-event *display* :handler #'handle-event)
+;;	      (display-finish-output *display*)))
+;;	(free-gcontext sm-gc)
+;;	(destroy-window sm-window)
+;;	(xungrab-keyboard)
+;;	(xungrab-pointer)
+;;	(grab-main-keys))
+;;      (adapt-window-to-group (current-window) (current-group))
+;;      (focus-window (current-window))
+;;      (show-all-group (current-workspace))
+;;      (wait-no-key-or-button-press))))
+
+
+
+;;;;; Alternative - Second mode with big screen border
+;;(let ((border-size 5)
+;;      (border-color "Green"))
+;;  (defun second-key-mode ()
+;;    "Switch to editing mode"
+;;    (let* ((windows (list (create-window :parent *root* :x 0 :y 0
+;;					 :width (screen-width *screen*) :height border-size
+;;					 :background (get-color border-color)
+;;					 :colormap (screen-default-colormap *screen*))
+;;			  (create-window :parent *root* :x 0 :y (- (screen-height *screen*) border-size)
+;;					 :width (screen-width *screen*) :height border-size
+;;					 :background (get-color border-color)
+;;					 :colormap (screen-default-colormap *screen*))
+;;			  (create-window :parent *root* :x 0 :y border-size
+;;					 :width border-size :height (- (screen-height *screen*) (* border-size 2))
+;;					 :background (get-color border-color)
+;;					 :colormap (screen-default-colormap *screen*))
+;;			  (create-window :parent *root* :x (- (screen-width *screen*) border-size)
+;;					 :y border-size
+;;					 :width border-size :height (- (screen-height *screen*) (* border-size 2))
+;;					 :background (get-color border-color)
+;;					 :colormap (screen-default-colormap *screen*)))))
+;;      (labels ((draw-second-mode-window ()
+;;		 (dolist (win windows)
+;;		   (raise-window win)))
+;;	       (handle-key-press (&rest event-slots &key root code state &allow-other-keys)
+;;		 (declare (ignore event-slots root))
+;;		 (funcall-key-from-code *second-keys* code state))
+;;	       (handle-enter-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+;;		 (declare (ignore event-slots))
+;;		 (focus-group-under-mouse root-x root-y))
+;;	       (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+;;		 (declare (ignore event-slots))
+;;		 (unless (event-case (*display* :discard-p nil :peek-p t :timeout 0)
+;;			   (:motion-notify () t))
+;;		   (funcall-button-from-code *mouse-action* 'motion 0 root-x root-y #'first)))
+;;	       (handle-button-press (&rest event-slots &key root-x root-y code state &allow-other-keys)
+;;		 (declare (ignore event-slots))
+;;		 (funcall-button-from-code *mouse-action* code state root-x root-y #'first))
+;;	       (handle-button-release (&rest event-slots &key root-x root-y code state &allow-other-keys)
+;;		 (declare (ignore event-slots))
+;;		 (funcall-button-from-code *mouse-action* code state root-x root-y #'third))
+;;	       (handle-event (&rest event-slots &key display event-key &allow-other-keys)
+;;		 (declare (ignore display))
+;;		 (handler-case 
+;;		     (case event-key
+;;		       (:key-press (apply #'handle-key-press event-slots))
+;;		       (:enter-notify (apply #'handle-enter-notify event-slots))
+;;		       (:motion-notify (apply #'handle-motion-notify event-slots))
+;;		       (:button-press (apply #'handle-button-press event-slots))
+;;		       (:button-release (apply #'handle-button-release event-slots))
+;;		       (:configure-request (apply #'handle-configure-request event-slots))
+;;		       (:map-request (apply #'handle-map-request event-slots))
+;;		       (:unmap-notify (apply #'handle-unmap-notify event-slots))
+;;		       (:destroy-notify (apply #'handle-destroy-notify event-slots))
+;;		       (:mapping-notify nil)
+;;		       (:property-notify nil)
+;;		       (:create-notify nil))
+;;		   ((or drawable-error window-error) (c)

[26 lines skipped]
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/29 23:05:56	1.15
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/05/02 19:56:08	1.16
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sat Mar  1 00:03:08 2008
+;;; #Date#: Wed Jan  2 23:45:31 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility
@@ -28,134 +28,393 @@
 (in-package :clfswm)
 
 
+;;;,-----
+;;;| Various definitions
+;;;`-----
+(defun stop-all-pending-actions ()
+  "Stop all pending actions (actions like open in new workspace/group)"
+  (setf *open-next-window-in-new-workspace* nil
+	*open-next-window-in-new-group* nil
+	*arrow-action* nil
+	*pager-arrow-action* nil))
+
+(defun rotate-window-up ()
+  "Rotate up windows in the current group"
+  (setf (group-window-list (current-group))
+	(rotate-list (group-window-list (current-group))))
+  (adapt-window-to-group (current-window) (current-group))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+(defun rotate-window-down ()
+  "Rotate down windows in the current group"
+  (setf (group-window-list (current-group))
+	(anti-rotate-list (group-window-list (current-group))))
+  (adapt-window-to-group (current-window) (current-group))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+
+(defun maximize-group (group)
+  "Maximize the group"
+  (when group
+    (unless (group-fullscreenp group)
+      (setf (group-fullscreenp group) t)))
+  (show-all-windows-in-workspace (current-workspace)))
+
+(defun minimize-group (group)
+  "Minimize the group"
+  (when group
+    (when (group-fullscreenp group)
+      (setf (group-fullscreenp group) nil)))
+  (show-all-windows-in-workspace (current-workspace)))
+
+(defun toggle-maximize-group (group)
+  "Maximize/minimize a group"
+  (if (group-fullscreenp group)
+      (minimize-group group)
+      (maximize-group group)))
+
+
+(defun toggle-maximize-current-group ()
+  "Maximize/minimize the current group"
+  (toggle-maximize-group (current-group)))
+
+
+(defun banish-pointer ()
+  "Move the pointer to the lower right corner of the screen and redraw all groups"
+  (warp-pointer *root*
+		(1- (screen-width *screen*))
+		(1- (screen-height *screen*)))
+  (show-all-group (current-workspace)))
+
+
+(defun renumber-workspaces ()
+  "Reset workspaces numbers (1 for current workspace, 2 for the second...) "
+  (hide-all-windows-in-workspace (current-workspace))
+  (setf *current-workspace-number* 0)
+  (loop for workspace in *workspace-list* do
+	(setf (workspace-number workspace) (incf *current-workspace-number*)))
+  (show-all-windows-in-workspace (current-workspace)))
+
+
+(defun sort-workspaces ()
+  "Sort workspaces by numbers"
+  (hide-all-windows-in-workspace (current-workspace))
+  (setf *workspace-list* (sort *workspace-list*
+			       #'(lambda (x y)
+				   (< (workspace-number x) (workspace-number y)))))
+  (show-all-windows-in-workspace (current-workspace)))
+
+
+
+
+(defun circulate-group-up ()
+  "Circulate up in group"
+  (banish-pointer)
+  (minimize-group (current-group))
+  (no-focus)
+  (setf (workspace-group-list (current-workspace))
+	(rotate-list (workspace-group-list (current-workspace))))
+  (adapt-window-to-group (current-window) (current-group))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+
+(defun circulate-group-up-move-window ()
+  "Circulate up in group moving the current window in the next group"
+  (banish-pointer)
+  (minimize-group (current-group))
+  (no-focus)
+  (let ((window (current-window)))
+    (remove-window-in-group window (current-group))
+    (focus-window (current-window))
+    (setf (workspace-group-list (current-workspace))
+	  (rotate-list (workspace-group-list (current-workspace))))
+    (add-window-in-group window (current-group)))
+  (adapt-window-to-group (current-window) (current-group))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+(defun circulate-group-up-copy-window ()
+  "Circulate up in group copying the current window in the next group"
+  (banish-pointer)
+  (minimize-group (current-group))
+  (no-focus)
+  (let ((window (current-window)))
+    (setf (workspace-group-list (current-workspace))
+	  (rotate-list (workspace-group-list (current-workspace))))
+    (unless (window-already-in-workspace window (current-workspace))
+      (add-window-in-group window (current-group))))
+  (adapt-window-to-group (current-window) (current-group))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+
+
+(defun circulate-group-down ()
+  "Circulate down in group"
+  (banish-pointer)
+  (minimize-group (current-group))
+  (no-focus)
+  (setf (workspace-group-list (current-workspace))
+	(anti-rotate-list (workspace-group-list (current-workspace))))
+  (adapt-window-to-group (current-window) (current-group))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+(defun circulate-group-down-move-window ()
+  "Circulate down in group moving the current window in the next group"
+  (banish-pointer)
+  (minimize-group (current-group))
+  (no-focus)
+  (let ((window (current-window)))
+    (remove-window-in-group window (current-group))
+    (focus-window (current-window))
+    (setf (workspace-group-list (current-workspace))
+	  (anti-rotate-list (workspace-group-list (current-workspace))))
+    (add-window-in-group window (current-group)))
+  (adapt-window-to-group (current-window) (current-group))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+(defun circulate-group-down-copy-window ()
+  "Circulate down in group copying the current window in the next group"
+  (banish-pointer)
+  (minimize-group (current-group))
+  (no-focus)
+  (let ((window (current-window)))
+    (setf (workspace-group-list (current-workspace))
+	  (anti-rotate-list (workspace-group-list (current-workspace))))
+    (unless (window-already-in-workspace window (current-workspace))
+      (add-window-in-group window (current-group))))
+  (adapt-window-to-group (current-window) (current-group))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
 
-(defun add-default-group ()
-  "Add a default group"
-  (when (group-p *current-child*)
-    (let ((name (query-string "Group name")))
-      (push (create-group :name name) (group-child *current-child*))))
-  (leave-second-mode))
-    
-
-(defun add-placed-group ()
-  "Add a placed group"
-  (when (group-p *current-child*)
-    (let ((name (query-string "Group name"))
-	  (x (/ (query-number "Group x in percent (%)") 100))
-	  (y (/ (query-number "Group y in percent (%)") 100))
-	  (w (/ (query-number "Group width in percent (%)") 100))
-	  (h (/ (query-number "Group height in percent (%)") 100)))
-      (push (create-group :name name :x x :y y :w w :h h)
-	    (group-child *current-child*))))
-  (leave-second-mode))
 
 
 
-(defun delete-focus-window ()
-  "Delete the focus window in all groups and workspaces"
-  (let ((window (xlib:input-focus *display*)))
-    (when (and window (not (xlib:window-equal window *no-focus-window*)))
-      (setf *current-child* *current-root*)
-      (remove-child-in-all-groups window)
-      (send-client-message window :WM_PROTOCOLS
-			   (xlib:intern-atom *display* "WM_DELETE_WINDOW"))
-      (show-all-childs))))
 
-(defun destroy-focus-window ()
-  "Destroy the focus window in all groups and workspaces"
-  (let ((window (xlib:input-focus *display*)))
-    (when (and window (not (xlib:window-equal window *no-focus-window*)))
-      (setf *current-child* *current-root*)
-      (remove-child-in-all-groups window)
-      (xlib:kill-client *display* (xlib:window-id window))
-      (show-all-childs))))
-
-(defun remove-focus-window ()
-  "Remove the focus window in the current group"
-  (let ((window (xlib:input-focus *display*)))
-    (when (and window (not (xlib:window-equal window *no-focus-window*)))
-      (setf *current-child* *current-root*)
-      (hide-child window)
-      (remove-child-in-group window (find-father-group window))
-      (show-all-childs))))
-
-
-(defun unhide-all-windows-in-current-child ()
-  "Unhide all hidden windows into the current child"
-  (with-xlib-protect
-      (dolist (window (get-hidden-windows))
-	(unhide-window window)
-	(process-new-window window)
-	(xlib:map-window window)))
-  (show-all-childs))
-
-
-
-
-(defun find-child-under-mouse (x y)
-  "Return the child window under the mouse"
-  (with-xlib-protect
-      (let ((win nil))
-	(with-all-windows-groups (*current-root* child)
-	  (when (and (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
-		     (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
-	    (setf win child))
-	  (when (and (<= (group-rx child) x (+ (group-rx child) (group-rw child)))
-		     (<= (group-ry child) y (+ (group-ry child) (group-rh child))))
-	    (setf win (group-window child))))
-	win)))
+(defun circulate-workspace-by-number (number)
+  "Focus a workspace given its number"
+  (no-focus)
+  (hide-all-windows-in-workspace (current-workspace))
+  (dotimes (i (length *workspace-list*))
+    (when (= (workspace-number (current-workspace)) number)
+      (return))
+    (setf *workspace-list* (rotate-list *workspace-list*)))
+  (show-all-windows-in-workspace (current-workspace)))
+  
 
+(defun circulate-workspace-up ()
+  "Circulate up in workspace"
+  (no-focus)
+  (hide-all-windows-in-workspace (current-workspace))
+  (setf *workspace-list* (rotate-list *workspace-list*))
+  (show-all-windows-in-workspace (current-workspace)))
+
+(defun circulate-workspace-up-move-group ()
+  "Circulate up in workspace moving current group in the next workspace"
+  (no-focus)
+  (hide-all-windows-in-workspace (current-workspace))
+  (let ((group (current-group)))
+    (remove-group-in-workspace group (current-workspace))
+    (setf *workspace-list* (rotate-list *workspace-list*))
+    (add-group-in-workspace (copy-group group) (current-workspace)))
+  (show-all-windows-in-workspace (current-workspace)))
+
+(defun circulate-workspace-up-copy-group ()
+  "Circulate up in workspace copying current group in the next workspace"
+  (no-focus)
+  (hide-all-windows-in-workspace (current-workspace))
+  (let ((group (current-group)))
+    (setf *workspace-list* (rotate-list *workspace-list*))
+    (unless (group-windows-already-in-workspace group (current-workspace))
+      (add-group-in-workspace (copy-group group) (current-workspace))))
+  (show-all-windows-in-workspace (current-workspace)))
+
+
+
+(defun circulate-workspace-down ()
+  "Circulate down in workspace"
+  (no-focus)
+  (hide-all-windows-in-workspace (current-workspace))
+  (setf *workspace-list* (anti-rotate-list *workspace-list*))
+  (show-all-windows-in-workspace (current-workspace)))
+
+(defun circulate-workspace-down-move-group ()
+  "Circulate down in workspace moving current group in the next workspace"
+  (no-focus)
+  (hide-all-windows-in-workspace (current-workspace))
+  (let ((group (current-group)))
+    (remove-group-in-workspace group (current-workspace))
+    (setf *workspace-list* (anti-rotate-list *workspace-list*))
+    (add-group-in-workspace (copy-group group) (current-workspace)))
+  (show-all-windows-in-workspace (current-workspace)))
+
+(defun circulate-workspace-down-copy-group ()
+  "Circulate down in workspace copying current group in the next workspace"
+  (no-focus)
+  (hide-all-windows-in-workspace (current-workspace))
+  (let ((group (current-group)))
+    (setf *workspace-list* (anti-rotate-list *workspace-list*))
+    (unless (group-windows-already-in-workspace group (current-workspace))
+      (add-group-in-workspace (copy-group group) (current-workspace))))
+  (show-all-windows-in-workspace (current-workspace)))
+
+
+
+(defun delete-current-window ()
+  "Delete the current window in all groups and workspaces"
+  (let ((window (current-window)))
+    (when window
+      (no-focus)
+      (remove-window-in-all-workspace window)
+      (send-client-message window :WM_PROTOCOLS
+			   (intern-atom *display* "WM_DELETE_WINDOW"))))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+
+(defun destroy-current-window ()
+  "Destroy the current window in all groups and workspaces"
+  (let ((window (current-window)))
+    (when window
+      (no-focus)
+      (remove-window-in-all-workspace window)
+      (kill-client *display* (window-id window))))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+(defun remove-current-window ()
+  "Remove the current window in the current group"
+  (let ((window (current-window)))
+    (when window
+      (no-focus)
+      (hide-window window)
+      (remove-window-in-group (current-window) (current-group))))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+(defun remove-current-group ()
+  "Remove the current group in the current workspace"
+  (minimize-group (current-group))
+  (let ((group (current-group)))
+    (when group
+      (no-focus)
+      (dolist (window (group-window-list group))
+	(when window
+	  (hide-window window)))
+      (remove-group-in-workspace group (current-workspace))))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+(defun remove-current-workspace ()
+  "Remove the current workspace"
+  (let ((workspace (current-workspace)))
+    (when workspace
+      (hide-all-windows-in-workspace workspace)
+      (remove-workspace workspace)
+      (show-all-windows-in-workspace (current-workspace)))))
+
+
+(defun unhide-all-windows-in-current-group ()
+  "Unhide all hidden windows into the current group"
+  (let ((all-windows (get-all-windows))
+	(hidden-windows (remove-if-not #'window-hidden-p
+				      (copy-list (query-tree *root*))))
+	(current-group (current-group)))
+    (dolist (window (set-difference hidden-windows all-windows))
+      (unhide-window window)
+      (process-new-window window)
+      (map-window window)
+      (adapt-window-to-group window current-group)))
+  (focus-window (current-window))
+  (show-all-group (current-workspace)))
+
+
+
+
+(defun create-new-default-group ()
+  "Create a new default group"
+  (minimize-group (current-group))
+  (add-group-in-workspace (copy-group *default-group*)
+			  (current-workspace))
+  (show-all-windows-in-workspace (current-workspace)))

[864 lines skipped]
--- /project/clfswm/cvsroot/clfswm/clfswm.asd	2008/02/24 20:53:37	1.7
+++ /project/clfswm/cvsroot/clfswm/clfswm.asd	2008/05/02 19:56:08	1.8
@@ -2,7 +2,7 @@
 ;;;; Author: Philippe Brochard <hocwp at free.fr>
 ;;;; ASDF System Definition
 ;;;
-;;; #date#: Fri Feb 22 21:39:37 2008
+;;; #date#: Wed Jan  2 23:30:31 2008
 
 (in-package #:asdf)
 
@@ -13,36 +13,43 @@
     :licence "GNU Public License (GPL)"
     :components ((:file "tools")
 		 (:file "my-html"
-			:depends-on ("tools"))
+		  :depends-on ("tools"))
 		 (:file "package"
-			:depends-on ("my-html" "tools"))
+		  :depends-on ("my-html" "tools"))
 		 (:file "config"
-			:depends-on ("package"))
+		  :depends-on ("package"))
 		 (:file "keysyms"
-			:depends-on ("package"))
+		  :depends-on ("package"))
 		 (:file "xlib-util"
-			:depends-on ("package" "keysyms" "config"))
+		  :depends-on ("package" "keysyms" "config"))
 		 (:file "netwm-util"
-			:depends-on ("package" "xlib-util"))
+		  :depends-on ("package" "xlib-util"))
 		 (:file "clfswm-keys"
-			:depends-on ("package" "config" "xlib-util" "keysyms"))
+		  :depends-on ("package" "config" "xlib-util" "keysyms"))
 		 (:file "clfswm-internal"
-			:depends-on ("xlib-util" "clfswm-keys" "netwm-util" "tools"))
-		 (:file "clfswm"
-			:depends-on ("xlib-util" "netwm-util" "clfswm-keys" "config"
-						 "clfswm-internal" "tools"))
+		  :depends-on ("xlib-util" "clfswm-keys" "netwm-util" "tools"))
 		 (:file "clfswm-second-mode"
-			:depends-on ("package" "clfswm-internal"))
-		 (:file "clfswm-info"
-			:depends-on ("package" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal"))
+		  :depends-on ("package" "clfswm-internal"))
+		 (:file "clfswm"
+		  :depends-on ("xlib-util" "netwm-util" "clfswm-keys" "config"
+					   "clfswm-internal" "clfswm-second-mode" "tools"))
 		 (:file "clfswm-util"
-			:depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode"))
-		 (:file "clfswm-layout"
-			:depends-on ("package" "clfswm-util" "clfswm-info"))
+		  :depends-on ("clfswm" "keysyms"))
+		 (:file "clfswm-pack"
+		  :depends-on ("clfswm" "clfswm-util"))
+		 (:file "clfswm-pager"
+		  :depends-on ("clfswm" "clfswm-util" "clfswm-pack"))
+		 (:file "clfswm-info"
+		  :depends-on ("clfswm" "clfswm-pager"))
 		 (:file "bindings"
-			:depends-on ("clfswm" "clfswm-internal"))
+		  :depends-on ("clfswm" "clfswm-util" "clfswm-pack" "clfswm-info"))
 		 (:file "bindings-second-mode"
-			:depends-on ("clfswm" "clfswm-util"))))
+		  :depends-on ("clfswm" "clfswm-util" "clfswm-pack" "clfswm-info"))
+		 (:file "bindings-pager"
+		  :depends-on ("clfswm" "clfswm-util" "clfswm-pack" "clfswm-pager"
+					"clfswm-info" "bindings"))))
+
+
 
 
 
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/02/29 23:05:56	1.16
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/05/02 19:56:08	1.17
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sat Mar  1 00:02:34 2008
+;;; #Date#: Sat Jan  5 15:16:21 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -38,6 +38,46 @@
 
 
 
+;;(defun handle-configure-request (&rest event-slots &key stack-mode #|parent|# window #|above-sibling|#
+;;				 x y width height border-width value-mask &allow-other-keys)
+;;  (declare (ignore event-slots))
+;;  (labels ((has-x (mask) (= 1 (logand mask 1)))
+;;  	   (has-y (mask) (= 2 (logand mask 2)))
+;;  	   (has-w (mask) (= 4 (logand mask 4)))
+;;  	   (has-h (mask) (= 8 (logand mask 8)))
+;;  	   (has-bw (mask) (= 16 (logand mask 16)))
+;;  	   (has-stackmode (mask) (= 64 (logand mask 64))))
+;;    (handler-case
+;;  	(progn
+;;  	  (with-state (window)
+;;  	    (when (has-x value-mask)
+;;  	      (setf (drawable-x window) x))
+;;  	    (when (has-y value-mask)
+;;  	      (setf (drawable-y window) y))
+;;  	    (when (has-h value-mask)
+;;  	      (setf (drawable-height window) height))
+;;  	    (when (has-w value-mask)
+;;  	      (setf (drawable-width window) width))
+;;  	    (when (has-bw value-mask)
+;;  	      (setf (drawable-border-width window) border-width)))
+;;  	  ;; The ICCCM says with have to send a fake configure-notify if
+;;  	  ;; the window is moved but not resized.
+;;  	  (when (member window (group-window-list (current-group)))
+;;	    (unless (or (logbitp 2 value-mask) (logbitp 3 value-mask))
+;;	      (send-configuration-notify window))
+;;	    (adapt-window-to-group window (current-group))
+;;	    (when (has-stackmode value-mask)
+;;	      (case stack-mode
+;;		(:above (raise-window window))))))
+;;      ((or match-error window-error drawable-error) (c)
+;;  	(declare (ignore c))))))
+;;  	;;(dbg "Configure Error" c)))))
+;;
+;;
+;;
+;;(defun handle-configure-notify (&rest event-slots)
+;;  (declare (ignore event-slots))
+;;  (adapt-all-window-in-workspace (current-workspace)))
 
 (defun handle-configure-request (&rest event-slots &key stack-mode #|parent|# window #|above-sibling|#
 				 x y width height border-width value-mask &allow-other-keys)
@@ -47,26 +87,29 @@
     	   (has-w (mask) (= 4 (logand mask 4)))
     	   (has-h (mask) (= 8 (logand mask 8)))
 	   (has-bw (mask) (= 16 (logand mask 16)))
-	   (has-stackmode (mask) (= 64 (logand mask 64)))
+  	   (has-stackmode (mask) (= 64 (logand mask 64)))
 	   (adjust-from-request ()
-	     (when (has-x value-mask) (setf (xlib:drawable-x window) x))
-	     (when (has-y value-mask) (setf (xlib:drawable-y window) y))
-	     (when (has-h value-mask) (setf (xlib:drawable-height window) height))
-	     (when (has-w value-mask) (setf (xlib:drawable-width window) width))))
-    (with-xlib-protect
-	(xlib:with-state (window)
-	  (when (has-bw value-mask)
-	    (setf (xlib:drawable-border-width window) border-width))
-	  (if (find-child window *current-root*)
-	      (case (window-type window)
-		(:normal (adapt-child-to-father window (find-father-group window *current-root*))
-			 (send-configuration-notify window))
-		(t (adjust-from-request)))
-	      (adjust-from-request))
-	  (when (has-stackmode value-mask)
-	    (case stack-mode
-	      (:above (raise-window window))))))))
-
+	     (when (has-x value-mask) (setf (drawable-x window) x))
+	     (when (has-y value-mask) (setf (drawable-y window) y))
+	     (when (has-h value-mask) (setf (drawable-height window) height))
+	     (when (has-w value-mask) (setf (drawable-width window) width))))
+    (handler-case
+  	(progn
+  	  (with-state (window)
+  	    (when (has-bw value-mask)
+  	      (setf (drawable-border-width window) border-width))
+	    (if (window-already-in-workspace window (current-workspace))
+		(case (window-type window)
+		  (:normal (adapt-window-to-group window (find-window-group window (current-workspace)))
+			   (send-configuration-notify window))
+		  (t (adjust-from-request)))
+		(adjust-from-request))
+	    (when (has-stackmode value-mask)
+	      (case stack-mode
+		(:above (raise-window window))))))
+      ((or match-error window-error drawable-error) (c)
+  	(declare (ignore c))))))
+  	;;(dbg "Configure Error" c)))))
 
 
 
@@ -79,41 +122,43 @@
 (defun handle-map-request (&rest event-slots &key window send-event-p &allow-other-keys)
   (declare (ignore event-slots))
   (unless send-event-p
-    ;;    (unhide-window window)
+    (unhide-window window)
     (process-new-window window)
-    (xlib:map-window window)
-    ;;    (focus-window window)
-    (show-all-childs)))
+    (map-window window)
+    (focus-window window)
+    (show-all-group (current-workspace))))
 
 
 (defun handle-unmap-notify (&rest event-slots &key send-event-p event-window window &allow-other-keys)
   (declare (ignore event-slots))
   (unless (and (not send-event-p)
-	       (not (xlib:window-equal window event-window)))
-    (when (find-child window *root-group*)
-      (remove-child-in-all-groups window)
-      (show-all-childs))))
+	       (not (window-equal window event-window)))
+    (let ((found-p (find window (get-all-windows) :test 'window-equal)))
+      (remove-window-in-all-workspace window)
+      (when found-p
+	(show-all-windows-in-workspace (current-workspace))))))
+
 
 
 (defun handle-destroy-notify (&rest event-slots &key send-event-p event-window window &allow-other-keys)
   (declare (ignore event-slots))
   (unless (or send-event-p
-	      (xlib:window-equal window event-window))
-    (when (find-child window *root-group*)
-      (remove-child-in-all-groups window)
-      (show-all-childs))))
+	      (window-equal event-window window))
+    (let ((found-p (find window (get-all-windows) :test 'window-equal)))
+      (remove-window-in-all-workspace window)
+      (when found-p
+	(show-all-windows-in-workspace (current-workspace))))))
 
 
 
 (defun handle-enter-notify  (&rest event-slots &key root-x root-y &allow-other-keys)
-  (declare (ignore event-slots root-x root-y)))
-
-
+  (declare (ignore event-slots))
+  (unless (group-fullscreenp (current-group))
+    (focus-group-under-mouse root-x root-y)))
 
-(defun handle-exposure   (&rest event-slots &key window &allow-other-keys)
+(defun handle-exposure   (&rest event-slots)
   (declare (ignore event-slots))
-  (awhen (find-group-window window *current-root*)
-	 (display-group-info it)))
+  (show-all-group (current-workspace) *root* *root-gc* nil))
 
 
 (defun handle-create-notify (&rest event-slots)
@@ -121,43 +166,17 @@
 
 
 
-;; PHIL: TODO: focus-policy par group
-;;  :click, :sloppy, :nofocus
-(defun handle-click-to-focus (window)
-  (let ((to-replay t)
-	(child window)
-	(father (find-father-group window *current-root*)))
-    (unless father
-      (setf child (find-group-window window *current-root*)
-	    father (find-father-group child *current-root*)))
-    (when (and child father (focus-all-childs child father))
-      (show-all-childs)
-      (setf to-replay nil))
-    (if to-replay (replay-button-event) (stop-button-event))))
-
-
-(defun handle-button-press (&rest event-slots &key code state window &allow-other-keys)
-  (declare (ignore event-slots))
-  (if (and (= code 1) (= state 0))
-      (handle-click-to-focus window)
-      (replay-button-event)))
-
-	
-
-
-
-
 ;;; CONFIG: Main mode hooks
 (setf *key-press-hook* #'handle-key-press
       *configure-request-hook* #'handle-configure-request
       *configure-notify-hook* #'handle-configure-notify
-      *destroy-notify-hook* 'handle-destroy-notify
+      *destroy-notify-hook* #'handle-destroy-notify
       *enter-notify-hook* #'handle-enter-notify
-      *exposure-hook* 'handle-exposure
+      *exposure-hook* #'handle-exposure
       *map-request-hook* #'handle-map-request
-      *unmap-notify-hook* 'handle-unmap-notify
-      *create-notify-hook* #'handle-create-notify
-      *button-press-hook* 'handle-button-press)
+      *unmap-notify-hook* #'handle-unmap-notify
+      *create-notify-hook* #'handle-create-notify)
+
 
 
 
@@ -165,10 +184,9 @@
 (defun handle-event (&rest event-slots &key display event-key &allow-other-keys)
   (declare (ignore display))
   ;;(dbg  event-key)
-  (with-xlib-protect
+  (handler-case
       (case event-key
 	(:button-press (call-hook *button-press-hook* event-slots))
-	(:motion-notify (call-hook *button-motion-notify-hook* event-slots))
 	(:key-press (call-hook *key-press-hook* event-slots))
 	(:configure-request (call-hook *configure-request-hook* event-slots))
 	(:configure-notify (call-hook *configure-notify-hook* event-slots))
@@ -179,84 +197,110 @@
 	(:property-notify (call-hook *property-notify-hook* event-slots))
 	(:create-notify (call-hook *create-notify-hook* event-slots))
 	(:enter-notify (call-hook *enter-notify-hook* event-slots))
-	(:exposure (call-hook *exposure-hook* event-slots))))
+	(:exposure (call-hook *exposure-hook* event-slots)))
+    ((or drawable-error window-error) (c)
+      (declare (ignore c))))
+      ;;(dbg "Ignore handle event" c event-slots)))
   t)
 
 
 
 (defun main-loop ()
   (loop
-     (with-xlib-protect
-	 (xlib:display-finish-output *display*)
-       (xlib:process-event *display* :handler #'handle-event))))
-;;(dbg "Main loop finish" c)))))
+   (handler-case
+       (progn
+	 (display-finish-output *display*)
+	 (process-event *display* :handler #'handle-event))
+     ((or match-error window-error drawable-error) (c)
+       (declare (ignore c))))))
+       ;;(dbg "Main loop finish" c)))))
 
 
-(defun open-display (display-str protocol)
-  (multiple-value-bind (host display-num) (parse-display-string display-str)
-    (setf *display* (xlib:open-display host :display display-num :protocol protocol)
-	  (getenv "DISPLAY") display-str)))
+(defun process-existing-windows (screen)
+  "Windows present when clfswm starts up must be absorbed by clfswm."
+  (let ((children (query-tree (screen-root screen)))
+	(id-list nil))
+    (dolist (win children)
+      (let ((map-state (window-map-state win))
+	    (wm-state (window-state win)))
+	(unless (or (eql (window-override-redirect win) :on)
+		    (eql win *no-focus-window*))
+	  (when (or (eql map-state :viewable)
+	  	    (eql wm-state +iconic-state+))
+	    (format t "Processing ~S ~S~%" (wm-name win) win)
+	    (unhide-window win)
+	    (process-new-window win)
+	    (map-window win)
+	    (push (window-id win) id-list)))))
+    (netwm-set-client-list id-list)))
 
 
-(defun init-display ()
-  (setf *screen* (first (xlib:display-roots *display*))
-	*root* (xlib:screen-root *screen*)
-	*no-focus-window* (xlib:create-window :parent *root* :x 0 :y 0 :width 1 :height 1)
-	*root-gc* (xlib:create-gcontext :drawable *root*
-					:foreground (get-color *color-unselected*)
-					:background (get-color "Black")
-					:line-style :solid)
-	*default-font* (xlib:open-font *display* *default-font-string*))
+
+
+
+
+
+(defun parse-display-string (display)
+  "Parse an X11 DISPLAY string and return the host and display from it."
+  (let* ((colon (position #\: display))
+	 (host (subseq display 0 colon))
+	 (rest (subseq display (1+ colon)))
+	 (dot (position #\. rest))
+	 (num (parse-integer (subseq rest 0 dot))))
+    (values host num)))
+
+
+
+(defun init-display (display-str protocol)
+  (multiple-value-bind (host display-num) (parse-display-string display-str)
+    (setf *display* (open-display host :display display-num :protocol protocol)
+	  *screen* (first (display-roots *display*))
+	  *root* (screen-root *screen*)
+	  *no-focus-window* (create-window :parent *root* :x 0 :y 0 :width 1 :height 1)
+	  *root-gc* (create-gcontext :drawable *root*
+				     :foreground (get-color *color-unselected*)
+				     :background (get-color "Black")
+				     :line-style :solid)))
   (xgrab-init-pointer)
   (xgrab-init-keyboard)
-  ;;(xgrab-pointer *root* 66 67 '(:enter-window :button-press :button-release) t)  ;; PHIL
-  ;;(grab-pointer *root* '(:button-press :button-release)
-  ;;  		:owner-p t :sync-keyboard-p nil :sync-pointer-p nil)
-  ;;(grab-button *root* 1 nil ;;'(:button-press :button-release)
-  ;;	       :owner-p nil  :sync-keyboard-p nil :sync-pointer-p nil)
-  ;;(xlib:grab-pointer *root* nil :owner-p nil)
-  (xlib:map-window *no-focus-window*)
+  (map-window *no-focus-window*)
+  (setf *workspace-list* nil
+	*current-workspace-number* 0
+	*open-next-window-in-new-workspace* nil
+	*open-next-window-in-new-group* nil
+	*arrow-action* nil
+	*pager-arrow-action* nil)
+  (destructuring-bind (x y width height) *fullscreen*
+    (setf *default-group* (make-group :x x :y y :width width :height height :fullscreenp nil)))
+  (add-workspace (make-workspace :number (incf *current-workspace-number*)
+				 :group-list (list (copy-group *default-group*))))
+  (setf (group-fullscreenp (current-group)) t)
   (dbg *display*)
-  (setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect
-							      :substructure-notify
-							      :property-change
-							      :exposure
-							      :button-press))
-  ;;(intern-atoms *display*)
+  (setf (getenv "DISPLAY") display-str)
+  (setf (window-event-mask *root*)
+	'(:substructure-redirect
+	  :substructure-notify
+	  :property-change
+	  :exposure))
   (netwm-set-properties)
-  (xlib:display-force-output *display*)
-  (setf *child-selection* nil)
-  (setf *root-group* (create-group :name "Root" :number 0 :layout #'tile-space-layout)
-	*current-root* *root-group*
-	*current-child* *current-root*)
-  (call-hook *init-hook*)
+  (display-force-output *display*)
   (process-existing-windows *screen*)
-  (show-all-childs)
+  (focus-window (current-window))
+  (show-all-group (current-workspace))
   (grab-main-keys)
-  (xlib:display-finish-output *display*))
-
-
-
-(defun xdg-config-home ()
-  (pathname-directory (concatenate 'string (or (getenv "XDG_CONFIG_HOME")
-					       (getenv "HOME"))
-				   "/")))
+  (display-finish-output *display*))
 
 
 (defun read-conf-file ()
   (let* ((user-conf (probe-file (merge-pathnames (user-homedir-pathname) #p".clfswmrc")))
 	 (etc-conf (probe-file #p"/etc/clfswmrc"))
-	 (config-user-conf (probe-file (make-pathname :directory (append (xdg-config-home) '("clfswm"))
-						      :name "clfswmrc")))
-	 (conf (or user-conf etc-conf config-user-conf)))
+	 (conf (or user-conf etc-conf)))
     (if conf
 	(handler-case (load conf)
 	  (error (c)
 	    (format t "~2%*** Error loading configurtion file: ~A ***~&~A~%" conf c)
 	    (values nil (format nil "~s" c) conf))
-	  (:no-error (&rest args)
-	    (declare (ignore args))
-	    (values t nil conf)))
+	  (:no-error (&rest args) (declare (ignore args)) (values t nil conf)))
 	(values t nil nil))))
 
 
@@ -264,45 +308,18 @@
 (defun main (&optional (display-str (or (getenv "DISPLAY") ":0")) protocol)
   (read-conf-file)
   (handler-case
-      (open-display display-str protocol)
-    (xlib:access-error (c)
-      (format t "~&~A~&Maybe another window manager is running.~%" c)

[44 lines skipped]
--- /project/clfswm/cvsroot/clfswm/config.lisp	2008/02/27 22:34:55	1.9
+++ /project/clfswm/cvsroot/clfswm/config.lisp	2008/05/02 19:56:08	1.10
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Feb 27 22:15:01 2008
+;;; #Date#: Wed Jan  2 23:40:41 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Configuration file
@@ -41,22 +41,16 @@
 
 
 ;;; CONFIG - Screen size
-(defun get-fullscreen-size ()
-  "Return the size of root child (values rx ry rw rh raise-p)
-You can tweak this to what you want"
-  (values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*) nil))
-;; (values -1 -1 1024 768))
-;;  (values 100 100 800 600))
-
-
-
-
+;;(defparameter *fullscreen* '(0 0 1024 600))
+(defparameter *fullscreen* '(0 0 1024 768))
+;;(defparameter *fullscreen* '(0 0 1280 960))
+;;(defparameter *fullscreen* '(100 0 1180 960))  ;; Example with a space on left.
+;;(defparameter *fullscreen* '(0 0 800 600))
 
 
 ;;; CONFIG: Main mode colors
 (defparameter *color-selected* "Red")
-(defparameter *color-unselected* "Blue")
-(defparameter *color-maybe-selected* "Yellow")
+(defparameter *color-unselected* "Yellow")
 
 ;;; CONFIG: Second mode colors and fonts
 (defparameter *sm-border-color* "Green")
@@ -95,7 +89,7 @@
 
 
 ;;; CONFIG - Identify key colors
-(defparameter *identify-font-string* "9x15")
+(defparameter *identify-font-string* "9x15bold")
 (defparameter *identify-background* "black")
 (defparameter *identify-foreground* "green")
 (defparameter *identify-border* "red")
@@ -113,7 +107,7 @@
 (defparameter *info-foreground* "green")
 (defparameter *info-border* "red")
 (defparameter *info-line-cursor* "white")
-(defparameter *info-font-string* "9x15")
+(defparameter *info-font-string* "9x15bold")
 
 
 
--- /project/clfswm/cvsroot/clfswm/dot-clfswmrc	2008/01/07 20:08:54	1.8
+++ /project/clfswm/cvsroot/clfswm/dot-clfswmrc	2008/05/02 19:56:08	1.9
@@ -146,7 +146,7 @@
 ;;;; Uncomment the lines below if you want to enable the larswm,
 ;;;; dwm, wmii... cycling style.
 ;;;;
-;;;; This leave the main window in one side of the screen and tile others
+;;;; This leave the main window in on side of the screen and tile others
 ;;;; on the other side. It can be configured in the rc file or interactively
 ;;;; with the function 'reconfigure-tile-workspace'.
 ;;;;
--- /project/clfswm/cvsroot/clfswm/keysyms.lisp	2008/02/24 20:53:37	1.2
+++ /project/clfswm/cvsroot/clfswm/keysyms.lisp	2008/05/02 19:56:08	1.3
@@ -49,8 +49,8 @@
     (declare (ignore present-p))
     value))
 
-(cl-define-keysym #xffffff "VoidSymbol") ;Void symbol 
-(cl-define-keysym #xff08 "BackSpace")	 ;Back space, back char 
+(cl-define-keysym #xffffff "VoidSymbol")	;Void symbol 
+(cl-define-keysym #xff08 "BackSpace")	;Back space, back char 
 (cl-define-keysym #xff09 "Tab")
 (cl-define-keysym #xff0a "Linefeed")	;Linefeed, LF 
 (cl-define-keysym #xff0b "Clear")
@@ -59,60 +59,60 @@
 (cl-define-keysym #xff14 "Scroll_Lock")
 (cl-define-keysym #xff15 "Sys_Req")
 (cl-define-keysym #xff1b "Escape")
-(cl-define-keysym #xffff "Delete")	;Delete, rubout 
+(cl-define-keysym #xffff "Delete")		;Delete, rubout 
 (cl-define-keysym #xff20 "Multi_key")	;Multi-key character compose 
 (cl-define-keysym #xff37 "Codeinput")
 (cl-define-keysym #xff3c "SingleCandidate")
 (cl-define-keysym #xff3d "MultipleCandidate")
 (cl-define-keysym #xff3e "PreviousCandidate")
-(cl-define-keysym #xff21 "Kanji")	;Kanji, Kanji convert 
+(cl-define-keysym #xff21 "Kanji")		;Kanji, Kanji convert 
 (cl-define-keysym #xff22 "Muhenkan")	;Cancel Conversion 
 (cl-define-keysym #xff23 "Henkan_Mode")	;Start/Stop Conversion 
-(cl-define-keysym #xff23 "Henkan")	;Alias for Henkan_Mode 
-(cl-define-keysym #xff24 "Romaji")	;to Romaji 
+(cl-define-keysym #xff23 "Henkan")		;Alias for Henkan_Mode 
+(cl-define-keysym #xff24 "Romaji")		;to Romaji 
 (cl-define-keysym #xff25 "Hiragana")	;to Hiragana 
 (cl-define-keysym #xff26 "Katakana")	;to Katakana 
 (cl-define-keysym #xff27 "Hiragana_Katakana") ;Hiragana/Katakana toggle 
-(cl-define-keysym #xff28 "Zenkaku")	      ;to Zenkaku 
-(cl-define-keysym #xff29 "Hankaku")	      ;to Hankaku 
+(cl-define-keysym #xff28 "Zenkaku")	   ;to Zenkaku 
+(cl-define-keysym #xff29 "Hankaku")	   ;to Hankaku 
 (cl-define-keysym #xff2a "Zenkaku_Hankaku")   ;Zenkaku/Hankaku toggle 
-(cl-define-keysym #xff2b "Touroku")	      ;Add to Dictionary 
-(cl-define-keysym #xff2c "Massyo")	      ;Delete from Dictionary 
-(cl-define-keysym #xff2d "Kana_Lock")	      ;Kana Lock 
-(cl-define-keysym #xff2e "Kana_Shift")	      ;Kana Shift 
-(cl-define-keysym #xff2f "Eisu_Shift")	      ;Alphanumeric Shift 
-(cl-define-keysym #xff30 "Eisu_toggle")	      ;Alphanumeric toggle 
-(cl-define-keysym #xff37 "Kanji_Bangou")      ;Codeinput 
+(cl-define-keysym #xff2b "Touroku")	   ;Add to Dictionary 
+(cl-define-keysym #xff2c "Massyo")		   ;Delete from Dictionary 
+(cl-define-keysym #xff2d "Kana_Lock")	   ;Kana Lock 
+(cl-define-keysym #xff2e "Kana_Shift")	   ;Kana Shift 
+(cl-define-keysym #xff2f "Eisu_Shift")	   ;Alphanumeric Shift 
+(cl-define-keysym #xff30 "Eisu_toggle")	   ;Alphanumeric toggle 
+(cl-define-keysym #xff37 "Kanji_Bangou")	   ;Codeinput 
 (cl-define-keysym #xff3d "Zen_Koho")	   ;Multiple/All Candidate(s) 
 (cl-define-keysym #xff3e "Mae_Koho")	   ;Previous Candidate 
 (cl-define-keysym #xff50 "Home")
-(cl-define-keysym #xff51 "Left")	;Move left, left arrow 
+(cl-define-keysym #xff51 "Left")		;Move left, left arrow 
 (cl-define-keysym #xff52 "Up")		;Move up, up arrow 
-(cl-define-keysym #xff53 "Right")	;Move right, right arrow 
-(cl-define-keysym #xff54 "Down")	;Move down, down arrow 
-(cl-define-keysym #xff55 "Prior")	;Prior, previous 
+(cl-define-keysym #xff53 "Right")		;Move right, right arrow 
+(cl-define-keysym #xff54 "Down")		;Move down, down arrow 
+(cl-define-keysym #xff55 "Prior")		;Prior, previous 
 (cl-define-keysym #xff55 "Page_Up")
-(cl-define-keysym #xff56 "Next")	;Next 
+(cl-define-keysym #xff56 "Next")		;Next 
 (cl-define-keysym #xff56 "Page_Down")
-(cl-define-keysym #xff57 "End")			;EOL 
+(cl-define-keysym #xff57 "End")		;EOL 
 (cl-define-keysym #xff58 "Begin")		;BOL 
 (cl-define-keysym #xff60 "Select")		;Select, mark 
 (cl-define-keysym #xff61 "Print")
-(cl-define-keysym #xff62 "Execute")		;Execute, run, do 
+(cl-define-keysym #xff62 "Execute")	;Execute, run, do 
 (cl-define-keysym #xff63 "Insert")		;Insert, insert here 
 (cl-define-keysym #xff65 "Undo")
-(cl-define-keysym #xff66 "Redo")	;Redo, again 
+(cl-define-keysym #xff66 "Redo")		;Redo, again 
 (cl-define-keysym #xff67 "Menu")
 (cl-define-keysym #xff68 "Find")		;Find, search 
-(cl-define-keysym #xff69 "Cancel")	;Cancel, stop, abort, exit 
-(cl-define-keysym #xff6a "Help")	;Help 
+(cl-define-keysym #xff69 "Cancel")		;Cancel, stop, abort, exit 
+(cl-define-keysym #xff6a "Help")		;Help 
 (cl-define-keysym #xff6b "Break")
-(cl-define-keysym #xff7e "Mode_switch")		;Character set switch 
-(cl-define-keysym #xff7e "script_switch") ;Alias for mode_switch 
+(cl-define-keysym #xff7e "Mode_switch")	;Character set switch 
+(cl-define-keysym #xff7e "script_switch")	;Alias for mode_switch 
 (cl-define-keysym #xff7f "Num_Lock")
 (cl-define-keysym #xff80 "KP_Space")	;Space 
 (cl-define-keysym #xff89 "KP_Tab")
-(cl-define-keysym #xff8d "KP_Enter")		;Enter 
+(cl-define-keysym #xff8d "KP_Enter")	;Enter 
 (cl-define-keysym #xff91 "KP_F1")		;PF1, KP_A, ... 
 (cl-define-keysym #xff92 "KP_F2")
 (cl-define-keysym #xff93 "KP_F3")
@@ -133,7 +133,7 @@
 (cl-define-keysym #xffbd "KP_Equal")	;Equals 
 (cl-define-keysym #xffaa "KP_Multiply")
 (cl-define-keysym #xffab "KP_Add")
-(cl-define-keysym #xffac "KP_Separator") ;Separator, often comma 
+(cl-define-keysym #xffac "KP_Separator")	;Separator, often comma 
 (cl-define-keysym #xffad "KP_Subtract")
 (cl-define-keysym #xffae "KP_Decimal")
 (cl-define-keysym #xffaf "KP_Divide")
@@ -213,10 +213,10 @@
 (cl-define-keysym #xffe4 "Control_R")	;Right control 
 (cl-define-keysym #xffe5 "Caps_Lock")	;Caps lock 
 (cl-define-keysym #xffe6 "Shift_Lock")	;Shift lock 
-(cl-define-keysym #xffe7 "Meta_L")	;Left meta 
-(cl-define-keysym #xffe8 "Meta_R")	;Right meta 
-(cl-define-keysym #xffe9 "Alt_L")	;Left alt 
-(cl-define-keysym #xffea "Alt_R")	;Right alt 
+(cl-define-keysym #xffe7 "Meta_L")		;Left meta 
+(cl-define-keysym #xffe8 "Meta_R")		;Right meta 
+(cl-define-keysym #xffe9 "Alt_L")		;Left alt 
+(cl-define-keysym #xffea "Alt_R")		;Right alt 
 (cl-define-keysym #xffeb "Super_L")	;Left super 
 (cl-define-keysym #xffec "Super_R")	;Right super 
 (cl-define-keysym #xffed "Hyper_L")	;Left hyper 
@@ -354,10 +354,10 @@
 (cl-define-keysym #xfd1d "3270_PrintScreen")
 (cl-define-keysym #xfd1e "3270_Enter")
 (cl-define-keysym #x0020 "space")		;U+0020 SPACE 
-(cl-define-keysym #x0021 "exclam")	;U+0021 EXCLAMATION MARK 
+(cl-define-keysym #x0021 "exclam")		;U+0021 EXCLAMATION MARK 
 (cl-define-keysym #x0022 "quotedbl")	;U+0022 QUOTATION MARK 
 (cl-define-keysym #x0023 "numbersign")	;U+0023 NUMBER SIGN 
-(cl-define-keysym #x0024 "dollar")	;U+0024 DOLLAR SIGN 
+(cl-define-keysym #x0024 "dollar")		;U+0024 DOLLAR SIGN 
 (cl-define-keysym #x0025 "percent")	;U+0025 PERCENT SIGN 
 (cl-define-keysym #x0026 "ampersand")	;U+0026 AMPERSAND 
 (cl-define-keysym #x0027 "apostrophe")	;U+0027 APOSTROPHE 
@@ -365,11 +365,11 @@
 (cl-define-keysym #x0028 "parenleft")	;U+0028 LEFT PARENTHESIS 
 (cl-define-keysym #x0029 "parenright")	;U+0029 RIGHT PARENTHESIS 
 (cl-define-keysym #x002a "asterisk")	;U+002A ASTERISK 
-(cl-define-keysym #x002b "plus")	;U+002B PLUS SIGN 
-(cl-define-keysym #x002c "comma")	;U+002C COMMA 
-(cl-define-keysym #x002d "minus")	;U+002D HYPHEN-MINUS 
-(cl-define-keysym #x002e "period")	;U+002E FULL STOP 
-(cl-define-keysym #x002f "slash")	;U+002F SOLIDUS 
+(cl-define-keysym #x002b "plus")		;U+002B PLUS SIGN 
+(cl-define-keysym #x002c "comma")		;U+002C COMMA 
+(cl-define-keysym #x002d "minus")		;U+002D HYPHEN-MINUS 
+(cl-define-keysym #x002e "period")		;U+002E FULL STOP 
+(cl-define-keysym #x002f "slash")		;U+002F SOLIDUS 
 (cl-define-keysym #x0030 "0")		;U+0030 DIGIT ZERO 
 (cl-define-keysym #x0031 "1")		;U+0031 DIGIT ONE 
 (cl-define-keysym #x0032 "2")		;U+0032 DIGIT TWO 
@@ -380,79 +380,79 @@
 (cl-define-keysym #x0037 "7")		;U+0037 DIGIT SEVEN 
 (cl-define-keysym #x0038 "8")		;U+0038 DIGIT EIGHT 
 (cl-define-keysym #x0039 "9")		;U+0039 DIGIT NINE 
-(cl-define-keysym #x003a "colon")	;U+003A COLON 
+(cl-define-keysym #x003a "colon")		;U+003A COLON 
 (cl-define-keysym #x003b "semicolon")	;U+003B SEMICOLON 
-(cl-define-keysym #x003c "less")	;U+003C LESS-THAN SIGN 
-(cl-define-keysym #x003d "equal")	;U+003D EQUALS SIGN 
+(cl-define-keysym #x003c "less")		;U+003C LESS-THAN SIGN 
+(cl-define-keysym #x003d "equal")		;U+003D EQUALS SIGN 
 (cl-define-keysym #x003e "greater")	;U+003E GREATER-THAN SIGN 
 (cl-define-keysym #x003f "question")	;U+003F QUESTION MARK 
 (cl-define-keysym #x0040 "at")		;U+0040 COMMERCIAL AT 
-(cl-define-keysym #x0041 "A")	       ;U+0041 LATIN CAPITAL LETTER A 
-(cl-define-keysym #x0042 "B")	       ;U+0042 LATIN CAPITAL LETTER B 
-(cl-define-keysym #x0043 "C")	       ;U+0043 LATIN CAPITAL LETTER C 
-(cl-define-keysym #x0044 "D")	       ;U+0044 LATIN CAPITAL LETTER D 
-(cl-define-keysym #x0045 "E")	       ;U+0045 LATIN CAPITAL LETTER E 
-(cl-define-keysym #x0046 "F")	       ;U+0046 LATIN CAPITAL LETTER F 
-(cl-define-keysym #x0047 "G")	       ;U+0047 LATIN CAPITAL LETTER G 
-(cl-define-keysym #x0048 "H")	       ;U+0048 LATIN CAPITAL LETTER H 
-(cl-define-keysym #x0049 "I")	       ;U+0049 LATIN CAPITAL LETTER I 
-(cl-define-keysym #x004a "J")	       ;U+004A LATIN CAPITAL LETTER J 
-(cl-define-keysym #x004b "K")	       ;U+004B LATIN CAPITAL LETTER K 
-(cl-define-keysym #x004c "L")	       ;U+004C LATIN CAPITAL LETTER L 
-(cl-define-keysym #x004d "M")	       ;U+004D LATIN CAPITAL LETTER M 
-(cl-define-keysym #x004e "N")	       ;U+004E LATIN CAPITAL LETTER N 
-(cl-define-keysym #x004f "O")	       ;U+004F LATIN CAPITAL LETTER O 
-(cl-define-keysym #x0050 "P")	       ;U+0050 LATIN CAPITAL LETTER P 
-(cl-define-keysym #x0051 "Q")	       ;U+0051 LATIN CAPITAL LETTER Q 
-(cl-define-keysym #x0052 "R")	       ;U+0052 LATIN CAPITAL LETTER R 
-(cl-define-keysym #x0053 "S")	       ;U+0053 LATIN CAPITAL LETTER S 
-(cl-define-keysym #x0054 "T")	       ;U+0054 LATIN CAPITAL LETTER T 
-(cl-define-keysym #x0055 "U")	       ;U+0055 LATIN CAPITAL LETTER U 
-(cl-define-keysym #x0056 "V")	       ;U+0056 LATIN CAPITAL LETTER V 
-(cl-define-keysym #x0057 "W")	       ;U+0057 LATIN CAPITAL LETTER W 
-(cl-define-keysym #x0058 "X")	       ;U+0058 LATIN CAPITAL LETTER X 
-(cl-define-keysym #x0059 "Y")	       ;U+0059 LATIN CAPITAL LETTER Y 
-(cl-define-keysym #x005a "Z")	       ;U+005A LATIN CAPITAL LETTER Z 
+(cl-define-keysym #x0041 "A")		;U+0041 LATIN CAPITAL LETTER A 
+(cl-define-keysym #x0042 "B")		;U+0042 LATIN CAPITAL LETTER B 
+(cl-define-keysym #x0043 "C")		;U+0043 LATIN CAPITAL LETTER C 
+(cl-define-keysym #x0044 "D")		;U+0044 LATIN CAPITAL LETTER D 
+(cl-define-keysym #x0045 "E")		;U+0045 LATIN CAPITAL LETTER E 
+(cl-define-keysym #x0046 "F")		;U+0046 LATIN CAPITAL LETTER F 
+(cl-define-keysym #x0047 "G")		;U+0047 LATIN CAPITAL LETTER G 
+(cl-define-keysym #x0048 "H")		;U+0048 LATIN CAPITAL LETTER H 
+(cl-define-keysym #x0049 "I")		;U+0049 LATIN CAPITAL LETTER I 
+(cl-define-keysym #x004a "J")		;U+004A LATIN CAPITAL LETTER J 
+(cl-define-keysym #x004b "K")		;U+004B LATIN CAPITAL LETTER K 
+(cl-define-keysym #x004c "L")		;U+004C LATIN CAPITAL LETTER L 
+(cl-define-keysym #x004d "M")		;U+004D LATIN CAPITAL LETTER M 
+(cl-define-keysym #x004e "N")		;U+004E LATIN CAPITAL LETTER N 
+(cl-define-keysym #x004f "O")		;U+004F LATIN CAPITAL LETTER O 
+(cl-define-keysym #x0050 "P")		;U+0050 LATIN CAPITAL LETTER P 
+(cl-define-keysym #x0051 "Q")		;U+0051 LATIN CAPITAL LETTER Q 
+(cl-define-keysym #x0052 "R")		;U+0052 LATIN CAPITAL LETTER R 
+(cl-define-keysym #x0053 "S")		;U+0053 LATIN CAPITAL LETTER S 
+(cl-define-keysym #x0054 "T")		;U+0054 LATIN CAPITAL LETTER T 
+(cl-define-keysym #x0055 "U")		;U+0055 LATIN CAPITAL LETTER U 
+(cl-define-keysym #x0056 "V")		;U+0056 LATIN CAPITAL LETTER V 
+(cl-define-keysym #x0057 "W")		;U+0057 LATIN CAPITAL LETTER W 
+(cl-define-keysym #x0058 "X")		;U+0058 LATIN CAPITAL LETTER X 
+(cl-define-keysym #x0059 "Y")		;U+0059 LATIN CAPITAL LETTER Y 
+(cl-define-keysym #x005a "Z")		;U+005A LATIN CAPITAL LETTER Z 
 (cl-define-keysym #x005b "bracketleft")	;U+005B LEFT SQUARE BRACKET 
 (cl-define-keysym #x005c "backslash")	;U+005C REVERSE SOLIDUS 
-(cl-define-keysym #x005d "bracketright") ;U+005D RIGHT SQUARE BRACKET 
-(cl-define-keysym #x005e "asciicircum")	 ;U+005E CIRCUMFLEX ACCENT 
-(cl-define-keysym #x005f "underscore")	 ;U+005F LOW LINE 
-(cl-define-keysym #x0060 "grave")	 ;U+0060 GRAVE ACCENT 
-(cl-define-keysym #x0060 "quoteleft")	 ;deprecated 
-(cl-define-keysym #x0061 "a")		 ;U+0061 LATIN SMALL LETTER A 
-(cl-define-keysym #x0062 "b")		 ;U+0062 LATIN SMALL LETTER B 
-(cl-define-keysym #x0063 "c")		 ;U+0063 LATIN SMALL LETTER C 
-(cl-define-keysym #x0064 "d")		 ;U+0064 LATIN SMALL LETTER D 
-(cl-define-keysym #x0065 "e")		 ;U+0065 LATIN SMALL LETTER E 
-(cl-define-keysym #x0066 "f")		 ;U+0066 LATIN SMALL LETTER F 
-(cl-define-keysym #x0067 "g")		 ;U+0067 LATIN SMALL LETTER G 
-(cl-define-keysym #x0068 "h")		 ;U+0068 LATIN SMALL LETTER H 
-(cl-define-keysym #x0069 "i")		 ;U+0069 LATIN SMALL LETTER I 
-(cl-define-keysym #x006a "j")		 ;U+006A LATIN SMALL LETTER J 
-(cl-define-keysym #x006b "k")		 ;U+006B LATIN SMALL LETTER K 
-(cl-define-keysym #x006c "l")		 ;U+006C LATIN SMALL LETTER L 
-(cl-define-keysym #x006d "m")		 ;U+006D LATIN SMALL LETTER M 
-(cl-define-keysym #x006e "n")		 ;U+006E LATIN SMALL LETTER N 
-(cl-define-keysym #x006f "o")		 ;U+006F LATIN SMALL LETTER O 
-(cl-define-keysym #x0070 "p")		 ;U+0070 LATIN SMALL LETTER P 
-(cl-define-keysym #x0071 "q")		 ;U+0071 LATIN SMALL LETTER Q 
-(cl-define-keysym #x0072 "r")		 ;U+0072 LATIN SMALL LETTER R 
-(cl-define-keysym #x0073 "s")		 ;U+0073 LATIN SMALL LETTER S 
-(cl-define-keysym #x0074 "t")		 ;U+0074 LATIN SMALL LETTER T 
-(cl-define-keysym #x0075 "u")		 ;U+0075 LATIN SMALL LETTER U 
-(cl-define-keysym #x0076 "v")		 ;U+0076 LATIN SMALL LETTER V 
-(cl-define-keysym #x0077 "w")		 ;U+0077 LATIN SMALL LETTER W 
-(cl-define-keysym #x0078 "x")		 ;U+0078 LATIN SMALL LETTER X 
-(cl-define-keysym #x0079 "y")		 ;U+0079 LATIN SMALL LETTER Y 
-(cl-define-keysym #x007a "z")		 ;U+007A LATIN SMALL LETTER Z 
-(cl-define-keysym #x007b "braceleft")	 ;U+007B LEFT CURLY BRACKET 
-(cl-define-keysym #x007c "bar")		 ;U+007C VERTICAL LINE 
-(cl-define-keysym #x007d "braceright")	 ;U+007D RIGHT CURLY BRACKET 
-(cl-define-keysym #x007e "asciitilde")	 ;U+007E TILDE 
-(cl-define-keysym #x00a0 "nobreakspace") ;U+00A0 NO-BREAK SPACE 
-(cl-define-keysym #x00a1 "exclamdown") ;U+00A1 INVERTED EXCLAMATION MARK 
-(cl-define-keysym #x00a2 "cent")	;U+00A2 CENT SIGN 
+(cl-define-keysym #x005d "bracketright")	;U+005D RIGHT SQUARE BRACKET 
+(cl-define-keysym #x005e "asciicircum")	;U+005E CIRCUMFLEX ACCENT 
+(cl-define-keysym #x005f "underscore")	;U+005F LOW LINE 
+(cl-define-keysym #x0060 "grave")		;U+0060 GRAVE ACCENT 
+(cl-define-keysym #x0060 "quoteleft")	;deprecated 
+(cl-define-keysym #x0061 "a")		;U+0061 LATIN SMALL LETTER A 
+(cl-define-keysym #x0062 "b")		;U+0062 LATIN SMALL LETTER B 
+(cl-define-keysym #x0063 "c")		;U+0063 LATIN SMALL LETTER C 
+(cl-define-keysym #x0064 "d")		;U+0064 LATIN SMALL LETTER D 
+(cl-define-keysym #x0065 "e")		;U+0065 LATIN SMALL LETTER E 
+(cl-define-keysym #x0066 "f")		;U+0066 LATIN SMALL LETTER F 
+(cl-define-keysym #x0067 "g")		;U+0067 LATIN SMALL LETTER G 
+(cl-define-keysym #x0068 "h")		;U+0068 LATIN SMALL LETTER H 
+(cl-define-keysym #x0069 "i")		;U+0069 LATIN SMALL LETTER I 
+(cl-define-keysym #x006a "j")		;U+006A LATIN SMALL LETTER J 
+(cl-define-keysym #x006b "k")		;U+006B LATIN SMALL LETTER K 
+(cl-define-keysym #x006c "l")		;U+006C LATIN SMALL LETTER L 
+(cl-define-keysym #x006d "m")		;U+006D LATIN SMALL LETTER M 
+(cl-define-keysym #x006e "n")		;U+006E LATIN SMALL LETTER N 
+(cl-define-keysym #x006f "o")		;U+006F LATIN SMALL LETTER O 
+(cl-define-keysym #x0070 "p")		;U+0070 LATIN SMALL LETTER P 
+(cl-define-keysym #x0071 "q")		;U+0071 LATIN SMALL LETTER Q 
+(cl-define-keysym #x0072 "r")		;U+0072 LATIN SMALL LETTER R 
+(cl-define-keysym #x0073 "s")		;U+0073 LATIN SMALL LETTER S 
+(cl-define-keysym #x0074 "t")		;U+0074 LATIN SMALL LETTER T 
+(cl-define-keysym #x0075 "u")		;U+0075 LATIN SMALL LETTER U 
+(cl-define-keysym #x0076 "v")		;U+0076 LATIN SMALL LETTER V 
+(cl-define-keysym #x0077 "w")		;U+0077 LATIN SMALL LETTER W 
+(cl-define-keysym #x0078 "x")		;U+0078 LATIN SMALL LETTER X 
+(cl-define-keysym #x0079 "y")		;U+0079 LATIN SMALL LETTER Y 
+(cl-define-keysym #x007a "z")		;U+007A LATIN SMALL LETTER Z 
+(cl-define-keysym #x007b "braceleft")	;U+007B LEFT CURLY BRACKET 
+(cl-define-keysym #x007c "bar")		;U+007C VERTICAL LINE 
+(cl-define-keysym #x007d "braceright")	;U+007D RIGHT CURLY BRACKET 
+(cl-define-keysym #x007e "asciitilde")	;U+007E TILDE 
+(cl-define-keysym #x00a0 "nobreakspace")	;U+00A0 NO-BREAK SPACE 
+(cl-define-keysym #x00a1 "exclamdown")	;U+00A1 INVERTED EXCLAMATION MARK 
+(cl-define-keysym #x00a2 "cent")		;U+00A2 CENT SIGN 
 (cl-define-keysym #x00a3 "sterling")	;U+00A3 POUND SIGN 
 (cl-define-keysym #x00a4 "currency")	;U+00A4 CURRENCY SIGN 
 (cl-define-keysym #x00a5 "yen")		;U+00A5 YEN SIGN 
@@ -461,630 +461,630 @@
 (cl-define-keysym #x00a8 "diaeresis")	;U+00A8 DIAERESIS 
 (cl-define-keysym #x00a9 "copyright")	;U+00A9 COPYRIGHT SIGN 
 (cl-define-keysym #x00aa "ordfeminine")	;U+00AA FEMININE ORDINAL INDICATOR 
-(cl-define-keysym #x00ab "guillemotleft") ;U+00AB LEFT-POINTING DOUBLE ANGLE QUOTATION MARK 
-(cl-define-keysym #x00ac "notsign")	  ;U+00AC NOT SIGN 
-(cl-define-keysym #x00ad "hyphen")	  ;U+00AD SOFT HYPHEN 
-(cl-define-keysym #x00ae "registered")	  ;U+00AE REGISTERED SIGN 
-(cl-define-keysym #x00af "macron")	  ;U+00AF MACRON 
-(cl-define-keysym #x00b0 "degree")	  ;U+00B0 DEGREE SIGN 
-(cl-define-keysym #x00b1 "plusminus")	  ;U+00B1 PLUS-MINUS SIGN 
-(cl-define-keysym #x00b2 "twosuperior")	  ;U+00B2 SUPERSCRIPT TWO 
-(cl-define-keysym #x00b3 "threesuperior") ;U+00B3 SUPERSCRIPT THREE 
-(cl-define-keysym #x00b4 "acute")	  ;U+00B4 ACUTE ACCENT 
-(cl-define-keysym #x00b5 "mu")		  ;U+00B5 MICRO SIGN 
-(cl-define-keysym #x00b6 "paragraph")	  ;U+00B6 PILCROW SIGN 
-(cl-define-keysym #x00b7 "periodcentered") ;U+00B7 MIDDLE DOT 
-(cl-define-keysym #x00b8 "cedilla")	   ;U+00B8 CEDILLA 
-(cl-define-keysym #x00b9 "onesuperior")	   ;U+00B9 SUPERSCRIPT ONE 
-(cl-define-keysym #x00ba "masculine") ;U+00BA MASCULINE ORDINAL INDICATOR 
-(cl-define-keysym #x00bb "guillemotright") ;U+00BB RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK 
-(cl-define-keysym #x00bc "onequarter") ;U+00BC VULGAR FRACTION ONE QUARTER 
-(cl-define-keysym #x00bd "onehalf")  ;U+00BD VULGAR FRACTION ONE HALF 
-(cl-define-keysym #x00be "threequarters") ;U+00BE VULGAR FRACTION THREE QUARTERS 
-(cl-define-keysym #x00bf "questiondown") ;U+00BF INVERTED QUESTION MARK 
-(cl-define-keysym #x00c0 "Agrave") ;U+00C0 LATIN CAPITAL LETTER A WITH GRAVE 
-(cl-define-keysym #x00c1 "Aacute") ;U+00C1 LATIN CAPITAL LETTER A WITH ACUTE 
+(cl-define-keysym #x00ab "guillemotleft")	;U+00AB LEFT-POINTING DOUBLE ANGLE QUOTATION MARK 
+(cl-define-keysym #x00ac "notsign")	;U+00AC NOT SIGN 
+(cl-define-keysym #x00ad "hyphen")		;U+00AD SOFT HYPHEN 
+(cl-define-keysym #x00ae "registered")	;U+00AE REGISTERED SIGN 
+(cl-define-keysym #x00af "macron")		;U+00AF MACRON 
+(cl-define-keysym #x00b0 "degree")		;U+00B0 DEGREE SIGN 
+(cl-define-keysym #x00b1 "plusminus")	;U+00B1 PLUS-MINUS SIGN 
+(cl-define-keysym #x00b2 "twosuperior")	;U+00B2 SUPERSCRIPT TWO 
+(cl-define-keysym #x00b3 "threesuperior")	;U+00B3 SUPERSCRIPT THREE 
+(cl-define-keysym #x00b4 "acute")		;U+00B4 ACUTE ACCENT 
+(cl-define-keysym #x00b5 "mu")		;U+00B5 MICRO SIGN 
+(cl-define-keysym #x00b6 "paragraph")	;U+00B6 PILCROW SIGN 
+(cl-define-keysym #x00b7 "periodcentered")	;U+00B7 MIDDLE DOT 
+(cl-define-keysym #x00b8 "cedilla")	;U+00B8 CEDILLA 
+(cl-define-keysym #x00b9 "onesuperior")	;U+00B9 SUPERSCRIPT ONE 
+(cl-define-keysym #x00ba "masculine")	;U+00BA MASCULINE ORDINAL INDICATOR 
+(cl-define-keysym #x00bb "guillemotright")	;U+00BB RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK 
+(cl-define-keysym #x00bc "onequarter")	;U+00BC VULGAR FRACTION ONE QUARTER 
+(cl-define-keysym #x00bd "onehalf")	;U+00BD VULGAR FRACTION ONE HALF 
+(cl-define-keysym #x00be "threequarters")	;U+00BE VULGAR FRACTION THREE QUARTERS 
+(cl-define-keysym #x00bf "questiondown")	;U+00BF INVERTED QUESTION MARK 
+(cl-define-keysym #x00c0 "Agrave")		;U+00C0 LATIN CAPITAL LETTER A WITH GRAVE 
+(cl-define-keysym #x00c1 "Aacute")		;U+00C1 LATIN CAPITAL LETTER A WITH ACUTE 
 (cl-define-keysym #x00c2 "Acircumflex")	;U+00C2 LATIN CAPITAL LETTER A WITH CIRCUMFLEX 
-(cl-define-keysym #x00c3 "Atilde") ;U+00C3 LATIN CAPITAL LETTER A WITH TILDE 
-(cl-define-keysym #x00c4 "Adiaeresis") ;U+00C4 LATIN CAPITAL LETTER A WITH DIAERESIS 
-(cl-define-keysym #x00c5 "Aring") ;U+00C5 LATIN CAPITAL LETTER A WITH RING ABOVE 
-(cl-define-keysym #x00c6 "AE")	      ;U+00C6 LATIN CAPITAL LETTER AE 
-(cl-define-keysym #x00c7 "Ccedilla") ;U+00C7 LATIN CAPITAL LETTER C WITH CEDILLA 
-(cl-define-keysym #x00c8 "Egrave") ;U+00C8 LATIN CAPITAL LETTER E WITH GRAVE 
-(cl-define-keysym #x00c9 "Eacute") ;U+00C9 LATIN CAPITAL LETTER E WITH ACUTE 
+(cl-define-keysym #x00c3 "Atilde")		;U+00C3 LATIN CAPITAL LETTER A WITH TILDE 
+(cl-define-keysym #x00c4 "Adiaeresis")	;U+00C4 LATIN CAPITAL LETTER A WITH DIAERESIS 
+(cl-define-keysym #x00c5 "Aring")		;U+00C5 LATIN CAPITAL LETTER A WITH RING ABOVE 
+(cl-define-keysym #x00c6 "AE")		;U+00C6 LATIN CAPITAL LETTER AE 
+(cl-define-keysym #x00c7 "Ccedilla")	;U+00C7 LATIN CAPITAL LETTER C WITH CEDILLA 
+(cl-define-keysym #x00c8 "Egrave")		;U+00C8 LATIN CAPITAL LETTER E WITH GRAVE 
+(cl-define-keysym #x00c9 "Eacute")		;U+00C9 LATIN CAPITAL LETTER E WITH ACUTE 
 (cl-define-keysym #x00ca "Ecircumflex")	;U+00CA LATIN CAPITAL LETTER E WITH CIRCUMFLEX 
-(cl-define-keysym #x00cb "Ediaeresis") ;U+00CB LATIN CAPITAL LETTER E WITH DIAERESIS 
-(cl-define-keysym #x00cc "Igrave") ;U+00CC LATIN CAPITAL LETTER I WITH GRAVE 
-(cl-define-keysym #x00cd "Iacute") ;U+00CD LATIN CAPITAL LETTER I WITH ACUTE 
+(cl-define-keysym #x00cb "Ediaeresis")	;U+00CB LATIN CAPITAL LETTER E WITH DIAERESIS 
+(cl-define-keysym #x00cc "Igrave")		;U+00CC LATIN CAPITAL LETTER I WITH GRAVE 
+(cl-define-keysym #x00cd "Iacute")		;U+00CD LATIN CAPITAL LETTER I WITH ACUTE 
 (cl-define-keysym #x00ce "Icircumflex")	;U+00CE LATIN CAPITAL LETTER I WITH CIRCUMFLEX 
-(cl-define-keysym #x00cf "Idiaeresis") ;U+00CF LATIN CAPITAL LETTER I WITH DIAERESIS 
-(cl-define-keysym #x00d0 "ETH")	     ;U+00D0 LATIN CAPITAL LETTER ETH 
-(cl-define-keysym #x00d0 "Eth")			;deprecated 
-(cl-define-keysym #x00d1 "Ntilde") ;U+00D1 LATIN CAPITAL LETTER N WITH TILDE 
-(cl-define-keysym #x00d2 "Ograve") ;U+00D2 LATIN CAPITAL LETTER O WITH GRAVE 
-(cl-define-keysym #x00d3 "Oacute") ;U+00D3 LATIN CAPITAL LETTER O WITH ACUTE 
+(cl-define-keysym #x00cf "Idiaeresis")	;U+00CF LATIN CAPITAL LETTER I WITH DIAERESIS 
+(cl-define-keysym #x00d0 "ETH")		;U+00D0 LATIN CAPITAL LETTER ETH 
+(cl-define-keysym #x00d0 "Eth")		;deprecated 
+(cl-define-keysym #x00d1 "Ntilde")		;U+00D1 LATIN CAPITAL LETTER N WITH TILDE 
+(cl-define-keysym #x00d2 "Ograve")		;U+00D2 LATIN CAPITAL LETTER O WITH GRAVE 
+(cl-define-keysym #x00d3 "Oacute")		;U+00D3 LATIN CAPITAL LETTER O WITH ACUTE 
 (cl-define-keysym #x00d4 "Ocircumflex")	;U+00D4 LATIN CAPITAL LETTER O WITH CIRCUMFLEX 
-(cl-define-keysym #x00d5 "Otilde") ;U+00D5 LATIN CAPITAL LETTER O WITH TILDE 
-(cl-define-keysym #x00d6 "Odiaeresis") ;U+00D6 LATIN CAPITAL LETTER O WITH DIAERESIS 
+(cl-define-keysym #x00d5 "Otilde")		;U+00D5 LATIN CAPITAL LETTER O WITH TILDE 
+(cl-define-keysym #x00d6 "Odiaeresis")	;U+00D6 LATIN CAPITAL LETTER O WITH DIAERESIS 
 (cl-define-keysym #x00d7 "multiply")	;U+00D7 MULTIPLICATION SIGN 
-(cl-define-keysym #x00d8 "Oslash") ;U+00D8 LATIN CAPITAL LETTER O WITH STROKE 
-(cl-define-keysym #x00d8 "Ooblique") ;U+00D8 LATIN CAPITAL LETTER O WITH STROKE 
-(cl-define-keysym #x00d9 "Ugrave") ;U+00D9 LATIN CAPITAL LETTER U WITH GRAVE 
-(cl-define-keysym #x00da "Uacute") ;U+00DA LATIN CAPITAL LETTER U WITH ACUTE 
+(cl-define-keysym #x00d8 "Oslash")		;U+00D8 LATIN CAPITAL LETTER O WITH STROKE 
+(cl-define-keysym #x00d8 "Ooblique")	;U+00D8 LATIN CAPITAL LETTER O WITH STROKE 
+(cl-define-keysym #x00d9 "Ugrave")		;U+00D9 LATIN CAPITAL LETTER U WITH GRAVE 
+(cl-define-keysym #x00da "Uacute")		;U+00DA LATIN CAPITAL LETTER U WITH ACUTE 

[2215 lines skipped]
--- /project/clfswm/cvsroot/clfswm/load.lisp	2008/02/26 22:02:24	1.8
+++ /project/clfswm/cvsroot/clfswm/load.lisp	2008/05/02 19:56:08	1.9
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 26 23:00:22 2008
+;;; #Date#: Fri Dec 21 23:00:32 2007
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: System loading functions
@@ -38,9 +38,6 @@
 (require :asdf)
 
 #+SBCL
-(require :sb-posix)
-
-#+SBCL
 (require :clx)
 
 #-ASDF
@@ -56,4 +53,4 @@
 
 (in-package :clfswm)
 
-(clfswm:main ":0")
+(clfswm:main)
--- /project/clfswm/cvsroot/clfswm/netwm-util.lisp	2008/02/24 20:53:37	1.4
+++ /project/clfswm/cvsroot/clfswm/netwm-util.lisp	2008/05/02 19:56:08	1.5
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Feb 20 23:26:21 2008
+;;; #Date#: Fri Dec 21 23:00:38 2007
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: NetWM functions
@@ -31,36 +31,36 @@
 
 ;;; Client List functions 
 (defun netwm-set-client-list (id-list)
-  (xlib:change-property *root* :_NET_CLIENT_LIST id-list :window 32))
+  (change-property *root* :_NET_CLIENT_LIST id-list :window 32))
 
 (defun netwm-get-client-list ()
-  (xlib:get-property *root* :_NET_CLIENT_LIST))
+  (get-property *root* :_NET_CLIENT_LIST))
 
 (defun netwm-add-in-client-list (window)
   (let ((last-list (netwm-get-client-list)))
-    (pushnew (xlib:window-id window) last-list)
+    (pushnew (window-id window) last-list)
     (netwm-set-client-list last-list)))
 
 (defun netwm-remove-in-client-list (window)
-  (netwm-set-client-list (remove (xlib:window-id window) (netwm-get-client-list))))
+  (netwm-set-client-list (remove (window-id window) (netwm-get-client-list))))
 
 
- 
-;;; Desktop functions ;; +PHIL
+
+;;; Desktop functions
 (defun netwm-update-desktop-property ()
-  ;;  (xlib:change-property *root* :_NET_NUMBER_OF_DESKTOPS
-  ;;		   (list (length *workspace-list*)) :cardinal 32)
-  ;;  (xlib:change-property *root* :_NET_DESKTOP_GEOMETRY
-  ;;		   (list (xlib:screen-width *screen*)
-  ;;			 (xlib:screen-height *screen*))
-  ;;		   :cardinal 32)
-  ;;  (xlib:change-property *root* :_NET_DESKTOP_VIEWPORT
-  ;;		   (list 0 0) :cardinal 32)
-  ;;  (xlib:change-property *root* :_NET_CURRENT_DESKTOP
-  ;;		   (list 1) :cardinal 32)
-;;; TODO
-  ;;(xlib:change-property *root* :_NET_DESKTOP_NAMES
-  ;;		   (list "toto" "klm" "poi") :string 8 :transform #'xlib:char->card8))
+  (change-property *root* :_NET_NUMBER_OF_DESKTOPS
+		   (list (length *workspace-list*)) :cardinal 32)
+  (change-property *root* :_NET_DESKTOP_GEOMETRY
+		   (list (screen-width *screen*)
+			 (screen-height *screen*))
+		   :cardinal 32)
+  (change-property *root* :_NET_DESKTOP_VIEWPORT
+		   (list 0 0) :cardinal 32)
+  (change-property *root* :_NET_CURRENT_DESKTOP
+		   (list 1) :cardinal 32)
+  ;;; TODO
+  ;;(change-property *root* :_NET_DESKTOP_NAMES
+  ;;		   (list "toto" "klm" "poi") :string 8 :transform #'char->card8))
   )
 
 
@@ -71,25 +71,20 @@
   "Set NETWM properties on the root window of the specified screen.
 FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK."
   ;; _NET_SUPPORTED
-  (xlib:change-property *root* :_NET_SUPPORTED
-			(mapcar (lambda (a)
-				  (xlib:intern-atom *display* a))
-				(append +netwm-supported+
-					(mapcar 'car +netwm-window-types+)))
-			:atom 32)
+  (change-property *root* :_NET_SUPPORTED
+		   (mapcar (lambda (a)
+			     (xlib:intern-atom *display* a))
+			   (append +netwm-supported+
+				   (mapcar 'car +netwm-window-types+)))
+		   :atom 32)
   ;; _NET_SUPPORTING_WM_CHECK
-  (xlib:change-property *root* :_NET_SUPPORTING_WM_CHECK
-			(list *no-focus-window*) :window 32
-			:transform #'xlib:drawable-id)
-  (xlib:change-property *no-focus-window* :_NET_SUPPORTING_WM_CHECK
-			(list *no-focus-window*) :window 32
-			:transform #'xlib:drawable-id)
-  (xlib:change-property *no-focus-window* :_NET_WM_NAME
-			"clfswm"
-			:string 8 :transform #'xlib:char->card8)
-  (netwm-update-desktop-property))
-
-
-
-
-
+  (change-property *root* :_NET_SUPPORTING_WM_CHECK
+		   (list *no-focus-window*) :window 32
+		   :transform #'drawable-id)
+  (change-property *no-focus-window* :_NET_SUPPORTING_WM_CHECK
+		   (list *no-focus-window*) :window 32
+		   :transform #'drawable-id)
+  (change-property *no-focus-window* :_NET_WM_NAME
+		   "clfswm"
+		   :string 8 :transform #'char->card8)
+  (netwm-update-desktop-property))
\ No newline at end of file
--- /project/clfswm/cvsroot/clfswm/package.lisp	2008/02/26 22:02:02	1.11
+++ /project/clfswm/cvsroot/clfswm/package.lisp	2008/05/02 19:56:08	1.12
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Mon Feb 25 21:33:22 2008
+;;; #Date#: Tue Jan  1 20:11:50 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Package definition
@@ -28,12 +28,15 @@
 (in-package :cl-user)
 
 (defpackage clfswm
-  (:use :common-lisp :my-html :tools)
+  (:use :common-lisp :xlib :my-html :tools)
   ;;(:shadow :defun)
   (:export :main))
 
 (in-package :clfswm)
 
+(defstruct workspace number group-list)
+(defstruct group x y width height window-list fullscreenp)
+
 
 (defparameter *display* nil)
 (defparameter *screen* nil)
@@ -41,53 +44,12 @@
 (defparameter *no-focus-window* nil)
 (defparameter *root-gc* nil)
 
-(defparameter *default-font* nil)
-;;(defparameter *default-font-string* "9x15")
-(defparameter *default-font-string* "fixed")
-
-
-(defparameter *child-selection* nil)
-
-(defparameter *layout-list* nil)
-
-
-;;(defstruct group (number (incf *current-group-number*)) name
-;;	   (x 0) (y 0) (w 1) (h 1) rx ry rw rh
-;;	   layout window gc child)
-
-(defclass group ()
-  ((name :initarg :name :accessor group-name :initform nil)
-   (number :initarg :number :accessor group-number :initform 0)
-   ;;; Float size between 0 and 1 - Manipulate only this variable and not real size
-   (x :initarg :x :accessor group-x :initform 0.1)
-   (y :initarg :y :accessor group-y :initform 0.1)
-   (w :initarg :w :accessor group-w :initform 0.8)
-   (h :initarg :h :accessor group-h :initform 0.8)
-   ;;; Real size (integer) in screen size - Don't set directly this variables
-   ;;; they may be recalculated by the layout manager.
-   (rx :initarg :rx :accessor group-rx :initform 0)
-   (ry :initarg :ry :accessor group-ry :initform 0)
-   (rw :initarg :rw :accessor group-rw :initform 800)
-   (rh :initarg :rh :accessor group-rh :initform 600)
-   (layout :initarg :layout :accessor group-layout :initform nil)
-   (window :initarg :window :accessor group-window :initform nil)
-   (gc :initarg :gc :accessor group-gc :initform nil)
-   (child :initarg :child :accessor group-child :initform nil)
-   (data :initarg :data :accessor group-data
-	 :initform (list '(:tile-size 0.8) '(:tile-space-size 0.1))
-	 :documentation "An assoc list to store additional data")))
-
 
 
-(defparameter *root-group* nil
-  "Root of the root - ie the root group")
-(defparameter *current-root* nil
-  "The current fullscreen maximized child")
-(defparameter *current-child* nil
-  "The current child with the focus")
-
-(defparameter *show-root-group-p* nil)
+(defparameter *default-group* nil)
 
+(defparameter *workspace-list* nil)
+(defparameter *current-workspace-number* 0)
 
 (defparameter *main-keys* (make-hash-table :test 'equal))
 (defparameter *second-keys* (make-hash-table :test 'equal))
@@ -125,12 +87,8 @@
 ;;;
 ;;; See clfswm.lisp for hooks examples.
 
-;;; Init hook. This hook is run just after the first root group is created
-(defparameter *init-hook* nil)
-
 ;;; Main mode hooks (set in clfswm.lisp)
 (defparameter *button-press-hook* nil)
-(defparameter *button-motion-notify-hook* nil)
 (defparameter *key-press-hook* nil)
 (defparameter *configure-request-hook* nil)
 (defparameter *configure-notify-hook* nil)
@@ -199,5 +157,5 @@
 ;;	(error (c)
 ;;	  (format t "New defun: Error in ~A : ~A~%" ',name c)
 ;;	  (format t "Root tree=~A~%All windows=~A~%"
-;;		  (xlib:query-tree *root*) (get-all-windows))
+;;		  (query-tree *root*) (get-all-windows))
 ;;	  (force-output))))))
--- /project/clfswm/cvsroot/clfswm/tools.lisp	2008/02/26 22:02:02	1.7
+++ /project/clfswm/cvsroot/clfswm/tools.lisp	2008/05/02 19:56:08	1.8
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 26 21:53:55 2008
+;;; #Date#: Thu Jan  3 22:53:59 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: General tools
@@ -30,10 +30,7 @@
 
 (defpackage tools
   (:use common-lisp)
-  (:export :it
-	   :awhen
-	   :aif
-	   :dbg
+  (:export :dbg
 	   :dbgnl
 	   :setf/=
 	   :create-symbol
@@ -84,13 +81,6 @@
 
 
 
-(defmacro awhen (test &body body)
-  `(let ((it ,test))
-     (when it
-       , at body)))
-
-(defmacro aif (test then &optional else)
-  `(let ((it ,test)) (if it ,then ,else)))
 
 
 ;;;,-----
@@ -102,36 +92,36 @@
 
 (defmacro dbg (&rest forms)
   `(progn
-     ,@(mapcar #'(lambda (form)
-		   (typecase form
-		     (string `(setf *%dbg-name%* ,form))
-		     (number `(setf *%dbg-count%* ,form))))
-	       forms)
-     (format t "~&DEBUG[~A - ~A]  " (incf *%dbg-count%*) *%dbg-name%*)
-     ,@(mapcar #'(lambda (form)
-		   (typecase form
-		     ((or string number) nil)
-		     (t `(format t "~A=~S   " ',form ,form))))
-	       forms)
-     (format t "~%")
-     (force-output)
-     , at forms))
+    ,@(mapcar #'(lambda (form)
+		  (typecase form
+		    (string `(setf *%dbg-name%* ,form))
+		    (number `(setf *%dbg-count%* ,form))))
+	      forms)
+    (format t "~&DEBUG[~A - ~A]  " (incf *%dbg-count%*) *%dbg-name%*)
+    ,@(mapcar #'(lambda (form)
+		  (typecase form
+		    ((or string number) nil)
+		    (t `(format t "~A=~S   " ',form ,form))))
+	      forms)
+    (format t "~%")
+    (force-output)
+    , at forms))
 
 (defmacro dbgnl (&rest forms)
   `(progn
-     ,@(mapcar #'(lambda (form)
-		   (typecase form
-		     (string `(setf *%dbg-name%* ,form))
-		     (number `(setf *%dbg-count%* ,form))))
-	       forms)
-     (format t "~&DEBUG[~A - ~A] --------------------~%" (incf *%dbg-count%*) *%dbg-name%*)
-     ,@(mapcar #'(lambda (form)
-		   (typecase form
-		     ((or string number) nil)
-		     (t `(format t "  -  ~A=~S~%" ',form ,form))))
-	       forms)
-     (force-output)
-     , at forms))
+    ,@(mapcar #'(lambda (form)
+		  (typecase form
+		    (string `(setf *%dbg-name%* ,form))
+		    (number `(setf *%dbg-count%* ,form))))
+	      forms)
+    (format t "~&DEBUG[~A - ~A] --------------------~%" (incf *%dbg-count%*) *%dbg-name%*)
+    ,@(mapcar #'(lambda (form)
+		  (typecase form
+		    ((or string number) nil)
+		    (t `(format t "  -  ~A=~S~%" ',form ,form))))
+	      forms)
+    (force-output)
+    , at forms))
 
 
 
@@ -157,10 +147,10 @@
 (defun split-string (string &optional (separator #\Space))
   "Return a list from a string splited at each separators"
   (loop for i = 0 then (1+ j)
-     as j = (position separator string :start i)
-     as sub = (subseq string i j)
-     unless (string= sub "") collect sub
-     while j))
+        as j = (position separator string :start i)
+        as sub = (subseq string i j)
+        unless (string= sub "") collect sub
+        while j))
 
 
 (defun expand-newline (list)
@@ -212,13 +202,13 @@
   (zerop (or (search word string) -1)))
 
 
-(defun find-free-number (l)		; stolen from stumpwm - thanks
+(defun find-free-number (l)     ; stolen from stumpwm - thanks
   "Return a number that is not in the list l."
   (let* ((nums (sort l #'<))
 	 (new-num (loop for n from 0 to (or (car (last nums)) 0)
-		     for i in nums
-		     when (/= n i)
-		     do (return n))))
+			for i in nums
+			when (/= n i)
+			do (return n))))
     (if new-num
 	new-num
 	;; there was no space between the numbers, so use the last + 1
@@ -240,21 +230,21 @@
     (dolist (a args)
       (setf fullstring (concatenate 'string fullstring " " a)))
     #+:cmu (let ((proc (ext:run-program program args :input :stream
-							    :output :stream :wait wt)))
+					:output :stream :wait wt)))
              (unless proc
                (error "Cannot create process."))
              (make-two-way-stream
               (ext:process-output proc)
               (ext:process-input proc)))
     #+:clisp (let ((proc (ext:run-program program :arguments args
-						  :input :stream :output
-						  :stream :wait (or wt t))))
+					  :input :stream :output
+					  :stream :wait (or wt t))))
 	       (unless proc
 		 (error "Cannot create process."))
 	       proc)
     #+:sbcl (let ((proc (sb-ext:run-program program args :input
-							 :stream :output
-							 :stream :wait wt)))
+					    :stream :output
+					    :stream :wait wt)))
 	      (unless proc
 		(error "Cannot create process."))
 	      (make-two-way-stream 
@@ -270,8 +260,8 @@
     #+:ecl(ext:run-program program args :input :stream :output :stream
 			   :error :output)
     #+:openmcl (let ((proc (ccl:run-program program args :input
-							 :stream :output
-							 :stream :wait wt)))
+					    :stream :output
+					    :stream :wait wt)))
 		 (unless proc
 		   (error "Cannot create process."))
 		 (make-two-way-stream
@@ -309,7 +299,7 @@
   #+clisp (setf (ext:getenv (string var)) (string val))
   #+(or cmu scl)
   (let ((cell (assoc (string var) ext:*environment-list* :test #'equalp
-							 :key #'string)))
+                     :key #'string)))
     (if cell
         (setf (cdr cell) (string val))
         (push (cons (intern (string var) "KEYWORD") (string val))
@@ -402,14 +392,14 @@
 
 (defun ushell-loop (&optional (shell-fun #'ushell))
   (loop
-     (format t "UNI-SHELL> ")
-     (let* ((line (read-line)))
-       (cond ((zerop (or (search "quit" line) -1)) (return))
-	     ((zerop (or (position #\! line) -1))
-	      (funcall shell-fun (subseq line 1)))
-	     (t (format t "~{~A~^ ;~%~}~%"
-			(multiple-value-list 
-			 (ignore-errors (eval (read-from-string line))))))))))
+   (format t "UNI-SHELL> ")
+   (let* ((line (read-line)))
+     (cond ((zerop (or (search "quit" line) -1)) (return))
+	   ((zerop (or (position #\! line) -1))
+	    (funcall shell-fun (subseq line 1)))
+	   (t (format t "~{~A~^ ;~%~}~%"
+		      (multiple-value-list 
+		       (ignore-errors (eval (read-from-string line))))))))))
 
 
 
@@ -435,10 +425,10 @@
 	(index (position split-char str :start start)
 	       (position split-char str :start start))
 	(accum nil))
-       ((null index)
-	(unless (string= (subseq str start) "")
-	  (push (subseq str start) accum))
-	(nreverse accum))
+      ((null index)
+       (unless (string= (subseq str start) "")
+	 (push (subseq str start) accum))
+       (nreverse accum))
     (when (/= start index)
       (push (subseq str start index) accum))))
 
@@ -452,10 +442,10 @@
 		 (if ret
 		     (if (< pos ret)
 			 pos
-			 ret)
-		     pos)
-		 ret)))
-       ((null char) ret)))
+		       ret)
+		   pos)
+	       ret)))
+      ((null char) ret)))
 
   
 ;;;(defun near-position2 (chars str &key (start 0))
@@ -476,10 +466,10 @@
 	(index (near-position split-chars str :start start)
 	       (near-position split-chars str :start start))
 	(accum nil))
-       ((null index)
-	(unless (string= (subseq str start) "")
-	  (push (subseq str start) accum))
-	(nreverse accum))
+      ((null index)
+       (unless (string= (subseq str start) "")
+	 (push (subseq str start) accum))
+       (nreverse accum))
     (let ((retstr (subseq str start (if preserve (1+ index) index))))
       (unless (string= retstr "")
 	(push retstr accum)))))
@@ -606,7 +596,7 @@
 ;;                                                                  ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun find-string (substr str &key (start 0) (end nil)
-		    (test nil) (ignore-case nil))
+			   (test nil) (ignore-case nil))
   "Find substr in str. Return begin and end of substr in str as two values.
 Start and end set the findinq region. Ignore-case make find-string case
 insensitive.
@@ -623,7 +613,7 @@
     (do ((done nil))
 	(done (if (functionp test)
 		  (funcall test str pos1 pos2)
-		  (values pos1 pos2)))
+		(values pos1 pos2)))
       (setq pos1 (position (aref substr 0) str :start (+ pos1 1) :end end))
       (unless pos1
 	(return-from find-string nil))
@@ -634,16 +624,16 @@
 
 
 (defun find-all-strings (substr str &key (start 0) (end nil)
-			 (test nil) (ignore-case nil))
+				(test nil) (ignore-case nil))
   "Find all substr in str. Parameters are the same as find-string.
 Return a list with all begin and end positions of substr in str
 ie: '((pos1.1 pos1.2) (pos2.1 pos2.2))..."
   (do ((pos (multiple-value-list
 	     (find-string substr str :start start :end end
-						  :test test :ignore-case ignore-case))
+			  :test test :ignore-case ignore-case))
 	    (multiple-value-list
 	     (find-string substr str :start (second pos) :end end
-							 :test test :ignore-case ignore-case)))
+			  :test test :ignore-case ignore-case)))
        (accum nil))
       ((equal pos '(nil)) (nreverse accum))
     (push pos accum)))
@@ -651,7 +641,7 @@
 
 
 (defun subst-strings (new substr str &key (start 0) (end nil)
-		      (test nil) (ignore-case nil))
+			  (test nil) (ignore-case nil))
   "Substitute all substr strings in str with new.
 New must be a string or a function witch takes str pos1 pos2
 as parameters and return a string to replace substr"
@@ -674,20 +664,20 @@
 				      (subseq str pos1 pos2)
 				      (if (functionp new)
 					  (funcall new str pos2 newpos)
-					  new)))
+					new)))
 	    (setq pos1 (if (and newpos (<= newpos end))
 			   newpos
-			   end)))
-	  (progn
-	    (setq outstr (concatenate 'string
-				      outstr (subseq str pos1)))
-	    (setq done t))))))
+			 end)))
+	(progn
+	  (setq outstr (concatenate 'string
+				    outstr (subseq str pos1)))
+	  (setq done t))))))
 
 
 
 (defun my-find-string-test (str pos1 pos2)
   (multiple-value-bind
-	(npos1 npos2)
+      (npos1 npos2)
       (find-string "=>" str :start pos2)
     (declare (ignore npos1))
     (values pos1 npos2)))
@@ -709,7 +699,7 @@
 
     (format t "[3] Find with test (ie '<=.*=>'): ~A~%"
 	    (multiple-value-bind
-		  (pos1 pos2)
+		(pos1 pos2)
 		(find-string "<=" str :test #'my-find-string-test)
 	      (subseq str pos1 pos2)))
 
@@ -741,7 +731,7 @@
 	     "<=" str
 	     :test #'(lambda (str pos1 pos2)
 		       (multiple-value-bind
-			     (npos1 npos2)
+			   (npos1 npos2)
 			   (find-string "=>" str :start pos2)
 			 (declare (ignore npos1))
 			 (values pos1 npos2)))))))
--- /project/clfswm/cvsroot/clfswm/xlib-util.lisp	2008/02/29 23:05:56	1.7
+++ /project/clfswm/cvsroot/clfswm/xlib-util.lisp	2008/05/02 19:56:08	1.8
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Feb 28 21:55:00 2008
+;;; #Date#: Thu Jan  3 17:50:59 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility functions
@@ -38,10 +38,7 @@
 				:property-change
 				:colormap-change
 				:focus-change
-				:enter-window
-				:exposure)
-  ;;:button-press
-  ;;:button-release)
+				:enter-window)
   "The events to listen for on managed windows.")
 
 
@@ -57,64 +54,33 @@
 Window types are in +WINDOW-TYPES+.")
 
 (defparameter +netwm-window-types+
-  '((:_NET_WM_WINDOW_TYPE_DESKTOP . :desktop)
-    (:_NET_WM_WINDOW_TYPE_DOCK . :dock)
-    (:_NET_WM_WINDOW_TYPE_TOOLBAR . :toolbar)
-    (:_NET_WM_WINDOW_TYPE_MENU . :menu)
-    (:_NET_WM_WINDOW_TYPE_UTILITY . :utility)
-    (:_NET_WM_WINDOW_TYPE_SPLASH . :splash)
+  '(
+    ;; (:_NET_WM_WINDOW_TYPE_DESKTOP . :desktop)
+    ;; (:_NET_WM_WINDOW_TYPE_DOCK . :dock)
+    ;; (:_NET_WM_WINDOW_TYPE_TOOLBAR . :toolbar)
+    ;; (:_NET_WM_WINDOW_TYPE_MENU . :menu)
+    ;; (:_NET_WM_WINDOW_TYPE_UTILITY . :utility)
+    ;; (:_NET_WM_WINDOW_TYPE_SPLASH . :splash)
     (:_NET_WM_WINDOW_TYPE_DIALOG . :dialog)
     (:_NET_WM_WINDOW_TYPE_NORMAL . :normal))
-  "Alist mapping NETWM window types to keywords.")
-
-
-(defmacro with-xlib-protect (&body body)
-  "Prevent Xlib errors"
-  `(handler-case
-       (progn
-	 , at body)
-     ((or xlib:match-error xlib:window-error xlib:drawable-error) (c)
-       (declare (ignore c)))))
-
-
-
-(defun parse-display-string (display)
-  "Parse an X11 DISPLAY string and return the host and display from it."
-  (let* ((colon (position #\: display))
-	 (host (subseq display 0 colon))
-	 (rest (subseq display (1+ colon)))
-	 (dot (position #\. rest))
-	 (num (parse-integer (subseq rest 0 dot))))
-    (values host num)))
-
-
-(defun banish-pointer ()
-  "Move the pointer to the lower right corner of the screen"
-  (xlib:warp-pointer *root*
-		     (1- (xlib:screen-width *screen*))
-		     (1- (xlib:screen-height *screen*))))
-
-
+  "Alist mapping NETWM window types to keywords.
+Include only those we are ready to support.")
 
 
+(defun set-window-state (win state)
+  "Set the state (iconic, normal, withdrawn) of a window."
+  (change-property win
+		   :WM_STATE
+		   (list state)
+		   :WM_STATE
+		   32))
 
 (defun window-state (win)
   "Get the state (iconic, normal, withdraw of a window."
-  (first (xlib:get-property win :WM_STATE)))
-
-
-(defun set-window-state (win state)
-  "Set the state (iconic, normal, withdrawn) of a window."
-  (xlib:change-property win
-			:WM_STATE
-			(list state)
-			:WM_STATE
-			32))
+  (first (get-property win :WM_STATE)))
 
 (defsetf window-state set-window-state)
 
-
-
 (defun window-hidden-p (window)
   (eql (window-state window) +iconic-state+))
 
@@ -122,182 +88,66 @@
 
 (defun unhide-window (window)
   (when window
-    (with-xlib-protect
-      (xlib:map-window window)
-      (setf (window-state window) +normal-state+
-	    (xlib:window-event-mask window) *window-events*))))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-;;(defconstant +exwm-atoms+
-;;  (list "_NET_SUPPORTED"              "_NET_CLIENT_LIST"
-;;	"_NET_CLIENT_LIST_STACKING"   "_NET_NUMBER_OF_DESKTOPS"
-;;	"_NET_CURRENT_DESKTOP"        "_NET_DESKTOP_GEOMETRY"
-;;	"_NET_DESKTOP_VIEWPORT"       "_NET_DESKTOP_NAMES"
-;;	"_NET_ACTIVE_WINDOW"          "_NET_WORKAREA"
-;;	"_NET_SUPPORTING_WM_CHECK"    "_NET_VIRTUAL_ROOTS"
-;;	"_NET_DESKTOP_LAYOUT"         
-;;
-;;        "_NET_RESTACK_WINDOW"         "_NET_REQUEST_FRAME_EXTENTS"
-;;        "_NET_MOVERESIZE_WINDOW"      "_NET_CLOSE_WINDOW"
-;;        "_NET_WM_MOVERESIZE"
-;;
-;;	"_NET_WM_SYNC_REQUEST"        "_NET_WM_PING"    
-;;
-;;	"_NET_WM_NAME"                "_NET_WM_VISIBLE_NAME"
-;;	"_NET_WM_ICON_NAME"           "_NET_WM_VISIBLE_ICON_NAME"
-;;	"_NET_WM_DESKTOP"             "_NET_WM_WINDOW_TYPE"
-;;	"_NET_WM_STATE"               "_NET_WM_STRUT"
-;;	"_NET_WM_ICON_GEOMETRY"       "_NET_WM_ICON"
-;;	"_NET_WM_PID"                 "_NET_WM_HANDLED_ICONS"
-;;	"_NET_WM_USER_TIME"           "_NET_FRAME_EXTENTS"
-;;        ;; "_NET_WM_MOVE_ACTIONS"
-;;
-;;	"_NET_WM_WINDOW_TYPE_DESKTOP" "_NET_WM_STATE_MODAL"
-;;	"_NET_WM_WINDOW_TYPE_DOCK"    "_NET_WM_STATE_STICKY"
-;;	"_NET_WM_WINDOW_TYPE_TOOLBAR" "_NET_WM_STATE_MAXIMIZED_VERT"
-;;	"_NET_WM_WINDOW_TYPE_MENU"    "_NET_WM_STATE_MAXIMIZED_HORZ"
-;;	"_NET_WM_WINDOW_TYPE_UTILITY" "_NET_WM_STATE_SHADED"
-;;	"_NET_WM_WINDOW_TYPE_SPLASH"  "_NET_WM_STATE_SKIP_TASKBAR"
-;;	"_NET_WM_WINDOW_TYPE_DIALOG"  "_NET_WM_STATE_SKIP_PAGER"
-;;	"_NET_WM_WINDOW_TYPE_NORMAL"  "_NET_WM_STATE_HIDDEN"
-;;	                              "_NET_WM_STATE_FULLSCREEN"
-;;				      "_NET_WM_STATE_ABOVE"
-;;				      "_NET_WM_STATE_BELOW"
-;;				      "_NET_WM_STATE_DEMANDS_ATTENTION"
-;;			
-;;	"_NET_WM_ALLOWED_ACTIONS"
-;;	"_NET_WM_ACTION_MOVE"
-;;	"_NET_WM_ACTION_RESIZE"
-;;	"_NET_WM_ACTION_SHADE"
-;;	"_NET_WM_ACTION_STICK"
-;;	"_NET_WM_ACTION_MAXIMIZE_HORZ"
-;;	"_NET_WM_ACTION_MAXIMIZE_VERT"
-;;	"_NET_WM_ACTION_FULLSCREEN"
-;;	"_NET_WM_ACTION_CHANGE_DESKTOP"
-;;	"_NET_WM_ACTION_CLOSE"
-;;
-;;	))
-;;
-;;
-;;(defun intern-atoms (display)
-;;  (declare (type xlib:display display))
-;;  (mapcar #'(lambda (atom-name) (xlib:intern-atom display atom-name))
-;;	  +exwm-atoms+)
-;;  (values))
-;;
-;;
-;;
-;;(defun get-atoms-property (window property-atom atom-list-p)
-;;  "Returns a list of atom-name (if atom-list-p is t) otherwise returns
-;;   a list of atom-id."
-;;  (xlib:get-property window property-atom
-;;		     :transform (when atom-list-p
-;;				  (lambda (id)
-;;				    (xlib:atom-name (xlib:drawable-display window) id)))))
-;;
-;;(defun set-atoms-property (window atoms property-atom &key (mode :replace))
-;;  "Sets the property designates by `property-atom'. ATOMS is a list of atom-id
-;;   or a list of keyword atom-names."
-;;  (xlib:change-property window property-atom atoms :ATOM 32 
-;;			:mode mode
-;;			:transform (unless (integerp (car atoms))
-;;				     (lambda (atom-key)
-;;				       (xlib:find-atom (xlib:drawable-display window) atom-key)))))
-;;
-;;
-;;
-;;
-;;(defun net-wm-state (window)
-;;  (get-atoms-property window :_NET_WM_STATE t))
-;;
-;;(defsetf net-wm-state (window &key (mode :replace)) (states)
-;;  `(set-atoms-property ,window ,states :_NET_WM_STATE :mode ,mode))
-;;
-;;
-;;
-;;(defun hide-window (window)
-;;  (when window
-;;    (with-xlib-protect
-;;      (let ((net-wm-state (net-wm-state window)))
-;;	(dbg net-wm-state)
-;;	(pushnew :_net_wm_state_hidden net-wm-state)
-;;	(setf (net-wm-state window) net-wm-state)
-;;	(dbg (net-wm-state window)))
-;;      (setf (window-state window) +iconic-state+
-;;	    (xlib:window-event-mask window) (remove :structure-notify *window-events*))
-;;      (xlib:unmap-window window)
-;;      (setf (xlib:window-event-mask window) *window-events*))))
+    (handler-case
+	(progn
+	  (map-window window)
+	  (setf (window-state window) +normal-state+))
+      ((or match-error window-error drawable-error) (c)
+	(declare (ignore c))))))
+	;;(dbg "Unhide window" window c)))))
 
 
 (defun hide-window (window)
   (when window
-    (with-xlib-protect
-      (setf (window-state window) +iconic-state+
-	    (xlib:window-event-mask window) (remove :structure-notify *window-events*))
-      (xlib:unmap-window window)
-      (setf (xlib:window-event-mask window) *window-events*))))
-
+    (handler-case
+	(progn
+	  (setf (window-state window) +iconic-state+
+		(window-event-mask window) (remove :structure-notify *window-events*))
+	  (unmap-window window)
+	  (setf (window-event-mask window) *window-events*))
+      ((or match-error window-error drawable-error) (c)
+	(declare (ignore c))))))
+	;;(dbg "Hide window" window c)))))
 
 
 (defun window-type (window)
-  "Return one of :desktop, :dock, :toolbar, :utility, :splash,
-:dialog, :transient, :maxsize and :normal."
-  (or (and (let ((hints (xlib:wm-normal-hints window)))
-             (and hints (or (xlib:wm-size-hints-max-width hints)
-                            (xlib:wm-size-hints-max-height hints)
-                            (xlib:wm-size-hints-min-aspect hints)
-                            (xlib:wm-size-hints-max-aspect hints))))
-           :maxsize)
-      (let ((net-wm-window-type (xlib:get-property window :_NET_WM_WINDOW_TYPE)))
-        (when net-wm-window-type
-          (dolist (type-atom net-wm-window-type)
-            (when (assoc (xlib:atom-name *display* type-atom) +netwm-window-types+)
-              (return (cdr (assoc (xlib:atom-name *display* type-atom) +netwm-window-types+)))))))
-      (and (xlib:get-property window :WM_TRANSIENT_FOR)
-           :transient)
+  "Return one of :maxsize, :transient, or :normal."
+  (or (and (get-property window :WM_TRANSIENT_FOR)
+	   :transient)
+      (and (let ((hints (wm-normal-hints window)))
+	     (and hints (or (wm-size-hints-max-width hints)
+			    (wm-size-hints-max-height hints))))
+	   :maxsize)
       :normal))
 
 
 
 
-
 ;; Stolen from Eclipse
 (defun send-configuration-notify (window)
   "Send a synthetic configure notify event to the given window (ICCCM 4.1.5)"
   (multiple-value-bind (x y)
-      (xlib:translate-coordinates window 0 0 (xlib:drawable-root window))
-    (xlib:send-event window
-		     :configure-notify
-		     (xlib:make-event-mask :structure-notify)
-		     :event-window window :window window
-		     :x x :y y
-		     :override-redirect-p nil
-		     :border-width (xlib:drawable-border-width window)
-		     :width (xlib:drawable-width window)
-		     :height (xlib:drawable-height window)
-		     :propagate-p nil)))
+      (translate-coordinates window 0 0 (drawable-root window))
+    (send-event window
+		:configure-notify
+		(make-event-mask :structure-notify)
+		:event-window window :window window
+		:x x :y y
+		:override-redirect-p nil
+		:border-width (drawable-border-width window)
+		:width (drawable-width window)
+		:height (drawable-height window)
+		:propagate-p nil)))
 
 
 (defun send-client-message (window type &rest data)
   "Send a client message to a client's window."
-  (xlib:send-event window
-		   :client-message nil
-		   :window window
-		   :type type
-		   :format 32
-		   :data data))
+  (send-event window
+	      :client-message nil
+	      :window window
+	      :type type
+	      :format 32
+	      :data data))
 
 
 
@@ -306,19 +156,26 @@
 (defun raise-window (window)
   "Map the window if needed and bring it to the top of the stack. Does not affect focus."
   (when window
-    (with-xlib-protect
-      (when (window-hidden-p window)
-	(unhide-window window))
-      (setf (xlib:window-priority window) :top-if))))
+    (handler-case
+	(progn
+	  (when (window-hidden-p window)
+	    (unhide-window window))
+	  (setf (window-priority window) :top-if))
+      ((or match-error window-error drawable-error) (c)
+	(declare (ignore c))))))
+	;;(dbg "Raise error" c window)))))
+
 
 (defun focus-window (window)
   "Give the window focus."
   (when window
-    (with-xlib-protect
-      (raise-window window)
-      (xlib:set-input-focus *display* window :parent))))
-    ;;(xlib:set-input-focus *display* :pointer-root :pointer-root)) ;;PHIL
-
+    (handler-case
+	(progn
+	  (raise-window window)
+	  (set-input-focus *display* window :pointer-root))
+      ((or match-error window-error drawable-error) (c)
+	(declare (ignore c))))))
+	;;(dbg "Focus error" c window)))))
 
 
 
@@ -326,7 +183,7 @@
 
 (defun no-focus ()
   "don't focus any window but still read keyboard events."
-  (xlib:set-input-focus *display* *no-focus-window* :pointer-root))
+  (set-input-focus *display* *no-focus-window* :pointer-root))
   
 
 
@@ -336,10 +193,10 @@
       (pointer-grabbed nil))
   (labels ((free-grab-pointer ()
 	     (when cursor
-	       (xlib:free-cursor cursor)
+	       (free-cursor cursor)
 	       (setf cursor nil))
 	     (when cursor-font
-	       (xlib:close-font cursor-font)
+	       (close-font cursor-font)
 	       (setf cursor-font nil))))
     (defun xgrab-init-pointer ()
       (setf pointer-grabbed nil))
@@ -347,28 +204,27 @@
     (defun xgrab-pointer-p ()
       pointer-grabbed)
     
-    (defun xgrab-pointer (root cursor-char cursor-mask-char
-			  &optional (pointer-mask '(:enter-window :pointer-motion
-						    :button-press :button-release)) owner-p)
+    (defun xgrab-pointer (root cursor-char cursor-mask-char)
       "Grab the pointer and set the pointer shape."
       (free-grab-pointer)
       (setf pointer-grabbed t)
-      (let* ((white (xlib:make-color :red 1.0 :green 1.0 :blue 1.0))
-	     (black (xlib:make-color :red 0.0 :green 0.0 :blue 0.0)))
-	(setf cursor-font (xlib:open-font *display* "cursor")

[156 lines skipped]



From pbrochard at common-lisp.net  Fri May  2 20:00:06 2008
From: pbrochard at common-lisp.net (pbrochard)
Date: Fri,  2 May 2008 16:00:06 -0400 (EDT)
Subject: [clfswm-cvs] CVS clfswm
Message-ID: <20080502200006.67F2C1302C@common-lisp.net>

Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv3014

Removed Files:
	clfswm-layout.lisp 
Log Message:
Revert to the 0801 version. See the SVN or GIT repository for new update




From pbrochard at common-lisp.net  Fri May  2 20:01:51 2008
From: pbrochard at common-lisp.net (pbrochard)
Date: Fri,  2 May 2008 16:01:51 -0400 (EDT)
Subject: [clfswm-cvs] CVS clfswm
Message-ID: <20080502200151.14712161DA@common-lisp.net>

Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv5176

Added Files:
	clfswm-pager.lisp 
Log Message:
Revert to the 0801 version. See the SVN or GIT repository for new update




From pbrochard at common-lisp.net  Fri May  2 21:49:00 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Fri,  2 May 2008 17:49:00 -0400 (EDT)
Subject: [clfswm-cvs] r111 - in clfswm: . src
Message-ID: <20080502214900.F1F1C1B023@common-lisp.net>

Author: pbrochard
Date: Fri May  2 17:49:00 2008
New Revision: 111

Modified:
   clfswm/ChangeLog
   clfswm/README
   clfswm/TODO
   clfswm/src/tools.lisp
   clfswm/src/xlib-util.lisp
Log:
-m

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Fri May  2 17:49:00 2008
@@ -1,5 +1,8 @@
 2008-05-02  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/tools.lisp (getenv): Implemented for ECL.
+	(urun-prog): Implemented for ECL.
+
 	* src/clfswm-util.lisp (identify-key): Use a double buffer to
 	display text.
 

Modified: clfswm/README
==============================================================================
--- clfswm/README	(original)
+++ clfswm/README	Fri May  2 17:49:00 2008
@@ -4,25 +4,45 @@
  and [2]Stumpwm. Many thanks to them).
  It can be driven only with the keyboard or with the mouse.
 
- A display is divided in workspaces, groups and windows. Windows are
- packed together in groups.
- By default a group is fullscreen maximized (no decorations, no buttons,
- no menus: nothing, just the application fullscreen!).
- When not maximized, a group of windows can be moved, resized, tiled,
- packed or filled to others groups edges.
+ A display contain a root frame and its children. A children can be a
+ window or another frame. The root frame or its children can be the
+ current root. The current root is fullscreen maximized (no
+ decorations, no buttons, no menus: nothing, just the application
+ fullscreen!).
+ Using CLFSWM is like walking throw a tree of frames and windows.
+ Enter in a child to make it the current root and make it fullscreen
+ maximized. Leave it to make its parent the current root.
+
+ Here is the default key binding to navigate throw this tree:
+
+  * Alt-Tab: circulate throw children of the current child.
+  * Alt-Left/Right: circulate throw brother children (ie: this is like
+      workspaces for a more conventional window manager)
+  * Alt-Up: select the first child of the current frame.
+  * Alt-Down: select the parent of the current child.
+  * Alt-Enter: Make the current selected child the current root (ie
+      maximize it) 
+  Alt+Shift-Enter: Make the parent of the current root the current
+      root (ie unmaximize the current root).
 
- For its binding, CLFSWM has two modes.
- A main mode with minimal keys and no mouse grabbing to avoid conflict
+ There is no more need for a pager: you are in the pager!
+
+ For its binding, CLFSWM has two modes:
+ A main mode with minimal keys and mouse grabbing to avoid conflicts
  with others applications.
  And a second mode with more keys and mouse actions.
  For details of its usage, have a look at the files keys.txt or 
  keys.html
 
+ A frame can be placed anywhere in its parent frame. And can have
+ differents layouts to automatically manage its children (tile, tile
+ to left, to bottom, no layout...).
+
 
 * Installation
 
-Boot up a common lisp implementation. I develop it with sbcl, I've
-tested it with cmucl and I use it with clisp (you need the clx/xlib
+Boot up a common lisp implementation. I develop it with sbcl, I test
+it with cmucl regularly and I use it with clisp (you need the clx/xlib
 package).
 
 To use CLFSWM, load the load.lisp file. It loads the ASDF package,
@@ -45,17 +65,13 @@
 files and at the config.lisp file for global variables.
 
 All variables can be overwritten in a user configuration file:
-$HOME/.clfswmrc or /etc/clfswmrc or $XDG_CONFIG_HOME/clfswm/clfswmrc.
+$XDG_CONFIG_HOME/clfswm/clfswmrc or $HOME/.clfswmrc or /etc/clfswmrc.
 It's a standard lisp file loaded at startup. There is an example in
 the clfswm source (see dot-clfswmrc).
 
-If you want to add workspaces or groups at startup, tell this to
-clfswm in the init-display function in clfswm.lisp (there is already a
-default workspace and a default group created).
-
-In all cases, you can grep the source with 'CONFIG' and 'Alternative'
-keywords to find where you can simply customize clfswm.
-
+There is a lot of hooks in CLFSWM to tweak its behaviour. For example,
+if you want to add some frames at startup you can write your own
+init-hook (see dot-clfswmrc).
 
 
 * Lisp implementation note

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Fri May  2 17:49:00 2008
@@ -7,7 +7,6 @@
 ===============
 Should handle these soon.
 
-- Ensure-unique-number/name (new function) [Philippe]
 
 MAYBE
 =====
@@ -34,7 +33,7 @@
 
 - Remote access to the clfswm REPL [Philippe]
 
-- cd/pwd a la shell to navigate throu frames. [Philippe] 
+- cd/pwd a la shell to navigate throw frames. [Philippe] 
 
 - Hide/Unhide frame [Philippe]
 
@@ -47,3 +46,5 @@
 - A Gimp layout example [Philippe]
 
 - Hook to open next window in named/numbered frame [Philippe]
+
+- Ensure-unique-number/name (new function) [Philippe]

Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp	(original)
+++ clfswm/src/tools.lisp	Fri May  2 17:49:00 2008
@@ -330,7 +330,8 @@
   #+lucid (lcl:environment-variable (string var))
   #+mcl (ccl::getenv var)
   #+sbcl (sb-posix:getenv (string var))
-  #-(or allegro clisp cmu gcl lispworks lucid mcl sbcl scl)
+  #+ecl (si:getenv (string var))
+  #-(or allegro clisp cmu gcl lispworks lucid mcl sbcl scl ecl)
   (error 'not-implemented :proc (list 'getenv var)))
 
 
@@ -349,7 +350,8 @@
   #+lispworks (setf (lw:environment-variable (string var)) (string val))
   #+lucid (setf (lcl:environment-variable (string var)) (string val))
   #+sbcl (sb-posix:putenv (format nil "~A=~A" (string var) (string val)))
-  #-(or allegro clisp cmu gcl lispworks lucid sbcl scl)
+  #+ecl (si:setenv (string var) (string val))
+  #-(or allegro clisp cmu gcl lispworks lucid sbcl scl ecl)
   (error 'not-implemented :proc (list '(setf getenv) var)))
 
 
@@ -403,7 +405,8 @@
                      opts)
   #+lucid (apply #'lcl:run-program prog :wait wait :arguments args opts)
   #+sbcl (apply #'sb-ext:run-program prog args :wait wait :output *standard-output* opts)
-  #-(or allegro clisp cmu gcl liquid lispworks lucid sbcl)
+  #+ecl (apply #'ext:run-program prog args opts)
+  #-(or allegro clisp cmu gcl liquid lispworks lucid sbcl ecl)
   (error 'not-implemented :proc (list 'run-prog prog opts)))
 
 

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Fri May  2 17:49:00 2008
@@ -332,15 +332,23 @@
 (let ((cursor-font nil)
       (cursor nil)
       (pointer-grabbed nil))
-  (labels ((free-grab-pointer ()
-	     (when cursor
-	       (xlib:free-cursor cursor)
-	       (setf cursor nil))
-	     (when cursor-font
-	       (xlib:close-font cursor-font)
-	       (setf cursor-font nil))))
-    (defun xgrab-init-pointer ()
-      (setf pointer-grabbed nil))
+;;  (labels ((free-grab-pointer ()
+;;	     (when cursor
+;;	       (xlib:free-cursor cursor)
+;;	       (setf cursor nil))
+;;	     (when cursor-font
+;;	       (xlib:close-font cursor-font)
+  ;;	       (setf cursor-font nil))))
+  (defun free-grab-pointer ()
+    (when cursor
+      (xlib:free-cursor cursor)
+      (setf cursor nil))
+    (when cursor-font
+      (xlib:close-font cursor-font)
+      (setf cursor-font nil)))
+
+  (defun xgrab-init-pointer ()
+    (setf pointer-grabbed nil))
 
     (defun xgrab-pointer-p ()
       pointer-grabbed)
@@ -369,7 +377,7 @@
       "Remove the grab on the cursor and restore the cursor shape."
       (setf pointer-grabbed nil)
       (xlib:ungrab-pointer *display*)
-      (free-grab-pointer))))
+      (free-grab-pointer)))
 
 
 (let ((keyboard-grabbed nil))


From pbrochard at common-lisp.net  Fri May  2 21:51:34 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Fri,  2 May 2008 17:51:34 -0400 (EDT)
Subject: [clfswm-cvs] r112 - clfswm/doc
Message-ID: <20080502215134.DCCE43C005@common-lisp.net>

Author: pbrochard
Date: Fri May  2 17:51:34 2008
New Revision: 112

Modified:
   clfswm/doc/keys.html
   clfswm/doc/keys.txt
   clfswm/doc/menu.html
   clfswm/doc/menu.txt
Log:
Documentation update

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Fri May  2 17:51:34 2008
@@ -544,6 +544,28 @@
           
         </td>
         <td align="center" nowrap>
+            <
+        </td>
+        <td style="color:#0000ff" nowrap>
+          Open the main menu
+        </td>
+      </tr>
+      <tr>
+        <td align="right" style="color:#ff0000" nowrap>
+           Control 
+        </td>
+        <td align="center" nowrap>
+            <
+        </td>
+        <td style="color:#0000ff" nowrap>
+          Open the main menu
+        </td>
+      </tr>
+      <tr>
+        <td align="right" style="color:#ff0000" nowrap>
+          
+        </td>
+        <td align="center" nowrap>
           F
         </td>
         <td style="color:#0000ff" nowrap>
@@ -651,17 +673,6 @@
       </tr>
       <tr>
         <td align="right" style="color:#ff0000" nowrap>
-           Control 
-        </td>
-        <td align="center" nowrap>
-            <
-        </td>
-        <td style="color:#0000ff" nowrap>
-          Leave second mode
-        </td>
-      </tr>
-      <tr>
-        <td align="right" style="color:#ff0000" nowrap>
            Mod-1  Control  Shift 
         </td>
         <td align="center" nowrap>

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Fri May  2 17:51:34 2008
@@ -59,6 +59,8 @@
 
 Mod-1                F1              Open the help and info window for the second mode
                      M               Open the main menu
+                     <               Open the main menu
+Control              <               Open the main menu
                      F               Open the frame menu
                      W               Open the window menu
                      N               Open the action by name menu
@@ -69,7 +71,6 @@
                      T               Leave second mode
                      Return          Leave second mode
                      Escape          Leave second mode
-Control              <               Leave second mode
 Mod-1 Control Shift  Home            Quit clfswm
 Mod-1                Right           Select the next brother frame
 Mod-1                Left            Select the previous brother frame

Modified: clfswm/doc/menu.html
==============================================================================
--- clfswm/doc/menu.html	(original)
+++ clfswm/doc/menu.html	Fri May  2 17:51:34 2008
@@ -264,10 +264,10 @@
       i: Display information on the current window
     </p>
     <p>
-      f: Force the current window to move in the frame (Useful only for transient windows)
+      f: Force the current window to move in the frame (Useful only for unmanaged windows)
     </p>
     <p>
-      c: Force the current window to move in the center of the frame (Useful only for transient windows)
+      c: Force the current window to move in the center of the frame (Useful only for unmanaged windows)
     </p>
     <p>
       m: Force to manage the current window by its parent frame

Modified: clfswm/doc/menu.txt
==============================================================================
--- clfswm/doc/menu.txt	(original)
+++ clfswm/doc/menu.txt	Fri May  2 17:51:34 2008
@@ -92,8 +92,8 @@
 
 Window-Menu
 i: Display information on the current window
-f: Force the current window to move in the frame (Useful only for transient windows)
-c: Force the current window to move in the center of the frame (Useful only for transient windows)
+f: Force the current window to move in the frame (Useful only for unmanaged windows)
+c: Force the current window to move in the center of the frame (Useful only for unmanaged windows)
 m: Force to manage the current window by its parent frame
 u: Force to not manage the current window by its parent frame
 a: Adapt the current frame to the current window minimal size hints


From pbrochard at common-lisp.net  Sat May  3 19:54:42 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sat,  3 May 2008 15:54:42 -0400 (EDT)
Subject: [clfswm-cvs] r113 - in clfswm: . src
Message-ID: <20080503195442.7FC5F7A019@common-lisp.net>

Author: pbrochard
Date: Sat May  3 15:54:40 2008
New Revision: 113

Modified:
   clfswm/ChangeLog
   clfswm/README
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-second-mode.lisp
Log:
display all frame info before leaving the second mode or the info mode.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat May  3 15:54:40 2008
@@ -1,3 +1,13 @@
+2008-05-03  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-info.lisp (info-mode): display all frame info before
+	leaving.
+
+	* src/clfswm-second-mode.lisp (second-key-mode): display all frame
+	info before leaving.
+
+	* src/clfswm-internal.lisp (display-all-frame-info): New function.
+
 2008-05-02  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/tools.lisp (getenv): Implemented for ECL.

Modified: clfswm/README
==============================================================================
--- clfswm/README	(original)
+++ clfswm/README	Sat May  3 15:54:40 2008
@@ -1,4 +1,4 @@
-        CLFSWM - A(nother) Common Lisp FullScreen Window Manager
+        CLFSWM[0] - A(nother) Common Lisp FullScreen Window Manager
 
  CLFSWM is a 100% Common Lisp X11 window manager (based on [1]Tinywm
  and [2]Stumpwm. Many thanks to them).
@@ -9,6 +9,11 @@
  current root. The current root is fullscreen maximized (no
  decorations, no buttons, no menus: nothing, just the application
  fullscreen!).
+
+ CLFSWM is highly dynamic. By default there is only one frame. Other
+ frames are created/deleted on the fly. A window can be in more than
+ one frame, so it can have multiple views of the same windows.
+
  Using CLFSWM is like walking throw a tree of frames and windows.
  Enter in a child to make it the current root and make it fullscreen
  maximized. Leave it to make its parent the current root.
@@ -22,7 +27,7 @@
   * Alt-Down: select the parent of the current child.
   * Alt-Enter: Make the current selected child the current root (ie
       maximize it) 
-  Alt+Shift-Enter: Make the parent of the current root the current
+  * Alt+Shift-Enter: Make the parent of the current root the current
       root (ie unmaximize the current root).
 
  There is no more need for a pager: you are in the pager!
@@ -31,11 +36,13 @@
  A main mode with minimal keys and mouse grabbing to avoid conflicts
  with others applications.
  And a second mode with more keys and mouse actions.
- For details of its usage, have a look at the files keys.txt or 
- keys.html
+ For details of its usage, have a look at the files doc/keys.txt or 
+ doc/keys.html
+ A lot of functions to manage CLFSWM can be found in the second mode
+ menu. See the file menu-def.lisp for an overview.
 
  A frame can be placed anywhere in its parent frame. And can have
- differents layouts to automatically manage its children (tile, tile
+ different layouts to automatically manage its children (tile, tile
  to left, to bottom, no layout...).
 
 
@@ -66,11 +73,11 @@
 
 All variables can be overwritten in a user configuration file:
 $XDG_CONFIG_HOME/clfswm/clfswmrc or $HOME/.clfswmrc or /etc/clfswmrc.
-It's a standard lisp file loaded at startup. There is an example in
+It's a standard lisp file loaded at start up. There is an example in
 the clfswm source (see dot-clfswmrc).
 
 There is a lot of hooks in CLFSWM to tweak its behaviour. For example,
-if you want to add some frames at startup you can write your own
+if you want to add some frames at start up you can write your own
 init-hook (see dot-clfswmrc).
 
 
@@ -95,6 +102,8 @@
 
 R?f?rences
 
+      http://common-lisp.net/project/clfswm/
+      http://trac.common-lisp.net/clfswm/
    1. http://incise.org/index.cgi/TinyWM
    2. http://www.nongnu.org/stumpwm/
    3. http://www.gnu.org/

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Sat May  3 15:54:40 2008
@@ -262,6 +262,7 @@
 	  (xlib:free-gcontext gc)
 	  (xlib:destroy-window window)
 	  (xlib:close-font font)
+	  (display-all-frame-info)
 	  (wait-no-key-or-button-press))))))
 
 

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Sat May  3 15:54:40 2008
@@ -365,7 +365,9 @@
       (copy-pixmap-buffer window gc))))
 
 
-
+(defun display-all-frame-info (&optional (root *current-root*))
+  (with-all-frames (root frame)
+    (display-frame-info frame)))
 
 
 

Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp	(original)
+++ clfswm/src/clfswm-second-mode.lisp	Sat May  3 15:54:40 2008
@@ -204,7 +204,8 @@
     (xungrab-keyboard)
     (xungrab-pointer)
     (grab-main-keys)
-    (show-all-children))
+    (show-all-children)
+    (display-all-frame-info))
   (wait-no-key-or-button-press)
   (when *second-mode-program*
     (do-shell *second-mode-program*)


From pbrochard at common-lisp.net  Sat May  3 21:38:43 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sat,  3 May 2008 17:38:43 -0400 (EDT)
Subject: [clfswm-cvs] r114 - in clfswm: . src
Message-ID: <20080503213843.AD5D67A035@common-lisp.net>

Author: pbrochard
Date: Sat May  3 17:38:42 2008
New Revision: 114

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-util.lisp
Log:
 For different mouse actions: Ensure that the current child is a frame.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat May  3 17:38:42 2008
@@ -1,5 +1,13 @@
 2008-05-03  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-util.lisp
+	(mouse-click-to-focus-generic,mouse-focus-move/resize-generic):
+	Check if child is a frame.
+
+	* src/clfswm-internal.lisp (managed-window-p): Handle the case
+	where frame is null.
+	(place-frame): Check if frame and parent are frames.
+
 	* src/clfswm-info.lisp (info-mode): display all frame info before
 	leaving.
 

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Sat May  3 17:38:42 2008
@@ -96,14 +96,16 @@
 
 (defun managed-window-p (window frame)
   "Return t only if window is managed by frame"
-  (with-slots ((managed forced-managed-window)
-	       (unmanaged forced-unmanaged-window)) frame
-    (and (not (member window unmanaged))
-	 (not (member (xlib:wm-name window) unmanaged :test #'string-equal-p))
-	 (or (member :all (frame-managed-type frame))
-	     (member (window-type window) (frame-managed-type frame))
-	     (member window managed)
-	     (member (xlib:wm-name window) managed :test #'string-equal-p)))))
+  (if (frame-p frame)
+      (with-slots ((managed forced-managed-window)
+		   (unmanaged forced-unmanaged-window)) frame
+	(and (not (member window unmanaged))
+	     (not (member (xlib:wm-name window) unmanaged :test #'string-equal-p))
+	     (or (member :all (frame-managed-type frame))
+		 (member (window-type window) (frame-managed-type frame))
+		 (member window managed)
+		 (member (xlib:wm-name window) managed :test #'string-equal-p))))
+      t))
 
 
 
@@ -238,15 +240,16 @@
 
 (defun place-frame (frame parent prx pry prw prh)
   "Place a frame from real (pixel) coordinates"
-  (with-slots (window x y w h) frame
-    (setf (xlib:drawable-x window) prx
-	  (xlib:drawable-y window) pry
-	  (xlib:drawable-width window) prw
-	  (xlib:drawable-height window) prh
-	  x (x-px->fl prx parent)
-	  y (y-px->fl pry parent)
-	  w (w-px->fl prw parent)
-	  h (h-px->fl prh parent))))
+  (when (and (frame-p frame) (frame-p parent))
+    (with-slots (window x y w h) frame
+      (setf (xlib:drawable-x window) prx
+	    (xlib:drawable-y window) pry
+	    (xlib:drawable-width window) prw
+	    (xlib:drawable-height window) prh
+	    x (x-px->fl prx parent)
+	    y (y-px->fl pry parent)
+	    w (w-px->fl prw parent)
+	    h (h-px->fl prh parent)))))
 
 (defun fixe-real-size (frame parent)
   "Fixe real (pixel) coordinates in float coordinates"

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Sat May  3 17:38:42 2008
@@ -496,11 +496,12 @@
 (defun mouse-click-to-focus-generic (window root-x root-y mouse-fn)
   "Focus the current frame or focus the current window parent
 mouse-fun is #'move-frame or #'resize-frame"
-  (let ((to-replay t)
-	(child window)
-	(parent (find-parent-frame window *current-root*))
-	(root-p (or (equal window *root*)
-		    (equal window (frame-window *current-root*)))))
+  (let* ((to-replay t)
+	 (child window)
+	 (parent (find-parent-frame child *current-root*))
+	 (root-p (or (equal window *root*)
+		     (and (frame-p child)
+			  (equal child (frame-window *current-root*))))))
     (when (or (not root-p) *create-frame-on-root*)
       (unless parent
 	(if root-p
@@ -540,7 +541,8 @@
 For window: set current child to window or its parent according to window-parent"
   (let* ((child (find-child-under-mouse root-x root-y))
 	 (parent (find-parent-frame child)))
-    (when (equal child *current-root*)
+    (when (and (equal child *current-root*)
+	       (frame-p *current-root*))
       (setf child (create-frame)
 	    parent *current-root*
 	    mouse-fn #'resize-frame)


From pbrochard at common-lisp.net  Sat May  3 21:54:34 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sat,  3 May 2008 17:54:34 -0400 (EDT)
Subject: [clfswm-cvs] r115 - in clfswm: . src
Message-ID: <20080503215434.80B9012061@common-lisp.net>

Author: pbrochard
Date: Sat May  3 17:54:33 2008
New Revision: 115

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-internal.lisp
Log:
set-current-child, adapt-child-to-parent, show-child, hide-child): Handle the case where child is not a frame or a window.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat May  3 17:54:33 2008
@@ -1,5 +1,9 @@
 2008-05-03  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-internal.lisp (set-current-child)
+	(adapt-child-to-parent, show-child, hide-child): Handle the case
+	where child is not a frame or a window.
+
 	* src/clfswm-util.lisp
 	(mouse-click-to-focus-generic,mouse-focus-move/resize-generic):
 	Check if child is a frame.

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Sat May  3 17:54:33 2008
@@ -421,7 +421,10 @@
 		(xlib:drawable-width window) rw
 		(xlib:drawable-height window) rh)
 	  (values raise-p change))))))
-   
+
+(defmethod adapt-child-to-parent (child parent)
+  (declare (ignore child parent))
+  ())
 
 
 
@@ -454,6 +457,9 @@
 	  (raise-if-needed window raise-p first-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))
+  ())
 
 
 (defgeneric hide-child (child))
@@ -466,7 +472,9 @@
 (defmethod hide-child ((window xlib:window))
   (hide-window window))
 
-
+(defmethod hide-child (child)
+  (declare (ignore child))
+  ())
 
 
 
@@ -488,6 +496,10 @@
 			   ((equal selected nil) *color-unselected*)
 			   (selected *color-selected*))))))
 
+(defmethod select-child (child selected)
+  (declare (ignore child selected))
+  ())
+
 (defun select-current-frame (selected)
   (select-child *current-child* selected))
 
@@ -582,6 +594,10 @@
   (declare (ignore parent window-parent))
   (set-current-child-generic child))
 
+(defmethod set-current-child (child parent window-parent)
+  (declare (ignore child parent window-parent))
+  ())
+
 
 (defun set-current-root (parent)
   "Set current root if parent is not in current root"


From pbrochard at common-lisp.net  Sun May  4 14:13:08 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sun,  4 May 2008 10:13:08 -0400 (EDT)
Subject: [clfswm-cvs] r116 - clfswm/src
Message-ID: <20080504141308.0D0713C0F1@common-lisp.net>

Author: pbrochard
Date: Sun May  4 10:13:08 2008
New Revision: 116

Modified:
   clfswm/src/version.lisp
Log:
Version update

Modified: clfswm/src/version.lisp
==============================================================================
--- clfswm/src/version.lisp	(original)
+++ clfswm/src/version.lisp	Sun May  4 10:13:08 2008
@@ -33,4 +33,4 @@
 
 (in-package :version)
 
-(defparameter *version* #.(concatenate 'string "0.0.1-git built " (date-string)))
\ No newline at end of file
+(defparameter *version* #.(concatenate 'string "0805 built " (date-string)))


From pbrochard at common-lisp.net  Mon May  5 20:10:13 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Mon,  5 May 2008 16:10:13 -0400 (EDT)
Subject: [clfswm-cvs] r117 - in clfswm: . doc src
Message-ID: <20080505201013.E03B92510F@common-lisp.net>

Author: pbrochard
Date: Mon May  5 16:10:09 2008
New Revision: 117

Modified:
   clfswm/ChangeLog
   clfswm/README
   clfswm/doc/dot-clfswmrc
   clfswm/doc/keys.html
   clfswm/doc/keys.txt
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/version.lisp
Log:
Update the dot-clfswm. New bindings to frame-pack/fill/resize-menu

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Mon May  5 16:10:09 2008
@@ -1,3 +1,7 @@
+2008-05-05  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* doc/dot-clfswmrc: Update to  follow the new clfswm way.
+
 2008-05-03  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp (set-current-child)

Modified: clfswm/README
==============================================================================
--- clfswm/README	(original)
+++ clfswm/README	Mon May  5 16:10:09 2008
@@ -4,7 +4,7 @@
  and [2]Stumpwm. Many thanks to them).
  It can be driven only with the keyboard or with the mouse.
 
- A display contain a root frame and its children. A children can be a
+ A display contains a root frame and its children. A children can be a
  window or another frame. The root frame or its children can be the
  current root. The current root is fullscreen maximized (no
  decorations, no buttons, no menus: nothing, just the application

Modified: clfswm/doc/dot-clfswmrc
==============================================================================
--- clfswm/doc/dot-clfswmrc	(original)
+++ clfswm/doc/dot-clfswmrc	Mon May  5 16:10:09 2008
@@ -2,8 +2,8 @@
 ;;;
 ;;; CLFSWM configuration file example
 ;;;
-;;; Send me your configuration file at hocwp _at_ free -dot- fr if
-;;; you want to share it with others.
+;;; Send me your configuration file at pbrochard _at_ common-lisp -dot- net
+;;; if you want to share it with others.
 
 (in-package :clfswm)
 
@@ -24,6 +24,12 @@
 (defparameter *fullscreen* '(0 0 1024 750))
 
 
+;;; Contributed code example
+;;; See in the clfswm/contrib directory to find some contributed code
+;;; and se load-contrib to load them. For example:
+(load-contrib "contrib-example.lisp")
+
+
 
 ;;; Binding example: Undefine Control-F1 and define  Control-F5 as a
 ;;; new binding in main mode
@@ -68,7 +74,7 @@
 ;;; Hook example
 ;;;
 ;;; See in package.lisp and clfswm.lisp, clfswm-second-mode.lisp
-;;; or clfswm-pager.lisp for hook examples
+;;; for hook examples
 (setf *key-press-hook* (list (lambda (&rest args) ; function 1
 			       (format t "Keyp press (before): ~A~%" args)
 			       (force-output))
@@ -80,30 +86,22 @@
 
 
 
+
 ;;; A more complex example I use to record my desktop and show
 ;;; documentation associated to each key press.
+(defun display-osd (formatter &rest args)
+  (do-shell "pkill osd_cat")
+  (do-shell (format nil "echo ~A | osd_cat -d 3 -p bottom -o -45 -f -*-fixed-*-*-*-*-12-*-*-*-*-*-*-1"
+		    (apply #'format nil formatter args)))
+  (force-output))
+
 (defun documentation-key-from-code (hash-key code state)
-  (labels ((doc-from (key)
-	     (multiple-value-bind (function foundp)
-		 (gethash (list key state) hash-key)
-	       (when (and foundp (first function))
-		 (documentation (first function) 'function))))
-	   (from-code ()
-	     (doc-from code))
-	   (from-char ()
-	     (let ((char (keycode->char code state)))
-	       (doc-from char)))
-	   (from-string ()
-	     (let ((string (keysym->keysym-name (keycode->keysym *display* code 0))))
-	       (doc-from string))))
-    (cond ((from-code))
-	  ((from-char))
-	  ((from-string)))))
+  (documentation (first (find-key-from-code hash-key code state)) 'function))
 
 
 (defun key-string (hash-key code state)
-  (let* ((modifiers (make-state-keys state))
-	 (keysym (keysym->keysym-name (keycode->keysym *display* code 0)))
+  (let* ((modifiers (xlib:make-state-keys state))
+	 (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0)))
 	 (doc (documentation-key-from-code hash-key code state)))
     (values (format nil "~:(~{~A+~}~A~) : ~S" modifiers keysym doc)
 	    doc)))
@@ -112,161 +110,116 @@
   (multiple-value-bind (str doc)
       (key-string hash-key code state)
     (when doc
-      (do-shell "pkill osd_cat")
-      (do-shell (format nil "echo ~A | osd_cat -d 3 -p bottom -o -45 -f -*-fixed-*-*-*-*-12-*-*-*-*-*-*-1" str))
-      (force-output))))
+      (display-osd "~A" str))))
 
 (defun display-key-osd-main (&rest event-slots &key code state &allow-other-keys)
+  (declare (ignore event-slots))
   (display-doc *main-keys* code state))
 
 (defun display-key-osd-second (&rest event-slots &key code state &allow-other-keys)
+  (declare (ignore event-slots))
   (display-doc *second-keys* code state))
 
-(defun display-key-pager (&rest event-slots &key code state &allow-other-keys)
-  (setf (gcontext-background *pager-gc*) (get-color "Black"))
-  (setf (gcontext-foreground *pager-gc*) (get-color "Red"))
-  (multiple-value-bind (str doc)
-      (key-string *pager-keys* code state)
-    (when doc
-      (draw-image-glyphs *pager-window* *pager-gc* 20 570
-			 (format nil "~A                                                  " str)))
-    (display-finish-output *display*)))
-
-;; Define new hook or add to precedent one
+;; Define new hook or add to the previous one
 (if (consp *key-press-hook*)
     (push #'display-key-osd-main *key-press-hook*)
     (setf *key-press-hook* (list #'display-key-osd-main #'handle-key-press)))
 (setf *sm-key-press-hook* (list #'display-key-osd-second #'sm-handle-key-press))
-(setf *pager-key-press-hook* (list #'pager-handle-key-press #'display-key-pager))
 
 ;;; -- Doc example end --
 
 
+;;; -- Azerty configuration --
+;;; For the main mode
+(define-main-key ("twosuperior") 'banish-pointer)
 
-;;;; Uncomment the lines below if you want to enable the larswm,
-;;;; dwm, wmii... cycling style.
-;;;;
-;;;; This leave the main window in one side of the screen and tile others
-;;;; on the other side. It can be configured in the rc file or interactively
-;;;; with the function 'reconfigure-tile-workspace'.
-;;;;
-(defun circulate-group-up ()
-  "Circulate up in group - larswm, dwm, wmii style"
-  (banish-pointer)
-  (minimize-group (current-group))
-  (no-focus)
-  (setf (workspace-group-list (current-workspace))
-	(rotate-list (workspace-group-list (current-workspace))))
-  (funcall *tile-workspace-function* (current-workspace))
-  (show-all-windows-in-workspace (current-workspace)))
-
-(defun circulate-group-down ()
-  "Circulate down in group - larswm, dwm, wmii style"
-  (banish-pointer)
-  (minimize-group (current-group))
-  (no-focus)
-  (setf (workspace-group-list (current-workspace))
-	(anti-rotate-list (workspace-group-list (current-workspace))))
-  (funcall *tile-workspace-function* (current-workspace))
-  (show-all-windows-in-workspace (current-workspace)))
-
-;;; -- Lasrwm style end --
+(undefine-main-multi-keys (#\t :mod-1) (#\b :mod-1) (#\b :mod-1 :control))
 
+(undefine-main-multi-keys ("1" :mod-1) ("2" :mod-1) ("3" :mod-1)
+			  ("4" :mod-1) ("5" :mod-1) ("6" :mod-1)
+			  ("7" :mod-1) ("8" :mod-1) ("9" :mod-1) ("0" :mod-1))
+(define-main-key ("ampersand" :mod-1) 'bind-or-jump 1)
+(define-main-key ("eacute" :mod-1) 'bind-or-jump 2)
+(define-main-key ("quotedbl" :mod-1) 'bind-or-jump 3)
+(define-main-key ("quoteright" :mod-1) 'bind-or-jump 4)
+(define-main-key ("parenleft" :mod-1) 'bind-or-jump 5)
+(define-main-key ("minus" :mod-1) 'bind-or-jump 6)
+(define-main-key ("egrave" :mod-1) 'bind-or-jump 7)
+(define-main-key ("underscore" :mod-1) 'bind-or-jump 8)
+(define-main-key ("ccedilla" :mod-1) 'bind-or-jump 9)
+(define-main-key ("agrave" :mod-1) 'bind-or-jump 10)
+
+
+;;; For the second mode
+(undefine-second-multi-keys ("1" :mod-1) ("2" :mod-1) ("3" :mod-1)
+			    ("4" :mod-1) ("5" :mod-1) ("6" :mod-1)
+			    ("7" :mod-1) ("8" :mod-1) ("9" :mod-1) ("0" :mod-1))
+(define-second-key ("ampersand" :mod-1) 'bind-or-jump 1)
+(define-second-key ("eacute" :mod-1) 'bind-or-jump 2)
+(define-second-key ("quotedbl" :mod-1) 'bind-or-jump 3)
+(define-second-key ("quoteright" :mod-1) 'bind-or-jump 4)
+(define-second-key ("parenleft" :mod-1) 'bind-or-jump 5)
+(define-second-key ("minus" :mod-1) 'bind-or-jump 6)
+(define-second-key ("egrave" :mod-1) 'bind-or-jump 7)
+(define-second-key ("underscore" :mod-1) 'bind-or-jump 8)
+(define-second-key ("ccedilla" :mod-1) 'bind-or-jump 9)
+(define-second-key ("agrave" :mod-1) 'bind-or-jump 10)
+;;; -- Azerty configuration end --
 
 
-;;; Azerty keyboard configuration (first remove keys, then rebind)
-;; Main mode
-;;(undefine-main-key (#\t :mod-1))
-;;(undefine-main-key (#\b :mod-1))
-;;(undefine-main-key (#\b :mod-1 :control))
-;;(undefine-main-key ("1" :mod-1))
-;;(undefine-main-key ("2" :mod-1))
-;;(undefine-main-key ("3" :mod-1))
-;;(undefine-main-key ("4" :mod-1))
-;;(undefine-main-key ("5" :mod-1))
-;;(undefine-main-key ("6" :mod-1))
-;;(undefine-main-key ("7" :mod-1))
-;;(undefine-main-key ("8" :mod-1))
-;;(undefine-main-key ("9" :mod-1))
-;;(undefine-main-key ("0" :mod-1))
-;; Or better:
-(undefine-main-multi-keys (#\t :mod-1) (#\b :mod-1) (#\b :mod-1 :control)
-			  (#\1 :mod-1) (#\2 :mod-1) (#\3 :mod-1)
-			  (#\4 :mod-1) (#\5 :mod-1) (#\6 :mod-1)
-			  (#\7 :mod-1) (#\8 :mod-1) (#\9 :mod-1) (#\0 :mod-1))
 
-(define-main-key (#\< :control) 'second-key-mode)
+;;; Init hook examples:
+(defun my-init-hook-1 ()
+  (dbg 'my-init-hook)
+  ;;(add-frame (create-frame :name "Default" :layout #'tile-left-layout :data (list '(:tile-size 0.6))) *root-frame*)
+  (add-frame (create-frame :name "The Gimp" :x 0.6 :y 0 :w 0.3 :h 0.2) *root-frame*)
+  (add-frame (create-frame :name "Net" :x 0.52 :y 0.3 :w 0.4 :h 0.3) *root-frame*)
+  (add-frame (create-frame :x 0.4 :y 0 :w 0.2 :h 0.3) (first (frame-child *root-frame*)))
+  (add-frame (create-frame :x 0.6 :y 0.4 :w 0.4 :h 0.2) (first (frame-child *root-frame*)))
+  (add-frame (create-frame :x 0.4 :y 0.7 :w 0.2 :h 0.3) (first (frame-child *root-frame*)))
+  (let ((frame (create-frame :name "The Qiv" :x 0 :y 0.4 :w 0.4 :h 0.2)))
+    (add-frame frame (first (frame-child *root-frame*)))
+    (add-frame (create-frame) frame))
+  (add-frame (create-frame :x 0.1 :y 0.55 :w 0.8 :h 0.43) *root-frame*)
+  (add-frame (create-frame :x 0.2 :y 0.1 :w 0.6 :h 0.4) (first (frame-child *root-frame*)))
+  (add-frame (create-frame :x 0.3 :y 0.55 :w 0.4 :h 0.3) (first (frame-child *root-frame*)))
+  (add-frame (create-frame :x 0.1 :y 0.1 :w 0.3 :h 0.6) (first (frame-child (first (frame-child *root-frame*)))))
+  (setf *current-child* (first (frame-child *current-root*)))
+  (setf (frame-layout *current-child*) #'tile-layout))
+
+(defun my-init-hook-2 ()
+  (dbg 'my-init-hook)
+  (add-frame (create-frame :name "Default" :layout #'tile-left-layout :data (list '(:tile-size 0.6))) *root-frame*)
+  (setf *current-child* (first (frame-child *current-root*)))
+  (setf (frame-layout *current-child*) #'tile-layout))
+
+
+(defun my-init-hook-3 ()
+  (dbg 'my-init-hook)
+  (add-frame (create-frame :name "plop" :x 0.1 :y 0.4 :w 0.7 :h 0.3) *root-frame*)
+  (add-frame (create-frame :name "Default" :layout nil :x 0.1 :y 0.5 :w 0.8 :h 0.5)
+	     *root-frame*)
+  (setf *current-child* (first (frame-child *current-root*)))
+  (setf (frame-layout *root-frame*) nil))
 
-(define-main-key ("twosuperior") 'banish-pointer)
-(define-main-key ("twosuperior" :mod-1) 'toggle-maximize-current-group)
 
-(define-main-key ("ampersand" :mod-1) 'b-main-focus-workspace-1)
-(define-main-key ("eacute" :mod-1) 'b-main-focus-workspace-2)
-(define-main-key ("quotedbl" :mod-1) 'b-main-focus-workspace-3)
-(define-main-key ("quoteright" :mod-1) 'b-main-focus-workspace-4)
-(define-main-key ("parenleft" :mod-1) 'b-main-focus-workspace-5)
-(define-main-key ("minus" :mod-1) 'b-main-focus-workspace-6)
-(define-main-key ("egrave" :mod-1) 'b-main-focus-workspace-7)
-(define-main-key ("underscore" :mod-1) 'b-main-focus-workspace-8)
-(define-main-key ("ccedilla" :mod-1) 'b-main-focus-workspace-9)
-(define-main-key ("agrave" :mod-1) 'b-main-focus-workspace-10)
-
-;; Second mode
-(undefine-second-multi-keys (#\t) (#\b) (#\b :mod-1)
-			    (#\1 :mod-1) (#\2 :mod-1) (#\3 :mod-1)
-			    (#\4 :mod-1) (#\5 :mod-1) (#\6 :mod-1)
-			    (#\7 :mod-1) (#\8 :mod-1) (#\9 :mod-1) (#\0 :mod-1)
-			    (#\1 :control :mod-1) (#\2 :control :mod-1))
-
-(define-second-key (#\<) 'leave-second-mode-maximize)
-
-
-(define-second-key ("ampersand" :mod-1) 'b-second-focus-workspace-1)
-(define-second-key ("eacute" :mod-1) 'b-second-focus-workspace-2)
-(define-second-key ("quotedbl" :mod-1) 'b-second-focus-workspace-3)
-(define-second-key ("quoteright" :mod-1) 'b-second-focus-workspace-4)
-(define-second-key ("parenleft" :mod-1) 'b-second-focus-workspace-5)
-(define-second-key ("minus" :mod-1) 'b-second-focus-workspace-6)
-(define-second-key ("egrave" :mod-1) 'b-second-focus-workspace-7)
-(define-second-key ("underscore" :mod-1) 'b-second-focus-workspace-8)
-(define-second-key ("ccedilla" :mod-1) 'b-second-focus-workspace-9)
-(define-second-key ("agrave" :mod-1) 'b-second-focus-workspace-10)
-
-(define-second-key ("ampersand" :control :mod-1) 'renumber-workspaces)
-(define-second-key ("eacute" :control :mod-1) 'sort-workspaces)
-
-
-(define-second-key ("twosuperior") 'banish-pointer)
-(define-second-key ("twosuperior" :mod-1) 'toggle-maximize-current-group)
-
-(define-second-key (#\t) 'tile-current-workspace-vertically)
-(define-second-key (#\t :shift) 'tile-current-workspace-horizontally)
-
-
-;; Pager mode
-(undefine-pager-multi-keys (#\b)
-			   (#\1 :mod-1) (#\2 :mod-1) (#\3 :mod-1)
-			   (#\4 :mod-1) (#\5 :mod-1) (#\6 :mod-1)
-			   (#\7 :mod-1) (#\8 :mod-1) (#\9 :mod-1) (#\0 :mod-1)
-			   (#\1 :control :mod-1) (#\2 :control :mod-1))
-
-(define-pager-key ("twosuperior") 'banish-pointer)
-
-(define-pager-key ("ampersand" :mod-1) 'b-pager-focus-workspace-1)
-(define-pager-key ("eacute" :mod-1) 'b-pager-focus-workspace-2)
-(define-pager-key ("quotedbl" :mod-1) 'b-pager-focus-workspace-3)
-(define-pager-key ("quoteright" :mod-1) 'b-pager-focus-workspace-4)
-(define-pager-key ("parenleft" :mod-1) 'b-pager-focus-workspace-5)
-(define-pager-key ("minus" :mod-1) 'b-pager-focus-workspace-6)
-(define-pager-key ("egrave" :mod-1) 'b-pager-focus-workspace-7)
-(define-pager-key ("underscore" :mod-1) 'b-pager-focus-workspace-8)
-(define-pager-key ("ccedilla" :mod-1) 'b-pager-focus-workspace-9)
-(define-pager-key ("agrave" :mod-1) 'b-pager-focus-workspace-10)
 
-(define-pager-key ("ampersand" :control :mod-1) 'pager-renumber-workspaces)
-(define-pager-key ("eacute" :control :mod-1) 'pager-sort-workspaces)
+(defun my-init-hook-4 ()
+  (let ((frame (add-frame (create-frame :name "Default"
+                                        :layout #'tile-left-layout
+					:x 0.05 :y 0.05 :w 0.9 :h 0.9)
+			  *root-frame*)))
+    (setf *current-child* frame)))
+
+
+;;; Use this hook and prevent yourself to create a new frame to emulate
+;;; the MS Windows desktop style :)
+(defun my-init-hook-ms-windows-style ()
+  (setf (frame-managed-type *root-frame*) nil))
 
-;;; -- Azerty configuration end --
 
 
 
+(setf *init-hook* #'my-init-hook-4)  ;; <- choose one in 1 to 4
+;;(setf *init-hook* nil)
+;;; Init hook end
\ No newline at end of file

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Mon May  5 16:10:09 2008
@@ -610,6 +610,39 @@
           
         </td>
         <td align="center" nowrap>
+          P
+        </td>
+        <td style="color:#0000ff" nowrap>
+          Open the frame pack menu
+        </td>
+      </tr>
+      <tr>
+        <td align="right" style="color:#ff0000" nowrap>
+          
+        </td>
+        <td align="center" nowrap>
+          L
+        </td>
+        <td style="color:#0000ff" nowrap>
+          Open the frame fill menu
+        </td>
+      </tr>
+      <tr>
+        <td align="right" style="color:#ff0000" nowrap>
+          
+        </td>
+        <td align="center" nowrap>
+          R
+        </td>
+        <td style="color:#0000ff" nowrap>
+          Open the frame resize menu
+        </td>
+      </tr>
+      <tr>
+        <td align="right" style="color:#ff0000" nowrap>
+          
+        </td>
+        <td align="center" nowrap>
           I
         </td>
         <td style="color:#0000ff" nowrap>
@@ -1467,7 +1500,7 @@
           
         </td>
         <td align="center" nowrap>
-          Motion
+          Clfswm  motion
         </td>
         <td style="color:#0000ff" nowrap>
           Grab text

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Mon May  5 16:10:09 2008
@@ -65,6 +65,9 @@
                      W               Open the window menu
                      N               Open the action by name menu
                      U               Open the action by number menu
+                     P               Open the frame pack menu
+                     L               Open the frame fill menu
+                     R               Open the frame resize menu
                      I               Identify a key
                      Colon           Eval a lisp form from the query input
                      Exclam          Run a program from the query input
@@ -153,5 +156,5 @@
                      2               Leave the info mode
                      4               Move one line up
                      5               Move one line down
-                     Motion          Grab text
+                     Clfswm::motion   Grab text
 

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Mon May  5 16:10:09 2008
@@ -52,6 +52,18 @@
   "Open the action by number menu"
   (open-menu (find-menu 'action-by-number-menu)))
 
+(defun open-frame-pack-menu ()
+  "Open the frame pack menu"
+  (open-menu (find-menu 'frame-pack-menu)))
+
+(defun open-frame-fill-menu ()
+  "Open the frame fill menu"
+  (open-menu (find-menu 'frame-fill-menu)))
+
+(defun open-frame-resize-menu ()
+  "Open the frame resize menu"
+  (open-menu (find-menu 'frame-resize-menu)))
+
 
 (define-second-key ("m") 'open-menu)
 (define-second-key (#\<) 'open-menu)
@@ -62,6 +74,11 @@
 (define-second-key ("n") 'open-action-by-name-menu)
 (define-second-key ("u") 'open-action-by-number-menu)
 
+(define-second-key ("p") 'open-frame-pack-menu)
+(define-second-key ("l") 'open-frame-fill-menu)
+(define-second-key ("r") 'open-frame-resize-menu)
+
+
 
 ;;(define-second-key (#\g :control) 'stop-all-pending-actions)
 

Modified: clfswm/src/version.lisp
==============================================================================
--- clfswm/src/version.lisp	(original)
+++ clfswm/src/version.lisp	Mon May  5 16:10:09 2008
@@ -33,4 +33,4 @@
 
 (in-package :version)
 
-(defparameter *version* #.(concatenate 'string "0805 built " (date-string)))
+(defparameter *version* #.(concatenate 'string "Version: 0805 built " (date-string)))


From pbrochard at common-lisp.net  Mon May  5 20:52:51 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Mon,  5 May 2008 16:52:51 -0400 (EDT)
Subject: [clfswm-cvs] r118 - clfswm
Message-ID: <20080505205251.8DEAB281E9@common-lisp.net>

Author: pbrochard
Date: Mon May  5 16:52:49 2008
New Revision: 118

Modified:
   clfswm/README
Log:
README update

Modified: clfswm/README
==============================================================================
--- clfswm/README	(original)
+++ clfswm/README	Mon May  5 16:52:49 2008
@@ -4,7 +4,7 @@
  and [2]Stumpwm. Many thanks to them).
  It can be driven only with the keyboard or with the mouse.
 
- A display contains a root frame and its children. A children can be a
+ A display contains a root frame and its children. A child can be a
  window or another frame. The root frame or its children can be the
  current root. The current root is fullscreen maximized (no
  decorations, no buttons, no menus: nothing, just the application


From pbrochard at common-lisp.net  Wed May  7 20:09:35 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Wed,  7 May 2008 16:09:35 -0400 (EDT)
Subject: [clfswm-cvs] r119 - in clfswm: . src
Message-ID: <20080507200935.86A876D16A@common-lisp.net>

Author: pbrochard
Date: Wed May  7 16:09:35 2008
New Revision: 119

Modified:
   clfswm/ChangeLog
   clfswm/clfswm.asd
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-layout.lisp
   clfswm/src/config.lisp
Log:
Give a minimal size for windows. Center windows in the screen instead of in there frame. tile-space-current-frame bound on C-t.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed May  7 16:09:35 2008
@@ -1,3 +1,19 @@
+2008-05-07  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp (place-window-from-hints): Give a
+	minimal size for windows.
+
+	* src/config.lisp (*default-window-width/height*): New parameters.
+
+	* src/clfswm-internal.lisp (place-window-from-hints): Center
+	windows in the screen instead of in there frame.
+
+	* src/bindings-second-mode.lisp (tile-space-current-frame): New
+	binding on C-t.
+
+	* src/clfswm-layout.lisp (register-layout): Intern the once name
+	in the right package.
+
 2008-05-05  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* doc/dot-clfswmrc: Update to  follow the new clfswm way.

Modified: clfswm/clfswm.asd
==============================================================================
--- clfswm/clfswm.asd	(original)
+++ clfswm/clfswm.asd	Wed May  7 16:09:35 2008
@@ -57,7 +57,8 @@
 			 (:file "bindings"
 			  :depends-on ("clfswm" "clfswm-internal" "clfswm-util"))
 			 (:file "bindings-second-mode"
-			  :depends-on ("clfswm" "clfswm-util" "clfswm-query" "bindings" "clfswm-pack" "clfswm-menu" "menu-def"))))))
+			  :depends-on ("clfswm" "clfswm-util" "clfswm-query" "bindings" "clfswm-pack" "clfswm-menu" "menu-def"
+						"clfswm-layout"))))))
 
 
 

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Wed May  7 16:09:35 2008
@@ -88,11 +88,17 @@
 (define-second-key ("exclam") 'run-program-from-query-string)
 
 
-(define-second-key (#\t) 'leave-second-mode)
 (define-second-key ("Return") 'leave-second-mode)
 (define-second-key ("Escape") 'leave-second-mode)
 
 
+(defun tile-space-current-frame ()
+  "Tile with spaces the current frame"
+  (explode-frame *current-child*)
+  (set-tile-space-layout-once)
+  (leave-second-mode))
+
+(define-second-key (#\t) 'tile-space-current-frame)
 
 (define-second-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
 

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Wed May  7 16:09:35 2008
@@ -757,10 +757,10 @@
 		       (xlib:drawable-width window)))
 	   (rheight (or (and hints (or (xlib:wm-size-hints-height hints) (xlib:wm-size-hints-base-height hints)))
 			(xlib:drawable-height window))))
-      (setf (xlib:drawable-width window) (min (max min-width rwidth) max-width)
-	    (xlib:drawable-height window) (min (max min-height rheight) max-height))
-      (setf (xlib:drawable-x window) (truncate (+ (frame-rx *current-child*) (/ (- (frame-rw *current-child*) (xlib:drawable-width window)) 2)))
-	    (xlib:drawable-y window) (truncate (+ (frame-ry *current-child*) (/ (- (frame-rh *current-child*) (xlib:drawable-height window)) 2)))))))
+      (setf (xlib:drawable-width window) (min (max min-width rwidth *default-window-width*) max-width)
+	    (xlib:drawable-height window) (min (max min-height rheight *default-window-height*) max-height))
+            (setf (xlib:drawable-x window) (truncate (+ (frame-rx *current-child*) (/ (- (xlib:screen-width *screen*) (xlib:drawable-width window)) 2)))
+		  (xlib:drawable-y window) (truncate (+ (frame-ry *current-child*) (/ (- (xlib:screen-height *screen*) (xlib:drawable-height window)) 2)))))))
 
 
 

Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp	(original)
+++ clfswm/src/clfswm-layout.lisp	Wed May  7 16:09:35 2008
@@ -66,10 +66,10 @@
 
 
 (defun register-layout (layout)
-  (let ((once-name (create-symbol (format nil "~A" layout) "-ONCE")))
+  (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)))
+	    (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)))

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Wed May  7 16:09:35 2008
@@ -84,6 +84,10 @@
 (defparameter *color-unselected* "Blue")
 (defparameter *color-maybe-selected* "Yellow")
 
+;;; CONFIG: Default window size
+(defparameter *default-window-width* 400)
+(defparameter *default-window-height* 300)
+
 ;;; CONFIG: Second mode colors and fonts
 (defparameter *sm-border-color* "Green")
 (defparameter *sm-background-color* "Black")


From pbrochard at common-lisp.net  Wed May  7 20:16:27 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Wed,  7 May 2008 16:16:27 -0400 (EDT)
Subject: [clfswm-cvs] r120 - clfswm/doc
Message-ID: <20080507201627.87B03702FD@common-lisp.net>

Author: pbrochard
Date: Wed May  7 16:16:27 2008
New Revision: 120

Modified:
   clfswm/doc/keys.html
   clfswm/doc/keys.txt
Log:
Autodoc update

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Wed May  7 16:16:27 2008
@@ -676,7 +676,7 @@
           
         </td>
         <td align="center" nowrap>
-            T
+          Return
         </td>
         <td style="color:#0000ff" nowrap>
           Leave second mode
@@ -687,7 +687,7 @@
           
         </td>
         <td align="center" nowrap>
-          Return
+          Escape
         </td>
         <td style="color:#0000ff" nowrap>
           Leave second mode
@@ -698,10 +698,10 @@
           
         </td>
         <td align="center" nowrap>
-          Escape
+            T
         </td>
         <td style="color:#0000ff" nowrap>
-          Leave second mode
+          Tile with spaces the current frame
         </td>
       </tr>
       <tr>
@@ -1500,7 +1500,7 @@
           
         </td>
         <td align="center" nowrap>
-          Clfswm  motion
+          Motion
         </td>
         <td style="color:#0000ff" nowrap>
           Grab text

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Wed May  7 16:16:27 2008
@@ -71,9 +71,9 @@
                      I               Identify a key
                      Colon           Eval a lisp form from the query input
                      Exclam          Run a program from the query input
-                     T               Leave second mode
                      Return          Leave second mode
                      Escape          Leave second mode
+                     T               Tile with spaces the current frame
 Mod-1 Control Shift  Home            Quit clfswm
 Mod-1                Right           Select the next brother frame
 Mod-1                Left            Select the previous brother frame
@@ -156,5 +156,5 @@
                      2               Leave the info mode
                      4               Move one line up
                      5               Move one line down
-                     Clfswm::motion   Grab text
+                     Motion          Grab text
 


From pbrochard at common-lisp.net  Wed May  7 20:57:46 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Wed,  7 May 2008 16:57:46 -0400 (EDT)
Subject: [clfswm-cvs] r121 - in clfswm: . src
Message-ID: <20080507205746.789337113F@common-lisp.net>

Author: pbrochard
Date: Wed May  7 16:57:45 2008
New Revision: 121

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-util.lisp
Log:
Take care of	unmanaged (hidden) windows.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed May  7 16:57:45 2008
@@ -1,7 +1,11 @@
 2008-05-07  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-util.lisp (find-child-under-mouse): Take care of
+	unmanaged (hidden) windows.
+
 	* src/clfswm-internal.lisp (place-window-from-hints): Give a
 	minimal size for windows.
+	(with-all-windows-frames-and-parent): New function.
 
 	* src/config.lisp (*default-window-width/height*): New parameters.
 

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Wed May  7 16:57:45 2008
@@ -204,6 +204,17 @@
 			   (,rec ,sub-child))))))
        (,rec ,root))))
 
+(defmacro with-all-windows-frames-and-parent ((root child parent) body-window body-frame)
+  (let ((rec (gensym))
+	(sub-child (gensym)))
+    `(labels ((,rec (,child ,parent)
+		(typecase ,child
+		  (xlib:window ,body-window)
+		  (frame ,body-frame
+			 (dolist (,sub-child (reverse (frame-child ,child)))
+			   (,rec ,sub-child ,child))))))
+       (,rec ,root nil))))
+
 
 
 (defun frame-find-free-number ()

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Wed May  7 16:57:45 2008
@@ -122,8 +122,9 @@
   "Return the child window under the mouse"
   (with-xlib-protect
     (let ((win *root*))
-      (with-all-windows-frames (*current-root* child)
-	(when (and (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
+      (with-all-windows-frames-and-parent (*current-root* child parent)
+	(when (and (or (managed-window-p child parent) (equal parent *current-child*))
+		   (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
 		   (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
 	  (setf win child))
 	(when (and (<= (frame-rx child) x (+ (frame-rx child) (frame-rw child)))
@@ -136,8 +137,9 @@
   "Return the child under the mouse"
   (with-xlib-protect
     (let ((ret nil))
-      (with-all-windows-frames (*current-root* child)
-	(when (and (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
+      (with-all-windows-frames-and-parent (*current-root* child parent)
+	(when (and (or (managed-window-p child parent) (equal parent *current-child*))
+		   (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
 		   (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
 	  (setf ret child))
 	(when (and (<= (frame-rx child) x (+ (frame-rx child) (frame-rw child)))


From pbrochard at common-lisp.net  Sat May 10 21:19:27 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sat, 10 May 2008 17:19:27 -0400 (EDT)
Subject: [clfswm-cvs] r122 - in clfswm: . src
Message-ID: <20080510211927.8B5435803D@common-lisp.net>

Author: pbrochard
Date: Sat May 10 17:19:26 2008
New Revision: 122

Modified:
   clfswm/ChangeLog
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/bindings.lisp
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-util.lisp
Log:
Use 'Tab' instead of 'Iso_Left_Tab'. bind-or-jump: Bind 'Tab', 'Return' and 'Space' to jump to a child. 'B' to bind a slot on the current child.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat May 10 17:19:26 2008
@@ -1,3 +1,12 @@
+2008-05-10  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (bind-or-jump): Bind "Tab", "Return" and
+	"Space" to jump to a child. "B" to bind a slot on the current
+	child.
+
+	* src/bindings-second-mode.lisp: Use "Tab" instead of
+	"Iso_Left_Tab".
+
 2008-05-07  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (find-child-under-mouse): Take care of

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Sat May 10 17:19:26 2008
@@ -109,7 +109,7 @@
 (define-second-key ("Up" :mod-1) 'select-next-level)
 
 (define-second-key ("Tab" :mod-1) 'select-next-child)
-(define-second-key ("ISO_Left_Tab" :mod-1 :shift) 'select-previous-child)
+(define-second-key ("Tab" :mod-1 :shift) 'select-previous-child)
 
 (define-second-key ("Return" :mod-1) 'enter-frame)
 (define-second-key ("Return" :mod-1 :shift) 'leave-frame)

Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp	(original)
+++ clfswm/src/bindings.lisp	Sat May 10 17:19:26 2008
@@ -46,7 +46,7 @@
 (define-main-key ("Up" :mod-1) 'select-next-level)
 
 (define-main-key ("Tab" :mod-1) 'select-next-child)
-(define-main-key ("ISO_Left_Tab" :mod-1 :shift) 'select-previous-child)
+(define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
 
 (define-main-key ("Return" :mod-1) 'enter-frame)
 (define-main-key ("Return" :mod-1 :shift) 'leave-frame)

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Sat May 10 17:19:26 2008
@@ -60,7 +60,6 @@
 (define-info-key (#\q) 'leave-info-mode)
 (define-info-key ("Return") 'leave-info-mode)
 (define-info-key ("Escape") 'leave-info-mode)
-(define-info-key (#\Space) 'leave-info-mode)
 
 (define-info-key ("twosuperior")
     (defun info-banish-pointer (info)

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Sat May 10 17:19:26 2008
@@ -652,9 +652,9 @@
   
   (defun bind-or-jump (n)
     "Bind or jump to a slot"
-    (let ((default-bind `("Return" bind-on-slot
-				   ,(format nil "Bind slot ~A on child: ~A" n (child-fullname *current-child*)))))
-      (setf current-slot (- n 1))
+    (setf current-slot (- n 1))
+    (let ((default-bind `("b" bind-on-slot
+			      ,(format nil "Bind slot ~A on child: ~A" n (child-fullname *current-child*)))))
       (info-mode-menu (aif (aref key-slots current-slot)
 			   `(,default-bind
 				("BackSpace" remove-binding-on-slot
@@ -663,7 +663,9 @@
 			      ("Tab" jump-to-slot
 				     ,(format nil "Jump to child: ~A" (aif (aref key-slots current-slot)
 									   (child-fullname it)
-									   "Not set - Please, bind it with Return"))))
+									   "Not set - Please, bind it with 'b'")))
+			      ("Return" jump-to-slot "Same thing")
+			      ("space" jump-to-slot "Same thing"))
 			   (list default-bind))))))
 
 


From pbrochard at common-lisp.net  Mon May 12 20:31:17 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Mon, 12 May 2008 16:31:17 -0400 (EDT)
Subject: [clfswm-cvs] r123 - in clfswm: . doc src
Message-ID: <20080512203117.6401A20018@common-lisp.net>

Author: pbrochard
Date: Mon May 12 16:31:09 2008
New Revision: 123

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/clfswm-autodoc.lisp
   clfswm/src/clfswm-util.lisp
Log:
Show a message to follow the autodocumentation process. Second mode #\a: New	binding on 'add-default-frame'.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Mon May 12 16:31:09 2008
@@ -1,3 +1,11 @@
+2008-05-12  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/bindings-second-mode.lisp (define-second-key #\a): New
+	binding on 'add-default-frame'.
+
+	* src/clfswm-autodoc.lisp (produce-*-doc-*-in-file): Show a
+	message to follow the autodocumentation process.
+
 2008-05-10  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (bind-or-jump): Bind "Tab", "Return" and

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Mon May 12 16:31:09 2008
@@ -112,7 +112,7 @@
            Mod-1  Shift 
         </td>
         <td align="center" nowrap>
-          Iso_left_tab
+          Tab
         </td>
         <td style="color:#0000ff" nowrap>
           Select the previous child
@@ -544,7 +544,7 @@
           
         </td>
         <td align="center" nowrap>
-            <
+          Less
         </td>
         <td style="color:#0000ff" nowrap>
           Open the main menu
@@ -555,7 +555,7 @@
            Control 
         </td>
         <td align="center" nowrap>
-            <
+          Less
         </td>
         <td style="color:#0000ff" nowrap>
           Open the main menu
@@ -775,7 +775,7 @@
            Mod-1  Shift 
         </td>
         <td align="center" nowrap>
-          Iso_left_tab
+          Tab
         </td>
         <td style="color:#0000ff" nowrap>
           Select the previous child
@@ -871,6 +871,17 @@
       </tr>
       <tr>
         <td align="right" style="color:#ff0000" nowrap>
+          
+        </td>
+        <td align="center" nowrap>
+            A
+        </td>
+        <td style="color:#0000ff" nowrap>
+          Add a default frame in the current frame
+        </td>
+      </tr>
+      <tr>
+        <td align="right" style="color:#ff0000" nowrap>
            Control  Shift 
         </td>
         <td align="center" nowrap>
@@ -1328,17 +1339,6 @@
           
         </td>
         <td align="center" nowrap>
-             
-        </td>
-        <td style="color:#0000ff" nowrap>
-          Leave the info mode
-        </td>
-      </tr>
-      <tr>
-        <td align="right" style="color:#ff0000" nowrap>
-          
-        </td>
-        <td align="center" nowrap>
           Twosuperior
         </td>
         <td style="color:#0000ff" nowrap>

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Mon May 12 16:31:09 2008
@@ -13,7 +13,7 @@
 Mod-1                Down            Select the previous level in frame
 Mod-1                Up              Select the next level in frame
 Mod-1                Tab             Select the next child
-Mod-1 Shift          Iso_left_tab    Select the previous child
+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                Home            Switch to the root frame
@@ -59,8 +59,8 @@
 
 Mod-1                F1              Open the help and info window for the second mode
                      M               Open the main menu
-                     <               Open the main menu
-Control              <               Open the main menu
+                     Less            Open the main menu
+Control              Less            Open the main menu
                      F               Open the frame menu
                      W               Open the window menu
                      N               Open the action by name menu
@@ -80,7 +80,7 @@
 Mod-1                Down            Select the previous level in frame
 Mod-1                Up              Select the next level in frame
 Mod-1                Tab             Select the next child
-Mod-1 Shift          Iso_left_tab    Select the previous child
+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                Home            Switch to the root frame
@@ -89,6 +89,7 @@
 Mod-1                B               Move the pointer to the lower right corner of the screen
                      O               Open the next window in a new frame in the root frame
 Control              O               Open the next window in a new frame in the parent frame
+                     A               Add a default frame in the current frame
 Control Shift        Escape          Delete the focus window in all frames and workspaces
 Mod-1 Control Shift  Escape          Destroy the focus window in all frames and workspaces
 Control              Escape          Remove the focus window in the current frame
@@ -137,7 +138,6 @@
                      Q               Leave the info mode
                      Return          Leave the info mode
                      Escape          Leave the info mode
-                                     Leave the info mode
                      Twosuperior     Move the pointer to the lower right corner of the screen
                      Down            Move one line down
                      Up              Move one line up

Modified: clfswm/doc/menu.html
==============================================================================
--- clfswm/doc/menu.html	(original)
+++ clfswm/doc/menu.html	Mon May 12 16:31:09 2008
@@ -74,10 +74,10 @@
       <a name="FRAME-ADDING-MENU"></a><a href="#FRAME-MENU">Frame-Adding-Menu</a>
     </h3>
     <p>
-      a: Add a default frame
+      a: Add a default frame in the current frame
     </p>
     <p>
-      p: Add a placed frame
+      p: Add a placed frame in the current frame
     </p>
     <hr>
     <h3>

Modified: clfswm/doc/menu.txt
==============================================================================
--- clfswm/doc/menu.txt	(original)
+++ clfswm/doc/menu.txt	Mon May 12 16:31:09 2008
@@ -22,8 +22,8 @@
 x: Create a new frame for each window in frame
 
 Frame-Adding-Menu
-a: Add a default frame
-p: Add a placed frame
+a: Add a default frame in the current frame
+p: Add a placed frame in the current frame
 
 Frame-Layout-Menu
 a: Maximize windows in there frame - leave frame to there size (no layout)

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Mon May 12 16:31:09 2008
@@ -66,8 +66,8 @@
 
 
 (define-second-key ("m") 'open-menu)
-(define-second-key (#\<) 'open-menu)
-(define-second-key (#\< :control) 'open-menu)
+(define-second-key ("less") 'open-menu)
+(define-second-key ("less" :control) 'open-menu)
 
 (define-second-key ("f") 'open-frame-menu)
 (define-second-key ("w") 'open-window-menu)
@@ -124,6 +124,8 @@
 (define-second-key (#\o) 'set-open-in-new-frame-in-root-frame-nw-hook)
 (define-second-key (#\o :control) 'set-open-in-new-frame-in-parent-frame-nw-hook)
 
+(define-second-key (#\a) 'add-default-frame)
+
 ;;;; Escape
 (define-second-key ("Escape" :control :shift) 'delete-focus-window)
 (define-second-key ("Escape" :mod-1 :control :shift) 'destroy-focus-window)
@@ -154,7 +156,7 @@
 (define-shell (#\e) b-start-emacs "start emacs" "exec emacs")
 (define-shell (#\e :control) b-start-emacsremote
   "start an emacs for another user"
-  "exec emacsremote-Eterm")
+  "exec xterm -e emacsremote")
 (define-shell (#\h) b-start-xclock "start an xclock" "exec xclock -d")
 
 

Modified: clfswm/src/clfswm-autodoc.lisp
==============================================================================
--- clfswm/src/clfswm-autodoc.lisp	(original)
+++ clfswm/src/clfswm-autodoc.lisp	Mon May 12 16:31:09 2008
@@ -71,11 +71,13 @@
 
 
 (defun produce-doc-html-in-file (filename)
+  (format t "Producing html keys documentation in ~S " filename)
   (with-open-file (stream filename :direction :output
 			  :if-exists :supersede :if-does-not-exist :create)
     (produce-doc-html (list *main-keys* *main-mouse* *second-keys* *second-mouse*
 			    *info-keys* *info-mouse*)
-		      stream)))
+		      stream))
+  (format t " done~%"))
 
 
 
@@ -103,11 +105,13 @@
 			   
 
 (defun produce-doc-in-file (filename)
+  (format t "Producing text keys documentation in ~S " filename)
   (with-open-file (stream filename :direction :output
 			  :if-exists :supersede :if-does-not-exist :create)
     (produce-doc (list *main-keys* *main-mouse* *second-keys* *second-mouse*
 		       *info-keys* *info-mouse*)
-		 stream)))
+		 stream))
+  (format t " done~%"))
 
 
 
@@ -136,9 +140,11 @@
 
   
 (defun produce-menu-doc-in-file (filename)
+  (format t "Producing text menus documentation in ~S " filename)
   (with-open-file (stream filename :direction :output
 			  :if-exists :supersede :if-does-not-exist :create)
-    (produce-menu-doc stream)))
+    (produce-menu-doc stream))
+  (format t " done~%"))
 
 
 
@@ -179,9 +185,11 @@
 
   
 (defun produce-menu-doc-html-in-file (filename)
+  (format t "Producing html menus documentation in ~S " filename)
   (with-open-file (stream filename :direction :output
 			  :if-exists :supersede :if-does-not-exist :create)
-    (produce-menu-doc-html stream)))
+    (produce-menu-doc-html stream))
+  (format t " done~%"))
 
 
 

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Mon May 12 16:31:09 2008
@@ -56,7 +56,7 @@
 
 
 (defun add-default-frame ()
-  "Add a default frame"
+  "Add a default frame in the current frame"
   (when (frame-p *current-child*)
     (let ((name (query-string "Frame name")))
       (push (create-frame :name name) (frame-child *current-child*))))
@@ -64,7 +64,7 @@
     
 
 (defun add-placed-frame ()
-  "Add a placed frame"
+  "Add a placed frame in the current frame"
   (when (frame-p *current-child*)
     (let ((name (query-string "Frame name"))
 	  (x (/ (query-number "Frame x in percent (%)") 100))


From pbrochard at common-lisp.net  Mon May 12 20:59:34 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Mon, 12 May 2008 16:59:34 -0400 (EDT)
Subject: [clfswm-cvs] r124 - in clfswm: . doc src
Message-ID: <20080512205934.B5C3D25115@common-lisp.net>

Author: pbrochard
Date: Mon May 12 16:59:33 2008
New Revision: 124

Modified:
   clfswm/ChangeLog
   clfswm/doc/keys.html
   clfswm/doc/keys.txt
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/bindings.lisp
   clfswm/src/clfswm-internal.lisp
Log:
In *.lisp: Rename 'brother' frames to 'sister' frames.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Mon May 12 16:59:33 2008
@@ -1,5 +1,7 @@
 2008-05-12  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/*.lisp: Rename 'brother' frames to 'sister' frames.
+
 	* src/bindings-second-mode.lisp (define-second-key #\a): New
 	binding on 'add-default-frame'.
 

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Mon May 12 16:59:33 2008
@@ -60,7 +60,7 @@
           Right
         </td>
         <td style="color:#0000ff" nowrap>
-          Select the next brother frame
+          Select the next sister frame
         </td>
       </tr>
       <tr>
@@ -71,7 +71,7 @@
           Left
         </td>
         <td style="color:#0000ff" nowrap>
-          Select the previous brother frame
+          Select the previous sister frame
         </td>
       </tr>
       <tr>
@@ -723,7 +723,7 @@
           Right
         </td>
         <td style="color:#0000ff" nowrap>
-          Select the next brother frame
+          Select the next sister frame
         </td>
       </tr>
       <tr>
@@ -734,7 +734,7 @@
           Left
         </td>
         <td style="color:#0000ff" nowrap>
-          Select the previous brother frame
+          Select the previous sister frame
         </td>
       </tr>
       <tr>

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Mon May 12 16:59:33 2008
@@ -8,8 +8,8 @@
 
 Mod-1                F1              Open the help and info window
 Mod-1 Control Shift  Home            Quit clfswm
-Mod-1                Right           Select the next brother frame
-Mod-1                Left            Select the previous brother frame
+Mod-1                Right           Select the next sister frame
+Mod-1                Left            Select the previous sister frame
 Mod-1                Down            Select the previous level in frame
 Mod-1                Up              Select the next level in frame
 Mod-1                Tab             Select the next child
@@ -75,8 +75,8 @@
                      Escape          Leave second mode
                      T               Tile with spaces the current frame
 Mod-1 Control Shift  Home            Quit clfswm
-Mod-1                Right           Select the next brother frame
-Mod-1                Left            Select the previous brother frame
+Mod-1                Right           Select the next sister frame
+Mod-1                Left            Select the previous sister frame
 Mod-1                Down            Select the previous level in frame
 Mod-1                Up              Select the next level in frame
 Mod-1                Tab             Select the next child

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Mon May 12 16:59:33 2008
@@ -102,8 +102,8 @@
 
 (define-second-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
 
-(define-second-key ("Right" :mod-1) 'select-next-brother)
-(define-second-key ("Left" :mod-1) 'select-previous-brother)
+(define-second-key ("Right" :mod-1) 'select-next-sister)
+(define-second-key ("Left" :mod-1) 'select-previous-sister)
 
 (define-second-key ("Down" :mod-1) 'select-previous-level)
 (define-second-key ("Up" :mod-1) 'select-next-level)

Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp	(original)
+++ clfswm/src/bindings.lisp	Mon May 12 16:59:33 2008
@@ -39,8 +39,8 @@
 
 (define-main-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
 
-(define-main-key ("Right" :mod-1) 'select-next-brother)
-(define-main-key ("Left" :mod-1) 'select-previous-brother)
+(define-main-key ("Right" :mod-1) 'select-next-sister)
+(define-main-key ("Left" :mod-1) 'select-previous-sister)
 
 (define-main-key ("Down" :mod-1) 'select-previous-level)
 (define-main-key ("Up" :mod-1) 'select-next-level)

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Mon May 12 16:59:33 2008
@@ -629,8 +629,8 @@
 
 
 
-(defun select-next/previous-brother (fun-rotate)
-  "Select the next/previous brother frame"
+(defun select-next/previous-sister (fun-rotate)
+  "Select the next/previous sister frame"
   (let ((frame-is-root? (and (equal *current-root* *current-child*)
 			     (not (equal *current-root* *root-frame*)))))
     (if frame-is-root?
@@ -646,13 +646,13 @@
     (show-all-children *current-root*)))
 
 
-(defun select-next-brother ()
-  "Select the next brother frame"
-  (select-next/previous-brother #'anti-rotate-list))
-
-(defun select-previous-brother ()
-  "Select the previous brother frame"
-  (select-next/previous-brother #'rotate-list))
+(defun select-next-sister ()
+  "Select the next sister frame"
+  (select-next/previous-sister #'anti-rotate-list))
+
+(defun select-previous-sister ()
+  "Select the previous sister frame"
+  (select-next/previous-sister #'rotate-list))
 
 
 (defun select-next-level ()


From pbrochard at common-lisp.net  Tue May 13 20:50:24 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Tue, 13 May 2008 16:50:24 -0400 (EDT)
Subject: [clfswm-cvs] r125 - in clfswm: . src
Message-ID: <20080513205024.AAB9E232BC@common-lisp.net>

Author: pbrochard
Date: Tue May 13 16:50:23 2008
New Revision: 125

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-util.lisp
Log:
with-movement: Display frame info for all frames in current root.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue May 13 16:50:23 2008
@@ -1,3 +1,8 @@
+2008-05-13  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (with-movement): Display frame info for all
+	frames in current root.
+
 2008-05-12  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/*.lisp: Rename 'brother' frames to 'sister' frames.

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Tue May 13 16:50:23 2008
@@ -677,6 +677,7 @@
   `(when (frame-p *current-child*)
      , at body
      (show-all-children)
+     (display-all-frame-info)
      (draw-second-mode-window)
      (open-menu (find-menu 'frame-movement-menu))))
 


From pbrochard at common-lisp.net  Thu May 15 20:14:03 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Thu, 15 May 2008 16:14:03 -0400 (EDT)
Subject: [clfswm-cvs] r126 - in clfswm: . src
Message-ID: <20080515201403.4830672095@common-lisp.net>

Author: pbrochard
Date: Thu May 15 16:14:02 2008
New Revision: 126

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/xlib-util.lisp
Log:
resize-window: Use a better algorithm to resize windows.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Thu May 15 16:14:02 2008
@@ -1,3 +1,14 @@
+2008-05-15  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (current-frame-manage-window-type): Fix a
+	typo in managed types.
+
+	* src/clfswm-internal.lisp (show-child): Always display frame info
+	even if the frame is hidden.
+
+	* src/xlib-util.lisp (resize-window): Use a better algorithme to
+	resize windows.
+
 2008-05-13  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (with-movement): Display frame info for all

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Thu May 15 16:14:02 2008
@@ -449,14 +449,14 @@
 
 (defmethod show-child ((frame frame) parent display-p raise-p first-p)
   (declare (ignore parent))
-  (when display-p
-    (with-xlib-protect
+  (with-xlib-protect
+    (when display-p
       (with-slots (window) frame
 	(when (or *show-root-frame-p* (not (equal frame *current-root*)))
 	  (setf (xlib:window-background window) (get-color "Black"))
 	  (xlib:map-window window)
-	  (raise-if-needed window raise-p first-p)
-	  (display-frame-info frame))))))
+	  (raise-if-needed window raise-p first-p))))
+    (display-frame-info frame)))
 
 
 (defmethod show-child ((window xlib:window) parent display-p raise-p first-p)

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Thu May 15 16:14:02 2008
@@ -804,21 +804,23 @@
 
 
 ;;; Managed window type functions
+(defun current-frame-manage-window-type-generic (type-list)
+  (when (frame-p *current-child*)
+    (setf (frame-managed-type *current-child*) type-list
+	  (frame-forced-managed-window *current-child*) nil
+	  (frame-forced-unmanaged-window *current-child*) nil))
+  (leave-second-mode))
+
+
 (defun current-frame-manage-window-type ()
   "Change window types to be managed by a frame"
   (when (frame-p *current-child*)
     (let* ((type-str (query-string "Managed window type: (all, normal, transient, maxsize, desktop, dock, toolbar, menu, utility, splash, dialog)"
-				   (format nil "~{~:(~A~)~}" (frame-managed-type *current-child*))))
+				   (format nil "~{~:(~A~) ~}" (frame-managed-type *current-child*))))
 	   (type-list (loop :for type :in (split-string type-str)
 			 :collect (intern (string-upcase type) :keyword))))
-      (setf (frame-managed-type *current-child*) type-list)))
-  (leave-second-mode))
-
+      (current-frame-manage-window-type-generic type-list))))
 
-(defun current-frame-manage-window-type-generic (type-list)
-  (when (frame-p *current-child*)
-    (setf (frame-managed-type *current-child*) type-list))
-  (leave-second-mode))
 
 (defun current-frame-manage-all-window-type ()
   "Manage all window type"

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Thu May 15 16:14:02 2008
@@ -496,10 +496,8 @@
 (defun resize-window (window orig-x orig-y &optional additional-fn additional-arg)
   (raise-window window)
   (let* ((done nil)
-	 (dx (- (xlib:drawable-x window) orig-x))
-	 (dy (- (xlib:drawable-y window) orig-y))
-	 (lx orig-x)
-	 (ly orig-y)
+	 (orig-width (xlib:drawable-width window))
+	 (orig-height (xlib:drawable-height window))
 	 (pointer-grabbed-p (xgrab-pointer-p))
 	 (hints (xlib:wm-normal-hints window))
 	 (min-width (or (and hints (xlib:wm-size-hints-min-width hints)) 0))
@@ -508,11 +506,8 @@
 	 (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 (+ (xlib:drawable-width window) (- root-x lx)) 10 min-width) max-width)
-		     (xlib:drawable-height window) (min (max (+ (xlib:drawable-height window) (- root-y ly)) 10 min-height) max-height)
-		     dx (- dx (- root-x lx))
-		     dy (- dy (- root-y ly))
-		     lx root-x ly root-y)
+	       (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)


From pbrochard at common-lisp.net  Sat May 17 11:14:23 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sat, 17 May 2008 07:14:23 -0400 (EDT)
Subject: [clfswm-cvs] r127 - in clfswm: . src
Message-ID: <20080517111423.A6D3931033@common-lisp.net>

Author: pbrochard
Date: Sat May 17 07:14:18 2008
New Revision: 127

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-nw-hooks.lisp
Log:
place-window-from-hints: Center unmanaged windows in the root screen. clear-nw-hook, clear-all-nw-hooks: new functions.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat May 17 07:14:18 2008
@@ -1,3 +1,11 @@
+2008-05-17  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp (place-window-from-hints): Center
+	unmanaged windows in the root screen.
+
+	* src/clfswm-nw-hooks.lisp (clear-nw-hook, clear-all-nw-hooks):
+	new functions.
+
 2008-05-15  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (current-frame-manage-window-type): Fix a

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Sat May 17 07:14:18 2008
@@ -435,7 +435,7 @@
 
 (defmethod adapt-child-to-parent (child parent)
   (declare (ignore child parent))
-  ())
+  (values nil nil))
 
 
 
@@ -770,8 +770,8 @@
 			(xlib:drawable-height window))))
       (setf (xlib:drawable-width window) (min (max min-width rwidth *default-window-width*) max-width)
 	    (xlib:drawable-height window) (min (max min-height rheight *default-window-height*) max-height))
-            (setf (xlib:drawable-x window) (truncate (+ (frame-rx *current-child*) (/ (- (xlib:screen-width *screen*) (xlib:drawable-width window)) 2)))
-		  (xlib:drawable-y window) (truncate (+ (frame-ry *current-child*) (/ (- (xlib:screen-height *screen*) (xlib:drawable-height window)) 2)))))))
+      (setf (xlib:drawable-x window) (truncate (/ (- (xlib:screen-width *screen*) (xlib:drawable-width window)) 2))
+	    (xlib:drawable-y window) (truncate (/ (- (xlib:screen-height *screen*) (xlib:drawable-height window)) 2))))))
 
 
 

Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp	(original)
+++ clfswm/src/clfswm-nw-hooks.lisp	Sat May 17 07:14:18 2008
@@ -65,6 +65,15 @@
     (leave-frame)
     (select-previous-level)))
 
+(defun clear-nw-hook (frame)
+  "Clear the frame new window hook"
+  (setf (frame-nw-hook frame) nil))
+
+(defun clear-all-nw-hooks ()
+  "Clear all new window hooks for all frames"
+  (with-all-frames (*root-frame* frame)
+    (clear-nw-hook frame)))
+
 
 
 ;;; Default frame new window hook
@@ -90,7 +99,7 @@
   (pushnew window (frame-child *current-root*))
   (setf *current-child* (first (frame-child *current-root*)))
   (default-window-placement *current-root* window)
-  (setf (frame-nw-hook frame) nil))
+  (clear-nw-hook frame))
 
 (defun set-open-in-current-root-nw-hook ()
   "Open the next window in the current root"
@@ -108,7 +117,7 @@
     (pushnew window (frame-child new-frame))
     (setf *current-child* new-frame)
     (default-window-placement new-frame window))
-  (setf (frame-nw-hook frame) nil))
+  (clear-nw-hook frame))
 
 (defun set-open-in-new-frame-in-current-root-nw-hook ()
   "Open the next window in a new frame in the current root"
@@ -128,7 +137,7 @@
     (set-tile-space-layout-once)
     (setf *current-child* new-frame)
     (default-window-placement new-frame window))
-  (setf (frame-nw-hook frame) nil))
+  (clear-nw-hook frame))
 
 (defun set-open-in-new-frame-in-root-frame-nw-hook ()
   "Open the next window in a new frame in the root frame"
@@ -150,7 +159,7 @@
       (setf *current-child* new-frame)
       (default-window-placement new-frame window)
       (show-all-children *current-root*)))
-  (setf (frame-nw-hook frame) nil))
+  (clear-nw-hook frame))
 
 (defun set-open-in-new-frame-in-parent-frame-nw-hook ()
   "Open the next window in a new frame in the parent frame"
@@ -170,7 +179,8 @@
     (when (second (frame-child *current-child*))
       (rotatef (first (frame-child *current-child*))
 	       (second (frame-child *current-child*)))))
-  (default-window-placement *current-child* window))
+  (default-window-placement *current-child* window)
+  (clear-nw-hook frame))
 
 (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  Sat May 17 11:18:04 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sat, 17 May 2008 07:18:04 -0400 (EDT)
Subject: [clfswm-cvs] r128 - clfswm/src
Message-ID: <20080517111804.B42CC73205@common-lisp.net>

Author: pbrochard
Date: Sat May 17 07:18:04 2008
New Revision: 128

Modified:
   clfswm/src/clfswm-nw-hooks.lisp
Log:
leave-focus-frame-nw-hook: remove an ignore declaration

Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp	(original)
+++ clfswm/src/clfswm-nw-hooks.lisp	Sat May 17 07:18:04 2008
@@ -172,7 +172,6 @@
 ;;; 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"
-  (declare (ignore frame))
   (leave-if-not-frame *current-child*)
   (when (frame-p *current-child*)
     (pushnew window (frame-child *current-child*))


From pbrochard at common-lisp.net  Sat May 17 19:41:07 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sat, 17 May 2008 15:41:07 -0400 (EDT)
Subject: [clfswm-cvs] r129 - in clfswm: . src
Message-ID: <20080517194107.86B333700E@common-lisp.net>

Author: pbrochard
Date: Sat May 17 15:41:06 2008
New Revision: 129

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-layout.lisp
Log:
(tile-left-space-layout): New layout. (tile-left-layout, tile-right-layout, tile-top-layout, tile-bottom-layout): Use all the frame space when there is only	one child.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat May 17 15:41:06 2008
@@ -1,5 +1,10 @@
 2008-05-17  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-layout.lisp (tile-left-space-layout): New layout.
+	(tile-left-layout, tile-right-layout, tile-top-layout)
+	(tile-bottom-layout): Use all the frame space when there is only
+	one child.
+
 	* src/clfswm-internal.lisp (place-window-from-hints): Center
 	unmanaged windows in the root screen.
 

Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp	(original)
+++ clfswm/src/clfswm-layout.lisp	Sat May 17 15:41:06 2008
@@ -90,6 +90,8 @@
 
 
 
+
+
 ;;; No layout
 (defgeneric no-layout (child parent)
   (:documentation "Maximize windows in there frame - leave frame to there size (no layout)"))
@@ -155,17 +157,19 @@
 	   (len (max (1- (length managed-children)) 1))
 	   (dy (/ rh len))
 	   (size (or (frame-data-slot parent :tile-size) 0.8)))
-      (if (= pos 0)
-	  (values (1+ rx)
-		  (1+ ry)
-		  (- (round (* rw size)) 2)
-		  (- rh 2)
-		  t)
-	  (values (1+ (round (+ rx (* rw size))))
-		  (1+ (round (+ ry (* dy (1- pos)))))
-		  (- (round (* rw (- 1 size))) 2)
-		  (- (round dy) 2)
-		  t)))))
+      (if (> (length managed-children) 1)
+	  (if (= pos 0)
+	      (values (1+ rx)
+		      (1+ ry)
+		      (- (round (* rw size)) 2)
+		      (- rh 2)
+		      t)
+	      (values (1+ (round (+ rx (* rw size))))
+		      (1+ (round (+ ry (* dy (1- pos)))))
+		      (- (round (* rw (- 1 size))) 2)
+		      (- (round dy) 2)
+		      t))
+	  (no-layout child parent)))))
 
 
 (defun set-tile-left-layout ()
@@ -188,17 +192,19 @@
 	   (len (max (1- (length managed-children)) 1))
 	   (dy (/ rh len))
 	   (size (or (frame-data-slot parent :tile-size) 0.8)))
-      (if (= pos 0)
-	  (values (1+ (round (+ rx (* rw (- 1 size)))))
-		  (1+ ry)
-		  (- (round (* rw size)) 2)
-		  (- rh 2)
-		  t)
-	  (values (1+ rx)
-		  (1+ (round (+ ry (* dy (1- pos)))))
-		  (- (round (* rw (- 1 size))) 2)
-		  (- (round dy) 2)
-		  t)))))
+      (if (> (length managed-children) 1)
+	  (if (= pos 0)
+	      (values (1+ (round (+ rx (* rw (- 1 size)))))
+		      (1+ ry)
+		      (- (round (* rw size)) 2)
+		      (- rh 2)
+		      t)
+	      (values (1+ rx)
+		      (1+ (round (+ ry (* dy (1- pos)))))
+		      (- (round (* rw (- 1 size))) 2)
+		      (- (round dy) 2)
+		      t))
+	  (no-layout child parent)))))
 
 
 (defun set-tile-right-layout ()
@@ -223,17 +229,19 @@
 	   (len (max (1- (length managed-children)) 1))
 	   (dx (/ rw len))
 	   (size (or (frame-data-slot parent :tile-size) 0.8)))
-      (if (= pos 0)
-	  (values (1+ rx)
-		  (1+ ry)
-		  (- rw 2)
-		  (- (round (* rh size)) 2)
-		  t)
-	  (values (1+ (round (+ rx (* dx (1- pos)))))
-		  (1+ (round (+ ry (* rh size))))
-		  (- (round dx) 2)
-		  (- (round (* rh (- 1 size))) 2)
-		  t)))))
+      (if (> (length managed-children) 1)
+	  (if (= pos 0)
+	      (values (1+ rx)
+		      (1+ ry)
+		      (- rw 2)
+		      (- (round (* rh size)) 2)
+		      t)
+	      (values (1+ (round (+ rx (* dx (1- pos)))))
+		      (1+ (round (+ ry (* rh size))))
+		      (- (round dx) 2)
+		      (- (round (* rh (- 1 size))) 2)
+		      t))
+	  (no-layout child parent)))))
 
 
 (defun set-tile-top-layout ()
@@ -256,17 +264,19 @@
 	   (len (max (1- (length managed-children)) 1))
 	   (dx (/ rw len))
 	   (size (or (frame-data-slot parent :tile-size) 0.8)))
-      (if (= pos 0)
-	  (values (1+ rx)
-		  (1+ (round (+ ry (* rh (- 1 size)))))
-		  (- rw 2)
-		  (- (round (* rh size)) 2)
-		  t)
-	  (values (1+ (round (+ rx (* dx (1- pos)))))
-		  (1+ ry)
-		  (- (round dx) 2)
-		  (- (round (* rh (- 1 size))) 2)
-		  t)))))
+      (if (> (length managed-children) 1)
+	  (if (= pos 0)
+	      (values (1+ rx)
+		      (1+ (round (+ ry (* rh (- 1 size)))))
+		      (- rw 2)
+		      (- (round (* rh size)) 2)
+		      t)
+	      (values (1+ (round (+ rx (* dx (1- pos)))))
+		      (1+ ry)
+		      (- (round dx) 2)
+		      (- (round (* rh (- 1 size))) 2)
+		      t))
+	  (no-layout child parent)))))
 
 
 
@@ -308,3 +318,58 @@
   (set-layout #'tile-space-layout))
 
 (register-layout 'set-tile-space-layout)
+
+
+
+
+
+
+
+
+;;; 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)))
+      (setf (frame-data-slot *current-child* slot) new-space))))
+
+
+(defgeneric tile-left-space-layout (child parent)
+  (:documentation "Tile Left Space: main child on left and others on right. Leave some space on the left."))
+
+;;; TODO: if only one window -> max in its frame
+(defmethod tile-left-space-layout (child parent)
+  (with-slots (rx ry rw rh) parent
+    (let* ((managed-children (get-managed-child parent))
+	   (pos (position child managed-children))
+	   (len (max (1- (length managed-children)) 1))
+	   (dy (/ rh len))
+	   (size (or (frame-data-slot parent :tile-size) 0.8))
+	   (space (or (frame-data-slot parent :tile-left-space) 100)))
+      (if (> (length managed-children) 1)
+	  (if (= pos 0)
+	      (values (+ rx space 1)
+		      (1+ ry)
+		      (- (round (* rw size)) 2 space)
+		      (- rh 2)
+		      t)
+	      (values (1+ (round (+ rx (* rw size))))
+		      (1+ (round (+ ry (* dy (1- pos)))))
+		      (- (round (* rw (- 1 size))) 2)
+		      (- (round dy) 2)
+		      t))
+	  (multiple-value-bind (rnx rny rnw rnh)
+	      (no-layout child parent)
+	    (values (+ rnx space)
+		    rny
+		    (- rnw space)
+		    rnh
+		    t))))))
+
+
+(defun set-tile-left-space-layout ()
+  "Tile Left Space: main child on left and others on right. Leave some space on the left."
+  (layout-ask-size "Tile size in percent (%)" :tile-size)
+  (layout-ask-space "Tile space" :tile-left-space)
+  (set-layout #'tile-left-space-layout))
+
+(register-layout 'set-tile-left-space-layout)


From pbrochard at common-lisp.net  Sat May 17 19:54:45 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sat, 17 May 2008 15:54:45 -0400 (EDT)
Subject: [clfswm-cvs] r130 - in clfswm: . src
Message-ID: <20080517195445.D7A9420018@common-lisp.net>

Author: pbrochard
Date: Sat May 17 15:54:45 2008
New Revision: 130

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-nw-hooks.lisp
Log:
default-frame-nw-hook: Do not handle the ROX pinboard (ie: leave it lowered in the root window as expected).

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat May 17 15:54:45 2008
@@ -1,5 +1,9 @@
 2008-05-17  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-nw-hooks.lisp (default-frame-nw-hook): Do not handle
+	the ROX pinboard (ie: leave it lowered in the root window as
+	expected).
+
 	* src/clfswm-layout.lisp (tile-left-space-layout): New layout.
 	(tile-left-layout, tile-right-layout, tile-top-layout)
 	(tile-bottom-layout): Use all the frame space when there is only

Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp	(original)
+++ clfswm/src/clfswm-nw-hooks.lisp	Sat May 17 15:54:45 2008
@@ -80,10 +80,11 @@
 (defun default-frame-nw-hook (frame window)
   "Open the next window in the current frame"
   (declare (ignore frame))
-  (leave-if-not-frame *current-child*)
-  (when (frame-p *current-child*)
-    (pushnew window (frame-child *current-child*)))
-  (default-window-placement *current-child* window))
+  (unless (string-equal (xlib:get-wm-class window) "ROX-Pinboard")
+    (leave-if-not-frame *current-child*)
+    (when (frame-p *current-child*)
+      (pushnew window (frame-child *current-child*)))
+    (default-window-placement *current-child* window)))
 
 (defun set-default-frame-nw-hook ()
   "Open the next window in the current frame"


From pbrochard at common-lisp.net  Sat May 17 22:09:41 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sat, 17 May 2008 18:09:41 -0400 (EDT)
Subject: [clfswm-cvs] r131 - in clfswm: . doc src
Message-ID: <20080517220941.452ED4610B@common-lisp.net>

Author: pbrochard
Date: Sat May 17 18:09:40 2008
New Revision: 131

Modified:
   clfswm/ChangeLog
   clfswm/doc/keys.html
   clfswm/doc/keys.txt
   clfswm/doc/menu.html
   clfswm/doc/menu.txt
   clfswm/src/clfswm-autodoc.lisp
Log:
Autodoc: produce-*-doc-*: Add a note to use the autodoc functions.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat May 17 18:09:40 2008
@@ -1,3 +1,8 @@
+2008-05-18  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-autodoc.lisp (produce-*-doc-*): Add a note to use the
+	autodoc functions.
+
 2008-05-17  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-nw-hooks.lisp (default-frame-nw-hook): Do not handle

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Sat May 17 18:09:40 2008
@@ -1507,5 +1507,19 @@
         </td>
       </tr>
     </table>
+    <p>
+      <small>
+        This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-doc-html-in-file or
+the produce-all-docs function from the Lisp REPL.
+      </small>
+    </p>
+    <p>
+      <small>
+        Something like this:<br>
+LISP> (in-package :clfswm)<br>
+CLFSWM> (produce-doc-html-in-file "my-keys.html")<br>
+or<br> CLFSWM> (produce-all-docs)
+      </small>
+    </p>
   </body>
 </html>

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Sat May 17 18:09:40 2008
@@ -158,3 +158,14 @@
                      5               Move one line down
                      Motion          Grab text
 
+
+
+This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-doc-in-file or
+the produce-all-docs function from the Lisp REPL.
+
+Something like this:
+LISP> (in-package :clfswm)
+CLFSWM> (produce-doc-in-file "my-keys.txt")
+or
+CLFSWM> (produce-all-docs)
+

Modified: clfswm/doc/menu.html
==============================================================================
--- clfswm/doc/menu.html	(original)
+++ clfswm/doc/menu.html	Sat May 17 18:09:40 2008
@@ -104,6 +104,9 @@
     <p>
       g: Tile Space: tile child in its frame leaving spaces between them
     </p>
+    <p>
+      h: Tile Left Space: main child on left and others on right. Leave some space on the left.
+    </p>
     <hr>
     <h3>
       <a name="FRAME-LAYOUT-ONCE-MENU"></a><a href="#FRAME-MENU">Frame-Layout-Once-Menu</a>
@@ -129,6 +132,9 @@
     <p>
       g: Tile Space: tile child in its frame leaving spaces between them
     </p>
+    <p>
+      h: Tile Left Space: main child on left and others on right. Leave some space on the left.
+    </p>
     <hr>
     <h3>
       <a name="FRAME-NW-HOOK-MENU"></a><a href="#FRAME-MENU">Frame-Nw-Hook-Menu</a>
@@ -358,5 +364,19 @@
       exclam: Run a program from the query input
     </p>
     <hr>
+    <p>
+      <small>
+        This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-menu-doc-html-in-file or
+the produce-all-docs function from the Lisp REPL.
+      </small>
+    </p>
+    <p>
+      <small>
+        Something like this:<br>
+LISP> (in-package :clfswm)<br>
+CLFSWM> (produce-menu-doc-html-in-file "my-menu.html")<br>
+or<br> CLFSWM> (produce-all-docs)
+      </small>
+    </p>
   </body>
 </html>

Modified: clfswm/doc/menu.txt
==============================================================================
--- clfswm/doc/menu.txt	(original)
+++ clfswm/doc/menu.txt	Sat May 17 18:09:40 2008
@@ -33,6 +33,7 @@
 e: Tile Top: main child on top and others on bottom
 f: Tile Bottom: main child on bottom and others on top
 g: Tile Space: tile child in its frame leaving spaces between them
+h: Tile Left Space: main child on left and others on right. Leave some space on the left.
 
 Frame-Layout-Once-Menu
 a: Maximize windows in there frame - leave frame to there size (no layout)
@@ -42,6 +43,7 @@
 e: Tile Top: main child on top and others on bottom
 f: Tile Bottom: main child on bottom and others on top
 g: Tile Space: tile child in its frame leaving spaces between them
+h: Tile Left Space: main child on left and others on right. Leave some space on the left.
 
 Frame-Nw-Hook-Menu
 a: Open the next window in the current frame
@@ -126,3 +128,14 @@
 i: Identify a key
 colon: Eval a lisp form from the query input
 exclam: Run a program from the query input
+
+
+This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-menu-doc-in-file or
+the produce-all-docs function from the Lisp REPL.
+
+Something like this:
+LISP> (in-package :clfswm)
+CLFSWM> (produce-menu-doc-in-file "my-menu.txt")
+or
+CLFSWM> (produce-all-docs)
+

Modified: clfswm/src/clfswm-autodoc.lisp
==============================================================================
--- clfswm/src/clfswm-autodoc.lisp	(original)
+++ clfswm/src/clfswm-autodoc.lisp	Sat May 17 18:09:40 2008
@@ -66,7 +66,13 @@
 	       (dolist (hk hash-table-key-list)
 		 (push `(h3 (u ,(gethash 'name hk))) acc)
 		 (push (produce-keys hk) acc))
-	       (nreverse acc))))
+	       (nreverse acc))
+	(p (small "This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-doc-html-in-file or
+the produce-all-docs function from the Lisp REPL."))
+	(p (small "Something like this:<br>
+LISP> (in-package :clfswm)<br>
+CLFSWM> (produce-doc-html-in-file \"my-keys.html\")<br>
+or<br> CLFSWM> (produce-all-docs)"))))
      0 stream)))
 
 
@@ -100,7 +106,15 @@
 									(first k)))))
 			   (documentation (or (first v) (third v)) 'function))))
 	     hk)
-    (format stream "~2&")))
+    (format stream "~2&"))
+  (format stream "~2%This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-doc-in-file or
+the produce-all-docs function from the Lisp REPL.
+
+Something like this:
+LISP> (in-package :clfswm)
+CLFSWM> (produce-doc-in-file \"my-keys.txt\")
+or
+CLFSWM> (produce-all-docs)~2%"))
 
 			   
 
@@ -135,7 +149,15 @@
 			      (rec (menu-item-value item))))))))
     (format stream "Here is the map of the CLFSWM menu:~%")
     (format stream "(By default it is bound on second-mode + m)~%")
-    (rec *menu*)))
+    (rec *menu*)
+    (format stream "~2%This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-menu-doc-in-file or
+the produce-all-docs function from the Lisp REPL.
+
+Something like this:
+LISP> (in-package :clfswm)
+CLFSWM> (produce-menu-doc-in-file \"my-menu.txt\")
+or
+CLFSWM> (produce-all-docs)~2%")))
 
 
   
@@ -180,7 +202,13 @@
 		       (h1 ("a name=\"Top\"" "CLFSWM Menu"))
 		       (p "Here is the map of the CLFSWM menu:"
 			  "(By default it is bound on second-mode + m)")
-		       ,@(nreverse menu-list)))
+		       ,@(nreverse menu-list)
+		       (p (small "This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-menu-doc-html-in-file or
+the produce-all-docs function from the Lisp REPL."))
+		       (p (small "Something like this:<br>
+LISP> (in-package :clfswm)<br>
+CLFSWM> (produce-menu-doc-html-in-file \"my-menu.html\")<br>
+or<br> CLFSWM> (produce-all-docs)"))))
 		    0 stream))))
 
   


From pbrochard at common-lisp.net  Sun May 18 20:53:14 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Sun, 18 May 2008 16:53:14 -0400 (EDT)
Subject: [clfswm-cvs] r132 - clfswm/doc
Message-ID: <20080518205314.7584D59098@common-lisp.net>

Author: pbrochard
Date: Sun May 18 16:53:13 2008
New Revision: 132

Modified:
   clfswm/doc/dot-clfswmrc
Log:
More dot-clfswmrc examples

Modified: clfswm/doc/dot-clfswmrc
==============================================================================
--- clfswm/doc/dot-clfswmrc	(original)
+++ clfswm/doc/dot-clfswmrc	Sun May 18 16:53:13 2008
@@ -218,8 +218,15 @@
   (setf (frame-managed-type *root-frame*) nil))
 
 
+;;; Here is another example useful with the ROX filer: Only the
+;;; root frame fullscreen with some space on the left for icons.
+(defun my-init-hook-rox-filer ()
+  (setf (frame-layout *root-frame*) #'tile-left-space-layout
+	(frame-data-slot *root-frame* :tile-size) 0.9))
+
+
 
 
 (setf *init-hook* #'my-init-hook-4)  ;; <- choose one in 1 to 4
 ;;(setf *init-hook* nil)
-;;; Init hook end
\ No newline at end of file
+;;; Init hook end


From pbrochard at common-lisp.net  Tue May 20 20:35:48 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Tue, 20 May 2008 16:35:48 -0400 (EDT)
Subject: [clfswm-cvs] r133 - in clfswm: . src
Message-ID: <20080520203548.438F236177@common-lisp.net>

Author: pbrochard
Date: Tue May 20 16:35:47 2008
New Revision: 133

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm.lisp
   clfswm/src/package.lisp
Log:
remove-child-in-frame: Destroy the frame window for the removed child and its children.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue May 20 16:35:47 2008
@@ -1,3 +1,8 @@
+2008-05-20  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-internal.lisp (remove-child-in-frame): Destroy the
+	frame window for the removed child and its children.
+
 2008-05-18  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-autodoc.lisp (produce-*-doc-*): Add a note to use the

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Tue May 20 16:35:47 2008
@@ -7,6 +7,29 @@
 ===============
 Should handle these soon.
 
+- Use conpressed motion events for clisp. [Philippe]
+
+- A frame parameter to display or not the frame window. [Philippe]
+
+- Remote access to the clfswm REPL [Philippe]
+
+- cd/pwd a la shell to navigate throw frames. [Philippe] 
+
+- Hide/Unhide frame [Philippe]
+
+- Undo/redo (any idea to implement this is welcome)
+
+- Raise/lower frame - 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]
+
+- Hook to open next window in named/numbered frame [Philippe]
+
+- Ensure-unique-number/name (new function) [Philippe]
+
+
 
 MAYBE
 =====
@@ -31,20 +54,3 @@
     * up
     * down
 
-- Remote access to the clfswm REPL [Philippe]
-
-- cd/pwd a la shell to navigate throw frames. [Philippe] 
-
-- Hide/Unhide frame [Philippe]
-
-- Undo/redo (any idea to implement this is welcome)
-
-- Raise/lower frame - 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]
-
-- Hook to open next window in named/numbered frame [Philippe]
-
-- Ensure-unique-number/name (new function) [Philippe]

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Tue May 20 16:35:47 2008
@@ -244,6 +244,8 @@
 
 
 
+
+
 (defun add-frame (frame parent)
   (push frame (frame-child parent))
   frame)
@@ -733,7 +735,13 @@
 (defun remove-child-in-frame (child frame)
   "Remove the child in frame"
   (when (frame-p frame)
-    (setf (frame-child frame) (remove child (frame-child frame) :test #'equal))))
+    (setf (frame-child frame) (remove child (frame-child frame) :test #'equal))
+    (let ((frame-windows nil))
+      (with-all-frames (child f)
+	(pushnew (frame-window f) frame-windows))
+      (dolist (win frame-windows)
+	(unless (find-frame-window win)
+	  (xlib:destroy-window win))))))
 
 (defun remove-child-in-frames (child root)
   "Remove child in the frame root and in all its children"

Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp	(original)
+++ clfswm/src/clfswm.lisp	Tue May 20 16:35:47 2008
@@ -195,10 +195,6 @@
   (setf *screen* (first (xlib:display-roots *display*))
 	*root* (xlib:screen-root *screen*)
 	*no-focus-window* (xlib:create-window :parent *root* :x 0 :y 0 :width 1 :height 1)
-	*root-gc* (xlib:create-gcontext :drawable *root*
-					:foreground (get-color *color-unselected*)
-					:background (get-color "Black")
-					:line-style :solid)
 	*default-font* (xlib:open-font *display* *default-font-string*)
 	*pixmap-buffer* (xlib:create-pixmap :width (xlib:screen-width *screen*)
 					    :height (xlib:screen-height *screen*)

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Tue May 20 16:35:47 2008
@@ -37,7 +37,6 @@
 (defparameter *screen* nil)
 (defparameter *root* nil)
 (defparameter *no-focus-window* nil)
-(defparameter *root-gc* nil)
 
 (defparameter *pixmap-buffer* nil)
 


From pbrochard at common-lisp.net  Thu May 22 13:39:19 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Thu, 22 May 2008 09:39:19 -0400 (EDT)
Subject: [clfswm-cvs] r134 - clfswm/src
Message-ID: <20080522133919.A555F830B6@common-lisp.net>

Author: pbrochard
Date: Thu May 22 09:39:19 2008
New Revision: 134

Modified:
   clfswm/src/clfswm-internal.lisp
Log:
remove-child-in-frame: better algorithm to remove window and gc frame

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Thu May 22 09:39:19 2008
@@ -736,12 +736,10 @@
   "Remove the child in frame"
   (when (frame-p frame)
     (setf (frame-child frame) (remove child (frame-child frame) :test #'equal))
-    (let ((frame-windows nil))
-      (with-all-frames (child f)
-	(pushnew (frame-window f) frame-windows))
-      (dolist (win frame-windows)
-	(unless (find-frame-window win)
-	  (xlib:destroy-window win))))))
+    (with-all-frames (child fr)
+      (unless (find-frame-window (frame-window fr))
+	(awhen (frame-gc fr) (xlib:free-gcontext it) (setf it nil))
+	(awhen (frame-window fr) (xlib:destroy-window it) (setf it nil))))))
 
 (defun remove-child-in-frames (child root)
   "Remove child in the frame root and in all its children"


From pbrochard at common-lisp.net  Fri May 23 20:51:52 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Fri, 23 May 2008 16:51:52 -0400 (EDT)
Subject: [clfswm-cvs] r135 - in clfswm: . src
Message-ID: <20080523205152.F02B628181@common-lisp.net>

Author: pbrochard
Date: Fri May 23 16:51:51 2008
New Revision: 135

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/menu-def.lisp
Log:
rename-current-child: Do not display the frame info for a window.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Fri May 23 16:51:51 2008
@@ -1,3 +1,8 @@
+2008-05-23  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (rename-current-child): Do not display the
+	frame info for a window.
+
 2008-05-20  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-internal.lisp (remove-child-in-frame): Destroy the

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Fri May 23 16:51:51 2008
@@ -15,11 +15,11 @@
 
 - cd/pwd a la shell to navigate throw frames. [Philippe] 
 
-- Hide/Unhide frame [Philippe]
+- Hide/Unhide child [Philippe]
 
 - Undo/redo (any idea to implement this is welcome)
 
-- Raise/lower frame - this can be done with children order [Philippe]
+- Raise/lower child - this can be done with children order [Philippe]
 
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]
 

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Fri May 23 16:51:51 2008
@@ -144,7 +144,8 @@
 (defgeneric rename-child (child name))
 
 (defmethod rename-child ((child frame) name)
-  (setf (frame-name child) name))
+  (setf (frame-name child) name)
+  (display-frame-info child))
 
 (defmethod rename-child ((child xlib:window) name)
   (setf (xlib:wm-name child) name))

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Fri May 23 16:51:51 2008
@@ -40,7 +40,6 @@
   (let ((name (query-string (format nil "New child name: (last: ~A)" (child-name *current-child*))
 			    (child-name *current-child*))))
     (rename-child *current-child* name)
-    (display-frame-info *current-child*)
     (leave-second-mode)))
 
 
@@ -178,7 +177,15 @@
   (remove-child-in-frame *current-child* (find-parent-frame *current-child* *current-root*))
   (setf *current-child* *current-root*)
   (leave-second-mode))
-      
+
+
+(defun remove-current-child-from-tree ()
+  "Remove the current child from the CLFSWM tree"
+  (remove-child-in-frame *current-child* (find-parent-frame *current-child* *current-root*))
+  (setf *current-child* *current-root*)
+  (leave-second-mode))
+
+
 
 (defun paste-selection-no-clear ()
   "Paste the selection in the current frame - Do not clear the selection after paste"

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Fri May 23 16:51:51 2008
@@ -62,6 +62,7 @@
 
 
 
+(add-sub-menu 'main "c" 'child-menu "Child menu")
 (add-sub-menu 'main "f" 'frame-menu "Frame menu")
 (add-sub-menu 'main "w" 'window-menu "Window menu")
 (add-sub-menu 'main "s" 'selection-menu "Selection menu")
@@ -71,6 +72,11 @@
 
 
 
+(add-menu-key 'child-menu "r" 'rename-current-child)
+(add-menu-key 'child-menu "x" 'remove-current-child-from-tree)
+(add-menu-key 'child-menu "Delete" 'remove-current-child)
+
+
 (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)")
@@ -78,7 +84,6 @@
 (add-sub-menu 'frame-menu "m" 'frame-movement-menu "Frame movement menu")
 (add-sub-menu 'frame-menu "w" 'managed-window-menu "Managed window type menu")
 (add-sub-menu 'frame-menu "i" 'frame-info-menu "Frame info menu")
-(add-menu-key 'frame-menu "r" 'rename-current-child)
 (add-menu-key 'frame-menu "u" 'renumber-current-frame)
 (add-menu-key 'frame-menu "x" 'explode-current-frame)
 


From pbrochard at common-lisp.net  Wed May 28 20:12:59 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Wed, 28 May 2008 16:12:59 -0400 (EDT)
Subject: [clfswm-cvs] r136 - in clfswm: . src
Message-ID: <20080528201259.907AB1B02B@common-lisp.net>

Author: pbrochard
Date: Wed May 28 16:12:58 2008
New Revision: 136

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/menu-def.lisp
   clfswm/src/package.lisp
Log:
hide/show-frame-window: new function and menu item.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed May 28 16:12:58 2008
@@ -1,3 +1,8 @@
+2008-05-28  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (hide/show-frame-window): new function and
+	menu item.
+
 2008-05-23  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (rename-current-child): Do not display the

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Wed May 28 16:12:58 2008
@@ -9,16 +9,10 @@
 
 - Use conpressed motion events for clisp. [Philippe]
 
-- A frame parameter to display or not the frame window. [Philippe]
-
-- Remote access to the clfswm REPL [Philippe]
-
 - cd/pwd a la shell to navigate throw frames. [Philippe] 
 
 - Hide/Unhide child [Philippe]
 
-- Undo/redo (any idea to implement this is welcome)
-
 - Raise/lower child - this can be done with children order [Philippe]
 
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]
@@ -54,3 +48,6 @@
     * up
     * down
 
+- Remote access to the clfswm REPL [Philippe]
+
+- Undo/redo (any idea to implement this is welcome)

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Wed May 28 16:12:58 2008
@@ -453,12 +453,14 @@
 (defmethod show-child ((frame frame) parent display-p raise-p first-p)
   (declare (ignore parent))
   (with-xlib-protect
-    (when display-p
-      (with-slots (window) frame
-	(when (or *show-root-frame-p* (not (equal frame *current-root*)))
-	  (setf (xlib:window-background window) (get-color "Black"))
-	  (xlib:map-window window)
-	  (raise-if-needed window raise-p first-p))))
+    (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)
+	      (raise-if-needed window raise-p first-p)))
+	  (hide-window window)))
     (display-frame-info frame)))
 
 

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Wed May 28 16:12:58 2008
@@ -942,3 +942,22 @@
   (stop-button-event))
 
 
+
+
+;;; Hide/Show frame window functions
+(defun hide/show-frame-window (frame value)
+  "Hide/show the frame window"
+  (when (frame-p frame)
+    (setf (frame-show-window-p *current-child*) value)
+    (show-all-children *current-root*))
+  (leave-second-mode))
+
+
+(defun hide-current-frame-window ()
+  "Hide the current frame window"
+  (hide/show-frame-window *current-child* nil))
+
+(defun show-current-frame-window ()
+  "Show the current frame window"
+  (hide/show-frame-window *current-child* t))
+

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Wed May 28 16:12:58 2008
@@ -83,9 +83,7 @@
 (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 "w" 'managed-window-menu "Managed window type menu")
-(add-sub-menu 'frame-menu "i" 'frame-info-menu "Frame info menu")
-(add-menu-key 'frame-menu "u" 'renumber-current-frame)
-(add-menu-key 'frame-menu "x" 'explode-current-frame)
+(add-sub-menu 'frame-menu "s" 'frame-miscellaneous-menu "Frame miscallenous menu")
 
 
 (add-menu-key 'frame-adding-menu "a" 'add-default-frame)
@@ -126,8 +124,14 @@
 (add-menu-key 'managed-window-menu "u" 'current-frame-manage-no-window-type)
 
 
-(add-menu-key 'frame-info-menu "s" 'show-all-frames-info)
-(add-menu-key 'frame-info-menu "h" 'hide-all-frames-info)
+(add-menu-key 'frame-miscellaneous-menu "s" 'show-all-frames-info)
+(add-menu-key 'frame-miscellaneous-menu "i" 'hide-all-frames-info)
+(add-menu-key 'frame-miscellaneous-menu "h" 'hide-current-frame-window)
+(add-menu-key 'frame-miscellaneous-menu "w" 'show-current-frame-window)
+(add-menu-key 'frame-miscellaneous-menu "u" 'renumber-current-frame)
+(add-menu-key 'frame-miscellaneous-menu "x" 'explode-current-frame)
+
+
 
 
 (add-menu-key 'window-menu "i" 'display-current-window-info)

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Wed May 28 16:12:58 2008
@@ -99,6 +99,11 @@
 			  :accessor frame-forced-unmanaged-window
 			  :initform nil
 			  :documentation "A list of forced unmanaged windows (wm-name or window)")
+   (show-window-p :initarg :show-window-p :accessor frame-show-window-p :initform t)
+   (hidden-list :initarg :hidden-list :accessor frame-hidden-list :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")
    (window :initarg :window :accessor frame-window :initform nil)
    (gc :initarg :gc :accessor frame-gc :initform nil)
    (child :initarg :child :accessor frame-child :initform nil)


From pbrochard at common-lisp.net  Wed May 28 21:55:16 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Wed, 28 May 2008 17:55:16 -0400 (EDT)
Subject: [clfswm-cvs] r137 - in clfswm: . src
Message-ID: <20080528215516.8CF1A59084@common-lisp.net>

Author: pbrochard
Date: Wed May 28 17:55:15 2008
New Revision: 137

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-menu.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/menu-def.lisp
   clfswm/src/package.lisp
Log:
hide-current-child, unhide-a-child, unhide-all-children: New functions. info-mode-menu: Handle symbols and functions.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed May 28 17:55:15 2008
@@ -1,5 +1,11 @@
 2008-05-28  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-util.lisp (hide-current-child, unhide-a-child)
+	(unhide-all-children): New functions.
+
+	* src/clfswm-info.lisp (info-mode-menu): Handle symbols and
+	functions.
+
 	* src/clfswm-util.lisp (hide/show-frame-window): new function and
 	menu item.
 

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Wed May 28 17:55:15 2008
@@ -9,8 +9,6 @@
 
 - Use conpressed motion events for clisp. [Philippe]
 
-- cd/pwd a la shell to navigate throw frames. [Philippe] 
-
 - Hide/Unhide child [Philippe]
 
 - Raise/lower child - this can be done with children order [Philippe]
@@ -28,6 +26,8 @@
 MAYBE
 =====
 
+- cd/pwd a la shell to navigate throw frames. [Philippe] 
+
 - From stumpwm: [Philippe]
  "In other news stumpwm should catch unhandled errors, restart, and
  print an error message. And there is now a soft-restart command. With
@@ -51,3 +51,4 @@
 - Remote access to the clfswm REPL [Philippe]
 
 - Undo/redo (any idea to implement this is welcome)
+

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Wed May 28 17:55:15 2008
@@ -290,8 +290,10 @@
     (dolist (item item-list)
       (let ((key (first item)))
 	(undefine-info-key-fun (list key 0))))
-    (when (fboundp action)
-      (funcall action))))
+    (typecase action
+      (function (funcall action))
+      (symbol (when (fboundp action)
+		(funcall action))))))
 
 
 

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Wed May 28 17:55:15 2008
@@ -354,7 +354,7 @@
 
 (defun display-frame-info (frame)
   (let ((dy (+ (xlib:max-char-ascent *default-font*) (xlib:max-char-descent *default-font*))))
-    (with-slots (name number gc window child) frame
+    (with-slots (name number gc window child hidden-children) frame
       (clear-pixmap-buffer window gc)
       (setf (xlib:gcontext-foreground gc) (get-color (if (and (equal frame *current-root*)
 							      (equal frame *current-child*))
@@ -377,8 +377,11 @@
 				    (frame (format str "frame:~A[~A] " (frame-number child)
 						   (aif (frame-name child) it "")))))))))
 	(dolist (ch child)
-	  (when (xlib:window-p ch)
-	    (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch))))))
+	  (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy) (ensure-printable (child-fullname ch))))
+	(setf (xlib:gcontext-foreground gc) (get-color "DarkGreen"))
+	(dolist (ch hidden-children)
+	  (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy)
+			    (format nil "~A - hidden" (ensure-printable (child-fullname ch))))))
       (copy-pixmap-buffer window gc))))
 
 

Modified: clfswm/src/clfswm-menu.lisp
==============================================================================
--- clfswm/src/clfswm-menu.lisp	(original)
+++ clfswm/src/clfswm-menu.lisp	Wed May 28 17:55:15 2008
@@ -119,4 +119,3 @@
       (t (when (fboundp action)
 	   (funcall action))))))
 
-      
\ No newline at end of file

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Wed May 28 17:55:15 2008
@@ -961,3 +961,48 @@
   "Show the current frame window"
   (hide/show-frame-window *current-child* t))
 
+
+
+;;; Hide/Unhide current child
+(defun hide-current-child ()
+  "Hide the current child"
+  (let ((parent (find-parent-frame *current-child*)))
+    (when (frame-p parent)
+      (with-slots (child hidden-children) parent
+	(hide-all *current-child*)
+	(setf child (remove *current-child* child))
+	(pushnew *current-child* hidden-children)
+	(setf *current-child* parent))
+      (show-all-children)))
+  (leave-second-mode))
+
+
+(defun unhide-a-child ()
+  "Unhide a child in the current frame"
+  (when (frame-p *current-child*)
+    (with-slots (child hidden-children) *current-child*
+      (info-mode-menu (loop :for i :from 0
+			 :for h :in hidden-children
+			 :collect (list (code-char (+ (char-code #\a) i))
+					(let ((hd h))
+					  (lambda ()
+					    (setf hidden-children (remove hd hidden-children))
+					    (pushnew hd child)))
+					(format nil "Unhide ~A" (child-fullname h))))))
+    (show-all-children))
+  (leave-second-mode))
+
+
+(defun unhide-all-children ()
+  "Unhide all current frame hidden children"
+  (when (frame-p *current-child*)
+    (with-slots (child hidden-children) *current-child*
+      (dolist (c hidden-children)
+	(pushnew c child))
+      (setf hidden-children nil))
+    (show-all-children))
+  (leave-second-mode))
+
+
+
+    

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Wed May 28 17:55:15 2008
@@ -75,6 +75,9 @@
 (add-menu-key 'child-menu "r" 'rename-current-child)
 (add-menu-key 'child-menu "x" 'remove-current-child-from-tree)
 (add-menu-key 'child-menu "Delete" 'remove-current-child)
+(add-menu-key 'child-menu "h" 'hide-current-child)
+(add-menu-key 'child-menu "u" 'unhide-a-child)
+(add-menu-key 'child-menu "a" 'unhide-all-children)
 
 
 (add-sub-menu 'frame-menu "a" 'frame-adding-menu "Adding frame menu")

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Wed May 28 17:55:15 2008
@@ -100,8 +100,8 @@
 			  :initform nil
 			  :documentation "A list of forced unmanaged windows (wm-name or window)")
    (show-window-p :initarg :show-window-p :accessor frame-show-window-p :initform t)
-   (hidden-list :initarg :hidden-list :accessor frame-hidden-list :initform nil
-		:documentation "A list of hidden children")
+   (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")
    (window :initarg :window :accessor frame-window :initform nil)


From pbrochard at common-lisp.net  Wed May 28 21:56:06 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Wed, 28 May 2008 17:56:06 -0400 (EDT)
Subject: [clfswm-cvs] r138 - clfswm
Message-ID: <20080528215606.5D5EAA2C7@common-lisp.net>

Author: pbrochard
Date: Wed May 28 17:56:05 2008
New Revision: 138

Modified:
   clfswm/TODO
Log:
(TODO update) hide-current-child, unhide-a-child, unhide-all-children: New functions.

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Wed May 28 17:56:05 2008
@@ -9,8 +9,6 @@
 
 - Use conpressed motion events for clisp. [Philippe]
 
-- Hide/Unhide child [Philippe]
-
 - Raise/lower child - this can be done with children order [Philippe]
 
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]


From pbrochard at common-lisp.net  Fri May 30 20:41:41 2008
From: pbrochard at common-lisp.net (pbrochard at common-lisp.net)
Date: Fri, 30 May 2008 16:41:41 -0400 (EDT)
Subject: [clfswm-cvs] r139 - in clfswm: . src
Message-ID: <20080530204141.5E38D590AC@common-lisp.net>

Author: pbrochard
Date: Fri May 30 16:41:37 2008
New Revision: 139

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/menu-def.lisp
Log:
unhide-a-child-from-all-frames: Unhide a child from a choice in all frames with hidden children. info-mode-menu: Handle separators.

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Fri May 30 16:41:37 2008
@@ -1,3 +1,10 @@
+2008-05-30  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (unhide-a-child-from-all-frames): Unhide a
+	child from a choice in all frames with hidden children.
+
+	* src/clfswm-info.lisp (info-mode-menu): Handle separators.
+
 2008-05-28  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-util.lisp (hide-current-child, unhide-a-child)

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Fri May 30 16:41:37 2008
@@ -271,25 +271,29 @@
 
 (defun info-mode-menu (item-list &key (x 0) (y 0) (width nil) (height nil))
   "Open an info help menu.
-Item-list is: '((key function) (key function))
+Item-list is: '((key function) separator (key function))
 or with explicit docstring: '((key function \"documentation 1\") (key function \"bla bla\") (key function)) 
-key is a character, a keycode or a keysym"
+key is a character, a keycode or a keysym
+Separator is a string or a symbol (all but a list)"
   (let ((info-list nil)
 	(action nil))
     (dolist (item item-list)
-      (destructuring-bind (key function explicit-doc) (ensure-n-elems item 3)
-	(push (format nil "~@(~A~): ~A" key (or explicit-doc
-						(documentation function 'function)))
-	      info-list)
-	(define-info-key-fun (list key 0)
-	    (lambda (&optional args)
-	      (declare (ignore args))
-	      (setf action function)
-	      (throw 'exit-info-loop nil)))))
+      (typecase item
+	(cons (destructuring-bind (key function explicit-doc) (ensure-n-elems item 3)
+		(push (format nil "~@(~A~): ~A" key (or explicit-doc
+							(documentation function 'function)))
+		      info-list)
+		(define-info-key-fun (list key 0)
+		    (lambda (&optional args)
+		      (declare (ignore args))
+		      (setf action function)
+		      (throw 'exit-info-loop nil)))))
+	(t (push (format nil "-=- ~A -=-" item) info-list))))
     (info-mode (nreverse info-list) :x x :y y :width width :height height)
     (dolist (item item-list)
-      (let ((key (first item)))
-	(undefine-info-key-fun (list key 0))))
+      (when (consp item)
+	(let ((key (first item)))
+	  (undefine-info-key-fun (list key 0)))))
     (typecase action
       (function (funcall action))
       (symbol (when (fboundp action)

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Fri May 30 16:41:37 2008
@@ -977,18 +977,26 @@
   (leave-second-mode))
 
 
+(defun frame-unhide-child (hidden frame-src frame-dest)
+  "Unhide a hidden child from frame-src in frame-dest"
+  (with-slots (hidden-children) frame-src
+    (setf hidden-children (remove hidden hidden-children)))
+  (with-slots (child) frame-dest
+    (pushnew hidden child)))
+  
+
+
 (defun unhide-a-child ()
   "Unhide a child in the current frame"
   (when (frame-p *current-child*)
     (with-slots (child hidden-children) *current-child*
       (info-mode-menu (loop :for i :from 0
-			 :for h :in hidden-children
+			 :for hidden :in hidden-children
 			 :collect (list (code-char (+ (char-code #\a) i))
-					(let ((hd h))
+					(let ((lhd hidden))
 					  (lambda ()
-					    (setf hidden-children (remove hd hidden-children))
-					    (pushnew hd child)))
-					(format nil "Unhide ~A" (child-fullname h))))))
+					    (frame-unhide-child lhd *current-child* *current-child*)))
+					(format nil "Unhide ~A" (child-fullname hidden))))))
     (show-all-children))
   (leave-second-mode))
 
@@ -1004,5 +1012,26 @@
   (leave-second-mode))
 
 
+(defun unhide-a-child-from-all-frames ()
+  "Unhide a child from all frames in the current frame"
+  (when (frame-p *current-child*)
+    (let ((acc nil)
+	  (keynum -1))
+      (with-all-frames (*root-frame* frame)
+	(when (frame-hidden-children frame)
+	  (push (format nil "~A" (child-fullname frame)) acc)
+	  (dolist (hidden (frame-hidden-children frame))
+	    (push (list (code-char (+ (char-code #\a) (incf keynum)))
+			(let ((lhd hidden))
+			  (lambda ()
+			    (frame-unhide-child lhd frame *current-child*)))
+			(format nil "Unhide ~A" (child-fullname hidden)))
+		  acc))))
+      (info-mode-menu (nreverse acc)))
+    (show-all-children))
+  (leave-second-mode))
+
+
+
 
     

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Fri May 30 16:41:37 2008
@@ -77,6 +77,7 @@
 (add-menu-key 'child-menu "Delete" 'remove-current-child)
 (add-menu-key 'child-menu "h" 'hide-current-child)
 (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)