From pbrochard at common-lisp.net  Tue Jan  3 21:45:55 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 03 Jan 2012 13:45:55 -0800
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-12-g5e8514a
Message-ID: <E1RiCB9-00052E-1o@common-lisp.net>

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  5e8514a2cde78233d5d956de63a8e359ebecba3f (commit)
      from  5b3e106b3a935888b50718bf9dd6b1321454540c (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 5e8514a2cde78233d5d956de63a8e359ebecba3f
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Tue Jan 3 22:45:43 2012 +0100

    src/xlib-util.lisp (handle-event): Fix a clisp/new-clx error when sometimes window slot of event-slots is a pixmap instead of a window.

diff --git a/ChangeLog b/ChangeLog
index 5c2c983..a3b890b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2012-01-03  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/xlib-util.lisp (handle-event): Fix a clisp/new-clx error
+	when sometimes window slot of event-slots is a pixmap instead of a
+	window.
+
 2011-12-26  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-query.lisp: Fill the history list with a non-nil
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index 23a3bdd..97ce8a9 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -155,7 +155,7 @@
   (loop
      (call-hook *loop-hook*)
      (process-timers)
-     (with-xlib-protect
+     (with-xlib-protect ()
        (when (xlib:event-listen *display* *loop-timeout*)
 	 (xlib:process-event *display* :handler #'handle-event))
        (xlib:display-finish-output *display*))))
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index 0b4ba6c..93be3b6 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -63,7 +63,7 @@ Window types are in +WINDOW-TYPES+.")
   "Alist mapping NETWM window types to keywords.")
 
 
-(defmacro with-xlib-protect (&body body)
+(defmacro with-xlib-protect (() &body body)
   "Prevent Xlib errors"
   `(handler-case
        (with-simple-restart (top-level "Return to clfswm's top level")
@@ -171,8 +171,30 @@ Expand in handle-event-fun-main-mode-key-press"
 
 
 
+;;; Workaround for pixmap error taken from STUMPWM - thanks:
+;; XXX: In both the clisp and sbcl clx libraries, sometimes what
+;; should be a window will be a pixmap instead. In this case, we
+;; need to manually translate it to a window to avoid breakage
+;; in stumpwm. So far the only slot that seems to be affected is
+;; the :window slot for configure-request and reparent-notify
+;; events. It appears as though the hash table of XIDs and clx
+;; structures gets out of sync with X or perhaps X assigns a
+;; duplicate ID for a pixmap and a window.
+(defun make-xlib-window (xobject)
+  "For some reason the clx xid cache screws up returns pixmaps when
+they should be windows. So use this function to make a window out of them."
+  #+clisp (make-instance 'xlib:window :id (slot-value xobject 'xlib::id) :display *display*)
+  #+(or sbcl ecl openmcl) (xlib::make-window :id (slot-value xobject 'xlib::id) :display *display*)
+  #-(or sbcl clisp ecl openmcl)
+  (error 'not-implemented))
+
+
 (defun handle-event (&rest event-slots &key event-key &allow-other-keys)
-  (with-xlib-protect
+  (with-xlib-protect ()
+    (let ((win (getf event-slots :window)))
+      (when (and win (not (xlib:window-p win)))
+        (dbg "Pixmap Workaround! Should be a window: " win)
+        (setf (getf event-slots :window) (make-xlib-window win))))
     (if (fboundp event-key)
 	(apply event-key event-slots)
 	#+:event-debug (pushnew (list *current-event-mode* event-key) *unhandled-events* :test #'equal))

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog          |    6 ++++++
 src/clfswm.lisp    |    2 +-
 src/xlib-util.lisp |   26 ++++++++++++++++++++++++--
 3 files changed, 31 insertions(+), 3 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager



From pbrochard at common-lisp.net  Wed Jan  4 21:52:01 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 04 Jan 2012 13:52:01 -0800
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-13-g29254aa
Message-ID: <E1RiYkb-0000gc-DV@common-lisp.net>

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  29254aac066a910669406599cd229404af7c28c0 (commit)
      from  5e8514a2cde78233d5d956de63a8e359ebecba3f (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 29254aac066a910669406599cd229404af7c28c0
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed Jan 4 22:51:55 2012 +0100

    src/xlib-util.lisp (with-xlib-protect): Protect from xlib:lookup-error. This prevent an error in clisp/new-clx when sometimes an xlib:colormap is expected instead of an xlib:window.

diff --git a/ChangeLog b/ChangeLog
index a3b890b..0c91d05 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2012-01-04  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/xlib-util.lisp (with-xlib-protect): Protect from
+	xlib:lookup-error. This prevent an error in clisp/new-clx when
+	sometimes an xlib:colormap is expected instead of an xlib:window.
+
 2012-01-03  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/xlib-util.lisp (handle-event): Fix a clisp/new-clx error
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index 93be3b6..cde1d50 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -68,9 +68,9 @@ Window types are in +WINDOW-TYPES+.")
   `(handler-case
        (with-simple-restart (top-level "Return to clfswm's top level")
 	 , at body)
-     ((or xlib:match-error xlib:window-error xlib:drawable-error) (c)
+     ((or xlib:match-error xlib:window-error xlib:drawable-error xlib:lookup-error) (c)
        (progn
-	 (dbg "Ignore Xlib Error" c ',body)
+         (format t "Ignoring XLib error: ~S~%" c)
 	 (unassoc-keyword-handle-event)
 	 (assoc-keyword-handle-event 'main-mode)
 	 (setf *in-second-mode* nil)))))

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog          |    6 ++++++
 src/xlib-util.lisp |    4 ++--
 2 files changed, 8 insertions(+), 2 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager



From pbrochard at common-lisp.net  Wed Jan  4 22:12:20 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 04 Jan 2012 14:12:20 -0800
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-14-g74320af
Message-ID: <E1RiZ4G-0002Mi-NJ@common-lisp.net>

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  74320af30b9c8cba649690252f48be1dc04b3ebc (commit)
      from  29254aac066a910669406599cd229404af7c28c0 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 74320af30b9c8cba649690252f48be1dc04b3ebc
Author: Ales Guzik <ales.guzik at gmail.com>
Date:   Wed Jan 4 23:12:00 2012 +0100

    src/clfswm-layout.lisp (update-layout-managed-children-keep-position): Fix an inattention error.

diff --git a/ChangeLog b/ChangeLog
index 0c91d05..8721247 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-01-04  Ales Guzik <ales.guzik at gmail.com>
+
+	* src/clfswm-layout.lisp (update-layout-managed-children-keep-position):
+	Fix an inattention error.
+
 2012-01-04  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/xlib-util.lisp (with-xlib-protect): Protect from
diff --git a/src/clfswm-layout.lisp b/src/clfswm-layout.lisp
index 449e1c6..fd80deb 100644
--- a/src/clfswm-layout.lisp
+++ b/src/clfswm-layout.lisp
@@ -237,7 +237,7 @@
 	(managed-in-parent (get-managed-child parent)))
     (dolist (ch managed-in-parent)
       (unless (child-member ch managed-children)
-	(setf managed-children (append managed-children (list child)))))
+	(setf managed-children (append managed-children (list ch)))))
     (setf managed-children (remove-if-not (lambda (x)
 					    (child-member x managed-in-parent))
 					  managed-children))

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog              |    5 +++++
 src/clfswm-layout.lisp |    2 +-
 2 files changed, 6 insertions(+), 1 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager



From pbrochard at common-lisp.net  Wed Jan  4 22:24:50 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 04 Jan 2012 14:24:50 -0800
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-15-g807ed53
Message-ID: <E1RiZGM-0003Bj-GO@common-lisp.net>

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  807ed53d0c5b8045904ffcc1b449483b8ffbfa0b (commit)
      from  74320af30b9c8cba649690252f48be1dc04b3ebc (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 807ed53d0c5b8045904ffcc1b449483b8ffbfa0b
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed Jan 4 23:24:44 2012 +0100

    load.lisp: Support clisp 2.49+ module system to load CLX.

diff --git a/ChangeLog b/ChangeLog
index 8721247..812da85 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2012-01-04  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* load.lisp: Support clisp 2.49+ module system to load CLX.
+
 2012-01-04  Ales Guzik <ales.guzik at gmail.com>
 
 	* src/clfswm-layout.lisp (update-layout-managed-children-keep-position):
diff --git a/load.lisp b/load.lisp
index e6d5299..7955af5 100644
--- a/load.lisp
+++ b/load.lisp
@@ -41,6 +41,10 @@
 #+(or CMU ECL)
 (require :clx)
 
+#+(AND CLISP (not CLX))
+(when (fboundp 'require)
+  (require "clx.lisp"))
+
 #-ASDF
 (load (make-pathname :host (pathname-host *base-dir*)
 		     :device (pathname-device *base-dir*)
diff --git a/src/clfswm-layout.lisp b/src/clfswm-layout.lisp
index fd80deb..08be39d 100644
--- a/src/clfswm-layout.lisp
+++ b/src/clfswm-layout.lisp
@@ -233,6 +233,7 @@
 
 
 (defun update-layout-managed-children-keep-position (child parent)
+  (declare (ignore child))
   (let ((managed-children (frame-data-slot parent :layout-managed-children))
 	(managed-in-parent (get-managed-child parent)))
     (dolist (ch managed-in-parent)

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog              |    4 ++++
 load.lisp              |    4 ++++
 src/clfswm-layout.lisp |    1 +
 3 files changed, 9 insertions(+), 0 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager



From pbrochard at common-lisp.net  Mon Jan  9 21:59:43 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Mon, 09 Jan 2012 13:59:43 -0800
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-16-g83adc09
Message-ID: <E1RkNFn-0001yj-8S@common-lisp.net>

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  83adc09c65378d7f410342f30e22b5246550ec0c (commit)
      from  807ed53d0c5b8045904ffcc1b449483b8ffbfa0b (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 83adc09c65378d7f410342f30e22b5246550ec0c
Author: Ales Guzik <ales.guzik at gmail.com>
Date:   Mon Jan 9 22:59:37 2012 +0100

    src/clfswm-layout.lisp (tile-layout-mix): New layout to automatically choose between vertival and horizontal tile layout. (tile-space-layout): Fix to have space between screen border and frame the same as between frames.

diff --git a/ChangeLog b/ChangeLog
index 812da85..7407ee5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2012-01-09  Ales Guzik <ales.guzik at gmail.com>
+
+	* src/clfswm-layout.lisp (tile-layout-mix): New layout to
+	automatically choose between vertival and horizontal tile layout.
+	(tile-space-layout): Fix to have space between screen border and
+	frame the same as between frames.
+
 2012-01-04  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* load.lisp: Support clisp 2.49+ module system to load CLX.
diff --git a/src/clfswm-layout.lisp b/src/clfswm-layout.lisp
index 08be39d..b3872a7 100644
--- a/src/clfswm-layout.lisp
+++ b/src/clfswm-layout.lisp
@@ -311,6 +311,41 @@
 
 
 
+
+;; Mix tile layout : automatic choose between vertical/horizontal
+(defgeneric tile-layout-mix (child parent)
+  (:documentation "Tile child in its frame (mix: automatic choose between vertical/horizontal)"))
+
+(defmethod tile-layout-mix (child parent)
+  (let* ((managed-children (update-layout-managed-children child parent))
+         (pos (child-position child managed-children))
+         (len (length managed-children))
+         (d1 (ceiling (sqrt len)))
+         (d2  (ceiling (/ len d1)))
+         (nx (if (> (frame-rw parent) (frame-rh parent)) d1 d2))
+         (ny (if (> (frame-rw parent) (frame-rh parent)) d2 d1))
+         (dx (/ (frame-rw parent) nx))
+         (dy (/ (frame-rh parent) ny))
+         (dpos (- (* nx ny) len))
+         (width dx))
+    (when (plusp dpos)
+      (if (zerop pos)
+          (setf width (* dx (1+ dpos)))
+          (incf pos dpos)))
+    (values (round (adj-border-xy (+ (frame-rx parent)
+                                     (truncate (* (mod pos nx) dx))) child))
+            (round (adj-border-xy (+ (frame-ry parent)
+                                     (truncate (* (truncate (/ pos nx)) dy))) child))
+            (round (adj-border-wh width child))
+            (round (adj-border-wh dy child)))))
+
+
+(defun set-tile-layout-mix ()
+  "Tile child in its frame (mix: automatic choose between vertical/horizontal)"
+  (set-layout-managed-children)
+  (set-layout #'tile-layout-mix))
+
+
 ;; One column layout
 (defgeneric one-column-layout (child parent)
   (:documentation "One column layout"))
@@ -359,19 +394,28 @@
   "Tile Space: tile child in its frame leaving spaces between them"
   (with-slots (rx ry rw rh) parent
     (let* ((managed-children (update-layout-managed-children child parent))
-	   (pos (child-position child managed-children))
-	   (len (length managed-children))
-	   (n (ceiling (sqrt len)))
-	   (dx (/ rw n))
-	   (dy (/ rh (ceiling (/ len n))))
-	   (size (or (frame-data-slot parent :tile-space-size) 0.1)))
-      (when (> size 0.5) (setf size 0.45))
-      (values (round (adj-border-xy (+ rx (truncate (* (mod pos n) dx)) (* dx size)) child))
-	      (round (adj-border-xy (+ ry (truncate (* (truncate (/ pos n)) dy)) (* dy size)) child))
-	      (round (adj-border-wh (- dx (* dx size 2)) child))
-	      (round (adj-border-wh (- dy (* dy size 2)) child))))))
-
-
+           (pos (child-position child managed-children))
+           (len (length managed-children))
+           (d1 (ceiling (sqrt len)))
+           (d2 (ceiling (/ len d1)))
+           (cols (if (> rw rh) d1 d2))
+           (rows (if (> rw rh) d2 d1))
+           (col (mod pos cols))
+           (row (floor pos cols))
+           (space-percent (or (frame-data-slot parent :tile-space-size) 0.05))
+           (col-space-total (* rw space-percent))
+           (row-space-total (* rh space-percent))
+           (col-space (floor col-space-total (1+ cols)))
+           (row-space (floor row-space-total (1+ rows)))
+           (child-width (floor (- rw col-space-total) cols))
+           (child-height (floor (- rh row-space-total) rows))
+           )
+      (values (round (adj-border-xy (+ rx col-space
+                                       (* (+ col-space child-width) col)) child))
+              (round (adj-border-xy (+ ry row-space
+                               (* (+ row-space child-height) row)) child))
+              (round (adj-border-wh child-width child))
+              (round (adj-border-wh child-height child))))))
 
 
 (defun set-tile-space-layout ()
@@ -385,6 +429,7 @@
 (register-layout-sub-menu 'frame-tile-layout-menu "Frame tile layout menu"
 			  '(("v" set-tile-layout)
 			    ("h" set-tile-horizontal-layout)
+                            ("m" set-tile-layout-mix)
 			    ("c" set-one-column-layout)
 			    ("l" set-one-line-layout)
 			    ("s" set-tile-space-layout)))

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog              |    7 +++++
 src/clfswm-layout.lisp |   71 +++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 65 insertions(+), 13 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager



From pbrochard at common-lisp.net  Sat Jan 14 22:42:26 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Sat, 14 Jan 2012 14:42:26 -0800
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-17-g7873a02
Message-ID: <E1RmCIs-0003fq-SY@common-lisp.net>

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  7873a020b3a560a9186b3994cd0ef78139554367 (commit)
      from  83adc09c65378d7f410342f30e22b5246550ec0c (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 7873a020b3a560a9186b3994cd0ef78139554367
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Sat Jan 14 23:42:19 2012 +0100

    src/*.lisp: Add transparency support.

diff --git a/ChangeLog b/ChangeLog
index 7407ee5..1a89174 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2012-01-14  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/*.lisp: Add transparency support.
+
 2012-01-09  Ales Guzik <ales.guzik at gmail.com>
 
 	* src/clfswm-layout.lisp (tile-layout-mix): New layout to
diff --git a/src/clfswm-info.lisp b/src/clfswm-info.lisp
index 0d0b36b..ac80674 100644
--- a/src/clfswm-info.lisp
+++ b/src/clfswm-info.lisp
@@ -90,10 +90,13 @@
 				  :background (if (equal posy *info-selected-item*)
 						  (get-color *info-selected-background*)
 						  (get-color *info-background*)))
-	       (xlib:draw-image-glyphs *pixmap-buffer* (info-gc info)
-				 (- (+ (info-ilw info) (* posx (info-ilw info))) (info-x info))
-				 (info-y-display-coords info posy)
-				 (format nil "~A" line)))
+	       (funcall (if (equal posy *info-selected-item*)
+                            #'xlib:draw-image-glyphs
+                            #'xlib:draw-glyphs)
+                        *pixmap-buffer* (info-gc info)
+                        (- (+ (info-ilw info) (* posx (info-ilw info))) (info-x info))
+                        (info-y-display-coords info posy)
+                        (format nil "~A" line)))
 	     (+ posx (length line))))
     (clear-pixmap-buffer (info-window info) (info-gc info))
     (loop for line in (info-list info)
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index e3a6c03..b363f04 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -1243,11 +1243,45 @@ managed."
 
 
 
+(defun with-all-mapped-windows (screen fun)
+  (let ((all-windows (get-all-windows)))
+    (dolist (win (xlib:query-tree (xlib:screen-root screen)))
+      (unless (child-member win all-windows)
+	(let ((map-state (xlib:window-map-state win))
+	      (wm-state (window-state win)))
+	  (unless (or (eql (xlib:window-override-redirect win) :on)
+		      (eql win *no-focus-window*)
+                      (is-notify-window-p win))
+	    (when (or (eql map-state :viewable)
+		      (eql wm-state +iconic-state+))
+              (funcall fun win))))))))
+
+(defun store-root-background ()
+  (with-all-mapped-windows *screen* #'hide-window)
+  (setf *background-image* (xlib:create-pixmap :width (xlib:screen-width *screen*)
+                                               :height (xlib:screen-height *screen*)
+                                               :depth (xlib:screen-root-depth *screen*)
+                                               :drawable *root*)
+        *background-gc* (xlib:create-gcontext :drawable *background-image*
+                                              :foreground (get-color *frame-foreground*)
+                                              :background (get-color *frame-background*)
+                                              :font *default-font*
+                                              :line-style :solid))
+  (xlib:copy-area *root* *background-gc*
+                  0 0 (xlib:screen-width *screen*) (xlib:screen-height *screen*)
+                  *background-image* 0 0)
+  (with-all-mapped-windows *screen* #'unhide-window))
+
+
+
+
 (defun hide-existing-windows (screen)
   "Hide all existing windows in screen"
   (dolist (win (xlib:query-tree (xlib:screen-root screen)))
     (hide-window win)))
 
+
+
 (defun process-existing-windows (screen)
   "Windows present when clfswm starts up must be absorbed by clfswm."
   (setf *in-process-existing-windows* t)
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index 97ce8a9..9aa3844 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -190,6 +190,7 @@
 					    :depth (xlib:screen-root-depth *screen*)
 					    :drawable *root*)
 	*in-second-mode* nil)
+  (store-root-background)
   (init-modifier-list)
   (xgrab-init-pointer)
   (xgrab-init-keyboard)
diff --git a/src/package.lisp b/src/package.lisp
index f29bcd7..6a64860 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -45,6 +45,8 @@
 This variable may be useful to speed up some slow version of CLX.
 It is particulary useful with CLISP/MIT-CLX.")
 
+(defconfig *transparent-background* t nil
+           "Enable transparent background")
 
 (defconfig *show-root-frame-p* nil nil
            "Show the root frame information or not")
@@ -68,6 +70,9 @@ It is particulary useful with CLISP/MIT-CLX.")
 (defparameter *root* nil)
 (defparameter *no-focus-window* nil)
 
+(defparameter *background-image* nil)
+(defparameter *background-gc* nil)
+
 (defconfig *loop-timeout* 0.1 nil
            "Maximum time (in seconds) to wait before calling *loop-hook*")
 
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index cde1d50..97c74bd 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -837,19 +837,25 @@ they should be windows. So use this function to make a window out of them."
 
 
 
-
 ;;; Double buffering tools
 (defun clear-pixmap-buffer (window gc)
-  (rotatef (xlib:gcontext-foreground gc) (xlib:gcontext-background gc))
-  (xlib:draw-rectangle *pixmap-buffer* gc
-		       0 0 (x-drawable-width window) (x-drawable-height window)
-		       t)
-  (rotatef (xlib:gcontext-foreground gc) (xlib:gcontext-background gc)))
+  (if *transparent-background*
+      (xlib:copy-area *background-image* *background-gc*
+                      (x-drawable-x window) (x-drawable-y window)
+                      (x-drawable-width window) (x-drawable-height window)
+                      *pixmap-buffer* 0 0)
+      (xlib:with-gcontext (gc :foreground (xlib:gcontext-background gc)
+                              :background (xlib:gcontext-foreground gc))
+        (xlib:draw-rectangle *pixmap-buffer* gc
+                             0 0 (x-drawable-width window) (x-drawable-height window)
+                             t))))
+
 
 (defun copy-pixmap-buffer (window gc)
   (xlib:copy-area *pixmap-buffer* gc
-		  0 0 (x-drawable-width window) (x-drawable-height window)
-		  window 0 0))
+  		  0 0 (x-drawable-width window) (x-drawable-height window)
+  		  window 0 0))
+
 
 
 (defun is-a-key-pressed-p ()

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog                |    4 ++++
 src/clfswm-info.lisp     |   11 +++++++----
 src/clfswm-internal.lisp |   34 ++++++++++++++++++++++++++++++++++
 src/clfswm.lisp          |    1 +
 src/package.lisp         |    5 +++++
 src/xlib-util.lisp       |   22 ++++++++++++++--------
 6 files changed, 65 insertions(+), 12 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager



From pbrochard at common-lisp.net  Tue Jan 17 22:33:28 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 17 Jan 2012 14:33:28 -0800
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-18-gc32a530
Message-ID: <E1RnHaq-0000SU-5V@common-lisp.net>

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  c32a530824352e04fb3374de13ba8dbc408015a5 (commit)
      from  7873a020b3a560a9186b3994cd0ef78139554367 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit c32a530824352e04fb3374de13ba8dbc408015a5
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Tue Jan 17 23:33:21 2012 +0100

    Add full transparency support (with xcompmgr)

diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index 3f5edd8..618568a 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -218,6 +218,7 @@
 					       :background (get-color *circulate-background*)
 					       :font *circulate-font*
 					       :line-style :solid))
+    (setf (window-transparency *circulate-window*) *circulate-transparency*)
     (map-window *circulate-window*)
     (draw-circulate-mode-window)
     (when child-direction
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index 5039b2d..e17d4f6 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -130,6 +130,7 @@
 				       :background (get-color *expose-background*)
 				       :font *expose-font*
 				       :line-style :solid)))
+        (setf (window-transparency window) *expose-transparency*)
 	(map-window window)
 	(push (list window gc string child) *expose-windows-list*)))))
 
diff --git a/src/clfswm-info.lisp b/src/clfswm-info.lisp
index ac80674..b5f58b6 100644
--- a/src/clfswm-info.lisp
+++ b/src/clfswm-info.lisp
@@ -341,6 +341,7 @@ Or ((1_word color) (2_word color) 3_word (4_word color)...)"
 				    :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)))
+              (setf (window-transparency window) *info-transparency*)
 	      (map-window window)
 	      (draw-info-window info)
 	      (xgrab-pointer *root* 68 69)
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index b363f04..2331401 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -237,6 +237,34 @@
   "???")
 
 
+(defgeneric child-transparency (child))
+
+(defmethod child-transparency ((child xlib:window))
+  (window-transparency child))
+
+(defmethod child-transparency ((child frame))
+  (window-transparency (frame-window child)))
+
+(defmethod child-transparency (child)
+  (declare (ignore child))
+  1)
+
+(defgeneric set-child-transparency (child value))
+
+(defmethod set-child-transparency ((child xlib:window) value)
+  (setf (window-transparency child) value))
+
+(defmethod set-child-transparency ((child frame) value)
+  (setf (window-transparency (frame-window child)) value))
+
+(defmethod set-child-transparency (child value)
+  (declare (ignore child value)))
+
+(defsetf child-transparency set-child-transparency)
+
+
+
+
 (defgeneric child-x (child))
 (defmethod child-x ((child xlib:window))
   (x-drawable-x child))
@@ -444,16 +472,18 @@
 
 
 (defun create-frame-window ()
-  (xlib:create-window :parent *root*
-                      :x 0
-                      :y 0
-                      :width 200
-                      :height 200
-                      :background (get-color *frame-background*)
-                      :colormap (xlib:screen-default-colormap *screen*)
-                      :border-width *border-size*
-                      :border (get-color *color-selected*)
-                      :event-mask '(:exposure :button-press :button-release :pointer-motion :enter-window)))
+  (let ((win (xlib:create-window :parent *root*
+                                 :x 0
+                                 :y 0
+                                 :width 200
+                                 :height 200
+                                 :background (get-color *frame-background*)
+                                 :colormap (xlib:screen-default-colormap *screen*)
+                                 :border-width *border-size*
+                                 :border (get-color *color-selected*)
+                                 :event-mask '(:exposure :button-press :button-release :pointer-motion :enter-window))))
+    (setf (window-transparency win) *frame-transparency*)
+    win))
 
 (defun create-frame-gc (window)
   (xlib:create-gcontext :drawable window
diff --git a/src/clfswm-query.lisp b/src/clfswm-query.lisp
index a3d881a..7838bb2 100644
--- a/src/clfswm-query.lisp
+++ b/src/clfswm-query.lisp
@@ -148,6 +148,7 @@
 					     :background (get-color *query-background*)
 					     :font *query-font*
 					     :line-style :solid))
+      (setf (window-transparency *query-window*) *query-transparency*)
       (map-window *query-window*)
       (query-print-string)
       (wait-no-key-or-button-press))))
diff --git a/src/clfswm-second-mode.lisp b/src/clfswm-second-mode.lisp
index 9d36c53..48e21d3 100644
--- a/src/clfswm-second-mode.lisp
+++ b/src/clfswm-second-mode.lisp
@@ -114,6 +114,7 @@
 					:background (get-color *sm-background-color*)
 					:font *sm-font*
 					:line-style :solid)))
+  (setf (window-transparency *sm-window*) *sm-transparency*)
   (map-window *sm-window*)
   (draw-second-mode-window)
   (no-focus)
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index e24f7f6..4317de3 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -80,6 +80,20 @@
     (leave-second-mode)))
 
 
+(defun ask-child-transparency (msg child)
+  (let ((trans (query-number (format nil "New ~A transparency: (last: ~A)"
+                                     msg
+                                     (* 100 (child-transparency child)))
+                             (* 100 (child-transparency child)))))
+    (when (numberp trans)
+      (setf (child-transparency child) (float (/ trans 100))))))
+
+(defun set-current-child-transparency ()
+  "Set the current child transparency"
+  (ask-child-transparency "child" *current-child*)
+  (leave-second-mode))
+
+
 (defun renumber-current-frame ()
   "Renumber the current frame"
   (when (frame-p *current-child*)
@@ -337,6 +351,7 @@
 				   :background (get-color *identify-background*)
 				   :font font
 				   :line-style :solid)))
+    (setf (window-transparency window) *identify-transparency*)
     (labels ((print-doc (msg hash-table-key pos code state)
 	       (let ((function (find-key-from-code hash-table-key code state)))
 		 (when (and function (fboundp (first function)))
@@ -1010,7 +1025,14 @@ For window: set current child to window or its parent according to window-parent
 		     (format nil "Window name:  ~A" (xlib:wm-name window))
 		     (format nil "Window class: ~A" (xlib:get-wm-class window))
 		     (format nil "Window type:  ~:(~A~)" (window-type window))
-		     (format nil "Window id:    0x~X" (xlib:window-id window)))))
+		     (format nil "Window id:    0x~X" (xlib:window-id window))
+                     (format nil "Window transparency: ~A" (* 100 (window-transparency window))))))
+  (leave-second-mode))
+
+(defun set-current-window-transparency ()
+  "Set the current window transparency"
+  (with-current-window
+      (ask-child-transparency "window" window))
   (leave-second-mode))
 
 
@@ -1566,6 +1588,7 @@ For window: set current child to window or its parent according to window-parent
 					 :background (get-color *notify-window-background*)
 					 :font font
 					 :line-style :solid))
+          (setf (window-transparency window) *notify-window-transparency*)
 	  (when (frame-p *current-child*)
 	    (setf current-child *current-child*)
 	    (push (list #'is-notify-window-p 'raise-window) *never-managed-window-list*))
diff --git a/src/config.lisp b/src/config.lisp
index 85d828b..d142b52 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -201,6 +201,8 @@ on the root window in the main mode with the mouse")
   'Frame-colors "Frame foreground when the frame is the root frame")
 (defconfig *frame-foreground-hidden* "Darkgreen"
   'Frame-colors "Frame foreground for hidden windows")
+(defconfig *frame-transparency* *default-transparency*
+  'Frame-colors "Frame background transparency")
 
 ;;; CONFIG: Default window size
 (defconfig *default-window-width* 400
@@ -221,7 +223,8 @@ on the root window in the main mode with the mouse")
   'Second-mode "Second mode window width")
 (defconfig *sm-height* 25
   'Second-mode "Second mode window height")
-
+(defconfig *sm-transparency* *default-transparency*
+  'Second-mode "Second mode background transparency")
 
 
 
@@ -235,6 +238,8 @@ on the root window in the main mode with the mouse")
   'Identify-key "Identify window foreground color")
 (defconfig *identify-border* "red"
   'Identify-key "Identify window border color")
+(defconfig *identify-transparency* *default-transparency*
+  'Identify-key "Identify window background transparency")
 
 ;;; CONFIG - Query string colors
 (defconfig *query-font-string* *default-font-string*
@@ -253,6 +258,8 @@ on the root window in the main mode with the mouse")
   'Query-string "Query string window parenthesis color when no match")
 (defconfig *query-border* "red"
   'Query-string "Query string window border color")
+(defconfig *query-transparency* *default-transparency*
+  'Query-string "Query string window background transparency")
 
 
 ;;; CONFIG - Info mode
@@ -268,6 +275,8 @@ on the root window in the main mode with the mouse")
   'Info-mode "Info selected item background color")
 (defconfig *info-font-string* *default-font-string*
   'Info-mode "Info window font string")
+(defconfig *info-transparency* *default-transparency*
+  'Info-mode "Info window background transparency")
 
 (defconfig *info-click-to-select* t
   'Info-mode "If true, click on info window select item. Otherwise, click to drag the menu")
@@ -285,6 +294,8 @@ on the root window in the main mode with the mouse")
   'Circulate-mode "Circulate mode window width")
 (defconfig *circulate-height* 15
   'Circulate-mode "Circulate mode window height")
+(defconfig *circulate-transparency* *default-transparency*
+  'Circulate-mode "Circulate window background transparency")
 
 
 (defconfig *circulate-text-limite* 30
@@ -304,6 +315,8 @@ on the root window in the main mode with the mouse")
   'Expose-mode "Valid expose mode when an accel key is pressed")
 (defconfig *expose-show-window-title* t
   'Expose-mode "Show the window title on accel window")
+(defconfig *expose-transparency* *default-transparency*
+  'Expose-mode "Expose string window background transparency")
 
 
 
@@ -341,5 +354,6 @@ on the root window in the main mode with the mouse")
   'Notify-Window "Notify Window border color")
 (defconfig *notify-window-delay* 10
   'Notify-Window "Notify Window display delay")
-
+(defconfig *notify-window-transparency* *default-transparency*
+  'Notify-window "Notify window background transparency")
 
diff --git a/src/menu-def.lisp b/src/menu-def.lisp
index fda594b..f5f1f6e 100644
--- a/src/menu-def.lisp
+++ b/src/menu-def.lisp
@@ -77,6 +77,7 @@
 
 
 (add-menu-key 'child-menu "r" 'rename-current-child)
+(add-menu-key 'child-menu "t" 'set-current-child-transparency)
 (add-menu-key 'child-menu "e" 'ensure-unique-name)
 (add-menu-key 'child-menu "n" 'ensure-unique-number)
 (add-menu-key 'child-menu "Delete" 'delete-current-child)
@@ -176,6 +177,7 @@
 
 
 (add-menu-key 'window-menu "i" 'display-current-window-info)
+(add-menu-key 'window-menu "t" 'set-current-window-transparency)
 (add-menu-key 'window-menu "f" 'force-window-in-frame)
 (add-menu-key 'window-menu "c" 'force-window-center-in-frame)
 (add-menu-key 'window-menu "m" 'manage-current-window)
@@ -194,7 +196,6 @@
 (add-menu-key 'selection-menu "z" 'clear-selection)
 
 
-
 (add-menu-key 'action-by-name-menu "f" 'focus-frame-by-name)
 (add-menu-key 'action-by-name-menu "o" 'open-frame-by-name)
 (add-menu-key 'action-by-name-menu "d" 'delete-frame-by-name)
diff --git a/src/package.lisp b/src/package.lisp
index 6a64860..164a488 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -46,7 +46,10 @@ This variable may be useful to speed up some slow version of CLX.
 It is particulary useful with CLISP/MIT-CLX.")
 
 (defconfig *transparent-background* t nil
-           "Enable transparent background")
+           "Enable transparent background: one of nil, :pseudo, t (xcompmgr must be started)")
+
+(defconfig *default-transparency* 0.6 nil
+           "Default transparency for all windows when in xcompmgr transparency mode")
 
 (defconfig *show-root-frame-p* nil nil
            "Show the root frame information or not")
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index 97c74bd..bd566ee 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -221,6 +221,22 @@ they should be windows. So use this function to make a window out of them."
     (xlib:warp-pointer *root* x y)))
 
 
+;;; Transparency support
+(let ((opaque #xFFFFFFFF))
+  (defun window-transparency (window)
+    "Return the window transparency"
+    (float (/ (or (first (xlib:get-property window :_NET_WM_WINDOW_OPACITY)) opaque)  opaque)))
+
+  (defun set-window-transparency (window value)
+    "Set the window transparency"
+    (when (numberp value)
+      (xlib:change-property window :_NET_WM_WINDOW_OPACITY
+                            (list (min (round (* opaque (if (equal *transparent-background* t) value 1))) opaque))
+                            :cardinal 32)))
+
+  (defsetf window-transparency set-window-transparency))
+
+
 
 (defun window-state (win)
   "Get the state (iconic, normal, withdrawn) of a window."
@@ -393,7 +409,6 @@ they should be windows. So use this function to make a window out of them."
 
 
 
-
 ;;; Stolen from Eclipse
 (defun send-configuration-notify (window x y w h bw)
   "Send a synthetic configure notify event to the given window (ICCCM 4.1.5)"
@@ -839,7 +854,7 @@ they should be windows. So use this function to make a window out of them."
 
 ;;; Double buffering tools
 (defun clear-pixmap-buffer (window gc)
-  (if *transparent-background*
+  (if (equal *transparent-background* :pseudo)
       (xlib:copy-area *background-image* *background-gc*
                       (x-drawable-x window) (x-drawable-y window)
                       (x-drawable-width window) (x-drawable-height window)

-----------------------------------------------------------------------

Summary of changes:
 src/clfswm-circulate-mode.lisp |    1 +
 src/clfswm-expose-mode.lisp    |    1 +
 src/clfswm-info.lisp           |    1 +
 src/clfswm-internal.lisp       |   50 ++++++++++++++++++++++++++++++++--------
 src/clfswm-query.lisp          |    1 +
 src/clfswm-second-mode.lisp    |    1 +
 src/clfswm-util.lisp           |   25 +++++++++++++++++++-
 src/config.lisp                |   18 ++++++++++++-
 src/menu-def.lisp              |    3 +-
 src/package.lisp               |    5 +++-
 src/xlib-util.lisp             |   19 +++++++++++++-
 11 files changed, 108 insertions(+), 17 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager



From pbrochard at common-lisp.net  Tue Jan 17 23:06:19 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Tue, 17 Jan 2012 15:06:19 -0800
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-19-ge80edf8
Message-ID: <E1RnI6d-0001jh-Re@common-lisp.net>

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  e80edf80fac89a72295f52b7ef6f1f144fed0c8c (commit)
      from  c32a530824352e04fb3374de13ba8dbc408015a5 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit e80edf80fac89a72295f52b7ef6f1f144fed0c8c
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed Jan 18 00:06:14 2012 +0100

    src/clfswm-keys.lisp (define-keys): New macro to ease multiple keys definitions. (Thanks Valentin Plechinger for the request).

diff --git a/ChangeLog b/ChangeLog
index 1a89174..cc340f8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2012-01-18  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-keys.lisp (define-keys): New macro to ease multiple
+	keys definitions. (Thanks Valentin Plechinger for the request).
+
+	* src/*.lisp: Add full transparency support with xcompmgr.
+
 2012-01-14  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/*.lisp: Add transparency support.
diff --git a/src/clfswm-keys.lisp b/src/clfswm-keys.lisp
index 6a40d64..0aedb55 100644
--- a/src/clfswm-keys.lisp
+++ b/src/clfswm-keys.lisp
@@ -248,3 +248,9 @@
 		      hashtable)))
     (dolist (h hashtables)
       (change h to from))))
+
+
+(defmacro define-keys ((mode) &body keys)
+  (let ((symb (symb "DEFINE-" mode "-KEY")))
+    `(progn
+       ,@(loop for k in keys collect `(,symb , at k)))))

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog            |    7 +++++++
 src/clfswm-keys.lisp |    6 ++++++
 2 files changed, 13 insertions(+), 0 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager



From pbrochard at common-lisp.net  Wed Jan 18 21:59:08 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 18 Jan 2012 13:59:08 -0800
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-20-g8f97d3e
Message-ID: <E1RndXA-00067t-Jk@common-lisp.net>

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  8f97d3ed7637d664ca02edd295bfd47035dc40a5 (commit)
      from  e80edf80fac89a72295f52b7ef6f1f144fed0c8c (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 8f97d3ed7637d664ca02edd295bfd47035dc40a5
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed Jan 18 22:59:02 2012 +0100

    src/bindings-second-mode.lisp (set-default-second-keys): New key binding to set window and frame transparency. src/bindings.lisp (set-default-main-mouse): New mouse binding to set window and frame transparency.

diff --git a/ChangeLog b/ChangeLog
index cc340f8..4bdd870 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2012-01-18  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/bindings-second-mode.lisp (set-default-second-keys): New
+	key binding to set window and frame transparency.
+
+	* src/bindings.lisp (set-default-main-mouse): New mouse binding to
+	set window and frame transparency.
+
 	* src/clfswm-keys.lisp (define-keys): New macro to ease multiple
 	keys definitions. (Thanks Valentin Plechinger for the request).
 
diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp
index f62a1fc..dd3eef9 100644
--- a/src/bindings-second-mode.lisp
+++ b/src/bindings-second-mode.lisp
@@ -181,7 +181,10 @@
   (define-second-key ("7" :mod-1) 'bind-or-jump 7)
   (define-second-key ("8" :mod-1) 'bind-or-jump 8)
   (define-second-key ("9" :mod-1) 'bind-or-jump 9)
-  (define-second-key ("0" :mod-1) 'bind-or-jump 10))
+  (define-second-key ("0" :mod-1) 'bind-or-jump 10)
+  ;;; Transparency
+  (define-second-key ("t" :control :shift) 'key-inc-transparency)
+  (define-second-key ("t" :control) 'key-dec-transparency))
 
 (add-hook *binding-hook* 'set-default-second-keys)
 
diff --git a/src/bindings.lisp b/src/bindings.lisp
index e8fe183..142d9f2 100644
--- a/src/bindings.lisp
+++ b/src/bindings.lisp
@@ -137,7 +137,11 @@
   (define-main-mouse (4) 'mouse-select-next-level)
   (define-main-mouse (5) 'mouse-select-previous-level)
   (define-main-mouse (4 :mod-1) 'mouse-enter-frame)
-  (define-main-mouse (5 :mod-1) 'mouse-leave-frame))
+  (define-main-mouse (5 :mod-1) 'mouse-leave-frame)
+  (define-main-mouse (4 :mod-1 :control) 'dec-transparency)
+  (define-main-mouse (5 :mod-1 :control) 'inc-transparency)
+  (define-main-mouse (4 :mod-1 :control :shift) 'dec-transparency-slow)
+  (define-main-mouse (5 :mod-1 :control :shift) 'inc-transparency-slow))
 
 (add-hook *binding-hook* 'set-default-main-mouse)
 
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 4317de3..029e445 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -1618,3 +1618,39 @@ For window: set current child to window or its parent according to window-parent
           (show-all-children t))
         (funcall run-fn))))
 
+;;; Transparency setting
+(defun inc-transparency (window root-x root-y)
+  "Increment the child under mouse transparency"
+  (declare (ignore root-x root-y))
+  (unless *in-second-mode* (stop-button-event))
+  (incf (child-transparency window) 0.1))
+
+(defun dec-transparency (window root-x root-y)
+  "Decrement the child under mouse transparency"
+  (declare (ignore root-x root-y))
+  (unless *in-second-mode* (stop-button-event))
+  (decf (child-transparency window) 0.1))
+
+(defun inc-transparency-slow (window root-x root-y)
+  "Increment slowly the child under mouse transparency"
+  (declare (ignore root-x root-y))
+  (unless *in-second-mode* (stop-button-event))
+  (incf (child-transparency window) 0.01))
+
+(defun dec-transparency-slow (window root-x root-y)
+  "Decrement slowly the child under mouse transparency"
+  (declare (ignore root-x root-y))
+  (unless *in-second-mode* (stop-button-event))
+  (decf (child-transparency window) 0.01))
+
+
+(defun key-inc-transparency ()
+  "Increment the current window transparency"
+  (with-current-window
+      (incf (child-transparency window) 0.1)))
+
+(defun key-dec-transparency ()
+  "Decrement the current window transparency"
+  (with-current-window
+      (decf (child-transparency window) 0.1)))
+
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index bd566ee..7aeaf80 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -231,7 +231,9 @@ they should be windows. So use this function to make a window out of them."
     "Set the window transparency"
     (when (numberp value)
       (xlib:change-property window :_NET_WM_WINDOW_OPACITY
-                            (list (min (round (* opaque (if (equal *transparent-background* t) value 1))) opaque))
+                            (list (max (min (round (* opaque (if (equal *transparent-background* t) value 1)))
+                                            opaque)
+                                       0))
                             :cardinal 32)))
 
   (defsetf window-transparency set-window-transparency))

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog                     |    6 ++++++
 src/bindings-second-mode.lisp |    5 ++++-
 src/bindings.lisp             |    6 +++++-
 src/clfswm-util.lisp          |   36 ++++++++++++++++++++++++++++++++++++
 src/xlib-util.lisp            |    4 +++-
 5 files changed, 54 insertions(+), 3 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager



From pbrochard at common-lisp.net  Wed Jan 18 22:43:25 2012
From: pbrochard at common-lisp.net (Philippe Brochard)
Date: Wed, 18 Jan 2012 14:43:25 -0800
Subject: [clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen
	Window Manager branch master updated. R-1106-21-g2fc480c
Message-ID: <E1RneE1-0000EI-6o@common-lisp.net>

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  2fc480c62e57ae1f6fd1e47bc7448d88f93dbe07 (commit)
      from  8f97d3ed7637d664ca02edd295bfd47035dc40a5 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 2fc480c62e57ae1f6fd1e47bc7448d88f93dbe07
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed Jan 18 23:43:20 2012 +0100

    src/*.lisp: Use create-symbol and create-symbol-in-package instead of the shorter symb. (Thanks Aad Versteden).

diff --git a/ChangeLog b/ChangeLog
index 4bdd870..8d10c79 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2012-01-18  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/*.lisp: Use create-symbol and create-symbol-in-package
+	instead of the shorter symb. (Thanks Aad Versteden).
+
 	* src/bindings-second-mode.lisp (set-default-second-keys): New
 	key binding to set window and frame transparency.
 
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index e17d4f6..e962c70 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -81,7 +81,7 @@
 
 (defmacro define-expose-letter-keys ()
   (labels ((produce-name (n)
-	     (symb "%" "expose-fun-key-" n "%")))
+	     (create-symbol "%" "expose-fun-key-" n "%")))
     `(progn
        ,@(loop for n from 0 to 61
 	    collect `(progn
diff --git a/src/clfswm-keys.lisp b/src/clfswm-keys.lisp
index 0aedb55..d188a8b 100644
--- a/src/clfswm-keys.lisp
+++ b/src/clfswm-keys.lisp
@@ -251,6 +251,6 @@
 
 
 (defmacro define-keys ((mode) &body keys)
-  (let ((symb (symb "DEFINE-" mode "-KEY")))
+  (let ((symbol (create-symbol "DEFINE-" mode "-KEY")))
     `(progn
-       ,@(loop for k in keys collect `(,symb , at k)))))
+       ,@(loop for k in keys collect `(,symbol , at k)))))
diff --git a/src/package.lisp b/src/package.lisp
index 164a488..2291007 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -265,9 +265,9 @@ loading configuration file and before opening the display.")
 (defmacro make-x-drawable (argname type)
   "Drawable wrapper to prevent type error in some CLX versions.
 Replace xlib:drawable-* functions with x-drawable-* equivalents"
-  (let ((fun-symbol (symb 'x-drawable- argname))
-        (set-symbol (symb 'set-x-drawable- argname))
-        (xlib-equiv-symbol (symb-intern :xlib 'drawable- argname)))
+  (let ((fun-symbol (create-symbol 'x-drawable- argname))
+        (set-symbol (create-symbol 'set-x-drawable- argname))
+        (xlib-equiv-symbol (create-symbol-in-package :xlib 'drawable- argname)))
     `(progn
        (declaim (inline ,fun-symbol))
        (defun ,fun-symbol (window)
@@ -275,7 +275,7 @@ Replace xlib:drawable-* functions with x-drawable-* equivalents"
        (defun ,set-symbol (window ,argname)
          (if (typep ,argname ',type)
              (setf (,xlib-equiv-symbol window) ,argname)
-             (dbg ',(symb 'drawable-type-error- argname) window ,argname (xlib:wm-name window))))
+             (dbg ',(create-symbol 'drawable-type-error- argname) window ,argname (xlib:wm-name window))))
        (defsetf ,fun-symbol ,set-symbol))))
 
 
diff --git a/src/tools.lisp b/src/tools.lisp
index 5453182..f4587f1 100644
--- a/src/tools.lisp
+++ b/src/tools.lisp
@@ -40,7 +40,7 @@
 	   :nfuncall
 	   :pfuncall
 	   :symbol-search
-	   :symb :symb-intern
+	   :create-symbol :create-symbol-in-package
 	   :call-hook
 	   :add-hook
 	   :remove-hook
@@ -62,7 +62,6 @@
 	   :empty-string-p
 	   :find-common-string
 	   :setf/=
-	   :create-symbol
 	   :number->char
            :number->string
 	   :simple-type-of
@@ -209,11 +208,11 @@
       (dolist (a args)
 	(princ a s))))
 
-  (defun symb (&rest args)
-    (values (intern (apply #'mkstr args))))
+  (defun create-symbol (&rest args)
+    (values (intern (string-upcase (apply #'mkstr args)))))
 
-  (defun symb-intern (package &rest args)
-    (values (intern (apply #'mkstr args) package))))
+  (defun create-symbol-in-package (package &rest args)
+    (values (intern (string-upcase (apply #'mkstr args)) package))))
 
 
 ;;;,-----
@@ -441,13 +440,6 @@ Return the result of the last hook"
 	 (setf ,var ,gval)))))
 
 
-
-
-(defun create-symbol (&rest names)
-  "Return a new symbol from names"
-  (intern (string-upcase (apply #'concatenate 'string names))))
-
-
 (defun number->char (number)
   (cond ((<= number 25) (code-char (+ (char-code #\a) number)))
         ((<= 26 number 35) (code-char (+ (char-code #\0) (- number 26))))
@@ -614,8 +606,8 @@ of the program to return.
 		 (unless proc
 		   (error "Cannot create process."))
 		 proc)
-    #+:ecl(ext:run-program program args :input :stream :output :stream
-			   :error :output)
+    #+:ecl (ext:run-program program args :input :stream :output :stream
+                            :error :output)
     #+:openmcl (let ((proc (ccl:run-program program args :input
 							 :stream :output
 							 :stream :wait wt)))
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index 7aeaf80..c40a0d6 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -101,7 +101,7 @@ Window types are in +WINDOW-TYPES+.")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun keyword->handle-event (mode keyword)
-    (symb 'handle-event-fun "-" mode "-" keyword)))
+    (create-symbol 'handle-event-fun "-" mode "-" keyword)))
 
 (defun handle-event->keyword (symbol)
   (let* ((name (string-downcase (symbol-name symbol)))

-----------------------------------------------------------------------

Summary of changes:
 ChangeLog                   |    3 +++
 src/clfswm-expose-mode.lisp |    2 +-
 src/clfswm-keys.lisp        |    4 ++--
 src/package.lisp            |    8 ++++----
 src/tools.lisp              |   22 +++++++---------------
 src/xlib-util.lisp          |    2 +-
 6 files changed, 18 insertions(+), 23 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager