about summary refs log tree commit diff
path: root/src/XMonad/Custom
diff options
context:
space:
mode:
Diffstat (limited to 'src/XMonad/Custom')
-rw-r--r--src/XMonad/Custom/Bindings.hs258
-rw-r--r--src/XMonad/Custom/Event.hs23
-rw-r--r--src/XMonad/Custom/Layout.hs59
-rw-r--r--src/XMonad/Custom/Log.hs80
-rw-r--r--src/XMonad/Custom/Manage.hs54
-rw-r--r--src/XMonad/Custom/Misc.hs33
-rw-r--r--src/XMonad/Custom/Navigation.hs22
-rw-r--r--src/XMonad/Custom/Projects.hs32
-rw-r--r--src/XMonad/Custom/Prompt.hs27
-rw-r--r--src/XMonad/Custom/Scratchpads.hs49
-rw-r--r--src/XMonad/Custom/Startup.hs56
-rw-r--r--src/XMonad/Custom/Theme.hs125
-rw-r--r--src/XMonad/Custom/Workspaces.hs34
13 files changed, 0 insertions, 852 deletions
diff --git a/src/XMonad/Custom/Bindings.hs b/src/XMonad/Custom/Bindings.hs
deleted file mode 100644
index de0fd26..0000000
--- a/src/XMonad/Custom/Bindings.hs
+++ /dev/null
@@ -1,258 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-
--- |
--- Module      : XMonad.Custom.Bindings
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
---
-
-module XMonad.Custom.Bindings
-  ( keys
-  , rawKeys
-  , modMask
-  , mouseBindings
-  ) where
-
-import qualified Data.Map                      as M
-import           System.Exit
-import           XMonad                  hiding ( keys
-                                                , modMask
-                                                , mouseBindings
-                                                )
-import           XMonad.Actions.CopyWindow
-import           XMonad.Actions.CycleWS
-import           XMonad.Actions.DynamicProjects
-import           XMonad.Actions.DynamicWorkspaces
-import qualified XMonad.Actions.FlexibleManipulate
-                                               as F
-import           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.UpdatePointer
-import           XMonad.Actions.WithAll
-import           XMonad.Custom.Layout
-import qualified XMonad.Custom.Misc            as C
-import           XMonad.Custom.Scratchpads
-import           XMonad.Custom.Theme
-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.Shell
-import           XMonad.Prompt.Window
-import           XMonad.Prompt.Workspace
-import qualified XMonad.StackSet               as S
-import           XMonad.Util.EZConfig
-import           XMonad.Util.NamedScratchpad
-import           XMonad.Util.WorkspaceCompare
-
-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]
-
-zipKeys :: [a] -> [[a]] -> [t1] -> (t1 -> b) -> [([a], b)]
-zipKeys m ks as f = zipWith (\k d -> (m ++ k, f d)) ks as
-zipKeys' :: [a] -> [[a]] -> [t1] -> (t1 -> t2 -> b) -> t2 -> [([a], b)]
-zipKeys' m ks as f b = zipWith (\k d -> (m ++ k, f d b)) ks as
-
-tryMessageR_ :: (Message a, Message b) => a -> b -> X ()
-tryMessageR_ x y = sequence_ [tryMessageWithNoRefreshToCurrent x y, refresh]
-
-toggleCopyToAll :: X ()
-toggleCopyToAll = wsContainingCopies >>= \case
-  [] -> windows copyToAll
-  _  -> killAllOtherCopies
-
-getSortByIndexNonSP :: X ([WindowSpace] -> [WindowSpace])
-getSortByIndexNonSP = (. namedScratchpadFilterOutWorkspace) <$> getSortByIndex
-
-nextNonEmptyWS, prevNonEmptyWS :: X ()
-nextNonEmptyWS = findWorkspace getSortByIndexNonSP Next HiddenNonEmptyWS 1
-  >>= \t -> windows . S.view $ t
-prevNonEmptyWS = findWorkspace getSortByIndexNonSP Prev HiddenNonEmptyWS 1
-  >>= \t -> windows . S.view $ t
-
-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
-  )
-
-withUpdatePointer :: [(String, X ())] -> [(String, X ())]
-withUpdatePointer = map addAction
- where
-  addAction :: (String, X ()) -> (String, X ())
-  addAction (key, action) = (key, action >> updatePointer (0.98, 0.01) (0, 0))
-
-keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
-keys c = mkKeymap c (rawKeys c)
-
-rawKeys :: XConfig Layout -> [(String, X ())]
-rawKeys c = withUpdatePointer $ concatMap ($ c) keymaps
- where
-  keymaps =
-    [ keysBase
-    , keysSystem
-    , keysMedia
-    , keysWorkspaces
-    , keysSpawnables
-    , keysWindows
-    , keysLayout
-    , keysResize
-    ]
-
-keysBase :: XConfig Layout -> [(String, X ())]
-keysBase _ =
-  [ ("M-S-q", confirmPrompt hotPromptTheme "Quit XMonad?" $ io exitSuccess)
-  , ("M-q"  , spawn "xmonad --restart") -- TODO Replace with interal calls
-  , ("M-C-q", spawn "xmonad --recompile && xmonad --restart")
-  , ("M-x"  , shellPrompt promptTheme)
-  , ("M-w"  , windowPrompt promptTheme Goto allWindows)
-  , ("M-S-w", windowPrompt promptTheme Bring allWindows)
-  ]
-
-keysSystem :: XConfig Layout -> [(String, X ())]
-keysSystem _ =
-  [ ("M-C-g"            , return ()) -- TODO Replace scripts with internal functions
-  , ("<XF86ScreenSaver>", spawn "~/.xmonad/scripts/screenlock.sh")
-  , ("M-<Print>", spawn "~/.xmonad/scripts/xshot-upload.sh")
-  , ("M-S-<Print>", spawn "~/.xmonad/scripts/xshot-select-upload.sh")
-  , ("M-C-c", spawn "~/.xmonad/scripts/toggle-compton.sh")
-  , ("M-C-r", spawn "~/.xmonad/scripts/toggle-redshift.sh")
-  , ("M-C-p", spawn "~/.xmonad/scripts/toggle-touchpad.sh")
-  , ("M-C-t", spawn "~/.xmonad/scripts/toggle-trackpoint.sh")
-  ]
-
-keysMedia :: XConfig Layout -> [(String, X ())] -- TODO Make audio keys compatible with ALSA/PA at the same time
-keysMedia _ =
-  [ ("<XF86AudioMicMute>", spawn "pactl set-source-mute 1 toggle")
-  , ("<XF86AudioMute>"   , spawn "pactl set-sink-mute 0 toggle")
-  , ( "<XF86AudioLowerVolume>"
-    , spawn "pactl set-sink-mute 0 false && pactl set-sink-volume 0 -10%"
-    )
-  , ( "<XF86AudioRaiseVolume>"
-    , spawn "pactl set-sink-mute 0 false && pactl set-sink-volume 0 +10%"
-    )
-  , ("<XF86AudioPlay>", spawn "mpc toggle")
-  , ("<XF86AudioStop>", spawn "mpc stop")
-  , ("<XF86AudioPrev>", spawn "mpc prev")
-  , ("<XF86AudioNext>", spawn "mpc next")
-  ]
-
-keysWorkspaces :: XConfig Layout -> [(String, X ())]
-keysWorkspaces _ =
-  [ ("M-S-o", switchProjectPrompt promptTheme)
-    , ("M-S-p", shiftToProjectPrompt promptTheme)
-    , ("M-,"  , nextNonEmptyWS)
-    , ("M-."  , prevNonEmptyWS)
-    , ("M-i"  , toggleWS' ["NSP"])
-    , ("M-n", workspacePrompt promptTheme $ windows . S.shift)
-    ]
-    ++ zipKeys "M-"     wsKeys [0 ..] (withNthWorkspace S.greedyView)
-    ++ zipKeys "M-S-"   wsKeys [0 ..] (withNthWorkspace S.shift)
-    ++ zipKeys "M-C-S-" wsKeys [0 ..] (withNthWorkspace copy)
-
-keysSpawnables :: XConfig Layout -> [(String, X ())]
-keysSpawnables _ =
-  [ ("M-<Return>", spawn (C.term C.applications))
-  , ("M-b"       , spawn (C.browser C.applications))
-  , ("M-c"       , namedScratchpadAction scratchpads "console")
-  , ("M-m"       , namedScratchpadAction scratchpads "music")
-  , ("M-t"       , namedScratchpadAction scratchpads "top")
-  , ("M-v"       , namedScratchpadAction scratchpads "volume")
-  ]
-
-keysWindows :: XConfig Layout -> [(String, X ())]
-keysWindows _ =
-  [ ("M-d"  , kill)
-    , ("M-S-d", confirmPrompt hotPromptTheme "Kill all" killAll)
-    , ("M-a"  , toggleCopyToAll)
-    , ("M-e"  , withFocused hideWindow) -- FIXME This is so broken
-    , ("M-S-e", popOldestHiddenWindow)
-    , ("M-p"  , promote)
-    , ("M-g", withFocused $ sendMessage . MergeAll)
-    , ("M-S-g", withFocused $ sendMessage . UnMerge)
-    , ("M-u"  , focusUrgent)
-    , ("M-s"  , windows S.focusMaster)
-    , ( "M-'"
-      , bindOn LD [("Tabs", windows S.focusDown), ("", onGroup S.focusDown')]
-      )
-    , ("M-;", bindOn LD [("Tabs", windows S.focusUp), ("", onGroup S.focusUp')])
-    , ("M-S-'", windows S.swapDown)
-    , ("M-S-;", windows S.swapUp)
-    ]
-    ++ zipKeys' "M-"   directionKeys directions windowGo   True -- TODO W moving
-    ++ zipKeys' "M-S-" directionKeys directions windowSwap True
-    ++ zipKeys "M-C-" directionKeys directions (sendMessage . pullGroup)
-    ++ zipKeys' "M-"   arrowKeys directions screenGo       True
-    ++ zipKeys' "M-S-" arrowKeys directions windowToScreen True
-    ++ zipKeys' "M-C-" arrowKeys directions screenSwap     True
-
-keysLayout :: XConfig Layout -> [(String, X ())]
-keysLayout c =
-  [ ("M-<Tab>"  , sendMessage NextLayout)
-  , ("M-C-<Tab>", toSubl NextLayout)
-  , ("M-S-<Tab>", setLayout $ XMonad.layoutHook c)
-  , ("M-o"      , withFocused toggleFloat)
-  , ("M-S-o"    , sinkAll)
-  , ("M-S-,"    , sendMessage $ IncMasterN (-1))
-  , ("M-S-."    , sendMessage $ IncMasterN 1)
-  , ("M-r"      , tryMessageR_ Rotate (Toggle REFLECTX))
-  , ("M-S-r"    , sendMessage $ Toggle REFLECTX)
-  , ( "M-f"
-    , sequence_ [withFocused $ windows . S.sink, sendMessage $ Toggle NBFULL]
-    )
-  , ("M-C-g", sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout
-  ]
-
-keysResize :: XConfig Layout -> [(String, X ())]
-keysResize _ =
-  [ ("M-["    , tryMessageR_ (ExpandTowards L) Shrink)
-  , ("M-]"    , tryMessageR_ (ExpandTowards R) Expand)
-  , ("M-S-["  , tryMessageR_ (ExpandTowards U) MirrorShrink)
-  , ("M-S-]"  , tryMessageR_ (ExpandTowards D) MirrorExpand)
-  , ("M-C-["  , tryMessageR_ (ShrinkFrom R) Shrink)
-  , ("M-C-]"  , tryMessageR_ (ShrinkFrom L) Expand)
-  , ("M-S-C-[", tryMessageR_ (ShrinkFrom D) MirrorShrink)
-  , ("M-S-C-]", tryMessageR_ (ShrinkFrom U) MirrorExpand)
-  ]
-
-mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
-mouseBindings XConfig{} = M.fromList
-  [ ( (modMask, button1)
-    , \w ->
-      focus w
-        >> F.mouseWindow F.position w
-        >> ifClick (snapSpacedMagicMove gapFull (Just 50) (Just 50) w)
-        >> windows S.shiftMaster
-    )
-  , ( (modMask, button3)
-    , \w ->
-      focus w
-        >> F.mouseWindow F.linear w
-        >> ifClick (snapMagicResize [L, R, U, D] (Just 50) (Just 50) w)
-        >> windows S.shiftMaster
-    )
-  ]
diff --git a/src/XMonad/Custom/Event.hs b/src/XMonad/Custom/Event.hs
deleted file mode 100644
index f55511d..0000000
--- a/src/XMonad/Custom/Event.hs
+++ /dev/null
@@ -1,23 +0,0 @@
--- |
--- Module      : XMonad.Custom.Event
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
---
-
-module XMonad.Custom.Event
-  ( handleEventHook
-  ) where
-
-import           Data.Monoid
-import           XMonad                  hiding ( handleEventHook )
-import           XMonad.Custom.Scratchpads
-import           XMonad.Hooks.EwmhDesktops
-import           XMonad.Hooks.ManageDocks
-import           XMonad.Util.Loggers.NamedScratchpad
-
-handleEventHook :: Event -> X All
-handleEventHook =
-  mconcat [nspTrackHook scratchpads, docksEventHook, fullscreenEventHook]
diff --git a/src/XMonad/Custom/Layout.hs b/src/XMonad/Custom/Layout.hs
deleted file mode 100644
index fe9224a..0000000
--- a/src/XMonad/Custom/Layout.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable    #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeSynonymInstances  #-}
-{-# OPTIONS_GHC -Wno-missing-signatures #-}
-
--- |
--- Module      : XMonad.Custom.Layout
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
---
-
-module XMonad.Custom.Layout
-  ( layoutHook
-  , CustomTransformers(..)
-  ) where
-
-import           XMonad                  hiding ( layoutHook )
-import           XMonad.Custom.Theme
-import           XMonad.Hooks.ManageDocks
-import           XMonad.Layout.Accordion
-import           XMonad.Layout.BinarySpacePartition
-import           XMonad.Layout.Fullscreen
-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 = spacingRaw False (Border 6 6 6 6) True (Border 6 6 6 6) True
-
-data CustomTransformers = GAPS
-  deriving (Read, Show, Eq, Typeable)
-
-instance Transformer CustomTransformers Window where
-  transform GAPS x k = k (avoidStruts $ applySpacing x) (const x)
-
-layoutHook =
-  fullscreenFloat
-    $ lessBorders OnlyLayoutFloat
-    $ mkToggle (single NBFULL)
-    $ avoidStruts
-    $ applySpacing
-    $ mkToggle (single GAPS)
-    $ mkToggle (single REFLECTX)
-    $ mkToggle (single REFLECTY)
-    $ windowNavigation
-    $ addTabs shrinkText tabTheme
-    $ hiddenWindows
-    $ subLayout [] (Simplest ||| Accordion) emptyBSP
diff --git a/src/XMonad/Custom/Log.hs b/src/XMonad/Custom/Log.hs
deleted file mode 100644
index 6b7af37..0000000
--- a/src/XMonad/Custom/Log.hs
+++ /dev/null
@@ -1,80 +0,0 @@
--- |
--- Module      : XMonad.Custom.Log
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
-
-module XMonad.Custom.Log
-  ( logHook
-  ) where
-
-import           System.IO
-import           XMonad                  hiding ( logHook )
-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 f = wrap (concat ["<fn=", show f, ">"]) "</fn>"
-
-topBarPP :: PP
-topBarPP = def
-  { ppCurrent         = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "="
-  , ppVisible         = xmobarColor white1 "" . wrap "~" "~"
-  , ppHidden          = xmobarColor white1 "" . wrap "-" "-"
-  , ppHiddenNoWindows = xmobarColor white1 "" . wrap "_" "_"
-  , ppUrgent          = xmobarColor red2 "" . wrap "!" "!"
-  , ppSep             = " / "
-  , ppWsSep           = " "
-  , ppTitle           = xmobarColor white1 "" . shorten 50
-  , ppTitleSanitize   = xmobarStrip
-  , ppLayout          = xmobarColor white1 ""
-  , ppOrder           = id
-  , ppSort            = (namedScratchpadFilterOutWorkspace .) <$> getSortByIndex
-  , ppExtras          = []
-  }
-
-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
-  t <- getNamedPipe "xmobarTop"
-  b <- getNamedPipe "xmobarBot"
-  c <- wsContainingCopies
-  let copiesCurrent ws
-        | ws `elem` c
-        = xmobarColor yellow2 "" . xmobarFont 2 . wrap "*" "=" $ ws
-        | otherwise
-        = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" $ ws
-  let copiesHidden ws
-        | ws `elem` c = xmobarColor yellow1 "" . wrap "*" "-" $ ws
-        | otherwise   = xmobarColor white1 "" . wrap "-" "-" $ ws
-  let copiesUrgent ws
-        | ws `elem` c = xmobarColor yellow2 "" . wrap "*" "!" $ ws
-        | otherwise   = xmobarColor white2 "" . wrap "!" "!" $ ws
-  dynamicLogWithPP $ topBarPP { ppCurrent = copiesCurrent
-                              , ppHidden  = copiesHidden
-                              , ppUrgent  = copiesUrgent
-                              , ppOutput  = safePrintToPipe t
-                              }
-  dynamicLogWithPP $ botBarPP { ppOutput = safePrintToPipe b }
diff --git a/src/XMonad/Custom/Manage.hs b/src/XMonad/Custom/Manage.hs
deleted file mode 100644
index ac4201b..0000000
--- a/src/XMonad/Custom/Manage.hs
+++ /dev/null
@@ -1,54 +0,0 @@
--- |
--- Module      : XMonad.Custom.Manage
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
---
-
-module XMonad.Custom.Manage
-  ( manageHook
-  ) where
-
-import           XMonad                  hiding ( manageHook )
-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 =? "Xmessage" -?> doCenterFloat
-  , className =? "Zenity" -?> doCenterFloat
-  , className =? "explorer.exe" -?> doFullFloat
-  , className =? "qemu-system-x86" -?> doCenterFloat
-  , className =? "qemu-system-x86_64" -?> doCenterFloat
-  , className =? "urxvt" -?> tileBelow
-  , className =? "xterm" -?> tileBelow
-  , isDialog -?> doCenterFloat
-  , isFullscreen -?> doFullFloat
-  , pure True -?> tileNormal
-  , stringProperty "WM_WINDOW_ROLE" =? "pop-up" -?> doCenterFloat
-  , stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooserDialog" -?> doCenterFloat
-  , transience
-  ]
- where
-  tileNormal       = insertPosition Above Newer
-  tileBelow        = insertPosition Below Newer
-  tileBelowNoFocus = insertPosition Below Older
-
-
-manageHook :: ManageHook
-manageHook = mconcat
-  [ manageDocks
-  , fullscreenManageHook
-  , namedScratchpadManageHook scratchpads
-  , composeOne composeActions
-  ]
diff --git a/src/XMonad/Custom/Misc.hs b/src/XMonad/Custom/Misc.hs
deleted file mode 100644
index aa48ee2..0000000
--- a/src/XMonad/Custom/Misc.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-{-# OPTIONS_GHC -funbox-strict-fields #-}
-
--- |
--- Module      : XMonad.Custom.Misc
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
-
-module XMonad.Custom.Misc
-  ( Applications(..)
-  , applications
-  ) where
-
-data Applications = Applications
-  { browser :: !String
-  , mixer   :: !String
-  , notify  :: !String
-  , player  :: !String
-  , term    :: !String
-  , top     :: !String
-  }
-  deriving (Eq, Show)
-
-applications :: Applications
-applications = Applications { browser = "qutebrowser"
-                            , mixer   = "pulsemixer"
-                            , notify  = "notify-send"
-                            , player  = "ncmpcpp"
-                            , term    = "urxvtc"
-                            , top     = "htop"
-                            }
diff --git a/src/XMonad/Custom/Navigation.hs b/src/XMonad/Custom/Navigation.hs
deleted file mode 100644
index 812dd30..0000000
--- a/src/XMonad/Custom/Navigation.hs
+++ /dev/null
@@ -1,22 +0,0 @@
--- |
--- Module      : XMonad.Custom.Navigation
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
---
-
-module XMonad.Custom.Navigation
-  ( navigation
-  ) where
-
-import           XMonad.Actions.Navigation2D
-
-navigation :: Navigation2DConfig
-navigation = def
-  { defaultTiledNavigation = hybridOf sideNavigation centerNavigation
-  , floatNavigation        = hybridOf lineNavigation centerNavigation
-  , layoutNavigation       = [("Full", centerNavigation)]
-  , unmappedWindowRect     = [("Full", singleWindowRect)]
-  }
diff --git a/src/XMonad/Custom/Projects.hs b/src/XMonad/Custom/Projects.hs
deleted file mode 100644
index 4726fc7..0000000
--- a/src/XMonad/Custom/Projects.hs
+++ /dev/null
@@ -1,32 +0,0 @@
--- |
--- Module      : XMonad.Custom.Projects
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
---
-
-module XMonad.Custom.Projects
-  ( projects
-  ) where
-
-import           XMonad.Actions.DynamicProjects
-import           XMonad.Actions.SpawnOn
-import qualified XMonad.Custom.Misc            as C
-
-projects :: [Project]
-projects =
-  [ Project { projectName      = "Template"
-            , projectDirectory = "~/"
-            , projectStartHook = Nothing
-            }
-  , Project { projectName      = "Emacs"
-            , projectDirectory = "~/"
-            , projectStartHook = Just $ spawnOn "Emacs" "emacsclient"
-            }
-  , Project { projectName      = "WWW"
-            , projectDirectory = "~/"
-            , projectStartHook = Just $ spawnOn "WWW" (C.browser C.applications)
-            }
-  ]
diff --git a/src/XMonad/Custom/Prompt.hs b/src/XMonad/Custom/Prompt.hs
deleted file mode 100644
index e8762d1..0000000
--- a/src/XMonad/Custom/Prompt.hs
+++ /dev/null
@@ -1,27 +0,0 @@
--- |
--- Module      : XMonad.Custom.Prompt
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
---
-
-module XMonad.Custom.Prompt
-  ( listCompFunc
-  , aListCompFunc
-  , predicateFunction
-  ) where
-
-import           Data.Char
-import           Data.List
-import           XMonad.Prompt
-
-listCompFunc :: XPConfig -> [String] -> String -> IO [String]
-listCompFunc c xs s = return (filter (searchPredicate c s) xs)
-
-aListCompFunc :: XPConfig -> [(String, a)] -> String -> IO [String]
-aListCompFunc c xs = listCompFunc c (map fst xs)
-
-predicateFunction :: String -> String -> Bool
-predicateFunction x y = lc x `isInfixOf` lc y where lc = map toLower
diff --git a/src/XMonad/Custom/Scratchpads.hs b/src/XMonad/Custom/Scratchpads.hs
deleted file mode 100644
index 157a1fb..0000000
--- a/src/XMonad/Custom/Scratchpads.hs
+++ /dev/null
@@ -1,49 +0,0 @@
--- |
--- Module      : XMonad.Custom.Scratchpads
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
---
-
-module XMonad.Custom.Scratchpads
-  ( scratchpads
-  ) where
-
-import           XMonad.Core
-import           XMonad.Custom.Misc            as C
-import           XMonad.ManageHook
-import qualified XMonad.StackSet               as S
-import           XMonad.Util.NamedScratchpad
-
-spawnTerminalWith :: String -> String -> String
-spawnTerminalWith t c = term applications ++ " -title " ++ t ++ " -e " ++ c
-
-floatingNSP :: ManageHook
-floatingNSP = customFloating $ S.RationalRect x y w h
- where
-  x = (1 - w) / 2
-  y = (1 - h) / 2
-  w = 1 / 2
-  h = 1 / 2.5
-
-scratchpads :: [NamedScratchpad]
-scratchpads =
-  [ NS "console"
-       (spawnTerminalWith "NSPConsole" "~/.xmonad/scripts/nsp-console.sh")
-       (title =? "NSPConsole")
-       floatingNSP
-  , NS "volume"
-       (spawnTerminalWith "NSPVolume" (C.mixer C.applications))
-       (title =? "NSPVolume")
-       floatingNSP
-  , NS "music"
-       (spawnTerminalWith "NSPMusic" (C.player C.applications))
-       (title =? "NSPMusic")
-       floatingNSP
-  , NS "top"
-       (spawnTerminalWith "NSPTop" (C.top C.applications))
-       (title =? "NSPTop")
-       floatingNSP
-  ]
diff --git a/src/XMonad/Custom/Startup.hs b/src/XMonad/Custom/Startup.hs
deleted file mode 100644
index cdd63ac..0000000
--- a/src/XMonad/Custom/Startup.hs
+++ /dev/null
@@ -1,56 +0,0 @@
--- |
--- Module      : XMonad.Custom.Startup
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
-
-module XMonad.Custom.Startup
-  ( startupHook
-  ) where
-
-import           Control.Monad
-import           Data.Maybe
-import           XMonad                  hiding ( startupHook )
-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
-  n <- getAtom "_NET_SUPPORTED"
-  a <- getAtom "ATOM"
-  liftIO $ do
-    p <- join . maybeToList <$> getWindowProperty32 d n r
-    when (fromIntegral x `notElem` p)
-      $ changeProperty32 d r n a propModeAppend [fromIntegral x]
-
-addEWMHFullscreen :: X ()
-addEWMHFullscreen = do
-  s <- mapM getAtom atomsToFullscreen
-  mapM_ addNETSupported s
-
-startupHook :: X ()
-startupHook = do
-  spawnNamedPipe "xmobar ~/.xmonad/xmobarrc/top.hs" "xmobarTop"
-  spawnNamedPipe "xmobar ~/.xmonad/xmobarrc/bot.hs" "xmobarBot"
-  docksStartupHook
-  addEWMHFullscreen
-  setDefaultCursor xC_left_ptr
-  setWMName "xmonad"
diff --git a/src/XMonad/Custom/Theme.hs b/src/XMonad/Custom/Theme.hs
deleted file mode 100644
index 64b52a8..0000000
--- a/src/XMonad/Custom/Theme.hs
+++ /dev/null
@@ -1,125 +0,0 @@
--- |
--- Module      : XMonad.Custom.Theme
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
---
-
-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           Data.Ratio
-import           Graphics.X11.Xlib.Types
-import           XMonad.Layout.Decoration
-import qualified XMonad.Prompt                 as P
-
-font :: String
-font = "xft:tewi:style=Regular:size=8" -- TODO CJKのフォールバックフォントを追加する
-
-black1, black2 :: String -- TODO get variables from Xresources
-(black1, black2) = ("#0b0806", "#2f2b2a")
-
--- | 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 = 6
-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.CenteredAt { P.xpCenterY = 3 % 10, P.xpWidth = 9 % 10 }
-  , P.height            = height
-  , P.maxComplRows      = Just 5
-  , P.searchPredicate   = isInfixOf `on` map toLower
-  , P.alwaysHighlight   = True
-  }
-hotPromptTheme = promptTheme { P.bgColor  = black2
-                             , P.fgColor  = white2
-                             , P.fgHLight = white1
-                             , P.bgHLight = black1
-                             }
diff --git a/src/XMonad/Custom/Workspaces.hs b/src/XMonad/Custom/Workspaces.hs
deleted file mode 100644
index 65d1b14..0000000
--- a/src/XMonad/Custom/Workspaces.hs
+++ /dev/null
@@ -1,34 +0,0 @@
--- |
--- Module      : XMonad.Custom.Workspaces
--- Copyright   : (c) 2018-2020 Azat Bahawi <azahi@teknik.io>
--- License     : BSD3-style (see LICENSE)
--- Maintainer  : Azat Bahawi <azahi@teknik.io>
--- Stability   : unstable
--- Portability : unportable
---
-
-module XMonad.Custom.Workspaces
-  ( workspaces
-  ) where
-
-import           XMonad.Actions.DynamicProjects
-import           XMonad.Core             hiding ( workspaces )
-
-workspaces :: [WorkspaceId]
-workspaces = map show [1 .. 9 :: Int]
-
-projects :: [Project]
-projects =
-  [ Project { projectName      = "scratch"
-            , projectDirectory = "~/"
-            , projectStartHook = Nothing
-            }
-  , Project { projectName      = "www"
-            , projectDirectory = "~/"
-            , projectStartHook = Nothing
-            }
-  , Project { projectName      = "mail"
-            , projectDirectory = "~/"
-            , projectStartHook = Nothing
-            }
-  ]

Consider giving Nix/NixOS a try! <3