From pbrochard at common-lisp.net  Wed Jun  3 21:43:06 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 03 Jun 2009 17:43:06 -0400
Subject: [clfswm-cvs] r232 - in clfswm: . src
Message-ID: <E1MByEk-0003a0-C1@common-lisp.net>

Author: pbrochard
Date: Wed Jun  3 17:43:06 2009
New Revision: 232

Log:
src/clfswm-placement.lisp: New file. Allow to place info windows or query windows on an arbitrary place. Allow to bannish the pointer on an arbitrary place.

Added:
   clfswm/src/clfswm-placement.lisp
Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/clfswm.asd
   clfswm/src/clfswm-circulate-mode.lisp
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-query.lisp
   clfswm/src/clfswm-second-mode.lisp
   clfswm/src/package.lisp
   clfswm/src/xlib-util.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed Jun  3 17:43:06 2009
@@ -1,3 +1,24 @@
+2009-06-03  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/xlib-util.lisp (banish-pointer): Use with-placement macro to
+	bannish the pointer in an arbitrary place.
+
+	* src/clfswm-info.lisp (info-mode): Use with-placement macro to
+	place the info window in an arbitrary place.
+
+	* src/clfswm-query.lisp (query-enter-function): Use with-placement
+	macro to place the query window in an arbitrary place.
+
+	* src/clfswm-placement.lisp: New file. Allow to place info windows
+	or query windows on an arbitrary place. Allow to bannish the
+	pointer on an arbitrary place.
+
+2009-05-16  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-circulate-mode.lisp (reorder-child)
+	(reorder-brother): Unfocus windows before reordering children or
+	brothers.
+
 2009-05-13  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-circulate-mode.lisp (reorder-brother): Ensure that

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Wed Jun  3 17:43:06 2009
@@ -7,6 +7,12 @@
 ===============
 Should handle these soon.
 
+- Add a hook for banish-pointer -> by default to bottom right corner
+
+- Add a placement hook for all windows (second-mode, info-mode...)
+
+- Alt+button draw on the selected frame if in the root frame
+
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]
    TODO :
    In ~/.clfswmrc:

Modified: clfswm/clfswm.asd
==============================================================================
--- clfswm/clfswm.asd	(original)
+++ clfswm/clfswm.asd	Wed Jun  3 17:43:06 2009
@@ -17,10 +17,12 @@
 				:depends-on ("tools"))
 			 (:file "package"
 				:depends-on ("my-html" "tools" "version"))
