diff options
Diffstat (limited to '')
| -rw-r--r-- | src/XMonad/Actions/FloatSnapSpaced.hs | 221 | ||||
| -rw-r--r-- | src/XMonad/Actions/PerConditionKeys.hs | 24 | ||||
| -rw-r--r-- | src/XMonad/Custom/Bindings.hs | 272 | ||||
| -rw-r--r-- | src/XMonad/Custom/Event.hs | 12 | ||||
| -rw-r--r-- | src/XMonad/Custom/Layout.hs | 36 | ||||
| -rw-r--r-- | src/XMonad/Custom/Log.hs | 93 | ||||
| -rw-r--r-- | src/XMonad/Custom/Manage.hs | 61 | ||||
| -rw-r--r-- | src/XMonad/Custom/Misc.hs | 36 | ||||
| -rw-r--r-- | src/XMonad/Custom/Navigation.hs | 14 | ||||
| -rw-r--r-- | src/XMonad/Custom/Projects.hs | 34 | ||||
| -rw-r--r-- | src/XMonad/Custom/Prompt.hs | 8 | ||||
| -rw-r--r-- | src/XMonad/Custom/Scratchpads.hs | 52 | ||||
| -rw-r--r-- | src/XMonad/Custom/Startup.hs | 35 | ||||
| -rw-r--r-- | src/XMonad/Custom/Theme.hs | 142 | ||||
| -rw-r--r-- | src/XMonad/Custom/Workspaces.hs | 36 |
15 files changed, 560 insertions, 516 deletions
diff --git a/src/XMonad/Actions/FloatSnapSpaced.hs b/src/XMonad/Actions/FloatSnapSpaced.hs index f43558a..ad14016 100644 --- a/src/XMonad/Actions/FloatSnapSpaced.hs +++ b/src/XMonad/Actions/FloatSnapSpaced.hs @@ -8,110 +8,147 @@ -- module XMonad.Actions.FloatSnapSpaced - ( snapSpacedMagicMove - ) where + ( snapSpacedMagicMove + ) where import Data.List import Data.Maybe -import Data.Set (fromList) +import Data.Set ( fromList ) import XMonad import XMonad.Hooks.ManageDocks -import qualified XMonad.StackSet as S +import qualified XMonad.StackSet as S snapSpacedMagicMove :: Int -> Maybe Int -> Maybe Int -> Window -> X () -snapSpacedMagicMove spacing collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do +snapSpacedMagicMove spacing collidedist snapdist w = + whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w - nx <- handleAxis True d wa + nx <- handleAxis True d wa ny <- handleAxis False d wa io $ moveWindow d w (fromIntegral nx) (fromIntegral ny) float w - where - handleAxis horiz d wa = do - ((mbl, mbr, bs), (mfl, mfr, fs)) <- getSnap horiz collidedist d w - return $ if bs || fs - then wpos wa - else let b = case (mbl, mbr) of - (Just bl, Just br) -> if wpos wa - bl < br - wpos wa - then bl + spacing - else br + spacing - (Just bl, Nothing) -> bl + spacing - (Nothing, Just br) -> br + spacing - (Nothing, Nothing) -> wpos wa + spacing - - f = case (mfl, mfr) of - (Just fl, Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa - then fl - spacing - else fr - spacing - (Just fl, Nothing) -> fl - spacing - (Nothing, Just fr) -> fr - spacing - (Nothing, Nothing) -> wpos wa - spacing - - newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) - then b - else f - wdim wa - - in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist - then newpos - else wpos wa - where - (wpos, wdim, _, _) = constructors horiz - -getSnap :: Bool -> Maybe Int -> Display -> Window -> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool)) + where + handleAxis horiz d wa = do + ((mbl, mbr, bs), (mfl, mfr, fs)) <- getSnap horiz collidedist d w + return $ if bs || fs + then wpos wa + else + let + b = case (mbl, mbr) of + (Just bl, Just br) -> + if wpos wa - bl < br - wpos wa then bl + spacing else br + spacing + (Just bl, Nothing) -> bl + spacing + (Nothing, Just br) -> br + spacing + (Nothing, Nothing) -> wpos wa + spacing + + f = case (mfl, mfr) of + (Just fl, Just fr) -> + if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa + then fl - spacing + else fr - spacing + (Just fl, Nothing) -> fl - spacing + (Nothing, Just fr) -> fr - spacing + (Nothing, Nothing) -> wpos wa - spacing + + newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) + then b + else f - wdim wa + in + if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist + then newpos + else wpos wa + where (wpos, wdim, _, _) = constructors horiz + +getSnap + :: Bool + -> Maybe Int + -> Display + -> Window + -> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool)) getSnap horiz collidedist d w = do - wa <- io $ getWindowAttributes d w - screen <- S.current <$> gets windowset - let sr = screenRect $ S.screenDetail screen - wl = S.integrate' . S.stack $ S.workspace screen - gr <- fmap ($ sr) $ calcGap $ fromList [minBound .. maxBound] - wla <- filter (collides wa) <$> io (mapM (getWindowAttributes d) $ filter (/= w) wl) - - return ( neighbours (back wa sr gr wla) (wpos wa) - , neighbours (front wa sr gr wla) (wpos wa + wdim wa) - ) - where - wborder = fromIntegral.wa_border_width - - (wpos, wdim, rpos, rdim) = constructors horiz - (refwpos, refwdim, _, _) = constructors $ not horiz - - back wa sr gr wla = dropWhile (< rpos sr) - $ takeWhile (< rpos sr + rdim sr) - $ sort - $ rpos sr : - rpos gr : - (rpos gr + rdim gr) : - foldr (\a as -> wpos a : (wpos a + wdim a + wborder a + wborder wa) : as) [] wla - - front wa sr gr wla = dropWhile (<= rpos sr) - $ takeWhile (<= rpos sr + rdim sr) - $ sort - $ (rpos gr - 2 * wborder wa) : - (rpos gr + rdim gr - 2 * wborder wa) : - (rpos sr + rdim sr - 2 * wborder wa) : - foldr (\a as -> (wpos a - wborder a - wborder wa) : (wpos a + wdim a) : as) [] wla - - neighbours l v = ( listToMaybe $ reverse $ takeWhile (< v) l - , listToMaybe $ dropWhile (<= v) l - , v `elem` l - ) - - collides wa oa = case collidedist of - Nothing -> True - Just dist -> refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist - && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa - - -constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int) -constructors True = ( fromIntegral.wa_x - , fromIntegral.wa_width - , fromIntegral.rect_x - , fromIntegral.rect_width - ) -constructors False = ( fromIntegral.wa_y - , fromIntegral.wa_height - , fromIntegral.rect_y - , fromIntegral.rect_height - ) + wa <- io $ getWindowAttributes d w + screen <- S.current <$> gets windowset + let sr = screenRect $ S.screenDetail screen + wl = S.integrate' . S.stack $ S.workspace screen + gr <- fmap ($ sr) $ calcGap $ fromList [minBound .. maxBound] + wla <- filter (collides wa) + <$> io (mapM (getWindowAttributes d) $ filter (/= w) wl) + + return + ( neighbours (back wa sr gr wla) (wpos wa) + , neighbours (front wa sr gr wla) (wpos wa + wdim wa) + ) + where + wborder = fromIntegral . wa_border_width + + (wpos , wdim , rpos, rdim) = constructors horiz + (refwpos, refwdim, _ , _ ) = constructors $ not horiz + + back wa sr gr wla = + dropWhile (< rpos sr) + $ takeWhile (< rpos sr + rdim sr) + $ sort + $ rpos sr + : rpos gr + : (rpos gr + rdim gr) + : foldr + (\a as -> wpos a : (wpos a + wdim a + wborder a + wborder wa) : as) + [] + wla + + front wa sr gr wla = + dropWhile (<= rpos sr) + $ takeWhile (<= rpos sr + rdim sr) + $ sort + $ (rpos gr - 2 * wborder wa) + : (rpos gr + rdim gr - 2 * wborder wa) + : (rpos sr + rdim sr - 2 * wborder wa) + : foldr + (\a as -> (wpos a - wborder a - wborder wa) : (wpos a + wdim a) : as) + [] + wla + + neighbours l v = + ( listToMaybe $ reverse $ takeWhile (< v) l + , listToMaybe $ dropWhile (<= v) l + , v `elem` l + ) + + collides wa oa = case collidedist of + Nothing -> True + Just dist -> + refwpos oa + - wborder oa + < refwpos wa + + refwdim wa + + wborder wa + + dist + && refwpos wa + - wborder wa + - dist + < refwpos oa + + refwdim oa + + wborder oa + + +constructors + :: Bool + -> ( WindowAttributes -> Int + , WindowAttributes -> Int + , Rectangle -> Int + , Rectangle -> Int + ) +constructors True = + ( fromIntegral . wa_x + , fromIntegral . wa_width + , fromIntegral . rect_x + , fromIntegral . rect_width + ) +constructors False = + ( fromIntegral . wa_y + , fromIntegral . wa_height + , fromIntegral . rect_y + , fromIntegral . rect_height + ) diff --git a/src/XMonad/Actions/PerConditionKeys.hs b/src/XMonad/Actions/PerConditionKeys.hs index b84b942..09372cd 100644 --- a/src/XMonad/Actions/PerConditionKeys.hs +++ b/src/XMonad/Actions/PerConditionKeys.hs @@ -8,25 +8,27 @@ -- module XMonad.Actions.PerConditionKeys - ( XCond(..) - , chooseAction - , bindOn - ) where + ( XCond(..) + , chooseAction + , bindOn + ) where import Data.List import XMonad -import qualified XMonad.StackSet as S +import qualified XMonad.StackSet as S data XCond = WS | LD chooseAction :: XCond -> (String -> X ()) -> X () chooseAction WS f = withWindowSet (f . S.currentTag) -chooseAction LD f = withWindowSet (f . description . S.layout . S.workspace . S.current) +chooseAction LD f = + withWindowSet (f . description . S.layout . S.workspace . S.current) bindOn :: XCond -> [(String, X ())] -> X () bindOn xc bindings = chooseAction xc chooser - where chooser x = case find ((x ==) . fst) bindings of - Just (_, action) -> action - Nothing -> case find (("" ==) . fst) bindings of - Just (_, action) -> action - Nothing -> return () + where + chooser x = case find ((x ==) . fst) bindings of + Just (_, action) -> action + Nothing -> case find (("" ==) . fst) bindings of + Just (_, action) -> action + Nothing -> return () diff --git a/src/XMonad/Custom/Bindings.hs b/src/XMonad/Custom/Bindings.hs index b008b64..de0fd26 100644 --- a/src/XMonad/Custom/Bindings.hs +++ b/src/XMonad/Custom/Bindings.hs @@ -10,21 +10,24 @@ -- module XMonad.Custom.Bindings - ( keys - , rawKeys - , modMask - , mouseBindings - ) where + ( keys + , rawKeys + , modMask + , mouseBindings + ) where -import qualified Data.Map as M +import qualified Data.Map as M import System.Exit -import XMonad hiding ( keys, modMask, - mouseBindings ) +import XMonad hiding ( keys + , modMask + , mouseBindings + ) import XMonad.Actions.CopyWindow import XMonad.Actions.CycleWS import XMonad.Actions.DynamicProjects import XMonad.Actions.DynamicWorkspaces -import qualified XMonad.Actions.FlexibleManipulate as F +import qualified XMonad.Actions.FlexibleManipulate + as F import XMonad.Actions.FloatSnap import XMonad.Actions.FloatSnapSpaced import XMonad.Actions.MessageFeedback @@ -34,7 +37,7 @@ import XMonad.Actions.Promote import XMonad.Actions.UpdatePointer import XMonad.Actions.WithAll import XMonad.Custom.Layout -import qualified XMonad.Custom.Misc as C +import qualified XMonad.Custom.Misc as C import XMonad.Custom.Scratchpads import XMonad.Custom.Theme import XMonad.Hooks.UrgencyHook @@ -49,7 +52,7 @@ import XMonad.Prompt.ConfirmPrompt import XMonad.Prompt.Shell import XMonad.Prompt.Window import XMonad.Prompt.Workspace -import qualified XMonad.StackSet as S +import qualified XMonad.StackSet as S import XMonad.Util.EZConfig import XMonad.Util.NamedScratchpad import XMonad.Util.WorkspaceCompare @@ -61,12 +64,12 @@ directions :: [Direction2D] directions = [D, U, L, R] arrowKeys, directionKeys, wsKeys :: [String] -arrowKeys = [ "<D>" , "<U>" , "<L>" , "<R>" ] -directionKeys = [ "j" , "k" , "h" , "l" ] -wsKeys = map show [1..9 :: Int] +arrowKeys = ["<D>", "<U>", "<L>", "<R>"] +directionKeys = ["j", "k", "h", "l"] +wsKeys = map show [1 .. 9 :: Int] -zipKeys :: [a] -> [[a]] -> [t1] -> (t1 -> b) -> [([a], b)] -zipKeys m ks as f = zipWith (\k d -> (m ++ k, f d)) ks as +zipKeys :: [a] -> [[a]] -> [t1] -> (t1 -> b) -> [([a], b)] +zipKeys m ks as f = zipWith (\k d -> (m ++ k, f d)) ks as zipKeys' :: [a] -> [[a]] -> [t1] -> (t1 -> t2 -> b) -> t2 -> [([a], b)] zipKeys' m ks as f b = zipWith (\k d -> (m ++ k, f d b)) ks as @@ -74,85 +77,98 @@ tryMessageR_ :: (Message a, Message b) => a -> b -> X () tryMessageR_ x y = sequence_ [tryMessageWithNoRefreshToCurrent x y, refresh] toggleCopyToAll :: X () -toggleCopyToAll = wsContainingCopies >>= \case [] -> windows copyToAll - _ -> killAllOtherCopies +toggleCopyToAll = wsContainingCopies >>= \case + [] -> windows copyToAll + _ -> killAllOtherCopies getSortByIndexNonSP :: X ([WindowSpace] -> [WindowSpace]) getSortByIndexNonSP = (. namedScratchpadFilterOutWorkspace) <$> getSortByIndex nextNonEmptyWS, prevNonEmptyWS :: X () -nextNonEmptyWS = findWorkspace getSortByIndexNonSP Next HiddenNonEmptyWS 1 >>= \t -> windows . S.view $ t -prevNonEmptyWS = findWorkspace getSortByIndexNonSP Prev HiddenNonEmptyWS 1 >>= \t -> windows . S.view $ t +nextNonEmptyWS = findWorkspace getSortByIndexNonSP Next HiddenNonEmptyWS 1 + >>= \t -> windows . S.view $ t +prevNonEmptyWS = findWorkspace getSortByIndexNonSP Prev HiddenNonEmptyWS 1 + >>= \t -> windows . S.view $ t toggleFloat :: Window -> X () -toggleFloat w = windows (\s -> if M.member w (S.floating s) - then S.sink w s - else S.float w (S.RationalRect (1/2 - 1/4) (1/2 - 1/4) (1/2) (1/2)) s) +toggleFloat w = windows + (\s -> if M.member w (S.floating s) + then S.sink w s + else S.float + w + (S.RationalRect (1 / 2 - 1 / 4) (1 / 2 - 1 / 4) (1 / 2) (1 / 2)) + s + ) withUpdatePointer :: [(String, X ())] -> [(String, X ())] withUpdatePointer = map addAction - where - addAction :: (String, X ()) -> (String, X ()) - addAction (key, action) = (key, action >> updatePointer (0.98, 0.01) (0, 0)) + where + addAction :: (String, X ()) -> (String, X ()) + addAction (key, action) = (key, action >> updatePointer (0.98, 0.01) (0, 0)) keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) keys c = mkKeymap c (rawKeys c) rawKeys :: XConfig Layout -> [(String, X ())] rawKeys c = withUpdatePointer $ concatMap ($ c) keymaps - where - keymaps = [ keysBase - , keysSystem - , keysMedia - , keysWorkspaces - , keysSpawnables - , keysWindows - , keysLayout - , keysResize - ] + where + keymaps = + [ keysBase + , keysSystem + , keysMedia + , keysWorkspaces + , keysSpawnables + , keysWindows + , keysLayout + , keysResize + ] keysBase :: XConfig Layout -> [(String, X ())] keysBase _ = - [ ("M-S-q" , confirmPrompt hotPromptTheme "Quit XMonad?" $ io exitSuccess) - , ("M-q" , spawn "xmonad --restart") -- TODO Replace with interal calls - , ("M-C-q" , spawn "xmonad --recompile && xmonad --restart") - , ("M-x" , shellPrompt promptTheme) - , ("M-w" , windowPrompt promptTheme Goto allWindows) - , ("M-S-w" , windowPrompt promptTheme Bring allWindows) - ] + [ ("M-S-q", confirmPrompt hotPromptTheme "Quit XMonad?" $ io exitSuccess) + , ("M-q" , spawn "xmonad --restart") -- TODO Replace with interal calls + , ("M-C-q", spawn "xmonad --recompile && xmonad --restart") + , ("M-x" , shellPrompt promptTheme) + , ("M-w" , windowPrompt promptTheme Goto allWindows) + , ("M-S-w", windowPrompt promptTheme Bring allWindows) + ] keysSystem :: XConfig Layout -> [(String, X ())] keysSystem _ = - [ ("M-C-g" , return ()) -- TODO Replace scripts with internal functions - , ("<XF86ScreenSaver>" , spawn "~/.xmonad/scripts/screenlock.sh") - , ("M-<Print>" , spawn "~/.xmonad/scripts/xshot-upload.sh") - , ("M-S-<Print>" , spawn "~/.xmonad/scripts/xshot-select-upload.sh") - , ("M-C-c" , spawn "~/.xmonad/scripts/toggle-compton.sh") - , ("M-C-r" , spawn "~/.xmonad/scripts/toggle-redshift.sh") - , ("M-C-p" , spawn "~/.xmonad/scripts/toggle-touchpad.sh") - , ("M-C-t" , spawn "~/.xmonad/scripts/toggle-trackpoint.sh") - ] + [ ("M-C-g" , return ()) -- TODO Replace scripts with internal functions + , ("<XF86ScreenSaver>", spawn "~/.xmonad/scripts/screenlock.sh") + , ("M-<Print>", spawn "~/.xmonad/scripts/xshot-upload.sh") + , ("M-S-<Print>", spawn "~/.xmonad/scripts/xshot-select-upload.sh") + , ("M-C-c", spawn "~/.xmonad/scripts/toggle-compton.sh") + , ("M-C-r", spawn "~/.xmonad/scripts/toggle-redshift.sh") + , ("M-C-p", spawn "~/.xmonad/scripts/toggle-touchpad.sh") + , ("M-C-t", spawn "~/.xmonad/scripts/toggle-trackpoint.sh") + ] keysMedia :: XConfig Layout -> [(String, X ())] -- TODO Make audio keys compatible with ALSA/PA at the same time keysMedia _ = - [ ("<XF86AudioMicMute>" , spawn "pactl set-source-mute 1 toggle") - , ("<XF86AudioMute>" , spawn "pactl set-sink-mute 0 toggle") - , ("<XF86AudioLowerVolume>" , spawn "pactl set-sink-mute 0 false && pactl set-sink-volume 0 -10%") - , ("<XF86AudioRaiseVolume>" , spawn "pactl set-sink-mute 0 false && pactl set-sink-volume 0 +10%") - , ("<XF86AudioPlay>" , spawn "mpc toggle") - , ("<XF86AudioStop>" , spawn "mpc stop") - , ("<XF86AudioPrev>" , spawn "mpc prev") - , ("<XF86AudioNext>" , spawn "mpc next") - ] + [ ("<XF86AudioMicMute>", spawn "pactl set-source-mute 1 toggle") + , ("<XF86AudioMute>" , spawn "pactl set-sink-mute 0 toggle") + , ( "<XF86AudioLowerVolume>" + , spawn "pactl set-sink-mute 0 false && pactl set-sink-volume 0 -10%" + ) + , ( "<XF86AudioRaiseVolume>" + , spawn "pactl set-sink-mute 0 false && pactl set-sink-volume 0 +10%" + ) + , ("<XF86AudioPlay>", spawn "mpc toggle") + , ("<XF86AudioStop>", spawn "mpc stop") + , ("<XF86AudioPrev>", spawn "mpc prev") + , ("<XF86AudioNext>", spawn "mpc next") + ] keysWorkspaces :: XConfig Layout -> [(String, X ())] keysWorkspaces _ = - [ ("M-S-o" , switchProjectPrompt promptTheme) - , ("M-S-p" , shiftToProjectPrompt promptTheme) - , ("M-," , nextNonEmptyWS) - , ("M-." , prevNonEmptyWS) - , ("M-i" , toggleWS' ["NSP"]) - , ("M-n" , workspacePrompt promptTheme $ windows . S.shift) + [ ("M-S-o", switchProjectPrompt promptTheme) + , ("M-S-p", shiftToProjectPrompt promptTheme) + , ("M-," , nextNonEmptyWS) + , ("M-." , prevNonEmptyWS) + , ("M-i" , toggleWS' ["NSP"]) + , ("M-n", workspacePrompt promptTheme $ windows . S.shift) ] ++ zipKeys "M-" wsKeys [0 ..] (withNthWorkspace S.greedyView) ++ zipKeys "M-S-" wsKeys [0 ..] (withNthWorkspace S.shift) @@ -160,79 +176,83 @@ keysWorkspaces _ = keysSpawnables :: XConfig Layout -> [(String, X ())] keysSpawnables _ = - [ ("M-<Return>" , spawn (C.term C.applications)) - , ("M-b" , spawn (C.browser C.applications)) - , ("M-c" , namedScratchpadAction scratchpads "console") - , ("M-m" , namedScratchpadAction scratchpads "music") - , ("M-t" , namedScratchpadAction scratchpads "top") - , ("M-v" , namedScratchpadAction scratchpads "volume") - ] + [ ("M-<Return>", spawn (C.term C.applications)) + , ("M-b" , spawn (C.browser C.applications)) + , ("M-c" , namedScratchpadAction scratchpads "console") + , ("M-m" , namedScratchpadAction scratchpads "music") + , ("M-t" , namedScratchpadAction scratchpads "top") + , ("M-v" , namedScratchpadAction scratchpads "volume") + ] keysWindows :: XConfig Layout -> [(String, X ())] keysWindows _ = - [ ("M-d" , kill) - , ("M-S-d" , confirmPrompt hotPromptTheme "Kill all" killAll) - , ("M-a" , toggleCopyToAll) - , ("M-e" , withFocused hideWindow) -- FIXME This is so broken - , ("M-S-e" , popOldestHiddenWindow) - , ("M-p" , promote) - , ("M-g" , withFocused $ sendMessage . MergeAll) - , ("M-S-g" , withFocused $ sendMessage . UnMerge) - , ("M-u" , focusUrgent) - , ("M-s" , windows S.focusMaster) - , ("M-'" , bindOn LD [ ("Tabs" , windows S.focusDown) - , ("" , onGroup S.focusDown') - ]) - , ("M-;" , bindOn LD [ ("Tabs" , windows S.focusUp) - , ("" , onGroup S.focusUp') - ]) - , ("M-S-'" , windows S.swapDown) - , ("M-S-;" , windows S.swapUp) + [ ("M-d" , kill) + , ("M-S-d", confirmPrompt hotPromptTheme "Kill all" killAll) + , ("M-a" , toggleCopyToAll) + , ("M-e" , withFocused hideWindow) -- FIXME This is so broken + , ("M-S-e", popOldestHiddenWindow) + , ("M-p" , promote) + , ("M-g", withFocused $ sendMessage . MergeAll) + , ("M-S-g", withFocused $ sendMessage . UnMerge) + , ("M-u" , focusUrgent) + , ("M-s" , windows S.focusMaster) + , ( "M-'" + , bindOn LD [("Tabs", windows S.focusDown), ("", onGroup S.focusDown')] + ) + , ("M-;", bindOn LD [("Tabs", windows S.focusUp), ("", onGroup S.focusUp')]) + , ("M-S-'", windows S.swapDown) + , ("M-S-;", windows S.swapUp) ] ++ zipKeys' "M-" directionKeys directions windowGo True -- TODO W moving ++ zipKeys' "M-S-" directionKeys directions windowSwap True - ++ zipKeys "M-C-" directionKeys directions (sendMessage . pullGroup) + ++ zipKeys "M-C-" directionKeys directions (sendMessage . pullGroup) ++ zipKeys' "M-" arrowKeys directions screenGo True ++ zipKeys' "M-S-" arrowKeys directions windowToScreen True ++ zipKeys' "M-C-" arrowKeys directions screenSwap True keysLayout :: XConfig Layout -> [(String, X ())] keysLayout c = - [ ("M-<Tab>" , sendMessage NextLayout) - , ("M-C-<Tab>" , toSubl NextLayout) - , ("M-S-<Tab>" , setLayout $ XMonad.layoutHook c) - , ("M-o" , withFocused toggleFloat) - , ("M-S-o" , sinkAll) - , ("M-S-," , sendMessage $ IncMasterN (-1)) - , ("M-S-." , sendMessage $ IncMasterN 1) - , ("M-r" , tryMessageR_ Rotate (Toggle REFLECTX)) - , ("M-S-r" , sendMessage $ Toggle REFLECTX) - , ("M-f" , sequence_ [ withFocused $ windows . S.sink - , sendMessage $ Toggle NBFULL - ]) - , ("M-C-g" , sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout - ] + [ ("M-<Tab>" , sendMessage NextLayout) + , ("M-C-<Tab>", toSubl NextLayout) + , ("M-S-<Tab>", setLayout $ XMonad.layoutHook c) + , ("M-o" , withFocused toggleFloat) + , ("M-S-o" , sinkAll) + , ("M-S-," , sendMessage $ IncMasterN (-1)) + , ("M-S-." , sendMessage $ IncMasterN 1) + , ("M-r" , tryMessageR_ Rotate (Toggle REFLECTX)) + , ("M-S-r" , sendMessage $ Toggle REFLECTX) + , ( "M-f" + , sequence_ [withFocused $ windows . S.sink, sendMessage $ Toggle NBFULL] + ) + , ("M-C-g", sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout + ] keysResize :: XConfig Layout -> [(String, X ())] keysResize _ = - [ ("M-[" , tryMessageR_ (ExpandTowards L) Shrink) - , ("M-]" , tryMessageR_ (ExpandTowards R) Expand) - , ("M-S-[" , tryMessageR_ (ExpandTowards U) MirrorShrink) - , ("M-S-]" , tryMessageR_ (ExpandTowards D) MirrorExpand) - , ("M-C-[" , tryMessageR_ (ShrinkFrom R) Shrink) - , ("M-C-]" , tryMessageR_ (ShrinkFrom L) Expand) - , ("M-S-C-[" , tryMessageR_ (ShrinkFrom D) MirrorShrink) - , ("M-S-C-]" , tryMessageR_ (ShrinkFrom U) MirrorExpand) - ] + [ ("M-[" , tryMessageR_ (ExpandTowards L) Shrink) + , ("M-]" , tryMessageR_ (ExpandTowards R) Expand) + , ("M-S-[" , tryMessageR_ (ExpandTowards U) MirrorShrink) + , ("M-S-]" , tryMessageR_ (ExpandTowards D) MirrorExpand) + , ("M-C-[" , tryMessageR_ (ShrinkFrom R) Shrink) + , ("M-C-]" , tryMessageR_ (ShrinkFrom L) Expand) + , ("M-S-C-[", tryMessageR_ (ShrinkFrom D) MirrorShrink) + , ("M-S-C-]", tryMessageR_ (ShrinkFrom U) MirrorExpand) + ] mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) -mouseBindings XConfig {} = M.fromList - [ ((modMask, button1), \w -> focus w - >> F.mouseWindow F.position w - >> ifClick (snapSpacedMagicMove gapFull (Just 50) (Just 50) w) - >> windows S.shiftMaster) - , ((modMask, button3), \w -> focus w - >> F.mouseWindow F.linear w - >> ifClick (snapMagicResize [L, R, U, D] (Just 50) (Just 50) w) - >> windows S.shiftMaster) - ] +mouseBindings XConfig{} = M.fromList + [ ( (modMask, button1) + , \w -> + focus w + >> F.mouseWindow F.position w + >> ifClick (snapSpacedMagicMove gapFull (Just 50) (Just 50) w) + >> windows S.shiftMaster + ) + , ( (modMask, button3) + , \w -> + focus w + >> F.mouseWindow F.linear w + >> ifClick (snapMagicResize [L, R, U, D] (Just 50) (Just 50) w) + >> windows S.shiftMaster + ) + ] diff --git a/src/XMonad/Custom/Event.hs b/src/XMonad/Custom/Event.hs index 745fefe..f55511d 100644 --- a/src/XMonad/Custom/Event.hs +++ b/src/XMonad/Custom/Event.hs @@ -8,18 +8,16 @@ -- module XMonad.Custom.Event - ( handleEventHook - ) where + ( handleEventHook + ) where import Data.Monoid -import XMonad hiding ( handleEventHook ) +import XMonad hiding ( handleEventHook ) import XMonad.Custom.Scratchpads import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageDocks import XMonad.Util.Loggers.NamedScratchpad handleEventHook :: Event -> X All -handleEventHook = mconcat [ nspTrackHook scratchpads - , docksEventHook - , fullscreenEventHook - ] +handleEventHook = + mconcat [nspTrackHook scratchpads, docksEventHook, fullscreenEventHook] diff --git a/src/XMonad/Custom/Layout.hs b/src/XMonad/Custom/Layout.hs index 70476a9..c7989b4 100644 --- a/src/XMonad/Custom/Layout.hs +++ b/src/XMonad/Custom/Layout.hs @@ -13,11 +13,11 @@ -- module XMonad.Custom.Layout - ( layoutHook - , CustomTransformers (..) - ) where + ( layoutHook + , CustomTransformers(..) + ) where -import XMonad hiding ( layoutHook ) +import XMonad hiding ( layoutHook ) import XMonad.Custom.Theme import XMonad.Hooks.ManageDocks import XMonad.Layout.Accordion @@ -39,21 +39,21 @@ applySpacing :: l a -> ModifiedLayout Spacing l a applySpacing = spacingRaw False (Border 6 6 6 6) True (Border 6 6 6 6) True data CustomTransformers = GAPS - deriving (Read, Show, Eq, Typeable) + deriving (Read, Show, Eq, Typeable) instance Transformer CustomTransformers Window where - transform GAPS x k = k (avoidStruts $ applySpacing x) (const x) + transform GAPS x k = k (avoidStruts $ applySpacing x) (const x) -layoutHook = fullscreenFloat - $ lessBorders OnlyLayoutFloat - $ mkToggle (single NBFULL) - $ avoidStruts - $ applySpacing +layoutHook = + fullscreenFloat + $ lessBorders OnlyLayoutFloat + $ mkToggle (single NBFULL) + $ avoidStruts + $ applySpacing -- $ mkToggle (single GAPS) - $ mkToggle (single REFLECTX) - $ mkToggle (single REFLECTY) - $ windowNavigation - $ addTabs shrinkText tabTheme - $ hiddenWindows - $ subLayout [] (Simplest ||| Accordion) - emptyBSP + $ mkToggle (single REFLECTX) + $ mkToggle (single REFLECTY) + $ windowNavigation + $ addTabs shrinkText tabTheme + $ hiddenWindows + $ subLayout [] (Simplest ||| Accordion) emptyBSP diff --git a/src/XMonad/Custom/Log.hs b/src/XMonad/Custom/Log.hs index b10fcdf..bfd7093 100644 --- a/src/XMonad/Custom/Log.hs +++ b/src/XMonad/Custom/Log.hs @@ -8,11 +8,11 @@ -- module XMonad.Custom.Log - ( logHook - ) where + ( logHook + ) where import System.IO -import XMonad hiding ( logHook ) +import XMonad hiding ( logHook ) import XMonad.Actions.CopyWindow import XMonad.Custom.Theme import XMonad.Hooks.CurrentWorkspaceOnTop @@ -27,54 +27,55 @@ xmobarFont f = wrap (concat ["<fn=", show f, ">"]) "</fn>" topBarPP :: PP topBarPP = def - { ppCurrent = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" - , ppVisible = xmobarColor white1 "" . wrap "~" "~" - , ppHidden = xmobarColor white1 "" . wrap "-" "-" - , ppHiddenNoWindows = xmobarColor white1 "" . wrap "_" "_" - , ppUrgent = xmobarColor red2 "" . wrap "!" "!" - , ppSep = " / " - , ppWsSep = " " - , ppTitle = xmobarColor white1 "" . shorten 50 - , ppTitleSanitize = xmobarStrip - , ppLayout = xmobarColor white1 "" - , ppOrder = id - , ppSort = (namedScratchpadFilterOutWorkspace .) <$> getSortByIndex - , ppExtras = [] - } + { ppCurrent = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" + , ppVisible = xmobarColor white1 "" . wrap "~" "~" + , ppHidden = xmobarColor white1 "" . wrap "-" "-" + , ppHiddenNoWindows = xmobarColor white1 "" . wrap "_" "_" + , ppUrgent = xmobarColor red2 "" . wrap "!" "!" + , ppSep = " / " + , ppWsSep = " " + , ppTitle = xmobarColor white1 "" . shorten 50 + , ppTitleSanitize = xmobarStrip + , ppLayout = xmobarColor white1 "" + , ppOrder = id + , ppSort = (namedScratchpadFilterOutWorkspace .) <$> getSortByIndex + , ppExtras = [] + } botBarPP :: PP -botBarPP = topBarPP - { ppCurrent = const "" - , ppVisible = const "" - , ppHidden = const "" - , ppHiddenNoWindows = const "" - , ppUrgent = const "" - , ppTitle = const "" - , ppLayout = const "" - } +botBarPP = topBarPP { ppCurrent = const "" + , ppVisible = const "" + , ppHidden = const "" + , ppHiddenNoWindows = const "" + , ppUrgent = const "" + , ppTitle = const "" + , ppLayout = const "" + } safePrintToPipe :: Maybe Handle -> String -> IO () safePrintToPipe = maybe (\_ -> return ()) hPutStrLn logHook :: X () logHook = do - currentWorkspaceOnTop - ewmhDesktopsLogHook - t <- getNamedPipe "xmobarTop" - b <- getNamedPipe "xmobarBot" - c <- wsContainingCopies - let copiesCurrent ws | ws `elem` c = xmobarColor yellow2 "" . xmobarFont 2 . wrap "*" "=" $ ws - | otherwise = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" $ ws - let copiesHidden ws | ws `elem` c = xmobarColor yellow1 "" . wrap "*" "-" $ ws - | otherwise = xmobarColor white1 "" . wrap "-" "-" $ ws - let copiesUrgent ws | ws `elem` c = xmobarColor yellow2 "" . wrap "*" "!" $ ws - | otherwise = xmobarColor white2 "" . wrap "!" "!" $ ws - dynamicLogWithPP $ topBarPP - { ppCurrent = copiesCurrent - , ppHidden = copiesHidden - , ppUrgent = copiesUrgent - , ppOutput = safePrintToPipe t - } - dynamicLogWithPP $ botBarPP - { ppOutput = safePrintToPipe b - } + currentWorkspaceOnTop + ewmhDesktopsLogHook + t <- getNamedPipe "xmobarTop" + b <- getNamedPipe "xmobarBot" + c <- wsContainingCopies + let copiesCurrent ws + | ws `elem` c + = xmobarColor yellow2 "" . xmobarFont 2 . wrap "*" "=" $ ws + | otherwise + = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" $ ws + let copiesHidden ws + | ws `elem` c = xmobarColor yellow1 "" . wrap "*" "-" $ ws + | otherwise = xmobarColor white1 "" . wrap "-" "-" $ ws + let copiesUrgent ws + | ws `elem` c = xmobarColor yellow2 "" . wrap "*" "!" $ ws + | otherwise = xmobarColor white2 "" . wrap "!" "!" $ ws + dynamicLogWithPP $ topBarPP { ppCurrent = copiesCurrent + , ppHidden = copiesHidden + , ppUrgent = copiesUrgent + , ppOutput = safePrintToPipe t + } + dynamicLogWithPP $ botBarPP { ppOutput = safePrintToPipe b } diff --git a/src/XMonad/Custom/Manage.hs b/src/XMonad/Custom/Manage.hs index deffa3b..ac4201b 100644 --- a/src/XMonad/Custom/Manage.hs +++ b/src/XMonad/Custom/Manage.hs @@ -8,10 +8,10 @@ -- module XMonad.Custom.Manage - ( manageHook - ) where + ( manageHook + ) where -import XMonad hiding ( manageHook ) +import XMonad hiding ( manageHook ) import XMonad.Custom.Scratchpads import XMonad.Hooks.InsertPosition import XMonad.Hooks.ManageDocks @@ -21,33 +21,34 @@ import XMonad.Util.NamedScratchpad composeActions :: [MaybeManageHook] composeActions = - [ appName =? "emacs-popup" -?> tileBelowNoFocus - , appName =? "eterm" -?> tileBelow - , className =? "Pinentry" -?> doCenterFloat - , className =? "Steam" <&&> not <$> title =? "Steam" -?> doFloat - , className =? "Xmessage" -?> doCenterFloat - , className =? "Zenity" -?> doCenterFloat - , className =? "explorer.exe" -?> doFullFloat - , className =? "qemu-system-x86" -?> doCenterFloat - , className =? "qemu-system-x86_64" -?> doCenterFloat - , className =? "urxvt" -?> tileBelow - , className =? "xterm" -?> tileBelow - , isDialog -?> doCenterFloat - , isFullscreen -?> doFullFloat - , pure True -?> tileNormal - , stringProperty "WM_WINDOW_ROLE" =? "pop-up" -?> doCenterFloat - , stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooserDialog" -?> doCenterFloat - , transience - ] - where - tileNormal = insertPosition Above Newer - tileBelow = insertPosition Below Newer - tileBelowNoFocus = insertPosition Below Older + [ appName =? "emacs-popup" -?> tileBelowNoFocus + , appName =? "eterm" -?> tileBelow + , className =? "Pinentry" -?> doCenterFloat + , className =? "Steam" <&&> not <$> title =? "Steam" -?> doFloat + , className =? "Xmessage" -?> doCenterFloat + , className =? "Zenity" -?> doCenterFloat + , className =? "explorer.exe" -?> doFullFloat + , className =? "qemu-system-x86" -?> doCenterFloat + , className =? "qemu-system-x86_64" -?> doCenterFloat + , className =? "urxvt" -?> tileBelow + , className =? "xterm" -?> tileBelow + , isDialog -?> doCenterFloat + , isFullscreen -?> doFullFloat + , pure True -?> tileNormal + , stringProperty "WM_WINDOW_ROLE" =? "pop-up" -?> doCenterFloat + , stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooserDialog" -?> doCenterFloat + , transience + ] + where + tileNormal = insertPosition Above Newer + tileBelow = insertPosition Below Newer + tileBelowNoFocus = insertPosition Below Older manageHook :: ManageHook -manageHook = mconcat [ manageDocks - , fullscreenManageHook - , namedScratchpadManageHook scratchpads - , composeOne composeActions - ] +manageHook = mconcat + [ manageDocks + , fullscreenManageHook + , namedScratchpadManageHook scratchpads + , composeOne composeActions + ] diff --git a/src/XMonad/Custom/Misc.hs b/src/XMonad/Custom/Misc.hs index 8e72632..e43e171 100644 --- a/src/XMonad/Custom/Misc.hs +++ b/src/XMonad/Custom/Misc.hs @@ -10,25 +10,25 @@ -- module XMonad.Custom.Misc - ( Applications (..) - , applications - ) where + ( Applications(..) + , applications + ) where data Applications = Applications - { browser :: !String - , mixer :: !String - , notify :: !String - , player :: !String - , term :: !String - , top :: !String - } deriving (Eq, Show) + { browser :: !String + , mixer :: !String + , notify :: !String + , player :: !String + , term :: !String + , top :: !String + } + deriving (Eq, Show) applications :: Applications -applications = Applications - { browser = "qutebrowser" - , mixer = "pulsemixer" - , notify = "notify-send" - , player = "ncmpcpp" - , term = "urxvtc" - , top = "htop" - } +applications = Applications { browser = "qutebrowser" + , mixer = "pulsemixer" + , notify = "notify-send" + , player = "ncmpcpp" + , term = "urxvtc" + , top = "htop" + } diff --git a/src/XMonad/Custom/Navigation.hs b/src/XMonad/Custom/Navigation.hs index db986a2..812dd30 100644 --- a/src/XMonad/Custom/Navigation.hs +++ b/src/XMonad/Custom/Navigation.hs @@ -8,15 +8,15 @@ -- module XMonad.Custom.Navigation - ( navigation - ) where + ( navigation + ) where import XMonad.Actions.Navigation2D navigation :: Navigation2DConfig navigation = def - { defaultTiledNavigation = hybridOf sideNavigation centerNavigation - , floatNavigation = hybridOf lineNavigation centerNavigation - , layoutNavigation = [("Full", centerNavigation)] - , unmappedWindowRect = [("Full", singleWindowRect)] - } + { defaultTiledNavigation = hybridOf sideNavigation centerNavigation + , floatNavigation = hybridOf lineNavigation centerNavigation + , layoutNavigation = [("Full", centerNavigation)] + , unmappedWindowRect = [("Full", singleWindowRect)] + } diff --git a/src/XMonad/Custom/Projects.hs b/src/XMonad/Custom/Projects.hs index a4ee21d..4726fc7 100644 --- a/src/XMonad/Custom/Projects.hs +++ b/src/XMonad/Custom/Projects.hs @@ -8,27 +8,25 @@ -- module XMonad.Custom.Projects - ( projects - ) where + ( projects + ) where import XMonad.Actions.DynamicProjects import XMonad.Actions.SpawnOn -import qualified XMonad.Custom.Misc as C +import qualified XMonad.Custom.Misc as C projects :: [Project] projects = - [ Project { projectName = "Template" - , projectDirectory = "~/" - , projectStartHook = Nothing - } - - , Project { projectName = "Emacs" - , projectDirectory = "~/" - , projectStartHook = Just $ spawnOn "Emacs" "emacsclient" - } - - , Project { projectName = "WWW" - , projectDirectory = "~/" - , projectStartHook = Just $ spawnOn "WWW" (C.browser C.applications) - } - ] + [ Project { projectName = "Template" + , projectDirectory = "~/" + , projectStartHook = Nothing + } + , Project { projectName = "Emacs" + , projectDirectory = "~/" + , projectStartHook = Just $ spawnOn "Emacs" "emacsclient" + } + , Project { projectName = "WWW" + , projectDirectory = "~/" + , projectStartHook = Just $ spawnOn "WWW" (C.browser C.applications) + } + ] diff --git a/src/XMonad/Custom/Prompt.hs b/src/XMonad/Custom/Prompt.hs index 59f19de..e8762d1 100644 --- a/src/XMonad/Custom/Prompt.hs +++ b/src/XMonad/Custom/Prompt.hs @@ -8,10 +8,10 @@ -- module XMonad.Custom.Prompt - ( listCompFunc - , aListCompFunc - , predicateFunction - ) where + ( listCompFunc + , aListCompFunc + , predicateFunction + ) where import Data.Char import Data.List diff --git a/src/XMonad/Custom/Scratchpads.hs b/src/XMonad/Custom/Scratchpads.hs index 90656aa..157a1fb 100644 --- a/src/XMonad/Custom/Scratchpads.hs +++ b/src/XMonad/Custom/Scratchpads.hs @@ -8,13 +8,13 @@ -- module XMonad.Custom.Scratchpads - ( scratchpads - ) where + ( scratchpads + ) where import XMonad.Core -import XMonad.Custom.Misc as C +import XMonad.Custom.Misc as C import XMonad.ManageHook -import qualified XMonad.StackSet as S +import qualified XMonad.StackSet as S import XMonad.Util.NamedScratchpad spawnTerminalWith :: String -> String -> String @@ -22,28 +22,28 @@ spawnTerminalWith t c = term applications ++ " -title " ++ t ++ " -e " ++ c floatingNSP :: ManageHook floatingNSP = customFloating $ S.RationalRect x y w h - where - x = (1 - w) / 2 - y = (1 - h) / 2 - w = 1 / 2 - h = 1 / 2.5 + where + x = (1 - w) / 2 + y = (1 - h) / 2 + w = 1 / 2 + h = 1 / 2.5 scratchpads :: [NamedScratchpad] scratchpads = - [ NS "console" - (spawnTerminalWith "NSPConsole" "~/.xmonad/scripts/nsp-console.sh") - (title =? "NSPConsole") - floatingNSP - , NS "volume" - (spawnTerminalWith "NSPVolume" (C.mixer C.applications)) - (title =? "NSPVolume") - floatingNSP - , NS "music" - (spawnTerminalWith "NSPMusic" (C.player C.applications)) - (title =? "NSPMusic") - floatingNSP - , NS "top" - (spawnTerminalWith "NSPTop" (C.top C.applications)) - (title =? "NSPTop") - floatingNSP - ] + [ NS "console" + (spawnTerminalWith "NSPConsole" "~/.xmonad/scripts/nsp-console.sh") + (title =? "NSPConsole") + floatingNSP + , NS "volume" + (spawnTerminalWith "NSPVolume" (C.mixer C.applications)) + (title =? "NSPVolume") + floatingNSP + , NS "music" + (spawnTerminalWith "NSPMusic" (C.player C.applications)) + (title =? "NSPMusic") + floatingNSP + , NS "top" + (spawnTerminalWith "NSPTop" (C.top C.applications)) + (title =? "NSPTop") + floatingNSP + ] diff --git a/src/XMonad/Custom/Startup.hs b/src/XMonad/Custom/Startup.hs index aa9340f..5a755b2 100644 --- a/src/XMonad/Custom/Startup.hs +++ b/src/XMonad/Custom/Startup.hs @@ -8,12 +8,12 @@ -- module XMonad.Custom.Startup - ( startupHook - ) where + ( startupHook + ) where import Control.Monad import Data.Maybe -import XMonad hiding ( startupHook ) +import XMonad hiding ( startupHook ) import XMonad.Hooks.ManageDocks import XMonad.Hooks.SetWMName import XMonad.Util.Cursor @@ -34,23 +34,24 @@ atomsToFullscreen = addNETSupported :: Atom -> X () addNETSupported x = withDisplay $ \d -> do - r <- asks theRoot - n <- getAtom "_NET_SUPPORTED" - a <- getAtom "ATOM" - liftIO $ do - p <- join . maybeToList <$> getWindowProperty32 d n r - when (fromIntegral x `notElem` p) $ changeProperty32 d r n a propModeAppend [fromIntegral x] + r <- asks theRoot + n <- getAtom "_NET_SUPPORTED" + a <- getAtom "ATOM" + liftIO $ do + p <- join . maybeToList <$> getWindowProperty32 d n r + when (fromIntegral x `notElem` p) + $ changeProperty32 d r n a propModeAppend [fromIntegral x] addEWMHFullscreen :: X () addEWMHFullscreen = do - s <- mapM getAtom atomsToFullscreen - mapM_ addNETSupported s + s <- mapM getAtom atomsToFullscreen + mapM_ addNETSupported s startupHook :: X () startupHook = do - spawnNamedPipe "xmobar ~/.xmonad/xmobarrc/top.hs" "xmobarTop" - spawnNamedPipe "xmobar ~/.xmonad/xmobarrc/bot.hs" "xmobarBot" - docksStartupHook - addEWMHFullscreen - setDefaultCursor xC_left_ptr - setWMName "xmonad" + spawnNamedPipe "xmobar ~/.xmonad/xmobarrc/top.hs" "xmobarTop" + spawnNamedPipe "xmobar ~/.xmonad/xmobarrc/bot.hs" "xmobarBot" + docksStartupHook + addEWMHFullscreen + setDefaultCursor xC_left_ptr + setWMName "xmonad" diff --git a/src/XMonad/Custom/Theme.hs b/src/XMonad/Custom/Theme.hs index 72d89fa..64b52a8 100644 --- a/src/XMonad/Custom/Theme.hs +++ b/src/XMonad/Custom/Theme.hs @@ -8,32 +8,32 @@ -- module XMonad.Custom.Theme - ( font - , black1 - , black2 - , red1 - , red2 - , green1 - , green2 - , yellow1 - , yellow2 - , blue1 - , blue2 - , magenta1 - , magenta2 - , cyan1 - , cyan2 - , white1 - , white2 - , colorN - , colorF - , gapBase - , gapFull - , border - , tabTheme - , promptTheme - , hotPromptTheme - ) where + ( font + , black1 + , black2 + , red1 + , red2 + , green1 + , green2 + , yellow1 + , yellow2 + , blue1 + , blue2 + , magenta1 + , magenta2 + , cyan1 + , cyan2 + , white1 + , white2 + , colorN + , colorF + , gapBase + , gapFull + , border + , tabTheme + , promptTheme + , hotPromptTheme + ) where import Data.Char import Data.Function @@ -41,49 +41,41 @@ import Data.List import Data.Ratio import Graphics.X11.Xlib.Types import XMonad.Layout.Decoration -import qualified XMonad.Prompt as P +import qualified XMonad.Prompt as P font :: String font = "xft:tewi:style=Regular:size=8" -- TODO CJKのフォールバックフォントを追加する black1, black2 :: String -- TODO get variables from Xresources -(black1, black2) = - ("#0b0806", "#2f2b2a") +(black1, black2) = ("#0b0806", "#2f2b2a") -- | Red red1, red2 :: String -(red1, red2) = - ("#844d2c", "#a64848") +(red1, red2) = ("#844d2c", "#a64848") -- | Green green1, green2 :: String -(green1, green2) = - ("#57553a", "#897f5a") +(green1, green2) = ("#57553a", "#897f5a") -- | Yellow yellow1, yellow2 :: String -(yellow1, yellow2) = - ("#a17c38", "#c8b38d") +(yellow1, yellow2) = ("#a17c38", "#c8b38d") -- | Blue blue1, blue2 :: String -(blue1, blue2) = - ("#41434f", "#526274") +(blue1, blue2) = ("#41434f", "#526274") -- | Magenta magenta1, magenta2 :: String -(magenta1, magenta2) = - ("#6b4444", "#755c47") +(magenta1, magenta2) = ("#6b4444", "#755c47") -- | Cyan cyan1, cyan2 :: String -(cyan1, cyan2) = - ("#59664c", "#718062") +(cyan1, cyan2) = ("#59664c", "#718062") -- | White white1, white2 :: String -(white1, white2) = - ("#a19782", "#c1ab83") +(white1, white2) = ("#a19782", "#c1ab83") colorN, colorF :: String colorN = black2 @@ -98,40 +90,36 @@ height = 12 * 2 border = 1 tabTheme :: Theme -tabTheme = def - { activeColor = black1 - , inactiveColor = black2 - , urgentColor = red1 - , activeBorderColor = white1 - , inactiveBorderColor = white2 - , urgentBorderColor = red2 - , activeTextColor = white1 - , inactiveTextColor = white2 - , urgentTextColor = red2 - , fontName = font - , decoHeight = height - } +tabTheme = def { activeColor = black1 + , inactiveColor = black2 + , urgentColor = red1 + , activeBorderColor = white1 + , inactiveBorderColor = white2 + , urgentBorderColor = red2 + , activeTextColor = white1 + , inactiveTextColor = white2 + , urgentTextColor = red2 + , fontName = font + , decoHeight = height + } promptTheme, hotPromptTheme :: P.XPConfig promptTheme = def - { P.font = font - , P.bgColor = black1 - , P.fgColor = white1 - , P.fgHLight = white2 - , P.bgHLight = black2 - , P.borderColor = white2 - , P.promptBorderWidth = border - , P.position = P.CenteredAt { P.xpCenterY = 3 % 10 - , P.xpWidth = 9 % 10 - } - , P.height = height - , P.maxComplRows = Just 5 - , P.searchPredicate = isInfixOf `on` map toLower - , P.alwaysHighlight = True - } -hotPromptTheme = promptTheme - { P.bgColor = black2 - , P.fgColor = white2 - , P.fgHLight = white1 - , P.bgHLight = black1 - } + { P.font = font + , P.bgColor = black1 + , P.fgColor = white1 + , P.fgHLight = white2 + , P.bgHLight = black2 + , P.borderColor = white2 + , P.promptBorderWidth = border + , P.position = P.CenteredAt { P.xpCenterY = 3 % 10, P.xpWidth = 9 % 10 } + , P.height = height + , P.maxComplRows = Just 5 + , P.searchPredicate = isInfixOf `on` map toLower + , P.alwaysHighlight = True + } +hotPromptTheme = promptTheme { P.bgColor = black2 + , P.fgColor = white2 + , P.fgHLight = white1 + , P.bgHLight = black1 + } diff --git a/src/XMonad/Custom/Workspaces.hs b/src/XMonad/Custom/Workspaces.hs index a4c1a73..65d1b14 100644 --- a/src/XMonad/Custom/Workspaces.hs +++ b/src/XMonad/Custom/Workspaces.hs @@ -8,29 +8,27 @@ -- module XMonad.Custom.Workspaces - ( workspaces - ) where + ( workspaces + ) where import XMonad.Actions.DynamicProjects -import XMonad.Core hiding ( workspaces ) +import XMonad.Core hiding ( workspaces ) workspaces :: [WorkspaceId] -workspaces = map show [1..9 :: Int] +workspaces = map show [1 .. 9 :: Int] projects :: [Project] projects = - [ Project { projectName = "scratch" - , projectDirectory = "~/" - , projectStartHook = Nothing - } - - , Project { projectName = "www" - , projectDirectory = "~/" - , projectStartHook = Nothing - } - - , Project { projectName = "mail" - , projectDirectory = "~/" - , projectStartHook = Nothing - } - ] + [ Project { projectName = "scratch" + , projectDirectory = "~/" + , projectStartHook = Nothing + } + , Project { projectName = "www" + , projectDirectory = "~/" + , projectStartHook = Nothing + } + , Project { projectName = "mail" + , projectDirectory = "~/" + , projectStartHook = Nothing + } + ] |