From pbrochard at common-lisp.net  Sun Feb 24 20:53:40 2008
From: pbrochard at common-lisp.net (pbrochard)
Date: Sun, 24 Feb 2008 15:53:40 -0500 (EST)
Subject: [clfswm-cvs] CVS clfswm
Message-ID: <20080224205340.742AE2F047@common-lisp.net>

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

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 
	keysyms.lisp load.lisp netwm-util.lisp package.lisp tools.lisp 
	xlib-util.lisp 
Added Files:
	clfswm-layout.lisp 
Removed Files:
	clfswm-pager.lisp 
Log Message:
Major update - No more reference to workspaces

--- /project/clfswm/cvsroot/clfswm/ChangeLog	2008/01/03 22:15:48	1.14
+++ /project/clfswm/cvsroot/clfswm/ChangeLog	2008/02/24 20:53:37	1.15
@@ -1,3 +1,21 @@
+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/01/04 22:57:22	1.8
+++ /project/clfswm/cvsroot/clfswm/bindings-pager.lisp	2008/02/24 20:53:37	1.9
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Fri Jan  4 23:56:09 2008
+;;; #Date#: Tue Feb 12 14:02:07 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/01/03 22:15:48	1.11
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/24 20:53:37	1.12
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Jan  3 23:13:40 2008
+;;; #Date#: Sun Feb 24 21:34:42 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse for second mode
@@ -34,553 +34,660 @@
 ;;;|
 ;;;| 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)
-
-(define-second-key (#\g :control) 'stop-all-pending-actions)
-
-(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))))
-
-(define-second-key (#\!) 'run-program-from-query-string)
-
-
-(define-second-key (#\t) 'leave-second-mode-maximize)
-(define-second-key ("Return") 'leave-second-mode-maximize)
-(define-second-key ("Escape") 'leave-second-mode)
-
-
-(define-second-key (#\< :control) 'leave-second-mode)
-(define-second-key ("Return" :control) 'leave-second-mode)
-
-;; 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)
-
-
-;; 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)
-
-
-(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)
+;;;;;;;;;;;;;;;
+;; Menu entry
+;;;;;;;;;;;;;;;
+(defun group-adding-menu ()
+  "Open the adding group menu"
+  (info-mode-menu '((#\a add-default-group)
+		    (#\p add-placed-group))))
+
+(defun group-layout-menu ()
+  "Open the 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))))
+
+
+  
+
+
+(defun group-pack-menu ()
+  "Open the group pack menu"
+  (info-mode-menu '(("Up" group-pack-up)
+		    ("Down" group-pack-down))))
+
+
+(defun group-movement-menu ()
+  "Open the movement menu"
+  (info-mode-menu '((#\p group-pack-menu)
+		    (#\f group-fill-menu)
+		    (#\r group-resize-menu))))
+
+
+(defun group-pack-up ()
+  "Pack group up"
+  (print 'pack-up)
+  (group-movement-menu))
+
+(defun group-pack-down ()
+  "Pack group down"
+  (print 'pack-down)
+  (group-movement-menu))
 
-(define-second-key (#\1 :control :mod-1) 'renumber-workspaces)
-(define-second-key (#\2 :control :mod-1) 'sort-workspaces)
 
 
+(defun group-menu ()
+  "Open the group menu"
+  (info-mode-menu '((#\a group-adding-menu)
+		    (#\l group-layout-menu)
+		    (#\m group-movement-menu))))
+
+
+(defun utility-menu ()
+  "Open the 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)
+		    (#\u 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 (#\k :mod-1) 'destroy-current-window)
-(define-second-key (#\k) 'remove-current-window)
-
-
-(define-second-key (#\g) 'create-new-default-group)
-(define-second-key (#\g :mod-1) 'remove-current-group)
-
-(define-second-key (#\w) 'create-new-default-workspace)
-(define-second-key (#\w :mod-1) 'remove-current-workspace)
-
-(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 ("F1" :mod-1) 'help-on-second-mode)
 
+(define-second-key ("m") 'main-menu)
+(define-second-key ("g") 'group-menu)
 
-(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 (#\g :control) 'stop-all-pending-actions)
 
-(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)))
+(define-second-key (#\i) 'identify-key)
+(define-second-key (#\:) 'eval-from-query-string)
 
+(define-second-key (#\!) 'run-program-from-query-string)
 
-;;;,-----
-;;;| 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))
-      (focus-window (current-window))
-      (show-all-group (current-workspace)))))
-
-(defun mouse-leave-second-mode-maximize (root-x root-y)
-  "Leave second mode and maximize current group"
-  (select-group-under-mouse root-x root-y)
-  (maximize-group (current-group))
-  (show-all-windows-in-workspace (current-workspace))
-  (throw 'exit-second-loop nil))
-
-(defun mouse-leave-second-mode (root-x root-y)
-  "Leave second mode"
-  (select-group-under-mouse root-x root-y)
-  (show-all-windows-in-workspace (current-workspace))

[793 lines skipped]
--- /project/clfswm/cvsroot/clfswm/bindings.lisp	2008/01/03 20:31:24	1.6
+++ /project/clfswm/cvsroot/clfswm/bindings.lisp	2008/02/24 20:53:37	1.7
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Jan  3 19:23:24 2008
+;;; #Date#: Sun Feb 24 21:34:48 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse
@@ -33,72 +33,141 @@
 ;;;| CONFIG - Bindings main mode
 ;;;`-----
 
+
 (define-main-key ("F1" :mod-1) 'help-on-clfswm)
 
 (defun quit-clfswm ()
   "Quit clfswm"
-  (throw 'quit-main-loop nil))
-
-
+  (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)
+(define-main-key ("Right" :mod-1) 'select-next-brother)
+(define-main-key ("Left" :mod-1) 'select-previous-brother)
 
+(define-main-key ("Down" :mod-1) 'select-next-level)
+(define-main-key ("Up" :mod-1) 'select-previous-level)
 
-;; 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 ("Tab" :mod-1) 'select-next-child)
+(define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
 
+(define-main-key ("Return" :mod-1) 'enter-group)
+(define-main-key ("Return" :mod-1 :shift) 'leave-group)
 
-;; 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)
+(define-main-key ("Home" :mod-1) 'switch-to-root-group)
+(define-main-key ("Home" :mod-1 :shift) 'switch-and-select-root-group)
 
+(define-main-key ("Menu") 'toggle-show-root-group)
 
-;; 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)
+(define-main-key (#\b :mod-1) 'banish-pointer)
 
 
-;; 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)
+;;;; 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)
 
 
+(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-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-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)
 
--- /project/clfswm/cvsroot/clfswm/clfswm-info.lisp	2007/12/21 22:01:14	1.4
+++ /project/clfswm/cvsroot/clfswm/clfswm-info.lisp	2008/02/24 20:53:37	1.5
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Fri Dec 21 23:00:04 2007
+;;; #Date#: Tue Feb 19 21:43:15 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; 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 nil))
+  (throw 'exit-info-loop 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 nil))
+  (throw 'exit-info-loop nil))
 
 
 
 (defun draw-info-window (info)
-  (clear-area (info-window info))
-  (setf (gcontext-foreground (info-gc info)) (get-color *info-foreground*))
+  (xlib:clear-area (info-window info))
+  (setf (xlib:gcontext-foreground (info-gc info)) (get-color *info-foreground*))
   (loop for line in (info-list info)
-	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))))
+     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 (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)
+    (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 (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)))
+       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)))
 
 
 ;;;,-----
@@ -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)) (drawable-height (info-window info))))
+	    (info-y info) (- (* (length (info-list info)) (info-ilh info)) (xlib: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 (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))
+	   (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))
 	   (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 (event-case (*display* :discard-p nil :peek-p t :timeout 0)
+		 (unless (xlib: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,18 +243,12 @@
 	       (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))
-	       (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)))
+	       (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-events (&rest event-slots &key display event-key &allow-other-keys)
 		 (declare (ignore display))
 		 (case event-key
@@ -263,33 +257,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 #'handle-unmap-notify event-slots) t)
-		   (:destroy-notify (apply #'handle-destroy-notify event-slots) t)
+		   (:unmap-notify (apply #'info-handle-unmap-notify event-slots) t)
+		   (:destroy-notify (apply #'info-handle-destroy-notify event-slots) t)
 		   (:mapping-notify nil)
 		   (:property-notify nil)
 		   (:create-notify nil)
 		   (:enter-notify nil)
 		   (:exposure (draw-info-window info)))
 		 t))
-	(map-window window)
+	(xlib:map-window window)
 	(draw-info-window info)
 	(xgrab-pointer *root* 68 69)
 	(unless keyboard-grabbed
 	  (xgrab-keyboard *root*))
 	(unwind-protect
-	     (catch 'exit-info
+	     (catch 'exit-info-loop
 	       (loop
-		(display-finish-output *display*)
-		(process-event *display* :handler #'handle-events)))
+		  (xlib:display-finish-output *display*)
+		  (xlib:process-event *display* :handler #'handle-events)))
 	  (if pointer-grabbed
 	      (xgrab-pointer *root* 66 67)
 	      (xungrab-pointer))
 	  (unless keyboard-grabbed
 	    (xungrab-keyboard))
-	  (free-gcontext gc)
-	  (destroy-window window)
-	  (close-font font)
-	  (show-all-group (current-workspace))
+	  (xlib:free-gcontext gc)
+	  (xlib:destroy-window window)
+	  (xlib:close-font font)
+	  (show-all-childs)
 	  (wait-no-key-or-button-press))))))
 
 
@@ -311,12 +305,12 @@
 	    (lambda (&optional args)
 	      (declare (ignore args))
 	      (setf action function)
-	      (throw 'exit-info nil)))))
+	      (throw 'exit-info-loop 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 action
+    (when (fboundp action)
       (funcall action))))
 
 
@@ -330,9 +324,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)
@@ -346,7 +340,6 @@
 (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 ()
@@ -358,12 +351,6 @@
   (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")))
@@ -380,18 +367,15 @@
   (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 ()
@@ -456,11 +440,5 @@
 
 
 
-(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/01/03 22:15:48	1.13
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/24 20:53:37	1.14
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Jan  3 23:09:04 2008
+;;; #Date#: Sun Feb 24 21:38:37 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -29,7 +29,7 @@
 
 
 ;;; Minimal hook
-(defun call-hook (hook args)
+(defun call-hook (hook &optional args)
   "Call a hook (a function, a symbol or a list of function)"
   (typecase hook
     (list (dolist (h hook)
@@ -37,265 +37,479 @@
     (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))
+
+(defsetf group-data-slot set-group-data-slot)
+
+
+
+(defgeneric group-p (group))
+(defmethod group-p ((group group))
+  (declare (ignore group))
+  t)
+(defmethod group-p (group)
+  (declare (ignore group))
+  nil)
+
+(defun create-group (&key name (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 :x x :y y :w w :h h :window window :gc gc :layout layout)))
+
+
+(defun add-group (group father)
+  (push group (group-child father)))
+
+
+
+;; (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))))
+
+
+;; (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))))
+
+
+;; (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))))
+
+
+
+;; (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))))
 
-;;; 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))))
 
 
+
+
+(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 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 adapt-all-window-in-group (group)
-  (when group
-    (dolist (window (group-window-list group))
-      (adapt-window-to-group window group))))
+(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 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))
+(defun get-all-windows (&optional (root *root-group*))
+  "Return all windows in root and in its childs"
+  (let ((acc nil))
+    (with-all-windows (root window)
+      (push window acc))
+    acc))
 
-(defun add-group-in-workspace (group workspace)
-  (when group
-    (pushnew group (workspace-group-list workspace))
-    group))
 
+(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 add-workspace (workspace)
-  (when workspace
-    (select-minimum-workspace)
-    (setf *workspace-list* (anti-rotate-list (append *workspace-list* (list workspace))))
-    (netwm-update-desktop-property)
-    workspace))
 
 
 
-(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)))
 
-(defun remove-window-in-all-workspace (window)
-  (dolist (workspace *workspace-list*)
-    (remove-window-in-workspace window workspace))
-  (netwm-remove-in-client-list window))
+(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-glyphs window gc 5 dy		 
+			  (format nil "Group: ~A~A" number
+				  (if name  (format nil " - ~A" name) "")))
+	(let ((pos dy))
+	  (when (equal group *current-root*)
+	    (xlib:draw-image-glyphs window 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)))
+					    (group (format str "group:~A[~A] " (group-number child)
+							   (aif (group-name child) it "")))))
+					(format str "                                                   ")))))
+	  (dolist (ch child)
+	    (when (xlib:window-p ch)
+	      (xlib:draw-glyphs window gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch))))))))))
 
 
-(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))
 
 
-(defun current-workspace ()
-  (if (consp *workspace-list*)
-      (first *workspace-list*)
-      (add-workspace (create-default-workspace))))
 
 
-(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 get-father-layout (child father)
+  (if (group-p father)
+      (aif (group-layout father)
+	   (funcall it child father)
+	   (no-layout child father))
+      (get-fullscreen-size)))
 
 
+(defgeneric adapt-child-to-father (child father))
 
+(defmethod adapt-child-to-father ((window xlib:window) father)
+  (with-xlib-protect
+    (multiple-value-bind (nx ny nw nh)
+	(get-father-layout window father)
+      (setf (xlib:drawable-x window) nx
+	    (xlib:drawable-y window) ny
+	    (xlib:drawable-width window) nw
+	    (xlib:drawable-height window) nh))))
 
+(defmethod adapt-child-to-father ((group group) father)
+  (with-xlib-protect
+    (multiple-value-bind (nx ny nw nh)
+	(get-father-layout group father)
+      (with-slots (rx ry rw rh window) group
+	(setf rx nx  ry ny  rw nw  rh nh)
+	(setf (xlib:drawable-x window) rx
+	      (xlib:drawable-y window) ry
+	      (xlib:drawable-width window) rw
+	      (xlib:drawable-height window) rh)))))
+   
+  
 
-(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))))
+(defgeneric show-child (child father))
+(defgeneric hide-child (child))
 
+(defmethod show-child ((group group) father)
+  (with-xlib-protect
+    (with-slots (window) group
+      (adapt-child-to-father group father)
+      (when (or *show-root-group-p* (not (equal group *current-root*)))
+	(setf (xlib:window-background window) (get-color "Black"))
+	(xlib:map-window window)
+	(raise-window window)
+	(display-group-info group)))))
 
 
-(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))))))
+(defmethod hide-child ((group group))
+  (with-xlib-protect
+    (with-slots (window) group
+      (xlib:unmap-window window))))
 
 
+(defmethod show-child ((window xlib:window) father)
+  (with-xlib-protect
+    (when (eql (window-type window) :normal)
+      (adapt-child-to-father window father))
+    (xlib:map-window window)
+    (raise-window window)))
 
-(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)

[460 lines skipped]
--- /project/clfswm/cvsroot/clfswm/clfswm-keys.lisp	2008/01/03 20:31:24	1.5
+++ /project/clfswm/cvsroot/clfswm/clfswm-keys.lisp	2008/02/24 20:53:37	1.6
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Jan  3 19:24:00 2008
+;;; #Date#: Tue Feb 12 19:23:14 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,27 +105,77 @@
 
 (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 (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)))
+     (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))))
 
-(define-ungrab/grab grab-main-keys grab-key *main-keys*)
-(define-ungrab/grab ungrab-main-keys ungrab-key *main-keys*)
 
 
 
@@ -145,8 +195,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	2007/12/29 15:20:10	1.4
+++ /project/clfswm/cvsroot/clfswm/clfswm-pack.lisp	2008/02/24 20:53:37	1.5
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Fri Dec 28 22:13:42 2007
+;;; #Date#: Tue Feb 12 14:02:45 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; 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 (/ (screen-width *screen*) n))
-	 (dy (/ (screen-height *screen*) (ceiling (/ len n)))))
+	 (dx (/ (xlib:screen-width *screen*) n))
+	 (dy (/ (xlib: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 (/ (screen-width *screen*) (ceiling (/ len n))))
-	 (dy (/ (screen-height *screen*) n)))
+	 (dx (/ (xlib:screen-width *screen*) (ceiling (/ len n))))
+	 (dy (/ (xlib: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) (screen-width *screen*)
-	      (group-height group) (screen-height *screen*))
-	(let ((dy (/ (screen-height *screen*) (1- len))))
+	      (group-width group) (xlib:screen-width *screen*)
+	      (group-height group) (xlib:screen-height *screen*))
+	(let ((dy (/ (xlib:screen-height *screen*) (1- len))))
 	  (setf (group-x group) 1
 		(group-y group) 1
-		(group-width group) (- (screen-width *screen*) *tile-border-size* 1)
-		(group-height group) (- (screen-height *screen*) 1))
+		(group-width group) (- (xlib:screen-width *screen*) *tile-border-size* 1)
+		(group-height group) (- (xlib:screen-height *screen*) 1))
 	  (loop :for i :from 0
-		: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))))))))
+	     :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))))))))
 
 (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) (screen-width *screen*)
-	      (group-height group) (screen-height *screen*))
-	(let ((dy (/ (screen-height *screen*) (1- len))))
+	      (group-width group) (xlib:screen-width *screen*)
+	      (group-height group) (xlib:screen-height *screen*))
+	(let ((dy (/ (xlib:screen-height *screen*) (1- len))))
 	  (setf (group-x group) *tile-border-size*
 		(group-y group) 1
-		(group-width group) (- (screen-width *screen*) *tile-border-size* 1)
-		(group-height group) (- (screen-height *screen*) 1))
+		(group-width group) (- (xlib:screen-width *screen*) *tile-border-size* 1)
+		(group-height group) (- (xlib: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) (screen-width *screen*)
-	      (group-height group) (screen-height *screen*))
-	(let ((dx (/ (screen-width *screen*) (1- len))))
+	      (group-width group) (xlib:screen-width *screen*)
+	      (group-height group) (xlib:screen-height *screen*))
+	(let ((dx (/ (xlib:screen-width *screen*) (1- len))))
 	  (setf (group-x group) 1
 		(group-y group) *tile-border-size*
-		(group-width group) (- (screen-width *screen*) 1)
-		(group-height group) (- (screen-height *screen*) *tile-border-size* 1))
+		(group-width group) (- (xlib:screen-width *screen*) 1)
+		(group-height group) (- (xlib: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) (screen-width *screen*)
-	      (group-height group) (screen-height *screen*))
-	(let ((dx (/ (screen-width *screen*) (1- len))))
+	      (group-width group) (xlib:screen-width *screen*)
+	      (group-height group) (xlib:screen-height *screen*))
+	(let ((dx (/ (xlib:screen-width *screen*) (1- len))))
 	  (setf (group-x group) 1
 		(group-y group) 1
-		(group-width group) (- (screen-width *screen*) 1)
-		(group-height group) (- (screen-height *screen*) *tile-border-size* 1))
+		(group-width group) (- (xlib:screen-width *screen*) 1)
+		(group-height group) (- (xlib: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) (- (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) (- (xlib: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 (screen-height *screen*)))
+  (let ((y-found (xlib: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 (screen-width *screen*)))
+  (let ((x-found (xlib: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 (/ (- (screen-width *screen*) (group-width group)) 2))
-	(group-y group) (truncate (/ (- (screen-height *screen*) (group-height group)) 2))))
+  (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))))
 
 (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/01/03 20:31:24	1.10
+++ /project/clfswm/cvsroot/clfswm/clfswm-second-mode.lisp	2008/02/24 20:53:37	1.11
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Jan  3 00:14:39 2008
+;;; #Date#: Fri Feb 22 21:38:53 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Second mode functions
@@ -34,24 +34,35 @@
 (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 ()
-  (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 ""))))
+  (xlib:clear-area *sm-window*)
+  (let* ((text (format nil "Second mode"))
 	 (len (length 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)))
+    (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)))
 
 
 
@@ -63,8 +74,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))
-  (focus-group-under-mouse root-x root-y)
+  (declare (ignore event-slots root-x root-y))
+  ;;  (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)
@@ -111,7 +122,7 @@
 
 
 ;;(defun sm-handle-property-notify (&rest event-slots &key window &allow-other-keys)
-;;  ;;(dbg (wm-name window))
+;;  ;;(dbg (xlib:wm-name window))
 ;;  (draw-second-mode-window))
 
 
@@ -135,24 +146,22 @@
 (defun sm-handle-event (&rest event-slots &key display event-key &allow-other-keys)
   (declare (ignore display))
   ;;(dbg event-key)
-  (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))))
+  (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))))
   ;;(dbg "Ignore handle event" c event-slots)))
   t)
 
@@ -161,23 +170,22 @@
 (defun second-key-mode ()
   "Switch to editing mode"
   ;;(dbg "Second key ignore" c)))))
-  (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*)
+  (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*)
   (draw-second-mode-window)
   (no-focus)
   (ungrab-main-keys)
@@ -187,18 +195,16 @@
        (catch 'exit-second-loop
 	 (loop
 	    (raise-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*)
+	    (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*)
     (xungrab-keyboard)
     (xungrab-pointer)
-    (grab-main-keys))
-  (adapt-window-to-group (current-window) (current-group))
-  (focus-window (current-window))
-  (show-all-group (current-workspace))
+    (grab-main-keys)
+    (show-all-childs))
   (wait-no-key-or-button-press)
   (when *second-mode-program*
     (do-shell *second-mode-program*)
@@ -206,229 +212,11 @@
 
 
 
+(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/01/03 20:31:24	1.10
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/24 20:53:37	1.11
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Jan  2 23:45:31 2008
+;;; #Date#: Fri Feb 22 22:44:09 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility
@@ -28,429 +28,549 @@
 (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*)
+    (push (create-group) (group-child *current-child*))
+    (show-all-childs)))
+
+(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*)))
+    (show-all-childs)))
 
 
 
-
-(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)
+(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
-			   (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))
+			   (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)
-      (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)))
-
-
-(defun create-new-default-workspace ()
-  "Create a new default workspace"
-  (hide-all-windows-in-workspace (current-workspace))
-  (add-workspace (create-default-workspace))
-  (show-all-windows-in-workspace (current-workspace)))
-
-
-
-
-;;;,-----
-;;;| Group moving
-;;;`-----
-(defun move-group (group dx dy)
-  "Move group"
-  (setf (group-x group) (+ (group-x group) dx)
-	(group-y group) (+ (group-y group) dy))
-  (dolist (window (group-window-list group))
-    (adapt-window-to-group window group))
-  (show-all-group (current-workspace)))
-

[727 lines skipped]
--- /project/clfswm/cvsroot/clfswm/clfswm.asd	2008/01/03 20:31:24	1.6
+++ /project/clfswm/cvsroot/clfswm/clfswm.asd	2008/02/24 20:53:37	1.7
@@ -2,7 +2,7 @@
 ;;;; Author: Philippe Brochard <hocwp at free.fr>
 ;;;; ASDF System Definition
 ;;;
-;;; #date#: Wed Jan  2 23:30:31 2008
+;;; #date#: Fri Feb 22 21:39:37 2008
 
 (in-package #:asdf)
 
@@ -13,43 +13,36 @@
     :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-second-mode"
-		  :depends-on ("package" "clfswm-internal"))
+			:depends-on ("xlib-util" "clfswm-keys" "netwm-util" "tools"))
 		 (:file "clfswm"
-		  :depends-on ("xlib-util" "netwm-util" "clfswm-keys" "config"
-					   "clfswm-internal" "clfswm-second-mode" "tools"))
-		 (:file "clfswm-util"
-		  :depends-on ("clfswm" "keysyms"))
-		 (:file "clfswm-pack"
-		  :depends-on ("clfswm" "clfswm-util"))
-		 (:file "clfswm-pager"
-		  :depends-on ("clfswm" "clfswm-util" "clfswm-pack"))
+			:depends-on ("xlib-util" "netwm-util" "clfswm-keys" "config"
+						 "clfswm-internal" "tools"))
+		 (:file "clfswm-second-mode"
+			:depends-on ("package" "clfswm-internal"))
 		 (:file "clfswm-info"
-		  :depends-on ("clfswm" "clfswm-pager"))
+			:depends-on ("package" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal"))
+		 (:file "clfswm-util"
+			:depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode"))
+		 (:file "clfswm-layout"
+			:depends-on ("package" "clfswm-util" "clfswm-info"))
 		 (:file "bindings"
-		  :depends-on ("clfswm" "clfswm-util" "clfswm-pack" "clfswm-info"))
+			:depends-on ("clfswm" "clfswm-internal"))
 		 (:file "bindings-second-mode"
-		  :depends-on ("clfswm" "clfswm-util" "clfswm-pack" "clfswm-info"))
-		 (:file "bindings-pager"
-		  :depends-on ("clfswm" "clfswm-util" "clfswm-pack" "clfswm-pager"
-					"clfswm-info" "bindings"))))
-
-
+			:depends-on ("clfswm" "clfswm-util"))))
 
 
 
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/01/05 14:25:29	1.12
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/02/24 20:53:37	1.13
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sat Jan  5 15:16:21 2008
+;;; #Date#: Sun Feb 24 21:36:00 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -38,46 +38,6 @@
 
 
 
-;;(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)
@@ -87,29 +47,26 @@
     	   (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 (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)))))
+	     (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))))))))
+
 
 
 
@@ -124,41 +81,39 @@
   (unless send-event-p
     (unhide-window window)
     (process-new-window window)
-    (map-window window)
+    (xlib:map-window window)
     (focus-window window)
-    (show-all-group (current-workspace))))
+    (show-all-childs)))
 
 
 (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 (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))))))
-
+	       (not (xlib:window-equal window event-window)))
+    (when (find-child window *root-group*)
+      (remove-child-in-all-groups window)
+      (show-all-childs))))
 
 
 (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
-	      (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))))))
+	      (xlib:window-equal window event-window))
+    (when (find-child window *root-group*)
+      (remove-child-in-all-groups window)
+      (show-all-childs))))
 
 
 
 (defun handle-enter-notify  (&rest event-slots &key root-x root-y &allow-other-keys)
-  (declare (ignore event-slots))
-  (unless (group-fullscreenp (current-group))
-    (focus-group-under-mouse root-x root-y)))
+  (declare (ignore event-slots root-x root-y)))
+
 
-(defun handle-exposure   (&rest event-slots)
+
+(defun handle-exposure   (&rest event-slots &key window &allow-other-keys)
   (declare (ignore event-slots))
-  (show-all-group (current-workspace) *root* *root-gc* nil))
+  (awhen (find-group-window window *current-root*)
+    (display-group-info it)))
 
 
 (defun handle-create-notify (&rest event-slots)
@@ -166,17 +121,43 @@
 
 
 
+;; 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-child 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)
-
+      *unmap-notify-hook* 'handle-unmap-notify
+      *create-notify-hook* #'handle-create-notify
+      *button-press-hook* 'handle-button-press)
 
 
 
@@ -184,117 +165,103 @@
 (defun handle-event (&rest event-slots &key display event-key &allow-other-keys)
   (declare (ignore display))
   ;;(dbg  event-key)
-  (handler-case
-      (case event-key
-	(:button-press (call-hook *button-press-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))
-	(:map-request (call-hook *map-request-hook* event-slots))
-	(:unmap-notify (call-hook *unmap-notify-hook* event-slots))
-	(:destroy-notify (call-hook *destroy-notify-hook* event-slots))
-	(:mapping-notify (call-hook *mapping-notify-hook* event-slots))
-	(: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)))
-    ((or drawable-error window-error) (c)
-      (declare (ignore c))))
-      ;;(dbg "Ignore handle event" c event-slots)))
+  (with-xlib-protect
+    (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))
+      (:map-request (call-hook *map-request-hook* event-slots))
+      (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
+      (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
+      (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
+      (: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))))
   t)
 
 
 
 (defun main-loop ()
   (loop
-   (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 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)))
-
-
-
-
+     (with-xlib-protect
+       (xlib:display-finish-output *display*)
+       (xlib:process-event *display* :handler #'handle-event))))
+;;(dbg "Main loop finish" 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 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 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)))
+(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*))
   (xgrab-init-pointer)
   (xgrab-init-keyboard)
-  (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)
+  ;;(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*)
   (dbg *display*)
-  (setf (getenv "DISPLAY") display-str)
-  (setf (window-event-mask *root*)
-	'(:substructure-redirect
-	  :substructure-notify
-	  :property-change
-	  :exposure))
+  (setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect
+							      :substructure-notify
+							      :property-change
+							      :exposure
+							      :button-press))
+  ;;(intern-atoms *display*)
   (netwm-set-properties)
-  (display-force-output *display*)
+  (xlib:display-force-output *display*)
+  (setf *child-selection* nil
+	*current-group-number* -1)
+  (setf *root-group* (create-group :name "Root" :layout #'tile-space-layout)
+	*current-root* *root-group*
+	*current-child* *current-root*)
+  (call-hook *init-hook*)
+;;  (add-group (create-group :name "Gimp" :x 0.6 :y 0 :w 0.3 :h 0.2) *root-group*)
+;;  (add-group (create-group :name "Net" :x 0.52 :y 0.3 :w 0.4 :h 0.3) *root-group*)
+;;  (add-group (create-group :x 0 :y 0.4 :w 0.4 :h 0.2) (first (group-child *root-group*)))
+;;  (add-group (create-group :x 0.4 :y 0 :w 0.2 :h 0.3) (first (group-child *root-group*)))
+;;  (add-group (create-group :x 0.6 :y 0.4 :w 0.4 :h 0.2) (first (group-child *root-group*)))
+;;  (add-group (create-group :x 0.4 :y 0.7 :w 0.2 :h 0.3) (first (group-child *root-group*)))
+;;  (add-group (create-group :x 0.1 :y 0.55 :w 0.8 :h 0.43) *root-group*)
+;;  (add-group (create-group :x 0.2 :y 0.1 :w 0.6 :h 0.4) (first (group-child *root-group*)))
+;;  (add-group (create-group :x 0.3 :y 0.55 :w 0.4 :h 0.3) (first (group-child *root-group*)))
+;;  (add-group (create-group :x 0.1 :y 0.1 :w 0.3 :h 0.6) (first (group-child (first (group-child *root-group*)))))
+;;  (setf *current-child* (first (group-child *current-root*)))
+;;  (setf (group-layout *current-child*) #'tile-layout)
   (process-existing-windows *screen*)
-  (focus-window (current-window))
-  (show-all-group (current-workspace))
+  (show-all-childs)
   (grab-main-keys)
-  (display-finish-output *display*))
+  (xlib:display-finish-output *display*))
+
+
+
+(defun xdg-config-home ()
+  (pathname-directory (concatenate 'string (or (getenv "XDG_CONFIG_HOME")
+					       (getenv "HOME"))
+				   "/")))
 
 
 (defun read-conf-file ()
   (let* ((user-conf (probe-file (merge-pathnames (user-homedir-pathname) #p".clfswmrc")))

[51 lines skipped]
--- /project/clfswm/cvsroot/clfswm/config.lisp	2008/01/03 20:31:24	1.7
+++ /project/clfswm/cvsroot/clfswm/config.lisp	2008/02/24 20:53:37	1.8
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Jan  2 23:40:41 2008
+;;; #Date#: Fri Feb 22 15:14:03 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Configuration file
@@ -41,16 +41,21 @@
 
 
 ;;; CONFIG - Screen size
-;;(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))
+(defun get-fullscreen-size ()
+  "Return the size of root child - you can tweak this to what you want"
+  (values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*)))
+;; (values -1 -1 1024 768))
+;;  (values 100 100 800 600))
+
+
+
+
 
 
 ;;; CONFIG: Main mode colors
 (defparameter *color-selected* "Red")
-(defparameter *color-unselected* "Yellow")
+(defparameter *color-unselected* "Blue")
+(defparameter *color-maybe-selected* "Yellow")
 
 ;;; CONFIG: Second mode colors and fonts
 (defparameter *sm-border-color* "Green")
@@ -89,7 +94,7 @@
 
 
 ;;; CONFIG - Identify key colors
-(defparameter *identify-font-string* "9x15bold")
+(defparameter *identify-font-string* "9x15")
 (defparameter *identify-background* "black")
 (defparameter *identify-foreground* "green")
 (defparameter *identify-border* "red")
@@ -107,7 +112,7 @@
 (defparameter *info-foreground* "green")
 (defparameter *info-border* "red")
 (defparameter *info-line-cursor* "white")
-(defparameter *info-font-string* "9x15bold")
+(defparameter *info-font-string* "9x15")
 
 
 
--- /project/clfswm/cvsroot/clfswm/keysyms.lisp	2007/05/15 19:49:51	1.1
+++ /project/clfswm/cvsroot/clfswm/keysyms.lisp	2008/02/24 20:53:37	1.2
@@ -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/01/03 20:31:24	1.4
+++ /project/clfswm/cvsroot/clfswm/load.lisp	2008/02/24 20:53:37	1.5
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Fri Dec 21 23:00:32 2007
+;;; #Date#: Wed Feb  6 23:39:49 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: System loading functions
@@ -38,6 +38,9 @@
 (require :asdf)
 
 #+SBCL
+(require :sb-posix)
+
+#+SBCL
 (require :clx)
 
 #-ASDF
@@ -53,4 +56,4 @@
 
 (in-package :clfswm)
 
-(clfswm:main)
+(clfswm:main ":1")
--- /project/clfswm/cvsroot/clfswm/netwm-util.lisp	2007/12/21 22:01:14	1.3
+++ /project/clfswm/cvsroot/clfswm/netwm-util.lisp	2008/02/24 20:53:37	1.4
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Fri Dec 21 23:00:38 2007
+;;; #Date#: Wed Feb 20 23:26:21 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: NetWM functions
@@ -31,36 +31,36 @@
 
 ;;; Client List functions 
 (defun netwm-set-client-list (id-list)
-  (change-property *root* :_NET_CLIENT_LIST id-list :window 32))
+  (xlib:change-property *root* :_NET_CLIENT_LIST id-list :window 32))
 
 (defun netwm-get-client-list ()
-  (get-property *root* :_NET_CLIENT_LIST))
+  (xlib:get-property *root* :_NET_CLIENT_LIST))
 
 (defun netwm-add-in-client-list (window)
   (let ((last-list (netwm-get-client-list)))
-    (pushnew (window-id window) last-list)
+    (pushnew (xlib:window-id window) last-list)
     (netwm-set-client-list last-list)))
 
 (defun netwm-remove-in-client-list (window)
-  (netwm-set-client-list (remove (window-id window) (netwm-get-client-list))))
+  (netwm-set-client-list (remove (xlib:window-id window) (netwm-get-client-list))))
 
 
-
-;;; Desktop functions
+ 
+;;; Desktop functions ;; +PHIL
 (defun netwm-update-desktop-property ()
-  (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))
+  ;;  (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))
   )
 
 
