about summary refs log tree commit diff
path: root/src/XMonad
diff options
context:
space:
mode:
Diffstat (limited to 'src/XMonad')
-rw-r--r--src/XMonad/Custom/Bindings.hs255
-rw-r--r--src/XMonad/Custom/Event.hs16
-rw-r--r--src/XMonad/Custom/Layout.hs56
-rw-r--r--src/XMonad/Custom/Log.hs73
-rw-r--r--src/XMonad/Custom/Manage.hs44
-rw-r--r--src/XMonad/Custom/Misc.hs19
-rw-r--r--src/XMonad/Custom/Navigation.hs13
-rw-r--r--src/XMonad/Custom/Projects.hs25
-rw-r--r--src/XMonad/Custom/Scratchpads.hs40
-rw-r--r--src/XMonad/Custom/Startup.hs47
-rw-r--r--src/XMonad/Custom/Theme.hs123
-rw-r--r--src/XMonad/Custom/Workspaces.hs8
12 files changed, 719 insertions, 0 deletions
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]

Consider giving Nix/NixOS a try! <3