about summary refs log tree commit diff
path: root/src/XMonad/Custom
diff options
context:
space:
mode:
Diffstat (limited to 'src/XMonad/Custom')
-rw-r--r--src/XMonad/Custom/Bindings.hs27
-rw-r--r--src/XMonad/Custom/Layout.hs13
-rw-r--r--src/XMonad/Custom/Log.hs9
-rw-r--r--src/XMonad/Custom/Navigation.hs4
-rw-r--r--src/XMonad/Custom/Startup.hs4
-rw-r--r--src/XMonad/Custom/Workspaces.hs20
6 files changed, 45 insertions, 32 deletions
diff --git a/src/XMonad/Custom/Bindings.hs b/src/XMonad/Custom/Bindings.hs
index 19eaa2a..414e89a 100644
--- a/src/XMonad/Custom/Bindings.hs
+++ b/src/XMonad/Custom/Bindings.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Custom.Bindings
@@ -34,7 +36,7 @@ import           XMonad.Actions.MessageFeedback
 import           XMonad.Actions.Navigation2D
 import           XMonad.Actions.PerConditionKeys
 import           XMonad.Actions.Promote
-import           XMonad.Actions.Volume
+--import           XMonad.Actions.Volume
 import           XMonad.Actions.WithAll
 import           XMonad.Custom.Layout
 import qualified XMonad.Custom.Misc                  as CM
@@ -86,16 +88,15 @@ zipM' :: [a] -> String -> [[a]] -> [t] -> (t -> t1 -> X ()) -> t1 -> [([a], Name
 zipM' m nm ks as f b = zipWith (\k d -> (m ++ k, addName nm $ f d b)) ks as
 
 tryMessageR_ :: (Message a, Message b) => a -> b -> X ()
-tryMessageR_ x y = sequence_ [tryMessage_ x y, refresh]
+tryMessageR_ x y = sequence_ [tryMessageWithNoRefreshToCurrent x y, refresh]
 
 xSelectionNotify :: MonadIO m => m ()
 xSelectionNotify = join $ io
-    $ (unsafeSpawn . (\x -> CM.notify CM.customApplications ++ " Clipboard " ++ wrap "\"\\\"" "\"\\\"" x)) <$> getSelection
+    $ unsafeSpawn . (\x -> CM.notify CM.customApplications ++ " Clipboard " ++ wrap "\"\\\"" "\"\\\"" x) <$> getSelection
 
 toggleCopyToAll :: X ()
-toggleCopyToAll = wsContainingCopies >>= \x -> case x of
-                                                   [] -> windows copyToAll
-                                                   _  -> killAllOtherCopies
+toggleCopyToAll = wsContainingCopies >>= \case [] -> windows copyToAll
+                                               _  -> killAllOtherCopies
 
 getSortByIndexNonSP :: X ([WindowSpace] -> [WindowSpace])
 getSortByIndexNonSP = (. namedScratchpadFilterOutWorkspace) <$> getSortByIndex
@@ -107,12 +108,10 @@ prevNonEmptyWS = findWorkspace getSortByIndexNonSP Prev HiddenNonEmptyWS 1 >>= \
 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)
+                               else S.float w (S.RationalRect (1/2 - 1/4) (1/2 - 1/4) (1/2) (1/2)) s)
 
 keyBindings :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
-keyBindings c =
-    let subKeys s ks = subtitle s:mkNamedKeymap c ks
-    in
+keyBindings c = let subKeys s ks = subtitle s:mkNamedKeymap c ks in
     subKeys "System"
     [ ("M-q"   , addName "Restart XMonad"             $ spawn "xmonad-ng --restart")
     , ("M-S-q" , addName "Quit XMonad"                $ confirmPrompt hotPromptTheme "Quit XMonad?" $ io exitSuccess)
@@ -148,10 +147,10 @@ keyBindings c =
     ]
     ^++^
     subKeys "Volume & Music"
