[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1106-17-g7873a02
Philippe Brochard
pbrochard at common-lisp.net
Sat Jan 14 22:42:26 UTC 2012
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
More information about the clfswm-cvs
mailing list