@@ -71,20 +71,25 @@
   "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
-  (change-property *root* :_NET_SUPPORTED
-		   (mapcar (lambda (a)
-			     (xlib:intern-atom *display* a))
-			   (append +netwm-supported+
-				   (mapcar 'car +netwm-window-types+)))
-		   :atom 32)
+  (xlib: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
-  (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
+  (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))
+
+
+
+
+
--- /project/clfswm/cvsroot/clfswm/package.lisp	2008/01/01 19:13:45	1.9
+++ /project/clfswm/cvsroot/clfswm/package.lisp	2008/02/24 20:53:37	1.10
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Jan  1 20:11:50 2008
+;;; #Date#: Sun Feb 24 21:35:31 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Package definition
@@ -28,15 +28,12 @@
 (in-package :cl-user)
 
 (defpackage clfswm
-  (:use :common-lisp :xlib :my-html :tools)
+  (:use :common-lisp :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)
@@ -44,12 +41,56 @@
 (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 *current-group-number* -1)
+
+(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 (incf *current-group-number*))
+   ;;; Float size - 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 *default-group* nil)
+(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 *workspace-list* nil)
-(defparameter *current-workspace-number* 0)
 
 (defparameter *main-keys* (make-hash-table :test 'equal))
 (defparameter *second-keys* (make-hash-table :test 'equal))
@@ -87,8 +128,12 @@
 ;;;
 ;;; 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)
@@ -157,5 +202,5 @@
 ;;	(error (c)
 ;;	  (format t "New defun: Error in ~A : ~A~%" ',name c)
 ;;	  (format t "Root tree=~A~%All windows=~A~%"
-;;		  (query-tree *root*) (get-all-windows))
+;;		  (xlib:query-tree *root*) (get-all-windows))
 ;;	  (force-output))))))
--- /project/clfswm/cvsroot/clfswm/tools.lisp	2008/01/03 22:15:48	1.5
+++ /project/clfswm/cvsroot/clfswm/tools.lisp	2008/02/24 20:53:37	1.6
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Jan  3 22:53:59 2008
+;;; #Date#: Tue Feb 12 14:03:59 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: General tools
@@ -30,7 +30,10 @@
 
 (defpackage tools
   (:use common-lisp)
-  (:export :dbg
+  (:export :it
+	   :awhen
+	   :aif
+	   :dbg
 	   :dbgnl
 	   :setf/=
 	   :create-symbol
@@ -81,6 +84,13 @@
 
 
 
+(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)))
 
 
 ;;;,-----
@@ -92,36 +102,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))
 
 
 
@@ -147,10 +157,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)
@@ -202,13 +212,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
@@ -230,21 +240,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 
@@ -260,8 +270,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
@@ -299,7 +309,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))
@@ -392,14 +402,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))))))))))
 
 
 
@@ -425,10 +435,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))))
 
@@ -442,10 +452,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))
@@ -466,10 +476,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)))))
@@ -596,7 +606,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.
@@ -613,7 +623,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))
@@ -624,16 +634,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)))
@@ -641,7 +651,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"
@@ -664,20 +674,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)))
@@ -699,7 +709,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)))
 
@@ -731,7 +741,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/01/03 20:31:24	1.5
+++ /project/clfswm/cvsroot/clfswm/xlib-util.lisp	2008/02/24 20:53:37	1.6
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Jan  3 17:50:59 2008
+;;; #Date#: Sun Feb 24 11:24:46 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility functions
@@ -38,7 +38,10 @@
 				:property-change
 				:colormap-change
 				:focus-change
-				:enter-window)
+				:enter-window
+				:exposure)
+  ;;:button-press
+  ;;:button-release)
   "The events to listen for on managed windows.")
 
 
@@ -67,20 +70,53 @@
 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))
+(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*))))
+
+
+
+
 
 (defun window-state (win)
   "Get the state (iconic, normal, withdraw of a window."
-  (first (get-property win :WM_STATE)))
+  (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))
 
 (defsetf window-state set-window-state)
 
