new SetWMName module, useful for working around problems running Java GUI applications.

MetaModule.hs

@@ -51,6 +51,7 @@ import XMonadContrib.NoBorders ()
 import XMonadContrib.Roledex ()
 import XMonadContrib.RotSlaves ()
 import XMonadContrib.RotView ()
+import XMonadContrib.SetWMName ()
 -- XMonadContrib.ShellPrompt depends on readline
 --import XMonadContrib.ShellPrompt ()
 import XMonadContrib.SimpleDate ()

SetWMName.hs

@@ -0,0 +1,114 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonadContrib.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 abolutely bogus values.
+-----------------------------------------------------------------------------
+
+module XMonadContrib.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 Data.Word (Word8)
+
+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 [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 (latin1StringToWord8List 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 $ atom_NET_SUPPORTING_WM_CHECK : atom_NET_WM_NAME : supportedList)
+  where
+    netSupportingWMCheckAtom :: X Atom
+    netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"
+
+    latin1StringToWord8List :: String -> [Word8]
+    latin1StringToWord8List 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 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