-    [ ("<XF86AudioMute>"        , addName "ALSA: Mute"         $ void   toggleMute)
-    , ("<XF86AudioLowerVolume>" , addName "ALSA: Lower volume" $ void $ lowerVolume 5)
-    , ("<XF86AudioRaiseVolume>" , addName "ALSA: Raise volume" $ void $ raiseVolume 5)
-    , ("<XF86AudioPlay>"        , addName "MPD: Play/pause"    $ spawn "~/.xmonad/bin/mpc-play-pause.sh")
+ -- [ ("<XF86AudioMute>"        , addName "ALSA: Mute"         $ void   toggleMute)
+ -- , ("<XF86AudioLowerVolume>" , addName "ALSA: Lower volume" $ void $ lowerVolume 5)
+ -- , ("<XF86AudioRaiseVolume>" , addName "ALSA: Raise volume" $ void $ raiseVolume 5)
+    [ ("<XF86AudioPlay>"        , addName "MPD: Play/pause"    $ spawn "~/.xmonad/bin/mpc-play-pause.sh")
     , ("<XF86AudioStop>"        , addName "MPD: Stop"          $ spawn "mpc --no-status stop")
     , ("<XF86AudioPrev>"        , addName "MPD: Previos track" $ spawn "mpc --no-status prev")
     , ("<XF86AudioNext>"        , addName "MPD: Next track"    $ spawn "mpc --no-status next")
diff --git a/src/XMonad/Custom/Layout.hs b/src/XMonad/Custom/Layout.hs
index 3a0a107..9983b9c 100644
--- a/src/XMonad/Custom/Layout.hs
+++ b/src/XMonad/Custom/Layout.hs
@@ -40,23 +40,16 @@ import           XMonad.Layout.Tabbed
 import           XMonad.Layout.WindowNavigation
 
 applySpacing :: l a -> ModifiedLayout Spacing l a
-applySpacing = spacing gapBase
-
-applyGaps :: l a -> ModifiedLayout Gaps l a
-applyGaps = gaps [ (U, gapBase)
-                 , (D, gapBase)
-                 , (R, gapBase)
-                 , (L, gapBase)
-                 ]
+applySpacing = spacingRaw True (Border 12 12 12 12) True (Border 12 12 12 12) True
 
 data CustomTransformers = GAPS
                         deriving (Read, Show, Eq, Typeable)
 
 instance Transformer CustomTransformers Window where
-    transform GAPS x k = k (avoidStruts $ applyGaps $ applySpacing x) (const x)
+    transform GAPS x k = k (avoidStruts $ applySpacing x) (const x)
 
 layoutHook' = fullscreenFloat
-            $ lessBorders OnlyFloat
+            $ lessBorders OnlyLayoutFloat
             $ mkToggle (single NBFULL)
             $ avoidStruts
             $ mkToggle (single GAPS)
diff --git a/src/XMonad/Custom/Log.hs b/src/XMonad/Custom/Log.hs
index 1bf05f1..4102f6f 100644
--- a/src/XMonad/Custom/Log.hs
+++ b/src/XMonad/Custom/Log.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Custom.Log
@@ -42,10 +44,9 @@ topBarPP = def
     , ppWsSep           = " "
     , ppTitle           = xmobarColor white1 "" . shorten 50
     , ppTitleSanitize   = xmobarStrip
-    , ppLayout          = xmobarColor white1 "" . \x -> case x of -- TODO Generalize string conversion
-                                                            "Spacing 12 Tabbed Hidden BSP" -> "Omni.Gaps"
-                                                            "Tabbed Hidden BSP"            -> "Omni"
-                                                            _                              -> "Misc"
+    , ppLayout          = xmobarColor white1 "" . \case "Spacing 12 Tabbed Hidden BSP" -> "Omni.Gaps"
+                                                        "Tabbed Hidden BSP"            -> "Omni"
+                                                        _                              -> "Misc"
     , ppOrder           = id
     , ppSort            = (namedScratchpadFilterOutWorkspace .) <$> getSortByIndex
     , ppExtras          = []
diff --git a/src/XMonad/Custom/Navigation.hs b/src/XMonad/Custom/Navigation.hs
index 583d5ae..c301219 100644
--- a/src/XMonad/Custom/Navigation.hs
+++ b/src/XMonad/Custom/Navigation.hs
@@ -18,8 +18,8 @@ import           XMonad.Actions.Navigation2D
 
 navigation2DConfig :: Navigation2DConfig
 navigation2DConfig = def
-    { defaultTiledNavigation = hybridNavigation
-    , floatNavigation        = hybridNavigation
+    { defaultTiledNavigation = hybridOf sideNavigation centerNavigation
+    , floatNavigation        = hybridOf lineNavigation centerNavigation
     , layoutNavigation       = [("Full", centerNavigation)]
     , unmappedWindowRect     = [("Full", singleWindowRect)]
     }
diff --git a/src/XMonad/Custom/Startup.hs b/src/XMonad/Custom/Startup.hs
index 592f9b8..68b8fd3 100644
--- a/src/XMonad/Custom/Startup.hs
+++ b/src/XMonad/Custom/Startup.hs
@@ -51,8 +51,8 @@ addEWMHFullscreen = do
 
 startupHook' :: X ()
 startupHook' = do
-    spawnNamedPipe "xmobar ~/work/xmonad-ng/xmobarrcTop.hs" "xmobarTop"
-    spawnNamedPipe "xmobar ~/work/xmonad-ng/xmobarrcBot.hs" "xmobarBot"
+    spawnNamedPipe "xmobar ~/.xmonad/xmobarrcTop.hs" "xmobarTop"
+    spawnNamedPipe "xmobar ~/.xmonad/xmobarrcBot.hs" "xmobarBot"
     docksStartupHook
     addEWMHFullscreen
     setDefaultCursor xC_left_ptr
diff --git a/src/XMonad/Custom/Workspaces.hs b/src/XMonad/Custom/Workspaces.hs
index 881861c..3c15671 100644
--- a/src/XMonad/Custom/Workspaces.hs
+++ b/src/XMonad/Custom/Workspaces.hs
@@ -14,7 +14,27 @@ module XMonad.Custom.Workspaces
     ( workspaces'
     ) where
 
+import           XMonad.Actions.DynamicProjects
 import           XMonad.Core
+import           XMonad.Custom.Misc
 
 workspaces' :: [WorkspaceId]
 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
+              }
+    ]

Consider giving Nix/NixOS a try! <3