From 37e55957fbf411b928184465acb2b1ecd5ca6852 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 17 Jan 2025 22:20:56 +0100 Subject: mako --- accounts/gkleen@sif/xmonad/xmonad.hs | 939 ----------------------------------- 1 file changed, 939 deletions(-) delete mode 100644 accounts/gkleen@sif/xmonad/xmonad.hs (limited to 'accounts/gkleen@sif/xmonad/xmonad.hs') diff --git a/accounts/gkleen@sif/xmonad/xmonad.hs b/accounts/gkleen@sif/xmonad/xmonad.hs deleted file mode 100644 index a44d3bb7..00000000 --- a/accounts/gkleen@sif/xmonad/xmonad.hs +++ /dev/null @@ -1,939 +0,0 @@ -{-# 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" - , "srv02.uniworx.de" - ] - ++ - 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 % 500, 1 % 250, 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 () -- cgit v1.2.3