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
114
|
-----------------------------------------------------------------------------
-- |
-- 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.Bits ((.|.))
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
|
