{-# LANGUAGE TupleSections, ViewPatterns, OverloadedStrings, FlexibleInstances, UndecidableInstances, MultiWayIf, NumDecimals #-} import XMonad import XMonad.Hooks.DynamicLog import XMonad.Hooks.ManageDocks import XMonad.Util.Run hiding (proc) import XMonad.Util.Loggers import XMonad.Util.EZConfig(additionalKeys) import System.IO import System.IO.Error import System.Environment import Data.Map (Map) import qualified Data.Map as Map import qualified XMonad.StackSet as W import System.Exit import Control.Monad.State (get) -- import XMonad.Layout.Spiral import Data.Ratio import Data.List import Data.Char import Data.Maybe (fromMaybe, listToMaybe, maybeToList, catMaybes, isJust) import XMonad.Layout.Tabbed import XMonad.Prompt import XMonad.Prompt.Input import XMonad.Util.Scratchpad import XMonad.Util.NamedScratchpad import XMonad.Util.Ungrab import Control.Monad (sequence, liftM, liftM2, join, void) import XMonad.Util.WorkspaceCompare import XMonad.Layout.NoBorders import XMonad.Layout.PerWorkspace import XMonad.Layout.SimplestFloat import XMonad.Layout.Renamed import XMonad.Layout.Reflect import XMonad.Layout.OnHost import XMonad.Layout.Combo import XMonad.Layout.ComboP import XMonad.Layout.Column import XMonad.Layout.TwoPane import XMonad.Layout.IfMax import XMonad.Layout.LayoutBuilder import XMonad.Layout.WindowNavigation import XMonad.Layout.Dwindle import XMonad.Layout.TrackFloating import System.Process import System.Directory (removeFile) import System.Posix.Files import System.FilePath (()) import Control.Concurrent import System.Posix.Process (getProcessID) import System.IO.Error import System.IO import XMonad.Hooks.ManageHelpers hiding (CW) import XMonad.Hooks.UrgencyHook as U import XMonad.Hooks.EwmhDesktops import XMonad.StackSet (RationalRect (..)) import Control.Monad (when, filterM, (<=<)) import Graphics.X11.ExtraTypes.XF86 import XMonad.Util.Cursor import XMonad.Actions.Warp import XMonad.Actions.FloatKeys import XMonad.Util.SpawnOnce import System.Directory import System.FilePath import XMonad.Actions.CopyWindow import XMonad.Hooks.ServerMode import XMonad.Actions.Commands import XMonad.Actions.CycleWS import XMonad.Actions.RotSlaves import XMonad.Actions.UpdatePointer import XMonad.Prompt.Window import Data.IORef import Data.Monoid import Data.String import qualified XMonad.Actions.PhysicalScreens as P import XMonad.Layout.IM import System.Taffybar.Support.PagerHints (pagerHints) import XMonad.Prompt.MyShell import XMonad.Prompt.MyPass import XMonad.Prompt.MySsh import XMonad.Mpv import Network.HostName import Control.Applicative ((<$>)) import Libnotify as Notify hiding (appName) import qualified Libnotify as Notify (appName) import Libnotify (Notification) -- import System.Information.Battery import Data.Int (Int32) import System.Posix.Process import System.Posix.Signals import System.Posix.IO as Posix import Control.Exception import System.IO.Unsafe import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Data.Fixed (Micro) import qualified Data.Text as Text import Data.Ord (comparing) import Debug.Trace instance MonadIO m => IsString (m ()) where fromString = spawn type KeyMap = Map (ButtonMask, KeySym) (X ()) data Host = Host { hName :: HostName , hManageHook :: ManageHook , hWsp :: Integer -> WorkspaceId , hCoWsp :: String -> Maybe WorkspaceId , hKeysMod :: XConfig Layout -> (KeyMap -> KeyMap) , hScreens :: [P.PhysicalScreen] , hKbLayouts :: [(String, Maybe String)] , hCmds :: X [(String, X ())] , hKeyUpKeys :: XConfig Layout -> KeyMap } defaultHost = Host { hName = "unkown" , hManageHook = composeOne [manageScratchTerm] , hWsp = show , hCoWsp = const Nothing , hKeysMod = const id , hScreens = [0,1..] , hKbLayouts = [ ("us", Just "dvp") , ("us", Nothing) , ("de", Nothing) ] , hCmds = return [] , hKeyUpKeys = const Map.empty } browser :: String browser = "env MOZ_USE_XINPUT2=1 firefox" gray, darkGray, red, green :: String gray = "#808080" darkGray = "#202020" red = "#800000" green = "#008000" hostFromName :: HostName -> Host hostFromName h@("vali") = defaultHost { hName = h , hManageHook = composeOne $ catMaybes [ Just manageScratchTerm , assign "web" $ className =? ".dwb-wrapped" , assign "web" $ className =? "Chromium" , assign "work" $ className =? "Emacs" , assign "media" $ className =? "mpv" ] , hWsp = hWsp , hCoWsp = hCoWsp , hKeysMod = \conf -> Map.union $ (Map.fromList $ join $ map (spawnBindings conf) [ (xK_d, ["chromium", "chromium $(xclip -o)"]) , (xK_e, ["emacsclient -c"]) ]) `Map.union` ( Map.fromList [ ((XMonad.modMask conf .|. controlMask, xK_Return), scratchpadSpawnActionCustom $ (XMonad.terminal conf) ++ " -name scratchpad -title scratchpad -e tmux new-session -D -s scratch") ] ) , hScreens = hScreens defaultHost } where workspaceNames = Map.fromList [ (2, "web") , (3, "work") , (10, "media") ] hWsp = wspFromMap workspaceNames hCoWsp = coWspFromMap workspaceNames assign wsp test = (\wsp -> test -?> doShift wsp) <$> hCoWsp wsp hostFromName h | h `elem` ["hel", "sif"] = defaultHost { hName = h , hManageHook = namedScratchpadManageHook scratchpads <+> composeOne (catMaybes [ assign "mpv" $ className =? "mpv" , assign "mpv" $ stringProperty "WM_WINDOW_ROLE" =? "presentation" , assign "read" $ stringProperty "WM_WINDOW_ROLE" =? "presenter" , assign "mpv" $ className =? "factorio" , assign "mpv" $ resource =? "twitch" , assign "web" $ className =? "chromium-browser" , assign "web" $ className =? "Google-chrome" , assign "work" $ (appName =? "Devtools" <&&> className =? "firefox") , assign "work" $ className =? "Postman" , assign "web" $ (appName =? "Navigator" <&&> className =? "firefox") , assign "comm" $ (className =? "Emacs" <&&> title =? "Mail") , assign "comm" $ className =? "Zulip" , assign "comm" $ className =? "Element" , assign "comm" $ className =? "Rocket.Chat" , assign "comm" $ className =? "Discord" , assign "comm" $ className =? "Rainbow" , assign "media" $ resource =? "media" , assign "monitor" $ className =? "Grafana" , assign "monitor" $ className =? "Virt-viewer" , assign "monitor" $ resource =? "htop" , assign "monitor" $ resource =? "monitor" , assign "monitor" $ className =? "xfreerdp" , assign "monitor" $ className =? "org.remmina.Remmina" , Just $ resource =? "htop" -?> centerFloat , Just $ (className =? "Scp-dbus-service.py") -?> centerFloat , Just $ resource =? "log" -?> centerFloat , assign "work" $ className =? "Alacritty" , Just $ (appName =? "Edit with Emacs FRAME") -?> centerFloat , assign' ["work", "uni"] $ (className =? "Emacs" <&&> appName /=? "Edit with Emacs FRAME") , assign' ["work", "uni"] $ className =? "jetbrains-idea-ce" , assign "read" $ className =? "llpp" , assign "read" $ className =? "Evince" , assign "read" $ className =? "Zathura" , assign "read" $ className =? "MuPDF" , assign "read" $ className =? "Xournal" , assign "read" $ appName =? "libreoffice" , assign "read" $ appName =? "com-trollworks-gcs-app-GCS" , assign "read" $ appName =? "Tux.py" , assign "read" $ className =? "Gnucash" , assign "comm" $ className =? "Skype" , assign "comm" $ className =? "Daily" , assign "comm" $ className =? "Pidgin" , assign "comm" $ className =? "Thunderbird" , assign "comm" $ className =? "Slack" , Just $ (resource =? "xvkbd") -?> doRectFloat $ RationalRect (1 % 8) (3 % 8) (6 % 8) (4 % 8) , Just $ (stringProperty "_NET_WM_WINDOW_TYPE" =? "_NET_WM_WINDOW_TYPE_DIALOG") -?> doFloat , Just $ (className =? "Dunst") -?> doFloat , Just $ (className =? "Xmessage") -?> doCenterFloat , Just $ (className =? "Nm-openconnect-auth-dialog") -?> centerFloat , Just $ (className =? "Pinentry") -?> doCenterFloat , Just $ (className =? "pinentry") -?> doCenterFloat , Just $ (stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooseDialog") -?> centerFloatSmall , Just $ (className =? "Nvidia-settings") -?> doCenterFloat , Just $ fmap ("Minetest" `isInfixOf`) title -?> doIgnore , Just $ fmap ("Automachef" `isInfixOf`) title -?> doIgnore , assign "call" $ className =? "zoom" ]) , hWsp = hWsp , hCoWsp = hCoWsp , hKeysMod = \conf -> Map.union $ (Map.fromList $ join $ map (spawnBindings conf) [ (xK_e, ["emacsclient -c"]) , (xK_d, [fromString browser, "google-chrome" {- , "notmuch-links" -}]) , (xK_c, [ inputPrompt xPConfigMonospace "dc" ?+ dc ]) , (xK_g, ["pidgin"]) , (xK_s, ["skype"]) -- , (xK_p, [mkPassPrompt "Type password" pwType xPConfig, mkPassPrompt "Show password" pwShow xPConfig, mkPassPrompt "Copy password" pwClip xPConfig]) , (xK_w, ["sudo rewacom"]) , (xK_y, [ "tmux new-window -dt media /var/media/link.hs $(xclip -o)" , "tmux new-window -dt media /var/media/download.hs $(xclip -o)" , "tmux new-window -dt media /var/media/download.hs $(xclip -o -selection clipboard)" ]) , (xK_l, [ "tmux new-window -dt media mpv $(xclip -o)" , "tmux new-window -dt media mpv $(xclip -o -selection clipboard)" , "alacritty --class media -e tmuxp load /var/media" ]) {- , (xK_m, [ "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e '(notmuch)'" , "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e '(notmuch-mua-new-mail)'" , "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e \"(browse-url-mail \"$(xclip -o)\")\"" ]) -} , (xK_Return, ["keynav start,windowzoom", "keynav start"]) , (xK_t, [inputPrompt xPConfigMonospace "fuzzytime timer" ?+ fuzzytime, fuzzytime "unset", work_fuzzytime]) , (xK_a, [inputPrompt xPConfigMonospace "adjmix" ?+ adjmix]) , (xK_s, [ inputPromptWithCompl xPConfigMonospace "start synergy" synergyCompl ?+ synergyStart , inputPromptWithCompl xPConfigMonospace "stop synergy" synergyCompl ?+ synergyStop ]) , (xK_h, [ "alacritty --class htop -e htop" , "alacritty --class log -e journalctl -xef" ]) , (xK_x, [ "autorandr -c" , "autorandr -fl def" ]) , (xK_z, [ "zulip -- --force-device-scale-factor=2" ]) ]) `Map.union` ( Map.fromList [ ((XMonad.modMask conf .|. controlMask, xK_Return), namedScratchpadAction scratchpads "term") , ((XMonad.modMask conf .|. controlMask, xK_a), namedScratchpadAction scratchpads "pavucontrol") , ((XMonad.modMask conf .|. controlMask, xK_o), namedScratchpadAction scratchpads "easyeffects") , ((XMonad.modMask conf .|. controlMask .|. shiftMask, xK_o), namedScratchpadAction scratchpads "helvum") , ((XMonad.modMask conf .|. controlMask, xK_w), namedScratchpadAction scratchpads "alarms") , ((XMonad.modMask conf .|. controlMask, xK_b), namedScratchpadAction scratchpads "blueman") , ((XMonad.modMask conf .|. controlMask, xK_p), namedScratchpadAction scratchpads "keepassxc") , ((XMonad.modMask conf .|. controlMask, xK_t), namedScratchpadAction scratchpads "toggl") , ((XMonad.modMask conf .|. controlMask, xK_e), namedScratchpadAction scratchpads "emacs") , ((XMonad.modMask conf .|. controlMask, xK_m), namedScratchpadAction scratchpads "calendar") , ((XMonad.modMask conf .|. controlMask, xK_f), namedScratchpadAction scratchpads "music") , ((XMonad.modMask conf .|. mod1Mask, xK_Up), rotate U) , ((XMonad.modMask conf .|. mod1Mask, xK_Down), rotate D) , ((XMonad.modMask conf .|. mod1Mask, xK_Left), rotate L) , ((XMonad.modMask conf .|. mod1Mask, xK_Right), rotate R) , ((controlMask, xK_space ), "dunstctl close" ) , ((controlMask .|. shiftMask, xK_space ), "dunstctl close-all" ) , ((controlMask, xK_period), "dunstctl context" ) , ((controlMask, xK_comma ), "dunstctl history-pop") -- , ((XMonad.modMask conf .|. shiftMask, xK_a), startMute "hel") ] ) , hKeyUpKeys = \conf -> Map.fromList [ -- ((XMonad.modMask conf .|. shiftMask, xK_a), stopMute "hel") ] , hScreens = hScreens defaultHost , hCmds = return [ ("prev-workspace", prevWS) , ("next-workspace", nextWS) , ("prev-window", rotAllDown) , ("next-window", rotAllUp) , ("banish", banishScreen LowerRight) , ("update-gpg-tty", safeSpawn "gpg-connect-agent" ["UPDATESTARTUPTTY", "/bye"]) , ("rescreen", rescreen) , ("repanel", do spawn "nm-applet" spawn "blueman-applet" spawn "pasystray" spawn "kdeconnect-indicator" spawn "dunst -print" spawn "udiskie" spawn "autocutsel -s PRIMARY" spawn "autocutsel -s CLIPBOARD" ) , ("pause", mediaMpv $ MpvSetProperty "pause" True) , ("unpause", mediaMpv $ MpvSetProperty "pause" False) , ("exit", io $ exitWith ExitSuccess) ] } where withGdkScale act = void . xfork $ setEnv "GDK_SCALE" "2" >> act workspaceNames = Map.fromList [ (1, "comm") , (2, "web") , (3, "work") , (4, "read") , (5, "monitor") , (6, "uni") , (8, "call") , (9, "media") , (10, "mpv") ] scratchpads = [ NS "term" "alacritty --class scratchpad --title scratchpad -e tmux new-session -AD -s scratch" (resource =? "scratchpad") centerFloat , NS "pavucontrol" "pavucontrol" (resource =? "pavucontrol") centerFloat , NS "helvum" "helvum" (resource =? "helvum") centerFloat , NS "easyeffects" "easyeffects" (resource =? "easyeffects") centerFloat , NS "alarms" "alarm-clock-applet" (className =? "Alarm-clock-applet" <&&> title =? "Alarms") centerFloat , NS "blueman" "blueman-manager" (className =? ".blueman-manager-wrapped") centerFloat , NS "keepassxc" "keepassxc" (className =? "KeePassXC") centerFloat , NS "toggl" "toggldesktop" (className =? "Toggl Desktop") centerFloat , NS "calendar" "minetime -- --force-device-scale-factor=1.6" (className =? "MineTime") centerFloat , NS "emacs" "emacsclient -c -F \"'(title . \\\"Scratchpad\\\")\"" (className =? "Emacs" <&&> title =? "Scratchpad") centerFloat , NS "music" "ytmdesktop" (className =? "youtube-music-desktop-app") centerFloat ] centerFloat = customFloating $ RationalRect (1 % 16) (1 % 16) (7 % 8) (7 % 8) centerFloatSmall = customFloating $ RationalRect (1 % 4) (1 % 4) (1 % 2) (1 % 2) hWsp = wspFromMap workspaceNames hCoWsp = coWspFromMap workspaceNames assign wsp test = (\wsp -> test -?> doShift wsp) <$> hCoWsp wsp assign' :: [String] -> Query Bool -> Maybe MaybeManageHook assign' wsps test = do wsIds <- mapM hCoWsp wsps return $ test -?> go wsIds where go :: [WorkspaceId] -> ManageHook go wsps = do visWsps <- liftX $ (\wset -> W.tag . W.workspace <$> W.current wset : W.visible wset) <$> gets windowset case (filter (`elem` visWsps) wsps, wsps) of (wsp : _, _) -> doShift wsp (_, wsp : _) -> doShift wsp ([], []) -> return mempty rotate rot = do safeSpawn "xrandr" ["--output", "eDP-1", "--rotate", xrandrDir] mapM_ rotTouch touchscreens where xrandrDir = case rot of U -> "normal" L -> "left" R -> "right" D -> "inverted" matrix = case rot of U -> [ [ 1, 0, 0] , [ 0, 1, 0] , [ 0, 0, 1] ] L -> [ [ 0, -1, 1] , [ 1, 0, 0] , [ 0, 0, 1] ] R -> [ [ 0, 1, 0] , [-1, 0, 1] , [ 0, 0, 1] ] D -> [ [-1, 0, 1] , [ 0, -1, 1] , [ 0, 0, 1] ] touchscreens = [ "Wacom Co.,Ltd. Pen and multitouch sensor Finger touch" , "Wacom Co.,Ltd. Pen and multitouch sensor Pen stylus" , "Wacom Co.,Ltd. Pen and multitouch sensor Pen eraser" ] rotTouch screen = do safeSpawn "xinput" $ ["set-prop", screen, "Coordinate Transformation Matrix"] ++ map (\n -> show n ++ ",") (concat matrix) safeSpawn "xinput" ["map-to-output", screen, "eDP-1"] withPw f label = io . void . forkProcess $ do uninstallSignalHandlers void $ createSession (dropWhileEnd isSpace -> pw) <- readCreateProcess (proc "pass" ["show", label]) "" void $ f pw pwType :: String -> X () pwType = withPw $ readCreateProcess (proc "xdotool" ["type", "--clearmodifiers", "--file", "-"]) pwClip label = safeSpawn "pass" ["show", "--clip", label] pwShow :: String -> X () pwShow = withPw $ \pw -> do xmessage <- fromMaybe "xmessage" <$> liftIO (lookupEnv "XMONAD_XMESSAGE") readCreateProcess (proc xmessage ["-file", "-"]) pw fuzzytime str = safeSpawn "fuzzytime" $ "timer" : words str work_fuzzytime = io . void . forkProcess $ do readCreateProcess (proc "worktime" []) "" >>= safeSpawn "fuzzytime" . ("timer" : ) . pure adjmix str = safeSpawn "adjmix" $ words str dc expr = void . xfork $ do result <- readProcess "dc" [] $ expr ++ "f" let (first : rest) = filter (not . null) $ lines result notification = Notify.summary first <> Notify.body (unlines rest) <> Notify.timeout Infinite <> Notify.urgency Normal <> Notify.appName "dc" void $ Notify.display notification synergyCompl = mkComplFunFromList' xPConfigMonospace ["mathw86"] synergyStart host = safeSpawn "systemctl" ["--user", "start", "synergy-rtunnel@" ++ host ++ ".service"] synergyStop host = safeSpawn "systemctl" ["--user", "stop", "synergy-rtunnel@" ++ host ++ ".service"] hostFromName _ = defaultHost -- muteRef :: IORef (Maybe (String, Notification)) -- {-# NOINLINE muteRef #-} -- muteRef = unsafePerformIO $ newIORef Nothing -- startMute, stopMute :: String -> X () -- startMute sink = liftIO $ do -- muted <- isJust <$> readIORef muteRef -- when (not muted) $ do -- let -- notification = Notify.summary "Muted" <> Notify.timeout Infinite <> Notify.urgency Normal -- level = "0.0dB" -- -- level <- runProcessWithInput "ssh" ["bragi", "cat", "/dev/shm/mix/" ++ sink ++ "/level"] "" -- -- callProcess "ssh" ["bragi", "adjmix", "-t", sink, "-o", "0"] -- hPutStrLn stderr "Mute" -- writeIORef muteRef . Just . (level, ) =<< Notify.display notification -- stopMute sink = liftIO $ do -- let -- unmute (Just (level, notification)) = do -- hPutStrLn stderr "Unmute" -- -- callProcess "ssh" ["bragi", "adjmix", "-t", sink, "-o", level] -- Notify.close notification -- unmute Nothing = return () -- muted <- isJust <$> readIORef muteRef -- when muted . join . atomicModifyIORef muteRef $ (Nothing, ) . unmute wspFromMap workspaceNames = \i -> case Map.lookup i workspaceNames of Just str -> show i ++ " " ++ str Nothing -> show i coWspFromMap workspaceNames = \str -> case filter ((== str) . snd) $ Map.toList workspaceNames of [] -> Nothing [(i, _)] -> Just $ wspFromMap workspaceNames i _ -> Nothing spawnModifiers = [0, controlMask, shiftMask .|. controlMask] spawnBindings :: XConfig layout -> (KeySym, [X ()]) -> [((KeyMask, KeySym), X ())] spawnBindings conf (k, cmds) = zipWith (\m cmd -> ((modm .|. mod1Mask .|. m, k), cmd)) spawnModifiers cmds where modm = XMonad.modMask conf manageScratchTerm = (resource =? "scratchpad" <||> resource =? "keysetup") -?> doRectFloat $ RationalRect (1 % 16) (1 % 16) (7 % 8) (7 % 8) tabbedLayout t = renamed [Replace "Tabbed"] $ reflectHoriz $ t CustomShrink $ tabbedTheme tabbedLayoutHoriz t = renamed [Replace "Tabbed Horiz"] $ reflectVert $ t CustomShrink $ tabbedTheme tabbedTheme = def { activeColor = "black" , inactiveColor = "black" , urgentColor = "black" , activeBorderColor = gray , inactiveBorderColor = darkGray , urgentBorderColor = red , activeTextColor = gray , inactiveTextColor = gray , urgentTextColor = gray , decoHeight = 32 , fontName = "xft:Fira Sans:pixelsize=21" } main :: IO () main = do arguments <- either (const []) id <$> tryIOError getArgs case arguments of ["--command", s] -> do d <- openDisplay "" rw <- rootWindow d $ defaultScreen d a <- internAtom d "XMONAD_COMMAND" False m <- internAtom d s False allocaXEvent $ \e -> do setEventType e clientMessage setClientMessageEvent e rw a 32 m currentTime sendEvent d rw False structureNotifyMask e sync d False _ -> do -- batteryMon <- xfork $ monitorBattery Nothing Nothing hostname <- getHostName let host = hostFromName hostname setEnv "HOST" hostname let myConfig = withHostUrgency . ewmhFullscreen . ewmh . pagerHints $ docks def { manageHook = hManageHook host , terminal = "alacritty" , layoutHook = smartBorders . avoidStruts $ windowNavigation layout' , logHook = do dynamicLogString xmobarPP' >>= writeProps updatePointer (99 % 100, 98 % 100) (0, 0) , modMask = mod4Mask , keys = \conf -> hKeysMod host conf $ myKeys' conf host , workspaces = take (length numKeys) $ map wsp [1..] , startupHook = setDefaultCursor xC_left_ptr , normalBorderColor = darkGray , focusedBorderColor = gray , handleEventHook = serverModeEventHookCmd' (hCmds host) <+> keyUpEventHook } writeProps str = do let encodeCChar = map $ fromIntegral . fromEnum atoms = [ "_XMONAD_WORKSPACES" , "_XMONAD_LAYOUT" , "_XMONAD_TITLE" ] (flip mapM_) (zip atoms (lines str)) $ \(atom', content) -> do ustring <- getAtom "UTF8_STRING" atom <- getAtom atom' withDisplay $ \dpy -> io $ do root <- rootWindow dpy $ defaultScreen dpy changeProperty8 dpy root atom ustring propModeReplace $ encodeCChar content sync dpy True wsp = hWsp host -- We can´t define per-host layout modifiers because we lack dependent types layout' = onHost "skadhi" ( onWorkspace (wsp 1) (Full ||| withIM (1%5) (Title "Buddy List") tabbedLayout') $ onWorkspace (wsp 10) Full $ onWorkspace (wsp 2) (Full ||| tabbedLayout') $ onWorkspace (wsp 5) tabbedLayout' $ onWorkspace (wsp 8) (withIM (1%5) (Title "Friends") tabbedLayout') $ defaultLayouts ) $ onHost "vali" ( onWorkspace (wsp 2) (Full ||| tabbedLayout' ||| combineTwo (TwoPane 0.01 0.57) Full tabbedLayout') $ onWorkspace (wsp 3) workLayouts $ defaultLayouts ) $ onHost "hel" ( onWorkspace (wsp 1) (withIM (1 % 8) (Title "Buddy List") $ trackFloating tabbedLayout') $ onWorkspace (wsp 2) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ onWorkspace (wsp 3) workLayouts $ onWorkspace (wsp 6) workLayouts $ onWorkspace (wsp 4) (tabbedLayout' ||| tabbedLayoutHoriz' ||| Dwindle R CW 1 (5 % 100)) $ onWorkspace (wsp 5) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ onWorkspace (wsp 10) (tabbedLayout''' ||| combineTwoP (TwoPane (1 % 100) (3 % 4)) tabbedLayout''' tabbedLayout''' (ClassName "mpv") ||| Dwindle R CW 1 (5 % 100)) $ defaultLayouts ) $ onHost "sif" ( onWorkspace (wsp 1) (withIM (1 % 8) (Title "Buddy List") $ trackFloating tabbedLayout') $ onWorkspace (wsp 2) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ onWorkspace (wsp 3) workLayouts $ onWorkspace (wsp 6) workLayouts $ onWorkspace (wsp 4) (tabbedLayout' ||| tabbedLayoutHoriz' ||| Dwindle R CW 1 (5 % 100)) $ onWorkspace (wsp 5) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ onWorkspace (wsp 8) tabbedLayout''' $ onWorkspace (wsp 10) (tabbedLayout''' ||| combineTwoP (TwoPane (1 % 100) (3 % 4)) tabbedLayout''' tabbedLayout''' (ClassName "mpv") ||| Dwindle R CW 1 (5 % 100)) $ defaultLayouts ) $ defaultLayouts -- tabbedLayout''' = renamed [Replace "Tabbed'"] $ IfMax 1 (noBorders Full) (tabbedLayout tabbedBottomAlways) tabbedLayout''' = tabbedLayout tabbedBottom tabbedLayout' = tabbedLayout tabbedBottomAlways tabbedLayoutHoriz' = tabbedLayoutHoriz tabbedLeftAlways defaultLayouts = {- spiralWithDir East CW (1 % 2) -} Dwindle R CW 1 (5 % 100) ||| tabbedLayout' ||| Full -- workLayouts = {- spiralWithDir East CW (1 % 2) -} Dwindle R CW (2 % 1) (5 % 100) ||| tabbedLayout' ||| Full workLayouts = tabbedLayout' ||| (renamed [Replace "Combined"] $ combineTwoP (TwoPane (1 % 100) (1891 % 2560)) tabbedLayout''' (Column 1.6) (ClassName "Postman" `Or` ClassName "Emacs" `Or` ClassName "jetbrains-idea-ce" `Or` (Resource "Devtools" `And` ClassName "Firefox"))) ||| Full ||| Dwindle R CW 1 (5 % 100) sqrtTwo = approxRational (sqrt 2) (1 / 2560) xmobarPP' = xmobarPP { ppTitle = shorten 80 , ppSort = (liftM2 (.)) getSortByIndex $ return scratchpadFilterOutWorkspace , ppUrgent = wrap "(" ")" . xmobarColor "#800000" "" , ppHiddenNoWindows = xmobarColor "#202020" "" . wrap "(" ")" , ppVisible = wrap "(" ")" . xmobarColor "#808000" "" , ppCurrent = wrap "(" ")" . xmobarColor "#008000" "" , ppHidden = wrap "(" ")" , ppWsSep = " " , ppSep = "\n" } withHostUrgency = case hostname of "sif" -> withUrgencyHookC urgencyHook' $ def { suppressWhen = U.Never, remindWhen = Every 2 } _ -> id urgencyHook' window = do let blinkLight = (lightHigh >> threadDelay 0.5e6) `finally` lightLow where lightHigh = writeFile "/sys/class/leds/input0::capslock/brightness" =<< readFile "/sys/class/leds/input0::capslock/max_brightness" lightLow = writeFile "/sys/class/leds/input0::capslock/brightness" "0" runQuery ((resource =? "comm" <||> resource =? "Pidgin" <||> className =? "Gajim" <||> className =? "Skype" <||> className =? "Thunderbird") --> void (xfork blinkLight)) window urgencyHook (BorderUrgencyHook { urgencyBorderColor = red }) window shutdown :: SomeException -> IO a shutdown e = do let pids = [ -- batteryMon ] mapM_ (signalProcess sigTERM) pids mapM_ (getProcessStatus False False) pids throw e keyUpEventHook :: Event -> X All keyUpEventHook event = handle event >> return (All True) where handle (KeyEvent { ev_event_type = t, ev_state = m, ev_keycode = code }) | t == keyRelease = withDisplay $ \dpy -> do s <- io $ keycodeToKeysym dpy code 0 mClean <- cleanMask m ks <- asks $ hKeyUpKeys host . config userCodeDef () $ whenJust (Map.lookup (mClean, s) ks) id | otherwise = return () handle _ = return () handle shutdown $ launch myConfig =<< getDirectories secs :: Int -> Int secs = (* 1000000) -- monitorBattery :: Maybe BatteryContext -> Maybe Notification -> IO () -- monitorBattery Nothing n = do -- ctx <- batteryContextNew -- case ctx of -- Nothing -> threadDelay (secs 10) >> monitorBattery Nothing n -- Just _ -> monitorBattery ctx n -- monitorBattery ctx@(Just ctx') n = do -- batInfo <- getBatteryInfo ctx' -- case batInfo of -- Nothing -> threadDelay (secs 1) >> monitorBattery ctx n -- Just batInfo -> do -- let n' -- | batteryState batInfo == BatteryStateDischarging -- , timeLeft <= 1200 -- , timeLeft > 0 = Just $ summary "Discharging" <> hint "value" percentage <> urgency u <> body (duz timeLeft ++ "left") -- | otherwise = Nothing -- u -- | timeLeft <= 600 = Critical -- | timeLeft <= 1800 = Normal -- | otherwise = Low -- timeLeft = batteryTimeToEmpty batInfo -- percentage :: Int32 -- percentage = round $ batteryPercentage batInfo -- ts = [("s", 60), ("m", 60), ("h", 24), ("d", 365), ("y", 1)] -- duz ms = ss -- where (ss, _) = foldl (\(ss, x) (s, y) -> ((if rem x y > 0 then show (rem x y) ++ s ++ " " else "") ++ ss , quot x y)) ("", ms) ts -- case n' of -- Just n' -> Notify.display (maybe mempty reuse n <> Notify.appName "monitorBattery" <> n') >>= (\n -> threadDelay (secs 2) >> monitorBattery ctx (Just n)) -- Nothing -> threadDelay (secs 30) >> monitorBattery ctx n disableTouchpad, disableTrackpoint, enableTrackpoint, enableTouchpad :: X () enableTouchpad = safeSpawn "xinput" ["enable", "SynPS/2 Synaptics TouchPad"] disableTouchpad = safeSpawn "xinput" ["disable", "SynPS/2 Synaptics TouchPad"] enableTrackpoint = safeSpawn "xinput" ["enable", "TPPS/2 IBM TrackPoint"] disableTrackpoint = safeSpawn "xinput" ["disable", "TPPS/2 IBM TrackPoint"] isDisabled :: String -> X Bool isDisabled str = do out <- runProcessWithInput "xinput" ["list", str] "" return $ "disabled" `isInfixOf` out spawnKeychain :: X () spawnKeychain = do home <- liftIO getHomeDirectory let keys = (map ((home ) . (".ssh/" ++)) ["id", "id-rsa"]) ++ ["6B13AA67"] liftIO (maybe (return ()) (setEnv "SSH_ASKPASS") =<< findAskpass) safeSpawn "keychain" . (["--agents", "gpg,ssh"] ++)=<< liftIO (filterM doesFileExist keys) where findAskpass = filter `liftM` readFile "/etc/zshrc" filter = listToMaybe . catMaybes . map (stripPrefix "export SSH_ASKPASS=") . lines assimilateKeychain :: X () assimilateKeychain = liftIO $ assimilateKeychain' >> return () assimilateKeychain' = tryIOError $ do -- pid <- getProcessID -- tmpDir <- lookupEnv "TMPDIR" -- let tmpDir' = fromMaybe "/tmp" tmpDir -- tmpFile = tmpDir' "xmonad-keychain" ++ (show pid) ++ ".env" env <- runProcessWithInput "sh" ["-c", "eval $(keychain --eval --noask --agents gpg,ssh); env"] "" -- > " ++ tmpFile] "" -- env <- readFile tmpFile let envVars = Map.fromList $ map (\(k, v) -> (k, tail' v)) $ map (span (/= '=')) $ envLines envVars' = Map.filterWithKey (\k _ -> k `elem` transfer) envVars transfer = ["SSH_AUTH_SOCK", "SSH_AGENT_PID", "GPG_AGENT_INFO"] envLines = filter (elem '=') $ lines env :: [String] sequence $ map (\(k, c) -> setEnv k c) $ Map.toList envVars' -- removeFile tmpFile where tail' [] = [] tail' (x:xs) = xs numKeys = [xK_parenleft, xK_parenright, xK_braceright, xK_plus, xK_braceleft, xK_bracketright, xK_bracketleft, xK_exclam, xK_equal, xK_asterisk] instance Shrinker CustomShrink where shrinkIt _ "" = [""] shrinkIt s cs | length cs >= 4 = cs : shrinkIt s ((reverse . drop 4 . reverse $ cs) ++ "...") | otherwise = cs : shrinkIt s (init cs) xPConfig, xPConfigMonospace :: XPConfig xPConfig = def { font = "xft:Fira Sans:pixelsize=21" , height = 32 , bgColor = "black" , fgColor = gray , fgHLight = green , bgHLight = "black" , borderColor = gray , searchPredicate = (\needle haystack -> all (`isInfixOf` map toLower haystack) . map (map toLower) $ words needle) , position = Top } xPConfigMonospace = xPConfig { font = "xft:Fira Code:pixelsize=21" } sshOverrides host = map (\h -> mkOverride { oHost = h, oCommand = moshCmd . inTmux host} ) [ "odin" , "ymir" , "surtr" , "vidhar" ] ++ map (\h -> mkOverride { oHost = h, oCommand = moshCmd' "/run/current-system/sw/bin/mosh-server" . withEnv [("TERM", "xterm")] . inTmux host} ) [ "bragi", "bragi.asgard.yggdrasil" ] ++ map (\h -> mkOverride { oHost = h, oCommand = sshCmd . inTmux host } ) [ "uni2work-dev1", "srv01.uniworx.de" ] ++ map (\h -> mkOverride { oHost = h, oCommand = sshCmd . withEnv [("TERM", "xterm")] . inTmux host } ) [ "remote.cip.ifi.lmu.de" , "uniworx3", "uniworx4", "uniworx5", "uniworxdb2" , "testworx" ] backlight :: (Rational -> Rational) -> X () backlight f = void . xfork . liftIO $ do [ _device , _class , read . Text.unpack -> currentBright , _currentPercentage , read . Text.unpack -> maximumBright ] <- Text.splitOn "," . Text.pack <$> readProcess "brightnessctl" ["-m"] "" let current = currentBright % maximumBright new' = f current * fromIntegral maximumBright new :: Integer new | floor new' < 0 = 0 | ceiling new' > maximumBright = maximumBright | new' >= maximumBright % 2 = ceiling new' | otherwise = floor new' callProcess "brightnessctl" ["-m", "s", show new] cycleThrough :: [Rational] -> (Rational -> Rational) cycleThrough opts current = fromMaybe currentOpt $ listToMaybe next' where currentOpt = minimumBy (comparing $ abs . subtract current) opts (_, _ : next') = break (== currentOpt) opts cycleKbLayout :: [(String, Maybe String)] -> X () cycleKbLayout [] = return () cycleKbLayout layouts = liftIO $ do next <- (getNext . extract) `liftM` runProcessWithInput "setxkbmap" ["-query"] "" let args = case next of (l, Just v) -> [l, v] (l, Nothing) -> [l] safeSpawn "setxkbmap" args where extract :: String -> Maybe (String, Maybe String) extract str = listToMaybe $ do ["layout:", l] <- str' [(l, Just v) | ["variant:", v] <- str'] ++ pure (l, Nothing) where str' = map words $ lines str getNext :: Maybe (String, Maybe String) -> (String, Maybe String) getNext = maybe (head layouts) getNext' getNext' x = case elemIndex x layouts of Nothing -> getNext Nothing Just i -> layouts !! ((i + 1) `mod` length layouts) mpvAll' :: MpvCommand -> IO [MpvResponse] mpvAll' = mpvAll "/var/media/.mpv-ipc" mpvOne' :: MpvCommand -> IO (Maybe MpvResponse) mpvOne' = mpvOne "/var/media/.mpv-ipc" mediaMpv :: MpvCommand -> X () mediaMpv cmd = void . xfork $ print =<< mpvAll' cmd mediaMpvTogglePause :: X () mediaMpvTogglePause = void . xfork $ do paused <- mapM mpvResponse <=< mpvAll' $ MpvGetProperty "pause" if | and paused -> print <=< mpvAll' $ MpvSetProperty "pause" False | otherwise -> print <=< mpvOne' $ MpvSetProperty "pause" True myKeys' conf host = Map.fromList $ -- launch a terminal [ ((modm, xK_Return), spawn $ (XMonad.terminal conf) ++ " -e tmux") , ((modm .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) -- launch dmenu --, ((modm, xK_d ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") , ((modm, xK_d ), shellPrompt "Run: " xPConfigMonospace) , ((modm .|. shiftMask, xK_d ), prompt "Run in Terminal: " ("alacritty" ++ " -e") xPConfigMonospace) , ((modm, xK_at ), sshPrompt (sshOverrides . Just $ hName host) xPConfigMonospace) -- close focused window , ((modm .|. shiftMask, xK_q ), kill) , ((modm .|. controlMask .|. shiftMask, xK_q ), spawn "xkill") -- Rotate through the available layout algorithms , ((modm, xK_space ), sendMessage NextLayout) -- Reset the layouts on the current workspace to default , ((modm .|. controlMask, xK_r ), (setLayout $ XMonad.layoutHook conf) >> refresh) -- Resize viewed windows to the correct size , ((modm, xK_r ), refresh) -- Move focus to the next window , ((modm, xK_t ), windows W.focusDown) -- Move focus to the previous window , ((modm, xK_n ), windows W.focusUp ) -- Move focus to the master window , ((modm, xK_m ), windows W.focusMaster ) -- Swap the focused window and the master window , ((modm .|. shiftMask, xK_m ), windows W.swapMaster) -- Swap the focused window with the next window , ((modm .|. shiftMask, xK_t ), windows W.swapDown ) -- Swap the focused window with the previous window , ((modm .|. shiftMask, xK_n ), windows W.swapUp ) -- Swap the focused window with the previous window , ((modm .|. shiftMask .|. controlMask, xK_m), sendMessage SwapWindow) , ((modm, xK_Right), sendMessage $ Go R) , ((modm, xK_Left ), sendMessage $ Go L) , ((modm, xK_Up ), sendMessage $ Go U) , ((modm, xK_Down ), sendMessage $ Go D) , ((modm .|. shiftMask , xK_Right), sendMessage $ Move R) , ((modm .|. shiftMask , xK_Left ), sendMessage $ Move L) , ((modm .|. shiftMask , xK_Up ), sendMessage $ Move U) , ((modm .|. shiftMask , xK_Down ), sendMessage $ Move D) -- , ((modm .|. controlMask, xK_Right), withFocused $ keysMoveWindow (10, 0)) -- , ((modm .|. controlMask, xK_Left ), withFocused $ keysMoveWindow (-10, 0)) -- , ((modm .|. controlMask, xK_Up ), withFocused $ keysMoveWindow (0, -10)) -- , ((modm .|. controlMask, xK_Down ), withFocused $ keysMoveWindow (0, 10)) -- Shrink the master area , ((modm, xK_h ), sendMessage Shrink) -- Expand the master area , ((modm, xK_s ), sendMessage Expand) -- Push window back into tiling , ((modm .|. shiftMask, xK_space ), withFocused $ windows . W.sink) , ((modm, xK_BackSpace), focusUrgent) , ((modm .|. shiftMask, xK_BackSpace), clearUrgents) -- 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))) , ((0, xF86XK_AudioRaiseVolume), safeSpawn "pamixer" ["-i", "2"]) , ((0, xF86XK_AudioLowerVolume), safeSpawn "pamixer" ["-d", "2"]) , ((0, xF86XK_AudioMute), safeSpawn "pamixer" ["-t"]) , ((0, xF86XK_AudioPause), mediaMpv $ MpvSetProperty "pause" False) , ((0, {-xF86XK_AudioMicMute-} 269025202), safeSpawn "pulseaudio-ctl" ["mute-input"]) , ((0, xF86XK_AudioPlay), mediaMpvTogglePause) , ((0, xK_Print), do home <- liftIO getHomeDirectory unGrab safeSpawn "scrot" ["-s", "-F", home "screenshots" "%Y-%m-%dT%H:%M:%S.png", "-e", "xclip -selection clipboard -t image/png -i $f"] ) , ((modm .|. mod1Mask, xK_space), mediaMpvTogglePause) -- , ((0, xF86XK_MonBrightnessDown), backlight . cycleThrough $ reverse brCycle) -- , ((0, xF86XK_MonBrightnessUp ), backlight $ cycleThrough brCycle) , ((modm .|. shiftMask , xK_b), backlight . cycleThrough $ reverse brCycle) , ((modm .|. shiftMask .|. controlMask, xK_b), backlight $ cycleThrough brCycle) , ((modm , xK_Escape), cycleKbLayout (hKbLayouts host)) , ((modm .|. controlMask, xK_Escape), safeSpawn "setxkbmap" $ fst (head $ hKbLayouts host) : maybeToList (snd . head $ hKbLayouts host)) -- Toggle the status bar gap -- Use this binding with avoidStruts from Hooks.ManageDocks. -- See also the statusBar function from Hooks.DynamicLog. -- , ((modm , xK_b ), sendMessage ToggleStruts) , ((modm .|. shiftMask, xK_p ), safeSpawn "playerctl" ["-a", "pause"]) -- Quit xmonad , ((modm .|. shiftMask, xK_e ), io (exitWith ExitSuccess)) -- Restart xmonad -- , ((modm .|. shiftMask .|. controlMask, xK_r ), void . xfork $ recompile False >>= flip when (safeSpawn "xmonad" ["--restart"])) , ((modm .|. shiftMask, xK_r ), void . liftIO $ executeFile "xmonad" True [] Nothing) , ((modm .|. shiftMask, xK_l ), void . xfork $ do sessId <- getEnv "XDG_SESSION_ID" safeSpawn "loginctl" ["lock-session", sessId] ) , ((modm .|. shiftMask, xK_s ), safeSpawn "systemctl" ["suspend"]) , ((modm .|. shiftMask, xK_h ), inputPromptWithCompl xPConfigMonospace "systemctl" powerActCompl ?+ powerAct) , ((modm, xK_v ), windows copyToAll) -- @@ Make focused window always visible , ((modm .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back , ((modm .|. shiftMask, xK_g ), windowPrompt xPConfig Goto wsWindows) , ((modm , xK_g ), windowPrompt xPConfig Bring allWindows) ] ++ -- -- 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) $ numKeys , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)] ] ++ [((m .|. modm .|. controlMask, k), void . runMaybeT $ MaybeT (P.getScreen def i) >>= MaybeT . screenWorkspace >>= lift . windows . f ) | (i, k) <- zip (hScreens host) [xK_g, xK_c, xK_r, xK_l] , (f, m) <- [(W.view, 0), (W.shift, shiftMask)] ] where modm = XMonad.modMask conf brCycle = [0, 1 % 100, 1 % 10, 1 % 4, 1 % 2, 3 % 4, 1] powerActWords = ["poweroff", "reboot", "hibernate", "suspend"] powerActCompl = mkComplFunFromList' xPConfigMonospace powerActWords powerAct act | act `elem` powerActWords = safeSpawn "systemctl" $ pure act | otherwise = return ()