+
+
 (defun window-hidden-p (window)
   (eql (window-state window) +iconic-state+))
 
@@ -88,35 +124,142 @@
 
 (defun unhide-window (window)
   (when window
-    (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)))))
+    (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*))))
 
 
 (defun hide-window (window)
   (when window
-    (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)))))
+    (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*))))
+
 
 
 (defun window-type (window)
   "Return one of :maxsize, :transient, or :normal."
-  (or (and (get-property window :WM_TRANSIENT_FOR)
+  (or (and (xlib: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))))
+      (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))))
 	   :maxsize)
       :normal))
 
@@ -127,27 +270,27 @@
 (defun send-configuration-notify (window)
   "Send a synthetic configure notify event to the given window (ICCCM 4.1.5)"
   (multiple-value-bind (x y)
-      (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)))
+      (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)))
 
 
 (defun send-client-message (window type &rest data)
   "Send a client message to a client's window."
-  (send-event window
-	      :client-message nil
-	      :window window
-	      :type type
-	      :format 32
-	      :data data))
+  (xlib:send-event window
+		   :client-message nil
+		   :window window
+		   :type type
+		   :format 32
+		   :data data))
 
 
 
@@ -156,26 +299,19 @@
 (defun raise-window (window)
   "Map the window if needed and bring it to the top of the stack. Does not affect focus."
   (when window
-    (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)))))
-
+    (with-xlib-protect
+      (when (window-hidden-p window)
+	(unhide-window window))
+      (setf (xlib:window-priority window) :top-if))))
 
 (defun focus-window (window)
   "Give the window focus."
   (when window
-    (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)))))
+    (with-xlib-protect
+      (raise-window window)
+      (xlib:set-input-focus *display* window :parent))))
+    ;;(xlib:set-input-focus *display* :pointer-root :pointer-root)) ;;PHIL
+
 
 
 
@@ -183,7 +319,7 @@
 
 (defun no-focus ()
   "don't focus any window but still read keyboard events."
-  (set-input-focus *display* *no-focus-window* :pointer-root))
+  (xlib:set-input-focus *display* *no-focus-window* :pointer-root))
   
 
 
@@ -193,10 +329,10 @@
       (pointer-grabbed nil))
   (labels ((free-grab-pointer ()
 	     (when cursor
-	       (free-cursor cursor)
+	       (xlib:free-cursor cursor)
 	       (setf cursor nil))
 	     (when cursor-font
-	       (close-font cursor-font)
+	       (xlib:close-font cursor-font)
 	       (setf cursor-font nil))))
     (defun xgrab-init-pointer ()
       (setf pointer-grabbed nil))
@@ -204,27 +340,28 @@
     (defun xgrab-pointer-p ()
       pointer-grabbed)
     
-    (defun xgrab-pointer (root cursor-char cursor-mask-char)
+    (defun xgrab-pointer (root cursor-char cursor-mask-char
+			  &optional (pointer-mask '(:enter-window :pointer-motion
+						    :button-press :button-release)) owner-p)
       "Grab the pointer and set the pointer shape."
       (free-grab-pointer)
       (setf pointer-grabbed t)
-      (let* ((white (make-color :red 1.0 :green 1.0 :blue 1.0))
-	     (black (make-color :red 0.0 :green 0.0 :blue 0.0)))
-	(setf cursor-font (open-font *display* "cursor")
-	      cursor (create-glyph-cursor :source-font cursor-font
-					  :source-char cursor-char
-					  :mask-font cursor-font
-					  :mask-char cursor-mask-char
-					  :foreground black
-					  :background white))
-	(grab-pointer root '(:enter-window :pointer-motion
-			     :button-press :button-release)
-		      :owner-p nil  :sync-keyboard-p nil :sync-pointer-p nil :cursor cursor)))
+      (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")
+	      cursor (xlib:create-glyph-cursor :source-font cursor-font
+					       :source-char cursor-char
+					       :mask-font cursor-font
+					       :mask-char cursor-mask-char
+					       :foreground black
+					       :background white))
+	(xlib:grab-pointer root pointer-mask
+			   :owner-p owner-p  :sync-keyboard-p nil :sync-pointer-p nil :cursor cursor)))
 
     (defun xungrab-pointer ()
       "Remove the grab on the cursor and restore the cursor shape."
       (setf pointer-grabbed nil)
-      (ungrab-pointer *display*)
+      (xlib:ungrab-pointer *display*)
       (free-grab-pointer))))
 
 
@@ -237,28 +374,49 @@
   
   (defun xgrab-keyboard (root)
     (setf keyboard-grabbed t)
-    (grab-keyboard root :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil))
+    (xlib:grab-keyboard root :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil))

[121 lines skipped]

--- /project/clfswm/cvsroot/clfswm/clfswm-layout.lisp	2008/02/24 20:53:40	NONE
+++ /project/clfswm/cvsroot/clfswm/clfswm-layout.lisp	2008/02/24 20:53:40	1.1

[398 lines skipped]


From pbrochard at common-lisp.net  Mon Feb 25 20:11:15 2008
From: pbrochard at common-lisp.net (pbrochard)
Date: Mon, 25 Feb 2008 15:11:15 -0500 (EST)
Subject: [clfswm-cvs] CVS clfswm
Message-ID: <20080225201115.C3D3F2D17E@common-lisp.net>

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

Modified Files:
	load.lisp 
Log Message:
load on display :0 and not :1

--- /project/clfswm/cvsroot/clfswm/load.lisp	2008/02/24 20:53:37	1.5
+++ /project/clfswm/cvsroot/clfswm/load.lisp	2008/02/25 20:11:08	1.6
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Feb  6 23:39:49 2008
+;;; #Date#: Mon Feb 25 21:08:57 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: System loading functions
@@ -56,4 +56,4 @@
 
 (in-package :clfswm)
 
-(clfswm:main ":1")
+(clfswm:main ":0")



From pbrochard at common-lisp.net  Tue Feb 26 22:02:04 2008
From: pbrochard at common-lisp.net (pbrochard)
Date: Tue, 26 Feb 2008 17:02:04 -0500 (EST)
Subject: [clfswm-cvs] CVS clfswm
Message-ID: <20080226220204.1C8EA1704D@common-lisp.net>

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

Modified Files:
	ChangeLog bindings-second-mode.lisp clfswm-internal.lisp 
	clfswm-util.lisp clfswm.lisp load.lisp package.lisp tools.lisp 
Log Message:
focus/copy/move/delete by name or number

--- /project/clfswm/cvsroot/clfswm/ChangeLog	2008/02/24 20:53:37	1.15
+++ /project/clfswm/cvsroot/clfswm/ChangeLog	2008/02/26 22:02:02	1.16
@@ -1,3 +1,11 @@
+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
--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/24 20:53:37	1.12
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/26 22:02:02	1.13
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sun Feb 24 21:34:42 2008
+;;; #Date#: Tue Feb 26 22:41:08 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse for second mode
@@ -80,15 +80,34 @@
 
 
 
