[clfswm-cvs] CVS clfswm

pbrochard pbrochard at common-lisp.net
Fri May 2 19:56:10 UTC 2008


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

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

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

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

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

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

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

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

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

[156 lines skipped]




More information about the clfswm-cvs mailing list