[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1106-18-gc32a530
Philippe Brochard
pbrochard at common-lisp.net
Tue Jan 17 22:33:28 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 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
More information about the clfswm-cvs
mailing list