+
+
+
+
+(defun action-by-name-menu ()
+  "Actions by name menu"
+  (info-mode-menu '((#\f focus-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)
+		    (#\d delete-group-by-number)
+		    (#\m move-current-child-by-number)
+		    (#\c copy-current-child-by-number))))
+
+
 (defun group-menu ()
-  "Open the group menu"
+  "Group menu"
   (info-mode-menu '((#\a group-adding-menu)
 		    (#\l group-layout-menu)
 		    (#\m group-movement-menu))))
 
 
 (defun utility-menu ()
-  "Open the utility menu"
+  "Utility menu"
   (info-mode-menu '((#\i identify-key)
 		    (#\: eval-from-query-string)
 		    (#\! run-program-from-query-string))))
@@ -98,7 +117,9 @@
   (info-mode-menu '((#\g group-menu)
 		    (#\w window-menu)
 		    (#\s selection-menu)
-		    (#\u utility-menu))))
+		    (#\n action-by-name-menu)
+		    (#\u action-by-number-menu)
+		    (#\y utility-menu))))
 
 
 
@@ -109,6 +130,8 @@
 
 (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 (#\g :control) 'stop-all-pending-actions)
@@ -160,6 +183,7 @@
 
 ;;; Selection
 (define-second-key ("x" :control) 'cut-current-child)
+(define-second-key ("x" :control :mod-1) 'clear-selection)
 (define-second-key ("c" :control) 'copy-current-child)
 (define-second-key ("v" :control) 'paste-selection)
 (define-second-key ("v" :control :shift) 'paste-selection-no-clear)
@@ -168,6 +192,7 @@
 
 
 
+
 (defun sm-handle-click-to-focus (root-x root-y)
   "Give the focus to the clicked child"
   (let ((win (find-child-under-mouse root-x root-y)))
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/24 20:53:37	1.14
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/26 22:02:02	1.15
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sun Feb 24 21:38:37 2008
+;;; #Date#: Tue Feb 26 22:49:18 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -63,27 +63,18 @@
   (declare (ignore group))
   nil)
 
-(defun create-group (&key name (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 :x x :y y :w w :h h :window window :gc gc :layout layout)))
 
 
-(defun add-group (group father)
-  (push group (group-child father)))
+(defgeneric child-name (child))
+
+(defmethod child-name ((child xlib:window))
+  (xlib:wm-name child))
+
+(defmethod child-name ((child group))
+  (group-name child))
+
+(defmethod child-name (child)
+  "???")
 
 
 
@@ -139,6 +130,50 @@
 
 
 
+(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 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 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)
@@ -164,6 +199,22 @@
       (return-from find-group-window group))))
 
 
+(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 get-all-windows (&optional (root *root-group*))
   "Return all windows in root and in its childs"
@@ -183,9 +234,6 @@
 
 
 
-
-
-
 (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
@@ -476,12 +524,18 @@
 	 (setf *current-child* father)
 	 t)))
 
+(defun set-current-root (father)
+  "Set current root if father is not in current root"
+  (unless (find-child father *current-root*)
+    (setf *current-root* father)))
+
 
 (defun focus-all-child (child father)
   "Focus child and its fathers - Set current group to father"
   (let ((new-focus (focus-child-rec child father))
-	(new-current-child (set-current-child child father)))
-    (or new-focus new-current-child)))
+	(new-current-child (set-current-child child father))
+	(new-root (set-current-root father)))
+    (or new-focus new-current-child new-root)))
 
 
 
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/24 20:53:37	1.11
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/26 22:02:02	1.12
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Fri Feb 22 22:44:09 2008
+;;; #Date#: Tue Feb 26 22:57:45 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility
@@ -32,8 +32,10 @@
 (defun add-default-group ()
   "Add a default group"
   (when (group-p *current-child*)
-    (push (create-group) (group-child *current-child*))
-    (show-all-childs)))
+    (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"
@@ -44,8 +46,8 @@
 	  (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*)))
-    (show-all-childs)))
+	    (group-child *current-child*))))
+  (leave-second-mode))
 
 
 
@@ -108,36 +110,37 @@
 
 
 ;;; Selection functions
-(defun get-current-child ()
-  "Return the current focused child"
-  (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 clear-selection ()
+  "Clear the current selection"
+  (setf *child-selection* nil)
+  (display-group-info *current-root*))
 
 (defun copy-current-child ()
   "Copy the current child to the selection"
   (let ((child (get-current-child)))
-    (pushnew child *child-selection*)
-    (display-group-info *current-root*)
-    child))
+    (when child
+      (pushnew child *child-selection*)
+      (display-group-info *current-root*)
+      child)))
 
 (defun cut-current-child ()
   "Cut the current child to the selection"
   (let ((child (copy-current-child)))
-    (setf *current-child* *current-root*)
-    (hide-child child)
-    (remove-child-in-group child (find-father-group child *current-root*))
-    (show-all-childs)))
+    (when child
+      (setf *current-child* *current-root*)
+      (hide-child child)
+      (remove-child-in-group child (find-father-group child *current-root*))
+      (show-all-childs))))
 
 (defun remove-current-child ()
   "Remove the current child from its father group"
   (let ((child (get-current-child)))
-    (setf *current-child* *current-root*)
-    (hide-child child)
-    (remove-child-in-group child (find-father-group child *current-root*))
-    (show-all-childs)))
+    (when child
+      (setf *current-child* *current-root*)
+      (hide-child child)
+      (remove-child-in-group child (find-father-group child *current-root*))))
+  (leave-second-mode))
+      
 
 (defun paste-selection-no-clear ()
   "Paste the selection in the current group - Do not clear the selection after paste"
@@ -149,11 +152,386 @@
 	(pushnew child (group-child group-dest)))
       (show-all-childs))))
 
-(defun paste-selection ()
-  "Paste the selection in the current group"
-  (paste-selection-no-clear)
-  (setf *child-selection* nil)
-  (display-group-info *current-root*))
+(defun paste-selection ()
+  "Paste the selection in the current group"
+  (paste-selection-no-clear)
+  (setf *child-selection* nil)
+  (display-group-info *current-root*))
+
+
+
+  
+
+
+
+;;; CONFIG - Identify mode
+(defun identify-key ()
+  "Identify a key"
+  (let* ((done nil)
+	 (font (xlib:open-font *display* *identify-font-string*))
+	 (window (xlib:create-window :parent *root*
+				     :x 0 :y 0
+				     :width (- (xlib:screen-width *screen*) 2)
+				     :height (* 3 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font)))
+				     :background (get-color *identify-background*)
+				     :border-width 1
+				     :border (get-color *identify-border*)
+				     :colormap (xlib:screen-default-colormap *screen*)
+				     :event-mask '(:exposure)))
+	 (gc (xlib:create-gcontext :drawable window
+				   :foreground (get-color *identify-foreground*)
+				   :background (get-color *identify-background*)
+				   :font font
+				   :line-style :solid)))
+    (labels ((print-key (code keysym key modifiers)
+	       (xlib:clear-area window)
+	       (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."))
+	       (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=~A  Key=~S  Modifiers=~A"
+						 code keysym key modifiers))))
+	     (handle-identify-key (&rest event-slots &key root code state &allow-other-keys)
+	       (declare (ignore event-slots root))
+	       (let* ((modifiers (xlib:make-state-keys state))
+		      (key (keycode->char code state))
+		      (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
+		 (setf done (and (equal key #\q) (null modifiers)))
+		 (dbg code keysym key modifiers)
+		 (print-key code keysym key modifiers)
+		 (force-output)))
+	     (handle-identify (&rest event-slots &key display event-key &allow-other-keys)
+	       (declare (ignore display))
+	       (case event-key
+		 (:key-press (apply #'handle-identify-key event-slots) t)
+		 (:exposure (print-key nil nil nil nil)))
+	       t))
+      (xgrab-pointer *root* 92 93)
+      (xlib:map-window window)
+      (format t "~&Press 'q' to stop the identify loop~%")
+      (print-key nil nil nil nil)
+      (force-output)
+      (unwind-protect
+	   (loop until done do
+		(xlib:display-finish-output *display*)
+		(xlib:process-event *display* :handler #'handle-identify))
+	(xlib:destroy-window window)
+	(xlib:close-font font)
+	(xgrab-pointer *root* 66 67)))))
+
+
+
+(defun query-show-paren (orig-string pos)
+  "Replace matching parentheses with brackets"
+  (let ((string (copy-seq orig-string))) 
+    (labels ((have-to-find-right? ()
+	       (and (< pos (length string)) (char= (aref string pos) #\()))
+	     (have-to-find-left? ()
+	       (and (> (1- pos) 0) (char= (aref string (1- pos)) #\))))
+	     (pos-right ()
+	       (loop :for p :from (1+ pos) :below (length string)
+		  :with level = 1   :for c = (aref string p)
+		  :do (when (char= c #\() (incf level))
+		  (when (char= c #\)) (decf level))
+		  (when (= level 0) (return p))))
+	     (pos-left ()
+	       (loop :for p :from (- pos 2) :downto 0
+		  :with level = 1   :for c = (aref string p)
+		  :do (when (char= c #\() (decf level))
+		  (when (char= c #\)) (incf level))
+		  (when (= level 0) (return p)))))
+      (when (have-to-find-right?)
+	(let ((p (pos-right)))
+	  (when p (setf (aref string p) #\]))))
+      (when (have-to-find-left?)
+	(let ((p (pos-left)))
+	  (when p (setf (aref string p) #\[))))
+      string)))
+
+
+;;; CONFIG - Query string mode
+(let ((history nil))
+  (defun clear-history ()
+    "Clear the query-string history"
+    (setf history nil))
+  
+  (defun query-string (msg &optional (default ""))
+    "Query a string from the keyboard. Display msg as prompt"
+    (let* ((done nil)
+	   (font (xlib:open-font *display* *query-font-string*))
+	   (window (xlib:create-window :parent *root*
+				       :x 0 :y 0
+				       :width (- (xlib:screen-width *screen*) 2)
+				       :height (* 3 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font)))
+				       :background (get-color *query-background*)
+				       :border-width 1
+				       :border (get-color *query-border*)
+				       :colormap (xlib:screen-default-colormap *screen*)
+				       :event-mask '(:exposure)))
+	   (gc (xlib:create-gcontext :drawable window
+				     :foreground (get-color *query-foreground*)
+				     :background (get-color *query-background*)
+				     :font font
+				     :line-style :solid))
+	   (result-string default)
+	   (pos (length default))
+	   (local-history history))
+      (labels ((add-cursor (string)
+		 (concatenate 'string (subseq string 0 pos) "|" (subseq string pos)))
+	       (print-string ()
+		 (xlib:clear-area window)
+		 (setf (xlib:gcontext-foreground gc) (get-color *query-foreground*))
+		 (xlib:draw-image-glyphs window 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))))
+	       (call-backspace (modifiers)
+		 (let ((del-pos (if (member :control modifiers)
+				    (or (position #\Space result-string :from-end t :end pos) 0)
+				    (1- pos))))
+		   (when (>= del-pos 0)
+		     (setf result-string (concatenate 'string
+						      (subseq result-string 0 del-pos)
+						      (subseq result-string pos))
+			   pos del-pos))))
+	       (call-delete (modifiers)
+		 (let ((del-pos (if (member :control modifiers)
+				    (1+ (or (position #\Space result-string :start pos) (1- (length result-string))))
+				    (1+ pos))))
+		   (if (<= del-pos (length result-string))
+		       (setf result-string (concatenate 'string
+							(subseq result-string 0 pos)
+							(subseq result-string del-pos))))))
+	       (call-delete-eof ()
+		 (setf result-string (subseq result-string 0 pos)))
+	       (handle-query-key (&rest event-slots &key root code state &allow-other-keys)
+		 (declare (ignore event-slots root))
+		 (let* ((modifiers (xlib:make-state-keys state))
+			(keysym (xlib:keycode->keysym *display* code (cond  ((member :shift modifiers) 1)
+									    ((member :mod-5 modifiers) 2)
+									    (t 0))))
+			(char (xlib:keysym->character *display* keysym))
+			(keysym-name (keysym->keysym-name keysym)))
+		   (setf done (cond ((string-equal keysym-name "Return") :Return)
+				    ((string-equal keysym-name "Tab") :Complet)
+				    ((string-equal keysym-name "Escape") :Escape)
+				    (t nil)))
+		   (cond ((string-equal keysym-name "Left")
+			  (when (> pos 0)
+			    (setf pos (if (member :control modifiers)
+					  (let ((p (position #\Space result-string
+							     :end (min (1- pos) (length result-string))
+							     :from-end t)))
+					    (if p p 0))
+					  (1- pos)))))
+			 ((string-equal keysym-name "Right")
+			  (when (< pos (length result-string))
+			    (setf pos (if (member :control modifiers)
+					  (let ((p (position #\Space result-string
+							     :start (min (1+ pos) (length result-string)))))
+					    (if p p (length result-string)))
+					  (1+ pos)))))
+			 ((string-equal keysym-name "Up")
+			  (setf result-string (first local-history)
+				pos (length result-string)
+				local-history (rotate-list local-history)))
+			 ((string-equal keysym-name "Down")
+			  (setf result-string (first local-history)
+				pos (length result-string)
+				local-history (anti-rotate-list local-history)))
+			 ((string-equal keysym-name "Home") (setf pos 0))
+			 ((string-equal keysym-name "End") (setf pos (length result-string)))
+			 ((string-equal keysym-name "Backspace") (call-backspace modifiers))
+			 ((string-equal keysym-name "Delete") (call-delete modifiers))
+			 ((and (string-equal keysym-name "k") (member :control modifiers))
+			  (call-delete-eof))
+			 ((and (characterp char) (standard-char-p char))
+			  (setf result-string (concatenate 'string
+							   (when (<= pos (length result-string))
+							     (subseq result-string 0 pos))
+							   (string char)
+							   (when (< pos (length result-string))
+							     (subseq result-string pos))))
+			  (incf pos)))
+		   (print-string)))
+	       (handle-query (&rest event-slots &key display event-key &allow-other-keys)
+		 (declare (ignore display))
+		 (case event-key
+		   (:key-press (apply #'handle-query-key event-slots) t)
+		   (:exposure (print-string)))
+		 t))
+	(xgrab-pointer *root* 92 93)
+	(xlib:map-window window)
+	(print-string)
+	(wait-no-key-or-button-press)
+	(unwind-protect
+	     (loop until (member done '(:Return :Escape :Complet)) do
+		  (xlib:display-finish-output *display*)
+		  (xlib:process-event *display* :handler #'handle-query))
+	  (xlib:destroy-window window)
+	  (xlib:close-font font)
+	  (xgrab-pointer *root* 66 67)))
+      (values (when (member done '(:Return :Complet))
+		(push result-string history)
+		result-string)
+	      done))))
+
+
+
+(defun query-number (msg)
+  "Query a number from the query input"
+  (parse-integer (or (query-string msg) "") :junk-allowed t))
+
+
+
+(defun eval-from-query-string ()
+  "Eval a lisp form from the query input"
+  (let ((form (query-string "Eval:"))
+	(result nil))
+    (when (and form (not (equal form "")))
+      (let ((printed-result
+	     (with-output-to-string (*standard-output*)
+	       (setf result (handler-case
+				(loop for i in (multiple-value-list
+						(eval (read-from-string form)))
+				   collect (format nil "~S" i))
+			      (error (condition)
+				(format nil "~A" condition)))))))
+	(info-mode (expand-newline (append (ensure-list (format nil "> ~A" form))
+					   (ensure-list printed-result)
+					   (ensure-list result)))
+		   :width (- (xlib:screen-width *screen*) 2))
+	(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))))
+
+
+
+
+;;; Group name actions
+;;;(loop :for str :in '("The Gimp" "The klm" "klm" "abc")  ;; Test
+;;;   :when (zerop (or (search "ThE" str :test #'string-equal) -1))
+;;;   :collect str)
+(defun ask-group-name (msg)
+  "Ask a group name"
+  (let ((all-group-name nil)
+	(name ""))
+    (with-all-groups (*root-group* group)
+      (awhen (group-name group) (push it all-group-name)))
+    (labels ((selected-names ()
+	       (loop :for str :in all-group-name
+		  :when (zerop (or (search name str :test #'string-equal) -1))
+		  :collect str))
+	     (complet-alone (req sel)
+	       (if (= 1 (length sel)) (first sel) req))
+	     (ask ()
+	       (let* ((selected (selected-names))
+		      (default (complet-alone name selected)))
+		 (multiple-value-bind (str done)
+		     (query-string (format nil "~A: ~{~A~^, ~}" msg selected) default)
+		   (setf name str)
+		   (when (or (not (string-equal name default)) (eql done :complet))
+		     (ask))))))
+      (ask))
+    name))
+
+
+
+;;; Focus by functions
+(defun focus-group-by (group)
+  (when (group-p group)
+    (focus-all-child group (or (find-father-group group *current-root*)
+			       (find-father-group group)))))

[341 lines skipped]
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/02/24 20:53:37	1.13
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/02/26 22:02:02	1.14
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sun Feb 24 21:36:00 2008
+;;; #Date#: Tue Feb 26 22:03:18 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -225,24 +225,11 @@
   ;;(intern-atoms *display*)
   (netwm-set-properties)
   (xlib:display-force-output *display*)
-  (setf *child-selection* nil
-	*current-group-number* -1)
-  (setf *root-group* (create-group :name "Root" :layout #'tile-space-layout)
+  (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*)
-;;  (add-group (create-group :name "Gimp" :x 0.6 :y 0 :w 0.3 :h 0.2) *root-group*)
-;;  (add-group (create-group :name "Net" :x 0.52 :y 0.3 :w 0.4 :h 0.3) *root-group*)
-;;  (add-group (create-group :x 0 :y 0.4 :w 0.4 :h 0.2) (first (group-child *root-group*)))
-;;  (add-group (create-group :x 0.4 :y 0 :w 0.2 :h 0.3) (first (group-child *root-group*)))
-;;  (add-group (create-group :x 0.6 :y 0.4 :w 0.4 :h 0.2) (first (group-child *root-group*)))
-;;  (add-group (create-group :x 0.4 :y 0.7 :w 0.2 :h 0.3) (first (group-child *root-group*)))
-;;  (add-group (create-group :x 0.1 :y 0.55 :w 0.8 :h 0.43) *root-group*)
-;;  (add-group (create-group :x 0.2 :y 0.1 :w 0.6 :h 0.4) (first (group-child *root-group*)))
-;;  (add-group (create-group :x 0.3 :y 0.55 :w 0.4 :h 0.3) (first (group-child *root-group*)))
-;;  (add-group (create-group :x 0.1 :y 0.1 :w 0.3 :h 0.6) (first (group-child (first (group-child *root-group*)))))
-;;  (setf *current-child* (first (group-child *current-root*)))
-;;  (setf (group-layout *current-child*) #'tile-layout)
   (process-existing-windows *screen*)
   (show-all-childs)
   (grab-main-keys)
@@ -267,7 +254,9 @@
 	  (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))))
 
 
@@ -280,9 +269,17 @@
       (format t "~&~A~&Maybe another window manager is running.~%" c)
       (force-output)
       (return-from main 'init-display-error)))
+  (handler-case
+      (init-display)
+    (xlib:access-error (c)
+      (ungrab-main-keys)
+      (xlib:destroy-window *no-focus-window*)
+      (xlib:close-display *display*)
+      (format t "~&~A~&Maybe another window manager is running.~%" c)
+      (force-output)
+      (return-from main 'init-display-error)))
   (unwind-protect
        (catch 'exit-main-loop
-	 (init-display)
 	 (main-loop))
     (ungrab-main-keys)
     (xlib:destroy-window *no-focus-window*)
--- /project/clfswm/cvsroot/clfswm/load.lisp	2008/02/25 20:11:08	1.6
+++ /project/clfswm/cvsroot/clfswm/load.lisp	2008/02/26 22:02:02	1.7
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Mon Feb 25 21:08:57 2008
+;;; #Date#: Tue Feb 26 21:45:34 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: System loading functions
@@ -56,4 +56,4 @@
 
 (in-package :clfswm)
 
-(clfswm:main ":0")
+(clfswm:main ":1")
--- /project/clfswm/cvsroot/clfswm/package.lisp	2008/02/24 20:53:37	1.10
+++ /project/clfswm/cvsroot/clfswm/package.lisp	2008/02/26 22:02:02	1.11
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sun Feb 24 21:35:31 2008
+;;; #Date#: Mon Feb 25 21:33:22 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Package definition
@@ -48,8 +48,6 @@
 
 (defparameter *child-selection* nil)
 
-(defparameter *current-group-number* -1)
-
 (defparameter *layout-list* nil)
 
 
@@ -59,9 +57,8 @@
 
 (defclass group ()
   ((name :initarg :name :accessor group-name :initform nil)
-   (number :initarg :number :accessor group-number
-	   :initform (incf *current-group-number*))
-   ;;; Float size - Manipulate only this variable and not real size
+   (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)
--- /project/clfswm/cvsroot/clfswm/tools.lisp	2008/02/24 20:53:37	1.6
+++ /project/clfswm/cvsroot/clfswm/tools.lisp	2008/02/26 22:02:02	1.7
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 12 14:03:59 2008
+;;; #Date#: Tue Feb 26 21:53:55 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: General tools



From pbrochard at common-lisp.net  Tue Feb 26 22:02:24 2008
From: pbrochard at common-lisp.net (pbrochard)
Date: Tue, 26 Feb 2008 17:02:24 -0500 (EST)
Subject: [clfswm-cvs] CVS clfswm
Message-ID: <20080226220224.9E13817045@common-lisp.net>

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

Modified Files:
	load.lisp 
Log Message:
focus/copy/move/delete by name or number

--- /project/clfswm/cvsroot/clfswm/load.lisp	2008/02/26 22:02:02	1.7
+++ /project/clfswm/cvsroot/clfswm/load.lisp	2008/02/26 22:02:24	1.8
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 26 21:45:34 2008
+;;; #Date#: Tue Feb 26 23:00:22 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: System loading functions
@@ -56,4 +56,4 @@
 
 (in-package :clfswm)
 
-(clfswm:main ":1")
+(clfswm:main ":0")



From pbrochard at common-lisp.net  Wed Feb 27 22:34:55 2008
From: pbrochard at common-lisp.net (pbrochard)
Date: Wed, 27 Feb 2008 17:34:55 -0500 (EST)
Subject: [clfswm-cvs] CVS clfswm
Message-ID: <20080227223455.59CD9601AD@common-lisp.net>

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

Modified Files:
	ChangeLog bindings-second-mode.lisp clfswm-internal.lisp 
	clfswm-layout.lisp clfswm-util.lisp clfswm.lisp config.lisp 
Log Message:
Add a raise-p parameter for each layout

--- /project/clfswm/cvsroot/clfswm/ChangeLog	2008/02/26 22:02:02	1.16
+++ /project/clfswm/cvsroot/clfswm/ChangeLog	2008/02/27 22:34:55	1.17
@@ -1,3 +1,8 @@
+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
--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/26 22:02:02	1.13
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/27 22:34:55	1.14
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 26 22:41:08 2008
+;;; #Date#: Wed Feb 27 21:08:44 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse for second mode
@@ -87,6 +87,7 @@
 (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))))
@@ -94,6 +95,7 @@
 (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))))
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/26 22:02:02	1.15
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/27 22:34:55	1.16
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 26 22:49:18 2008
+;;; #Date#: Wed Feb 27 22:23:42 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -74,6 +74,7 @@
   (group-name child))
 
 (defmethod child-name (child)
+  (declare (ignore child))
   "???")
 
 
@@ -242,13 +243,14 @@
       (xlib:with-gcontext (gc :foreground (get-color (if (and (equal group *current-root*)
 							      (equal group *current-child*))
 							 "Red" "Green")))
-	(xlib:draw-glyphs window gc 5 dy		 
-			  (format nil "Group: ~A~A" number
-				  (if name  (format nil " - ~A" name) "")))
+	(xlib:draw-image-glyphs window gc 5 dy		 
+				(format nil "Group: ~A~A                                                  "
+					number
+					(if name  (format nil " - ~A" name) "")))
 	(let ((pos dy))
 	  (when (equal group *current-root*)
 	    (xlib:draw-image-glyphs window gc 5 (incf pos dy)
-				    (format nil "~A hidden windows      " (length (get-hidden-windows))))
+				    (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)
@@ -284,23 +286,25 @@
 
 (defmethod adapt-child-to-father ((window xlib:window) father)
   (with-xlib-protect
-    (multiple-value-bind (nx ny nw nh)
+    (multiple-value-bind (nx ny nw nh raise-p)
 	(get-father-layout window father)
       (setf (xlib:drawable-x window) nx
 	    (xlib:drawable-y window) ny
 	    (xlib:drawable-width window) nw
-	    (xlib:drawable-height window) nh))))
+	    (xlib:drawable-height window) nh)
+      raise-p)))
 
 (defmethod adapt-child-to-father ((group group) father)
   (with-xlib-protect
-    (multiple-value-bind (nx ny nw nh)
+    (multiple-value-bind (nx ny nw nh raise-p)
 	(get-father-layout group father)
       (with-slots (rx ry rw rh window) group
 	(setf rx nx  ry ny  rw nw  rh nh)
 	(setf (xlib:drawable-x window) rx
 	      (xlib:drawable-y window) ry
 	      (xlib:drawable-width window) rw
-	      (xlib:drawable-height window) rh)))))
+	      (xlib:drawable-height window) rh)
+	raise-p))))
    
   
 
@@ -310,12 +314,13 @@
 (defmethod show-child ((group group) father)
   (with-xlib-protect
     (with-slots (window) group
-      (adapt-child-to-father group father)
-      (when (or *show-root-group-p* (not (equal group *current-root*)))
-	(setf (xlib:window-background window) (get-color "Black"))
-	(xlib:map-window window)
-	(raise-window window)
-	(display-group-info group)))))
+      (let ((raise-p (adapt-child-to-father group father)))
+	(when (or *show-root-group-p* (not (equal group *current-root*)))
+	  (setf (xlib:window-background window) (get-color "Black"))
+	  (xlib:map-window window)
+	  (when raise-p
+	    (raise-window window))
+	  (display-group-info group))))))
 
 
 (defmethod hide-child ((group group))
@@ -326,10 +331,12 @@
 
 (defmethod show-child ((window xlib:window) father)
   (with-xlib-protect
-    (when (eql (window-type window) :normal)
-      (adapt-child-to-father window father))
-    (xlib:map-window window)
-    (raise-window window)))
+    (let ((raise-p nil))
+      (when (eql (window-type window) :normal)
+	(setf raise-p (adapt-child-to-father window father)))
+      (xlib:map-window window)
+      (when raise-p
+	(raise-window window)))))
 
 (defmethod hide-child ((window xlib:window))
   (hide-window window))
@@ -625,8 +632,8 @@
 		    (eql win *no-focus-window*))
 	  (when (or (eql map-state :viewable)
 	  	    (eql wm-state +iconic-state+))
-	    (format t "Processing ~S ~S~%" (xlib:wm-name win) win)
-	    (unhide-window win)
+	    (format t "Processing ~S: type=~A ~S~%" (xlib:wm-name win) (window-type win)win)
+	    ;;	    (unhide-window win)
 	    (process-new-window win)
 	    (xlib:map-window win)
 	    (push (xlib:window-id win) id-list)))))
--- /project/clfswm/cvsroot/clfswm/clfswm-layout.lisp	2008/02/24 20:53:37	1.1
+++ /project/clfswm/cvsroot/clfswm/clfswm-layout.lisp	2008/02/27 22:34:55	1.2
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Fri Feb 22 21:34:48 2008
+;;; #Date#: Wed Feb 27 22:19:57 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Layout functions
@@ -32,7 +32,7 @@
 ;;;
 ;;; To add a new layout:
 ;;;   1- define your own layout: a method returning the real size of the
-;;;      child in screen size (integer) as 4 values (rx, ry, rw, rh).
+;;;      child in screen size (integer) as 5 values (rx, ry, rw, rh, raise-p).
 ;;;      This method can use the float size of the child (x, y ,w , h).
 ;;;      It can be specialised for xlib:window or group
 ;;;   2- Define a seter function for your layout
@@ -62,21 +62,21 @@
 
 
 ;;; No layout
-(defgeneric no-layout (child father))
+(defgeneric no-layout (child father)
+  (:documentation "Maximize windows in there group - leave group to there size"))
 
 (defmethod no-layout ((child xlib:window) father)
-  "Maximize windows in there group - leave group to there size"
   (with-slots (rx ry rw rh) father
-    (values (1+ rx)  (1+ ry) (- rw 2) (- rh 2))))
+    (values (1+ rx)  (1+ ry) (- rw 2) (- rh 2) nil)))
 
 (defmethod no-layout ((child group) father)
-  "Maximize windows in there group - leave group to there size"
   (with-slots ((cx x) (cy y) (cw w) (ch h)) child
     (with-slots ((frx rx) (fry ry) (frw rw) (frh rh)) father
       (values (round (+ (* cx frw) frx))
 	      (round (+ (* cy frh) fry))
 	      (round (* cw frw))
-	      (round (* ch frh))))))
+	      (round (* ch frh))
+	      t))))
 
 (defun set-no-layout ()
   "Maximize windows in there group - leave group to there size"
@@ -88,10 +88,10 @@
 
 
 ;;; Tile layout
-(defgeneric tile-layout (child father))
+(defgeneric tile-layout (child father)
+  (:documentation "Tile child in its group"))
 
 (defmethod tile-layout (child father)
-  "Tile child in its group"
   (let* ((managed-childs (get-managed-child father))
 	 (pos (position child managed-childs))
 	 (len (length managed-childs))
@@ -101,7 +101,8 @@
     (values (round (+ (group-rx father) (truncate (* (mod pos n) dx)) 1))
 	    (round (+ (group-ry father) (truncate (* (truncate (/ pos n)) dy)) 1))
 	    (round (- dx 2))
-	    (round (- dy 2)))))
+	    (round (- dy 2))
+	    nil)))
 
 (defun set-tile-layout ()
   "Tile child in its group"
@@ -120,10 +121,10 @@
 
 
 
-(defgeneric tile-left-layout (child father))
+(defgeneric tile-left-layout (child father)
+  (:documentation "Tile Left: main child on left and others on right"))
 
 (defmethod tile-left-layout (child father)
-  "Tile Left: main child on left and others on right"
   (with-slots (rx ry rw rh) father
     (let* ((managed-childs (get-managed-child father))
 	   (pos (position child managed-childs))
@@ -134,11 +135,13 @@
 	    (values (1+ rx)
 		    (1+ ry)
 		    (- (round (* rw size)) 2)
-		    (- rh 2))
+		    (- rh 2)
+		    nil)
 	    (values (1+ (round (+ rx (* rw size))))
 		    (1+ (round (+ ry (* dy (1- pos)))))
 		    (- (round (* rw (- 1 size))) 2)
-		    (- (round dy) 2))))))
+		    (- (round dy) 2)
+		    nil)))))
 
 
 (defun set-tile-left-layout ()
@@ -151,10 +154,10 @@
 
 
 ;;; Tile right
-(defgeneric tile-right-layout (child father))
+(defgeneric tile-right-layout (child father)
+  (:documentation "Tile Right: main child on right and others on left"))
 
 (defmethod tile-right-layout (child father)
-  "Tile Right: main child on right and others on left"
   (with-slots (rx ry rw rh) father
     (let* ((managed-childs (get-managed-child father))
 	   (pos (position child managed-childs))
@@ -165,12 +168,13 @@
 	  (values (1+ (round (+ rx (* rw (- 1 size)))))
 		  (1+ ry)
 		  (- (round (* rw size)) 2)
-		  (- rh 2))
+		  (- rh 2)
+		  nil)
 	  (values (1+ rx)
 		  (1+ (round (+ ry (* dy (1- pos)))))
 		  (- (round (* rw (- 1 size))) 2)
-		  (- (round dy) 2))))))
-
+		  (- (round dy) 2)
+		  nil)))))
 
 
 (defun set-tile-right-layout ()
@@ -185,10 +189,10 @@
 
 
 ;;; Tile Top
-(defgeneric tile-top-layout (child father))
+(defgeneric tile-top-layout (child father)
+  (:documentation "Tile Top: main child on top and others on bottom"))
 
 (defmethod tile-top-layout (child father)
-  "Tile Top: main child on top and others on bottom"
   (with-slots (rx ry rw rh) father
     (let* ((managed-childs (get-managed-child father))
 	   (pos (position child managed-childs))
@@ -199,11 +203,13 @@
 	    (values (1+ rx)
 		    (1+ ry)
 		    (- rw 2)
-		    (- (round (* rh size)) 2))
+		    (- (round (* rh size)) 2)
+		    nil)
 	    (values (1+ (round (+ rx (* dx (1- pos)))))
 		    (1+ (round (+ ry (* rh size))))
 		    (- (round dx) 2)
-		    (- (round (* rh (- 1 size))) 2))))))
+		    (- (round (* rh (- 1 size))) 2)
+		    nil)))))
 
 
 (defun set-tile-top-layout ()
@@ -216,10 +222,10 @@
 
 
 ;;; Tile Bottom
-(defgeneric tile-bottom-layout (child father))
+(defgeneric tile-bottom-layout (child father)
+  (:documentation "Tile Bottom: main child on bottom and others on top"))
 
 (defmethod tile-bottom-layout (child father)
-  "Tile Bottom: main child on bottom and others on top"
   (with-slots (rx ry rw rh) father
     (let* ((managed-childs (get-managed-child father))
 	   (pos (position child managed-childs))
@@ -251,10 +257,10 @@
 
 
 ;;; Space layout
-(defgeneric tile-space-layout (child father))
+(defgeneric tile-space-layout (child father)
+  (:documentation "Tile Space: tile child in its group leaving spaces between them"))
 
 (defmethod tile-space-layout (child father)
-  "Tile Space: tile child in its group leaving spaces between them"
   (with-slots (rx ry rw rh) father
     (let* ((managed-childs (get-managed-child father))
 	   (pos (position child managed-childs))
@@ -267,7 +273,8 @@
       (values (round (+ rx (truncate (* (mod pos n) dx)) (* dx size) 1))
 	      (round (+ ry (truncate (* (truncate (/ pos n)) dy)) (* dy size) 1))
 	      (round (- dx (* dx size 2) 2))
-	      (round (- dy (* dy size 2) 2))))))
+	      (round (- dy (* dy size 2) 2))
+	      nil))))
 
 (defun set-space-tile-layout ()
   "Tile Space: tile child in its group leaving spaces between them"
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/26 22:02:02	1.12
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/27 22:34:55	1.13
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 26 22:57:45 2008
+;;; #Date#: Wed Feb 27 21:09:58 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility
@@ -451,7 +451,8 @@
 (defun focus-group-by (group)
   (when (group-p group)
     (focus-all-child group (or (find-father-group group *current-root*)
-			       (find-father-group group)))))
+			       (find-father-group group)
+			       *root-group*))))
 
 
 (defun focus-group-by-name ()
@@ -465,6 +466,23 @@
   (leave-second-mode))
 
 
+;;; Open by functions
+(defun open-group-by (group)
+  (when (group-p group)
+    (push (create-group :name (query-string "Group name")) (group-child group))))
+
+
+
+(defun open-group-by-name ()
+  "Open a new group in a named group"
+  (open-group-by (find-group-by-name (ask-group-name "Open a new group in")))
+  (leave-second-mode))
+
+(defun open-group-by-number ()
+  "Open a new group in a numbered group"
+  (open-group-by (find-group-by-name (ask-group-name "Open a new group in the grou numbered:")))
+  (leave-second-mode))
+
 
 ;;; Delete by functions
 (defun delete-group-by (group)
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/02/26 22:02:02	1.14
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/02/27 22:34:55	1.15
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Feb 26 22:03:18 2008
+;;; #Date#: Wed Feb 27 20:52:03 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -79,10 +79,10 @@
 (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)
+;;    (focus-window window)
     (show-all-childs)))
 
 
--- /project/clfswm/cvsroot/clfswm/config.lisp	2008/02/24 20:53:37	1.8
+++ /project/clfswm/cvsroot/clfswm/config.lisp	2008/02/27 22:34:55	1.9
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Fri Feb 22 15:14:03 2008
+;;; #Date#: Wed Feb 27 22:15:01 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Configuration file
@@ -42,8 +42,9 @@
 
 ;;; CONFIG - Screen size
 (defun get-fullscreen-size ()
-  "Return the size of root child - you can tweak this to what you want"
-  (values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*)))
+  "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))
 



From pbrochard at common-lisp.net  Thu Feb 28 20:36:26 2008
From: pbrochard at common-lisp.net (pbrochard)
Date: Thu, 28 Feb 2008 15:36:26 -0500 (EST)
Subject: [clfswm-cvs] CVS clfswm
Message-ID: <20080228203626.C6549111E1@common-lisp.net>

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

Modified Files:
	bindings-second-mode.lisp clfswm-internal.lisp 
	clfswm-util.lisp 
Log Message:
Do action on *current-child* and not on (get-current-child) (ie: the focused child)

--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/27 22:34:55	1.14
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/28 20:36:26	1.15
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Feb 27 21:08:44 2008
+;;; #Date#: Thu Feb 28 21:30:15 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse for second mode
@@ -108,6 +108,17 @@
 		    (#\m group-movement-menu))))
 
 
+
+(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)
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/27 22:34:55	1.16
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/28 20:36:26	1.17
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Feb 27 22:23:42 2008
+;;; #Date#: Thu Feb 28 21:18:23 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -396,11 +396,11 @@
 
 
 
-(defun hide-all-groups (root)
+(defun hide-all-childs (root)
   (hide-child root)
   (when (group-p root)
     (dolist (child (group-child root))
-      (hide-all-groups child))))
+      (hide-all-childs child))))
 
 
 
@@ -410,7 +410,7 @@
   (let ((group-is-root? (and (equal *current-root* *current-child*)
 			     (not (equal *current-root* *root-group*)))))
     (if group-is-root?
-	(hide-all-groups *current-root*)
+	(hide-all-childs *current-root*)
 	(select-current-group nil))
     (let ((father (find-father-group *current-child*)))
       (when (group-p father)
@@ -468,13 +468,13 @@
 
 (defun enter-group ()
   "Enter in the selected group - ie make it the root group"
-  (hide-all-groups *current-root*)
+  (hide-all-childs *current-root*)
   (setf *current-root* *current-child*)
   (show-all-childs))
 
 (defun leave-group ()
   "Leave the selected group - ie make its father the root group"
-  (hide-all-groups *current-root*)
+  (hide-all-childs *current-root*)
   (awhen (find-father-group *current-root*)
     (when (group-p it)
       (setf *current-root* it)))
@@ -483,13 +483,13 @@
 
 (defun switch-to-root-group ()
   "Switch to the root group"
-  (hide-all-groups *current-root*)
+  (hide-all-childs *current-root*)
   (setf *current-root* *root-group*)
   (show-all-childs))
 
 (defun switch-and-select-root-group ()
   "Switch and select the root group"
-  (hide-all-groups *current-root*)
+  (hide-all-childs *current-root*)
   (setf *current-root* *root-group*)
   (setf *current-child* *current-root*)
   (show-all-childs))
@@ -497,7 +497,7 @@
 
 (defun toggle-show-root-group ()
   "Show/Hide the root group"
-  (hide-all-groups *current-root*)
+  (hide-all-childs *current-root*)
   (setf *show-root-group-p* (not *show-root-group-p*))
   (show-all-childs))
 
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/27 22:34:55	1.13
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/28 20:36:26	1.14
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Feb 27 21:09:58 2008
+;;; #Date#: Thu Feb 28 21:23:55 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility
@@ -117,28 +117,23 @@
 
 (defun copy-current-child ()
   "Copy the current child to the selection"
-  (let ((child (get-current-child)))
-    (when child
-      (pushnew child *child-selection*)
-      (display-group-info *current-root*)
-      child)))
+  (pushnew *current-child* *child-selection*)
+  (display-group-info *current-root*))
+
 
 (defun cut-current-child ()
   "Cut the current child to the selection"
-  (let ((child (copy-current-child)))
-    (when child
-      (setf *current-child* *current-root*)
-      (hide-child child)
-      (remove-child-in-group child (find-father-group child *current-root*))
-      (show-all-childs))))
+  (copy-current-child)
+  (hide-all-childs *current-child*)
+  (remove-child-in-group *current-child* (find-father-group *current-child* *current-root*))
+  (setf *current-child* *current-root*)
+  (show-all-childs))
 
 (defun remove-current-child ()
   "Remove the current child from its father group"
-  (let ((child (get-current-child)))
-    (when child
-      (setf *current-child* *current-root*)
-      (hide-child child)
-      (remove-child-in-group child (find-father-group child *current-root*))))
+  (hide-all-childs *current-child*)
+  (remove-child-in-group *current-child* (find-father-group *current-child* *current-root*))
+  (setf *current-child* *current-root*)
   (leave-second-mode))
       
 
@@ -514,16 +509,16 @@
 
 (defun move-current-child-by-name ()
   "Move current child in a named group"
-  (let ((child (get-current-child)))
-    (move-current-child-by child (find-group-by-name
-				  (ask-group-name (format nil "Move '~A' to group" (child-name child))))))
+  (move-current-child-by *current-child*
+			 (find-group-by-name
+			  (ask-group-name (format nil "Move '~A' to group" (child-name *current-child*)))))
   (leave-second-mode))
 
 (defun move-current-child-by-number ()
   "Move current child in a numbered group"
-  (let ((child (get-current-child)))
-    (move-current-child-by child (find-group-by-number
-				  (query-number (format nil "Move '~A' to group numbered:" (child-name child))))))
+  (move-current-child-by *current-child*
+			 (find-group-by-number
+			  (query-number (format nil "Move '~A' to group numbered:" (child-name *current-child*)))))
   (leave-second-mode))
 
 
@@ -535,16 +530,16 @@
 
 (defun copy-current-child-by-name ()
   "Copy current child in a named group"
-  (let ((child (get-current-child)))
-    (copy-current-child-by child (find-group-by-name
-				  (ask-group-name (format nil "Copy '~A' to group" (child-name child))))))
+  (copy-current-child-by *current-child*
+			 (find-group-by-name
+			  (ask-group-name (format nil "Copy '~A' to group" (child-name *current-child*)))))
   (leave-second-mode))
 
 (defun copy-current-child-by-number ()
   "Copy current child in a numbered group"
-  (let ((child (get-current-child)))
-    (copy-current-child-by child (find-group-by-number
-				  (query-number (format nil "Copy '~A' to group numbered:" (child-name child))))))
+  (copy-current-child-by *current-child*
+			 (find-group-by-number
+			  (query-number (format nil "Copy '~A' to group numbered:" (child-name *current-child*)))))
   (leave-second-mode))
 
 



From pbrochard at common-lisp.net  Fri Feb 29 23:05:57 2008
From: pbrochard at common-lisp.net (pbrochard)
Date: Fri, 29 Feb 2008 18:05:57 -0500 (EST)
Subject: [clfswm-cvs] CVS clfswm
Message-ID: <20080229230557.536D3111DC@common-lisp.net>

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

Modified Files:
	bindings-second-mode.lisp clfswm-internal.lisp 
	clfswm-util.lisp clfswm.lisp xlib-util.lisp 
Log Message:
rename focus-all-child to focus-all-childs

--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/28 20:36:26	1.15
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/02/29 23:05:56	1.16
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Feb 28 21:30:15 2008
+;;; #Date#: Thu Feb 28 21:38:00 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse for second mode
@@ -41,12 +41,12 @@
 ;; Menu entry
 ;;;;;;;;;;;;;;;
 (defun group-adding-menu ()
-  "Open the adding group menu"
+  "Adding group menu"
   (info-mode-menu '((#\a add-default-group)
 		    (#\p add-placed-group))))
 
 (defun group-layout-menu ()
-  "Open the 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))))
@@ -56,13 +56,13 @@
 
 
 (defun group-pack-menu ()
-  "Open the group pack menu"
+  "Group pack menu"
   (info-mode-menu '(("Up" group-pack-up)
 		    ("Down" group-pack-down))))
 
 
 (defun group-movement-menu ()
-  "Open the movement menu"
+  "Group movement menu"
   (info-mode-menu '((#\p group-pack-menu)
 		    (#\f group-fill-menu)
 		    (#\r group-resize-menu))))
@@ -128,7 +128,7 @@
 (defun main-menu ()
   "Open the main menu"
   (info-mode-menu '((#\g group-menu)
-		    (#\w window-menu)
+		    ;;(#\w window-menu)
 		    (#\s selection-menu)
 		    (#\n action-by-name-menu)
 		    (#\u action-by-number-menu)
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/28 20:36:26	1.17
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/02/29 23:05:56	1.18
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Feb 28 21:18:23 2008
+;;; #Date#: Sat Mar  1 00:03:14 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -227,10 +227,10 @@
 
 (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)))
+  (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)))
 
 
 
@@ -286,25 +286,25 @@
 
 (defmethod adapt-child-to-father ((window xlib:window) father)
   (with-xlib-protect
-    (multiple-value-bind (nx ny nw nh raise-p)
-	(get-father-layout window father)
-      (setf (xlib:drawable-x window) nx
-	    (xlib:drawable-y window) ny
-	    (xlib:drawable-width window) nw
-	    (xlib:drawable-height window) nh)
-      raise-p)))
+      (multiple-value-bind (nx ny nw nh raise-p)
+	  (get-father-layout window father)
+	(setf (xlib:drawable-x window) nx
+	      (xlib:drawable-y window) ny
+	      (xlib:drawable-width window) nw
+	      (xlib:drawable-height window) nh)
+	raise-p)))
 
 (defmethod adapt-child-to-father ((group group) father)
   (with-xlib-protect
-    (multiple-value-bind (nx ny nw nh raise-p)
-	(get-father-layout group father)
-      (with-slots (rx ry rw rh window) group
-	(setf rx nx  ry ny  rw nw  rh nh)
-	(setf (xlib:drawable-x window) rx
-	      (xlib:drawable-y window) ry
-	      (xlib:drawable-width window) rw
-	      (xlib:drawable-height window) rh)
-	raise-p))))
+      (multiple-value-bind (nx ny nw nh raise-p)
+	  (get-father-layout group father)
+	(with-slots (rx ry rw rh window) group
+	  (setf rx nx  ry ny  rw nw  rh nh)
+	  (setf (xlib:drawable-x window) rx
+		(xlib:drawable-y window) ry
+		(xlib:drawable-width window) rw
+		(xlib:drawable-height window) rh)
+	  raise-p))))
    
   
 
@@ -313,30 +313,30 @@
 
 (defmethod show-child ((group group) father)
   (with-xlib-protect
-    (with-slots (window) group
-      (let ((raise-p (adapt-child-to-father group father)))
-	(when (or *show-root-group-p* (not (equal group *current-root*)))
-	  (setf (xlib:window-background window) (get-color "Black"))
-	  (xlib:map-window window)
-	  (when raise-p
-	    (raise-window window))
-	  (display-group-info group))))))
+      (with-slots (window) group
+	(let ((raise-p (adapt-child-to-father group father)))
+	  (when (or *show-root-group-p* (not (equal group *current-root*)))
+	    (setf (xlib:window-background window) (get-color "Black"))
+	    (xlib:map-window window)
+	    (when raise-p
+	      (raise-window window))
+	    (display-group-info group))))))
 
 
 (defmethod hide-child ((group group))
   (with-xlib-protect
-    (with-slots (window) group
-      (xlib:unmap-window window))))
+      (with-slots (window) group
+	(xlib:unmap-window window))))
 
 
 (defmethod show-child ((window xlib:window) father)
   (with-xlib-protect
-    (let ((raise-p nil))
-      (when (eql (window-type window) :normal)
-	(setf raise-p (adapt-child-to-father window father)))
-      (xlib:map-window window)
-      (when raise-p
-	(raise-window window)))))
+      (let ((raise-p nil))
+	(when (eql (window-type window) :normal)
+	  (setf raise-p (adapt-child-to-father window father)))
+	(xlib:map-window window)
+	(when raise-p
+	  (raise-window window)))))
 
 (defmethod hide-child ((window xlib:window))
   (hide-window window))
@@ -350,18 +350,18 @@
 
 (defmethod select-child ((group group) selected)
   (with-xlib-protect
-    (when (and (group-p group) (group-window group))
-      (setf (xlib:window-border (group-window group))
-	    (get-color (cond ((equal selected :maybe) *color-maybe-selected*)
-			     ((equal selected nil) *color-unselected*)
-			     (selected *color-selected*)))))))
+      (when (and (group-p group) (group-window group))
+	(setf (xlib:window-border (group-window group))
+	      (get-color (cond ((equal selected :maybe) *color-maybe-selected*)
+			       ((equal selected nil) *color-unselected*)
+			       (selected *color-selected*)))))))
 
 (defmethod select-child ((window xlib:window) selected)
   (with-xlib-protect
-    (setf (xlib:window-border window)
-	  (get-color (cond ((equal selected :maybe) *color-maybe-selected*)
-			   ((equal selected nil) *color-unselected*)
-			   (selected *color-selected*))))))
+      (setf (xlib:window-border window)
+	    (get-color (cond ((equal selected :maybe) *color-maybe-selected*)
+			     ((equal selected nil) *color-unselected*)
+			     (selected *color-selected*))))))
 
 (defun select-current-group (selected)
   (select-child *current-child* selected))
@@ -436,7 +436,7 @@
   (select-current-group nil)
   (when (group-p *current-child*)
     (awhen (first (group-child *current-child*))
-      (setf *current-child* it)))
+	   (setf *current-child* it)))
   (show-all-childs))
 
 (defun select-previous-level ()
@@ -444,7 +444,7 @@
   (unless (equal *current-child* *current-root*)
     (select-current-group nil)
     (awhen (find-father-group *current-child*)
-      (setf *current-child* it))
+	   (setf *current-child* it))
     (show-all-childs)))
 
 
@@ -476,8 +476,8 @@
   "Leave the selected group - ie make its father the root group"
   (hide-all-childs *current-root*)
   (awhen (find-father-group *current-root*)
-    (when (group-p it)
-      (setf *current-root* it)))
+	 (when (group-p it)
+	   (setf *current-root* it)))
   (show-all-childs))
 
 
@@ -537,7 +537,7 @@
     (setf *current-root* father)))
 
 
-(defun focus-all-child (child father)
+(defun focus-all-childs (child father)
   "Focus child and its fathers - Set current group to father"
   (let ((new-focus (focus-child-rec child father))
 	(new-current-child (set-current-child child father))
@@ -582,7 +582,7 @@
   ;;(create-group-on-request)
   ;; PHIL: TODO: add a hook here
   (with-xlib-protect
-    (setf (xlib:window-event-mask window) *window-events*)
+      (setf (xlib:window-event-mask window) *window-events*)
     (set-window-state window +normal-state+)
     (setf (xlib:drawable-border-width window) (case (window-type window)
 						(:normal 1)
@@ -594,9 +594,9 @@
       (leave-group)
       (select-previous-level))
     ;;(unless (eql (window-type window) :maxsize) ;; PHIL: this is sufficient for the ROX panel
-    (pushnew window (group-child *current-child*));)
+    (pushnew window (group-child *current-child*)) ;)
     (unhide-window window)
-    ;;(dbg (window-type window) (xlib:wm-name window)) ;;; PHIL
+    ;;(dbg (xlib:wm-name window) (xlib:get-wm-class window) (window-type window)) ;;; PHIL
     (case (window-type window)
       (:normal (adapt-child-to-father window *current-child*))
       (t (let* ((hints (xlib:wm-normal-hints window))
@@ -624,17 +624,19 @@
 
 (defun process-existing-windows (screen)
   "Windows present when clfswm starts up must be absorbed by clfswm."
-  (let ((id-list nil))
+  (let ((id-list nil)
+	(all-windows (get-all-windows)))
     (dolist (win (xlib:query-tree (xlib:screen-root screen)))
-      (let ((map-state (xlib:window-map-state win))
-	    (wm-state (window-state win)))
-	(unless (or (eql (xlib: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: type=~A ~S~%" (xlib:wm-name win) (window-type win)win)
-	    ;;	    (unhide-window win)
-	    (process-new-window win)
-	    (xlib:map-window win)
-	    (push (xlib:window-id win) id-list)))))
+      (unless (member win all-windows)
+	(let ((map-state (xlib:window-map-state win))
+	      (wm-state (window-state win)))
+	  (unless (or (eql (xlib: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: type=~A ~S~%" (xlib:wm-name win) (window-type win)win)
+	      ;;	    (unhide-window win)
+	      (process-new-window win)
+	      (xlib:map-window win)
+	      (pushnew (xlib:window-id win) id-list))))))
     (netwm-set-client-list id-list)))
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/28 20:36:26	1.14
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/02/29 23:05:56	1.15
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Feb 28 21:23:55 2008
+;;; #Date#: Sat Mar  1 00:03:08 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility
@@ -83,10 +83,10 @@
 (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)))
+      (dolist (window (get-hidden-windows))
+	(unhide-window window)
+	(process-new-window window)
+	(xlib:map-window window)))
   (show-all-childs))
 
 
@@ -95,15 +95,15 @@
 (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)))
+      (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)))
 
 
 
@@ -445,9 +445,9 @@
 ;;; Focus by functions
 (defun focus-group-by (group)
   (when (group-p group)
-    (focus-all-child group (or (find-father-group group *current-root*)
-			       (find-father-group group)
-			       *root-group*))))
+    (focus-all-childs group (or (find-father-group group *current-root*)
+				(find-father-group group)
+				*root-group*))))
 
 
 (defun focus-group-by-name ()
@@ -505,7 +505,7 @@
   (when (and child (group-p group-dest))
     (remove-child-in-group child (find-father-group child))
     (pushnew child (group-child group-dest))
-    (focus-all-child child group-dest)))
+    (focus-all-childs child group-dest)))
 
 (defun move-current-child-by-name ()
   "Move current child in a named group"
@@ -526,7 +526,7 @@
 (defun copy-current-child-by (child group-dest)
   (when (and child (group-p group-dest))
     (pushnew child (group-child group-dest))
-    (focus-all-child child group-dest)))
+    (focus-all-childs child group-dest)))
 
 (defun copy-current-child-by-name ()
   "Copy current child in a named group"
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/02/27 22:34:55	1.15
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/02/29 23:05:56	1.16
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Feb 27 20:52:03 2008
+;;; #Date#: Sat Mar  1 00:02:34 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
@@ -54,18 +54,18 @@
 	     (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))))))))
