import XMonad import XMonad.Hooks.DynamicLog import XMonad.Hooks.ManageDocks import XMonad.Util.Run import XMonad.Util.Loggers import XMonad.Util.EZConfig(additionalKeys) import System.IO 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.Maybe (fromMaybe, listToMaybe, catMaybes) import XMonad.Layout.Tabbed import XMonad.Prompt import XMonad.Util.Scratchpad import Control.Monad (sequence, liftM, liftM2, join) 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 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.StackSet (RationalRect (..)) import Control.Monad (when) import Graphics.X11.ExtraTypes.XF86 import XMonad.Util.Cursor import XMonad.Actions.Warp import XMonad.Layout.IM import XMonad.Prompt.MyShell import XMonad.Prompt.MySsh import Network.HostName import Control.Applicative ((<$>)) 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 :: [ScreenId] } defaultHost = Host { hName = "unkown" , hManageHook = composeOne [manageScratchTerm] , hWsp = show , hCoWsp = const Nothing , hKeysMod = const id , hScreens = [0,1..] } 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" ] , hWsp = hWsp , hCoWsp = hCoWsp , hKeysMod = \conf -> Map.union $ Map.fromList $ join $ map (spawnBindings conf) [ (xK_d, ["dwb", "dwb $(xclip -o)"]) , (xK_e, ["emacsclient -c"]) ] , hScreens = [1, 0] ++ [2,3..] } where workspaceNames = Map.fromList [ (2, "web") , (3, "work") ] hWsp = wspFromMap workspaceNames hCoWsp = coWspFromMap workspaceNames assign wsp test = (\wsp -> test -?> doShift wsp) <$> hCoWsp wsp hostFromName _ = defaultHost 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 conf (k, cmds) = zipWith (\m cmd -> ((modm .|. mod1Mask .|. m, k), spawn cmd)) spawnModifiers cmds where modm = XMonad.modMask conf manageScratchTerm = resource =? "scratchpad" -?> doRectFloat $ RationalRect (1 % 16) (1 % 16) (7 % 8) (7 % 8) tabbedLayout t = renamed [Replace "Tabbed"] $ reflectHoriz $ t CustomShrink $ tabbedTheme tabbedTheme = defaultTheme { activeColor = "black" , inactiveColor = "black" , urgentColor = "black" , activeBorderColor = "white" , inactiveBorderColor = "#202020" , urgentBorderColor = "#bb0000" , activeTextColor = "white" , inactiveTextColor = "white" , urgentTextColor = "white" , decoHeight = 16 } main = do xmobarProc <- spawnPipe "xmobar" host <- getHostName >>= return . hostFromName let myConfig = defaultConfig { manageHook = manageDocks <+> hManageHook host , terminal = "urxvtc" , layoutHook = smartBorders $ avoidStruts layout' , logHook = dynamicLogWithPP xmobarPP' , modMask = mod4Mask , keys = \conf -> hKeysMod host conf $ myKeys' conf host , workspaces = take (length numKeys) $ map wsp [1..] , startupHook = assimilateKeychain >> (sequence autostart) >> (setDefaultCursor xC_left_ptr) >> banishScreen LowerRight >> return () , normalBorderColor = "#202020" , focusedBorderColor = "white" } wsp = hWsp host -- We canĀ“t define per-host layout modifiers because we lack dependent types layout' = onHost "skadhi" ( onWorkspace (wsp 1) (noBorders Full ||| withIM (1%5) (Title "Buddy List") (tabbedLayout tabbedBottomAlways)) $ onWorkspace (wsp 10) (noBorders Full) $ onWorkspace (wsp 2) (noBorders Full ||| tabbedLayout tabbedBottomAlways) $ onWorkspace (wsp 5) (tabbedLayout tabbedBottomAlways) $ onWorkspace (wsp 8) (withIM (1%5) (Title "Friends") (tabbedLayout tabbedBottomAlways)) $ defaultLayouts ) $ onHost "vali" ( onWorkspace (wsp 2) (noBorders Full ||| tabbedLayout tabbedBottomAlways) $ defaultLayouts ) $ defaultLayouts defaultLayouts = spiralWithDir East CW (1 % 2) ||| tabbedLayout tabbedBottom ||| noBorders Full ||| simplestFloat xmobarPP' = xmobarPP { ppOutput = hPutStrLn xmobarProc , ppTitle = shorten 50 , ppSort = (liftM2 (.)) getSortByIndex $ return scratchpadFilterOutWorkspace , ppUrgent = wrap "(" ")" . xmobarColor "red" "" , ppHiddenNoWindows = xmobarColor "#202020" "" . wrap "(" ")" , ppVisible = wrap "(" ")" . xmobarColor "yellow" "" , ppCurrent = wrap "(" ")" . xmobarColor "green" "" , ppHidden = wrap "(" ")" , ppWsSep = " " , ppSep = " | " } xmonad $ myConfig autostart = [ spawnKeychain ] spawnKeychain = safeSpawn "urxvt" $ ["-e", "keychain"] ++ keys where keys = map ("~/.ssh/id_" ++) ["ed25519", "ecdsa", "rsa"] 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); 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 = cs : shrinkIt s ((reverse . drop 4 . reverse $ cs) ++ "...") xPConfig = defaultXPConfig { bgColor = "black" , fgColor = "white" , fgHLight = "green" , bgHLight = "black" , borderColor = "white" } sshOverrides = map (\h -> mkOverride { oHost = h, oCommand = moshCmd . inTmux } ) [ "odin", "odin.asgard.yggdrasil" , "surtr", "yggdrasil.li", "surtr.yggdrasil.li", "praseodym.org", "surtr.praseodym.org", "surtr.141.li", "141.li" , "vindler", "vindler.alfheim.yggdrasil" , "ullr" ] ++ map (\h -> mkOverride { oHost = h, oCommand = moshCmd' "/run/current-system/sw/bin/mosh-server" . withEnv [("TERM", "xterm")] . inTmux} ) [ "bragi", "bragi.asgard.yggdrasil" ] ++ map (\h -> mkOverride { oHost = h, oCommand = sshCmd . withEnv [("TERM", "xterm")] . inTmux } ) [ "galois", "galois.praseodym.org" ] myKeys' conf host = Map.fromList $ -- launch a terminal [ ((modm, xK_Return), spawn $ (XMonad.terminal conf) ++ " -e tmux") , ((modm .|. controlMask, xK_Return), scratchpadSpawnActionCustom $ (XMonad.terminal conf) ++ " -name scratchpad -title scratchpad -e tmux") -- launch dmenu --, ((modm, xK_d ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") , ((modm, xK_d ), shellPrompt "Run: " xPConfig) , ((modm .|. shiftMask, xK_d ), prompt "Run in Terminal: " ("urxvtc" ++ " -e") xPConfig) , ((modm, xK_at ), sshPrompt sshOverrides xPConfig) -- close focused window , ((modm .|. shiftMask, xK_q ), kill) -- Rotate through the available layout algorithms , ((modm, xK_space ), sendMessage NextLayout) -- Reset the layouts on the current workspace to default , ((modm , 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 ) -- 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) -- 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 "amixer" ["sset", "Master", "Playback", "5+"]) , ((0, xF86XK_AudioLowerVolume), safeSpawn "amixer" ["sset", "Master", "Playback", "5-"]) -- 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) -- Quit xmonad , ((modm .|. shiftMask, xK_e ), io (exitWith ExitSuccess)) -- Restart xmonad , ((modm .|. shiftMask, xK_r ), whenX (recompile True) $ safeSpawn "xmonad" ["--restart"]) , ((modm .|. shiftMask, xK_l ), safeSpawn "slock" []) ] ++ -- -- 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.view, 0), (W.shift, shiftMask)] ] ++ [((m .|. modm .|. controlMask, k), screenWorkspace i >>= (flip whenJust) (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