before upgrade

WeissXmonad.cabal

@@ -85,6 +85,7 @@ library
     WeissXmobar
     WeissXMonad
     WorkspaceFamily
+    TreeActions
 
   build-depends:
     , base
@@ -100,4 +101,4 @@ library
     , unix
     , unordered-containers
     , xmonad
-    , xmonad-contrib
+    , xmonad-contrib >= 0.18.1

src/TreeActions.hs

@@ -0,0 +1,63 @@
+module TreeActions where
+
+import Data.Map qualified as Map
+import Data.Tree (Tree (..))
+import WeissScratchpad (myScratchPads, switchNSP)
+import XMonad (def, spawn)
+import XMonad.Actions.TreeSelect
+import XMonad.Config.Prime
+import XMonad.Prelude ((<&>))
+import XMonad.Util.NamedScratchpad (NamedScratchpad (NS))
+
+myTreeConf =
+  TSConfig
+    { ts_hidechildren = True
+    , ts_background = 0xdd282c34
+    , ts_font = "xft:Ubuntu:bold"
+    , ts_node = (0xffc678dd, 0xff202328)
+    , ts_nodealt = (0xffc678dd, 0xff202020)
+    , ts_highlight = (0xff000000, 0xff46D9FF) -- black, cyan
+    , ts_extra = 0xff78DD9D
+    , ts_node_width = 200
+    , ts_node_height = 30
+    , ts_originX = 500
+    , ts_originY = 500
+    , ts_indent = 80
+    , ts_navigate = navigation
+    }
+  where
+    navigation =
+      Map.fromList
+        [ ((0, xK_Escape), cancel)
+        , ((0, xK_Return), select)
+        , ((0, xK_space), select)
+        , ((0, xK_Up), movePrev)
+        , ((0, xK_Down), moveNext)
+        , ((0, xK_Left), moveParent)
+        , ((0, xK_Right), moveChild)
+        , ((0, xK_k), movePrev)
+        , ((0, xK_j), moveNext)
+        , ((0, xK_i), moveParent)
+        , ((0, xK_l), moveChild)
+        , ((0, xK_u), moveHistBack)
+        , ((0, xK_o), moveHistForward)
+        ]
+
+weissTreeActions =
+  treeselectAction
+    myTreeConf
+    $ [ Node
+          (TSNode "System" "System operations" (return ()))
+          [ Node (TSNode "Shutdown" "Poweroff the system" (spawn "shutdown")) []
+          , Node (TSNode "Reboot" "Reboot the system" (spawn "shutdown")) []
+          , Node (TSNode "Suspend" "Suspend the system" (spawn "shutdown")) []
+          ]
+      ]
+      <> scratchpadActions
+  where
+    scratchpadActions =
+      myScratchPads <&> \(NS name _ _ _) ->
+        Node
+          ( TSNode name ("Activate scratchpad " <> name) (switchNSP name)
+          )
+          []

src/WeissScratchpad.hs

@@ -2,16 +2,20 @@ module WeissScratchpad where
 
 import Config
 import Control.Monad (liftM)
-import Control.Monad.Extra (andM, firstJustM)
+import Control.Monad.Extra (andM, firstJustM, unlessM, whenJustM, whenM)
 import Control.Monad.Trans.Maybe
 import Data.Foldable.Extra (findM)
 import Data.Functor (void)
-import Data.Maybe (isJust)
+import Data.Maybe (isJust, isNothing)
+import Data.Tree (Tree (Node))
 import Utils
 import XMonad
+import XMonad.Actions.GridSelect (runSelectedAction)
 import XMonad.Actions.ShowText (flashText)
+import XMonad.Actions.TreeSelect (TSNode (..), treeselectAction)
+import XMonad.Actions.WithAll (withAll)
 import XMonad.Hooks.ManageHelpers
-import XMonad.Prelude (Endo (..))
+import XMonad.Prelude (Endo (..), catMaybes, (<&>))
 import XMonad.StackSet qualified as W
 import XMonad.Util.ExtensibleState qualified as XS
 import XMonad.Util.Loggers
@@ -67,6 +71,12 @@ instance ExtensionClass CurrentScratchpadName where
 findNSP :: Window -> X (Maybe NamedScratchpad)
 findNSP w = findM (\(NS {..}) -> runQuery query w) myScratchPads
 
+hideAllNSP :: X ()
+hideAllNSP = withAll $ \w ->
+  whenJustM
+    (findNSP w)
+    (\(NS name _ _ _) -> namedScratchpadAction myScratchPads name)
+
 isNSP :: Window -> X Bool
 isNSP w = isJust <$> findNSP w
 
@@ -82,7 +92,10 @@ curNSP_ = do
   namedScratchpadAction myScratchPads cur
 
 curNSP :: X ()
-curNSP = curNSP_ >> repositionNSP
+curNSP = withFocused $ \w -> do
+  curNSP_
+  unlessM (isNSP w) $
+    withFocused (\newW -> unlessM (isNSP newW) curNSP_)
 
 initialNSP :: X ()
 initialNSP = do
@@ -103,3 +116,9 @@ prevNSP = do
   let prev = dropWhile (/= cur) (cycle (reverse myScratchpadNames)) !! 1
   namedScratchpadAction myScratchPads prev
   XS.put (CurrentScratchpadName prev)
+
+switchNSP :: String -> X ()
+switchNSP name = do
+  hideAllNSP
+  namedScratchpadAction myScratchPads name
+  XS.put (CurrentScratchpadName name)

src/WeissWindowOperations.hs

