{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -Wno-deprecations #-} import XMonad import XMonad.Config.Desktop -- Actions import XMonad.Actions.CycleWS import XMonad.Actions.DynamicWorkspaces as DW import XMonad.Actions.GridSelect import XMonad.Actions.OnScreen import XMonad.Actions.SpawnOn import XMonad.Actions.UpdatePointer import XMonad.Actions.WindowGo import XMonad.Actions.WorkspaceNames hiding (workspaceNamesPP) -- Data import Data.List import Data.Monoid import Data.Ratio import qualified Data.Map as M -- Hooks import XMonad.Hooks.DynamicLog import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.FadeInactive import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers import XMonad.Hooks.SetWMName import XMonad.Hooks.UrgencyHook -- Layout import XMonad.Layout import XMonad.Layout.Gaps import XMonad.Layout.IM as IM -- GIMP stuff import qualified XMonad.Layout.IndependentScreens as IS import XMonad.Layout.LayoutHints (layoutHints) import XMonad.Layout.NoBorders (smartBorders, noBorders) import XMonad.Layout.PerScreen import XMonad.Layout.PerWorkspace import XMonad.Layout.Reflect -- GIMP stuff import XMonad.Layout.ResizableTile import XMonad.Layout.SimpleFloat import XMonad.Layout.Spacing import XMonad.Layout.Tabbed import XMonad.Layout.TrackFloating -- GIMP stuff -- Util import XMonad.Util.EZConfig import XMonad.Util.Font import XMonad.Util.Loggers import XMonad.Util.Paste import XMonad.Util.Run import XMonad.Util.Ungrab import XMonad.Util.WorkspaceCompare import qualified XMonad.Util.ExtensibleState as XS -- Miscellaneous import Control.Applicative import Control.Monad (liftM) import Graphics.X11.ExtraTypes.XF86 import System.IO import System.Exit import XMonad.Operations import XMonad.Prompt import XMonad.Prompt.Window import qualified Codec.Binary.UTF8.String as UTF8 --import qualified DBus as D --import qualified DBus.Client as D import qualified XMonad.StackSet as W -- DynamicWorkspaces Stuff filterWorkspaces :: [WorkspaceId] -> [WindowSpace] -> [WindowSpace] filterWorkspaces ws = filter (\(W.Workspace tag _ _) -> tag `elem` ws) -- xScreen are the type classes which hold the workspace name lists newtype LeftScreen = LeftScreen {getLeftScreen :: [WorkspaceId]} deriving (Typeable,Read,Show) instance ExtensionClass LeftScreen where initialValue = LeftScreen [] extensionType = PersistentExtension newtype CenterScreen = CenterScreen {getCenterScreen :: [WorkspaceId]} deriving (Typeable,Read,Show) instance ExtensionClass CenterScreen where initialValue = CenterScreen [] extensionType = PersistentExtension newtype RightScreen = RightScreen {getRightScreen :: [WorkspaceId]} deriving (Typeable,Read,Show) instance ExtensionClass RightScreen where initialValue = RightScreen [] extensionType = PersistentExtension genWorkspaces :: ScreenId -> [IS.PhysicalWorkspace] genWorkspaces sc = if sc == 3 then IS.withScreen 0 ["pindrop"] ++ IS.withScreen 2 ["shell", "VM"] ++ IS.withScreen 1 ["qb"] else IS.withScreens sc ["shell", "qb", "pindrop", "VM"] -- End DynamicWorkspaces code (keybindings are below) -- getTopBar :: Int -> String getTopBar sc = if sc == 1 then "dzen2 -dock -p -x 0 -ta l -w 1024 -e 'onstart:lower;button2=togglehide;sigusr1=togglehide'" else "dzen2 -dock -p -x 2880 -ta l -w 1024 -e 'onstart:lower;button2=togglehide;sigusr1=togglehide'" --getBarbicanBar :: Int -> String --getBarbicanBar sc = if sc == 1 -- then "ssh barbican 'conky' | dzen2 -dock -p -x 0 -h 16 -y -112 -ta l -w 1920 -e 'sigusr1=togglehide'" -- else "ssh barbican 'conky' | dzen2 -dock -p -x 1920 -h 16 -y -112 -ta l -w 1920 -e 'sigusr1=togglehide'" --getDeltachunkBar :: Int -> String --getDeltachunkBar sc = if sc == 1 -- then "ssh deltachunk 'conky' | dzen2 -dock -p -x 0 -h 16 -y -96 -ta l -w 1920 -e 'sigusr1=togglehide'" -- else "ssh deltachunk 'conky' | dzen2 -dock -p -x 1920 -h 16 -y -96 -ta l -w 1920 -e 'sigusr1=togglehide'" --getFerrumBar :: Int -> String --getFerrumBar sc = if sc == 1 -- then "conky | dzen2 -dock -p -x 0 -h 16 -y -80 -ta l -w 1920 -e 'sigusr1=togglehide'" -- else "conky | dzen2 -dock -p -x 1920 -h 16 -y -80 -ta l -w 1920 -e 'sigusr1=togglehide'" -- getGammachunkBar :: Int -> String -- getGammachunkBar sc = if sc == 1 -- then "ssh gammachunk 'conky' | dzen2 -dock -p -x 0 -y -72 -ta l -w 1920 -e 'sigusr1=togglehide'" -- else "ssh gammachunk 'conky' | dzen2 -dock -p -x 1920 -y -72 -ta l -w 1920 -e 'sigusr1=togglehide'" --getOsmiumBar :: Int -> String --getOsmiumBar sc = if sc == 1 -- then "ssh osmium 'conky' | dzen2 -dock -p -x 0 -h 16 -y -64 -ta l -w 1920 -e 'sigusr1=togglehide'" -- else "ssh osmium 'conky' | dzen2 -dock -p -x 1920 -h 16 -y -64 -ta l -w 1920 -e 'sigusr1=togglehide'" -- --getSodiumBar :: Int -> String --getSodiumBar sc = if sc == 1 -- then "ssh sodium 'conky' | dzen2 -dock -p -x 0 -h 16 -y -48 -ta l -w 1920 -e 'sigusr1=togglehide'" -- else "ssh sodium 'conky' | dzen2 -dock -p -x 1920 -h 16 -y -48 -ta l -w 1920 -e 'sigusr1=togglehide'" -- --getTennessineBar :: Int -> String --getTennessineBar sc = if sc == 1 -- then "ssh tennessine 'conky' | dzen2 -dock -p -x 0 -h 16 -y -32 -ta l -w 1920 -e 'sigusr1=togglehide'" -- else "ssh tennessine 'conky' | dzen2 -dock -p -x 1920 -h 16 -y -32 -ta l -w 1920 -e 'sigusr1=togglehide'" -- --getBlancherBar :: Int -> String --getBlancherBar sc = if sc == 1 -- then "ssh blancher 'conky' | dzen2 -dock -p -x 0 -h 16 -y -16 -ta l -w 1920 -e 'sigusr1=togglehide'" -- else "ssh blancher 'conky' | dzen2 -dock -p -x 1920 -h 16 -y -16 -ta l -w 1920 -e 'sigusr1=togglehide'" toggleHomeScreens :: X () toggleHomeScreens = do sc <- IS.countScreens if sc == 1 then do --spawn "xrandr --output DVI-I-2-1 --off --output DVI-I-3-2 --off" spawn "while true; do \n\ \~/bin/battery; \n\ \echo -n ' '; \n\ \~/bin/temp.sh; \n\ \echo -n ' '; \n\ \date \"+%a, %b %d %T\"; \n\ \/usr/bin/sed -E \"s/($(date +%_d)\b)/^fg(green)\1^fg()/\" ; \n\ \sleep 1; \n\ \done | dzen2 -dock -p -x 2400 -w 480 -u -h 24 -ta r -sa c -e 'sigusr1=togglehide' &" else if sc == 3 then do --spawn "xrandr --output eDP-1 --primary --auto --output DVI-I-3-2 --auto --left-of eDP-1 --output DVI-I-2-1 --auto --right-of eDP-1" -- spawn "xrandr --output eDP-1-1 --primary --auto --output DVI-I-2-1 --auto --left-of eDP-1-1 --output DVI-I-3-2 --auto --right-of eDP-1-1" --spawn "while true; do \n\ -- \~/bin/battery; \n\ -- \echo -n ' '; \n\ -- \~/bin/temp.sh; \n\ -- \echo -n ' '; \n\ -- \date '+%a, %b %d %T'; \n\ -- \sleep 1; \n\ -- \done | dzen2 -dock -p -x 1602 -w 325 -h 24 -ta l -fn 'xos4 Terminus:style=Regular:Pixelsize=12' &" -- spawn "while true; do \n\ -- \~/bin/battery; \n\ -- \echo -n ' '; \n\ -- \~/bin/temp.sh; \n\ -- \echo -n ' '; \n\ -- \date '+%a, %b %d %T'; \n\ -- \sleep 1; \n\ -- \done | dzen2 -dock -p -x 3522 -w 325 -h 24 -ta l -fn 'xos4 Terminus:style=Regular:Pixelsize=12' &" spawn "while true; do \n\ \~/bin/battery; \n\ \echo -n ' '; \n\ \~/bin/temp.sh; \n\ \echo -n ' '; \n\ \date '+%a, %b %d %T'; \n\ \sleep 1; \n\ \done | dzen2 -dock -p -x 5399 -w 480 -h 24 -ta l -fg #ebdbb2 -bg #000000 -fn 'xft:monospace:style=Regular:Pixelsize=10' &" {- spawn "while true; do echo -n $(cat /tmp/temp); echo -n ' '; date '+%a, %b %d %T'; sleep 1; done | dzen2 -dock -p -x 1710 -w 210 -e 'onstart:lower;button2=togglehide' -h 24 -ta l -fg #aaaaaa -bg #282828 -fn Terminus-10 -xs 1 &" spawn "while true; do echo -n $(cat /tmp/temp); echo -n ' '; date '+%a, %b %d %T'; sleep 1; done | dzen2 -dock -p -x 3630 -w 210 -e 'onstart:lower;button2=togglehide' -h 24 -ta l -fg #aaaaaa -bg #282828 -fn Terminus-10 -xs 0 &" spawn "while true; do echo -n $(cat /tmp/temp); echo -n ' '; date '+%a, %b %d %T'; sleep 1; done | dzen2 -dock -p -x 5550 -w 210 -e 'onstart:lower;button2=togglehide' -h 24 -ta r -fg #aaaaaa -bg #282828 -fn Terminus-10 -xs 2 &" -} else return () -- get these with xprop myManageHook = composeAll [ isDialog --> doFloat , className =? "Org.gnome.Dictionary" --> doFloat , className =? "Xfce4-dict" --> doFloat , className =? "Goldendict" --> doFloat , className =? "Last.fm" --> doFloat , className =? "Xmessage" --> doFloat , className =? "Audacious" --> doFloat --, className =? "Gimp" --> doFloat , className =? "Skype" --> doFloat , className =? "Keepassx" --> doFloat , className =? "Kcalc" --> doFloat , className =? "Clementine" --> doFloat , className =? "SpiderOak" --> doFloat , className =? "Pavucontrol" --> doFloat , className =? "Gnome-calendar" --> doFloat {- The following sets doFloat on the Orage window (as above) But also ensures that it appears only on the left screen (screen 0). (screenWorkspace 0) returns X (Maybe WorkspaceId), and the liftX function lifts an X action to a Query (which is Maybe WorkspaceId) and the next lines return the workspace (if not empty), or do nothing if (Maybe WorkspaceId) -> Nothing. idHook maps to mempty, which means do nothing -} , className =? "Orage" --> doFloat <+> do ws <- liftX (screenWorkspace 0) case ws of Just w -> doShift w Nothing -> idHook -- end Orage window stuff -- Weather report stuff , className =? "Wrapper" --> doFloat <+> do ws <- liftX (screenWorkspace 0) case ws of Just w -> doShift w Nothing -> idHook -- end Weather Report window stuff -- , className =? "Plasma-desktop" --> doFloat -- <+> do -- ws <- liftX (screenWorkspace 0) -- case ws of -- Just w -> doShift w -- Nothing -> idHook -- end Plasma desktop stuff , className =? "Xfce4-notifyd" --> doIgnore , manageDocks ] --shiftInsert w = -- let translatedProgs = ["Chromium", "Chrome"] -- in do -- c <- runQuery className w; -- let toTranslate = any (== c) translatedProgs -- if toTranslate then spawn ("CLIP=$(xclip -out -selection clipboard); xclip -out" -- ++ " | xclip -in -selection clipboard; xdotool key --clearmodifiers --window " -- ++ show w ++ " ctrl+v; echo -n $CLIP | xclip -in -selection clipboard") -- else sendKey shiftMask xK_Insert layoutH = layoutHints -- $ onWorkspace "5:" (Mirror tiled2 -- ||| tiled ||| Full) -- $ onWorkspaces ["1:wkbr","2:wksh"] (Full -- ||| tiled ||| Mirror tiled) $ Full ||| Mirror tiled ||| tabbed shrinkText myTheme ||| tiled where tiled = Tall 1 (3 % 100) (1/2) --tiled2 = Tall 1 (3 % 100) (5 % 9) myTheme :: Theme --myTheme = defaultTheme { myTheme = def { fontName = myFont } myFont = "xft:monospace:style=Regular:Pixelsize=18" fadeHook = fadeInactiveLogHook fadeAmount where fadeAmount = 0.8 makeLauncher yargs run exec close = concat ["exe=`yegonesh ", yargs, "` && ", run, " ", exec, "$exe", close] --launcher = makeLauncher "-x -- -nf grey -nb black -fn 'xos4 Terminus:Pixelsize=8'" "eval" "\"exec " "\"" launcher = makeLauncher "-x" "eval" "\"exec " "\"" startTrayer sc = do if sc == 3 then "trayer --edge top --align right --widthtype request --margin 490 --expand false --SetDockType true --SetPartialStrut false --tint 0x000000 --transparent true --alpha 0 --height 24 --monitor 2" else "trayer --edge top --align right --widthtype request --margin 490 --expand false --SetDockType true --SetPartialStrut false --tint 0x000000 --transparent true --alpha 0 --height 24 --monitor 'primary'" main = do sc <- IS.countScreens dzenTopBar <- spawnPipe (getTopBar sc) --dzenBarbicanBar <- spawnPipe (getBarbicanBar sc) --dzenDeltachunkBar <- spawnPipe (getDeltachunkBar sc) --dzenFerrumBar <- spawnPipe (getFerrumBar sc) --dzenOsmiumBar <- spawnPipe (getOsmiumBar sc) --dzenSodiumBar <- spawnPipe (getSodiumBar sc) --dzenTennessineBar <- spawnPipe (getTennessineBar sc) --dzenBlancherBar <- spawnPipe (getBlancherBar sc) xmonad $ ewmhFullscreen . ewmh $ def { workspaces = genWorkspaces (S sc) , terminal = myTerminal , focusFollowsMouse = True , manageHook = manageDocks <+> myManageHook -- <+> manageHook desktopConfig , handleEventHook = handleEventHook desktopConfig --, layoutHook = avoidStruts $ gaps [(D,108)] $ layoutH , layoutHook = avoidStruts $ layoutH , logHook = myLogHook dzenTopBar >> fadeHook >> updatePointer (0.5, 0.5) (0, 0) , borderWidth = 1 , normalBorderColor = "#000000" , focusedBorderColor = "#ebdbb2" , modMask = winKey , startupHook = myStartup } `additionalKeys` myKeys `removeKeys` remKeys myStartup :: X () myStartup = do --setWMName "LG3D" sc <- IS.countScreens toggleHomeScreens --spawn "xset dpms 600" spawn "xautolock -secure -time 10 -locker 'i3lock -c 000000'" spawn (startTrayer sc) -- --spawn "trayer --edge top --align right --widthtype request --margin 318 --expand false --SetDockType true --SetPartialStrut false --tint 0x282828 --transparent true --alpha 0 --height 24 --monitor 'primary'" -- --spawn "stalonetray" -- --spawn "gnome-gmail-notifier" -- --spawn "xautolock -secure -time 10 -locker 'i3lock -c 000000 -i /home/trey/images/black.png'" -- -- --spawn "trayer --edge top --align right --widthtype request --margin 318 --expand false --SetDockType true --SetPartialStrut false --tint 0x282828 --transparent true --alpha 0 --height 24 --monitor 2" activateMyTerminal :: X () activateMyTerminal = do sc <- IS.countScreens if sc == 1 then do windows (viewOnScreen 0 "shell") else if sc == 3 then do windows (viewOnScreen 2 "shell") else return () myBitmapsDir = "/home/trey/.xmonad/dzen2" --centerBar = fmap getCenterBar IS.countScreens --bottomBar = fmap getBottomBar IS.countScreens --leftBar = "dzen2 -w 0 -h 24 -ta l -fg #555753 -bg #000000 -fn Terminus-10 -xs 1" -- rightBar = "dzen2 -w 3840 -h 24 -ta r -fg #555753 -bg #000000 -fn Terminus-10 -xs 2" myLogHook :: Handle -> X () --myLogHook h = dynamicLogWithPP $ defaultPP myLogHook h = dynamicLogWithPP $ IS.marshallPP (S 0) $ def { ppCurrent = dzenColor "#8AE234" "#000000" . pad , ppVisible = dzenColor "#555753" "#000000" . pad , ppHidden = dzenColor "#ebdbb2" "#000000" . pad , ppHiddenNoWindows = dzenColor "#555753" "#000000" . pad , ppUrgent = dzenColor "#cc0000" "#000000" . pad , ppWsSep = "." , ppSep = " | " , ppLayout = dzenColor "#666600" "#000000" . (\x -> case x of "Tall" -> "^i(" ++ myBitmapsDir ++ "/tall.xbm)" "Mirror Tall" -> "^i(" ++ myBitmapsDir ++ "/mtall.xbm)" "Full" -> "^i(" ++ myBitmapsDir ++ "/full.xbm)" "Simple Float" -> "~" "IM Grid" -> "IM" _ -> x ) , ppTitle = ("" ++) . dzenColor "#ff6600" "#000000" . dzenEscape , ppOutput = hPutStrLn h } winKey :: KeyMask winKey = mod4Mask lAlt :: KeyMask lAlt = mod1Mask {-Multiline comment for reference winKey :: KeyMask winKey :: KeyMask-} --myTerminal :: String --myTerminal = "konsole" --myTerminal = "ssh-agent urxvtc -cd ~" myTerminal = "alacritty" --myTerminal = "terminator" --altTerminal = "urxvtc -cd ~ -name altUrxvt4 --myTerminal = "gnome-terminal" --myTerminal = "terminator" {-slotWksp = ["1:main", "2:jobs", "3:is660","4:office","5:sysadmin","6:irc","7:digium", "8:vm","9:dump","0:music","F1:man","F2:jobs","F3:isovr","F4:offovr","F5:sysovr","F6:ircovr","F7:dgmovr","F8:vmovr","F9:dmpovr","F10:musovr"] leftWksp = ["01:main","02:jobs","03:is660","04:office","05:sysadmin","06:irc","07:digium","08:vm","09:dump","10:music"] rightWksp = [ "F1:man" , "F2:jobs" , "F3:isovr" , "F4:offovr" , "F5:sysovr" , "F6:ircovr" , "F7:dgmovr" , "F8:vmovr" , "F9:dmpovr" , "F10:musovr" ]-} {- Many of the key combinations below match or are analogs of key combinations - in Windows. This is to keep the amount of mental context switching to a - minimum. - -} myKeys = [ --((winKey , xK_t), withFocused $ windows . W.sink) -- Push window back into tiling (default) ((winKey .|. shiftMask, xK_t), withFocused $ windows . W.sink) -- Push window back into tiling --, ((winKey , xK_l), spawnHere "xscreensaver-command --lock && sleep 3 && xset dpms force off") --, ((winKey , xK_l), spawnHere "gnome-screensaver-command --lock && sleep 10 && xset dpms force off") --, ((winKey , xK_l), spawnHere "dm-tool lock") , ((winKey , xK_l), spawnHere "i3lock --color 000000 -i /home/trey/images/black.png && sleep 3 && xset dpms force off") -- , ((winKey , xK_l), spawnHere "light-locker-command --lock && sleep 10 && xset dpms force off") -- , ((winKey , xK_l), spawnHere "dm-tool lock && sleep 3 && xset dpms force off") -- ((winKey , xK_l), spawnHere "xscreensaver-command --lock") -- ((winKey , xK_l), spawnHere "qdbus org.kde.krunner /ScreenSaver Lock") , ((winKey , xK_Return), do ifWindows (resource =? "Alacritty") (mapM_ focus) (spawnHere myTerminal) activateMyTerminal) , ((winKey , xK_v), do ifWindows (resource =? "Alacritty") (mapM_ focus) (spawnHere myTerminal) activateMyTerminal) --ifWindows (resource =? "main") (mapM_ focus) (spawnHere myTerminal)) , ((controlMask .|. lAlt, xK_BackSpace), (spawnHere "xfdesktop --quit")) , ((controlMask .|. lAlt, xK_Delete), (spawnHere "pkill -9 chromium")) , ((controlMask .|. shiftMask, xK_Return), (spawnHere myTerminal)) , ((controlMask .|. shiftMask, xK_3), spawn "scrot --exec 'mkdir -p ~/images && mv $f ~/images' && paplay ~/wav/camera.wav") , ((controlMask .|. shiftMask, xK_4), unGrab >> spawn "scrot --exec 'mkdir -p ~/images && mv $f ~/images' --select && paplay ~/wav/camera.wav") , ((controlMask .|. winKey, xK_z), ifWindows (resource =? "Zoom") (mapM_ focus) (spawnHere "zoom")) -- windows (viewOnScreen 1 "ws") -- ifWindows (resource =? "altUrxvt") (mapM_ focus) (spawnHere altTerminal)) , ((lAlt, xK_v), spawn "CM_HISTLENGTH=20 clipmenu && xdotool key Ctrl+v") --, ((winKey .|. shiftMask, xK_v), do -- windows (viewOnScreen 1 "virtualbox") -- ifWindows (className =? "Gvim") (mapM_ focus) (spawnHere "gvim")) --, ((winKey , xK_v), do -- windows (viewOnScreen 1 "timetracker") -- ifWindows (title =? "osmium:timetracker") (mapM_ focus) (spawnHere "urxvtc -cd ~/timetracker -e 'tmux attach -t timetracker || tmux -2 new-session -s timetracker'")) --, ((lAlt , xK_v), spawnHere "xfce4-popup-clipman") --, ((winKey , xK_x), windowPromptGoto dXPConfig) --, ((winKey .|. shiftMask, xK_x), windowPromptBring dXPConfig) --, ((winKey .|. shiftMask, xK_x), windowPrompt def Bring dXPConfig) --, ((winKey .|. shiftMask, xK_Return), windows W.swapMaster) --, ((winKey .|. shiftMask, xK_Return), spawnHere myTerminal) , ((winKey , xK_b), do spawnHere "pkill -USR1 dzen2" spawnHere "pkill trayer" sendMessage $ ToggleStruts sendMessage $ ToggleGaps) --sendMessage $ ToggleStruts) , ((lAlt , xK_g), spawnHere "~/bin/google_selection.sh") --, ((winKey , xK_g), ifWindows (className =? "Google-chrome") (mapM_ focus) (spawnHere "google-chrome")) , ((winKey , xK_g), do windows (viewOnScreen 0 "pindrop") ifWindows (className =? "Vivaldi-stable") (mapM_ focus) (spawnHere "vivaldi")) --, ((winKey , xK_r), do -- windows (viewOnScreen 1 "wb") -- ifWindows (className =? "Google-chrome-stable") (mapM_ focus) (spawnHere "google-chrome-stable")) --ifWindows (className =? "Google-chrome") (mapM_ focus) (spawnHere "chromium --user-data-directory=~/work/avoxi/chromium")) --, ((winKey , xK_g), spawnHere "google-chrome --purge-memory-button ") --, ((winKey , xK_i), spawnHere "iceweasel") --, ((winKey , xK_i), spawnHere "clementine") -- , ((winKey , xK_i), ifWindows (className =? "Clementine") (mapM_ killWindow) (spawnHere "clementine")) -- , ((winKey , xK_d ), ifWindows (className =? "Goldendict") (mapM_ killWindow) (spawnHere "goldendict")) -- , ((winKey , xK_d), ifWindows (className =? "Xfce4-dict") (mapM_ killWindow) (spawnHere "xfce4-dict")) , ((winKey , xK_d), ifWindows (className =? "Org.gnome.Dictionary") (mapM_ killWindow) (spawnHere "gnome-dictionary")) --, ((winKey , xK_f), spawnHere (myTerminal ++ " -e vifm . ~")) --, ((winKey , xK_f), spawnHere ("export SHELL=/bin/bash && " ++ myTerminal ++ " -e mc")) --, ((winKey , xK_e), spawnHere ("export SHELL=/bin/bash && " ++ myTerminal ++ " -e mc")) -- key stroke matches Win+E (from Win7) , ((winKey , xK_o), do --windows (viewOnScreen 0 "of") ifWindows (fmap("libreoffice" `isPrefixOf`) className) (mapM_ focus) (spawnHere "libreoffice")) -- , ((winKey , xK_o), do -- windows (viewOnScreen 1 "rbank") -- ifWindows (className =? "Opera") (mapM_ focus) (spawnHere "opera")) -- , ((winKey .|. controlMask , xK_a), spawnHere "/home/trey/launchers/airdroid.desktop") -- , ((winKey , xK_s), do -- windows (viewOnScreen 1 "hng") -- ifWindows (className =? "Skype") (mapM_ focus) (spawnHere "skype")) , ((winKey , xK_s), ifWindows (className =? "Pavucontrol") (mapM_ killWindow) (spawnHere "pavucontrol")) -- , ((winKey , xK_t), do -- spawn "pkill trayer" -- spawn (startTrayer sc)) , ((winKey , xK_c), kill) --, ((winKey , xK_m), windows W.focusMaster) , ((winKey , xK_comma), sendMessage (IncMasterN 1)) , ((winKey , xK_period), sendMessage (IncMasterN (-1))) , ((winKey , xK_j), windows W.focusDown) -- explicitly setting the default , ((winKey .|. controlMask, xK_j), windows W.swapDown) -- explicitly setting the default , ((winKey , xK_k), windows W.focusUp) -- explicitly setting the default , ((winKey .|. controlMask, xK_k), windows W.swapUp) -- explicitly setting the default , ((lAlt , xK_Tab), windows W.focusDown) -- replicating MS Windows task switcher behavior --, ((winKey , xK_Tab), goToSelected defaultGSConfig) , ((winKey , xK_Tab), goToSelected def) , ((lAlt .|. shiftMask, xK_Tab), windows W.focusUp) -- replicating MS Windows task switcher behavior , ((winKey .|. controlMask, xK_Return), windows W.swapMaster) , ((winKey, xK_space ), sendMessage NextLayout) --, ((winKey .|. shiftMask, xK_space), setLayout $ XMonad.layoutHook conf) -- the default, commented here for documentation and posterity , ((winKey , xK_p), spawnHere launcher) , ((winKey .|. shiftMask, xK_p), spawnHere "gmrun") --, ((winKey .|. controlMask , xK_d), spawn ("sleep 1 && date +%F | tr -d '\n' | ~/bin/genxmacro | xmacroplay -d 0.1 $DISPLAY")) --, ((controlMask .|. shiftMask , xK_d), spawn ("sleep 1 && date '+%F %T %p: ' | tr -d '\n' | ~/bin/genxmacro | xmacroplay -d 0.1 $DISPLAY")) --, ((winKey .|. controlMask , xK_k), spawn ("sleep 1 && cat ~/.macros/code.macro | xmacroplay -d 0.1 $DISPLAY")) --, ((shiftMask, xK_Insert), withFocused shiftInsert) --, ((controlMask, xK_n), raiseMaybe (spawnHere myTerminal) (className =? "URxvt")) -- , ((winKey , xK_Print), spawnHere "xfce4-screenshooter") , ((winKey , xK_Left), prevWS) , ((winKey , xK_Right), nextWS) , ((winKey , xK_Up), spawnHere "skippy-xd --paging") --, ((0, xF86XK_Calculator), spawnHere "/home/trey/bin/calc") --, ((0, xF86XK_Calculator), ifWindows (className =? "Gcalctool") (mapM_ killWindow) (spawnHere "gcalctool")) , ((winKey , xK_y), spawn "dunstctl close-all") , ((winKey , xK_x), spawn "dunstctl close") -- , ((0, xF86XK_Calculator), ifWindows (className =? "Gnome-calculator") (mapM_ killWindow) (spawnHere "gnome-calculator")) , ((0, xF86XK_AudioPlay), spawn "clementine --play-pause") --, ((0, xF86XK_AudioMute), spawn "amixer -c 0 set Master toggle") , ((0, xF86XK_AudioMute), spawn "pamixer --toggle-mute") , ((0, xF86XK_AudioRaiseVolume), spawn "pamixer --increase 5") , ((0, xF86XK_AudioLowerVolume), spawn "pamixer --decrease 5") , ((0, xF86XK_MonBrightnessUp), spawn "sudo xbacklight -inc 5") , ((0, xF86XK_MonBrightnessDown), spawn "sudo xbacklight -dec 5") -- , ((winKey .|. controlMask, xK_Left), shiftToPrev >> prevWS) -- , ((winKey .|. controlMask, xK_Right), shiftToNext >> nextWS) , ((winKey .|. controlMask, xK_h), sendMessage Shrink) , ((winKey .|. lAlt, xK_h), do --windows (viewOnScreen 1 "hng") --windows (viewOnScreen 1 "chromium") --ifWindows (className =? "Chromium") (mapM_ focus) (spawnHere "chromium")) --windows (viewOnScreen 1 "vivaldi") --ifWindows (className =? "Vivaldi-stable") (mapM_ focus) (spawnHere "vivaldi-stable")) windows (viewOnScreen 0 "qb") ifWindows (className =? "qutebrowser") (mapM_ focus) (spawnHere "qutebrowser")) --ifWindows (className =? "Iceweasel") (mapM_ focus) (spawnHere "iceweasel")) , ((winKey .|. controlMask, xK_l), sendMessage Expand) --, ((winKey , xK_1), windows (viewOnScreen 0 "shell")) --, ((winKey , xK_1), ifWindows (className =? "Alacritty") (mapM_ focus) (spawnHere myTerminal)) --, ((winKey , xK_2), windows (viewOnScreen 0 "chromium")) , ((winKey , xK_a), do windows (viewOnScreen 0 "pindrop") --ifWindows (className =? "Pidgin") (mapM_ focus) (spawnHere "pidgin")) ifWindows (className =? "Slack") (mapM_ focus) (spawnHere "slack")) , ((winKey , xK_q), spawn "killall dzen2 stalonetray; xmonad --recompile; xmonad --restart") , ((winKey .|. shiftMask , xK_q), io (exitWith ExitSuccess)) -- win+h shows the selected workspace , ((winKey, xK_h), DW.withWorkspace myXPConfigSelect $ \wk -> do --sc <- screenBy 0 --if sc == 0 --then XS.modify $ LeftScreen . (wk :) . getLeftScreen -- prefix to list -- then XS.modify $ LeftScreen . (++ [wk]) . getLeftScreen -- append to list --else XS.modify $ RightScreen . (wk :) . getRightScreen -- prefix to list -- else XS.modify $ RightScreen . (++ [wk]) . getRightScreen -- append to list windows $ W.view wk) -- win+z moves the current window to the selected workspace , ((winKey, xK_z), DW.withWorkspace myXPConfigSelect (\ws -> do --sc <- screenBy 0 --if sc == 0 -- then XS.modify $ LeftScreen . nub . (ws :) . getLeftScreen -- prefix to list -- else XS.modify $ RightScreen . nub . (ws :) . getRightScreen -- prefix to list --then XS.modify $ LeftScreen . nub . (++ [ws]) . getLeftScreen -- append to list --else XS.modify $ RightScreen . nub . (++ [ws]) . getRightScreen -- append to list windows $ W.shift ws -- refresh )) -- win+BackSpace removes the current workspace , ((winKey , xK_BackSpace), do curr <- gets (W.currentTag . windowset) sc <- screenBy 0 if sc == 0 then do ws <- XS.gets getLeftScreen XS.put (LeftScreen (filter (/= curr) ws)) else do ws <- XS.gets getRightScreen XS.put (RightScreen (filter (/= curr) ws)) DW.removeWorkspace ) -- win+ctrl+e renames the current workspace , ((winKey .|. controlMask , xK_r), do old <- gets (W.currentTag . windowset) DW.renameWorkspace myXPConfigNew created <- gets (W.currentTag . windowset) sc <- screenBy 0 if sc == 0 then do ws <- XS.gets getLeftScreen XS.put (LeftScreen (filter (/= old) ws)) --XS.modify $ LeftScreen . (created :) . getLeftScreen -- prefix to list XS.modify $ LeftScreen . (++ [created]) . getLeftScreen -- append to list else do ws <- XS.gets getRightScreen XS.put (RightScreen (filter (/= old) ws)) --XS.modify $ RightScreen . (created :) . getRightScreen -- prefix to list XS.modify $ RightScreen . (++ [created]) . getRightScreen -- append to list refresh) -- win+m creates a new workspace , ((winKey , xK_m) , DW.withWorkspace myXPConfigNew $ \wk -> do sc <- screenBy 0 if sc == 0 --then XS.modify $ LeftScreen . (wk :) . getLeftScreen -- prefix to list then XS.modify $ LeftScreen . (++ [wk]) . getLeftScreen -- append to list --else XS.modify $ RightScreen . (wk :) . getRightScreen -- prefix to list else XS.modify $ RightScreen . (++ [wk]) . getRightScreen -- append to list windows $ W.view wk) --, ((winKey .|. shiftMask, xK_d) -- macro conflict dialog problem needs to be resolved ] ++ -- Set up window -> workspace keys [((m .|. winKey, key), screenWorkspace sc >>= flip whenJust (windows . f)) -- | (key, sc) <- zip [xK_w, xK_r] [0..] -- | (key, sc) <- zip [xK_Left, xK_Right] [0..] -- For arrow keys | (key, sc) <- zip [xK_e, xK_w, xK_r] [0..] -- For w,r keys -- | (key, sc) <- zip [xK_w, xK_r] [1,0] -- For w,r keys in backwards order -- | (key, sc) <- zip [xK_w, xK_r] [1,0] -- For w,r keys in backwards order , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] remKeys = [(winKey, n) | n <- [xK_0 .. xK_9]] --dXPConfig = defaultXPConfig { dXPConfig = def { bgColor = "yellow" , fgColor = "blue" , font = myFont } --myXPConfigSelect = defaultXPConfig { myXPConfigSelect = def { bgColor = "yellow" , fgColor = "blue" , autoComplete = Just 0 , showCompletionOnTab = True , font = myFont } --myXPConfigNew = defaultXPConfig { myXPConfigNew = def { bgColor = "yellow" , fgColor = "blue" , autoComplete = Nothing , showCompletionOnTab = True , font = myFont }