Add X.Custom and split existing code in modules

13 files changed, 757 insertions, 628 deletions

diff --git a/src/Main.hs b/src/Main.hs
index edc6af6..74117e4 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,648 +1,58 @@
-{-# LANGUAGE AllowAmbiguousTypes   #-}
-{-# LANGUAGE DeriveDataTypeable    #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeSynonymInstances  #-}
-
 module Main where
 
-import           Control.Monad
-import           Data.Char
-import           Data.Function
-import           Data.List
-import qualified Data.Map                            as M
-import           Data.Maybe
-import           Data.Monoid
-import           Data.Time.Clock
-import           Data.Time.Format
-import           System.Directory
-import           System.Exit
-import           System.FilePath
-import           System.IO
-import           XMonad                              hiding ((|||))
-import qualified XMonad.Actions.ConstrainedResize    as C
-import           XMonad.Actions.CopyWindow
-import           XMonad.Actions.CycleWS
+import           XMonad
 import           XMonad.Actions.DynamicProjects
-import           XMonad.Actions.DynamicWorkspaces
-import qualified XMonad.Actions.FlexibleManipulate   as F
-import           XMonad.Actions.FloatSnap
-import           XMonad.Actions.FloatSnapSpaced
-import           XMonad.Actions.MessageFeedback
 import           XMonad.Actions.Navigation2D
-import           XMonad.Actions.PerConditionKeys
-import           XMonad.Actions.Promote
-import           XMonad.Actions.SinkAll
-import           XMonad.Actions.SpawnOn
-import           XMonad.Actions.Volume
-import           XMonad.Actions.WithAll
-import           XMonad.Hooks.CurrentWorkspaceOnTop
+import qualified XMonad.Custom.Bindings         as Custom
+import qualified XMonad.Custom.Event            as Custom
+import qualified XMonad.Custom.Layout           as Custom
+import qualified XMonad.Custom.Log              as Custom
+import qualified XMonad.Custom.Manage           as Custom
+import qualified XMonad.Custom.Misc             as Custom
+import qualified XMonad.Custom.Navigation       as Custom
+import qualified XMonad.Custom.Projects         as Custom
+import qualified XMonad.Custom.Startup          as Custom
+import qualified XMonad.Custom.Theme            as Custom
+import qualified XMonad.Custom.Workspaces       as Custom
 import           XMonad.Hooks.DynamicLog
-import           XMonad.Hooks.EwmhDesktops           hiding
-                                                      (fullscreenEventHook)
-import           XMonad.Hooks.FloatNext
+import           XMonad.Hooks.EwmhDesktops
 import           XMonad.Hooks.ManageDocks
-import           XMonad.Hooks.ManageHelpers
-import           XMonad.Hooks.SetWMName
 import           XMonad.Hooks.UrgencyHook
-import           XMonad.Layout.Accordion
-import           XMonad.Layout.BinarySpacePartition
-import           XMonad.Layout.ComboP
-import           XMonad.Layout.Decoration
 import           XMonad.Layout.Fullscreen
-import           XMonad.Layout.Gaps
-import           XMonad.Layout.Hidden
-import           XMonad.Layout.LayoutCombinators
-import           XMonad.Layout.MultiToggle
-import           XMonad.Layout.MultiToggle.Instances
-import           XMonad.Layout.NoBorders
-import           XMonad.Layout.Reflect
-import           XMonad.Layout.ResizableTile
-import           XMonad.Layout.Simplest
-import           XMonad.Layout.Spacing
-import           XMonad.Layout.SubLayouts
-import           XMonad.Layout.Tabbed
-import           XMonad.Layout.WindowNavigation
-import           XMonad.Prompt
-import           XMonad.Prompt.ConfirmPrompt
-import           XMonad.Prompt.Pass
-import           XMonad.Prompt.Shell
-import           XMonad.Prompt.Window
-import           XMonad.Prompt.Workspace
-import qualified XMonad.StackSet                     as S
-import           XMonad.Util.Cursor
-import           XMonad.Util.EZConfig
-import           XMonad.Util.Loggers
-import           XMonad.Util.Loggers.NamedScratchpad
+import qualified XMonad.StackSet                as S
 import           XMonad.Util.NamedActions
-import           XMonad.Util.NamedScratchpad
 import           XMonad.Util.NamedWindows
-import           XMonad.Util.PositionStore
 import           XMonad.Util.Run
-import           XMonad.Util.SpawnNamedPipe
-import           XMonad.Util.WorkspaceCompare
-import           XMonad.Util.XSelection
-
-(+++) :: String -> String -> String
-(+++) (x:xs) ys = x:xs ++ " " ++ ys
-(+++) []     ys = ys
-
-myBorderWidth :: Dimension
-myBorderWidth = 1
-
-myBrowser, myNotify, myTerminal :: String -- TODO Pull values with environment variables
-myBrowser  = "/usr/bin/qutebrowser"
-myNotify   = "/usr/bin/notify-send"
-myTerminal = "/usr/bin/urxvtc"
 
-showKeybindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
-showKeybindings a = addName "Show Keybindings" $ io $ do
-    p <- spawnPipe "/usr/bin/zenity --text-info" -- TOOD Find an application that doesn't rely on any toolkits
-    hPutStr p $ unlines $ showKm a
-    hClose p
-    return ()
+data NotifyUrgencyHook = NotifyUrgencyHook
+                       deriving (Read, Show)
 
-data LibnotifyUrgencyHook = LibnotifyUrgencyHook
-                          deriving (Read, Show)
-
-instance UrgencyHook LibnotifyUrgencyHook where
-    urgencyHook LibnotifyUrgencyHook w = do
+instance UrgencyHook NotifyUrgencyHook where
+    urgencyHook NotifyUrgencyHook w = do
         n      <- getName w
         Just i <- S.findTag w <$> gets windowset
-        safeSpawn myNotify [show n, "workspace" +++ wrap "[" "]" i]
+        safeSpawn (Custom.notify Custom.customApplications) [show n, "workspace " ++ wrap "[" "]" i]
 
 main :: IO ()
 main = xmonad $ ewmh
               $ fullscreenSupport
               $ docks
-              $ withUrgencyHook LibnotifyUrgencyHook
-              $ withNavigation2DConfig myNav2DConf
-              $ dynamicProjects myProjects
-              $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) myKeys
-                myXMonadConfig -- TODO Make selection target the last selected W when changing scopes
-
-myNav2DConf :: Navigation2DConfig
-myNav2DConf = def
-    { defaultTiledNavigation = hybridNavigation
-    , floatNavigation        = hybridNavigation
-    , layoutNavigation       = [("Full", centerNavigation)]
-    , unmappedWindowRect     = [("Full", singleWindowRect)]
-    }
-
-myXMonadConfig = def
-    { XMonad.borderWidth        = myBorderWidth
-    , XMonad.workspaces         = myWorkspaces -- TODO save WS state
-    , XMonad.layoutHook         = myLayoutHook -- TODO save layout state and floating W position
-    , XMonad.terminal           = myTerminal
-    , XMonad.normalBorderColor  = myColorN
-    , XMonad.focusedBorderColor = myColorF
-    , XMonad.modMask            = myModMask
-    , XMonad.logHook            = myLogHook
-    , XMonad.startupHook        = myStartupHook
-    , XMonad.mouseBindings      = myMouseBindings
-    , XMonad.manageHook         = myManageHook
-    , XMonad.handleEventHook    = myHandleEventHook
-    , XMonad.focusFollowsMouse  = myFocusFollowsMouse
-    , XMonad.clickJustFocuses   = myClickJustFocuses
-    }
-
-myFocusFollowsMouse, myClickJustFocuses :: Bool
-myFocusFollowsMouse = False
-myClickJustFocuses  = False
-
-wsCHAT = "CHA" :: String
-wsM1   = "M/1" :: String
-wsM2   = "M/2" :: String
-wsM3   = "M/3" :: String
-wsT    = "TER" :: String
-wsW1   = "W/1" :: String
-wsW2   = "W/2" :: String
-wsW3   = "W/3" :: String
-wsWWW  = "WWW" :: String
-
-myWorkspaces :: [WorkspaceId]
-myWorkspaces = map show [1 .. 9 :: Int]
-
-myProjects :: [Project]
-myProjects =
-    [ Project { projectName      = "Template"
-              , projectDirectory = "~/"
-              , projectStartHook = Nothing
-              }
-
-    , Project { projectName      = wsW1
-              , projectDirectory = "~/"
-              , projectStartHook = Just $ do spawnOn wsW1 myTerminal
-                                             spawnOn wsW1 myTerminal
-              }
-
-    , Project { projectName      = wsW2
-              , projectDirectory = "~/"
-              , projectStartHook = Just $ do spawnOn wsW2 myTerminal
-                                             spawnOn wsW2 myTerminal
-              }
-
-    , Project { projectName      = wsW3
-              , projectDirectory = "~/"
-              , projectStartHook = Just $ do spawnOn wsW3 myTerminal
-                                             spawnOn wsW3 myTerminal
-              }
-
-    , Project { projectName      = wsWWW
-              , projectDirectory = "~/"
-              , projectStartHook = Just $    spawnOn wsWWW myBrowser
-              }
-    ]
-
-myFont :: String
-myFont = "xft:lucy tewi:style=Regular:size=8" -- TODO CJKのフォールバックフォントを追加する
-
-black1   = "#0b0806" :: String -- TODO get variables from Xresources
-black2   = "#2f2b2a" :: String
-red1     = "#844d2c" :: String
-red2     = "#a64848" :: String
-green1   = "#57553a" :: String
-green2   = "#897f5a" :: String
-yellow1  = "#a17c38" :: String
-yellow2  = "#c8b38d" :: String
-blue1    = "#41434f" :: String
-blue2    = "#526274" :: String
-magenta1 = "#6b4444" :: String
-magenta2 = "#755c47" :: String
-cyan1    = "#59664c" :: String
-cyan2    = "#718062" :: String
-white1   = "#a19782" :: String
-white2   = "#c1ab83" :: String
-
-myColorN, myColorF :: String
-myColorN = black2
-myColorF = white2
-
-baseInt, fullInt :: Int
-baseInt = 12
-fullInt = baseInt * 2
-
-fullDim :: Dimension
-fullDim = 12 * 2
-
-myTabTheme :: Theme
-myTabTheme = def
-    { activeColor         = black1
-    , inactiveColor       = black2
-    , urgentColor         = red1
-    , activeBorderColor   = white1
-    , inactiveBorderColor = white2
-    , urgentBorderColor   = red2
-    , activeTextColor     = white1
-    , inactiveTextColor   = white2
-    , urgentTextColor     = red2
-    , fontName            = myFont
-    , decoHeight          = fullDim
-    }
-
-myPromptTheme, myHotPromptTheme :: XPConfig
-myPromptTheme = def
-    { font              = myFont
-    , bgColor           = black1
-    , fgColor           = white1
-    , fgHLight          = white2
-    , bgHLight          = black2
-    , borderColor       = white2
-    , promptBorderWidth = myBorderWidth
-    , position          = Bottom
-    , height            = fullDim
-    , searchPredicate   = isInfixOf `on` map toLower
-    }
-myHotPromptTheme = myPromptTheme
-    { bgColor           = black2
-    , fgColor           = white2
-    , fgHLight          = white1
-    , bgHLight          = black1
-    }
-
-mySpacing :: l a -> ModifiedLayout Spacing l a
-mySpacing = spacing baseInt
-
-myGaps :: l a -> ModifiedLayout Gaps l a
-myGaps = gaps [ (U, baseInt)
-              , (D, baseInt)
-              , (R, baseInt)
-              , (L, baseInt)
-              ]
-
-data MyTransformers = GAPS
-                    deriving (Read, Show, Eq, Typeable)
-
-instance Transformer MyTransformers Window where
-    transform GAPS x k = k (avoidStruts $ myGaps $ mySpacing x) (const x)
-
-myLayoutHook = fullscreenFloat
-             $ lessBorders OnlyFloat
-             $ mkToggle (single NBFULL)
-             $ avoidStruts
-             $ mkToggle (single GAPS)
-             $ mkToggle (single REFLECTX)
-             $ mkToggle (single REFLECTY)
-             $ windowNavigation
-             $ addTabs shrinkText myTabTheme
-             $ hiddenWindows
-             $ subLayout [] (Simplest ||| Accordion) -- TODO Proper bindings
-               emptyBSP
-
-myModMask :: KeyMask
-myModMask = mod4Mask
-
-myKeys :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
-myKeys config = let
-    subKeys :: String -> [(String, NamedAction)] -> [((KeyMask, KeySym), NamedAction)]
-    subKeys s ks = subtitle s:mkNamedKeymap config ks
-
-    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]
-
-    zipM  :: [a] -> String -> [[a]] -> [t] -> (t ->       X ()) ->       [([a], NamedAction)]
-    zipM  m nm ks as f   = zipWith (\k d -> (m ++ k, addName nm $ f d))   ks as
-    zipM' :: [a] -> String -> [[a]] -> [t] -> (t -> t1 -> X ()) -> t1 -> [([a], NamedAction)]
-    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]
-
-    unsafeSelectionNotify :: MonadIO m => String -> m ()
-    unsafeSelectionNotify a = join
-                            $ io
-                            $ (unsafeSpawn . (\x -> a +++ "Clipboard" +++ wrap "\"\\\"" "\"\\\"" x))
-                              <$> getSelection
-
-    toggleCopyToAll :: X ()
-    toggleCopyToAll = wsContainingCopies >>= \x -> case x of
-                                                        [] -> 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
-
-    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)
-
-    in
-
-    subKeys "System"
-    [ ("M-q"    , addName "Restart XMonad"             $ spawn "/usr/bin/xmonad --restart")
-    , ("M-C-q"  , addName "Recompile & restart XMonad" $ spawn "/usr/bin/xmonad --recompile && /usr/bin/xmonad --restart")
-    , ("M-S-q"  , addName "Quit XMonad"                $ confirmPrompt myHotPromptTheme "Quit XMonad?" $ io exitSuccess)
-    , ("M-x"    , addName "Shell prompt"               $ shellPrompt myPromptTheme)
-    , ("M-o"    , addName "Goto W prompt"              $ windowPrompt myPromptTheme Goto allWindows)
-    , ("M-S-o"  , addName "Bring W prompt"             $ windowPrompt myPromptTheme Bring allWindows)
-    ]
-
-    ^++^
-    subKeys "Actions"
-    [ ("M-C-g"             , addName "Cancel"                                    $ return ())
-    , ("<XF86ScreenSaver>" , addName "Lock screen"                               $ spawn "~/.xmonad/bin/\
-                                                                                         \screenlock.sh")
-    , ("M-S-c"             , addName "Print clipboard content"                   $ unsafeSelectionNotify myNotify)
-    , ("M-<Print>"         , addName "Take a screenshot of the current WS, \
-                                     \upload it and copy link to the buffer"     $ spawn "~/.xmonad/bin/\
-                                                                                         \xshot-upload.sh")
-    , ("M-S-<Print>"       , addName "Take a screenshot of the selected area, \
-                                     \upload it and copy link to the buffer"     $ spawn "~/.xmonad/bin/\
-                                                                                         \xshot-select-upload.sh")
-    , ("M-<Insert>"        , addName "Start recording screen as webm"            $ spawn "~/.xmonad/bin/\
-                                                                                         \xcast.sh --webm")
-    , ("M-S-<Insert>"      , addName "Start recording screen as gif"             $ spawn "~/.xmonad/bin/\
-                                                                                         \xcast.sh --gif")
-    , ("M-C-<Insert>"      , addName "Stop recording"                            $ spawn "/usr/bin/pkill ffmpeg")
-    , ("M-C-c"             , addName "Toggle compton on/off"                     $ spawn "~/.xmonad/bin/\
-                                                                                         \toggle-compton.sh")
-    , ("M-C-r"             , addName "Toggle redshift on/off"                    $ spawn "~/.xmonad/bin/\
-                                                                                         \toggle-redshift.sh")
-    , ("M-C-p"             , addName "Toggle touchpad on/off"                    $ spawn "~/.xmonad/bin/\
-                                                                                             \toggle-touchpad.sh")
-    , ("M-C-t"             , addName "Toggle trackpoint on/off"                  $ spawn "~/.xmonad/bin/\
-                                                                                         \toggle-trackpoint.sh")
-    ]
-
-    ^++^
-    subKeys "Volume & Music" -- TODO replace play/pause script with Haskell implementation
-    [ ("<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 "/usr/bin/mpc --no-status stop")
-    , ("<XF86AudioPrev>"        , addName "MPD: Previos track" $ spawn "/usr/bin/mpc --no-status prev")
-    , ("<XF86AudioNext>"        , addName "MPD: Next track"    $ spawn "/usr/bin/mpc --no-status next")
-    ]
-
-    ^++^
-    subKeys "Spawnables"
-    [ ("M-<Return>" , addName "Terminal"         $ spawn myTerminal)
-    , ("M-b"        , addName "Browser"          $ spawn myBrowser)
-    , ("M-S-p"      , addName "Pass prompt"      $ passPrompt myPromptTheme)
-    , ("M-c"        , addName "NSP Console"      $ namedScratchpadAction myScratchpads "console")
-    , ("M-m"        , addName "NSP Music"        $ namedScratchpadAction myScratchpads "music")
-    , ("M-t"        , addName "NSP Top"          $ namedScratchpadAction myScratchpads "top")
-    , ("M-v"        , addName "NSP Volume"       $ namedScratchpadAction myScratchpads "volume")
-    ]
-
-    ^++^
-    subKeys "Windows"
-    ( [ ("M-d"     , addName "Kill W"                     kill)
-      , ("M-S-d"   , addName "Kill all W on WS"         $ confirmPrompt myHotPromptTheme "Kill all" killAll)
-      , ("M-C-d"   , addName "Duplicate W to all WS"      toggleCopyToAll)
-      , ("M-a"     , addName "Hide W"                   $ withFocused hideWindow) -- FIXME This is so broken
-      , ("M-S-a"   , addName "Restore hidden W"           popOldestHiddenWindow)
-      , ("M-p"     , addName "Promote W"                  promote)
-      , ("M-s"     , addName "Merge W from sublayout"   $ withFocused $ sendMessage . MergeAll)
-      , ("M-S-s"   , addName "Unmerge W from sublayout" $ withFocused $ sendMessage . UnMerge)
-      , ("M-u"     , addName "Focus urgent W"             focusUrgent)
-      , ("M-e"     , addName "Focus master W"           $ windows S.focusMaster)
-      , ("M-'"     , addName "Navigate tabbed W -> D"   $ bindOn LD [ ("Tabs" , windows S.focusDown)
-                                                                    , (""     , onGroup S.focusDown')
-                                                                    ])
-      , ("M-;"     , addName "Navigate tabbed W -> U"   $ bindOn LD [ ("Tabs" , windows S.focusUp)
-                                                                    , (""     , onGroup S.focusUp')
-                                                                    ])
-      , ("M-S-'"   , addName "Swap tabbed W -> D"       $ windows S.swapDown)
-      , ("M-S-;"   , addName "Swap tabbed W -> U"       $ windows S.swapUp)
-      ]
-
-      ++ zipM' "M-"   "Navigate W"             directionKeys directions windowGo   True -- TODO W moving
-      ++ zipM' "M-S-" "Swap W"                 directionKeys directions windowSwap True
-      ++ zipM  "M-C-" "Merge W with sublayout" directionKeys directions (sendMessage . pullGroup)
-
-      ++ zipM' "M-"   "Navigate screen"        arrowKeys directions screenGo       True
-      ++ zipM' "M-S-" "Move W to screen"       arrowKeys directions windowToScreen True
-      ++ zipM' "M-C-" "Swap W to screen"       arrowKeys directions screenSwap     True
-    )
-
-    ^++^
-    subKeys "Workspaces & Projects"
-    ( [ ("M-w"   , addName "Switch to project"     $ switchProjectPrompt  myPromptTheme)
-      , ("M-S-w" , addName "Shift to project"      $ shiftToProjectPrompt myPromptTheme)
-      , ("M-,"   , addName "Next non-empty WS"       nextNonEmptyWS)
-      , ("M-."   , addName "Previous non-empty WS"   prevNonEmptyWS)
-      , ("M-i"   , addName "Toggle last WS"        $ toggleWS' ["NSP"])
-      , ("M-`"   , addName "WS prompt"             $ workspacePrompt myPromptTheme $ windows . S.shift)
-      ]
-
-      ++ zipM "M-"     "View WS"      wsKeys [0 ..] (withNthWorkspace S.greedyView)
-      ++ zipM "M-S-"   "Move W to WS" wsKeys [0 ..] (withNthWorkspace S.shift)
-      ++ zipM "M-C-S-" "Copy W to WS" wsKeys [0 ..] (withNthWorkspace copy)
-    )
-
-    ^++^
-    subKeys "Layout Management"
-    [ ("M-<Tab>"   , addName "Cycle layouts"            $ sendMessage NextLayout)
-    , ("M-C-<Tab>" , addName "Cycle sublayouts"         $ toSubl NextLayout)
-    , ("M-S-<Tab>" , addName "Reset layout"             $ setLayout $ XMonad.layoutHook config)
-    , ("M-y"       , addName "Toggle float/tile on W"   $ withFocused toggleFloat)
-    , ("M-S-y"     , addName "Tile all floating W"        sinkAll)
-    , ("M-S-,"     , addName "Decrease maximum W count" $ sendMessage $ IncMasterN (-1))
-    , ("M-S-."     , addName "Increase maximum W count" $ sendMessage $ IncMasterN 1)
-    , ("M-r"       , addName "Rotate/reflect W"         $ tryMessageR_ Rotate (Toggle REFLECTX))
-    , ("M-S-r"     , addName "Reflect W"                $ sendMessage $ Toggle REFLECTX)
-    , ("M-f"       , addName "Toggle fullscreen layout" $ sequence_ [ withFocused $ windows . S.sink
-                                                                    , sendMessage $ Toggle NBFULL
-                                                                    ])
-    , ("M-S-g"     , addName "Toggle gapped layout"     $ sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout
-    ]
-
-    ^++^
-    subKeys "Resize"
-    [ ("M-["     , addName "Expand L" $ tryMessageR_ (ExpandTowards L) Shrink)
-    , ("M-]"     , addName "Expand R" $ tryMessageR_ (ExpandTowards R) Expand)
-    , ("M-S-["   , addName "Expand U" $ tryMessageR_ (ExpandTowards U) MirrorShrink)
-    , ("M-S-]"   , addName "Expand D" $ tryMessageR_ (ExpandTowards D) MirrorExpand)
-    , ("M-C-["   , addName "Shrink L" $ tryMessageR_ (ShrinkFrom    R) Shrink)
-    , ("M-C-]"   , addName "Shrink R" $ tryMessageR_ (ShrinkFrom    L) Expand)
-    , ("M-S-C-[" , addName "Shrink U" $ tryMessageR_ (ShrinkFrom    D) MirrorShrink)
-    , ("M-S-C-]" , addName "Shrink D" $ tryMessageR_ (ShrinkFrom    U) MirrorExpand)
-    ]
-
-myScratchpads :: [NamedScratchpad]
-myScratchpads =
-    [ NS "console"
-         (spawnTerminalWith "NSPConsole" "~/.xmonad/bin/nsp-console.sh")
-         (title =? "NSPConsole")
-         floatingNSP
-    , NS "volume"
-         (spawnTerminalWith "NSPVolume" "/usr/bin/alsamixer")
-         (title =? "NSPVolume")
-         floatingNSP
-    , NS "music"
-         (spawnTerminalWith "NSPMusic" "~/.bin/mp")
-         (title =? "NSPMusic")
-         floatingNSP
-    , NS "top"
-         (spawnTerminalWith "NSPTop" "/usr/bin/htop")
-         (title =? "NSPTop")
-         floatingNSP
-    ]
-    where
-        spawnTerminalWith :: String -> String -> String
-        spawnTerminalWith t c = myTerminal +++ "-title" +++ t +++ "-e" +++ c
-
-        floatingNSP :: ManageHook
-        floatingNSP = customFloating $ S.RationalRect x y w h
-        x = (1 - w) / 2
-        y = (1 - h) / 2
-        w = 1 / 2
-        h = 1 / 2.5
-
-xmobarFont :: Int -> String -> String
-xmobarFont fn = wrap (concat ["<fn=", show fn, ">"]) "</fn>"
-
-myTopBarPP :: PP
-myTopBarPP = def
-    { ppCurrent         = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "="
-    , ppVisible         = xmobarColor white1 ""                . wrap "~" "~"
-    , ppHidden          = xmobarColor white1 ""                . wrap "-" "-"
-    , ppHiddenNoWindows = xmobarColor white1 ""                . wrap "_" "_"
-    , ppUrgent          = xmobarColor red1   ""                . wrap "!" "!"
-    , ppSep             = " / "
-    , ppWsSep           = " "
-    , ppTitle           = xmobarColor white1 "" . shorten 50
-    , ppTitleSanitize   = xmobarStrip
-    , ppLayout          = xmobarColor white1 "" . \x -> case x of
-                                                             "Spacing 12 Tabbed Hidden BSP" -> "Omni.Gaps"
-                                                             "Tabbed Hidden BSP"            -> "Omni"
-                                                             _                              -> "Misc"
-    , ppOrder           = id
-    , ppSort            = (namedScratchpadFilterOutWorkspace .) <$> getSortByIndex
-    , ppExtras          = []
-    }
-
-myBotBarPP :: PP
-myBotBarPP = myTopBarPP
-    { ppCurrent         = const ""
-    , ppVisible         = const ""
-    , ppHidden          = const ""
-    , ppHiddenNoWindows = const ""
-    , ppUrgent          = const ""
-    , ppTitle           = const ""
-    , ppLayout          = const ""
-    }
-
-myLogHook :: X ()
-myLogHook = do
-    currentWorkspaceOnTop
-    ewmhDesktopsLogHook
-    b1 <- getNamedPipe "xmobarTop"
-    b2 <- 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 $ myTopBarPP
-        { ppCurrent = copiesCurrent
-        , ppHidden  = copiesHidden
-        , ppUrgent  = copiesUrgent
-        , ppOutput  = safePrintToPipe b1
-        }
-    dynamicLogWithPP $ myBotBarPP
-        { ppOutput  = safePrintToPipe b2
-        }
-    where
-        safePrintToPipe :: Maybe Handle -> String -> IO ()
-        safePrintToPipe = maybe (\_ -> return ()) hPutStrLn
-
-addNETSupported :: Atom -> X ()
-addNETSupported x = withDisplay $ \d -> do
-    r  <- asks theRoot
-    ns <- getAtom "_NET_SUPPORTED"
-    a  <- getAtom "ATOM"
-    liftIO $ do
-        s <- (join . maybeToList) <$> getWindowProperty32 d ns r
-        when (fromIntegral x `notElem` s) $ changeProperty32 d r ns a propModeAppend [fromIntegral x]
-
-addEWMHFullscreen :: X ()
-addEWMHFullscreen = do
-    s <- mapM getAtom atoms
-    mapM_ addNETSupported s
-    where
-        atoms :: [String]
-        atoms = [ "_NET_ACTIVE_WINDOW"
-                , "_NET_CLIENT_LIST"
-                , "_NET_CLIENT_LIST_STACKING"
-                , "_NET_DESKTOP_NAMES"
-                , "_NET_WM_DESKTOP"
-                , "_NET_WM_STATE"
-                , "_NET_WM_STATE_FULLSCREEN"
-                , "_NET_WM_STATE_HIDDEN"
-                , "_NET_WM_STRUT"
-                ]
-
-myStartupHook :: X ()
-myStartupHook = do
-    startupHook def
-    spawnNamedPipe "/usr/bin/xmobar ~/.xmonad/xmobarrcTop.hs" "xmobarTop"
-    spawnNamedPipe "/usr/bin/xmobar ~/.xmonad/xmobarrcBot.hs" "xmobarBot"
-    nspTrackStartup myScratchpads -- TODO
-    docksStartupHook
-    addEWMHFullscreen
-    setDefaultCursor xC_left_ptr
-    setWMName "xmonad"
-
-myMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) -- TODO implement snapSpacedMagicResize
-myMouseBindings XConfig {XMonad.modMask = m} = M.fromList
-    [ ((m,               button1), \w -> focus w >> F.mouseWindow F.position w
-                                                 >> ifClick (snapSpacedMagicMove fullInt  (Just 50) (Just 50) w)
-                                                 >> windows S.shiftMaster
-      )
-    , ((m .|. shiftMask, button1), \w -> focus w >> C.mouseResizeWindow w True
-                                                 >> ifClick (snapMagicResize [L, R, U, D] (Just 50) (Just 50) w)
-                                                 >> windows S.shiftMaster
-      )
-    , ((m,               button3), \w -> focus w >> F.mouseWindow F.linear w
-                                                 >> ifClick (snapMagicResize [L, R]       (Just 50) (Just 50) w)
-                                                 >> windows S.shiftMaster
-      )
-    , ((m .|. shiftMask, button3), \w -> focus w >> C.mouseResizeWindow w True
-                                                 >> ifClick (snapMagicResize [U, D]       (Just 50) (Just 50) w)
-                                                 >> windows S.shiftMaster
-      )
-    ]
-
-myManageHook :: ManageHook
-myManageHook = manageHook def
-           <+> manageDocks
-           <+> fullscreenManageHook
-           <+> namedScratchpadManageHook myScratchpads
-           <+> composeOne composeActions
-    where
-        composeActions :: [MaybeManageHook]
-        composeActions = [ isFullscreen                                       -?> doFullFloat
-                         , className =? "explorer.exe"                        -?> doFullFloat
-                         , isDialog                                           -?> doCenterFloat
-                         , className =? "Xmessage"                            -?> doCenterFloat
-                         , className =? "Zenity"                              -?> doCenterFloat
-                         , className =? "qemu-system-x86"                     -?> doCenterFloat
-                         , className =? "qemu-system-x86_64"                  -?> doCenterFloat
-                         , className =? "Steam" <&&> not <$> title =? "Steam" -?> doFloat
-                         ]
-
-myHandleEventHook :: Event -> X All
-myHandleEventHook = handleEventHook def
-                <+> nspTrackHook myScratchpads
-                <+> docksEventHook
-                <+> fullscreenEventHook
-
--- vim:filetype=haskell:expandtab:tabstop=4:shiftwidth=4
+              $ withUrgencyHook NotifyUrgencyHook
+              $ withNavigation2DConfig Custom.navigation2DConfig
+              $ dynamicProjects Custom.projects
+              $ addDescrKeys' ((Custom.modMask', xK_F1), Custom.showKeyBindings) Custom.keyBindings
+              $ def { borderWidth        = Custom.border
+                    , workspaces         = Custom.workspaces' -- TODO save WS state
+                    , layoutHook         = Custom.layoutHook' -- TODO save layout state and floating W position
+                    , terminal           = Custom.term Custom.customApplications
+                    , normalBorderColor  = Custom.colorN
+                    , focusedBorderColor = Custom.colorF
+                    , modMask            = Custom.modMask'
+                    , logHook            = Custom.logHook'
+                    , startupHook        = Custom.startupHook'
+                    , mouseBindings      = Custom.mouseBindings'
+                    , manageHook         = Custom.manageHook'
+                    , handleEventHook    = Custom.handleEventHook'
+                    , focusFollowsMouse  = False
+                    , clickJustFocuses   = False
+                    }
diff --git a/src/XMonad/Custom/Bindings.hs b/src/XMonad/Custom/Bindings.hs
new file mode 100644
index 0000000..fd59e88
--- /dev/null
+++ b/src/XMonad/Custom/Bindings.hs
@@ -0,0 +1,255 @@
+module XMonad.Custom.Bindings
+    ( showKeyBindings
+    , modMask'
+    , keyBindings
+    , mouseBindings'
+    ) where
+
+import           Control.Monad
+import qualified Data.Map                            as M
+import           System.Exit
+import           System.IO
+import           XMonad
+import           XMonad.Actions.CopyWindow
+import qualified XMonad.Actions.ConstrainedResize as C
+import           XMonad.Actions.CycleWS
+import qualified XMonad.Actions.FlexibleManipulate as F
+import           XMonad.Actions.DynamicProjects
+import XMonad.Actions.FloatSnap
+import           XMonad.Actions.DynamicWorkspaces
+import           XMonad.Actions.FloatSnapSpaced
+import           XMonad.Actions.MessageFeedback
+import           XMonad.Actions.Navigation2D
+import           XMonad.Actions.PerConditionKeys
+import           XMonad.Actions.Promote
+import           XMonad.Actions.Volume
+import           XMonad.Actions.WithAll
+import           XMonad.Custom.Layout
+import qualified XMonad.Custom.Misc                  as CM
+import           XMonad.Custom.Scratchpads
+import           XMonad.Custom.Theme
+import           XMonad.Hooks.DynamicLog
+import           XMonad.Hooks.UrgencyHook
+import           XMonad.Layout.BinarySpacePartition
+import           XMonad.Layout.Hidden
+import           XMonad.Layout.MultiToggle
+import           XMonad.Layout.MultiToggle.Instances
+import           XMonad.Layout.Reflect
+import           XMonad.Layout.ResizableTile
+import           XMonad.Layout.SubLayouts
+import           XMonad.Prompt.ConfirmPrompt
+import           XMonad.Prompt.Pass
+import           XMonad.Prompt.Shell
+import           XMonad.Prompt.Window
+import           XMonad.Prompt.Workspace
+import qualified XMonad.StackSet                     as S
+import           XMonad.Util.EZConfig
+import           XMonad.Util.NamedActions
+import           XMonad.Util.NamedScratchpad
+import           XMonad.Util.Run
+import           XMonad.Util.WorkspaceCompare
+import           XMonad.Util.XSelection
+
+showKeyBindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
+showKeyBindings a = addName "Show Keybindings" $ io $ do
+    p <- spawnPipe "/usr/bin/zenity --text-info" -- TOOD Find an application that doesn't rely on any toolkits
+    hPutStr p $ unlines $ showKm a
+    hClose p
+    return ()
+
+modMask' :: KeyMask
+modMask' = mod4Mask
+
+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]
+
+zipM  :: [a] -> String -> [[a]] -> [t] -> (t ->       X ()) ->       [([a], NamedAction)]
+zipM  m nm ks as f   = zipWith (\k d -> (m ++ k, addName nm $ f d))   ks as
+zipM' :: [a] -> String -> [[a]] -> [t] -> (t -> t1 -> X ()) -> t1 -> [([a], NamedAction)]
+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]
+
+xSelectionNotify :: MonadIO m => m ()
+xSelectionNotify = join
+                 $ io
+                 $ (unsafeSpawn . (\x -> CM.notify CM.customApplications ++ " Clipboard " ++ wrap "\"\\\"" "\"\\\"" x))
+                   <$> getSelection
+
+toggleCopyToAll :: X ()
+toggleCopyToAll = wsContainingCopies >>= \x -> case x of
+                                                    [] -> 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
+
+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)
+
+keyBindings :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
+keyBindings c = let subKeys s ks = subtitle s:mkNamedKeymap c ks in
+    subKeys "System"
+    [ ("M-q"    , addName "Restart XMonad"             $ spawn "/usr/bin/xmonad --restart")
+    , ("M-C-q"  , addName "Recompile & restart XMonad" $ spawn "/usr/bin/xmonad --recompile && /usr/bin/xmonad --restart")
+    , ("M-S-q"  , addName "Quit XMonad"                $ confirmPrompt hotPromptTheme "Quit XMonad?" $ io exitSuccess)
+    , ("M-x"    , addName "Shell prompt"               $ shellPrompt promptTheme)
+    , ("M-o"    , addName "Goto W prompt"              $ windowPrompt promptTheme Goto allWindows)
+    , ("M-S-o"  , addName "Bring W prompt"             $ windowPrompt promptTheme Bring allWindows)
+    ]
+
+    ^++^
+    subKeys "Actions"
+    [ ("M-C-g"             , addName "Cancel"                                    $ return ())
+    , ("<XF86ScreenSaver>" , addName "Lock screen"                               $ spawn "~/.xmonad/bin/\
+                                                                                         \screenlock.sh")
+    , ("M-S-c"             , addName "Print clipboard content"                     xSelectionNotify)
+    , ("M-<Print>"         , addName "Take a screenshot of the current WS, \
+                                     \upload it and copy link to the buffer"     $ spawn "~/.xmonad/bin/\
+                                                                                         \xshot-upload.sh")
+    , ("M-S-<Print>"       , addName "Take a screenshot of the selected area, \
+                                     \upload it and copy link to the buffer"     $ spawn "~/.xmonad/bin/\
+                                                                                         \xshot-select-upload.sh")
+    , ("M-<Insert>"        , addName "Start recording screen as webm"            $ spawn "~/.xmonad/bin/\
+                                                                                         \xcast.sh --webm")
+    , ("M-S-<Insert>"      , addName "Start recording screen as gif"             $ spawn "~/.xmonad/bin/\
+                                                                                         \xcast.sh --gif")
+    , ("M-C-<Insert>"      , addName "Stop recording"                            $ spawn "/usr/bin/pkill ffmpeg")
+    , ("M-C-c"             , addName "Toggle compton on/off"                     $ spawn "~/.xmonad/bin/\
+                                                                                         \toggle-compton.sh")
+    , ("M-C-r"             , addName "Toggle redshift on/off"                    $ spawn "~/.xmonad/bin/\
+                                                                                         \toggle-redshift.sh")
+    , ("M-C-p"             , addName "Toggle touchpad on/off"                    $ spawn "~/.xmonad/bin/\
+                                                                                             \toggle-touchpad.sh")
+    , ("M-C-t"             , addName "Toggle trackpoint on/off"                  $ spawn "~/.xmonad/bin/\
+                                                                                         \toggle-trackpoint.sh")
+    ]
+
+    ^++^
+    subKeys "Volume & Music" -- TODO replace play/pause script with Haskell implementation
+    [ ("<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 "/usr/bin/mpc --no-status stop")
+    , ("<XF86AudioPrev>"        , addName "MPD: Previos track" $ spawn "/usr/bin/mpc --no-status prev")
+    , ("<XF86AudioNext>"        , addName "MPD: Next track"    $ spawn "/usr/bin/mpc --no-status next")
+    ]
+
+    ^++^
+    subKeys "Spawnables"
+    [ ("M-<Return>" , addName "Terminal"         $ spawn (CM.term CM.customApplications))
+    , ("M-b"        , addName "Browser"          $ spawn (CM.browser CM.customApplications))
+    , ("M-S-p"      , addName "Pass prompt"      $ passPrompt promptTheme)
+    , ("M-c"        , addName "NSP Console"      $ namedScratchpadAction scratchpads "console")
+    , ("M-m"        , addName "NSP Music"        $ namedScratchpadAction scratchpads "music")
+    , ("M-t"        , addName "NSP Top"          $ namedScratchpadAction scratchpads "top")
+    , ("M-v"        , addName "NSP Volume"       $ namedScratchpadAction scratchpads "volume")
+    ]
+
+    ^++^
+    subKeys "Windows"
+    ( [ ("M-d"     , addName "Kill W"                     kill)
+      , ("M-S-d"   , addName "Kill all W on WS"         $ confirmPrompt hotPromptTheme "Kill all" killAll)
+      , ("M-C-d"   , addName "Duplicate W to all WS"      toggleCopyToAll)
+      , ("M-a"     , addName "Hide W"                   $ withFocused hideWindow) -- FIXME This is so broken
+      , ("M-S-a"   , addName "Restore hidden W"           popOldestHiddenWindow)
+      , ("M-p"     , addName "Promote W"                  promote)
+      , ("M-s"     , addName "Merge W from sublayout"   $ withFocused $ sendMessage . MergeAll)
+      , ("M-S-s"   , addName "Unmerge W from sublayout" $ withFocused $ sendMessage . UnMerge)
+      , ("M-u"     , addName "Focus urgent W"             focusUrgent)
+      , ("M-e"     , addName "Focus master W"           $ windows S.focusMaster)
+      , ("M-'"     , addName "Navigate tabbed W -> D"   $ bindOn LD [ ("Tabs" , windows S.focusDown)
+                                                                    , (""     , onGroup S.focusDown')
+                                                                    ])
+      , ("M-;"     , addName "Navigate tabbed W -> U"   $ bindOn LD [ ("Tabs" , windows S.focusUp)
+                                                                    , (""     , onGroup S.focusUp')
+                                                                    ])
+      , ("M-S-'"   , addName "Swap tabbed W -> D"       $ windows S.swapDown)
+      , ("M-S-;"   , addName "Swap tabbed W -> U"       $ windows S.swapUp)
+      ]
+
+      ++ zipM' "M-"   "Navigate W"             directionKeys directions windowGo   True -- TODO W moving
+      ++ zipM' "M-S-" "Swap W"                 directionKeys directions windowSwap True
+      ++ zipM  "M-C-" "Merge W with sublayout" directionKeys directions (sendMessage . pullGroup)
+
+      ++ zipM' "M-"   "Navigate screen"        arrowKeys directions screenGo       True
+      ++ zipM' "M-S-" "Move W to screen"       arrowKeys directions windowToScreen True
+      ++ zipM' "M-C-" "Swap W to screen"       arrowKeys directions screenSwap     True
+    )
+
+    ^++^
+    subKeys "Workspaces & Projects"
+    ( [ ("M-w"   , addName "Switch to project"     $ switchProjectPrompt  promptTheme)
+      , ("M-S-w" , addName "Shift to project"      $ shiftToProjectPrompt promptTheme)
+      , ("M-,"   , addName "Next non-empty WS"       nextNonEmptyWS)
+      , ("M-."   , addName "Previous non-empty WS"   prevNonEmptyWS)
+      , ("M-i"   , addName "Toggle last WS"        $ toggleWS' ["NSP"])
+      , ("M-`"   , addName "WS prompt"             $ workspacePrompt promptTheme $ windows . S.shift)
+      ]
+
+      ++ zipM "M-"     "View WS"      wsKeys [0 ..] (withNthWorkspace S.greedyView)
+      ++ zipM "M-S-"   "Move W to WS" wsKeys [0 ..] (withNthWorkspace S.shift)
+      ++ zipM "M-C-S-" "Copy W to WS" wsKeys [0 ..] (withNthWorkspace copy)
+    )
+
+    ^++^
+    subKeys "Layout Management"
+    [ ("M-<Tab>"   , addName "Cycle layouts"            $ sendMessage NextLayout)
+    , ("M-C-<Tab>" , addName "Cycle sublayouts"         $ toSubl NextLayout)
+    , ("M-S-<Tab>" , addName "Reset layout"             $ setLayout $ XMonad.layoutHook c)
+    , ("M-y"       , addName "Toggle float/tile on W"   $ withFocused toggleFloat)
+    , ("M-S-y"     , addName "Tile all floating W"        sinkAll)
+    , ("M-S-,"     , addName "Decrease maximum W count" $ sendMessage $ IncMasterN (-1))
+    , ("M-S-."     , addName "Increase maximum W count" $ sendMessage $ IncMasterN 1)
+    , ("M-r"       , addName "Rotate/reflect W"         $ tryMessageR_ Rotate (Toggle REFLECTX))
+    , ("M-S-r"     , addName "Reflect W"                $ sendMessage $ Toggle REFLECTX)
+    , ("M-f"       , addName "Toggle fullscreen layout" $ sequence_ [ withFocused $ windows . S.sink
+                                                                    , sendMessage $ Toggle NBFULL
+                                                                    ])
+    , ("M-S-g"     , addName "Toggle gapped layout"     $ sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout
+    ]
+
+    ^++^
+    subKeys "Resize"
+    [ ("M-["     , addName "Expand L" $ tryMessageR_ (ExpandTowards L) Shrink)
+    , ("M-]"     , addName "Expand R" $ tryMessageR_ (ExpandTowards R) Expand)
+    , ("M-S-["   , addName "Expand U" $ tryMessageR_ (ExpandTowards U) MirrorShrink)
+    , ("M-S-]"   , addName "Expand D" $ tryMessageR_ (ExpandTowards D) MirrorExpand)
+    , ("M-C-["   , addName "Shrink L" $ tryMessageR_ (ShrinkFrom    R) Shrink)
+    , ("M-C-]"   , addName "Shrink R" $ tryMessageR_ (ShrinkFrom    L) Expand)
+    , ("M-S-C-[" , addName "Shrink U" $ tryMessageR_ (ShrinkFrom    D) MirrorShrink)
+    , ("M-S-C-]" , addName "Shrink D" $ tryMessageR_ (ShrinkFrom    U) MirrorExpand)
+    ]
+
+mouseBindings' :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
+mouseBindings' XConfig {XMonad.modMask = m} = M.fromList
+    [ ((m,               button1), \w -> focus w >> F.mouseWindow F.position w
+                                                 >> ifClick (snapSpacedMagicMove gapBase  (Just 50) (Just 50) w)
+                                                 >> windows S.shiftMaster
+      )
+    , ((m .|. shiftMask, button1), \w -> focus w >> C.mouseResizeWindow w True
+                                                 >> ifClick (snapMagicResize [L, R, U, D] (Just 50) (Just 50) w)
+                                                 >> windows S.shiftMaster
+      )
+    , ((m,               button3), \w -> focus w >> F.mouseWindow F.linear w
+                                                 >> ifClick (snapMagicResize [L, R]       (Just 50) (Just 50) w)
+                                                 >> windows S.shiftMaster
+      )
+    , ((m .|. shiftMask, button3), \w -> focus w >> C.mouseResizeWindow w True
+                                                 >> ifClick (snapMagicResize [U, D]       (Just 50) (Just 50) w)
+                                                 >> windows S.shiftMaster
+      )
+    ]
diff --git a/src/XMonad/Custom/Event.hs b/src/XMonad/Custom/Event.hs
new file mode 100644
index 0000000..032efd1
--- /dev/null
+++ b/src/XMonad/Custom/Event.hs
@@ -0,0 +1,16 @@
+module XMonad.Custom.Event
+    ( handleEventHook'
+    ) where
+
+import           Data.Monoid
+import           XMonad
+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
+                           ]
diff --git a/src/XMonad/Custom/Layout.hs b/src/XMonad/Custom/Layout.hs
new file mode 100644
index 0000000..8f14926
--- /dev/null
+++ b/src/XMonad/Custom/Layout.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+
+module XMonad.Custom.Layout
+    ( layoutHook'
+    , Transformers (..)
+    ) where
+
+import           XMonad
+import           XMonad.Custom.Theme
+import           XMonad.Hooks.ManageDocks
+import           XMonad.Layout.Accordion
+import           XMonad.Layout.BinarySpacePartition
+import           XMonad.Layout.Fullscreen
+import           XMonad.Layout.Gaps
+import           XMonad.Layout.Hidden
+import           XMonad.Layout.LayoutModifier
+import           XMonad.Layout.MultiToggle
+import           XMonad.Layout.MultiToggle.Instances
+import           XMonad.Layout.NoBorders
+import           XMonad.Layout.Reflect
+import           XMonad.Layout.Simplest
+import           XMonad.Layout.Spacing
+import           XMonad.Layout.SubLayouts
+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)
+                 ]
+
+data Transformers = GAPS
+                  deriving (Read, Show, Eq, Typeable)
+
+instance Transformer Transformers Window where
+    transform GAPS x k = k (avoidStruts $ applyGaps $ applySpacing x) (const x)
+
+layoutHook' = fullscreenFloat
+            $ lessBorders OnlyFloat
+            $ mkToggle (single NBFULL)
+            $ avoidStruts
+            $ mkToggle (single GAPS)
+            $ 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
new file mode 100644
index 0000000..49b7334
--- /dev/null
+++ b/src/XMonad/Custom/Log.hs
@@ -0,0 +1,73 @@
+module XMonad.Custom.Log
+    ( logHook' ) where
+
+import           System.IO
+import           XMonad
+import           XMonad.Actions.CopyWindow
+import           XMonad.Custom.Theme
+import           XMonad.Hooks.CurrentWorkspaceOnTop
+import           XMonad.Hooks.DynamicLog
+import           XMonad.Hooks.EwmhDesktops
+import           XMonad.Util.NamedScratchpad
+import           XMonad.Util.SpawnNamedPipe
+import           XMonad.Util.WorkspaceCompare
+
+xmobarFont :: Int -> String -> String
+xmobarFont fn = wrap (concat ["<fn=", show fn, ">"]) "</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 red1   ""                . wrap "!" "!"
+    , ppSep             = " / "
+    , 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"
+    , ppOrder           = id
+    , ppSort            = (namedScratchpadFilterOutWorkspace .) <$> getSortByIndex
+    , ppExtras          = []
+    }
+
+botBarPP :: PP
+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
+    b1 <- getNamedPipe "xmobarTop"
+    b2 <- 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 b1
+        }
+    dynamicLogWithPP $ botBarPP
+        { ppOutput  = safePrintToPipe b2
+        }
diff --git a/src/XMonad/Custom/Manage.hs b/src/XMonad/Custom/Manage.hs
new file mode 100644
index 0000000..09ee651
--- /dev/null
+++ b/src/XMonad/Custom/Manage.hs
@@ -0,0 +1,44 @@
+module XMonad.Custom.Manage
+    ( manageHook'
+    ) where
+
+import           XMonad
+import           XMonad.Custom.Scratchpads
+import           XMonad.Hooks.InsertPosition
+import           XMonad.Hooks.ManageDocks
+import           XMonad.Hooks.ManageHelpers
+import           XMonad.Layout.Fullscreen
+import           XMonad.Util.NamedScratchpad
+
+composeActions :: [MaybeManageHook]
+composeActions =
+    [ appName =? "emacs-popup"                                  -?> tileBelowNoFocus
+    , appName =? "eterm"                                        -?> tileBelow
+    , className =? "Pinentry"                                   -?> doCenterFloat
+    , className =? "Steam" <&&> not <$> title =? "Steam"        -?> doFloat
+    , className =? "URxvt"                                      -?> tileBelow
+    , className =? "Xmessage"                                   -?> doCenterFloat
+    , className =? "Zenity"                                     -?> doCenterFloat
+    , className =? "explorer.exe"                               -?> doFullFloat
+    , className =? "qemu-system-x86"                            -?> doCenterFloat
+    , className =? "qemu-system-x86_64"                         -?> doCenterFloat
+    , className =? "xterm"                                      -?> tileBelow
+    , isDialog                                                  -?> doCenterFloat
+    , isFullscreen                                              -?> doFullFloat
+    , pure True                                                 -?> normalTile
+    , stringProperty "WM_WINDOW_ROLE" =? "pop-up"               -?> doCenterFloat
+    , stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooserDialog" -?> doCenterFloat
+    , transience
+    ]
+    where
+        normalTile       = insertPosition Above Newer
+        tileBelow        = insertPosition Below Newer
+        tileBelowNoFocus = insertPosition Below Older
+
+
+manageHook' :: ManageHook
+manageHook' = mconcat [ manageDocks
+                      , fullscreenManageHook
+                      , namedScratchpadManageHook scratchpads
+                      , composeOne composeActions
+                      ]
diff --git a/src/XMonad/Custom/Misc.hs b/src/XMonad/Custom/Misc.hs
new file mode 100644
index 0000000..41883b5
--- /dev/null
+++ b/src/XMonad/Custom/Misc.hs
@@ -0,0 +1,19 @@
+module XMonad.Custom.Misc
+    ( Applications (..)
+    , customApplications
+    ) where
+
+data Applications = Applications { term    :: String
+                                 , browser :: String
+                                 , top     :: String
+                                 , mixer   :: String
+                                 , notify  :: String
+                                 } deriving (Show)
+
+customApplications :: Applications
+customApplications = Applications { term    = "/usr/bin/urxvtc"
+                                  , browser = "/usr/bin/qutebrowser"
+                                  , top     = "/usr/bin/htop"
+                                  , mixer   = "/usr/bin/alsamixer"
+                                  , notify  = "/usr/bin/notify-send"
+                                  }
diff --git a/src/XMonad/Custom/Navigation.hs b/src/XMonad/Custom/Navigation.hs
new file mode 100644
index 0000000..112afd3
--- /dev/null
+++ b/src/XMonad/Custom/Navigation.hs
@@ -0,0 +1,13 @@
+module XMonad.Custom.Navigation
+    ( navigation2DConfig
+    ) where
+
+import XMonad.Actions.Navigation2D
+
+navigation2DConfig :: Navigation2DConfig
+navigation2DConfig = def
+    { defaultTiledNavigation = hybridNavigation
+    , floatNavigation        = hybridNavigation
+    , layoutNavigation       = [("Full", centerNavigation)]
+    , unmappedWindowRect     = [("Full", singleWindowRect)]
+    }
diff --git a/src/XMonad/Custom/Projects.hs b/src/XMonad/Custom/Projects.hs
new file mode 100644
index 0000000..fac181b
--- /dev/null
+++ b/src/XMonad/Custom/Projects.hs
@@ -0,0 +1,25 @@
+module XMonad.Custom.Projects
+    ( projects
+    ) where
+
+import           XMonad.Actions.DynamicProjects
+import           XMonad.Actions.SpawnOn
+import qualified XMonad.Custom.Misc             as CM
+
+projects :: [Project]
+projects =
+    [ Project { projectName      = "Template"
+              , projectDirectory = "~/"
+              , projectStartHook = Nothing
+              }
+
+    , Project { projectName      = "Emacs"
+              , projectDirectory = "~/"
+              , projectStartHook = Just $ spawnOn "Emacs" "/usr/bin/emacsclient"
+              }
+
+    , Project { projectName      = "WWW"
+              , projectDirectory = "~/"
+              , projectStartHook = Just $ spawnOn "WWW" (CM.browser CM.customApplications)
+              }
+    ]
diff --git a/src/XMonad/Custom/Scratchpads.hs b/src/XMonad/Custom/Scratchpads.hs
new file mode 100644
index 0000000..9d82ed5
--- /dev/null
+++ b/src/XMonad/Custom/Scratchpads.hs
@@ -0,0 +1,40 @@
+module XMonad.Custom.Scratchpads
+    ( scratchpads
+    ) where
+
+import           XMonad.Core
+import qualified XMonad.Custom.Misc          as CM
+import           XMonad.ManageHook
+import qualified XMonad.StackSet             as S
+import           XMonad.Util.NamedScratchpad
+
+spawnTerminalWith :: String -> String -> String
+spawnTerminalWith t c = CM.term CM.customApplications ++ " -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
+
+scratchpads :: [NamedScratchpad]
+scratchpads =
+    [ NS "console"
+         (spawnTerminalWith "NSPConsole" "~/.xmonad/bin/nsp-console.sh")
+         (title =? "NSPConsole")
+         floatingNSP
+    , NS "volume"
+         (spawnTerminalWith "NSPVolume" (CM.mixer CM.customApplications))
+         (title =? "NSPVolume")
+         floatingNSP
+    , NS "music"
+         (spawnTerminalWith "NSPMusic" "~/.bin/mp")
+         (title =? "NSPMusic")
+         floatingNSP
+    , NS "top"
+         (spawnTerminalWith "NSPTop" (CM.top CM.customApplications))
+         (title =? "NSPTop")
+         floatingNSP
+    ]
diff --git a/src/XMonad/Custom/Startup.hs b/src/XMonad/Custom/Startup.hs
new file mode 100644
index 0000000..b2765a0
--- /dev/null
+++ b/src/XMonad/Custom/Startup.hs
@@ -0,0 +1,47 @@
+module XMonad.Custom.Startup
+    ( startupHook'
+    ) where
+
+import           Control.Monad
+import           Data.Maybe
+import           XMonad
+import           XMonad.Hooks.ManageDocks
+import           XMonad.Hooks.SetWMName
+import           XMonad.Util.Cursor
+import           XMonad.Util.SpawnNamedPipe
+
+atomsToFullscreen :: [String]
+atomsToFullscreen =
+    [ "_NET_ACTIVE_WINDOW"
+    , "_NET_CLIENT_LIST"
+    , "_NET_CLIENT_LIST_STACKING"
+    , "_NET_DESKTOP_NAMES"
+    , "_NET_WM_DESKTOP"
+    , "_NET_WM_STATE"
+    , "_NET_WM_STATE_FULLSCREEN"
+    , "_NET_WM_STATE_HIDDEN"
+    , "_NET_WM_STRUT"
+    ]
+
+addNETSupported :: Atom -> X ()
+addNETSupported x = withDisplay $ \d -> do
+    r  <- asks theRoot
+    ns <- getAtom "_NET_SUPPORTED"
+    a  <- getAtom "ATOM"
+    liftIO $ do
+        s <- (join . maybeToList) <$> getWindowProperty32 d ns r
+        when (fromIntegral x `notElem` s) $ changeProperty32 d r ns a propModeAppend [fromIntegral x]
+
+addEWMHFullscreen :: X ()
+addEWMHFullscreen = do
+    s <- mapM getAtom atomsToFullscreen
+    mapM_ addNETSupported s
+
+startupHook' :: X ()
+startupHook' = do
+    spawnNamedPipe "/usr/bin/xmobar ~/.xmonad/xmobarrcTop.hs" "xmobarTop"
+    spawnNamedPipe "/usr/bin/xmobar ~/.xmonad/xmobarrcBot.hs" "xmobarBot"
+    docksStartupHook
+    addEWMHFullscreen
+    setDefaultCursor xC_left_ptr
+    setWMName "xmonad"
diff --git a/src/XMonad/Custom/Theme.hs b/src/XMonad/Custom/Theme.hs
new file mode 100644
index 0000000..50fa398
--- /dev/null
+++ b/src/XMonad/Custom/Theme.hs
@@ -0,0 +1,123 @@
+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
+
+import           Data.Char
+import           Data.Function
+import           Data.List
+import           Graphics.X11.Xlib.Types
+import           XMonad.Layout.Decoration
+import qualified XMonad.Prompt            as P
+
+font :: String
+font = "xft:lucy tewi:style=Regular:size=8" -- TODO CJKのフォールバックフォントを追加する
+
+black1, black2 :: String -- TODO get variables from Xresources
+(black1, black2) =
+    ("#0b0806", "#2f2b2a")
+
+-- | Red
+red1, red2 :: String
+(red1, red2) =
+    ("#844d2c", "#a64848")
+
+-- | Green
+green1, green2 :: String
+(green1, green2) =
+    ("#57553a", "#897f5a")
+
+-- | Yellow
+yellow1, yellow2 :: String
+(yellow1, yellow2) =
+    ("#a17c38", "#c8b38d")
+
+-- | Blue
+blue1, blue2 :: String
+(blue1, blue2) =
+    ("#41434f", "#526274")
+
+-- | Magenta
+magenta1, magenta2 :: String
+(magenta1, magenta2) =
+    ("#6b4444", "#755c47")
+
+-- | Cyan
+cyan1, cyan2 :: String
+(cyan1, cyan2) =
+    ("#59664c", "#718062")
+
+-- | White
+white1, white2 :: String
+(white1, white2) =
+    ("#a19782", "#c1ab83")
+
+colorN, colorF :: String
+colorN = black2
+colorF = white2
+
+gapBase, gapFull :: Int
+gapBase = 12
+gapFull = gapBase * 2
+
+height, border :: Dimension
+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
+    }
+
+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.Bottom
+    , P.height            = height
+    , P.searchPredicate   = isInfixOf `on` map toLower
+    }
+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
new file mode 100644
index 0000000..beae415
--- /dev/null
+++ b/src/XMonad/Custom/Workspaces.hs
@@ -0,0 +1,8 @@
+module XMonad.Custom.Workspaces
+    ( workspaces'
+    ) where
+
+import           XMonad.Core
+
+workspaces' :: [WorkspaceId]
+workspaces' = map show [1 .. 9 :: Int]