diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Internal/Keys.hs | 103 | ||||
| -rw-r--r-- | src/Internal/Layout.hs | 73 | ||||
| -rw-r--r-- | src/Internal/Marking.hs | 77 | ||||
| -rw-r--r-- | src/Main.hs | 32 |
4 files changed, 285 insertions, 0 deletions
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs new file mode 100644 index 0000000..b00458e --- /dev/null +++ b/src/Internal/Keys.hs @@ -0,0 +1,103 @@ +module Internal.Keys where + +import qualified Data.Map as Map +import Data.Map (Map) +import Internal.Marking +import XMonad.Actions.Submap +import XMonad.Util.CustomKeys +import XMonad +import Control.Monad +import XMonad.Actions.WindowNavigation +import qualified XMonad.StackSet as W + +type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) + +applyKeys :: XConfig l -> IO (XConfig l) +applyKeys config@(XConfig {modMask = modm}) = do + ks <- newKeys + withWindowNavigation (xK_k, xK_h, xK_j, xK_l) $ + config { keys = ks } + +newKeys :: IO (KeyMap l) +newKeys = + withNewMarkContext $ \markContext -> + return $ \config@(XConfig {modMask = modm}) -> + let workspacesByInt = + Map.fromList $ + zip ['1'..] (XMonad.workspaces config) + + gotoWorkspace :: Char -> X () + gotoWorkspace ch = + mapM_ (windows . W.greedyView) (Map.lookup ch workspacesByInt) + + in + + Map.fromList + [ ((modm, xK_F12), (void $ spawn "spotify-control next")) + , ((modm, xK_F11), (void $ spawn "spotify-control prev")) + , ((modm, xK_F10), (void $ spawn "spotify-control play")) + , ((modm .|. mod1Mask, xK_l), (void $ spawn "xscreensaver-command -lock")) + , ((modm, xK_t), (void $ spawn (terminal config))) + , ((modm, xK_m), (submap $ mapAlpha modm (markCurrentWindow markContext))) + , ((modm, xK_apostrophe), (submap $ + Map.insert + (modm, xK_apostrophe) + (jumpToLast markContext) + (mapAlpha modm (jumpToMark markContext)))) + , ((modm, xK_g), (submap $ mapNumbers 0 gotoWorkspace)) + + , ((modm .|. shiftMask, xK_bracketleft), sendMessage (IncMasterN (-1))) + , ((modm .|. shiftMask, xK_bracketright), sendMessage (IncMasterN 1)) + , ((modm, xK_bracketleft), sendMessage Shrink) + , ((modm, xK_bracketright), sendMessage Expand) + + , ((modm, xK_space), sendMessage NextLayout) + + , ((modm, xK_q), spawn "xmonad --recompile && xmonad --restart") + ] + +mapNumbers :: KeyMask -> (Char -> X ()) -> Map (KeyMask, KeySym) (X ()) +mapNumbers km fn = + Map.fromList [ + ((km, xK_0), fn '0') + , ((km, xK_1), fn '1') + , ((km, xK_2), fn '2') + , ((km, xK_3), fn '3') + , ((km, xK_4), fn '4') + , ((km, xK_5), fn '5') + , ((km, xK_6), fn '6') + , ((km, xK_7), fn '7') + , ((km, xK_8), fn '8') + , ((km, xK_9), fn '9') + ] + +mapAlpha :: KeyMask -> (Char -> X ()) -> Map (KeyMask, KeySym) (X ()) +mapAlpha km fn = + Map.fromList [ + ((km, xK_a), fn 'a') + , ((km, xK_b), fn 'b') + , ((km, xK_c), fn 'c') + , ((km, xK_d), fn 'd') + , ((km, xK_e), fn 'e') + , ((km, xK_f), fn 'f') + , ((km, xK_g), fn 'g') + , ((km, xK_h), fn 'h') + , ((km, xK_i), fn 'i') + , ((km, xK_j), fn 'j') + , ((km, xK_k), fn 'k') + , ((km, xK_l), fn 'l') + , ((km, xK_m), fn 'm') + , ((km, xK_n), fn 'n') + , ((km, xK_o), fn 'o') + , ((km, xK_p), fn 'p') + , ((km, xK_q), fn 'q') + , ((km, xK_r), fn 'r') + , ((km, xK_s), fn 's') + , ((km, xK_t), fn 't') + , ((km, xK_u), fn 'u') + , ((km, xK_v), fn 'v') + , ((km, xK_w), fn 'w') + , ((km, xK_x), fn 'x') + , ((km, xK_y), fn 'y') + , ((km, xK_z), fn 'z') + ] diff --git a/src/Internal/Layout.hs b/src/Internal/Layout.hs new file mode 100644 index 0000000..2b35dbc --- /dev/null +++ b/src/Internal/Layout.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} +module Internal.Layout where + +import XMonad.Layout.Spiral +import XMonad.Layout.ThreeColumns +import XMonad.Layout.Grid +import XMonad.Layout +import XMonad + +import qualified XMonad.StackSet as W + +myLayout = + spiral (6/7) ||| + Center 0.7 ||| + Tall 1 (3/100) (1/2) ||| + ThreeCol 1 (3/100) (1/2) ||| + Grid + + +data Center a = + Center { + proportion :: Float -- between 0 and 1 + } + deriving (Show, Read) + +instance LayoutClass Center a where + doLayout l (Rectangle x y w h) stack = + + let wf = fromIntegral w + hf = fromIntegral h + x' = (wf - wf * proportion l) / 2 + y' = (hf - hf * proportion l) / 2 + w' = wf * proportion l + h' = hf * proportion l + middleRect = Rectangle (floor x') (floor y') (floor w') (floor h') + topRect = Rectangle 0 0 (floor wf) (floor y') + rightRect = Rectangle (floor (x' + w')) (floor y') (floor x') (floor h') + bottomRect = Rectangle 0 (floor $ y' + h') (floor wf) (floor y') + leftRect = Rectangle 0 (floor y') (floor x') (floor h') + + nWin = length (W.integrate stack) + winsTop = nWin `div` 8 + + portion = fromIntegral $ nWin `div` 6 + winRem = fromIntegral $ nWin `mod` 6 + in + return $ + (zip (W.integrate stack) ( + (:) middleRect $ + (divRect topRect (portion * 2)) + ++ (divRect rightRect portion) + ++ (divRect bottomRect (portion * 2)) + ++ (divRect leftRect (portion + winRem))), Just l) + where + divRect (Rectangle x y w h) n = + if h > w + then + let h' = h `div` n + in flip map [0..(n - 1)] $ \mul -> + Rectangle x (y + fromIntegral (h' * mul)) w h' + else + let w' = w `div` n + in flip map [0..(n - 1)] $ \mul -> + Rectangle (x + fromIntegral (w' * mul)) y w' h + + handleMessage (Center prop) m = + return $ fmap resize (fromMessage m) + where + resize Shrink = (Center (prop - 0.05)) + resize Expand = (Center (prop + 0.05)) + + + emptyLayout c root = return ([], Just c) diff --git a/src/Internal/Marking.hs b/src/Internal/Marking.hs new file mode 100644 index 0000000..352131b --- /dev/null +++ b/src/Internal/Marking.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Internal.Marking where + +import XMonad +import Data.IORef +import Data.Map (Map) + +import System.FilePath +import System.IO +import Control.Exception + +import qualified Data.Map as Map + +{- Submodule that handles marking windows so they can be jumped back to. -} + +type Mark = Char + +data MarkState = + MarkState { + markStateMap :: Map Mark Window + , markLast :: Maybe Window + } deriving (Read, Show) + +data MarkContext = MarkContext (IORef MarkState) + +readMarkState :: IO MarkState +readMarkState = do + dir <- getXMonadDir + let markstate = dir </> "markstate" + catch + (read <$> (hGetContents =<< openFile markstate ReadMode)) + (\(e :: IOError) -> return (MarkState mempty Nothing)) + +saveMarkState :: MarkState -> X () +saveMarkState ms = do + dir <- getXMonadDir + let markstate = dir </> "markstate" + liftIO $ writeFile markstate (show ms) + + +withNewMarkContext :: (MarkContext -> IO a) -> IO a +withNewMarkContext fn = do + ioref <- newIORef =<< readMarkState + fn (MarkContext ioref) + +markCurrentWindow :: MarkContext -> Mark -> X () +markCurrentWindow (MarkContext ioref) mark = do + withFocused $ \win -> + liftIO $ + modifyIORef ioref $ \state@(MarkState {markStateMap = ms}) -> + state { + markStateMap = Map.insert mark win ms + } + + saveMarkState =<< liftIO (readIORef ioref) + +jumpToLast :: MarkContext -> X () +jumpToLast (MarkContext ioref) = do + withFocused $ \win -> do + m <- markLast <$> (liftIO $ readIORef ioref) + liftIO $ modifyIORef ioref (\state -> state { markLast = Just win }) + mapM_ focus m + + saveMarkState =<< liftIO (readIORef ioref) + +jumpToMark :: MarkContext -> Mark -> X () +jumpToMark (MarkContext ioref) mark = do + withFocused $ \win -> do + MarkState {markStateMap = m} <- liftIO $ readIORef ioref + case Map.lookup mark m of + Nothing -> return () + Just w -> do + liftIO $ modifyIORef ioref $ \state -> + state { markLast = Just win } + focus w + + saveMarkState =<< liftIO (readIORef ioref) diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..c067b62 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,32 @@ +import XMonad +import XMonad.Hooks.DynamicLog +import XMonad.Layout.Spacing +import XMonad.Actions.WindowNavigation +import XMonad.Util.CustomKeys +import System.Directory +import System.FilePath +import System.Process +import Internal.Layout + +import Internal.Keys + +main = do + -- Execute some commands. + homeDir <- getHomeDirectory + let fp = homeDir </> ".xmonad" </> "startup" + + config <- + applyKeys $ def + { terminal = "st" + , modMask = mod4Mask + , borderWidth = 0 + , keys = \config -> mempty + , focusedBorderColor = "#FFFFFF" + , normalBorderColor = "#000000" + , layoutHook = spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $ + myLayout + , startupHook = do + spawn fp + } + + xmonad =<< xmobar config { modMask = mod4Mask } |