Merge branch 'master' of git.yggdrasil.li:dotfiles

1 files changed, 74 insertions, 33 deletions

diff --git a/.xmonad/xmonad.hs b/.xmonad/xmonad.hs
index 4e04fee..353041d 100644
--- a/.xmonad/xmonad.hs
+++ b/.xmonad/xmonad.hs
@@ -14,7 +14,7 @@ import Control.Monad.State (get)
 import XMonad.Layout.Spiral
 import Data.Ratio
 import Data.List
-import Data.Maybe (fromMaybe, listToMaybe)
+import Data.Maybe (fromMaybe, listToMaybe, catMaybes)
 import XMonad.Layout.Tabbed
 import XMonad.Prompt
 import XMonad.Util.Scratchpad
@@ -25,6 +25,7 @@ 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
@@ -39,6 +40,9 @@ import Control.Monad (when)
 import Graphics.X11.ExtraTypes.XF86
 import XMonad.Util.Cursor
 import XMonad.Actions.Warp
+import XMonad.Util.SpawnOnce
+import System.Directory
+import System.FilePath
 
 import XMonad.Layout.IM
 
@@ -47,44 +51,78 @@ import XMonad.Prompt.MySsh
 
 import Network.HostName
 
+import Control.Applicative ((<$>))
+
 type KeyMap = Map (ButtonMask, KeySym) (X ())
 
-data Host l1 l2 = Host
+data Host = Host
             { hName :: HostName
             , hManageHook :: ManageHook
             , hWsp :: Integer -> WorkspaceId
-            , hLayoutMod :: l1 -> l2
+            , hCoWsp :: String -> Maybe WorkspaceId
             , hKeysMod :: XConfig Layout -> (KeyMap -> KeyMap)
+            , hScreens :: [ScreenId]
             }
 
 defaultHost = Host { hName = "unkown"
                    , hManageHook = composeOne [manageScratchTerm]
                    , hWsp = show
-                   , hLayoutMod = id
+                   , hCoWsp = const Nothing
                    , hKeysMod = const id
+                   , hScreens = [0,1..]
                    }
 
---hostFromName :: (LayoutClass l1 a, LayoutClass l2 a) => HostName -> Host (l1 a) (l2 a)
+hostFromName :: HostName -> Host
 hostFromName h@("vali") = defaultHost { hName = h
-                                      , hManageHook = hManageHook defaultHost
-                                      , hWsp = \i -> case Map.lookup i workspaceNames of
-                                        Just str -> show i ++ " " ++ str
-                                        Nothing -> show i
-                                      , hLayoutMod = id
-                                      , hKeysMod = \conf -> Map.union $ Map.fromList $ join $ map (spawnBindings conf) [ (xK_d, ["dwb", "dwb $(xclip -o)"])
-                                                                                                                       ]
+                                      , 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, ["chromium", "chromium $(xclip -o)"])
+                                                                                                                      , (xK_e, ["emacsclient -c"])
+                                                                                                                      ]
+                                      , hScreens = [1, 0] ++ [2,3..]
                                       }
   where
-    workspaceNames = Map.fromList [ (1, "web")
+    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)
+manageScratchTerm = (resource =? "scratchpad" <||> resource =? "keysetup") -?> 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"
@@ -95,26 +133,26 @@ main = do
         , layoutHook = smartBorders $ avoidStruts layout'
         , logHook = dynamicLogWithPP xmobarPP'
         , modMask = mod4Mask
-        , keys = \conf -> hKeysMod host conf $ myKeys' conf
-        , workspaces = take (length numKeys) $ map (hWsp host) [1..]
+        , 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"
         }
-      layout' = hLayoutMod host $ defaultLayouts
+      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
-      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
-                                 }
       xmobarPP' = xmobarPP { ppOutput = hPutStrLn xmobarProc
                            , ppTitle = shorten 50
                            , ppSort = (liftM2 (.)) getSortByIndex $ return scratchpadFilterOutWorkspace
@@ -129,10 +167,13 @@ main = do
   xmonad $ myConfig
   
 autostart = [ spawnKeychain
-            , safeSpawn "urxvtd" ["-q", "-f", "-o"]
+            , spawnOnce "urxvtd -o"
             ]
 
-spawnKeychain = runInTerm "" "keychain ~/.ssh/id_ecdsa ~/.ssh/id_rsa"
+spawnKeychain = do
+  home <- liftIO getHomeDirectory
+  let keys = map ((home </>) . ("/.ssh/id_" ++)) ["ed25519", "ecdsa", "rsa"]
+  safeSpawn "urxvt" $ ["-title", "keysetup", "-e", "keychain"] ++ keys
 
 assimilateKeychain :: X ()
 assimilateKeychain = liftIO $ assimilateKeychain' >> return ()
@@ -183,7 +224,7 @@ sshOverrides = map (\h -> mkOverride { oHost = h, oCommand = moshCmd . inTmux }
                [ "galois", "galois.praseodym.org"
                ]
 
-myKeys' conf = Map.fromList $
+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")
@@ -269,7 +310,7 @@ myKeys' conf = Map.fromList $
     ]
     ++
     [((m .|. modm .|. controlMask, k), screenWorkspace i >>= (flip whenJust) (windows . f))
-    | (i, k) <- zip [0..] [xK_g, xK_c, xK_r, xK_l]
+    | (i, k) <- zip (hScreens host) [xK_g, xK_c, xK_r, xK_l]
     , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]
     ]
   where