Adding scratchpad

lib/KeyBindings.hs

@@ -3,7 +3,9 @@ module KeyBindings (
   KeyBindings.modify
 ) where
 
+import Control.Monad (void)
 import Data.List (sort, isSuffixOf)
+import Data.Maybe (isJust)
 import Graphics.X11.Types
 import System.Exit
 import Text.EditDistance
@@ -18,7 +20,9 @@ import XMonad.Prompt
 import XMonad.Prompt.ConfirmPrompt
 import XMonad.Prompt.Shell
 import XMonad.Util.EZConfig
+import XMonad.Util.NamedScratchpad
 import qualified Solarized as S
+import qualified Scratchpad as R
 import qualified XMonad.StackSet as W
 
 modify :: XConfig l -> XConfig l
@@ -43,15 +47,26 @@ modify conf = conf
     , ("M-S-<Delete>", spawn "/run/current-system/sw/bin/i3lock-fancy -g -p")
     , ("M-S-<Left>", shiftToPrev >> prevWS)
     , ("M-S-<Right>", shiftToNext >> nextWS)
-    , ("M-S-s", spawn "sleep 0.2 ; /run/current-system/sw/bin/scrot -s /tmp/screenSel.png")
-    , ("M-s", spawn "/run/current-system/sw/bin/scrot /tmp/screen.png")
+    , ("M-s s", spawn "sleep 0.2 ; /run/current-system/sw/bin/scrot -s /tmp/screenSel.png")
+    , ("M-s S", spawn "/run/current-system/sw/bin/scrot /tmp/screen.png")
     -- Workspace and tasks
-    , ("M-p v", gridselectWorkspace defaultGSConfig W.view)
-    , ("M-p n", switchProjectPrompt promptConfig)
     , ("M-p m", shiftToProjectPrompt promptConfig)
+    , ("M-p n", switchProjectPrompt promptConfig)
+    , ("M-p r", renameProjectPrompt promptConfig)
     , ("M-p s", shellPrompt promptConfig)
+    , ("M-p u", gridselectWorkspace' defaultGSConfig viewProject)
+    , ("M-p v", gridselectWorkspace defaultGSConfig W.view)
+    -- Scratchpads
+    , ("M-p p", namedScratchpadAction R.pads "htop")
     ]
 
+viewProject :: WorkspaceId -> X ()
+viewProject id = do
+  project <- lookupProject id
+  case project of
+    Just p -> switchProject p
+    Nothing -> return ()
+
 promptConfig = def
   { position          = Top
   , alwaysHighlight   = True

lib/Scratchpad.hs

@@ -0,0 +1,24 @@
+
+module Scratchpad (
+  Scratchpad.modify,
+  Scratchpad.pads
+) where
+
+import Control.Monad (void)
+import XMonad.Core
+import XMonad.ManageHook
+import XMonad.Util.NamedScratchpad
+import qualified XMonad.StackSet as W
+
+modify :: XConfig l -> XConfig l
+modify conf = conf
+  { manageHook = namedScratchpadManageHook pads
+  }
+
+pads =
+  [ NS "htop" "/run/current-system/sw/bin/alacritty -t htop -e tmux" (title =? "htop")
+      (customFloating $ W.RationalRect (1/3) (1/3) (1/3) (1/3))
+  -- , NS "stardict" "stardict" (className =? "Stardict")
+  --     (customFloating $ W.RationalRect (1/6) (1/6) (2/3) (2/3))
+  -- , NS "notes" "gvim --role notes ~/notes.txt" (role =? "notes") nonFloating
+  ] where role = stringProperty "WM_WINDOW_ROLE"

xmonad.hs

@@ -19,7 +19,8 @@ import qualified Solarized as S
 -- Tidy modules
 import KeyBindings as Keys (modify)
 import MouseBindings as Mouse (modify)
-import Projects as Projects (modify)
+import Projects (modify)
+import Scratchpad (modify)
 
 --------- toggle btw    vvvvvvvvvv or vvvvv
 layouts = toggleLayouts fullscreen    tiled
@@ -34,11 +35,11 @@ layouts = toggleLayouts fullscreen    tiled
 -------------- Here be the law of windows
 myManageHook = composeOne
   [ className =? "Pinentry"     -?> doFloat
-  , className =? "mpv"          -?> doFullFloat <+> (doShift "Flims")
-  , className =? "Steam"        -?> doShift "Steam"
-  , className =? "csgo_linux64" -?> doFullFloat <+> (doShift "CSGO")
-  , className =? "Pavucontrol"  -?> doShift "Music"
-  , className =? "qutebrowser"  -?> doShift "Web Perso"
+  , className =? "mpv"          -?> doFullFloat <+> (doShift "flims")
+  , className =? "Steam"        -?> doShift "steam"
+  , className =? "csgo_linux64" -?> doShift "csgo"
+  , className =? "Pavucontrol"  -?> doShift "music"
+  , className =? "qutebrowser"  -?> doShift "web"
   , isDialog                    -?> doCenterFloat
 
     -- Move transient windows to their parent:
@@ -50,6 +51,7 @@ withConfig =
       Projects.modify   -- Apply projects config
     $ Keys.modify       -- Apply keybindings config
     $ Mouse.modify      -- Apply mouse bindings config
+    $ Scratchpad.modify -- Apply scratchpad managehook config
     $ desktopConfig     --   on a default desktop config
     { manageHook         = myManageHook <+> manageHook desktopConfig
     , layoutHook         = desktopLayoutModifiers layouts