{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} module Main where import Control.Monad import Data.Char import Data.Function import Data.List import qualified Data.Map as M import Data.Maybe import Data.Monoid import Data.Time.Clock import Data.Time.Format import System.Directory import System.Exit import System.FilePath import System.IO import XMonad hiding ((|||)) import qualified XMonad.Actions.ConstrainedResize as C import XMonad.Actions.CopyWindow import XMonad.Actions.CycleWS import XMonad.Actions.DynamicProjects import XMonad.Actions.DynamicWorkspaces import qualified XMonad.Actions.FlexibleManipulate as F import XMonad.Actions.FloatSnap import XMonad.Actions.FloatSnapSpaced import XMonad.Actions.MessageFeedback import XMonad.Actions.Navigation2D import XMonad.Actions.PerConditionKeys import XMonad.Actions.Promote import XMonad.Actions.SinkAll import XMonad.Actions.SpawnOn import XMonad.Actions.Volume import XMonad.Actions.WithAll import XMonad.Hooks.CurrentWorkspaceOnTop import XMonad.Hooks.DynamicLog import XMonad.Hooks.EwmhDesktops hiding (fullscreenEventHook) import XMonad.Hooks.FloatNext import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers import XMonad.Hooks.SetWMName import XMonad.Hooks.UrgencyHook import XMonad.Layout.Accordion import XMonad.Layout.BinarySpacePartition import XMonad.Layout.ComboP import XMonad.Layout.Decoration import XMonad.Layout.Fullscreen import XMonad.Layout.Gaps import XMonad.Layout.Hidden import XMonad.Layout.LayoutCombinators import XMonad.Layout.MultiToggle import XMonad.Layout.MultiToggle.Instances import XMonad.Layout.NoBorders import XMonad.Layout.Reflect import XMonad.Layout.ResizableTile import XMonad.Layout.Simplest import XMonad.Layout.Spacing import XMonad.Layout.SubLayouts import XMonad.Layout.Tabbed import XMonad.Layout.WindowNavigation import XMonad.Prompt import XMonad.Prompt.ConfirmPrompt import XMonad.Prompt.Pass import XMonad.Prompt.Shell import XMonad.Prompt.Window import XMonad.Prompt.Workspace import qualified XMonad.StackSet as S import XMonad.Util.Cursor import XMonad.Util.EZConfig import XMonad.Util.Loggers import XMonad.Util.Loggers.NamedScratchpad import XMonad.Util.NamedActions import XMonad.Util.NamedScratchpad import XMonad.Util.NamedWindows import XMonad.Util.PositionStore import XMonad.Util.Run import XMonad.Util.SpawnNamedPipe import XMonad.Util.WorkspaceCompare import XMonad.Util.XSelection (+++) :: String -> String -> String (+++) (x:xs) ys = x:xs ++ " " ++ ys (+++) [] ys = ys myBorderWidth :: Dimension myBorderWidth = 1 myBrowser, myNotify, myTerminal :: String -- TODO Pull values with environment variables myBrowser = "/usr/bin/qutebrowser" myNotify = "/usr/bin/notify-send" myTerminal = "/usr/bin/urxvtc" showKeybindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction showKeybindings a = addName "Show Keybindings" $ io $ do p <- spawnPipe "/usr/bin/zenity --text-info" -- TOOD Find an application that doesn't rely on any toolkits hPutStr p $ unlines $ showKm a hClose p return () data LibnotifyUrgencyHook = LibnotifyUrgencyHook deriving (Read, Show) instance UrgencyHook LibnotifyUrgencyHook where urgencyHook LibnotifyUrgencyHook w = do n <- getName w Just i <- S.findTag w <$> gets windowset safeSpawn myNotify [show n, "workspace" +++ wrap "[" "]" i] main :: IO () main = xmonad $ ewmh $ fullscreenSupport $ docks $ withUrgencyHook LibnotifyUrgencyHook $ withNavigation2DConfig myNav2DConf $ dynamicProjects myProjects $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) myKeys myXMonadConfig -- TODO Make selection target the last selected W when changing scopes myNav2DConf :: Navigation2DConfig myNav2DConf = def { defaultTiledNavigation = hybridNavigation , floatNavigation = hybridNavigation , layoutNavigation = [("Full", centerNavigation)] , unmappedWindowRect = [("Full", singleWindowRect)] } myXMonadConfig = def { XMonad.borderWidth = myBorderWidth , XMonad.workspaces = myWorkspaces -- TODO save WS state , XMonad.layoutHook = myLayoutHook -- TODO save layout state and floating W position , XMonad.terminal = myTerminal , XMonad.normalBorderColor = myColorN , XMonad.focusedBorderColor = myColorF , XMonad.modMask = myModMask , XMonad.logHook = myLogHook , XMonad.startupHook = myStartupHook , XMonad.mouseBindings = myMouseBindings , XMonad.manageHook = myManageHook , XMonad.handleEventHook = myHandleEventHook , XMonad.focusFollowsMouse = myFocusFollowsMouse , XMonad.clickJustFocuses = myClickJustFocuses } myFocusFollowsMouse, myClickJustFocuses :: Bool myFocusFollowsMouse = False myClickJustFocuses = False wsCHAT = "CHA" :: String wsM1 = "M/1" :: String wsM2 = "M/2" :: String wsM3 = "M/3" :: String wsT = "TER" :: String wsW1 = "W/1" :: String wsW2 = "W/2" :: String wsW3 = "W/3" :: String wsWWW = "WWW" :: String myWorkspaces :: [WorkspaceId] myWorkspaces = map show [1 .. 9 :: Int] myProjects :: [Project] myProjects = [ Project { projectName = "Template" , projectDirectory = "~/" , projectStartHook = Nothing } , Project { projectName = wsW1 , projectDirectory = "~/" , projectStartHook = Just $ do spawnOn wsW1 myTerminal spawnOn wsW1 myTerminal } , Project { projectName = wsW2 , projectDirectory = "~/" , projectStartHook = Just $ do spawnOn wsW2 myTerminal spawnOn wsW2 myTerminal } , Project { projectName = wsW3 , projectDirectory = "~/" , projectStartHook = Just $ do spawnOn wsW3 myTerminal spawnOn wsW3 myTerminal } , Project { projectName = wsWWW , projectDirectory = "~/" , projectStartHook = Just $ spawnOn wsWWW myBrowser } ] myFont :: String myFont = "xft:lucy tewi:style=Regular:size=8" -- TODO CJKのフォールバックフォントを追加する black1 = "#0b0806" :: String -- TODO get variables from Xresources black2 = "#2f2b2a" :: String red1 = "#844d2c" :: String red2 = "#a64848" :: String green1 = "#57553a" :: String green2 = "#897f5a" :: String yellow1 = "#a17c38" :: String yellow2 = "#c8b38d" :: String blue1 = "#41434f" :: String blue2 = "#526274" :: String magenta1 = "#6b4444" :: String magenta2 = "#755c47" :: String cyan1 = "#59664c" :: String cyan2 = "#718062" :: String white1 = "#a19782" :: String white2 = "#c1ab83" :: String myColorN, myColorF :: String myColorN = black2 myColorF = white2 baseInt, fullInt :: Int baseInt = 12 fullInt = baseInt * 2 fullDim :: Dimension fullDim = 12 * 2 myTabTheme :: Theme myTabTheme = def { activeColor = black1 , inactiveColor = black2 , urgentColor = red1 , activeBorderColor = white1 , inactiveBorderColor = white2 , urgentBorderColor = red2 , activeTextColor = white1 , inactiveTextColor = white2 , urgentTextColor = red2 , fontName = myFont , decoHeight = fullDim } myPromptTheme, myHotPromptTheme :: XPConfig myPromptTheme = def { font = myFont , bgColor = black1 , fgColor = white1 , fgHLight = white2 , bgHLight = black2 , borderColor = white2 , promptBorderWidth = myBorderWidth , position = Bottom , height = fullDim , searchPredicate = isInfixOf `on` map toLower } myHotPromptTheme = myPromptTheme { bgColor = black2 , fgColor = white2 , fgHLight = white1 , bgHLight = black1 } mySpacing :: l a -> ModifiedLayout Spacing l a mySpacing = spacing baseInt myGaps :: l a -> ModifiedLayout Gaps l a myGaps = gaps [ (U, baseInt) , (D, baseInt) , (R, baseInt) , (L, baseInt) ] data MyTransformers = GAPS deriving (Read, Show, Eq, Typeable) instance Transformer MyTransformers Window where transform GAPS x k = k (avoidStruts $ myGaps $ mySpacing x) (const x) myLayoutHook = fullscreenFloat $ lessBorders OnlyFloat $ mkToggle (single NBFULL) $ avoidStruts $ mkToggle (single GAPS) $ mkToggle (single REFLECTX) $ mkToggle (single REFLECTY) $ windowNavigation $ addTabs shrinkText myTabTheme $ hiddenWindows $ subLayout [] (Simplest ||| Accordion) -- TODO Proper bindings emptyBSP myModMask :: KeyMask myModMask = mod4Mask myKeys :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)] myKeys config = let subKeys :: String -> [(String, NamedAction)] -> [((KeyMask, KeySym), NamedAction)] subKeys s ks = subtitle s:mkNamedKeymap config ks directions :: [Direction2D] directions = [D, U, L, R] arrowKeys, directionKeys, wsKeys :: [String] arrowKeys = [ "" , "" , "" , "" ] directionKeys = [ "j" , "k" , "h" , "l" ] wsKeys = map show [1 .. 9 :: Int] zipM :: [a] -> String -> [[a]] -> [t] -> (t -> X ()) -> [([a], NamedAction)] zipM m nm ks as f = zipWith (\k d -> (m ++ k, addName nm $ f d)) ks as zipM' :: [a] -> String -> [[a]] -> [t] -> (t -> t1 -> X ()) -> t1 -> [([a], NamedAction)] zipM' m nm ks as f b = zipWith (\k d -> (m ++ k, addName nm $ f d b)) ks as tryMessageR_ :: (Message a, Message b) => a -> b -> X () tryMessageR_ x y = sequence_ [tryMessage_ x y, refresh] unsafeSelectionNotify :: MonadIO m => String -> m () unsafeSelectionNotify a = join $ io $ (unsafeSpawn . (\x -> a +++ "Clipboard" +++ wrap "\"\\\"" "\"\\\"" x)) <$> getSelection toggleCopyToAll :: X () toggleCopyToAll = wsContainingCopies >>= \x -> case x of [] -> windows copyToAll _ -> killAllOtherCopies getSortByIndexNonSP :: X ([WindowSpace] -> [WindowSpace]) getSortByIndexNonSP = (. namedScratchpadFilterOutWorkspace) <$> getSortByIndex nextNonEmptyWS, prevNonEmptyWS :: X () nextNonEmptyWS = findWorkspace getSortByIndexNonSP Next HiddenNonEmptyWS 1 >>= \t -> windows . S.view $ t prevNonEmptyWS = findWorkspace getSortByIndexNonSP Prev HiddenNonEmptyWS 1 >>= \t -> windows . S.view $ t toggleFloat :: Window -> X () toggleFloat w = windows (\s -> if M.member w (S.floating s) then S.sink w s else S.float w (S.RationalRect (1/2 - 1/4) (1/2 - 1/4) (1/2) (1/2)) s) in subKeys "System" [ ("M-q" , addName "Restart XMonad" $ spawn "/usr/bin/xmonad --restart") , ("M-C-q" , addName "Recompile & restart XMonad" $ spawn "/usr/bin/xmonad --recompile && /usr/bin/xmonad --restart") , ("M-S-q" , addName "Quit XMonad" $ confirmPrompt myHotPromptTheme "Quit XMonad?" $ io exitSuccess) , ("M-x" , addName "Shell prompt" $ shellPrompt myPromptTheme) , ("M-o" , addName "Goto W prompt" $ windowPrompt myPromptTheme Goto allWindows) , ("M-S-o" , addName "Bring W prompt" $ windowPrompt myPromptTheme Bring allWindows) ] ^++^ subKeys "Actions" [ ("M-C-g" , addName "Cancel" $ return ()) , ("" , addName "Lock screen" $ spawn "~/.xmonad/bin/\ \screenlock.sh") , ("M-S-c" , addName "Print clipboard content" $ unsafeSelectionNotify myNotify) , ("M-" , addName "Take a screenshot of the current WS, \ \upload it and copy link to the buffer" $ spawn "~/.xmonad/bin/\ \xshot-upload.sh") , ("M-S-" , addName "Take a screenshot of the selected area, \ \upload it and copy link to the buffer" $ spawn "~/.xmonad/bin/\ \xshot-select-upload.sh") , ("M-" , addName "Start recording screen as webm" $ spawn "~/.xmonad/bin/\ \xcast.sh --webm") , ("M-S-" , addName "Start recording screen as gif" $ spawn "~/.xmonad/bin/\ \xcast.sh --gif") , ("M-C-" , addName "Stop recording" $ spawn "/usr/bin/pkill ffmpeg") , ("M-C-c" , addName "Toggle compton on/off" $ spawn "~/.xmonad/bin/\ \toggle-compton.sh") , ("M-C-r" , addName "Toggle redshift on/off" $ spawn "~/.xmonad/bin/\ \toggle-redshift.sh") , ("M-C-p" , addName "Toggle touchpad on/off" $ spawn "~/.xmonad/bin/\ \toggle-touchpad.sh") , ("M-C-t" , addName "Toggle trackpoint on/off" $ spawn "~/.xmonad/bin/\ \toggle-trackpoint.sh") ] ^++^ subKeys "Volume & Music" -- TODO replace play/pause script with Haskell implementation [ ("" , addName "ALSA: Mute" $ void toggleMute) , ("" , addName "ALSA: Lower volume" $ void $ lowerVolume 5) , ("" , addName "ALSA: Raise volume" $ void $ raiseVolume 5) , ("" , addName "MPD: Play/pause" $ spawn "~/.xmonad/bin/mpc-play-pause.sh") , ("" , addName "MPD: Stop" $ spawn "/usr/bin/mpc --no-status stop") , ("" , addName "MPD: Previos track" $ spawn "/usr/bin/mpc --no-status prev") , ("" , addName "MPD: Next track" $ spawn "/usr/bin/mpc --no-status next") ] ^++^ subKeys "Spawnables" [ ("M-" , addName "Terminal" $ spawn myTerminal) , ("M-b" , addName "Browser" $ spawn myBrowser) , ("M-S-p" , addName "Pass prompt" $ passPrompt myPromptTheme) , ("M-c" , addName "NSP Console" $ namedScratchpadAction myScratchpads "console") , ("M-m" , addName "NSP Music" $ namedScratchpadAction myScratchpads "music") , ("M-t" , addName "NSP Top" $ namedScratchpadAction myScratchpads "top") , ("M-v" , addName "NSP Volume" $ namedScratchpadAction myScratchpads "volume") ] ^++^ subKeys "Windows" ( [ ("M-d" , addName "Kill W" kill) , ("M-S-d" , addName "Kill all W on WS" $ confirmPrompt myHotPromptTheme "Kill all" killAll) , ("M-C-d" , addName "Duplicate W to all WS" toggleCopyToAll) , ("M-a" , addName "Hide W" $ withFocused hideWindow) -- FIXME This is so broken , ("M-S-a" , addName "Restore hidden W" popOldestHiddenWindow) , ("M-p" , addName "Promote W" promote) , ("M-s" , addName "Merge W from sublayout" $ withFocused $ sendMessage . MergeAll) , ("M-S-s" , addName "Unmerge W from sublayout" $ withFocused $ sendMessage . UnMerge) , ("M-u" , addName "Focus urgent W" focusUrgent) , ("M-e" , addName "Focus master W" $ windows S.focusMaster) , ("M-'" , addName "Navigate tabbed W -> D" $ bindOn LD [ ("Tabs" , windows S.focusDown) , ("" , onGroup S.focusDown') ]) , ("M-;" , addName "Navigate tabbed W -> U" $ bindOn LD [ ("Tabs" , windows S.focusUp) , ("" , onGroup S.focusUp') ]) , ("M-S-'" , addName "Swap tabbed W -> D" $ windows S.swapDown) , ("M-S-;" , addName "Swap tabbed W -> U" $ windows S.swapUp) ] ++ zipM' "M-" "Navigate W" directionKeys directions windowGo True -- TODO W moving ++ zipM' "M-S-" "Swap W" directionKeys directions windowSwap True ++ zipM "M-C-" "Merge W with sublayout" directionKeys directions (sendMessage . pullGroup) ++ zipM' "M-" "Navigate screen" arrowKeys directions screenGo True ++ zipM' "M-S-" "Move W to screen" arrowKeys directions windowToScreen True ++ zipM' "M-C-" "Swap W to screen" arrowKeys directions screenSwap True ) ^++^ subKeys "Workspaces & Projects" ( [ ("M-w" , addName "Switch to project" $ switchProjectPrompt myPromptTheme) , ("M-S-w" , addName "Shift to project" $ shiftToProjectPrompt myPromptTheme) , ("M-," , addName "Next non-empty WS" nextNonEmptyWS) , ("M-." , addName "Previous non-empty WS" prevNonEmptyWS) , ("M-i" , addName "Toggle last WS" $ toggleWS' ["NSP"]) , ("M-`" , addName "WS prompt" $ workspacePrompt myPromptTheme $ windows . S.shift) ] ++ zipM "M-" "View WS" wsKeys [0 ..] (withNthWorkspace S.greedyView) ++ zipM "M-S-" "Move W to WS" wsKeys [0 ..] (withNthWorkspace S.shift) ++ zipM "M-C-S-" "Copy W to WS" wsKeys [0 ..] (withNthWorkspace copy) ) ^++^ subKeys "Layout Management" [ ("M-" , addName "Cycle layouts" $ sendMessage NextLayout) , ("M-C-" , addName "Cycle sublayouts" $ toSubl NextLayout) , ("M-S-" , addName "Reset layout" $ setLayout $ XMonad.layoutHook config) , ("M-y" , addName "Toggle float/tile on W" $ withFocused toggleFloat) , ("M-S-y" , addName "Tile all floating W" sinkAll) , ("M-S-," , addName "Decrease maximum W count" $ sendMessage $ IncMasterN (-1)) , ("M-S-." , addName "Increase maximum W count" $ sendMessage $ IncMasterN 1) , ("M-r" , addName "Rotate/reflect W" $ tryMessageR_ Rotate (Toggle REFLECTX)) , ("M-S-r" , addName "Reflect W" $ sendMessage $ Toggle REFLECTX) , ("M-f" , addName "Toggle fullscreen layout" $ sequence_ [ withFocused $ windows . S.sink , sendMessage $ Toggle NBFULL ]) , ("M-S-g" , addName "Toggle gapped layout" $ sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout ] ^++^ subKeys "Resize" [ ("M-[" , addName "Expand L" $ tryMessageR_ (ExpandTowards L) Shrink) , ("M-]" , addName "Expand R" $ tryMessageR_ (ExpandTowards R) Expand) , ("M-S-[" , addName "Expand U" $ tryMessageR_ (ExpandTowards U) MirrorShrink) , ("M-S-]" , addName "Expand D" $ tryMessageR_ (ExpandTowards D) MirrorExpand) , ("M-C-[" , addName "Shrink L" $ tryMessageR_ (ShrinkFrom R) Shrink) , ("M-C-]" , addName "Shrink R" $ tryMessageR_ (ShrinkFrom L) Expand) , ("M-S-C-[" , addName "Shrink U" $ tryMessageR_ (ShrinkFrom D) MirrorShrink) , ("M-S-C-]" , addName "Shrink D" $ tryMessageR_ (ShrinkFrom U) MirrorExpand) ] myScratchpads :: [NamedScratchpad] myScratchpads = [ NS "console" (spawnTerminalWith "NSPConsole" "~/.xmonad/bin/nsp-console.sh") (title =? "NSPConsole") floatingNSP , NS "volume" (spawnTerminalWith "NSPVolume" "/usr/bin/alsamixer") (title =? "NSPVolume") floatingNSP , NS "music" (spawnTerminalWith "NSPMusic" "~/.bin/mp") (title =? "NSPMusic") floatingNSP , NS "top" (spawnTerminalWith "NSPTop" "/usr/bin/htop") (title =? "NSPTop") floatingNSP ] where spawnTerminalWith :: String -> String -> String spawnTerminalWith t c = myTerminal +++ "-title" +++ t +++ "-e" +++ c floatingNSP :: ManageHook floatingNSP = customFloating $ S.RationalRect x y w h x = (1 - w) / 2 y = (1 - h) / 2 w = 1 / 2 h = 1 / 2.5 xmobarFont :: Int -> String -> String xmobarFont fn = wrap (concat [""]) "" myTopBarPP :: PP myTopBarPP = def { ppCurrent = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" , ppVisible = xmobarColor white1 "" . wrap "~" "~" , ppHidden = xmobarColor white1 "" . wrap "-" "-" , ppHiddenNoWindows = xmobarColor white1 "" . wrap "_" "_" , ppUrgent = xmobarColor red1 "" . wrap "!" "!" , ppSep = " / " , ppWsSep = " " , ppTitle = xmobarColor white1 "" . shorten 50 , ppTitleSanitize = xmobarStrip , ppLayout = xmobarColor white1 "" . \x -> case x of "Spacing 12 Tabbed Hidden BSP" -> "Omni.Gaps" "Tabbed Hidden BSP" -> "Omni" _ -> "Misc" , ppOrder = id , ppSort = (namedScratchpadFilterOutWorkspace .) <$> getSortByIndex , ppExtras = [] } myBotBarPP :: PP myBotBarPP = myTopBarPP { ppCurrent = const "" , ppVisible = const "" , ppHidden = const "" , ppHiddenNoWindows = const "" , ppUrgent = const "" , ppTitle = const "" , ppLayout = const "" } myLogHook :: X () myLogHook = do currentWorkspaceOnTop ewmhDesktopsLogHook b1 <- getNamedPipe "xmobarTop" b2 <- getNamedPipe "xmobarBot" c <- wsContainingCopies let copiesCurrent ws | ws `elem` c = xmobarColor yellow2 "" . xmobarFont 2 . wrap "*" "=" $ ws | otherwise = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" $ ws let copiesHidden ws | ws `elem` c = xmobarColor yellow1 "" . wrap "*" "-" $ ws | otherwise = xmobarColor white1 "" . wrap "-" "-" $ ws let copiesUrgent ws | ws `elem` c = xmobarColor yellow2 "" . wrap "*" "!" $ ws | otherwise = xmobarColor white2 "" . wrap "!" "!" $ ws dynamicLogWithPP $ myTopBarPP { ppCurrent = copiesCurrent , ppHidden = copiesHidden , ppUrgent = copiesUrgent , ppOutput = safePrintToPipe b1 } dynamicLogWithPP $ myBotBarPP { ppOutput = safePrintToPipe b2 } where safePrintToPipe :: Maybe Handle -> String -> IO () safePrintToPipe = maybe (\_ -> return ()) hPutStrLn addNETSupported :: Atom -> X () addNETSupported x = withDisplay $ \d -> do r <- asks theRoot ns <- getAtom "_NET_SUPPORTED" a <- getAtom "ATOM" liftIO $ do s <- (join . maybeToList) <$> getWindowProperty32 d ns r when (fromIntegral x `notElem` s) $ changeProperty32 d r ns a propModeAppend [fromIntegral x] addEWMHFullscreen :: X () addEWMHFullscreen = do s <- mapM getAtom atoms mapM_ addNETSupported s where atoms :: [String] atoms = [ "_NET_ACTIVE_WINDOW" , "_NET_CLIENT_LIST" , "_NET_CLIENT_LIST_STACKING" , "_NET_DESKTOP_NAMES" , "_NET_WM_DESKTOP" , "_NET_WM_STATE" , "_NET_WM_STATE_FULLSCREEN" , "_NET_WM_STATE_HIDDEN" , "_NET_WM_STRUT" ] myStartupHook :: X () myStartupHook = do startupHook def spawnNamedPipe "/usr/bin/xmobar ~/.xmonad/xmobarrcTop.hs" "xmobarTop" spawnNamedPipe "/usr/bin/xmobar ~/.xmonad/xmobarrcBot.hs" "xmobarBot" nspTrackStartup myScratchpads -- TODO docksStartupHook addEWMHFullscreen setDefaultCursor xC_left_ptr setWMName "xmonad" myMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) -- TODO implement snapSpacedMagicResize myMouseBindings XConfig {XMonad.modMask = m} = M.fromList [ ((m, button1), \w -> focus w >> F.mouseWindow F.position w >> ifClick (snapSpacedMagicMove fullInt (Just 50) (Just 50) w) >> windows S.shiftMaster ) , ((m .|. shiftMask, button1), \w -> focus w >> C.mouseResizeWindow w True >> ifClick (snapMagicResize [L, R, U, D] (Just 50) (Just 50) w) >> windows S.shiftMaster ) , ((m, button3), \w -> focus w >> F.mouseWindow F.linear w >> ifClick (snapMagicResize [L, R] (Just 50) (Just 50) w) >> windows S.shiftMaster ) , ((m .|. shiftMask, button3), \w -> focus w >> C.mouseResizeWindow w True >> ifClick (snapMagicResize [U, D] (Just 50) (Just 50) w) >> windows S.shiftMaster ) ] myManageHook :: ManageHook myManageHook = manageHook def <+> manageDocks <+> fullscreenManageHook <+> namedScratchpadManageHook myScratchpads <+> composeOne composeActions where composeActions :: [MaybeManageHook] composeActions = [ isFullscreen -?> doFullFloat , className =? "explorer.exe" -?> doFullFloat , isDialog -?> doCenterFloat , className =? "Xmessage" -?> doCenterFloat , className =? "Zenity" -?> doCenterFloat , className =? "qemu-system-x86" -?> doCenterFloat , className =? "qemu-system-x86_64" -?> doCenterFloat , className =? "Steam" <&&> not <$> title =? "Steam" -?> doFloat ] myHandleEventHook :: Event -> X All myHandleEventHook = handleEventHook def <+> nspTrackHook myScratchpads <+> docksEventHook <+> fullscreenEventHook -- vim:filetype=haskell:expandtab:tabstop=4:shiftwidth=4