{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable #-} import System.IO import System.Exit import XMonad import XMonad.Hooks.DynamicLog import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers import XMonad.Hooks.SetWMName import XMonad.Layout.Fullscreen import XMonad.Layout.NoBorders import XMonad.Layout.Spiral import XMonad.Layout.Tabbed import XMonad.Layout.ThreeColumns import XMonad.Layout.SimpleFloat import XMonad.Util.Run(spawnPipe) import XMonad.Hooks.UrgencyHook import qualified XMonad.StackSet as W import qualified Data.Map as M import Data.List(foldl') import XMonad.Hooks.EwmhDesktops as E import XMonad.Actions.WindowBringer import XMonad.Util.WorkspaceCompare import XMonad.Actions.PhysicalScreens import XMonad.Util.SpawnOnce (spawnOnce) import Control.Arrow ((***), second) import Control.Monad import Graphics.X11 (Rectangle(..)) data Tall54 a = Tall54 { tallNMaster :: !Int -- ^ The default number of windows in the master pane (default: 1) , tallRatioIncrement :: !Rational -- ^ Percent of screen to increment by when resizing panes (default: 3/100) , tallRatio :: !Rational -- ^ Default proportion of screen occupied by master pane (default: 1/2) } deriving (Show, Read) instance LayoutClass Tall54 a where pureLayout (Tall54 nmaster _ frac) r s = zip ws rs where ws = W.integrate s rs = tile54 frac r nmaster (length ws) pureMessage (Tall54 nmaster delta frac) m = msum [fmap resize (fromMessage m) ,fmap incmastern (fromMessage m)] where resize Shrink = Tall54 nmaster delta (max 0 $ frac-delta) resize Expand = Tall54 nmaster delta (min 1 $ frac+delta) incmastern (IncMasterN d) = Tall54 (max 0 (nmaster+d)) delta frac description _ = "Tall54" tile54 :: Rational -- ^ @frac@, what proportion of the screen to devote to the master area -> Rectangle -- ^ @r@, the rectangle representing the screen -> Int -- ^ @nmaster@, the number of windows in the master pane -> Int -- ^ @n@, the total number of windows to tile -> [Rectangle] tile54 f (Rectangle sx sy sw sh) nmaster 1 = [Rectangle sx1 sy sw1 sh] where sx1 = sx + sm1 sm1 = fromIntegral (sw - sw1) `div` 2 sw1 = 5 * fromIntegral (sh `div` 4) tile54 f r nmaster n = if n <= nmaster || nmaster == 0 then splitVertically n r else splitVertically nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns where (r1,r2) = splitHorizontallyBy f r modm = mod4Mask myTerminal = "alacritty" superMask = mod4Mask .|. controlMask .|. mod1Mask myWorkspaces = map show [1..9] myManageHook = composeAll [ resource =? "desktop_window" --> doIgnore , className =? "Galculator" --> doFloat , resource =? "gpicview" --> doFloat , className =? "MPlayer" --> doFloat , className =? "stalonetray" --> doIgnore , className =? "conky" --> doIgnore , className =? "xclock" --> doIgnore , className =? "Dunst" --> doIgnore , className =? "Cairo-clock" --> doIgnore , className =? "Deezer" --> doCenterFloat , className =? "Zenity" --> doCenterFloat , className =? "Hamster" --> doCenterFloat , className =? "Xdialog" --> doCenterFloat , className =? "Pinentry-gtk-2" --> doCenterFloat , className =? "Chromium" --> doShift "8:web" , className =? "SDL_App" --> doCenterFloat , isFullscreen --> (doF W.focusDown <+> doFullFloat) ] main = do xmobarpipe <- spawnPipe "xmobar -x 1 ~/.xmonad/xmobarrc.hs" xmonad $ withUrgencyHook NoUrgencyHook $ ewmh defaults { logHook = dynamicLogWithPP $ xmobarPP { ppOutput = hPutStrLn xmobarpipe , ppTitle = shorten 60 . wrap "" "" , ppCurrent = xmobarColor "#a89984" "#665c54" . wrap " " " " . xmobarPPName , ppVisible = xmobarColor "#a89984" "#3c3836" . wrap " " " " . xmobarPPName , ppHidden = wrap " " " " . xmobarPPName , ppUrgent = xmobarColor "#cc241d" "" . wrap " " " " . xmobarPPName , ppSep = "" , ppWsSep = "" , ppLayout = wrap " " " " . xmobarPPLayout , ppSort = getSortByXineramaPhysicalRule horizontalScreenOrderer , ppOrder = reverse } } xmobarPPLayout x = case x of "Tall54" -> "[=]" "Tall" -> "[]=" "Mirror Tall" -> "TTT" "ThreeCol" -> "|||" "Tabbed Bottom Simplest" -> "___" "Full" -> "[F]" "Spiral" -> "[@]" "Simple Float" -> "<->" _ -> pad x xmobarPPName x = x --xmobarPPName x = tail $ tail x myStartup :: X () myStartup = spawnOnce "xdotool key super+q super+6 super+w super+1" defaults = def { terminal = myTerminal , modMask = modm , workspaces = myWorkspaces , startupHook = startupHook def <+> setWMName "LG3D" <+> docksStartupHook <+> myStartup , focusFollowsMouse = True , normalBorderColor = "#3c3836" , focusedBorderColor = "#ff0000" , borderWidth = 2 , layoutHook=myLayout , manageHook=manageHook def <+> manageDocks <+> myManageHook , handleEventHook = handleEventHook def <+> E.fullscreenEventHook <+> docksEventHook -- <+> floatClickFocusHandler , keys = myKeys , mouseBindings = myMouseBindings } myLayout = smartBorders $ avoidStruts ( Tall54 1 (3/100) (1/2) ||| Tall 1 (3/100) (1/2) ||| Mirror (Tall 1 (3/100) (1/2)) ||| Full ||| simpleFloat ||| ThreeColMid 1 (3/100) (1/2) ||| tabbedBottomAlways shrinkText tabConfig ||| spiral (6/7)) ||| noBorders (fullscreenFull Full) tabConfig = def { activeBorderColor = "#3c3836", activeTextColor = "#ebdbb2", activeColor = "#3c3836", inactiveBorderColor = "#1d2021", inactiveTextColor = "#ebdbb2", inactiveColor = "#1d2021", fontName = "xft:Source Code Pro for Powerline:style=Semibold:pixelsize=10.5:antialias=true:hintstyle=hintfull:hinting=true" } ------------------------------------------------------------------------ myKeys conf@ XConfig {XMonad.modMask = modm} = M.fromList $ [ ((modm .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) , ((modm, xK_g ), spawn "dmenu_run") , ((modm .|. shiftMask, xK_c ), kill) , ((modm, xK_space ), sendMessage NextLayout) , ((modm .|. shiftMask, xK_space ), setLayout $ XMonad.layoutHook conf) , ((modm, xK_s ), refresh) , ((modm, xK_Tab ), windows W.focusDown) , ((modm .|. shiftMask, xK_Tab ), windows W.focusUp ) , ((modm, xK_m ), windows W.focusMaster ) , ((modm, xK_Return), windows W.swapMaster) , ((modm .|. shiftMask, xK_o ), windows W.swapDown ) , ((modm .|. shiftMask, xK_n ), windows W.swapUp ) , ((modm, xK_n ), sendMessage Shrink) , ((modm, xK_o ), sendMessage Expand) , ((modm, xK_t ), withFocused $ windows . W.sink) , ((modm, xK_comma ), sendMessage (IncMasterN 1)) , ((modm, xK_period), sendMessage (IncMasterN (-1))) , ((modm, xK_b ), sendMessage ToggleStruts) -- Hide / show xmobar , ((modm .|. shiftMask .|. controlMask, xK_q ), io exitSuccess) -- Quit xmonad , ((modm .|. controlMask, xK_q ), spawn "notify-send 'Kompajliram'; xmonad --recompile; xmonad --restart") -- Restart xmonad , ((modm .|. shiftMask, xK_minus), spawn "import -window root ~/desktop/$(date +%F_%H%M%S_%N).png") -- Screenshot whole screen , ((modm .|. shiftMask, xK_backslash), spawn "import -window \"$(xdotool getwindowfocus -f)\" ~/desktop/$(date +%F_%H%M%S_%N).png") -- Screenshot focused window , ((modm .|. shiftMask, xK_g ), gotoMenuArgs ["-l","30"]) -- GotoMenu , ((modm .|. shiftMask, xK_i ), spawn "firefox") , ((modm .|. shiftMask, xK_r ), spawn "alacritty -e vifm") , ((modm .|. shiftMask, xK_t ), spawn "~/bin/st/st -e todo") , ((modm .|. shiftMask, xK_e ), spawn "gvim") , ((superMask, xK_f ), spawn "mixer vol -5") , ((shiftMask, xK_F7 ), spawn "mixer vol -5") , ((superMask, xK_e ), spawn "mixer vol +5") , ((shiftMask, xK_F8 ), spawn "mixer vol +5") , ((superMask, xK_a ), spawn "dpass") , ((shiftMask, xK_F12 ), spawn "dpass") , ((superMask, xK_b ), spawn "mpc toggle") , ((shiftMask, xK_F9 ), spawn "mpc toggle") , ((superMask, xK_c ), spawn "mpc stop") , ((shiftMask, xK_F10 ), spawn "mpc stop") , ((superMask, xK_d ), spawn "mpc play") , ((shiftMask, xK_F11 ), spawn "mpc play") , ((shiftMask .|. superMask, xK_d), spawn "~/bin/mpcplay") , ((shiftMask .|. modm, xK_F11 ), spawn "~/bin/mpcplay") , ((shiftMask .|. superMask, xK_c), spawn "~/bin/helpers/toggledeezer") ] ++ -- mod-[1..9], Switch to workspace N, mod-shift-[1..9], Move client to workspace N [((m .|. modm, k), windows $ f i) | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9] , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] ++ -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3, mod-shift-{w,e,r}, Move client to screen 1, 2, or 3 [((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f)) | (key, sc) <- zip [xK_q, xK_w, xK_f] [1,0..] -- bilo [0..] , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] ------------------------------------------------------------------------ myMouseBindings XConfig {XMonad.modMask = modm} = M.fromList -- mod-button1, Set the window to floating mode and move by dragging [ ((modm, button1), \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster) -- mod-button2, Raise the window to the top of the stack , ((modm, button2), \w -> focus w >> windows W.shiftMaster) -- mod-button3, Set the window to floating mode and resize by dragging , ((modm .|. shiftMask, button1), \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster) -- you may also bind events to the mouse scroll wheel (button4 and button5) ]