+	(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))))))))
 
 
 
@@ -79,10 +79,10 @@
 (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)
+    ;;    (focus-window window)
     (show-all-childs)))
 
 
@@ -113,7 +113,7 @@
 (defun handle-exposure   (&rest event-slots &key window &allow-other-keys)
   (declare (ignore event-slots))
   (awhen (find-group-window window *current-root*)
-    (display-group-info it)))
+	 (display-group-info it)))
 
 
 (defun handle-create-notify (&rest event-slots)
@@ -130,7 +130,7 @@
     (unless father
       (setf child (find-group-window window *current-root*)
 	    father (find-father-group child *current-root*)))
-    (when (and child father (focus-all-child child father))
+    (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))))
@@ -166,20 +166,20 @@
   (declare (ignore display))
   ;;(dbg  event-key)
   (with-xlib-protect
-    (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))
-      (:map-request (call-hook *map-request-hook* event-slots))
-      (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
-      (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
-      (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
-      (: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))))
+      (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))
+	(:map-request (call-hook *map-request-hook* event-slots))
+	(:unmap-notify (call-hook *unmap-notify-hook* event-slots))
+	(:destroy-notify (call-hook *destroy-notify-hook* event-slots))
+	(:mapping-notify (call-hook *mapping-notify-hook* event-slots))
+	(: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))))
   t)
 
 
