Skip to content

Instantly share code, notes, and snippets.

@Niriel
Last active September 10, 2016 23:20
Show Gist options
  • Save Niriel/6933664 to your computer and use it in GitHub Desktop.
Save Niriel/6933664 to your computer and use it in GitHub Desktop.
My xmonad configuration. Java hack inside.
import XMonad
import XMonad.Config.Gnome
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageHelpers -- (isFullscreen, doFullFloat)
import XMonad.Hooks.SetWMName --hack to fix broken sun java
import XMonad.Layout.NoBorders
import XMonad.Util.CustomKeys
import Control.OldException
import Monad -- (when)
import Data.Monoid (All (All)) -- (All)
import qualified XMonad.StackSet as W
import DBus
import DBus.Connection
import DBus.Message
main :: IO ()
main = withConnection Session $ \dbus -> do
getWellKnownName dbus
xmonad $ gnomeConfig
{ modMask = myModMask -- Use Super instead of Alt.
, borderWidth = 2
, normalBorderColor = "#808080"
, focusedBorderColor = "#33cccc"
, logHook = dynamicLogWithPP (prettyPrinter dbus) -- gnome-panel.
, manageHook = composeAll
[ manageHook gnomeConfig
, isFullscreen --> doFullFloat
]
, layoutHook = smartBorders $ layoutHook gnomeConfig
, handleEventHook = evHook -- fullscreen evince.
, keys = customKeys delkeys inskeys
-- , focusFollowsMouse = False
-- , startupHook = setWMName "LG3D" -- @@ Java hack
}
where
delkeys :: XConfig l -> [(KeyMask, KeySym)]
delkeys XConfig {modMask = modm} =
[(modm, xK_j)
,(modm, xK_k)
,(modm .|. shiftMask, xK_j)
,(modm .|. shiftMask, xK_k)]
inskeys :: XConfig l -> [((KeyMask, KeySym), X ())]
inskeys conf@(XConfig {modMask = modm}) =
[((modm, xK_j ), windows W.focusUp)
,((modm, xK_k ), windows W.focusDown)
,((modm .|. shiftMask, xK_j), windows W.swapUp )
,((modm .|. shiftMask, xK_k), windows W.swapDown)
,((modm .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack
]
myModMask = mod4Mask
-- This is for xmonad to toggle evince to real full screen when viewing a
-- presentation. Should also work for totem but I don't care.
-- Helper functions to fullscreen the window
fullFloat, tileWin :: Window -> X ()
fullFloat w = windows $ W.float w r
where r = W.RationalRect 0 0 1 1
tileWin w = windows $ W.sink w
evHook :: Event -> X All
evHook (ClientMessageEvent _ _ _ dpy win typ dat) = do
state <- getAtom "_NET_WM_STATE"
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
isFull <- runQuery isFullscreen win
-- Constants for the _NET_WM_STATE protocol
let remove = 0
add = 1
toggle = 2
-- The ATOM property type for changeProperty
ptype = 4
action = head dat
when (typ == state && (fromIntegral fullsc) `elem` tail dat) $ do
when (action == add || (action == toggle && not isFull)) $ do
io $ changeProperty32 dpy win state ptype propModeReplace [fromIntegral fullsc]
fullFloat win
when (head dat == remove || (action == toggle && isFull)) $ do
io $ changeProperty32 dpy win state ptype propModeReplace []
tileWin win
-- It shouldn't be necessary for xmonad to do anything more with this event
return $ All False
evHook _ = return $ All True
-- Everything under here is for xmonad to communicate with the gnome-panel
-- applet.
prettyPrinter :: Connection -> PP
prettyPrinter dbus = defaultPP
{ ppOutput = dbusOutput dbus
, ppTitle = pangoSanitize
, ppCurrent = pangoColor "#cc33cc" . wrap "[" "]" . pangoSanitize
, ppVisible = pangoColor "yellow" . wrap "(" ")" . pangoSanitize
, ppHidden = const ""
, ppUrgent = pangoColor "red"
, ppLayout = const ""
, ppSep = " "
}
getWellKnownName :: Connection -> IO ()
getWellKnownName dbus = tryGetName `catchDyn` (\(DBus.Error _ _) -> getWellKnownName dbus)
where
tryGetName = do
namereq <- newMethodCall serviceDBus pathDBus interfaceDBus "RequestName"
addArgs namereq [String "org.xmonad.Log", Word32 5]
sendWithReplyAndBlock dbus namereq 0
return ()
dbusOutput :: Connection -> String -> IO ()
dbusOutput dbus str = do
msg <- newSignal "/org/xmonad/Log" "org.xmonad.Log" "Update"
addArgs msg [String ("<b>" ++ str ++ "</b>")]
-- If the send fails, ignore it.
send dbus msg 0 `catchDyn` (\(DBus.Error _ _) -> return 0)
return ()
pangoColor :: String -> String -> String
pangoColor fg = wrap left right
where
left = "<span foreground=\"" ++ fg ++ "\">"
right = "</span>"
pangoSanitize :: String -> String
pangoSanitize = foldr sanitize ""
where
sanitize '>' xs = "&gt;" ++ xs
sanitize '<' xs = "&lt;" ++ xs
sanitize '\"' xs = "&quot;" ++ xs
sanitize '&' xs = "&amp;" ++ xs
sanitize x xs = x:xs
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment