import Codec.Binary.UTF8.String import Graphics.X11.ExtraTypes.XF86 import LemonBar import qualified Solarized as S import qualified Data.Map as M import qualified XMonad.StackSet as W import System.Exit import System.IO import Text.Printf import XMonad import XMonad.Actions.CycleWS import XMonad.Config.Desktop import XMonad.Hooks.DynamicLog import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers import XMonad.Layout.IndependentScreens import XMonad.Layout.LayoutCombinators hiding ( (|||) ) import XMonad.Layout.Reflect import XMonad.Prompt import XMonad.Prompt.Shell(shellPrompt) import XMonad.Util.Font import XMonad.Util.Loggers -- import XMonad.Util.Run main = do spawn bar xmonad $ docks $ ewmh desktopConfig { manageHook = myManageHook <+> manageDocks <+> manageHook defaultConfig , layoutHook = myLayout , logHook = maLogouk , modMask = mod4Mask -- Rebind to Logo key , workspaces = ["●", "◕", "◑", "◔", "◯", "◐", "◒", "◓", "☦"] , borderWidth = 0 , keys = myKeys , terminal = "/run/current-system/sw/bin/st -t Terminal" , handleEventHook = handleEventHook defaultConfig <+> fullscreenEventHook } sym "Tall" = "|" sym "Mirror Tall" = "-" sym "Full" = "F" sym _ = "◓" maLogouk = dynamicLogWithPP $ defaultPP { ppOutput = printToFile , ppCurrent = LemonBar.color S.orange S.base03 . LemonBar.underline -- . sym , ppVisible = LemonBar.color S.yellow S.base03 . LemonBar.underline -- . sym , ppHidden = LemonBar.color S.base2 S.base03 . LemonBar.underline -- . sym , ppHiddenNoWindows = LemonBar.color S.base01 S.base03 -- . sym , ppLayout = sym , ppTitle = LemonBar.fColor S.violet . shorten 70 , ppSep = " " } printToFile :: String -> IO () printToFile s = do h <- openFile "/tmp/monitors/xmonad" WriteMode hPutStrLn h $ decodeString s -- xxxxxxxxxxxx -- v----------------| -- Hacky hack to fix the broken fix of dynamicLogWithPP hClose h myManageHook = composeAll [ className =? "float" --> doCenterFloat , manageDocks ] ------------------------------------------------------------------------ -- LogHook. Dynamically outputs logs nicely formatted for dzen2 -- -- myLogHook h = dynamicLogWithPP $ defaultPP { -- ppCurrent = dzenColor "#cb4b16" "#eee8d5", -- ppVisible = dzenColor "#657b83" "#eee8d5", -- ppHiddenNoWindows = dzenColor "#93a1a1" "#eee8d5", -- ppLayout = dzenColor "#6c71c4" "#eee8d5", -- ppTitle = (dzenColor "#cb4b16" "") . (fixedWidth 256), -- ppSep = " ", -- ppWsSep = " ", -- ppOutput = hPutStrLn h -- } -- where -- fixedWidth n l = take (n+5) $ l ++ (cycle ".") ------------------------------------------------------------------------ -- StatusBar. Call lemonbar --bar = "pgrep lemonbar > /dev/null || /home/eeva/prefix/bin/mkstatus.sh | /home/eeva/prefix/bin/bar" bar = printf "pkill lemonbar; /home/eeva/bin/mkstatus.sh | \ \ lemonbar -g 1920x24+0+0 \ \ -f '%s' \ \ -f '%s' \ \ -u %d -B '%s' -F '%s' -U '%s'" --"tewi:style=Regular:antialias=false:autohint=false" "Iosevka:size=12" "DejaVu Sans Mono:size=12" (2 :: Int) S.base03 S.base0 S.violet myLayout = (avoidStruts $ tiled ||| Mirror tiled) ||| Full where tiled = Tall 1 (3/100) (1/2) -- Prompt config myXPConfig = defaultXPConfig { position = Top, promptBorderWidth = 5, font = "xft:tewi:style=Regular:antialias=false:autohint=false", height = 24, borderColor = S.base03, bgHLight = S.base02, fgHLight = S.magenta, bgColor = S.base03, fgColor = S.base0, defaultText = "" } ------------------------------------------------------------------------ -- Key bindings. Add, modify or remove key bindings here. -- myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $ [ -- launch dmenu --((modm, xK_p), spawn "dmenu_run -b -l 3") -- launch prompt ((modm, xK_p), shellPrompt myXPConfig) -- close focused window , ((modm, xK_Delete), kill) -- Rotate through the available layout algorithms , ((modm, xK_space ), sendMessage NextLayout) --, ((modm .|. shiftMask xK_Tab ), sendMessage PreviousLayout) -- Reset the layouts on the current workspace to default , ((modm .|. shiftMask, xK_space ), setLayout $ XMonad.layoutHook conf) -- Resize viewed windows to the correct size , ((modm, xK_n ), refresh) -- Move focus to the master window , ((modm, xK_m ), windows W.focusMaster ) -- Swap the focused window and the master window , ((modm, xK_BackSpace), windows W.swapMaster) -- Move focus to the next window , ((modm, xK_j ), windows W.focusDown) , ((modm, xK_Down ), windows W.focusDown) -- Move focus to the previous window , ((modm, xK_k ), windows W.focusUp ) , ((modm, xK_Up ), windows W.focusUp) -- Swap the focused window with the next window , ((modm .|. shiftMask, xK_j ), windows W.swapDown ) , ((modm .|. shiftMask, xK_Down ), windows W.swapDown ) -- Swap the focused window with the previous window , ((modm .|. shiftMask, xK_k ), windows W.swapUp ) , ((modm .|. shiftMask, xK_Up ), windows W.swapUp ) -- Shrink the master area , ((modm, xK_h ), sendMessage Shrink) -- Expand the master area , ((modm, xK_l ), sendMessage Expand) -- Move to next Workspace , ((modm, xK_Right ), nextWS) -- Move to previous Workspace , ((modm, xK_Left ), prevWS) -- Move focused window to next Workspace , ((modm .|. shiftMask, xK_Right ), shiftToNext >> nextWS) -- Move focused window to previous Workspace , ((modm .|. shiftMask, xK_Left ), shiftToPrev >> prevWS) -- Cycle between windows , ((modm , xK_Tab ), toggleWS) -- Push window back into tiling , ((modm, xK_t ), withFocused $ windows . W.sink) -- Increment the number of windows in the master area , ((modm , xK_comma ), sendMessage (IncMasterN 1)) -- Deincrement the number of windows in the master area , ((modm , xK_period), sendMessage (IncMasterN (-1))) -- close focused window , ((modm .|. shiftMask, xK_c ), kill) -- Swap the focused window and the master window , ((modm, xK_Return), windows W.swapMaster) -- run my terminal , ((modm .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) -- lock my session --, ((modm .|. shiftMask, xK_Delete), spawn "/usr/bin/sxlock -f \"-*-ubuntu mono-*-r-*-*-*-*-*-*-*-*-*-*\"") , ((modm .|. shiftMask, xK_Delete), spawn "/run/current-system/sw/bin/i3lock-fancy -g -p") -- quit xmonad , ((modm .|. shiftMask, xK_q), io (exitWith ExitSuccess)) -- Raise volume (XF86XK_AudioRaiseVolume) , ((0 , xF86XK_AudioRaiseVolume), spawn "/home/eeva/prefix/bin/volume up") -- Lower volume (XF86XK_AudioLowerVolume) , ((0 , xF86XK_AudioLowerVolume), spawn "/home/eeva/prefix/bin/volume down") -- Mute volume (xF86XK_AudioMute) , ((0 , xF86XK_AudioMute), spawn "/home/eeva/prefix/bin/volume toggle") -- Playlist play (xK_F7) , ((0 , xK_F7), spawn "/usr/bin/notify-send \"Current song\" \"$(mpc -h ~/.config/mpd/mpd.socket | head -n 1)\"") -- Playlist play (xK_F8) , ((0 , xK_F8), spawn "/home/eeva/prefix/bin/playlist toggle") -- Playlist stop (xK_F9) , ((0 , xK_F9), spawn "/home/eeva/prefix/bin/playlist stop") -- Launch App (XF86XK_Launch1) , ((0 , xF86XK_Launch1), spawn "/usr/bin/firefox") -- Adjust Brightness up (xF86XK_MonBrightnessUp) , ((0 , xF86XK_MonBrightnessUp), spawn "/usr/bin/xbacklight +10") -- Adjust Brightness down (xF86XK_MonBrightnessDown) , ((0 , xF86XK_MonBrightnessDown), spawn "/usr/bin/xbacklight -10") ] ++ -- -- mod-[1..9], Switch to workspace N -- -- 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_F1 .. xK_F9] , (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_z, xK_e, xK_r] [0..] , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] -- Utility functions