Huge update

13 files changed, 848 insertions, 0 deletions

diff --git a/src/lib/XMonad/Custom/Bindings.hs b/src/lib/XMonad/Custom/Bindings.hs
new file mode 100644
index 0000000..208ccdf
--- /dev/null
+++ b/src/lib/XMonad/Custom/Bindings.hs
@@ -0,0 +1,256 @@
+{-# LANGUAGE LambdaCase #-}
+
+-- |
+-- Module                  : XMonad.Custom.Bindings
+-- Description             : Key bindings and keys configuration
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+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.MessageFeedback
+import           XMonad.Actions.Navigation2D
+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)
+    , ("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-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 (snapMagicMove (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/lib/XMonad/Custom/Event.hs b/src/lib/XMonad/Custom/Event.hs
new file mode 100644
index 0000000..9ff2552
--- /dev/null
+++ b/src/lib/XMonad/Custom/Event.hs
@@ -0,0 +1,24 @@
+-- |
+-- Module                  : XMonad.Custom.Event
+-- Description             : Event hooks and stuff
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+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/lib/XMonad/Custom/Layout.hs b/src/lib/XMonad/Custom/Layout.hs
new file mode 100644
index 0000000..8ed7d08
--- /dev/null
+++ b/src/lib/XMonad/Custom/Layout.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+
+-- |
+-- Module                  : XMonad.Custom.Layout
+-- Description             : Layouts and such
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+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/lib/XMonad/Custom/Log.hs b/src/lib/XMonad/Custom/Log.hs
new file mode 100644
index 0000000..e9d3c1a
--- /dev/null
+++ b/src/lib/XMonad/Custom/Log.hs
@@ -0,0 +1,82 @@
+-- |
+-- Module                  : XMonad.Custom.Log
+-- Description             : Loggers and statusbar configuration
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+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/lib/XMonad/Custom/Manage.hs b/src/lib/XMonad/Custom/Manage.hs
new file mode 100644
index 0000000..dbc560e
--- /dev/null
+++ b/src/lib/XMonad/Custom/Manage.hs
@@ -0,0 +1,54 @@
+-- |
+-- Module                  : XMonad.Custom.Manage
+-- Description             : Window management hooks and scratchpads
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+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/lib/XMonad/Custom/Misc.hs b/src/lib/XMonad/Custom/Misc.hs
new file mode 100644
index 0000000..b9901b4
--- /dev/null
+++ b/src/lib/XMonad/Custom/Misc.hs
@@ -0,0 +1,36 @@
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-- |
+-- Module                  : XMonad.Custom.Misc
+-- Description             : Miscellaneous functions and constants
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+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/lib/XMonad/Custom/Navigation.hs b/src/lib/XMonad/Custom/Navigation.hs
new file mode 100644
index 0000000..2646db4
--- /dev/null
+++ b/src/lib/XMonad/Custom/Navigation.hs
@@ -0,0 +1,23 @@
+-- |
+-- Module                  : XMonad.Custom.Navigation
+-- Description             : Window navigation and layouts
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+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/lib/XMonad/Custom/Projects.hs b/src/lib/XMonad/Custom/Projects.hs
new file mode 100644
index 0000000..9fa7a37
--- /dev/null
+++ b/src/lib/XMonad/Custom/Projects.hs
@@ -0,0 +1,33 @@
+-- |
+-- Module                  : XMonad.Custom.Projects
+-- Description             : Per-project workspaces
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+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/lib/XMonad/Custom/Prompt.hs b/src/lib/XMonad/Custom/Prompt.hs
new file mode 100644
index 0000000..c54a00f
--- /dev/null
+++ b/src/lib/XMonad/Custom/Prompt.hs
@@ -0,0 +1,28 @@
+-- |
+-- Module                  : XMonad.Custom.Prompt
+-- Description             : Prompt configuration
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+module XMonad.Custom.Prompt
+  ( listCompFunc
+  , aListCompFunc
+  , predicateFunction
+  ) where
+
+import           Data.Char
+import           Data.List                      ( isInfixOf )
+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/lib/XMonad/Custom/Scratchpads.hs b/src/lib/XMonad/Custom/Scratchpads.hs
new file mode 100644
index 0000000..5570435
--- /dev/null
+++ b/src/lib/XMonad/Custom/Scratchpads.hs
@@ -0,0 +1,50 @@
+-- |
+-- Module                  : XMonad.Custom.Scratchpads
+-- Description             : Scratchpads configuration
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+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/lib/XMonad/Custom/Startup.hs b/src/lib/XMonad/Custom/Startup.hs
new file mode 100644
index 0000000..f2415ea
--- /dev/null
+++ b/src/lib/XMonad/Custom/Startup.hs
@@ -0,0 +1,58 @@
+-- |
+-- Module                  : XMonad.Custom.Startup
+-- Description             : Startup hooks
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+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/lib/XMonad/Custom/Theme.hs b/src/lib/XMonad/Custom/Theme.hs
new file mode 100644
index 0000000..cfcd176
--- /dev/null
+++ b/src/lib/XMonad/Custom/Theme.hs
@@ -0,0 +1,126 @@
+-- |
+-- Module                  : XMonad.Custom.Theme
+-- Description             : Theming and styles
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+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                      ( isInfixOf )
+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/lib/XMonad/Custom/Workspaces.hs b/src/lib/XMonad/Custom/Workspaces.hs
new file mode 100644
index 0000000..ba2a1e7
--- /dev/null
+++ b/src/lib/XMonad/Custom/Workspaces.hs
@@ -0,0 +1,18 @@
+-- |
+-- Module                  : XMonad.Custom.Workspaces
+-- Description             : General workspace configuration
+-- Copyright               : (c) Azat Bahawi 2018-2021
+-- SPDX-License-Identifier : GPL-3.0-or-later
+-- Maintainer              : azahi@teknik.io
+-- Stability               : experimental
+-- Portability             : non-portable
+--
+
+module XMonad.Custom.Workspaces
+  ( workspaces
+  ) where
+
+import           XMonad.Core             hiding ( workspaces )
+
+workspaces :: [WorkspaceId]
+workspaces = map show [1 .. 9 :: Int]