@@ -1,17 +1,33 @@
 {-# LANGUAGE LambdaCase #-}
 
-module WeissWindowOperations (weissFocusDown, weissFocusUp, weissSwapMaster) where
+module WeissWindowOperations (weissFocusDown, weissFocusUp, weissSwapMaster, easySwap, weissSwitchFocus) where
 
+import Data.List qualified as L
 import Data.List.Unique
 import Data.Map qualified
 import Data.Map qualified as M
+import Data.Map qualified as Map
 import Data.Maybe
+import TreeActions (weissTreeActions)
 import Utils
 import WeissScratchpad
 import XMonad
+import XMonad (windowset)
+import XMonad.Actions.EasyMotion (
+  ChordKeys (..),
+  EasyMotionConfig (..),
+  selectWindow,
+  textSize,
+ )
+import XMonad.Actions.FocusNth (swapNth)
 import XMonad.StackSet qualified as W
 import XMonad.Util.Loggers
 
+onWindowsCount :: (Int -> X ()) -> X ()
+onWindowsCount f = do
+  winCount <- length . W.index . windowset <$> get
+  f winCount
+
 handleOp :: X () -> X () -> X ()
 handleOp handleNSP handleNormal = withFocused $ \w ->
   ifM
@@ -20,7 +36,7 @@ handleOp handleNSP handleNormal = withFocused $ \w ->
     (ifM (isFloating w) (return ()) handleNormal)
 
 weissFocusDown :: X ()
-weissFocusDown = handleOp nextNSP weissFocusDown_
+weissFocusDown = handleOp weissTreeActions weissFocusDown_
 
 weissFocusDown_ :: X ()
 weissFocusDown_ = do
@@ -96,3 +112,30 @@ weissSwapMaster_ = do
       W.Stack r1 (l : up) (r2 : down) -> W.Stack r2 [r1] (l : down)
       W.Stack l [] (r1 : r2 : down) -> W.Stack l [] (r2 : r1 : down)
       _ -> swapBetweenMasterAndSlave stack
+
+easyMotionConf :: EasyMotionConfig
+easyMotionConf =
+  def
+    { overlayF = textSize
+    , cancelKey = xK_Escape
+    , sKeys =
+        PerScreenKeys
+          ( Map.fromList
+              [ (0, [xK_j, xK_k, xK_l, xK_u, xK_i, xK_o])
+              , (1, [xK_m, xK_n, xK_h, xK_y])
+              ]
+          )
+    }
+
+easySwap :: X ()
+easySwap = do
+  win <- selectWindow easyMotionConf
+  stack <- gets $ W.index . windowset
+  let match = L.find ((win ==) . Just . fst) $ zip stack [0 ..]
+  whenJust match $ swapNth . snd
+
+weissSwitchFocus :: X ()
+weissSwitchFocus = onWindowsCount $ \c ->
+  if c <= 3
+    then windows $ \s -> skipFloating s W.focusDown
+    else selectWindow easyMotionConf >>= (`whenJust` windows . W.focusWindow)

src/WeissXMonad.hs

@@ -8,6 +8,7 @@ import Data.List
 import Data.Maybe
 import System.IO (hPutStrLn)
 import Text.Regex
+import TreeActions
 import Utils
 import WeissPromptPass
 import WeissScratchpad
@@ -16,6 +17,7 @@ import WeissXmobar
 import WorkspaceFamily
 import XMonad
 import XMonad.Actions.CycleWS
+import XMonad.Actions.EasyMotion (EasyMotionConfig (..), selectWindow)
 import XMonad.Actions.MouseResize
 import XMonad.Actions.ShowText (flashText, handleTimerEvent)
 import XMonad.Hooks.DynamicLog
@@ -30,6 +32,7 @@ import XMonad.Layout.MultiColumns
 import XMonad.Layout.NoBorders
 import XMonad.Layout.NoFrillsDecoration
 import XMonad.Layout.PerScreen (ifWider)
+import XMonad.Layout.ResizableThreeColumns (ResizableThreeCol (..))
 import XMonad.Layout.Spacing
 import XMonad.Layout.StackTile
 import XMonad.Layout.TwoPane
@@ -95,6 +98,7 @@ myLayout =
               (myMulCol ||| myTall ||| Full)
               (Mirror myTall ||| myStackTile ||| Full)
   where
+    threeCol = ResizableThreeCol 1 (3 / 100) (1 / 3) []
     myMulCol = multiCol [1, 1] 0 0.01 (-0.5)
     twoPane = TwoPane delta ratio
     myTall = Tall nmaster delta ratio
@@ -113,10 +117,10 @@ myKeys =
   , ("<XF86Launch8>", nextScreen)
   , ("<F6>", curNSP)
   , ("<F11>", withFocused toggleFloat)
-  , ("<XF86Launch6>", weissSwapMaster)
+  , ("<XF86Launch6>", weissSwitchFocus)
   , ("M-<Escape>", kill)
-  , ("M-1", weissFocusUp)
-  , ("M-2", weissFocusDown)
+  , ("M-1", weissTreeActions)
+  , ("M-2", easySwap)
   , ("M-<Up>", sendMessage Shrink)
   , ("M-<Down>", sendMessage Expand)
   , ("M-k", spawn myTerminal)
@@ -209,8 +213,3 @@ runXmonad xmobarDir = do
       ewmh $
         withEasySB (xmobarVertical xmobarDir <> xmobarHori xmobarDir) defToggleStrutsKey $
           docks myConfig
-
--- myFocusUp, myFocusDown, mySwapMaster :: X ()
--- myFocusUp = myFocusUpWithNSP myScratchPads
--- myFocusDown = myFocusDownWithNSP myScratchPads
--- mySwapMaster = mySwapMasterWithNsp myScratchPads