1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.SetWMName
-- Copyright : © 2007 Ivan Tarasov <Ivan.Tarasov@gmail.com>
-- License : BSD
--
-- Maintainer : Ivan.Tarasov@gmail.com
-- Stability : experimental
-- Portability : unportable
--
-- Sets the WM name to a given string, so that it could be detected using
-- _NET_SUPPORTING_WM_CHECK protocol.
--
-- May be useful for making Java GUI programs work, just set WM name to "LG3D"
-- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later.
--
-- Remember that you need to call the setWMName action yourself (at least until
-- we have startup hooks). E.g., you can bind it in your Config.hs:
--
-- > ((modMask .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack
--
-- and press the key combination before running the Java programs (you only
-- need to do it once per XMonad execution)
--
-- For details on the problems with running Java GUI programs in non-reparenting
-- WMs, see "http:\/\/bugs.sun.com\/bugdatabase\/view_bug.do?bug_id=6429775" and
-- related bugs.
--
-- Setting WM name to "compiz" does not solve the problem, because of yet
-- another bug in AWT code (related to insets). For LG3D insets are explicitly
-- set to 0, while for other WMs the insets are \"guessed\" and the algorithm
-- fails miserably by guessing absolutely bogus values.
-----------------------------------------------------------------------------
module XMonad.Hooks.SetWMName (
setWMName) where
import Control.Monad (join)
import Control.Monad.Reader (asks)
import Data.Char (ord)
import Data.List (nub)
import Data.Maybe (fromJust, listToMaybe, maybeToList)
import Foreign.C.Types (CChar)
import Foreign.Marshal.Alloc (alloca)
import XMonad
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Atom
import Graphics.X11.Xlib.Extras
-- | sets WM name
setWMName :: String -> X ()
setWMName name = do
atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom
atom_NET_WM_NAME <- getAtom "_NET_WM_NAME"
atom_NET_SUPPORTED_ATOM <- getAtom "_NET_SUPPORTED"
atom_UTF8_STRING <- getAtom "UTF8_STRING"
root <- asks theRoot
supportWindow <- getSupportWindow
dpy <- asks display
io $ do
-- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window
mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [fromIntegral supportWindow]) [root, supportWindow]
-- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder)
changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToCCharList name)
-- declare which _NET protocols are supported (append to the list if it exists)
supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root
changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList)
where
netSupportingWMCheckAtom :: X Atom
netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"
latin1StringToCCharList :: String -> [CChar]
latin1StringToCCharList str = map (fromIntegral . ord) str
getSupportWindow :: X Window
getSupportWindow = withDisplay $ \dpy -> do
atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom
root <- asks theRoot
supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root
validateWindow (fmap fromIntegral supportWindow)
validateWindow :: Maybe Window -> X Window
validateWindow w = do
valid <- maybe (return False) isValidWindow w
if valid then
return $ fromJust w
else
createSupportWindow
-- is there a better way to check the validity of the window?
isValidWindow :: Window -> X Bool
isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do
status <- xGetWindowAttributes dpy w p
return (status /= 0)
-- this code was translated from C (see OpenBox WM, screen.c)
createSupportWindow :: X Window
createSupportWindow = withDisplay $ \dpy -> do
root <- asks theRoot
let visual = defaultVisual dpy (defaultScreen dpy) -- should be CopyFromParent (=0), but the constructor is hidden in X11.XLib
window <- io $ allocaSetWindowAttributes $ \winAttrs -> do
set_override_redirect winAttrs True -- WM cannot decorate/move/close this window
set_event_mask winAttrs propertyChangeMask -- not sure if this is needed
let bogusX = -100
bogusY = -100
in
createWindow dpy root bogusX bogusY 1 1 0 0 inputOutput visual (cWEventMask .|. cWOverrideRedirect) winAttrs
io $ mapWindow dpy window -- not sure if this is needed
io $ lowerWindow dpy window -- not sure if this is needed
return window
|
