2020-06-21 10:41:26 +00:00
{- # LANGUAGE NamedFieldPuns # -}
{- # LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, ScopedTypeVariables, LambdaCase # -}
{- # OPTIONS_GHC - fno - warn - missing - signatures - fno - warn - unused - binds # -}
-- Imports -------------------------------------------------------- {{{
module Config ( main ) where
import qualified Data.Map.Strict as M
import Control.Concurrent
import Control.Exception ( catch , SomeException )
2020-08-30 17:00:09 +00:00
import Control.Monad ( join , filterM
2020-06-21 10:41:26 +00:00
, when
2020-11-14 22:32:12 +00:00
2020-06-21 10:41:26 +00:00
)
import Control.Arrow ( ( >>> ) )
import Data.List ( isPrefixOf
, isSuffixOf
2020-10-19 15:40:50 +00:00
, isInfixOf
2020-06-21 10:41:26 +00:00
)
2020-11-14 22:32:12 +00:00
import qualified Data.List
2020-06-21 10:41:26 +00:00
import System.Exit ( exitSuccess )
import qualified Rofi
import qualified DescribedSubmap
import qualified TiledDragging
2020-08-05 12:55:11 +00:00
--import qualified WindowSwallowing
2020-06-21 10:41:26 +00:00
2020-08-05 12:55:11 +00:00
import XMonad.Hooks.WindowSwallowing as WindowSwallowing
2020-06-21 10:41:26 +00:00
2020-09-20 08:29:51 +00:00
2020-12-31 14:09:09 +00:00
--import XMonad.Hooks.WindowedFullscreenFix
2020-11-18 16:46:53 +00:00
--import XMonad.Util.ActionCycle
2020-06-21 10:41:26 +00:00
import Data.Foldable ( for_ )
import Data.Function ( ( & ) )
import XMonad hiding ( ( ||| ) )
import XMonad.Actions.CopyWindow
import XMonad.Actions.PhysicalScreens ( horizontalScreenOrderer )
import XMonad.Actions.SpawnOn
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.SetWMName ( setWMName )
import XMonad.Layout.BinarySpacePartition
import XMonad.Layout.BorderResize
import XMonad.Layout.Gaps
import XMonad.Layout.IndependentScreens
import XMonad.Layout.LayoutCombinators ( ( ||| ) )
import XMonad.Layout.LayoutHints
import XMonad.Layout.MouseResizableTile
import XMonad.Layout.NoBorders
import XMonad.Layout.Renamed ( renamed , Rename ( Replace ) )
--import qualified XMonad.Layout.MultiColumns as MultiCol
import XMonad.Layout.ResizableTile
import XMonad.Layout.Simplest
import XMonad.Layout.Reflect
import XMonad.Layout.Spacing ( spacingRaw , Border ( .. ) , toggleWindowSpacingEnabled , incScreenWindowSpacing , decScreenWindowSpacing )
import XMonad.Layout.SubLayouts
import XMonad.Layout.Tabbed
import XMonad.Layout.WindowNavigation ( windowNavigation )
import XMonad.Layout.ZoomRow
import XMonad.Layout.ThreeColumns
import XMonad.Layout.ResizableThreeColumns
import XMonad.Layout.WindowSwitcherDecoration
import XMonad.Layout.DraggingVisualizer
--import XMonad.Layout.Hidden as Hidden
import XMonad.Util.EZConfig ( additionalKeysP
, removeKeysP
, checkKeymap
)
2020-12-25 10:53:37 +00:00
2020-06-21 10:41:26 +00:00
import XMonad.Util.NamedScratchpad
import XMonad.Util.Run
import XMonad.Util.SpawnOnce ( spawnOnce )
import XMonad.Util.WorkspaceCompare ( getSortByXineramaPhysicalRule , getSortByIndex )
import Data.Monoid ( Endo )
import Data.Semigroup ( All ( .. ) )
import qualified System.IO as SysIO
import qualified XMonad.Actions.Navigation2D as Nav2d
import qualified XMonad.Config.Desktop as Desktop
import qualified XMonad.Hooks.EwmhDesktops as Ewmh
import qualified XMonad.Hooks.ManageHelpers as ManageHelpers
2020-08-30 17:00:09 +00:00
import XMonad.Hooks.DebugStack ( debugStackFullString
2020-06-21 10:41:26 +00:00
)
import qualified XMonad.Layout.BoringWindows as BoringWindows
import qualified XMonad.Layout.MultiToggle as MTog
import qualified XMonad.Layout.MultiToggle.Instances as MTog
import qualified XMonad.Layout.ToggleLayouts as ToggleLayouts
import qualified XMonad.StackSet as W
import qualified XMonad.Util.XSelection as XSel
import qualified XMonad.Layout.PerScreen as PerScreen
2020-11-14 22:32:12 +00:00
import Data.Maybe ( catMaybes , maybeToList , fromMaybe )
import Data.Bifunctor
2020-11-18 16:46:53 +00:00
import GHC.IO.Unsafe ( unsafePerformIO )
2020-12-25 16:48:15 +00:00
import XMonad.Layout.LayoutModifier
2020-12-31 14:09:09 +00:00
--import XMonad.Layout.MultiColumns (multiCol)
2020-06-21 10:41:26 +00:00
{- # ANN module "HLint: ignore Redundant $" # -}
{- # ANN module "HLint: ignore Redundant bracket" # -}
{- # ANN module "HLint: ignore Move brackets to avoid $" # -}
{- # ANN module "HLint: ignore Unused LANGUAGE pragma" # -}
-- }}}
-- Values -------------------- {{{
myModMask = mod4Mask
2020-08-16 21:05:10 +00:00
myLauncher = Rofi . asCommand def [ " -show run " ]
2020-12-25 10:53:37 +00:00
myTerminal = " alacritty "
2020-06-21 10:41:26 +00:00
useSharedWorkspaces = False
{- | adds the scripts - directory path to the filename of a script | -}
scriptFile :: String -> String
scriptFile script = " /home/leon/scripts/ " ++ script
scratchpads :: [ NamedScratchpad ]
scratchpads =
[ NS " terminal " " termite --class sp_term " ( className =? " sp_term " ) ( customFloating $ W . RationalRect 0.66 0.7 0.34 0.3 )
, NS " spotify " " spotify " ( appName =? " spotify " ) defaultFloating
, NS " whatsapp " launchWhatsapp ( ( " WhatsApp " ` isSuffixOf ` ) <$> title ) defaultFloating
, NS " slack " " slack " ( ( " Slack | " ` isPrefixOf ` ) <$> title ) defaultFloating
, NS " discord " launchDiscord ( appName =? " discord " ) defaultFloating
]
where
--launchWhatsapp = "gtk-launch chrome-hnpfjngllnobngcgfapefoaidbinmjnm-Default.desktop"
launchWhatsapp = " google-chrome-stable --start-fullscreen -kiosk --app='https://web.whatsapp.com' "
2020-08-24 13:57:25 +00:00
launchDiscord = " discocss "
2020-06-21 10:41:26 +00:00
--launchDiscord = "beautifuldiscord --css /home/leon/.config/beautifuldiscord/custom_discord.css"
2020-11-14 22:32:12 +00:00
-- }}}
2020-06-21 10:41:26 +00:00
-- Colors ------ {{{
gray = " #888974 "
red = " #fb4934 "
purple = " #d3869b "
aqua = " #8ec07c "
-- }}}
-- Layout ---------------------------------------- {{{
2020-08-11 11:18:46 +00:00
myTabTheme :: Theme
2020-06-21 10:41:26 +00:00
myTabTheme = def -- defaultThemeWithButtons
2020-11-01 12:51:00 +00:00
{ activeColor = " #1d2021 " --activeColor = "#1d2021"
2020-09-20 08:29:51 +00:00
, inactiveColor = " #1d2021 " --inactiveColor = "#282828"
2020-06-21 10:41:26 +00:00
, activeBorderColor = " #1d2021 "
, inactiveBorderColor = " #282828 "
, activeTextColor = " #fbf1c7 "
, inactiveTextColor = " #fbf1c7 "
2020-09-20 08:29:51 +00:00
, decoHeight = 40
, activeBorderWidth = 0
, inactiveBorderWidth = 0
, urgentBorderWidth = 0
2020-06-21 10:41:26 +00:00
, fontName = " -misc-cozettevector-*-*-*-*-10-*-*-*-*-*-*-* "
}
data EmptyShrinker = EmptyShrinker deriving ( Show , Read )
instance Shrinker EmptyShrinker where
shrinkIt _ _ = [] :: [ String ]
2020-08-18 22:25:19 +00:00
2020-12-25 16:48:15 +00:00
myLayout = noBorders
. avoidStruts
. smartBorders
. MTog . mkToggle1 MTog . FULL
. ToggleLayouts . toggleLayouts tabbedTall
. MTog . mkToggle1 WINDOWDECORATION
. draggingVisualizer
. layoutHintsToCenter
2020-06-21 10:41:26 +00:00
$ layouts
where
-- | if the screen is wider than 1900px it's horizontal, so use horizontal layouts.
-- if it's not, it's vertical, so use layouts for vertical screens.
2020-12-25 16:48:15 +00:00
layouts = PerScreen . ifWider 1900 ( PerScreen . ifWider 3000 chonkyScreenLayouts horizScreenLayouts ) vertScreenLayouts
2020-06-21 10:41:26 +00:00
2020-12-25 16:48:15 +00:00
chonkyScreenLayouts = ( rn " UltraTall " $ withGaps $ centeredIfSingle 0.6 resizableThreeCol ) ||| horizScreenLayouts
horizScreenLayouts =
2020-12-31 14:09:09 +00:00
( rn " Tall " $ withGaps $ centeredIfSingle 0.7 mouseResizableTile { draggerType = BordersDragger } )
||| ( rn " Horizon " $ withGaps $ mouseResizableTileMirrored { draggerType = BordersDragger } )
||| ( rn " BSP " $ withGaps $ borderResize $ emptyBSP )
2020-12-25 16:48:15 +00:00
||| ( rn " ThreeCol " $ mkTabbed $ withGaps $ resizableThreeCol )
||| ( rn " TabbedRow " $ mkTabbed $ withGaps $ zoomRow )
2020-12-31 14:09:09 +00:00
-- ||| (rn "Colm" $ mkTabbed $ withGaps $ centeredIfSingle 0.7 (multiCol [1] 2 0.05))
2020-06-21 10:41:26 +00:00
vertScreenLayouts =
2020-12-25 16:48:15 +00:00
( ( rn " ThreeCol " $ mkTabbed $ withGaps $ Mirror $ reflectHoriz $ ThreeColMid 1 ( 3 / 100 ) ( 1 / 2 ) )
||| ( rn " Horizon " $ withGaps $ mouseResizableTileMirrored { draggerType = BordersDragger } ) )
2020-06-21 10:41:26 +00:00
2020-12-25 16:48:15 +00:00
-- | Simple tall layout with tab support
tabbedTall = rn " Tabbed " . mkTabbed . withGaps $ ResizableTall 1 ( 3 / 100 ) ( 1 / 2 ) []
-- | Specific instance of ResizableThreeCol
2020-12-31 14:09:09 +00:00
resizableThreeCol = ResizableThreeColMid 1 ( 3 / 100 ) ( 2 / 5 ) []
2020-08-18 22:25:19 +00:00
2020-12-25 16:48:15 +00:00
rn n = renamed [ Replace n ]
2020-08-18 22:25:19 +00:00
2020-12-25 16:48:15 +00:00
withGaps = spacingRaw False border True border True
where gap = 15
border = Border gap gap gap gap
2020-06-21 10:41:26 +00:00
-- | transform a layout into supporting tabs
2020-12-25 16:48:15 +00:00
mkTabbed layout = BoringWindows . boringWindows . windowNavigation . addTabs shrinkText myTabTheme $ subLayout [] Simplest $ layout
-- LayoutModifier and layout definitions ---------- {{{
2020-06-21 10:41:26 +00:00
-- | window decoration layout modifier. this needs you to add `dragginVisualizer` yourself
data WINDOWDECORATION = WINDOWDECORATION deriving ( Read , Show , Eq , Typeable )
instance MTog . Transformer WINDOWDECORATION Window where
transform WINDOWDECORATION x k = k
2020-09-20 08:29:51 +00:00
( windowSwitcherDecoration EmptyShrinker ( myTabTheme { activeBorderColor = " #1d2021 " } ) $ x )
2020-06-21 10:41:26 +00:00
( const x )
2020-09-20 08:29:51 +00:00
2020-12-25 16:48:15 +00:00
-- | Layout modifier that tells layouts to only use a percentage of the screen, leaving space on the sides.
newtype Smaller a = Smaller Double
deriving ( Show , Read )
instance LayoutModifier Smaller a where
modifyLayout ( Smaller ratio ) workspace rect = runLayout workspace ( rectangleCenterPiece ratio rect )
-- | Layout Modifier that places a window in the center of the screen,
-- leaving room on the left and right, if there is only a single window
newtype CenteredIfSingle a = CenteredIfSingle Double deriving ( Show , Read )
instance LayoutModifier CenteredIfSingle Window where
pureModifier ( CenteredIfSingle ratio ) r _ [ ( onlyWindow , _ ) ] = ( [ ( onlyWindow , rectangleCenterPiece ratio r ) ] , Nothing )
pureModifier _ _ _ winRects = ( winRects , Nothing )
-- | Layout Modifier that places a window in the center of the screen,
-- leaving room on the left and right, if there is only a single window
centeredIfSingle :: Double -> l a -> ModifiedLayout CenteredIfSingle l a
centeredIfSingle ratio = ModifiedLayout ( CenteredIfSingle ratio )
-- | Give the center piece of a rectangle by taking the given percentage
-- of the rectangle and taking that in the middle.
rectangleCenterPiece :: Double -> Rectangle -> Rectangle
rectangleCenterPiece ratio ( Rectangle rx ry rw rh ) = Rectangle start ry width rh
where
sides = floor $ ( ( fi rw ) * ( 1.0 - ratio ) ) / 2
start = ( fi rx ) + sides
width = fi $ ( fi rw ) - ( sides * 2 )
fi :: ( Integral a , Num b ) => a -> b
fi = fromIntegral
-- }}}
2020-09-20 08:29:51 +00:00
2020-06-21 10:41:26 +00:00
-- }}}
-- Startuphook ----------------------------- {{{
myStartupHook :: X ()
myStartupHook = do
setWMName " LG3D " -- Java stuff hack
--spawnOnce "nm-applet &"
--spawnOnce "udiskie -s &" -- Mount USB sticks automatically. -s is smart systray mode: systray icon if something is mounted
spawnOnce " xfce4-clipman & "
2020-12-25 10:53:37 +00:00
--spawnOnce "redshift -P -O 5000 &"
2020-06-21 10:41:26 +00:00
spawn " xset r rate 300 50 & " -- make key repeat quicker
2020-12-25 10:53:37 +00:00
--spawn "/home/leon/.screenlayout/dualscreen-stacked.sh"
spawn " /home/leon/.screenlayout/tripplescreen.sh "
2020-08-24 13:57:25 +00:00
spawnOnce " xsetroot -cursor_name left_ptr "
spawnOnce " xrdb -merge ~/.Xresources "
2020-06-21 10:41:26 +00:00
io $ threadDelay $ 1000 * 100
2020-11-21 12:06:55 +00:00
--spawnOnce "/home/leon/Downloads/picom --config /home/leon/.config/picom.conf --experimental-backends --backend xrender" --no-fading-openclose"
spawnOnce " picom --config /home/leon/.config/picom.conf --experimental-backends --backend glx " --no-fading-openclose"
2020-06-21 10:41:26 +00:00
spawn " /home/leon/.config/polybar/launch.sh "
spawnOnce " nitrogen --restore "
spawnOnce " mailnag "
2020-08-30 17:00:09 +00:00
spawnOnce " flashfocus "
2020-06-21 10:41:26 +00:00
for_ [ " led1 " , " led2 " ] $ \ led -> safeSpawn " sudo " [ " liquidctl " , " set " , led , " color " , " fixed " , " 00ffff " ]
2020-08-30 17:00:09 +00:00
withDisplay $ \ dpy -> do
r <- asks theRoot
a <- getAtom " _NET_SUPPORTED "
c <- getAtom " ATOM "
f <- getAtom " _GTK_FRAME_EXTENTS "
io $ do
sup <- ( join . maybeToList ) <$> getWindowProperty32 dpy a r
when ( fromIntegral f ` notElem ` sup ) $ do
changeProperty32 dpy r a c propModeAppend [ fromIntegral f ]
2020-06-21 10:41:26 +00:00
-- }}}
-- Keymap --------------------------------------- {{{
myMouseBindings :: XConfig Layout -> M . Map ( KeyMask , Button ) ( Window -> X () )
myMouseBindings ( XConfig { XMonad . modMask = modMask' } ) = M . fromList
[ ( ( modMask' .|. shiftMask , button1 ) , TiledDragging . tiledDrag ) ]
-- Default mappings that need to be removed
removedKeys :: [ String ]
removedKeys = [ " M-<Tab> " , " M-S-c " , " M-S-q " , " M-h " , " M-l " , " M-j " , " M-k " , " M-S-<Return> " ]
++ if useSharedWorkspaces then [] else [ key ++ show n | key <- [ " M- " , " M-S- " , " M-C- " ] , n <- [ 1 .. 9 :: Int ] ]
myKeys :: [ ( String , X () ) ]
myKeys = concat [ zoomRowBindings , tabbedBindings , multiMonitorBindings , programLaunchBindings , miscBindings , windowControlBindings , workspaceBindings ]
where
keyDirPairs = [ ( " h " , L ) , ( " j " , D ) , ( " k " , U ) , ( " l " , R ) ]
zoomRowBindings :: [ ( String , X () ) ]
zoomRowBindings =
[ ( " M-+ " , sendMessage zoomIn )
, ( " M-- " , sendMessage zoomOut )
, ( " M-# " , sendMessage zoomReset )
]
tabbedBindings :: [ ( String , X () ) ]
tabbedBindings =
[ ( " M-j " , ifLayoutName ( " Tabbed " ` isPrefixOf ` ) ( BoringWindows . focusDown ) ( windows W . focusDown ) )
, ( " M-k " , ifLayoutName ( " Tabbed " ` isPrefixOf ` ) ( BoringWindows . focusUp ) ( windows W . focusUp ) )
, ( " M-C-S-h " , sendMessage $ pullGroup L )
, ( " M-C-S-j " , sendMessage $ pullGroup D )
, ( " M-C-S-k " , sendMessage $ pullGroup U )
, ( " M-C-S-l " , sendMessage $ pullGroup R )
, ( " M-S-C-m " , withFocused ( sendMessage . MergeAll ) )
, ( " M-S-C-<Backspace> " , withFocused ( sendMessage . UnMerge ) )
, ( " M-<Tab> " , onGroup W . focusDown' )
, ( " M-C-<Tab> " , onGroup W . focusUp' )
, ( " M-S-t " , toggleTabbedLayout )
-- In tabbed mode, while focussing master pane, cycle tabs on the first slave
, ( " M-S-<Tab> " , do windows W . focusMaster
BoringWindows . focusDown
onGroup W . focusDown'
windows W . focusMaster )
2020-11-14 22:32:12 +00:00
2020-11-18 16:46:53 +00:00
2020-06-21 10:41:26 +00:00
]
multiMonitorBindings :: [ ( String , X () ) ]
multiMonitorBindings =
2020-12-31 14:09:09 +00:00
[ ( " M-s " , windows $ withFocusedOnScreen 2 W . view )
, ( " M-a " , windows $ withFocusedOnScreen 1 W . view )
, ( " M-d " , windows $ withFocusedOnScreen 0 W . view )
, ( " M-S-s " , windows $ withFocusedOnScreen 2 ( \ wsp -> W . view wsp >> W . shift wsp ) )
, ( " M-S-a " , windows $ withFocusedOnScreen 1 ( \ wsp -> W . view wsp >> W . shift wsp ) )
, ( " M-S-d " , windows $ withFocusedOnScreen 0 ( \ wsp -> W . view wsp >> W . shift wsp ) )
2020-06-21 10:41:26 +00:00
, ( " M-C-s " , windows swapScreenContents )
]
programLaunchBindings :: [ ( String , X () ) ]
programLaunchBindings =
[ ( " M-p " , spawn myLauncher )
2020-08-16 21:05:10 +00:00
, ( " M-S-p " , Rofi . showCombi def [ " drun " , " window " , " ssh " ] )
, ( " M-S-e " , Rofi . showNormal ( def { Rofi . fuzzy = False } ) " emoji " )
2020-06-21 10:41:26 +00:00
--, ("M-s", spawn $ scriptFile "rofi-search.sh")
, ( " M-S-o " , spawn $ scriptFile " rofi-open.sh " )
, ( " M-n " , scratchpadSubmap )
, ( " M-e " , Rofi . promptRunCommand def specialCommands )
, ( " M-o " , Rofi . promptRunCommand def withSelectionCommands )
2020-09-20 08:29:51 +00:00
, ( " M-S-C-g " , spawn " giph --stop " >> spawn " scr -s " ) -- stop gif and video recording
2020-06-21 10:41:26 +00:00
--, ("M-b", launchWithBackgroundInstance (className =? "qutebrowser") "bwrap --bind / / --dev-bind /dev /dev --tmpfs /tmp --tmpfs /run qutebrowser")
--, ("M-b", safeSpawnProg "qutebrowser")
, ( " M-b " , safeSpawnProg " firefox " )
2020-11-21 12:06:55 +00:00
, ( " M-S-<Return> " , spawn myTerminal )
2020-06-21 10:41:26 +00:00
--, ("M-S-<Return>", launchWithBackgroundInstance (className =? "Alacritty") "alacritty")
2020-08-25 22:26:00 +00:00
, ( " M-S-< " , spawn " flameshot gui " )
2020-11-18 16:46:53 +00:00
, ( " M-S-h " , fuckshit )
2020-06-21 10:41:26 +00:00
]
miscBindings :: [ ( String , X () ) ]
miscBindings =
[ ( " M-f " , do withFocused ( windows . W . sink )
sendMessage ( MTog . Toggle MTog . FULL )
sendMessage ToggleStruts )
, ( " M-C-S-w " , sendMessage $ MTog . Toggle WINDOWDECORATION )
, ( " M-S-C-c " , kill1 )
, ( " M-S-C-q " , io exitSuccess )
2020-12-25 10:53:37 +00:00
-- useless binding simply to not accidentally quit firefox
, ( " C-q " , pure () )
2020-06-21 10:41:26 +00:00
-- Binary space partitioning
, ( " M-<Delete> " , sendMessage Swap )
, ( " M-M1-<Delete> " , sendMessage Rotate )
-- Media
2020-10-19 15:40:50 +00:00
, ( " <XF86AudioRaiseVolume> " , spawn " ~/.config/eww/popup.sh 3 volume_popup && amixer sset Master 5%+ " )
, ( " <XF86AudioLowerVolume> " , spawn " ~/.config/eww/popup.sh 3 volume_popup && amixer sset Master 5%- " )
2020-06-21 10:41:26 +00:00
, ( " M-S-C-, " , ( notify " hi " ( show $ map ( \ ( a , _ ) -> show a ) workspaceBindings ) ) >> ( notify " ho " ( show removedKeys ) ) )
, ( " M-<Backspace> " , spawn " flash_window " )
, ( " M-g " , incScreenWindowSpacing 5 )
, ( " M-S-g " , decScreenWindowSpacing 5 )
]
workspaceBindings :: [ ( String , X () ) ]
workspaceBindings =
if useSharedWorkspaces
then []
else concat $
[ [ ( " M- " ++ show wspNum , runActionOnWorkspace W . view wspNum )
, ( " M-S- " ++ show wspNum , runActionOnWorkspace W . shift wspNum )
, ( " M-C- " ++ show wspNum , runActionOnWorkspace copy wspNum )
]
| wspNum <- [ 1 .. 9 :: Int ]
]
where
2020-12-31 14:09:09 +00:00
runActionOnWorkspace :: ( VirtualWorkspace -> WindowSet -> WindowSet ) -> Int -> X ()
2020-06-21 10:41:26 +00:00
runActionOnWorkspace action wspNum = do
wsps <- workspaces' <$> asks config
2020-12-31 14:09:09 +00:00
if length wsps > ( wspNum - 1 )
then windows $ onCurrentScreen action ( wsps !! ( wspNum - 1 ) )
else pure ()
2020-06-21 10:41:26 +00:00
windowControlBindings :: [ ( String , X () ) ]
windowControlBindings = windowGoMappings ++ windowSwapMappings ++ resizeMappings
where
windowGoMappings = [ ( " M-M1- " ++ key , Nav2d . windowGo dir False ) | ( key , dir ) <- keyDirPairs ]
windowSwapMappings = [ ( " M-S-M1- " ++ key , Nav2d . windowSwap dir False ) | ( key , dir ) <- keyDirPairs ]
resizeMappings =
[ ( " M-C-h " , ifLayoutIs " BSP " ( sendMessage $ ExpandTowards L ) ( ifLayoutIs " Horizon " ( sendMessage ShrinkSlave ) ( sendMessage Shrink ) ) )
, ( " M-C-j " , ifLayoutIs " BSP " ( sendMessage $ ExpandTowards D ) ( ifLayoutIs " Horizon " ( sendMessage Expand ) ( sendMessage MirrorShrink >> sendMessage ExpandSlave ) ) )
, ( " M-C-k " , ifLayoutIs " BSP " ( sendMessage $ ExpandTowards U ) ( ifLayoutIs " Horizon " ( sendMessage Shrink ) ( sendMessage MirrorExpand >> sendMessage ShrinkSlave ) ) )
, ( " M-C-l " , ifLayoutIs " BSP " ( sendMessage $ ExpandTowards R ) ( ifLayoutIs " Horizon " ( sendMessage ExpandSlave ) ( sendMessage Expand ) ) )
]
-- | toggle tabbed Tall layout, merging all non-master windows
-- into a single tab group when initializing the tabbed layout.
toggleTabbedLayout :: X ()
toggleTabbedLayout = do
sendMessage $ ToggleLayouts . Toggle " Tabbed "
ifLayoutIs " Tabbed " ( do BoringWindows . focusMaster
withFocused ( sendMessage . MergeAll )
withFocused ( sendMessage . UnMerge )
-- refresh the tabs, so they draw correctly
windows W . focusUp
windows W . focusDown )
( return () )
-- | launch a program by starting an instance in a hidden workspace,
-- and just raising an already running instance. This allows for super quick "startup" time.
-- For this to work, the window needs to have the `_NET_WM_PID` set and unique!
launchWithBackgroundInstance :: ( Query Bool ) -> String -> X ()
launchWithBackgroundInstance windowQuery commandToRun = withWindowSet $ \ winSet -> do
fittingHiddenWindows <- ( W . allWindows winSet ) |> filter ( \ win -> Just " NSP " == W . findTag win winSet )
|> filterM ( runQuery windowQuery )
case fittingHiddenWindows of
[] -> do spawnHere commandToRun
spawnOn " NSP " commandToRun
[ winId ] -> do windows $ W . shiftWin ( W . currentTag winSet ) winId
spawnOn " NSP " commandToRun
( winId : _ ) -> windows $ W . shiftWin ( W . currentTag winSet ) winId
swapScreenContents :: W . StackSet i l a sid sd -> W . StackSet i l a sid sd
swapScreenContents ws = if null ( W . visible ws ) then ws else
let
otherScreen = head $ W . visible ws
otherWsp = W . workspace otherScreen
currentScreen = W . current ws
currentWsp = W . workspace currentScreen
in
ws
{ W . current = currentScreen { W . workspace = otherWsp { W . tag = W . tag currentWsp } }
, W . visible = ( otherScreen { W . workspace = currentWsp { W . tag = W . tag otherWsp } } : ( tail $ W . visible ws ) )
}
withSelectionCommands :: [ ( String , X () ) ]
withSelectionCommands =
[ ( " Google " , XSel . transformPromptSelection ( " https://google.com/search?q= " ++ ) " qutebrowser " )
, ( " Hoogle " , XSel . transformPromptSelection ( " https://hoogle.haskell.org/?hoogle= " ++ ) " qutebrowser " )
, ( " Translate " , XSel . getSelection >>= translateMenu )
]
translateMenu :: String -> X ()
translateMenu input = do
selectedLanguage <- Rofi . promptSimple def [ " de " , " en " , " fr " ]
translated <- runProcessWithInput " trans " [ " : " ++ selectedLanguage , input , " --no-ansi " ] " "
notify " Translation " translated
specialCommands :: [ ( String , X () ) ]
specialCommands =
[ ( " screenshot " , spawn $ scriptFile " screenshot.sh " )
, ( " screenshot to file " , spawn $ scriptFile " screenshot.sh --tofile " )
, ( " screenshot full to file " , spawn $ scriptFile " screenshot.sh --tofile --fullscreen " )
2020-08-18 13:20:00 +00:00
, ( " screenvideo to file " , spawn ( scriptFile " screenvideo.sh " ) >> notify " video " " stop video-recording with M-S-C-g " )
2020-06-21 10:41:26 +00:00
, ( " screengif to file " , spawn ( scriptFile " screengif.sh " ) >> notify " gif " " stop gif-recording with M-S-C-g " )
, ( " toggleOptimal " , sendMessage ToggleGaps >> toggleWindowSpacingEnabled )
, ( " toggleSpacing " , toggleWindowSpacingEnabled )
, ( " toggleGaps " , sendMessage ToggleGaps )
, ( " Copy to all workspaces " , windows copyToAll )
, ( " Kill all other copies " , killAllOtherCopies )
, ( " toggle polybar " , sendMessage ToggleStruts >> safeSpawn " polybar-msg " [ " cmd " , " toggle " ] )
, ( " get debug data " , debugStackFullString >>= ( \ str -> safeSpawn " xmessage " [ str ] ) )
, ( " get full stackset " , withWindowSet ( \ ws -> spawn $ " echo ' " ++ show ( W . floating ws ) ++ " \ n " ++ show ( W . current ws ) ++ " ' | xclip -in -selection clipboard " ) )
, ( " asdf " , windows ( \ ws -> ws { W . floating = M . empty } ) )
]
scratchpadSubmap :: X ()
scratchpadSubmap = DescribedSubmap . describedSubmap " Scratchpads "
[ ( " M-n " , " terminal " , namedScratchpadAction scratchpads " terminal " )
, ( " M-w " , " whatsapp " , namedScratchpadAction scratchpads " whatsapp " )
, ( " M-s " , " slack " , namedScratchpadAction scratchpads " slack " )
, ( " M-m " , " spotify " , namedScratchpadAction scratchpads " spotify " )
, ( " M-d " , " discord " , namedScratchpadAction scratchpads " discord " )
]
-- }}}
-- ManageHook -------------------------------{{{
myManageHook :: Query ( Data . Monoid . Endo WindowSet )
myManageHook = composeAll
[ resource =? " Dialog " --> ManageHelpers . doCenterFloat
, appName =? " pavucontrol " --> ManageHelpers . doCenterFloat
2020-07-02 13:40:06 +00:00
--, className =? "mpv" --> ManageHelpers.doRectFloat (W.RationalRect 0.9 0.9 0.1 0.1)
2020-06-21 10:41:26 +00:00
, title =? " Something " --> doFloat
, className =? " termite_floating " --> ManageHelpers . doRectFloat ( W . RationalRect 0.2 0.2 0.6 0.6 )
, className =? " bar_system_status_indicator " --> ManageHelpers . doRectFloat ( W . RationalRect 0.7 0.05 0.29 0.26 )
2020-11-14 22:32:12 +00:00
, title =? " discord.com hat Ihren Bildschirm freigegeben " --> doShift " NSP "
2020-06-21 10:41:26 +00:00
, manageDocks
, namedScratchpadManageHook scratchpads
]
-- }}}
-- Main ------------------------------------ {{{
main :: IO ()
main = do
currentScreenCount :: Int <- countScreens
let monitorIndices = [ 0 .. currentScreenCount - 1 ]
2020-09-25 18:56:00 +00:00
2020-11-14 22:32:12 +00:00
2020-06-21 10:41:26 +00:00
-- create a fifo named pipe for every monitor (called /tmp/xmonad-state-bar0, etc)
for_ monitorIndices ( \ idx -> safeSpawn " mkfifo " [ " /tmp/xmonad-state-bar " ++ show idx ] )
-- create polybarLogHooks for every monitor and combine them using the <+> monoid instance
let polybarLogHooks = composeAll $ map polybarLogHook monitorIndices
let myConfig = flip additionalKeysP myKeys
$ flip removeKeysP removedKeys
$ Desktop . desktopConfig
{ terminal = myTerminal
, workspaces = if useSharedWorkspaces
then ( map show [ 1 .. 9 :: Int ] ) ++ [ " NSP " ]
else ( withScreens ( fromIntegral currentScreenCount ) ( map show [ 1 .. 6 :: Int ] ) ) ++ [ " NSP " ]
, modMask = myModMask
2020-08-30 17:00:09 +00:00
, borderWidth = 0
2020-06-21 10:41:26 +00:00
, layoutHook = myLayout
2020-08-30 17:00:09 +00:00
, logHook = mconcat [ polybarLogHooks
, Ewmh . ewmhDesktopsLogHook
, logHook Desktop . desktopConfig
--, fadeInactiveLogHook 0.95
, logHook def ]
, startupHook = mconcat [ Ewmh . ewmhDesktopsStartup , myStartupHook , return () >> checkKeymap myConfig myKeys ]
2020-06-21 10:41:26 +00:00
, manageHook = mconcat [ manageSpawn , myManageHook , manageHook def ]
, focusedBorderColor = " #427b58 "
, normalBorderColor = " #282828 "
, handleEventHook = mconcat [ mySwallowEventHook
, activateWindowEventHook
, handleEventHook Desktop . desktopConfig
2020-12-31 14:09:09 +00:00
, fullscreenFixEventHook
2020-06-21 10:41:26 +00:00
, Ewmh . ewmhDesktopsEventHook
]
--, handleEventHook = minimizeEventHook <+> handleEventHook def <+> hintsEventHook -- <+> Ewmh.fullscreenEventHook
, mouseBindings = myMouseBindings <+> mouseBindings def
}
xmonad
$ Nav2d . withNavigation2DConfig def { Nav2d . defaultTiledNavigation = Nav2d . sideNavigation }
$ docks
$ myConfig
-- }}}
2020-11-18 16:46:53 +00:00
2020-07-10 13:16:46 +00:00
mySwallowEventHook = WindowSwallowing . swallowEventHook
2020-08-05 12:55:11 +00:00
( className =? " Alacritty " <||> className =? " Termite " <||> className =? " NOPE Thunar " )
2020-10-19 15:40:50 +00:00
( ( not <$> ( className =* " eww " <||> className =? " Dragon " <||> className =? " noswallow " ) ) <||> className =? " re " ) -- remove that last part
2020-06-21 10:41:26 +00:00
2020-10-19 15:40:50 +00:00
( =* ) :: Query String -> String -> Query Bool
query =* value = ( value ` isInfixOf ` ) <$> query
2020-06-21 10:41:26 +00:00
activateWindowEventHook :: Event -> X All
activateWindowEventHook ( ClientMessageEvent { ev_message_type = messageType , ev_window = window } ) = withWindowSet $ \ ws -> do
activateWindowAtom <- getAtom " _NET_ACTIVE_WINDOW "
2020-06-25 18:57:56 +00:00
2020-06-21 10:41:26 +00:00
when ( messageType == activateWindowAtom ) $
2020-12-31 14:09:09 +00:00
if window ` elem ` W . allWindows ws
2020-06-21 10:41:26 +00:00
then windows ( W . focusWindow window )
else do
shouldRaise <- runQuery ( className =? " discord " <||> className =? " web.whatsapp.com " ) window
if shouldRaise
2020-12-31 14:09:09 +00:00
then windows ( W . shiftWin ( W . currentTag ws ) window )
else withWindowSet $ focusWindowIndependentScreens window
2020-06-21 10:41:26 +00:00
return $ All True
activateWindowEventHook _ = return $ All True
2020-06-26 18:38:19 +00:00
-- | Fixes fullscreen behaviour of chromium based apps by quickly applying and undoing a resize.
2020-07-10 13:16:46 +00:00
-- This causes chromium to recalculate the fullscreen window
2020-06-26 18:38:19 +00:00
-- dimensions to match the actual "windowed fullscreen" dimensions.
fullscreenFixEventHook :: Event -> X All
fullscreenFixEventHook ( ClientMessageEvent _ _ _ dpy win typ ( _ : dats ) ) = do
wmstate <- getAtom " _NET_WM_STATE "
fullscreen <- getAtom " _NET_WM_STATE_FULLSCREEN "
when ( typ == wmstate && fromIntegral fullscreen ` elem ` dats ) $ do
withWindowAttributes dpy win $ \ attrs ->
liftIO $ resizeWindow dpy win ( fromIntegral $ wa_width attrs - 1 ) ( fromIntegral $ wa_height attrs )
withWindowAttributes dpy win $ \ attrs ->
liftIO $ resizeWindow dpy win ( fromIntegral $ wa_width attrs + 1 ) ( fromIntegral $ wa_height attrs )
return $ All True
fullscreenFixEventHook _ = return $ All True
2020-07-10 13:16:46 +00:00
2020-09-25 18:56:00 +00:00
2020-06-26 18:38:19 +00:00
2020-06-21 10:41:26 +00:00
-- POLYBAR Kram -------------------------------------- {{{
-- | Loghook for polybar on a given monitor.
-- Will write the polybar formatted string to /tmp/xmonad-state-bar${monitor}
polybarLogHook :: Int -> X ()
polybarLogHook monitor = do
barOut <- dynamicLogString $ polybarPP $ fromIntegral monitor
io $ SysIO . appendFile ( " /tmp/xmonad-state-bar " ++ show monitor ) ( barOut ++ " \ n " )
-- swapping namedScratchpadFilterOutWorkspacePP and marshallPP will throw "Prelude.read no Parse" errors..... wtf
-- | create a polybar Pretty printer, marshalled for given monitor.
polybarPP :: ScreenId -> PP
polybarPP monitor = namedScratchpadFilterOutWorkspacePP . ( if useSharedWorkspaces then id else marshallPP $ fromIntegral monitor ) $ def
{ ppCurrent = withFG aqua . withMargin . withFont 5 . const " __active__ "
, ppVisible = withFG aqua . withMargin . withFont 5 . const " __active__ "
, ppUrgent = withFG red . withMargin . withFont 5 . const " __urgent__ "
, ppHidden = withFG gray . withMargin . withFont 5 . ( ` wrapClickableWorkspace ` " __hidden__ " )
, ppHiddenNoWindows = withFG gray . withMargin . withFont 5 . ( ` wrapClickableWorkspace ` " __empty__ " )
, ppWsSep = " "
, ppSep = " "
, ppLayout = removeWords [ " DraggingVisualizer " , " WindowSwitcherDeco " , " Minimize " , " Hinted " , " Spacing " , " Tall " ]
>>> \ l -> if l == " Tall " || l == " Horizon " || l == " " then " "
else ( withFG gray " | " ) ++ ( withFG purple $ withMargin l )
, ppExtras = []
, ppTitle = const " " -- withFG aqua . (shorten 40)
, ppSort = if useSharedWorkspaces then getSortByXineramaPhysicalRule horizontalScreenOrderer
else onlyRelevantWspsSorter
}
where
withMargin = wrap " " " "
removeWords wrds = unwords . filter ( ` notElem ` wrds ) . words
withFont fNum = wrap ( " %{T " ++ show ( fNum :: Int ) ++ " } " ) " %{T} "
withBG col = wrap ( " %{B " ++ col ++ " } " ) " %{B-} "
withFG col = wrap ( " %{F " ++ col ++ " } " ) " %{F-} "
wrapOnClickCmd command = wrap ( " %{A1: " ++ command ++ " :} " ) " %{A} "
wrapClickableWorkspace wsp = wrapOnClickCmd ( " xdotool key super+ " ++ wsp )
onlyRelevantWspsSorter = do
sortByIndex <- getSortByIndex
visibleWorkspaceTags <- getVisibleWorkspacesTagsOnMonitor monitor
let isEmptyAndNotOpened wsp = ( null $ W . stack wsp ) && ( W . tag wsp ) ` notElem ` visibleWorkspaceTags
return $ dropEndWhile isEmptyAndNotOpened . sortByIndex
-- }}}
-- Utilities --------------------------------------------------- {{{
( |> ) :: a -> ( a -> b ) -> b
( |> ) = ( & )
infixl 1 |>
dropEndWhile :: ( a -> Bool ) -> [ a ] -> [ a ]
dropEndWhile _ [] = []
dropEndWhile test xs = if test $ last xs then dropEndWhile test ( init xs ) else xs
catchAndNotifyAny :: IO () -> IO ()
catchAndNotifyAny ioAction = catch ioAction ( \ ( e :: SomeException ) -> notify " Xmonad exception " ( show e ) )
getVisibleWorkspacesTagsOnMonitor :: ScreenId -> X [ VirtualWorkspace ]
getVisibleWorkspacesTagsOnMonitor monitor = do
ws <- gets windowset
return $ W . current ws : W . visible ws
|> map ( W . tag . W . workspace )
|> filter ( \ tag -> monitor == fromIntegral ( unmarshallS tag ) )
|> map unmarshallW
notify :: MonadIO m => String -> String -> m ()
notify notificationTitle notificationMsg = safeSpawn " notify-send " [ notificationTitle , notificationMsg ]
ifLayoutIs :: String -> X a -> X a -> X a
ifLayoutIs layoutAName = ifLayoutName ( == layoutAName )
ifLayoutName :: ( String -> Bool ) -> X a -> X a -> X a
ifLayoutName check onLayoutA onLayoutB = do
layout <- getActiveLayoutDescription
if ( check layout ) then onLayoutA else onLayoutB
2020-11-18 16:46:53 +00:00
-- | Get the name of the active layout.
2020-06-21 10:41:26 +00:00
getActiveLayoutDescription :: X String
getActiveLayoutDescription = ( description . W . layout . W . workspace . W . current ) <$> gets windowset
2020-12-31 14:09:09 +00:00
-- | Focus a window, switching workspace on the correct Xinerama screen if neccessary - respecting IndependentLayouts
focusWindowIndependentScreens :: Window -> WindowSet -> X ()
focusWindowIndependentScreens window ws
| Just window == W . peek ws = pure ()
| otherwise = case W . findTag window ws of
Just tag -> windows $ W . focusWindow window . withFocusedOnScreen ( unmarshallS tag ) W . view
Nothing -> pure ()
-- | Get the workspace that is active on a given screen
screenOnMonitor :: ScreenId -> WindowSet -> Maybe ( W . Screen WorkspaceId ( Layout Window ) Window ScreenId ScreenDetail )
screenOnMonitor screenId ws = Data . List . find ( ( screenId == ) . W . screen ) ( W . current ws : W . visible ws )
-- | Convert a function that needs a workspace id into a windowset transformation by providing it with the workspace currently focused on a given screen.
withFocusedOnScreen
:: ScreenId -- ^ screen from which the workspaceId will be taken
-> ( WorkspaceId -> WindowSet -> WindowSet ) -- ^ operation that will be transformed
-> ( WindowSet -> WindowSet )
withFocusedOnScreen screenId operation ws =
case screenOnMonitor screenId ws of
Just wsp -> operation ( W . tag $ W . workspace wsp ) ws
Nothing -> ws
2020-06-21 10:41:26 +00:00
-- }}}
2020-11-14 22:32:12 +00:00
2020-11-18 16:46:53 +00:00
--
--
-- newtype ActionCycleState = ActionCycleState (M.Map String Int) deriving Typeable
-- instance ExtensionClass ActionCycleState where
-- initialValue = ActionCycleState mempty
--
-- getActionCycle :: String -> ActionCycleState -> Maybe Int
-- getActionCycle name (ActionCycleState s) = M.lookup name s
--
-- nextActionCycle :: String -> Int -> ActionCycleState -> ActionCycleState
-- nextActionCycle name maxNum (ActionCycleState s) = ActionCycleState $ M.update (\n -> Just $ (n + 1) `mod` maxNum) name s
--
-- setActionCycle :: String -> Int -> ActionCycleState -> ActionCycleState
-- setActionCycle name n (ActionCycleState s)= ActionCycleState $ M.insert name n s
--
-- cycleAction :: String -> [X ()] -> X ()
-- cycleAction _ [] = pure ()
-- cycleAction name actions = do
-- idx <- XS.gets (getActionCycle name) >>= \case
-- Just x -> do
-- XS.modify (nextActionCycle name (length actions))
-- pure x
-- Nothing -> do
-- XS.modify (setActionCycle name 1)
-- pure 0
--
-- sequence_ $ actions `safeIdx` idx
--
--
--
--
-- safeIdx :: [a] -> Int -> Maybe a
-- safeIdx list i
-- | i < length list = Just $ list !! i
-- | otherwise = Nothing
--
unsafeGetXrdbValue :: String -> String
unsafeGetXrdbValue = unsafePerformIO . getXrdbValue
2020-11-14 22:32:12 +00:00
getXrdbValue :: String -> IO String
getXrdbValue key = fromMaybe " " . findValue key <$> runProcessWithInput " xrdb " [ " -query " ] " "
where
findValue :: String -> String -> Maybe String
findValue xresKey xres =
snd <$> ( Data . List . find ( ( == xresKey ) . fst )
$ catMaybes
$ splitAtColon
<$> lines xres
)
splitAtColon :: String -> Maybe ( String , String )
splitAtColon str = splitAtTrimming str <$> ( Data . List . elemIndex ':' str )
splitAtTrimming :: String -> Int -> ( String , String )
splitAtTrimming str idx = bimap trim trim . ( second tail ) $ splitAt idx str
2020-11-18 16:46:53 +00:00
fuckshit = getActiveLayoutDescription >>= debugShit
debugShit :: MonadIO m => String -> m ()
debugShit x = spawn $ " notify-send 'Debug' ' " ++ x ++ " ' "