@@ -187,7 +187,7 @@
 (defun main-loop ()
   (loop
      (with-xlib-protect
-       (xlib:display-finish-output *display*)
+	 (xlib:display-finish-output *display*)
        (xlib:process-event *display* :handler #'handle-event))))
 ;;(dbg "Main loop finish" c)))))
 
--- /project/clfswm/cvsroot/clfswm/xlib-util.lisp	2008/02/24 20:53:37	1.6
+++ /project/clfswm/cvsroot/clfswm/xlib-util.lisp	2008/02/29 23:05:56	1.7
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sun Feb 24 11:24:46 2008
+;;; #Date#: Thu Feb 28 21:55:00 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility functions
@@ -57,17 +57,15 @@
 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.
-Include only those we are ready to support.")
+  "Alist mapping NETWM window types to keywords.")
 
 
 (defmacro with-xlib-protect (&body body)
@@ -254,18 +252,27 @@
 
 
 (defun window-type (window)
-  "Return one of :maxsize, :transient, or :normal."
-  (or (and (xlib:get-property window :WM_TRANSIENT_FOR)
-	   :transient)
-      (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))))
-	   :maxsize)
+  "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)
       :normal))
 
 
 
 
+
 ;; Stolen from Eclipse
 (defun send-configuration-notify (window)
   "Send a synthetic configure notify event to the given window (ICCCM 4.1.5)"