+			 (:file "clfswm-placement"
+				:depends-on ("package"))
 			 (:file "keysyms"
 				:depends-on ("package"))
 			 (:file "xlib-util"
-				:depends-on ("package" "keysyms" "tools"))
+				:depends-on ("package" "keysyms" "tools" "clfswm-placement"))
 			 (:file "config"
 				:depends-on ("package" "xlib-util"))
 			 (:file "netwm-util"
@@ -42,18 +44,19 @@
 			 (:file "version"
 				:depends-on ("tools"))
 			 (:file "clfswm-second-mode"
-				:depends-on ("package" "clfswm" "clfswm-internal" "clfswm-generic-mode"))
+				:depends-on ("package" "clfswm" "clfswm-internal" "clfswm-generic-mode"
+						       "clfswm-placement"))
 			 (:file "clfswm-corner"
 				:depends-on ("package" "config" "clfswm-internal"))
 			 (:file "clfswm-info"
 				:depends-on ("package" "version" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal"
 						       "clfswm-autodoc" "clfswm-corner"
-						       "clfswm-generic-mode"))
+						       "clfswm-generic-mode" "clfswm-placement"))
 			 (:file "clfswm-menu"
 				:depends-on ("package" "clfswm-info"))
 			 (:file "clfswm-query"
 				:depends-on ("package" "config" "xlib-util" "clfswm-keys"
-						       "clfswm-generic-mode"))
+						       "clfswm-generic-mode" "clfswm-placement"))
 			 (:file "clfswm-util"
 				:depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode" "clfswm-query" "clfswm-menu" "clfswm-autodoc" "clfswm-corner"))
 			 (:file "clfswm-layout"

Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp	(original)
+++ clfswm/src/clfswm-circulate-mode.lisp	Wed Jun  3 17:43:06 2009
@@ -69,6 +69,7 @@
 
 
 (defun reorder-child (direction)
+  (no-focus)
   (with-slots (child) *current-child*
     (unless *circulate-orig*
       (reset-circulate-child))
@@ -81,6 +82,7 @@
 
 
 (defun reorder-brother (direction)
+  (no-focus)
   (let ((frame-is-root? (and (equal *current-root* *current-child*)
 			     (not (equal *current-root* *root-frame*)))))
     (if frame-is-root?

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Wed Jun  3 17:43:06 2009
@@ -188,7 +188,7 @@
 ;;;| Main mode
 ;;;`-----
 
-(defun info-mode (info-list &key (x 0) (y 0) (width nil) (height nil))
+(defun info-mode (info-list &key (width nil) (height nil))
   "Open the info mode. Info-list is a list of info: One string per line
 Or for colored output: a list (line_string color)
 Or ((1_word color) (2_word color) 3_word (4_word color)...)"
@@ -203,74 +203,77 @@
 					       (t (length l)))))))
 			 (t (length (first line)))))
 		 (t (length line)))))
-      (let* ((pointer-grabbed-p (xgrab-pointer-p))
-	     (keyboard-grabbed-p (xgrab-keyboard-p))
-	     (font (xlib:open-font *display* *info-font-string*))
+      (let* ((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 (compute-size l)) 2) ilw)
-							 (- (xlib:screen-width *screen*) 2 x)))
-					 :height (or height
-						     (min (round (+ (* (length info-list) ilh) (/ ilh 2)))
-							  (- (xlib:screen-height *screen*) 2 y)))
-					 :background (get-color *info-background*)
-					 :colormap (xlib:screen-default-colormap *screen*)
-					 :border-width 1
-					 :border (get-color *info-border*)
-					 :event-mask '(:exposure)))
-	     (gc (xlib:create-gcontext :drawable window
-				       :foreground (get-color *info-foreground*)
-				       :background (get-color *info-background*)
-				       :font font
-				       :line-style :solid))
-	     (info (make-info :window window :gc gc :x 0 :y 0 :list info-list
-			      :font font :ilw ilw :ilh ilh
-			      :max-x (* (loop for l in info-list maximize (compute-size l)) ilw)
-			      :max-y (* (length info-list) ilh))))
-	(labels ((handle-key (&rest event-slots &key root code state &allow-other-keys)
-		   (declare (ignore event-slots root))
-		   (funcall-key-from-code *info-keys* code state info))
-		 (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
-		   (declare (ignore event-slots))
-		   (unless (compress-motion-notify)
-		     (funcall-button-from-code *info-mouse* 'motion (modifiers->state *default-modifiers*)
-					       window root-x root-y *fun-press* (list info))))
-		 (handle-button-press (&rest event-slots &key window root-x root-y code state &allow-other-keys)
-		   (declare (ignore event-slots))
-		   (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-press* (list info)))
-		 (handle-button-release (&rest event-slots &key window root-x root-y code state &allow-other-keys)
-		   (declare (ignore event-slots))
-		   (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-release* (list info))))
-	  (map-window window)
-	  (draw-info-window info)
-	  (xgrab-pointer *root* 68 69)
-	  (unless keyboard-grabbed-p
-	    (xgrab-keyboard *root*))
-	  (generic-mode 'exit-info-loop
-			:loop-function (lambda ()
-					 (raise-window (info-window info)))
-			:button-press-hook #'handle-button-press
-			:button-release-hook #'handle-button-release
-			:motion-notify-hook #'handle-motion-notify
-			:key-press-hook #'handle-key)
-	  (if pointer-grabbed-p
-	      (xgrab-pointer *root* 66 67)
-	      (xungrab-pointer))
-	  (unless keyboard-grabbed-p
-	    (xungrab-keyboard))
-	  (xlib:free-gcontext gc)
-	  (xlib:destroy-window window)
-	  (xlib:close-font font)
-	  (display-all-frame-info)
-	  (wait-no-key-or-button-press))))))
+	     (width (or width
+			(min (* (+ (loop for l in info-list maximize (compute-size l)) 2) ilw)
+			     (xlib:screen-width *screen*))))
+	     (height (or height
+			 (min (round (+ (* (length info-list) ilh) (/ ilh 2)))
+			      (xlib:screen-height *screen*)))))
+	(with-placement (*info-mode-placement* x y width height)
+	  (let* ((pointer-grabbed-p (xgrab-pointer-p))
+		 (keyboard-grabbed-p (xgrab-keyboard-p))
+		 (window (xlib:create-window :parent *root*
+					     :x x :y y
+					     :width width
+					     :height height
+					     :background (get-color *info-background*)
+					     :colormap (xlib:screen-default-colormap *screen*)
+					     :border-width 1
+					     :border (get-color *info-border*)
+					     :event-mask '(:exposure)))
+		 (gc (xlib:create-gcontext :drawable window
+					   :foreground (get-color *info-foreground*)
+					   :background (get-color *info-background*)
+					   :font font
+					   :line-style :solid))
+		 (info (make-info :window window :gc gc :x 0 :y 0 :list info-list
+				  :font font :ilw ilw :ilh ilh
+				  :max-x (* (loop for l in info-list maximize (compute-size l)) ilw)
+				  :max-y (* (length info-list) ilh))))
+	    (labels ((handle-key (&rest event-slots &key root code state &allow-other-keys)
+		       (declare (ignore event-slots root))
+		       (funcall-key-from-code *info-keys* code state info))
+		     (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+		       (declare (ignore event-slots))
+		       (unless (compress-motion-notify)
+			 (funcall-button-from-code *info-mouse* 'motion (modifiers->state *default-modifiers*)
+						   window root-x root-y *fun-press* (list info))))
+		     (handle-button-press (&rest event-slots &key window root-x root-y code state &allow-other-keys)
+		       (declare (ignore event-slots))
+		       (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-press* (list info)))
+		     (handle-button-release (&rest event-slots &key window root-x root-y code state &allow-other-keys)
+		       (declare (ignore event-slots))
+		       (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-release* (list info))))
+	      (map-window window)
+	      (draw-info-window info)
+	      (xgrab-pointer *root* 68 69)
+	      (unless keyboard-grabbed-p
+		(xgrab-keyboard *root*))
+	      (generic-mode 'exit-info-loop
+			    :loop-function (lambda ()
+					     (raise-window (info-window info)))
+			    :button-press-hook #'handle-button-press
+			    :button-release-hook #'handle-button-release
+			    :motion-notify-hook #'handle-motion-notify
+			    :key-press-hook #'handle-key)
+	      (if pointer-grabbed-p
+		  (xgrab-pointer *root* 66 67)
+		  (xungrab-pointer))
+	      (unless keyboard-grabbed-p
+		(xungrab-keyboard))
+	      (xlib:free-gcontext gc)
+	      (xlib:destroy-window window)
+	      (xlib:close-font font)
+	      (display-all-frame-info)
+	      (wait-no-key-or-button-press))))))))
 
 
 
 
-(defun info-mode-menu (item-list &key (x 0) (y 0) (width nil) (height nil))
+(defun info-mode-menu (item-list &key (width nil) (height nil))
   "Open an info help menu.
 Item-list is: '((key function) separator (key function))
 or with explicit docstring: '((key function \"documentation 1\") (key function \"bla bla\") (key function))
@@ -299,7 +302,7 @@
 			     info-list)
 		       (define-key key function)))))
 	  (t (push (list (format nil "-=- ~A -=-" item) *menu-color-comment*) info-list))))
-      (info-mode (nreverse info-list) :x x :y y :width width :height height)
+      (info-mode (nreverse info-list) :width width :height height)
       (dolist (item item-list)
 	(when (consp item)
 	  (let ((key (first item)))

Added: clfswm/src/clfswm-placement.lisp
==============================================================================
--- (empty file)
+++ clfswm/src/clfswm-placement.lisp	Wed Jun  3 17:43:06 2009
@@ -0,0 +1,181 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Placement functions
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(defun get-placement-values (placement &optional (width 0) (height 0))
+  (typecase placement
+    (list (values (first placement)
+		  (second placement)))
+    (function (funcall placement width height))
+    (symbol
+     (if (fboundp placement)
+	 (funcall placement width height)
+	 (values 0 0)))
+    (t (values 0 0))))
+
+(defmacro with-placement ((placement x y &optional (width 0) (height 0)) &body body)
+  `(multiple-value-bind (,x ,y)
+       (get-placement-values ,placement ,width ,height)
+     , at body))
+
+;;;; Test functions
+;;
+;;(defun fun-placement (&optional width height)
+;;  (declare (ignore width height))
+;;  (values 30 40))
+;;
+;;(defparameter *placement-test* (list 10 20))
+;;;;(defparameter *placement-test* #'fun-placement)
+;;;;(defparameter *placement-test* 'fun-placement)
+;;
+;;(defun toto ()
+;;  (with-placement (*placement-test* x y)
+;;    (format t "X=~A  Y=~A~%" x y)))
+
+;;;
+;;; Absolute placement
+;;;
+(defun top-left-placement (&optional (width 0) (height 0))
+  (declare (ignore width height))
+  (values 0 0))
+
+(defun top-middle-placement (&optional (width 0) (height 0))
+  (declare (ignore height))
+  (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
+	  0))
+
+(defun top-right-placement (&optional (width 0) (height 0))
+  (declare (ignore height))
+  (values (- (xlib:screen-width *screen*) width 1)
+	  0))
+
+
+
+(defun middle-left-placement (&optional (width 0) (height 0))
+  (declare (ignore width))
+  (values 0
+	  (truncate (/ (- (xlib:screen-height *screen*) height) 2))))
+
+(defun middle-middle-placement (&optional (width 0) (height 0))
+  (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
+	  (truncate (/ (- (xlib:screen-height *screen*) height) 2))))
+
+(defun middle-right-placement (&optional (width 0) (height 0))
+  (values (- (xlib:screen-width *screen*) width 1)
+	  (truncate (/ (- (xlib:screen-height *screen*) height) 2))))
+
+
+(defun bottom-left-placement (&optional (width 0) (height 0))
+  (declare (ignore width))
+  (values 0
+	  (- (xlib:screen-height *screen*) height 1)))
+
+(defun bottom-middle-placement (&optional (width 0) (height 0))
+  (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
+	  (- (xlib:screen-height *screen*) height 1)))
+
+(defun bottom-right-placement (&optional (width 0) (height 0))
+  (values (- (xlib:screen-width *screen*) width 1)
+	  (- (xlib:screen-height *screen*) height 1)))
+
+
+;;;
+;;; Current child placement
+;;;
+(defun current-child-coord ()
+  (typecase *current-child*
+    (xlib:window (values (xlib:drawable-x *current-child*)
+			 (xlib:drawable-y *current-child*)
+			 (xlib:drawable-width *current-child*)
+			 (xlib:drawable-height *current-child*)))
+    (frame (values (frame-rx *current-child*)
+		   (frame-ry *current-child*)
+		   (frame-rw *current-child*)
+		   (frame-rh *current-child*)))
+    (t (values 0 0 10 10))))
+
+(defmacro with-current-child-coord ((x y w h) &body body)
+  `(multiple-value-bind (,x ,y ,w ,h)
+       (current-child-coord)
+     , at body))
+
+
+(defun top-left-child-placement (&optional (width 0) (height 0))
+  (declare (ignore width height))
+  (with-current-child-coord (x y w h)
+    (declare (ignore w h))
+    (values x y)))
+
+(defun top-middle-child-placement (&optional (width 0) (height 0))
+  (declare (ignore height))
+  (with-current-child-coord (x y w h)
+    (declare (ignore h))
+    (values (+ x (truncate (/ (- w width) 2)))
+	    y)))
+
+(defun top-right-child-placement (&optional (width 0) (height 0))
+  (declare (ignore height))
+  (with-current-child-coord (x y w h)
+    (declare (ignore h))
+    (values (+ x (- w width))
+	    y)))
+
+
+
+(defun middle-left-child-placement (&optional (width 0) (height 0))
+  (declare (ignore width))
+  (with-current-child-coord (x y w h)
+    (declare (ignore w))
+    (values x
+	    (+ y (truncate (/ (- h height) 2))))))
+
+(defun middle-middle-child-placement (&optional (width 0) (height 0))
+  (with-current-child-coord (x y w h)
+    (values (+ x (truncate (/ (- w width) 2)))
+	    (+ y (truncate (/ (- h height) 2))))))
+
+(defun middle-right-child-placement (&optional (width 0) (height 0))
+  (with-current-child-coord (x y w h)
+    (values (+ x (- w width))
+	    (+ y (truncate (/ (- h height) 2))))))
+
+
+(defun bottom-left-child-placement (&optional (width 0) (height 0))
+  (declare (ignore width))
+  (with-current-child-coord (x y w h)
+    (declare (ignore w))
+    (values x
+	    (+ y (- h height)))))
+
+(defun bottom-middle-child-placement (&optional (width 0) (height 0))
+  (with-current-child-coord (x y w h)
+    (values (+ x (truncate (/ (- w width) 2)))
+	    (+ y (- h height)))))
+
+(defun bottom-right-child-placement (&optional (width 0) (height 0))
+  (with-current-child-coord (x y w h)
+    (values (+ x (- w width))
+	    (+ y (- h height)))))

Modified: clfswm/src/clfswm-query.lisp
==============================================================================
--- clfswm/src/clfswm-query.lisp	(original)
+++ clfswm/src/clfswm-query.lisp	Wed Jun  3 17:43:06 2009
@@ -107,24 +107,27 @@
 
 
 (defun query-enter-function ()
-  (setf *query-font* (xlib:open-font *display* *query-font-string*)
-	*query-window* (xlib:create-window :parent *root*
-					   :x 0 :y 0
-					   :width (- (xlib:screen-width *screen*) 2)
-					   :height (* 3 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*)))
-					   :background (get-color *query-background*)
-					   :border-width 1
-					   :border (get-color *query-border*)
-					   :colormap (xlib:screen-default-colormap *screen*)
-					   :event-mask '(:exposure :key-press))
-	*query-gc* (xlib:create-gcontext :drawable *query-window*
-					 :foreground (get-color *query-foreground*)
-					 :background (get-color *query-background*)
-					 :font *query-font*
-					 :line-style :solid))
-  (map-window *query-window*)
-  (query-print-string)
-  (wait-no-key-or-button-press))
+  (let ((width (- (xlib:screen-width *screen*) 2))
+	(height (* 3 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*)))))
+    (with-placement (*query-mode-placement* x y width height)
+      (setf *query-font* (xlib:open-font *display* *query-font-string*)
+	    *query-window* (xlib:create-window :parent *root*
+					       :x x :y y
+					       :width width
+					       :height height
+					       :background (get-color *query-background*)
+					       :border-width 1
+					       :border (get-color *query-border*)
+					       :colormap (xlib:screen-default-colormap *screen*)
+					       :event-mask '(:exposure :key-press))
+	    *query-gc* (xlib:create-gcontext :drawable *query-window*
+					     :foreground (get-color *query-foreground*)
+					     :background (get-color *query-background*)
+					     :font *query-font*
+					     :line-style :solid))
+      (map-window *query-window*)
+      (query-print-string)
+      (wait-no-key-or-button-press))))
 
 
 (defun query-leave-function ()

Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp	(original)
+++ clfswm/src/clfswm-second-mode.lisp	Wed Jun  3 17:43:06 2009
@@ -197,22 +197,22 @@
 
 
 (defun sm-enter-function ()
-  (setf *in-second-mode* t
-	*sm-window* (xlib:create-window :parent *root*
-					:x (truncate (/ (- (xlib:screen-width *screen*) *sm-width*) 2))
-					:y 0
-					:width *sm-width* :height *sm-height*
+  (with-placement (*second-mode-placement* x y *sm-width* *sm-height*)
+    (setf *in-second-mode* t
+	  *sm-window* (xlib:create-window :parent *root*
+					  :x x :y y
+					  :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*)
-					: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))
+					:font *sm-font*
+					:line-style :solid)))
   (map-window *sm-window*)
   (draw-second-mode-window)
   (no-focus)

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Wed Jun  3 17:43:06 2009
@@ -94,8 +94,6 @@
   "Config(): Default mouse focus policy. One of :click, :sloppy, :sloppy-strict or :sloppy-select.")
 
 
-
-
 (defclass frame ()
   ((name :initarg :name :accessor frame-name :initform nil)
    (number :initarg :number :accessor frame-number :initform 0)
@@ -244,6 +242,24 @@
 (defparameter *vt-keyboard-on* nil)
 (defparameter *clfswm-terminal* nil)
 
+
+;;; Placement variables. A list of two absolute coordinates
+;;; or a function: 'Y-X-placement' for absolute placement or
+;;; 'Y-X-child-placement' for child relative placement.
+;;; Where Y-X are one of:
+;;;
+;;; top-left     top-middle     top-right
+;;; middle-left  middle-middle  middle-right
+;;; bottom-left  bottom-middle  bottom-right
+;;;
+(defparameter *banish-pointer-placement* 'bottom-left-placement)
+(defparameter *second-mode-placement* 'top-middle-child-placement)
+(defparameter *info-mode-placement* 'top-middle-child-placement)
+(defparameter *query-mode-placement* 'bottom-left-placement)
+
+
+
+
 ;; For debug - redefine defun
 ;;(shadow :defun)
 ;;

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Wed Jun  3 17:43:06 2009
@@ -86,11 +86,8 @@
 
 (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*))))
-
-
+  (with-placement (*banish-pointer-placement* x y)
+    (xlib:warp-pointer *root* x y)))
 
 
 



From pbrochard at common-lisp.net  Wed Jun  3 21:48:08 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 03 Jun 2009 17:48:08 -0400
Subject: [clfswm-cvs] r233 - clfswm/src
Message-ID: <E1MByJc-00045t-C7@common-lisp.net>

Author: pbrochard
Date: Wed Jun  3 17:48:08 2009
New Revision: 233

Log:
package.lisp: fixe default placements

Modified:
   clfswm/src/package.lisp

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Wed Jun  3 17:48:08 2009
@@ -252,10 +252,10 @@
 ;;; middle-left  middle-middle  middle-right
 ;;; bottom-left  bottom-middle  bottom-right
 ;;;
-(defparameter *banish-pointer-placement* 'bottom-left-placement)
+(defparameter *banish-pointer-placement* 'bottom-left-child-placement)
 (defparameter *second-mode-placement* 'top-middle-child-placement)
-(defparameter *info-mode-placement* 'top-middle-child-placement)
-(defparameter *query-mode-placement* 'bottom-left-placement)
+(defparameter *info-mode-placement* 'top-left-child-placement)
+(defparameter *query-mode-placement* 'top-left-child-placement)
 
 
 



From pbrochard at common-lisp.net  Wed Jun  3 21:51:25 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 03 Jun 2009 17:51:25 -0400
Subject: [clfswm-cvs] r234 - in clfswm: . src
Message-ID: <E1MByMn-0004JS-7s@common-lisp.net>

Author: pbrochard
Date: Wed Jun  3 17:51:24 2009
New Revision: 234

Log:
fixe TODO and bannish pointer placement

Modified:
   clfswm/TODO
   clfswm/src/package.lisp

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Wed Jun  3 17:51:24 2009
@@ -7,10 +7,6 @@
 ===============
 Should handle these soon.
 
-- Add a hook for banish-pointer -> by default to bottom right corner
-
-- Add a placement hook for all windows (second-mode, info-mode...)
-
 - Alt+button draw on the selected frame if in the root frame
 
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Wed Jun  3 17:51:24 2009
@@ -252,7 +252,7 @@
 ;;; middle-left  middle-middle  middle-right
 ;;; bottom-left  bottom-middle  bottom-right
 ;;;
-(defparameter *banish-pointer-placement* 'bottom-left-child-placement)
+(defparameter *banish-pointer-placement* 'bottom-right-child-placement)
 (defparameter *second-mode-placement* 'top-middle-child-placement)
 (defparameter *info-mode-placement* 'top-left-child-placement)
 (defparameter *query-mode-placement* 'top-left-child-placement)



From pbrochard at common-lisp.net  Thu Jun  4 19:35:36 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Thu, 04 Jun 2009 15:35:36 -0400
Subject: [clfswm-cvs] r235 - in clfswm: . src
Message-ID: <E1MCIiu-0001kj-BA@common-lisp.net>

Author: pbrochard
Date: Thu Jun  4 15:35:31 2009
New Revision: 235

Log:
query-enter-function: Assign font before width and height calculation.

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-query.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Thu Jun  4 15:35:31 2009
@@ -1,3 +1,8 @@
+2009-06-04  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-query.lisp (query-enter-function): Assign font before
+	width and height calculation.
+
 2009-06-03  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/xlib-util.lisp (banish-pointer): Use with-placement macro to

Modified: clfswm/src/clfswm-query.lisp
==============================================================================
--- clfswm/src/clfswm-query.lisp	(original)
+++ clfswm/src/clfswm-query.lisp	Thu Jun  4 15:35:31 2009
@@ -107,11 +107,11 @@
 
 
 (defun query-enter-function ()
+  (setf *query-font* (xlib:open-font *display* *query-font-string*))
   (let ((width (- (xlib:screen-width *screen*) 2))
 	(height (* 3 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*)))))
     (with-placement (*query-mode-placement* x y width height)
-      (setf *query-font* (xlib:open-font *display* *query-font-string*)
-	    *query-window* (xlib:create-window :parent *root*
+      (setf *query-window* (xlib:create-window :parent *root*
 					       :x x :y y
 					       :width width
 					       :height height



From pbrochard at common-lisp.net  Tue Jun 16 19:38:32 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 16 Jun 2009 15:38:32 -0400
Subject: [clfswm-cvs] r236 - in clfswm: . src
Message-ID: <E1MGeUK-0004yA-1V@common-lisp.net>

Author: pbrochard
Date: Tue Jun 16 15:38:30 2009
New Revision: 236

Log:
*-child-placement: Adjust coordinates to one pixel in the current child.

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-placement.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Jun 16 15:38:30 2009
@@ -1,3 +1,8 @@
+2009-06-16  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-placement.lisp (*-child-placement): Adjust
+	coordinates to one pixel in the current child.
+
 2009-06-04  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-query.lisp (query-enter-function): Assign font before

Modified: clfswm/src/clfswm-placement.lisp
==============================================================================
--- clfswm/src/clfswm-placement.lisp	(original)
+++ clfswm/src/clfswm-placement.lisp	Tue Jun 16 15:38:30 2009
@@ -127,21 +127,22 @@
   (declare (ignore width height))
   (with-current-child-coord (x y w h)
     (declare (ignore w h))
-    (values x y)))
+    (values (1+ x)
+	    (1+ y))))
 
 (defun top-middle-child-placement (&optional (width 0) (height 0))
   (declare (ignore height))
   (with-current-child-coord (x y w h)
     (declare (ignore h))
     (values (+ x (truncate (/ (- w width) 2)))
-	    y)))
+	    (1+ y))))
 
 (defun top-right-child-placement (&optional (width 0) (height 0))
   (declare (ignore height))
   (with-current-child-coord (x y w h)
     (declare (ignore h))
-    (values (+ x (- w width))
-	    y)))
+    (values (+ x (- w width 1))
+	    (1+ y))))
 
 
 
@@ -149,7 +150,7 @@
   (declare (ignore width))
   (with-current-child-coord (x y w h)
     (declare (ignore w))
-    (values x
+    (values (1+ x)
 	    (+ y (truncate (/ (- h height) 2))))))
 
 (defun middle-middle-child-placement (&optional (width 0) (height 0))
@@ -159,7 +160,7 @@
 
 (defun middle-right-child-placement (&optional (width 0) (height 0))
   (with-current-child-coord (x y w h)
-    (values (+ x (- w width))
+    (values (+ x (- w width 1))
 	    (+ y (truncate (/ (- h height) 2))))))
 
 
@@ -167,15 +168,15 @@
   (declare (ignore width))
   (with-current-child-coord (x y w h)
     (declare (ignore w))
-    (values x
-	    (+ y (- h height)))))
+    (values (1+ x)
+	    (+ y (- h height 1)))))
 
 (defun bottom-middle-child-placement (&optional (width 0) (height 0))
   (with-current-child-coord (x y w h)
     (values (+ x (truncate (/ (- w width) 2)))
-	    (+ y (- h height)))))
+	    (+ y (- h height 1)))))
 
 (defun bottom-right-child-placement (&optional (width 0) (height 0))
   (with-current-child-coord (x y w h)
-    (values (+ x (- w width))
-	    (+ y (- h height)))))
+    (values (+ x (- w width 1))
+	    (+ y (- h height 1)))))



From pbrochard at common-lisp.net  Tue Jun 16 20:22:50 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 16 Jun 2009 16:22:50 -0400
Subject: [clfswm-cvs] r237 - in clfswm: . src
Message-ID: <E1MGfBC-0000PI-Sz@common-lisp.net>

Author: pbrochard
Date: Tue Jun 16 16:22:49 2009
New Revision: 237

Log:
get-fullscreen-size: Adjust default fullscreen sizes.

Modified:
   clfswm/ChangeLog
   clfswm/src/config.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Jun 16 16:22:49 2009
@@ -1,5 +1,8 @@
 2009-06-16  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/config.lisp (get-fullscreen-size): Adjust default fullscreen
+	sizes.
+
 	* src/clfswm-placement.lisp (*-child-placement): Adjust
 	coordinates to one pixel in the current child.
 

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Tue Jun 16 16:22:49 2009
@@ -59,7 +59,7 @@
 (defun get-fullscreen-size ()
   "Return the size of root child (values rx ry rw rh)
 You can tweak this to what you want"
-  (values -2 -2 (+ (xlib:screen-width *screen*) 2) (+ (xlib:screen-height *screen*) 2)))
+  (values -1 -1 (+ (xlib:screen-width *screen*)) (+ (xlib:screen-height *screen*))))
   ;;(values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*)))
 ;; (values -1 -1 1024 768))
 ;;  (values 100 100 800 600))



From pbrochard at common-lisp.net  Tue Jun 16 20:27:20 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 16 Jun 2009 16:27:20 -0400
Subject: [clfswm-cvs] r238 - in clfswm: . src
Message-ID: <E1MGfFY-0000UD-7u@common-lisp.net>

Author: pbrochard
Date: Tue Jun 16 16:27:19 2009
New Revision: 238

Log:
draw-circulate-mode-window: Ensure that all characters are printable.

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-circulate-mode.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Jun 16 16:27:19 2009
@@ -1,5 +1,8 @@
 2009-06-16  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-circulate-mode.lisp (draw-circulate-mode-window):
+	Ensure that all characters are printable.
+
 	* src/config.lisp (get-fullscreen-size): Adjust default fullscreen
 	sizes.
 

Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp	(original)
+++ clfswm/src/clfswm-circulate-mode.lisp	Tue Jun 16 16:27:19 2009
@@ -39,8 +39,8 @@
   (raise-window *circulate-window*)
   (clear-pixmap-buffer *circulate-window* *circulate-gc*)
   (let* ((text (format nil "Current: ~A  Focus: ~A"
-		       (child-fullname *current-child*)
-		       (child-fullname (xlib:input-focus *display*))))
+		       (ensure-printable (child-fullname *current-child*))
+		       (ensure-printable (child-fullname (xlib:input-focus *display*)))))
 	 (len (length text)))
     (xlib:draw-glyphs *pixmap-buffer* *circulate-gc*
 		      (truncate (/ (- *circulate-width* (* (xlib:max-char-width *circulate-font*) len)) 2))



From pbrochard at common-lisp.net  Tue Jun 16 21:05:10 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 16 Jun 2009 17:05:10 -0400
Subject: [clfswm-cvs] r239 - clfswm/src
Message-ID: <E1MGfqA-0002wZ-Rw@common-lisp.net>

Author: pbrochard
Date: Tue Jun 16 17:05:07 2009
New Revision: 239

Log:
clfswm-circulate-mode: Adjust circulate-mode-placement

Modified:
   clfswm/src/clfswm-circulate-mode.lisp
   clfswm/src/clfswm-internal.lisp
   clfswm/src/config.lisp
   clfswm/src/package.lisp
   clfswm/src/tools.lisp

Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp	(original)
+++ clfswm/src/clfswm-circulate-mode.lisp	Tue Jun 16 17:05:07 2009
@@ -38,9 +38,11 @@
 (defun draw-circulate-mode-window ()
   (raise-window *circulate-window*)
   (clear-pixmap-buffer *circulate-window* *circulate-gc*)
-  (let* ((text (format nil "Current: ~A  Focus: ~A"
-		       (ensure-printable (child-fullname *current-child*))
-		       (ensure-printable (child-fullname (xlib:input-focus *display*)))))
+  (let* ((text (format nil "~A [~A]"
+		       (limit-length (ensure-printable (child-name (xlib:input-focus *display*)))
+				     *circulate-text-limite*)
+		       (limit-length (ensure-printable (child-name *current-child*))
+				     *circulate-text-limite*)))
 	 (len (length text)))
     (xlib:draw-glyphs *pixmap-buffer* *circulate-gc*
 		      (truncate (/ (- *circulate-width* (* (xlib:max-char-width *circulate-font*) len)) 2))
@@ -140,13 +142,14 @@
 
 (defun set-default-circulate-keys ()
   (define-circulate-key ("Escape") 'leave-circulate-mode)
+  (define-circulate-key ("g" :control) 'leave-circulate-mode)
+  (define-circulate-key ("Escape" :alt) 'leave-circulate-mode)
+  (define-circulate-key ("g" :control :alt) 'leave-circulate-mode)
   (define-circulate-key ("Tab" :mod-1) 'circulate-select-next-child)
   (define-circulate-key ("Tab" :mod-1 :shift) 'circulate-select-previous-child)
   (define-circulate-key ("Iso_Left_Tab" :mod-1 :shift) 'circulate-select-previous-child)
   (define-circulate-key ("Right" :mod-1) 'circulate-select-next-brother)
   (define-circulate-key ("Left" :mod-1) 'circulate-select-previous-brother)
-
-
   (define-circulate-release-key ("Alt_L" :alt) 'leave-circulate-mode))
 
 
@@ -201,45 +204,46 @@
 (defun circulate-mode (&key child-direction brother-direction)
   (setf *circulate-hit* 0)
   (set-circulate-leave-key)
-  (setf *circulate-font* (xlib:open-font *display* *circulate-font-string*)
-	*circulate-window* (xlib:create-window :parent *root*
-					       :x (truncate (/ (- (xlib:screen-width *screen*) *circulate-width*) 2))
-					       :y (- (xlib:screen-height *screen*) *circulate-height* 2)
-					       :width *circulate-width*
-					       :height *circulate-height*
+  (with-placement (*circulate-mode-placement* x y *circulate-width* *circulate-height*)
+    (setf *circulate-font* (xlib:open-font *display* *circulate-font-string*)
+	  *circulate-window* (xlib:create-window :parent *root*
+						 :x x
+						 :y y
+						 :width *circulate-width*
+						 :height *circulate-height*
+						 :background (get-color *circulate-background*)
+						 :border-width 1
+						 :border (get-color *circulate-border*)
+						 :colormap (xlib:screen-default-colormap *screen*)
+						 :event-mask '(:exposure :key-press))
+	  *circulate-gc* (xlib:create-gcontext :drawable *circulate-window*
+					       :foreground (get-color *circulate-foreground*)
 					       :background (get-color *circulate-background*)
-					       :border-width 1
-					       :border (get-color *circulate-border*)
-					       :colormap (xlib:screen-default-colormap *screen*)
-					       :event-mask '(:exposure :key-press))
-	*circulate-gc* (xlib:create-gcontext :drawable *circulate-window*
-					     :foreground (get-color *circulate-foreground*)
-					     :background (get-color *circulate-background*)
-					     :font *circulate-font*
-					     :line-style :solid))
-  (map-window *circulate-window*)
-  (draw-circulate-mode-window)
-  (when child-direction
-    (reorder-child child-direction))
-  (when brother-direction
-    (reorder-brother brother-direction))
-  (let ((grab-keyboard-p (xgrab-keyboard-p))
-	(grab-pointer-p (xgrab-pointer-p)))
-    (xgrab-pointer *root* 92 93)
-    (unless grab-keyboard-p
-      (ungrab-main-keys)
-      (xgrab-keyboard *root*))
-    (generic-mode 'exit-circulate-loop
-		  :loop-function #'circulate-loop-function
-		  :leave-function #'circulate-leave-function
-		  :key-press-hook #'circulate-handle-key-press
-		  :key-release-hook #'circulate-handle-key-release)
-    (unless grab-keyboard-p
-      (xungrab-keyboard)
-      (grab-main-keys))
-    (if grab-pointer-p
-	(xgrab-pointer *root* 66 67)
-	(xungrab-pointer))))
+					       :font *circulate-font*
+					       :line-style :solid))
+    (map-window *circulate-window*)
+    (draw-circulate-mode-window)
+    (when child-direction
+      (reorder-child child-direction))
+    (when brother-direction
+      (reorder-brother brother-direction))
+    (let ((grab-keyboard-p (xgrab-keyboard-p))
+	  (grab-pointer-p (xgrab-pointer-p)))
+      (xgrab-pointer *root* 92 93)
+      (unless grab-keyboard-p
+	(ungrab-main-keys)
+	(xgrab-keyboard *root*))
+      (generic-mode 'exit-circulate-loop
+		    :loop-function #'circulate-loop-function
+		    :leave-function #'circulate-leave-function
+		    :key-press-hook #'circulate-handle-key-press
+		    :key-release-hook #'circulate-handle-key-release)
+      (unless grab-keyboard-p
+	(xungrab-keyboard)
+	(grab-main-keys))
+      (if grab-pointer-p
+	  (xgrab-pointer *root* 66 67)
+	  (xungrab-pointer)))))
 
 
 (defun select-next-child ()

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Tue Jun 16 17:05:07 2009
@@ -469,6 +469,7 @@
 		(xlib:drawable-y window) ny
 		(xlib:drawable-width window) nw
 		(xlib:drawable-height window) nh)
+	  (xlib:display-finish-output *display*)
 	  change)))))
 
 
@@ -488,6 +489,7 @@
 		(xlib:drawable-y window) ry
 		(xlib:drawable-width window) rw
 		(xlib:drawable-height window) rh)
+	  (xlib:display-finish-output *display*)
 	  change)))))
 
 (defmethod adapt-child-to-parent (child parent)

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Tue Jun 16 17:05:07 2009
@@ -252,6 +252,10 @@
   "Config(Circulate mode group): Circulate mode window height")
 
 
+(defparameter *circulate-text-limite* 30
+  "Config(Circulate mode group): Maximum text limite in the circulate window")
+
+
 
 ;;; CONFIG - Show key binding colors
 (defparameter *info-color-title* "Magenta"

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Tue Jun 16 17:05:07 2009
@@ -256,6 +256,7 @@
 (defparameter *second-mode-placement* 'top-middle-child-placement)
 (defparameter *info-mode-placement* 'top-left-child-placement)
 (defparameter *query-mode-placement* 'top-left-child-placement)
+(defparameter *circulate-mode-placement* 'bottom-middle-child-placement)
 
 
 

Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp	(original)
+++ clfswm/src/tools.lisp	Tue Jun 16 17:05:07 2009
@@ -52,6 +52,7 @@
 	   :expand-newline
 	   :ensure-list
 	   :ensure-printable
+	   :limit-length
 	   :ensure-n-elems
 	   :begin-with-2-spaces
 	   :string-equal-p
@@ -327,6 +328,9 @@
   "Ensure a string is printable in ascii"
   (or (substitute-if-not new #'standard-char-p (or string "")) ""))
 
+(defun limit-length (string &optional (length 10))
+  (subseq string 0 (min (length string) length)))
+
 
 (defun ensure-n-elems (list n)
   "Ensure that list has exactly n elements"



From pbrochard at common-lisp.net  Thu Jun 18 14:23:57 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Thu, 18 Jun 2009 10:23:57 -0400
Subject: [clfswm-cvs] r240 - in clfswm: . src
Message-ID: <E1MHIWz-0004er-Ct@common-lisp.net>

Author: pbrochard
Date: Thu Jun 18 10:23:56 2009
New Revision: 240

Log:
get-fullscreen-size, *-child-placement: One pixel adjustment (again).

Modified:
   clfswm/ChangeLog
   clfswm/load.lisp
   clfswm/src/clfswm-placement.lisp
   clfswm/src/config.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Thu Jun 18 10:23:56 2009
@@ -1,3 +1,11 @@
+2009-06-18  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/config.lisp (get-fullscreen-size):  One pixel adjustment
+ 	(again).
+
+	* src/clfswm-placement.lisp (*-child-placement): One pixel
+	adjustment (again).
+
 2009-06-16  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-circulate-mode.lisp (draw-circulate-mode-window):

Modified: clfswm/load.lisp
==============================================================================
--- clfswm/load.lisp	(original)
+++ clfswm/load.lisp	Thu Jun 18 10:23:56 2009
@@ -38,7 +38,7 @@
 #+SBCL
 (require :sb-posix)
 
-#+SBCL
+#+(or SBCL ECL)
 (require :clx)
 
 #-ASDF

Modified: clfswm/src/clfswm-placement.lisp
==============================================================================
--- clfswm/src/clfswm-placement.lisp	(original)
+++ clfswm/src/clfswm-placement.lisp	Thu Jun 18 10:23:56 2009
@@ -127,22 +127,22 @@
   (declare (ignore width height))
   (with-current-child-coord (x y w h)
     (declare (ignore w h))
-    (values (1+ x)
-	    (1+ y))))
+    (values (+ x 2)
+	    (+ y 2))))
 
 (defun top-middle-child-placement (&optional (width 0) (height 0))
   (declare (ignore height))
   (with-current-child-coord (x y w h)
     (declare (ignore h))
     (values (+ x (truncate (/ (- w width) 2)))
-	    (1+ y))))
+	    (+ y 2))))
 
 (defun top-right-child-placement (&optional (width 0) (height 0))
   (declare (ignore height))
   (with-current-child-coord (x y w h)
     (declare (ignore h))
-    (values (+ x (- w width 1))
-	    (1+ y))))
+    (values (+ x (- w width 2))
+	    (+ y 2))))
 
 
 
@@ -150,7 +150,7 @@
   (declare (ignore width))
   (with-current-child-coord (x y w h)
     (declare (ignore w))
-    (values (1+ x)
+    (values (+ x 2)
 	    (+ y (truncate (/ (- h height) 2))))))
 
 (defun middle-middle-child-placement (&optional (width 0) (height 0))
@@ -160,7 +160,7 @@
 
 (defun middle-right-child-placement (&optional (width 0) (height 0))
   (with-current-child-coord (x y w h)
-    (values (+ x (- w width 1))
+    (values (+ x (- w width 2))
 	    (+ y (truncate (/ (- h height) 2))))))
 
 
@@ -168,15 +168,15 @@
   (declare (ignore width))
   (with-current-child-coord (x y w h)
     (declare (ignore w))
-    (values (1+ x)
-	    (+ y (- h height 1)))))
+    (values (+ x 2)
+	    (+ y (- h height 2)))))
 
 (defun bottom-middle-child-placement (&optional (width 0) (height 0))
   (with-current-child-coord (x y w h)
     (values (+ x (truncate (/ (- w width) 2)))
-	    (+ y (- h height 1)))))
+	    (+ y (- h height 2)))))
 
 (defun bottom-right-child-placement (&optional (width 0) (height 0))
   (with-current-child-coord (x y w h)
-    (values (+ x (- w width 1))
-	    (+ y (- h height 1)))))
+    (values (+ x (- w width 2))
+	    (+ y (- h height 2)))))

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Thu Jun 18 10:23:56 2009
@@ -59,7 +59,7 @@
 (defun get-fullscreen-size ()
   "Return the size of root child (values rx ry rw rh)
 You can tweak this to what you want"
-  (values -1 -1 (+ (xlib:screen-width *screen*)) (+ (xlib:screen-height *screen*))))
+  (values -2 -2 (+ (xlib:screen-width *screen*) 2) (+ (xlib:screen-height *screen*) 2)))
   ;;(values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*)))
 ;; (values -1 -1 1024 768))
 ;;  (values 100 100 800 600))



From pbrochard at common-lisp.net  Fri Jun 19 19:19:46 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Fri, 19 Jun 2009 15:19:46 -0400
Subject: [clfswm-cvs] r241 - clfswm
Message-ID: <E1MHjco-0004hy-N8@common-lisp.net>

Author: pbrochard
Date: Fri Jun 19 15:19:39 2009
New Revision: 241

Log:
TODO update

Modified:
   clfswm/TODO

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Fri Jun 19 15:19:39 2009
@@ -7,18 +7,16 @@
 ===============
 Should handle these soon.
 
-- Alt+button draw on the selected frame if in the root frame
+- Mouse support in menu
 
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]
    TODO :
    In ~/.clfswmrc:
       ;;;; AUTO-CONFIG - Do not edit those lines by hands: they are overwritten by CLFSWM
-      (defparameter *ma-var* value)
+      (defparameter *my-var* value)
       ...
       ;;;; AUTO-CONFIG End : You can add your configurations below this line.
 
-- Mouse support in menu
-
 - Remote access to the clfswm REPL [Philippe]
    this can be done with net.lisp or via xprop (ie the Stumpwm way).
 



From pbrochard at common-lisp.net  Fri Jun 19 19:41:51 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Fri, 19 Jun 2009 15:41:51 -0400
Subject: [clfswm-cvs] r242 - in clfswm: . doc src
Message-ID: <E1MHjyB-0006O5-Bt@common-lisp.net>

Author: pbrochard
Date: Fri Jun 19 15:41:51 2009
New Revision: 242

Log:
Minor documentation update

Modified:
   clfswm/ChangeLog
   clfswm/doc/keys.html
   clfswm/doc/keys.txt
   clfswm/src/clfswm-autodoc.lisp
   clfswm/src/clfswm-util.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Fri Jun 19 15:41:51 2009
@@ -1,3 +1,8 @@
+2009-06-19  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-autodoc.lisp (produce-doc, produce-doc-html): Minor
+	number key cleanup.
+
 2009-06-18  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/config.lisp (get-fullscreen-size):  One pixel adjustment

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Fri Jun 19 15:41:51 2009
@@ -332,10 +332,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |1|
+          1
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -343,10 +343,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |2|
+          2
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -354,10 +354,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |3|
+          3
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -365,10 +365,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |4|
+          4
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -376,10 +376,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |5|
+          5
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -387,10 +387,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |6|
+          6
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -398,10 +398,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |7|
+          7
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -409,10 +409,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |8|
+          8
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -420,10 +420,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |9|
+          9
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -431,10 +431,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |0|
+          0
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
     </table>
@@ -1173,10 +1173,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |1|
+          1
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -1184,10 +1184,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |2|
+          2
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -1195,10 +1195,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |3|
+          3
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -1206,10 +1206,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |4|
+          4
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -1217,10 +1217,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |5|
+          5
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -1228,10 +1228,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |6|
+          6
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -1239,10 +1239,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |7|
+          7
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -1250,10 +1250,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |8|
+          8
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -1261,10 +1261,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |9|
+          9
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
       <tr>
@@ -1272,10 +1272,10 @@
            Mod-1 
         </td>
         <td align="center" nowrap>
-          |0|
+          0
         </td>
         <td style="color:#0000ff" nowrap>
-          Bind or jump to a slot
+          Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
     </table>
@@ -1625,7 +1625,7 @@
           
         </td>
         <td align="center" nowrap>
-          Clfswm  motion
+          Motion
         </td>
         <td style="color:#0000ff" nowrap>
           Grab text

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Fri Jun 19 15:41:51 2009
@@ -33,16 +33,16 @@
   Shift                Escape          Unhide all hidden windows into the current child
   Mod-1                T               Switch to editing mode
   Control              Less            Switch to editing mode
-  Mod-1                |1|             Bind or jump to a slot
-  Mod-1                |2|             Bind or jump to a slot
-  Mod-1                |3|             Bind or jump to a slot
-  Mod-1                |4|             Bind or jump to a slot
-  Mod-1                |5|             Bind or jump to a slot
-  Mod-1                |6|             Bind or jump to a slot
-  Mod-1                |7|             Bind or jump to a slot
-  Mod-1                |8|             Bind or jump to a slot
-  Mod-1                |9|             Bind or jump to a slot
-  Mod-1                |0|             Bind or jump to a slot
+  Mod-1                1               Bind or jump to a slot (a frame or a window)
+  Mod-1                2               Bind or jump to a slot (a frame or a window)
+  Mod-1                3               Bind or jump to a slot (a frame or a window)
+  Mod-1                4               Bind or jump to a slot (a frame or a window)
+  Mod-1                5               Bind or jump to a slot (a frame or a window)
+  Mod-1                6               Bind or jump to a slot (a frame or a window)
+  Mod-1                7               Bind or jump to a slot (a frame or a window)
+  Mod-1                8               Bind or jump to a slot (a frame or a window)
+  Mod-1                9               Bind or jump to a slot (a frame or a window)
+  Mod-1                0               Bind or jump to a slot (a frame or a window)
 
 
 Mouse buttons actions in main mode:
@@ -118,16 +118,16 @@
                        H               start an xclock
   Shift                Menu            Show all frames info windows
   Control              Menu            Show/Hide the root frame
-  Mod-1                |1|             Bind or jump to a slot
-  Mod-1                |2|             Bind or jump to a slot
-  Mod-1                |3|             Bind or jump to a slot
-  Mod-1                |4|             Bind or jump to a slot
-  Mod-1                |5|             Bind or jump to a slot
-  Mod-1                |6|             Bind or jump to a slot
-  Mod-1                |7|             Bind or jump to a slot
-  Mod-1                |8|             Bind or jump to a slot
-  Mod-1                |9|             Bind or jump to a slot
-  Mod-1                |0|             Bind or jump to a slot
+  Mod-1                1               Bind or jump to a slot (a frame or a window)
+  Mod-1                2               Bind or jump to a slot (a frame or a window)
+  Mod-1                3               Bind or jump to a slot (a frame or a window)
+  Mod-1                4               Bind or jump to a slot (a frame or a window)
+  Mod-1                5               Bind or jump to a slot (a frame or a window)
+  Mod-1                6               Bind or jump to a slot (a frame or a window)
+  Mod-1                7               Bind or jump to a slot (a frame or a window)
+  Mod-1                8               Bind or jump to a slot (a frame or a window)
+  Mod-1                9               Bind or jump to a slot (a frame or a window)
+  Mod-1                0               Bind or jump to a slot (a frame or a window)
 
 
 Mouse buttons actions in second mode:
@@ -171,7 +171,7 @@
                        2               Leave the info mode
                        4               Move one line up
                        5               Move one line down
-                       Clfswm::motion   Grab text
+                       Motion          Grab text
 
 
 

Modified: clfswm/src/clfswm-autodoc.lisp
==============================================================================
--- clfswm/src/clfswm-autodoc.lisp	(original)
+++ clfswm/src/clfswm-autodoc.lisp	Fri Jun 19 15:41:51 2009
@@ -26,6 +26,12 @@
 (in-package :clfswm)
 
 
+(defun is-string-keysym (k)
+  (when (stringp k)
+    (or (parse-integer k :junk-allowed t)
+	(intern (string-upcase k)))))
+
+
 (defun produce-doc-html (hash-table-key-list &optional (stream t))
   "Produce an html doc from a hash-table key"
   (labels ((clean-string (str)
@@ -48,9 +54,7 @@
 					      ,(clean-string (format nil "~{~@(~S ~)~}" (state->modifiers (second k)))))
 					     ("td align=\"center\" nowrap"
 					      ,(clean-string (format nil "~@(~S~)"
-								     (or (and (stringp (first k))
-									      (intern (string-upcase (first k))))
-									 (first k)))))
+								     (or (is-string-keysym (first k)) (first k)))))
 					     ("td style=\"color:#0000FF\" nowrap" ,(documentation (or (first v) (third v)) 'function)))
 					   acc)))
 			       hk)
@@ -101,9 +105,7 @@
 		 (when (consp k)
 		   (format stream "~&  ~20@<~{~@(~A~) ~}~> ~13@<~@(~A~)~>   ~A~%"
 			   (state->modifiers (second k))
-			   (remove #\# (remove #\\ (format nil "~S" (or (and (stringp (first k))
-									     (intern (string-upcase (first k))))
-									(first k)))))
+			   (remove #\# (remove #\\ (format nil "~S" (or (is-string-keysym (first k)) (first k)))))
 			   (documentation (or (first v) (third v)) 'function))))
 	     hk)
     (format stream "~2&"))
@@ -117,7 +119,7 @@
 or
 CLFSWM> (produce-all-docs)~2%"))
 
-			   
+
 
 (defun produce-doc-in-file (filename)
   (format t "Producing text keys documentation in ~S " filename)
@@ -163,7 +165,7 @@
 CLFSWM> (produce-all-docs)~2%")))
 
 
-  
+
 (defun produce-menu-doc-in-file (filename)
   (format t "Producing text menus documentation in ~S " filename)
   (with-open-file (stream filename :direction :output
@@ -216,7 +218,7 @@
 or<br> CLFSWM> (produce-all-docs)"))))
 		    0 stream))))
 
-  
+
 (defun produce-menu-doc-html-in-file (filename)
   (format t "Producing html menus documentation in ~S " filename)
   (with-open-file (stream filename :direction :output
@@ -249,7 +251,7 @@
 or
 CLFSWM> (produce-all-docs)~2%")))
 
-  
+
 (defun produce-corner-doc-in-file (filename)
   (format t "Producing text corner documentation in ~S " filename)
   (with-open-file (stream filename :direction :output
@@ -292,7 +294,7 @@
 or<br> CLFSWM> (produce-all-docs)"))))
 		    0 stream))))
 
-  
+
 (defun produce-corner-doc-html-in-file (filename)
   (format t "Producing html corner documentation in ~S " filename)
   (with-open-file (stream filename :direction :output

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Fri Jun 19 15:41:51 2009
@@ -695,7 +695,7 @@
 	(show-all-children *current-root*))))
 
   (defun bind-or-jump (n)
-    "Bind or jump to a slot"
+    "Bind or jump to a slot (a frame or a window)"
     (setf current-slot (- n 1))
     (let ((default-bind `("b" bind-on-slot
 			      ,(format nil "Bind slot ~A on child: ~A" n (child-fullname *current-child*)))))



From pbrochard at common-lisp.net  Mon Jun 22 20:27:52 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Mon, 22 Jun 2009 16:27:52 -0400
Subject: [clfswm-cvs] r243 - in clfswm: . contrib src
Message-ID: <E1MIq7M-0006l6-TF@common-lisp.net>

Author: pbrochard
Date: Mon Jun 22 16:27:52 2009
New Revision: 243

Log:
contrib/mpd.lisp: New file to handle the Music Player Daemon (MPD)

Added:
   clfswm/contrib/mpd.lisp
Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-circulate-mode.lisp
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/clfswm.lisp
   clfswm/src/config.lisp
   clfswm/src/tools.lisp
   clfswm/src/version.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Mon Jun 22 16:27:52 2009
@@ -1,3 +1,7 @@
+2009-06-22  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* contrib/mpd.lisp: New file to handle the Music Player Daemon (MPD)
+
 2009-06-19  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-autodoc.lisp (produce-doc, produce-doc-html): Minor

Added: clfswm/contrib/mpd.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/mpd.lisp	Mon Jun 22 16:27:52 2009
@@ -0,0 +1,107 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Music Player Daemon (MPD) interface
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2009 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; Documentation: If you want to use this file, just add this line in
+;;; your configuration file:
+;;;
+;;;   (load-contrib "mpd.lisp")
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(format t "Loading MPD code... ")
+
+
+(defun start-sonata ()
+  "Start sonata"
+  (do-shell "exec sonata"))
+
+
+(defun show-mpd-info ()
+  "Show MPD informations"
+  (info-on-shell "MPD informations:" "mpc"))
+
+(defun mpd-previous ()
+  "Play the previous song in the current playlist"
+  (do-shell "mpc prev"))
+
+(defun mpd-next ()
+  "Play the next song in the current playlist"
+  (do-shell "mpc next"))
+
+(defun mpd-toggle ()
+  "Toggles Play/Pause, plays if stopped"
+  (do-shell "mpc toggle"))
+
+(defun mpd-play ()
+  "Start playing"
+  (do-shell "mpc play"))
+
+(defun mpd-stop ()
+  "Stop the currently playing playlists"
+  (do-shell "mpc stop"))
+
+
+(defun mpd-seek-+5% ()
+  "Seeks to +5%"
+  (do-shell "mpc seek +5%")
+  (mpd-menu))
+
+(defun mpd-seek--5% ()
+  "Seeks to -5%"
+  (do-shell "mpc seek -5%")
+  (mpd-menu))
+
+(defun show-mpd-playlist ()
+  "Show the current MPD playlist"
+  (info-on-shell "Current MPD playlist:" "mpc playlist"))
+
+(defun mpd-menu ()
+  "< Open the MPD menu >"
+  (info-mode-menu '((#\i show-mpd-info)
+		    (#\p mpd-previous)
+		    (#\n mpd-next)
+		    (#\t mpd-toggle)
+		    (#\y mpd-play)
+		    (#\k mpd-stop)
+		    (#\x mpd-seek-+5%)
+		    (#\w mpd-seek--5%)
+		    (#\l show-mpd-playlist)
+		    (#\s start-sonata))))
+
+
+(defun add-mpd-menu-to-help-menu ()
+  (setf *help-menu-list* (append *help-menu-list*
+				 `((#\s (mpd-menu ,*menu-color-submenu*))))))
+
+(add-hook *init-hook* 'add-mpd-menu-to-help-menu)
+
+(defun mpd-binding ()
+  (define-main-key ("F2" :alt) 'mpd-menu))
+
+(add-hook *binding-hook* 'mpd-binding)
+
+
+
+(format t "done~%")

Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp	(original)
+++ clfswm/src/clfswm-circulate-mode.lisp	Mon Jun 22 16:27:52 2009
@@ -171,9 +171,13 @@
 
 
 (defun circulate-leave-function ()
-  (xlib:destroy-window *circulate-window*)
-  (xlib:close-font *circulate-font*)
-  (xlib:display-finish-output *display*))
+  (when *circulate-window*
+    (xlib:destroy-window *circulate-window*))
+  (when *circulate-font*
+    (xlib:close-font *circulate-font*))
+  (xlib:display-finish-output *display*)
+  (setf *circulate-window* nil
+	*circulate-font* nil))
 
 (defun circulate-loop-function ()
   ;;; Check if the key modifier is alway pressed
@@ -238,6 +242,7 @@
 		    :leave-function #'circulate-leave-function
 		    :key-press-hook #'circulate-handle-key-press
 		    :key-release-hook #'circulate-handle-key-release)
+      (circulate-leave-function)
       (unless grab-keyboard-p
 	(xungrab-keyboard)
 	(grab-main-keys))

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Mon Jun 22 16:27:52 2009
@@ -484,32 +484,15 @@
   (info-mode (list *version*)))
 
 
+
 (defun help-on-clfswm ()
   "Open the help and info window"
-  (info-mode-menu `((#\h show-global-key-binding)
-		    (#\b show-main-mode-key-binding)
-		    (#\c show-corner-help)
-		    (#\g show-config-variable)
-		    (#\d show-date)
-		    (#\p show-cpu-proc)
-		    (#\m show-mem-proc)
-		    (#\x (xmms-info-menu ,*menu-color-submenu*))
-		    (#\v show-version)
-		    (#\i (info-on-cd-menu ,*menu-color-submenu*)))))
+  (info-mode-menu *help-menu-list*))
 
 
 (defun help-on-second-mode ()
   "Open the help and info window for the second mode"
-  (info-mode-menu `((#\h show-global-key-binding)
-		    (#\b show-second-mode-key-binding)
-		    (#\c show-corner-help)
-		    (#\g show-config-variable)
-		    (#\d show-date)
-		    (#\p show-cpu-proc)
-		    (#\m show-mem-proc)
-		    (#\x (xmms-info-menu ,*menu-color-submenu*))
-		    (#\v show-version)
-		    (#\i (info-on-cd-menu ,*menu-color-submenu*)))))
+  (info-mode-menu *help-menu-list*))
 
 
 

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Mon Jun 22 16:27:52 2009
@@ -30,7 +30,7 @@
   (let ((truename (concatenate 'string *contrib-dir* "contrib/" file)))
     (format t "Loading contribution file: ~A~%" truename)
     (when (probe-file truename)
-      (load truename))))
+      (load truename :verbose nil))))
 
 
 (defun reload-clfswm ()

Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp	(original)
+++ clfswm/src/clfswm.lisp	Mon Jun 22 16:27:52 2009
@@ -240,6 +240,7 @@
   (xgrab-init-pointer)
   (xgrab-init-keyboard)
   (init-last-child)
+  (reset-help-menu-list)
   (call-hook *binding-hook*)
   (map-window *no-focus-window*)
   (dbg *display*)

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Mon Jun 22 16:27:52 2009
@@ -280,5 +280,18 @@
   "Config(Menu group): Menu key color in menu")
 
 
+;;; Help menu list
+(defparameter *help-menu-list* nil
+  "Config(Info mode group): List of menus in the help menu")
 
-
+(defun reset-help-menu-list ()
+  (setf *help-menu-list* `((#\h show-global-key-binding)
+			   (#\b show-main-mode-key-binding)
+			   (#\c show-corner-help)
+			   (#\g show-config-variable)
+			   (#\d show-date)
+			   (#\p show-cpu-proc)
+			   (#\m show-mem-proc)
+			   (#\x (xmms-info-menu ,*menu-color-submenu*))
+			   (#\v show-version)
+			   (#\i (info-on-cd-menu ,*menu-color-submenu*)))))
\ No newline at end of file

Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp	(original)
+++ clfswm/src/tools.lisp	Mon Jun 22 16:27:52 2009
@@ -133,7 +133,10 @@
 
 
 (defmacro add-hook (hook &rest value)
-  `(setf ,hook (append ,hook (list , at value))))
+  `(setf ,hook (append (typecase ,hook
+			 (list ,hook)
+			 (t (list ,hook)))
+		       (list , at value))))
 
 (defmacro remove-hook (hook &rest value)
   (let ((i (gensym)))

Modified: clfswm/src/version.lisp
==============================================================================
--- clfswm/src/version.lisp	(original)
+++ clfswm/src/version.lisp	Mon Jun 22 16:27:52 2009
@@ -33,4 +33,4 @@
 
 (in-package :version)
 
-(defparameter *version* #.(concatenate 'string "Version: 0805 built " (date-string)))
+(defparameter *version* #.(concatenate 'string "Version: 0906 built " (date-string)))



From pbrochard at common-lisp.net  Wed Jun 24 19:34:26 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 24 Jun 2009 15:34:26 -0400
Subject: [clfswm-cvs] r244 - in clfswm: . src
Message-ID: <E1MJYEk-0007n9-Hs@common-lisp.net>

Author: pbrochard
Date: Wed Jun 24 15:34:26 2009
New Revision: 244

Log:
clfswm-info.lisp: Use a standard menu for the help-menu.

Modified:
   clfswm/ChangeLog
   clfswm/clfswm.asd
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/bindings.lisp
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm.lisp
   clfswm/src/config.lisp
   clfswm/src/menu-def.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed Jun 24 15:34:26 2009
@@ -1,3 +1,7 @@
+2009-06-24  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-info.lisp: Use a standard menu for the help-menu.
+
 2009-06-22  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* contrib/mpd.lisp: New file to handle the Music Player Daemon (MPD)

Modified: clfswm/clfswm.asd
==============================================================================
--- clfswm/clfswm.asd	(original)
+++ clfswm/clfswm.asd	Wed Jun 24 15:34:26 2009
@@ -66,12 +66,12 @@
 			 (:file "clfswm-nw-hooks"
 				:depends-on ("package" "clfswm-util" "clfswm-info" "clfswm-layout" "menu-def"))
 			 (:file "bindings"
-				:depends-on ("clfswm" "clfswm-internal" "clfswm-util"))
+				:depends-on ("clfswm" "clfswm-internal" "clfswm-util" "clfswm-menu"))
 			 (:file "bindings-second-mode"
 				:depends-on ("clfswm" "clfswm-util" "clfswm-query" "bindings" "clfswm-pack" "clfswm-menu" "menu-def"
 						      "clfswm-layout"))
 			 (:file "menu-def"
-				:depends-on ("clfswm-menu" "clfswm" "clfswm-util"))))))
+				:depends-on ("clfswm-menu" "clfswm" "clfswm-util" "clfswm-info"))))))
 
 
 

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Wed Jun 24 15:34:26 2009
@@ -34,6 +34,7 @@
 ;;;`-----
 (add-hook *binding-hook* 'init-*second-keys* 'init-*second-mouse*)
 
+
 (defun open-frame-menu ()
   "Open the frame menu"
   (open-menu (find-menu 'frame-menu)))
@@ -79,7 +80,7 @@
 
 
 (defun set-default-second-keys ()
-  (define-second-key ("F1" :mod-1) 'help-on-second-mode)
+  (define-second-key ("F1" :mod-1) 'help-on-clfswm)
   (define-second-key ("m") 'open-menu)
   (define-second-key ("less") 'open-menu)
   (define-second-key ("less" :control) 'open-menu)

Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp	(original)
+++ clfswm/src/bindings.lisp	Wed Jun 24 15:34:26 2009
@@ -34,6 +34,13 @@
 
 (add-hook *binding-hook* 'init-*main-keys* 'init-*main-mouse*)
 
+
+
+(defun help-on-clfswm ()
+  "Open the help and info window"
+  (open-menu (find-menu 'help-menu)))
+
+
 (defun set-default-main-keys ()
   (define-main-key ("F1" :mod-1) 'help-on-clfswm)
   (define-main-key ("Home" :mod-1 :control :shift) 'exit-clfswm)

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Wed Jun 24 15:34:26 2009
@@ -458,11 +458,6 @@
   (info-on-shell "XMMS Playlist:" "xmms-shell -e list"))
 
 
-(defun xmms-info-menu ()
-  "< Open the xmms menu >"
-  (info-mode-menu '((#\s show-xmms-status)
-		    (#\l show-xmms-playlist))))
-
 
 
 (defun show-cd-info ()
@@ -473,11 +468,6 @@
   "Show the current CD playlist"
   (info-on-shell "Current CD playlist:" "pcd mi"))
 
-(defun info-on-cd-menu ()
-  "< Open the CD info menu >"
-  (info-mode-menu '((#\i show-cd-info)
-		    (#\l show-cd-playlist))))
-
 
 (defun show-version ()
   "Show the current CLFSWM version"
@@ -485,16 +475,6 @@
 
 
 
-(defun help-on-clfswm ()
-  "Open the help and info window"
-  (info-mode-menu *help-menu-list*))
-
-
-(defun help-on-second-mode ()
-  "Open the help and info window for the second mode"
-  (info-mode-menu *help-menu-list*))
-
-
 
 
 

Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp	(original)
+++ clfswm/src/clfswm.lisp	Wed Jun 24 15:34:26 2009
@@ -240,7 +240,6 @@
   (xgrab-init-pointer)
   (xgrab-init-keyboard)
   (init-last-child)
-  (reset-help-menu-list)
   (call-hook *binding-hook*)
   (map-window *no-focus-window*)
   (dbg *display*)

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Wed Jun 24 15:34:26 2009
@@ -279,19 +279,3 @@
 (defparameter *menu-color-menu-key* (->color #xFF9AFF)
   "Config(Menu group): Menu key color in menu")
 
-
-;;; Help menu list
-(defparameter *help-menu-list* nil
-  "Config(Info mode group): List of menus in the help menu")
-
-(defun reset-help-menu-list ()
-  (setf *help-menu-list* `((#\h show-global-key-binding)
-			   (#\b show-main-mode-key-binding)
-			   (#\c show-corner-help)
-			   (#\g show-config-variable)
-			   (#\d show-date)
-			   (#\p show-cpu-proc)
-			   (#\m show-mem-proc)
-			   (#\x (xmms-info-menu ,*menu-color-submenu*))
-			   (#\v show-version)
-			   (#\i (info-on-cd-menu ,*menu-color-submenu*)))))
\ No newline at end of file

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Wed Jun 24 15:34:26 2009
@@ -47,7 +47,7 @@
 
 ;;(define-second-key ("a") 'open-menu)
 
-;;(add-menu-key 'main "d" 'show-standard-menu)
+(add-sub-menu 'main "F1" 'help-menu "Help menu")
 (add-sub-menu 'main "d" 'standard-menu "Standard menu")
 (add-sub-menu 'main "c" 'child-menu "Child menu")
 (add-sub-menu 'main "f" 'frame-menu "Frame menu")
@@ -61,6 +61,24 @@
 
 (update-menus (find-menu 'standard-menu))
 
+(add-menu-key 'help-menu "h" 'show-global-key-binding)
+(add-menu-key 'help-menu "b" 'show-main-mode-key-binding)
+(add-menu-key 'help-menu "s" 'show-second-mode-key-binding)
+(add-menu-key 'help-menu "c" 'show-corner-help)
+(add-menu-key 'help-menu "g" 'show-config-variable)
+(add-menu-key 'help-menu "d" 'show-date)
+(add-menu-key 'help-menu "p" 'show-cpu-proc)
+(add-menu-key 'help-menu "m" 'show-mem-proc)
+(add-sub-menu 'help-menu "x" 'xmms-info-menu "XMMS menu")
+(add-menu-key 'help-menu "v" 'show-version)
+(add-sub-menu 'help-menu "i" 'info-on-cd-menu "CD info menu")
+
+(add-menu-key 'xmms-info-menu "s" 'show-xmms-status)
+(add-menu-key 'xmms-info-menu "l" 'show-xmms-playlist)
+
+(add-menu-key 'info-on-cd-menu "i" 'show-cd-info)
+(add-menu-key 'info-on-cd-menu "l" 'show-cd-playlist)
+
 
 (add-menu-key 'child-menu "r" 'rename-current-child)
 (add-menu-key 'child-menu "e" 'ensure-unique-name)



From pbrochard at common-lisp.net  Wed Jun 24 19:43:52 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 24 Jun 2009 15:43:52 -0400
Subject: [clfswm-cvs] r245 - in clfswm: . contrib
Message-ID: <E1MJYNs-0000Cq-5e@common-lisp.net>

Author: pbrochard
Date: Wed Jun 24 15:43:51 2009
New Revision: 245

Log:
contrib/mpd.lisp: Use a standard menu.

Modified:
   clfswm/ChangeLog
   clfswm/contrib/mpd.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed Jun 24 15:43:51 2009
@@ -1,5 +1,7 @@
 2009-06-24  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* contrib/mpd.lisp: Use a standard menu.
+
 	* src/clfswm-info.lisp: Use a standard menu for the help-menu.
 
 2009-06-22  Philippe Brochard  <pbrochard at common-lisp.net>

Modified: clfswm/contrib/mpd.lisp
==============================================================================
--- clfswm/contrib/mpd.lisp	(original)
+++ clfswm/contrib/mpd.lisp	Wed Jun 24 15:43:51 2009
@@ -33,6 +33,11 @@
 (format t "Loading MPD code... ")
 
 
+(defun mpd-menu ()
+  "Open the Music Player Daemon (MPD) menu"
+  (open-menu (find-menu 'mpd-menu)))
+
+
 (defun start-sonata ()
   "Start sonata"
   (do-shell "exec sonata"))
@@ -40,15 +45,18 @@
 
 (defun show-mpd-info ()
   "Show MPD informations"
-  (info-on-shell "MPD informations:" "mpc"))
+  (info-on-shell "MPD informations:" "mpc")
+  (mpd-menu))
 
 (defun mpd-previous ()
   "Play the previous song in the current playlist"
-  (do-shell "mpc prev"))
+  (info-on-shell "MPD:" "mpc prev")
+  (mpd-menu))
 
 (defun mpd-next ()
   "Play the next song in the current playlist"
-  (do-shell "mpc next"))
+  (info-on-shell "MPD:" "mpc next")
+  (mpd-menu))
 
 (defun mpd-toggle ()
   "Toggles Play/Pause, plays if stopped"
@@ -75,27 +83,22 @@
 
 (defun show-mpd-playlist ()
   "Show the current MPD playlist"
-  (info-on-shell "Current MPD playlist:" "mpc playlist"))
+  (info-on-shell "Current MPD playlist:" "mpc playlist")
+  (mpd-menu))
 
-(defun mpd-menu ()
-  "< Open the MPD menu >"
-  (info-mode-menu '((#\i show-mpd-info)
-		    (#\p mpd-previous)
-		    (#\n mpd-next)
-		    (#\t mpd-toggle)
-		    (#\y mpd-play)
-		    (#\k mpd-stop)
-		    (#\x mpd-seek-+5%)
-		    (#\w mpd-seek--5%)
-		    (#\l show-mpd-playlist)
-		    (#\s start-sonata))))
-
-
-(defun add-mpd-menu-to-help-menu ()
-  (setf *help-menu-list* (append *help-menu-list*
-				 `((#\s (mpd-menu ,*menu-color-submenu*))))))
+(add-sub-menu 'help-menu "F2" 'mpd-menu "Music Player Daemon (MPD) menu")
+
+(add-menu-key 'mpd-menu "i" 'show-mpd-info)
+(add-menu-key 'mpd-menu "p" 'mpd-previous)
+(add-menu-key 'mpd-menu "n" 'mpd-next)
+(add-menu-key 'mpd-menu "t" 'mpd-toggle)
+(add-menu-key 'mpd-menu "y" 'mpd-play)
+(add-menu-key 'mpd-menu "k" 'mpd-stop)
+(add-menu-key 'mpd-menu "x" 'mpd-seek-+5%)
+(add-menu-key 'mpd-menu "w" 'mpd-seek--5%)
+(add-menu-key 'mpd-menu "l" 'show-mpd-playlist)
+(add-menu-key 'mpd-menu "s" 'start-sonata)
 
-(add-hook *init-hook* 'add-mpd-menu-to-help-menu)
 
 (defun mpd-binding ()
   (define-main-key ("F2" :alt) 'mpd-menu))



From pbrochard at common-lisp.net  Sat Jun 27 15:52:27 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sat, 27 Jun 2009 11:52:27 -0400
Subject: [clfswm-cvs] r246 - clfswm
Message-ID: <E1MKaCZ-0007PC-PK@common-lisp.net>

Author: pbrochard
Date: Sat Jun 27 11:52:27 2009
New Revision: 246

Log:
TODO update

Modified:
   clfswm/TODO

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Sat Jun 27 11:52:27 2009
@@ -7,6 +7,9 @@
 ===============
 Should handle these soon.
 
+- New: in contrib: keyb-fr.lisp (french binding)
+       pcd / xmms modules...
+
 - Mouse support in menu
 
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]
@@ -16,6 +19,8 @@
       (defparameter *my-var* value)
       ...
       ;;;; AUTO-CONFIG End : You can add your configurations below this line.
+   Ask to change value. Check if new value type is the same as the old value.
+
 
 - Remote access to the clfswm REPL [Philippe]
    this can be done with net.lisp or via xprop (ie the Stumpwm way).



From pbrochard at common-lisp.net  Sat Jun 27 20:23:21 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sat, 27 Jun 2009 16:23:21 -0400
Subject: [clfswm-cvs] r247 - in clfswm: . contrib
Message-ID: <E1MKeQj-0001QH-KD@common-lisp.net>

Author: pbrochard
Date: Sat Jun 27 16:23:20 2009
New Revision: 247

Log:
contrib/keyb_fr.lisp: New file to handle an azerty keyboard.

Added:
   clfswm/contrib/keyb_fr.lisp
Modified:
   clfswm/ChangeLog

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat Jun 27 16:23:20 2009
@@ -1,3 +1,7 @@
+2009-06-27  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* contrib/keyb_fr.lisp: New file to handle an azerty keyboard.
+
 2009-06-24  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* contrib/mpd.lisp: Use a standard menu.

Added: clfswm/contrib/keyb_fr.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/keyb_fr.lisp	Sat Jun 27 16:23:20 2009
@@ -0,0 +1,72 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Music Player Daemon (MPD) interface
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2009 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; Documentation: French keyboard layout.
+;;;   If you want to use this file, just add this line in
+;;; your configuration file:
+;;;
+;;;   (load-contrib "keyb_fr.lisp")
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(format t "Loading French Keyboard code... ")
+
+(defun fr-binding ()
+  ;; For an azery keyboard:
+  ;; Main mode
+  (undefine-main-multi-keys ("1" :mod-1) ("2" :mod-1) ("3" :mod-1)
+			    ("4" :mod-1) ("5" :mod-1) ("6" :mod-1)
+			    ("7" :mod-1) ("8" :mod-1) ("9" :mod-1) ("0" :mod-1))
+  (define-main-key ("twosuperior") 'banish-pointer)
+  (define-main-key ("ampersand" :mod-1) 'bind-or-jump 1)
+  (define-main-key ("eacute" :mod-1) 'bind-or-jump 2)
+  (define-main-key ("quotedbl" :mod-1) 'bind-or-jump 3)
+  (define-main-key ("quoteright" :mod-1) 'bind-or-jump 4)
+  (define-main-key ("parenleft" :mod-1) 'bind-or-jump 5)
+  (define-main-key ("minus" :mod-1) 'bind-or-jump 6)
+  (define-main-key ("egrave" :mod-1) 'bind-or-jump 7)
+  (define-main-key ("underscore" :mod-1) 'bind-or-jump 8)
+  (define-main-key ("ccedilla" :mod-1) 'bind-or-jump 9)
+  (define-main-key ("agrave" :mod-1) 'bind-or-jump 10)
+  ;; Second mode
+  (undefine-second-multi-keys ("1" :mod-1) ("2" :mod-1) ("3" :mod-1)
+			      ("4" :mod-1) ("5" :mod-1) ("6" :mod-1)
+			      ("7" :mod-1) ("8" :mod-1) ("9" :mod-1) ("0" :mod-1))
+  (define-second-key ("twosuperior") 'banish-pointer)
+  (define-second-key ("ampersand" :mod-1) 'bind-or-jump 1)
+  (define-second-key ("eacute" :mod-1) 'bind-or-jump 2)
+  (define-second-key ("quotedbl" :mod-1) 'bind-or-jump 3)
+  (define-second-key ("quoteright" :mod-1) 'bind-or-jump 4)
+  (define-second-key ("parenleft" :mod-1) 'bind-or-jump 5)
+  (define-second-key ("minus" :mod-1) 'bind-or-jump 6)
+  (define-second-key ("egrave" :mod-1) 'bind-or-jump 7)
+  (define-second-key ("underscore" :mod-1) 'bind-or-jump 8)
+  (define-second-key ("ccedilla" :mod-1) 'bind-or-jump 9)
+  (define-second-key ("agrave" :mod-1) 'bind-or-jump 10))
+
+(unless (member 'fr-binding *binding-hook*)
+  (add-hook *binding-hook* 'fr-binding))
+
+(format t "done~%")



From pbrochard at common-lisp.net  Sun Jun 28 13:07:45 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sun, 28 Jun 2009 09:07:45 -0400
Subject: [clfswm-cvs] r248 - in clfswm: . src
Message-ID: <E1MKu6j-0007UQ-Sp@common-lisp.net>

Author: pbrochard
Date: Sun Jun 28 09:07:41 2009
New Revision: 248

Log:
set-default-second-keys: Bind 'o' on set-open-in-new-frame-in-parent-frame-nw-hook.

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/clfswm-nw-hooks.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sun Jun 28 09:07:41 2009
@@ -1,3 +1,8 @@
+2009-06-28  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/bindings-second-mode.lisp (set-default-second-keys): Bind
+	"o" on set-open-in-new-frame-in-parent-frame-nw-hook.
+
 2009-06-27  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* contrib/keyb_fr.lisp: New file to handle an azerty keyboard.

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Sun Jun 28 09:07:41 2009
@@ -7,8 +7,7 @@
 ===============
 Should handle these soon.
 
-- New: in contrib: keyb-fr.lisp (french binding)
-       pcd / xmms modules...
+- New: Put CD player / xmms modules in contrib/ ...
 
 - Mouse support in menu
 

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Sun Jun 28 09:07:41 2009
@@ -115,8 +115,8 @@
   (define-second-key ("Home" :mod-1 :shift) 'switch-and-select-root-frame)
   (define-second-key ("Menu") 'toggle-show-root-frame)
   (define-second-key (#\b :mod-1) 'banish-pointer)
-  (define-second-key (#\o) 'set-open-in-new-frame-in-root-frame-nw-hook)
-  (define-second-key (#\o :control) 'set-open-in-new-frame-in-parent-frame-nw-hook)
+  (define-second-key (#\o) 'set-open-in-new-frame-in-parent-frame-nw-hook)
+  (define-second-key (#\o :control) 'set-open-in-new-frame-in-root-frame-nw-hook)
   (define-second-key (#\a) 'add-default-frame)
   ;; Escape
   (define-second-key ("Escape" :control :shift) 'delete-focus-window)

Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp	(original)
+++ clfswm/src/clfswm-nw-hooks.lisp	Sun Jun 28 09:07:41 2009
@@ -155,7 +155,9 @@
       (pushnew new-frame (frame-child parent))
       (pushnew window (frame-child new-frame))
       (hide-all *current-root*)
-      (setf *current-root* parent)
+      (setf *current-root* parent
+	    *current-child* parent)
+      (set-layout-once #'tile-space-layout)
       (setf *current-child* new-frame)
       (default-window-placement new-frame window)
       (show-all-children *current-root*))))



From pbrochard at common-lisp.net  Sun Jun 28 19:28:10 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sun, 28 Jun 2009 15:28:10 -0400
Subject: [clfswm-cvs] r249 - in clfswm: . doc src
Message-ID: <E1ML02s-0002r4-As@common-lisp.net>

Author: pbrochard
Date: Sun Jun 28 15:28:10 2009
New Revision: 249

Log:
set-no-layout-remember-size): New layout: Maximize windows in there frame - Leave frames to there actual size.

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/doc/keys.html
   clfswm/doc/keys.txt
   clfswm/doc/menu.html
   clfswm/doc/menu.txt
   clfswm/src/clfswm-layout.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sun Jun 28 15:28:10 2009
@@ -1,5 +1,9 @@
 2009-06-28  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-layout.lisp (set-no-layout-remember-size): New layout:
+	Maximize windows in there frame - Leave frames to there	actual
+	size.
+
 	* src/bindings-second-mode.lisp (set-default-second-keys): Bind
 	"o" on set-open-in-new-frame-in-parent-frame-nw-hook.
 

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Sun Jun 28 15:28:10 2009
@@ -7,6 +7,8 @@
 ===============
 Should handle these soon.
 
+- Frame layout menu: No layout but frames 'learn' there position/size.
+
 - New: Put CD player / xmms modules in contrib/ ...
 
 - Mouse support in menu

Modified: clfswm/doc/keys.html
==============================================================================
--- clfswm/doc/keys.html	(original)
+++ clfswm/doc/keys.html	Sun Jun 28 15:28:10 2009
@@ -437,6 +437,17 @@
           Bind or jump to a slot (a frame or a window)
         </td>
       </tr>
+      <tr>
+        <td align="right" style="color:#ff0000" nowrap>
+           Mod-1 
+        </td>
+        <td align="center" nowrap>
+          F2
+        </td>
+        <td style="color:#0000ff" nowrap>
+          Open the Music Player Daemon (MPD) menu
+        </td>
+      </tr>
     </table>
     <h3>
       <u>
@@ -593,7 +604,7 @@
           F1
         </td>
         <td style="color:#0000ff" nowrap>
-          Open the help and info window for the second mode
+          Open the help and info window
         </td>
       </tr>
       <tr>
@@ -967,7 +978,7 @@
             O
         </td>
         <td style="color:#0000ff" nowrap>
-          Open the next window in a new frame in the root frame
+          Open the next window in a new frame in the parent frame
         </td>
       </tr>
       <tr>
@@ -978,7 +989,7 @@
             O
         </td>
         <td style="color:#0000ff" nowrap>
-          Open the next window in a new frame in the parent frame
+          Open the next window in a new frame in the root frame
         </td>
       </tr>
       <tr>

Modified: clfswm/doc/keys.txt
==============================================================================
--- clfswm/doc/keys.txt	(original)
+++ clfswm/doc/keys.txt	Sun Jun 28 15:28:10 2009
@@ -43,6 +43,7 @@
   Mod-1                8               Bind or jump to a slot (a frame or a window)
   Mod-1                9               Bind or jump to a slot (a frame or a window)
   Mod-1                0               Bind or jump to a slot (a frame or a window)
+  Mod-1                F2              Open the Music Player Daemon (MPD) menu
 
 
 Mouse buttons actions in main mode:
@@ -65,7 +66,7 @@
 Second mode keys:
 ----------------
 
-  Mod-1                F1              Open the help and info window for the second mode
+  Mod-1                F1              Open the help and info window
                        M               Open the main menu
                        Less            Open the main menu
   Control              Less            Open the main menu
@@ -99,8 +100,8 @@
   Mod-1 Shift          Home            Switch and select the root frame
                        Menu            Show all frames info windows until a key is release
   Mod-1                B               Move the pointer to the lower right corner of the screen
-                       O               Open the next window in a new frame in the root frame
-  Control              O               Open the next window in a new frame in the parent frame
+                       O               Open the next window in a new frame in the parent frame
+  Control              O               Open the next window in a new frame in the root frame
                        A               Add a default frame in the current frame
   Control Shift        Escape          Close focus window: Delete the focus window in all frames and workspaces
   Mod-1 Control Shift  Escape          Kill focus window: Destroy the focus window in all frames and workspaces

Modified: clfswm/doc/menu.html
==============================================================================
--- clfswm/doc/menu.html	(original)
+++ clfswm/doc/menu.html	Sun Jun 28 15:28:10 2009
@@ -18,6 +18,9 @@
       <a name="MAIN"></a><a href="#Top">Main</a>
     </h3>
     <p>
+      F1: <a href="#HELP-MENU">< Help menu ></a>
+    </p>
+    <p>
       d: <a href="#STANDARD-MENU">< Standard menu ></a>
     </p>
     <p>
@@ -46,6 +49,100 @@
     </p>
     <hr>
     <h3>
+      <a name="HELP-MENU"></a><a href="#MAIN">Help-Menu</a>
+    </h3>
+    <p>
+      h: Show all key binding
+    </p>
+    <p>
+      b: Show the main mode binding
+    </p>
+    <p>
+      s: Show the second mode key binding
+    </p>
+    <p>
+      c: Help on clfswm corner
+    </p>
+    <p>
+      g: Show all configurable variables
+    </p>
+    <p>
+      d: Show the current time and date
+    </p>
+    <p>
+      p: Show current processes sorted by CPU usage
+    </p>
+    <p>
+      m: Show current processes sorted by memory usage
+    </p>
+    <p>
+      x: <a href="#XMMS-INFO-MENU">< XMMS menu ></a>
+    </p>
+    <p>
+      v: Show the current CLFSWM version
+    </p>
+    <p>
+      i: <a href="#INFO-ON-CD-MENU">< CD info menu ></a>
+    </p>
+    <p>
+      F2: <a href="#MPD-MENU">< Music Player Daemon (MPD) menu ></a>
+    </p>
+    <hr>
+    <h3>
+      <a name="XMMS-INFO-MENU"></a><a href="#HELP-MENU">Xmms-Info-Menu</a>
+    </h3>
+    <p>
+      s: Show the current xmms status
+    </p>
+    <p>
+      l: Show the current xmms playlist
+    </p>
+    <hr>
+    <h3>
+      <a name="INFO-ON-CD-MENU"></a><a href="#HELP-MENU">Info-On-Cd-Menu</a>
+    </h3>
+    <p>
+      i: Show the current CD track
+    </p>
+    <p>
+      l: Show the current CD playlist
+    </p>
+    <hr>
+    <h3>
+      <a name="MPD-MENU"></a><a href="#HELP-MENU">Mpd-Menu</a>
+    </h3>
+    <p>
+      i: Show MPD informations
+    </p>
+    <p>
+      p: Play the previous song in the current playlist
+    </p>
+    <p>
+      n: Play the next song in the current playlist
+    </p>
+    <p>
+      t: Toggles Play/Pause, plays if stopped
+    </p>
+    <p>
+      y: Start playing
+    </p>
+    <p>
+      k: Stop the currently playing playlists
+    </p>
+    <p>
+      x: Seeks to +5%
+    </p>
+    <p>
+      w: Seeks to -5%
+    </p>
+    <p>
+      l: Show the current MPD playlist
+    </p>
+    <p>
+      s: Start sonata
+    </p>
+    <hr>
+    <h3>
       <a name="STANDARD-MENU"></a><a href="#MAIN">Standard-Menu</a>
     </h3>
     <hr>
@@ -131,25 +228,28 @@
       a: <a href="#FRAME-FAST-LAYOUT-MENU">< Frame fast layout menu ></a>
     </p>
     <p>
-      b: No layout: Maximize windows in there frame - Leave frame to there size
+      b: No layout: Maximize windows in there frame - Leave frames to there original size
+    </p>
+    <p>
+      c: No layout: Maximize windows in there frame - Leave frames to there actual size
     </p>
     <p>
-      c: Maximize layout: Maximize windows and frames in there parent frame
+      d: Maximize layout: Maximize windows and frames in there parent frame
     </p>
     <p>
-      d: <a href="#FRAME-TILE-LAYOUT-MENU">< Frame tile layout menu ></a>
+      e: <a href="#FRAME-TILE-LAYOUT-MENU">< Frame tile layout menu ></a>
     </p>
     <p>
-      e: <a href="#FRAME-TILE-DIR-LAYOUT-MENU">< Tile in one direction layout menu ></a>
+      f: <a href="#FRAME-TILE-DIR-LAYOUT-MENU">< Tile in one direction layout menu ></a>
     </p>
     <p>
-      f: <a href="#FRAME-TILE-SPACE-LAYOUT-MENU">< Tile with some space on one side menu ></a>
+      g: <a href="#FRAME-TILE-SPACE-LAYOUT-MENU">< Tile with some space on one side menu ></a>
     </p>
     <p>
-      g: <a href="#FRAME-MAIN-WINDOW-LAYOUT-MENU">< Main window layout menu ></a>
+      h: <a href="#FRAME-MAIN-WINDOW-LAYOUT-MENU">< Main window layout menu ></a>
     </p>
     <p>
-      h: <a href="#FRAME-GIMP-LAYOUT-MENU">< The GIMP layout menu ></a>
+      i: <a href="#FRAME-GIMP-LAYOUT-MENU">< The GIMP layout menu ></a>
     </p>
     <hr>
     <h3>

Modified: clfswm/doc/menu.txt
==============================================================================
--- clfswm/doc/menu.txt	(original)
+++ clfswm/doc/menu.txt	Sun Jun 28 15:28:10 2009
@@ -2,6 +2,7 @@
 (By default it is bound on second-mode + m)
 
 Main
+F1: < Help menu >
 d: < Standard menu >
 c: < Child menu >
 f: < Frame menu >
@@ -12,6 +13,40 @@
 y: < Utility menu >
 m: < CLFSWM menu >
 
+Help-Menu
+h: Show all key binding
+b: Show the main mode binding
+s: Show the second mode key binding
+c: Help on clfswm corner
+g: Show all configurable variables
+d: Show the current time and date
+p: Show current processes sorted by CPU usage
+m: Show current processes sorted by memory usage
+x: < XMMS menu >
+v: Show the current CLFSWM version
+i: < CD info menu >
+F2: < Music Player Daemon (MPD) menu >
+
+Xmms-Info-Menu
+s: Show the current xmms status
+l: Show the current xmms playlist
+
+Info-On-Cd-Menu
+i: Show the current CD track
+l: Show the current CD playlist
+
+Mpd-Menu
+i: Show MPD informations
+p: Play the previous song in the current playlist
+n: Play the next song in the current playlist
+t: Toggles Play/Pause, plays if stopped
+y: Start playing
+k: Stop the currently playing playlists
+x: Seeks to +5%
+w: Seeks to -5%
+l: Show the current MPD playlist
+s: Start sonata
+
 Standard-Menu
 
 Child-Menu
@@ -43,13 +78,14 @@
 
 Frame-Layout-Menu
 a: < Frame fast layout menu >
-b: No layout: Maximize windows in there frame - Leave frame to there size
-c: Maximize layout: Maximize windows and frames in there parent frame
-d: < Frame tile layout menu >
-e: < Tile in one direction layout menu >
-f: < Tile with some space on one side menu >
-g: < Main window layout menu >
-h: < The GIMP layout menu >
+b: No layout: Maximize windows in there frame - Leave frames to there original size
+c: No layout: Maximize windows in there frame - Leave frames to there actual size
+d: Maximize layout: Maximize windows and frames in there parent frame
+e: < Frame tile layout menu >
+f: < Tile in one direction layout menu >
+g: < Tile with some space on one side menu >
+h: < Main window layout menu >
+i: < The GIMP layout menu >
 
 Frame-Fast-Layout-Menu
 s: Switch between two layouts

Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp	(original)
+++ clfswm/src/clfswm-layout.lisp	Sun Jun 28 15:28:10 2009
@@ -130,7 +130,7 @@
 
 ;;; No layout
 (defgeneric no-layout (child parent)
-  (:documentation "No layout: Maximize windows in there frame - Leave frame to there size"))
+  (:documentation "No layout: Maximize windows in there frame - Leave frames to there original size"))
 
 (defmethod no-layout ((child xlib:window) parent)
   (with-slots (rx ry rw rh) parent
@@ -148,11 +148,20 @@
 
 
 (defun set-no-layout ()
-  "No layout: Maximize windows in there frame - Leave frame to there size"
+  "No layout: Maximize windows in there frame - Leave frames to there original size"
   (set-layout #'no-layout))
 
 (register-layout 'set-no-layout)
 
+;;; No layout remember size
+(defun set-no-layout-remember-size ()
+  "No layout: Maximize windows in there frame - Leave frames to there actual size"
+  (fixe-real-size-current-child)
+  (set-no-layout))
+
+(register-layout 'set-no-layout-remember-size)
+
+
 
 ;;; Maximize layout
 (defgeneric maximize-layout (child parent)



From pbrochard at common-lisp.net  Mon Jun 29 10:48:29 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Mon, 29 Jun 2009 06:48:29 -0400
Subject: [clfswm-cvs] r250 - in clfswm: . contrib src
Message-ID: <E1MLEPV-00054F-EH@common-lisp.net>

Author: pbrochard
Date: Mon Jun 29 06:48:28 2009
New Revision: 250

Log:
contrib/xmms.lisp: New file to handle the xmms player.

Added:
   clfswm/contrib/xmms.lisp
Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/contrib/mpd.lisp
   clfswm/src/clfswm-info.lisp
   clfswm/src/menu-def.lisp
   clfswm/src/xlib-util.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Mon Jun 29 06:48:28 2009
@@ -1,3 +1,7 @@
+2009-06-29  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* contrib/xmms.lisp: New file to handle the xmms player.
+
 2009-06-28  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-layout.lisp (set-no-layout-remember-size): New layout:

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Mon Jun 29 06:48:28 2009
@@ -7,8 +7,6 @@
 ===============
 Should handle these soon.
 
-- Frame layout menu: No layout but frames 'learn' there position/size.
-
 - New: Put CD player / xmms modules in contrib/ ...
 
 - Mouse support in menu

Modified: clfswm/contrib/mpd.lisp
==============================================================================
--- clfswm/contrib/mpd.lisp	(original)
+++ clfswm/contrib/mpd.lisp	Mon Jun 29 06:48:28 2009
@@ -86,18 +86,19 @@
   (info-on-shell "Current MPD playlist:" "mpc playlist")
   (mpd-menu))
 
-(add-sub-menu 'help-menu "F2" 'mpd-menu "Music Player Daemon (MPD) menu")
+(unless (find-menu 'mpd-menu)
+  (add-sub-menu 'help-menu "F2" 'mpd-menu "Music Player Daemon (MPD) menu")
 
-(add-menu-key 'mpd-menu "i" 'show-mpd-info)
-(add-menu-key 'mpd-menu "p" 'mpd-previous)
-(add-menu-key 'mpd-menu "n" 'mpd-next)
-(add-menu-key 'mpd-menu "t" 'mpd-toggle)
-(add-menu-key 'mpd-menu "y" 'mpd-play)
-(add-menu-key 'mpd-menu "k" 'mpd-stop)
-(add-menu-key 'mpd-menu "x" 'mpd-seek-+5%)
-(add-menu-key 'mpd-menu "w" 'mpd-seek--5%)
-(add-menu-key 'mpd-menu "l" 'show-mpd-playlist)
-(add-menu-key 'mpd-menu "s" 'start-sonata)
+  (add-menu-key 'mpd-menu "i" 'show-mpd-info)
+  (add-menu-key 'mpd-menu "p" 'mpd-previous)
+  (add-menu-key 'mpd-menu "n" 'mpd-next)
+  (add-menu-key 'mpd-menu "t" 'mpd-toggle)
+  (add-menu-key 'mpd-menu "y" 'mpd-play)
+  (add-menu-key 'mpd-menu "k" 'mpd-stop)
+  (add-menu-key 'mpd-menu "x" 'mpd-seek-+5%)
+  (add-menu-key 'mpd-menu "w" 'mpd-seek--5%)
+  (add-menu-key 'mpd-menu "l" 'show-mpd-playlist)
+  (add-menu-key 'mpd-menu "s" 'start-sonata))
 
 
 (defun mpd-binding ()

Added: clfswm/contrib/xmms.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/xmms.lisp	Mon Jun 29 06:48:28 2009
@@ -0,0 +1,77 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Music Player Daemon (MPD) interface
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2009 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; Documentation: If you want to use this file, just add this line in
+;;; your configuration file:
+;;;
+;;;   (load-contrib "xmms.lisp")
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(format t "Loading XMMS code... ")
+
+(defun xmms-menu ()
+  "Open the XMMS menu"
+  (open-menu (find-menu 'xmms-menu)))
+
+(defun launch-xmms ()
+  "Lanch XMMS"
+  (do-shell "xmmsctrl launch"))
+
+(defun show-xmms-status ()
+  "Show the current xmms status"
+  (info-on-shell "XMMS status:" "xmmsctrl cur"))
+
+(defun show-xmms-playlist ()
+  "Show the current xmms playlist"
+  (info-on-shell "XMMS Playlist:" "xmmsctrl playlist"))
+
+(defun xmms-next-track ()
+  "Play the next XMMS track"
+  (do-shell "xmmsctrl next")
+  (show-xmms-status)
+  (xmms-menu))
+
+(defun xmms-previous-track ()
+  "Play the previous XMMS track"
+  (do-shell "xmmsctrl previous")
+  (show-xmms-status)
+  (xmms-menu))
+
+(defun xmms-load-file ()
+  "open xmms \"Load file(s)\" dialog window."
+  (do-shell "xmmsctrl eject"))
+
+(unless (find-menu 'xmms-menu)
+  (add-sub-menu 'help-menu "x" 'xmms-menu "XMMS menu")
+
+  (add-menu-key 'xmms-menu "r" 'launch-xmms)
+  (add-menu-key 'xmms-menu "s" 'show-xmms-status)
+  (add-menu-key 'xmms-menu "l" 'show-xmms-playlist)
+  (add-menu-key 'xmms-menu "n" 'xmms-next-track)
+  (add-menu-key 'xmms-menu "p" 'xmms-previous-track)
+  (add-menu-key 'xmms-menu "e" 'xmms-load-file))
+
+(format t "done~%")

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Mon Jun 29 06:48:28 2009
@@ -272,7 +272,6 @@
 
 
 
-
 (defun info-mode-menu (item-list &key (width nil) (height nil))
   "Open an info help menu.
 Item-list is: '((key function) separator (key function))
@@ -449,16 +448,6 @@
   (info-on-shell "Current processes sorted by MEMORY usage:"
 		 "ps --cols=1000 --sort='-vsz,uid,pgid,ppid,pid' -e -o user,pid,stime,pcpu,pmem,args"))
 
-(defun show-xmms-status ()
-  "Show the current xmms status"
-  (info-on-shell "XMMS status:" "xmms-shell -e status"))
-
-(defun show-xmms-playlist ()
-  "Show the current xmms playlist"
-  (info-on-shell "XMMS Playlist:" "xmms-shell -e list"))
-
-
-
 
 (defun show-cd-info ()
   "Show the current CD track"

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Mon Jun 29 06:48:28 2009
@@ -69,15 +69,12 @@
 (add-menu-key 'help-menu "d" 'show-date)
 (add-menu-key 'help-menu "p" 'show-cpu-proc)
 (add-menu-key 'help-menu "m" 'show-mem-proc)
-(add-sub-menu 'help-menu "x" 'xmms-info-menu "XMMS menu")
 (add-menu-key 'help-menu "v" 'show-version)
-(add-sub-menu 'help-menu "i" 'info-on-cd-menu "CD info menu")
 
-(add-menu-key 'xmms-info-menu "s" 'show-xmms-status)
-(add-menu-key 'xmms-info-menu "l" 'show-xmms-playlist)
-
-(add-menu-key 'info-on-cd-menu "i" 'show-cd-info)
-(add-menu-key 'info-on-cd-menu "l" 'show-cd-playlist)
+;;(add-sub-menu 'help-menu "i" 'info-on-cd-menu "CD info menu")
+;;
+;;(add-menu-key 'info-on-cd-menu "i" 'show-cd-info)
+;;(add-menu-key 'info-on-cd-menu "l" 'show-cd-playlist)
 
 
 (add-menu-key 'child-menu "r" 'rename-current-child)

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Mon Jun 29 06:48:28 2009
@@ -704,21 +704,21 @@
 (defun wait-no-key-or-button-press ()
   (with-grab-keyboard-and-pointer (66 67 66 67)
     (loop
-     (let ((key (loop for k across (xlib:query-keymap *display*)
-		      for code from 0
-		      when (and (plusp k) (not (modifier-p code))) return t))
-	   (button (loop for b in (xlib:make-state-keys (nth-value 4 (xlib:query-pointer *root*)))
-			 when (member b '(:button-1 :button-2 :button-3 :button-4 :button-5))
-			 return t)))
-       (when (and (not key) (not button))
-	 (loop while (xlib:event-case (*display* :discard-p t :peek-p nil :timeout 0)
-		       (:motion-notify () t)
-		       (:key-press () t)
-		       (:key-release () t)
-		       (:button-press () t)
-		       (:button-release () t)
-		       (t nil)))
-	 (return))))))
+       (let ((key (loop for k across (xlib:query-keymap *display*)
+		     for code from 0
+		     when (and (plusp k) (not (modifier-p code))) return t))
+	     (button (loop for b in (xlib:make-state-keys (nth-value 4 (xlib:query-pointer *root*)))
+			when (member b '(:button-1 :button-2 :button-3 :button-4 :button-5))
+			return t)))
+	 (when (and (not key) (not button))
+	   (loop while (xlib:event-case (*display* :discard-p t :peek-p nil :timeout 0)
+			 (:motion-notify () t)
+			 (:key-press () t)
+			 (:key-release () t)
+			 (:button-press () t)
+			 (:button-release () t)
+			 (t nil)))
+	   (return))))))
 
 
 (defun wait-a-key-or-button-press ()



From pbrochard at common-lisp.net  Mon Jun 29 11:14:47 2009
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Mon, 29 Jun 2009 07:14:47 -0400
Subject: [clfswm-cvs] r251 - in clfswm: . contrib src
Message-ID: <E1MLEox-0007GS-Pn@common-lisp.net>

Author: pbrochard
Date: Mon Jun 29 07:14:47 2009
New Revision: 251

Log:
contrib/cd-player.lisp: New file to handle the CD player.

Added:
   clfswm/contrib/cd-player.lisp
Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/contrib/xmms.lisp
   clfswm/src/menu-def.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Mon Jun 29 07:14:47 2009
@@ -1,5 +1,7 @@
 2009-06-29  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* contrib/cd-player.lisp: New file to handle the CD player.
+
 	* contrib/xmms.lisp: New file to handle the xmms player.
 
 2009-06-28  Philippe Brochard  <pbrochard at common-lisp.net>

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Mon Jun 29 07:14:47 2009
@@ -7,8 +7,6 @@
 ===============
 Should handle these soon.
 
-- New: Put CD player / xmms modules in contrib/ ...
-
 - Mouse support in menu
 
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]

Added: clfswm/contrib/cd-player.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/cd-player.lisp	Mon Jun 29 07:14:47 2009
@@ -0,0 +1,94 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Music Player Daemon (MPD) interface
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2009 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; Documentation: Handle the CD player
+;;;   This code needs pcd (http://hocwp.free.fr/pcd.html).
+;;    If you want to use this file, just add this line in
+;;;   your configuration file:
+;;;
+;;;     (load-contrib "cd-player.lisp")
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(format t "Loading CDPLAYER code... ")
+
+(defun cdplayer-menu ()
+  "Open the CDPLAYER menu"
+  (open-menu (find-menu 'cdplayer-menu)))
+
+(defun cdplayer-play ()
+  "Start playing CD"
+  (do-shell "pcd play"))
+
+(defun cdplayer-stop ()
+  "Stop playing CD"
+  (do-shell "pcd stop"))
+
+(defun cdplayer-pause ()
+  "Toggle pause"
+  (do-shell "pcd toggle"))
+
+(defun show-cdplayer-status ()
+  "Show the current CD status"
+  (info-on-shell "CDPLAYER status:" "pcd info")
+  (cdplayer-menu))
+
+(defun show-cdplayer-playlist ()
+  "Show the current CD playlist"
+  (info-on-shell "CDPLAYER:" "pcd more_info")
+  (cdplayer-menu))
+
+(defun cdplayer-next-track ()
+  "Play the next CD track"
+  (do-shell "pcd next")
+  (cdplayer-menu))
+
+(defun cdplayer-previous-track ()
+  "Play the previous CD track"
+  (do-shell "pcd previous")
+  (cdplayer-menu))
+
+(defun cdplayer-eject ()
+  "Eject CD"
+  (do-shell "pcd eject"))
+
+(defun cdplayer-close ()
+  "Close CD"
+  (do-shell "pcd close"))
+
+(unless (find-menu 'cdplayer-menu)
+  (add-sub-menu 'help-menu "i" 'cdplayer-menu "CDPLAYER menu")
+
+  (add-menu-key 'cdplayer-menu "y" 'cdplayer-play)
+  (add-menu-key 'cdplayer-menu "k" 'cdplayer-stop)
+  (add-menu-key 'cdplayer-menu "t" 'cdplayer-pause)
+  (add-menu-key 'cdplayer-menu "s" 'show-cdplayer-status)
+  (add-menu-key 'cdplayer-menu "l" 'show-cdplayer-playlist)
+  (add-menu-key 'cdplayer-menu "n" 'cdplayer-next-track)
+  (add-menu-key 'cdplayer-menu "p" 'cdplayer-previous-track)
+  (add-menu-key 'cdplayer-menu "e" 'cdplayer-eject)
+  (add-menu-key 'cdplayer-menu "c" 'cdplayer-close))
+
+(format t "done~%")

Modified: clfswm/contrib/xmms.lisp
==============================================================================
--- clfswm/contrib/xmms.lisp	(original)
+++ clfswm/contrib/xmms.lisp	Mon Jun 29 07:14:47 2009
@@ -21,10 +21,12 @@
 ;;; along with this program; if not, write to the Free Software
 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 ;;;
-;;; Documentation: If you want to use this file, just add this line in
-;;; your configuration file:
+;;; Documentation: Handle the XMMS player
+;;;   This code needs xmmsctrl.
+;;    If you want to use this file, just add this line in
+;;;   your configuration file:
 ;;;
-;;;   (load-contrib "xmms.lisp")
+;;;     (load-contrib "xmms.lisp")
 ;;;
 ;;; --------------------------------------------------------------------------
 

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Mon Jun 29 07:14:47 2009
@@ -71,11 +71,6 @@
 (add-menu-key 'help-menu "m" 'show-mem-proc)
 (add-menu-key 'help-menu "v" 'show-version)
 
-;;(add-sub-menu 'help-menu "i" 'info-on-cd-menu "CD info menu")
-;;
-;;(add-menu-key 'info-on-cd-menu "i" 'show-cd-info)
-;;(add-menu-key 'info-on-cd-menu "l" 'show-cd-playlist)
-
 
 (add-menu-key 'child-menu "r" 'rename-current-child)
 (add-menu-key 'child-menu "e" 'ensure-unique-name)