[feat] better use of rdectl in xmobar.

1 files changed, 81 insertions, 2 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index bbf182f..b6f8737 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -1,4 +1,4 @@
-module Rahm.Desktop.Keys (applyKeys) where
+module Rahm.Desktop.Keys (applyKeys, commandHandler) where
 
 import Control.Applicative
 import Control.Monad
@@ -19,7 +19,7 @@ import Control.Monad.Writer
     lift,
     tell,
   )
-import Data.Char (isAlpha, toLower)
+import Data.Char (isAlpha, isSpace, toLower)
 import Data.IORef
 import Data.List (foldl', isInfixOf)
 import Data.List.Safe ((!!))
@@ -39,6 +39,7 @@ import Graphics.X11.ExtraTypes.XF86
     xF86XK_AudioPrev,
     xF86XK_AudioRaiseVolume,
     xF86XK_Calculator,
+    xF86XK_Display,
     xF86XK_MonBrightnessDown,
     xF86XK_MonBrightnessUp,
   )
@@ -109,6 +110,7 @@ import Rahm.Desktop.RebindKeys
   ( remapKey,
     sendKey,
   )
+import Rahm.Desktop.Server (CommandHandler (..), (<<>>))
 import Rahm.Desktop.StackSet (screens)
 import qualified Rahm.Desktop.StackSet as W
 import Rahm.Desktop.Submap
@@ -118,6 +120,7 @@ import Rahm.Desktop.Submap
     submapButtonsWithKey,
   )
 import Rahm.Desktop.SwapMaster (swapMaster)
+import Rahm.Desktop.TabletMode
 import Rahm.Desktop.Theater
   ( restoreTheater,
   )
@@ -137,6 +140,7 @@ import Rahm.Desktop.XMobarLog.PendingBuffer
   )
 import System.Exit (exitFailure, exitSuccess)
 import Text.Printf (printf)
+import Text.Read (readMaybe)
 import XMonad as X
 import XMonad.Actions.CopyWindow as CopyWindow
 import XMonad.Actions.RotSlaves
@@ -163,6 +167,31 @@ spawnX = spawn
 safeSpawnX :: String -> [String] -> X ()
 safeSpawnX = safeSpawn
 
+parseNumber :: (Read a, Num a) => String -> Maybe a
+parseNumber s
+  | "0x" `isPrefixOf` s || "0X" `isPrefixOf` s = readMaybeHex (drop 2 s)
+  | "0b" `isPrefixOf` s || "0B" `isPrefixOf` s = readMaybeBinary (drop 2 s)
+  | otherwise = readMaybe s
+  where
+    readMaybeHex str =
+      let trimmed = takeWhile (not . isSpace) str
+       in if all isValidHexChar trimmed
+            then readMaybe trimmed
+            else Nothing
+    readMaybeBinary str =
+      let trimmed = takeWhile (not . isSpace) str
+       in if all (`elem` "01") trimmed
+            then readMaybe trimmed
+            else Nothing
+
+isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
+isPrefixOf _ [] = True
+isPrefixOf [] _ = False
+isPrefixOf (x : xs) (y : ys) = x == y && isPrefixOf xs ys
+
+isValidHexChar :: Char -> Bool
+isValidHexChar c = c `elem` "0123456789abcdefABCDEF"
+
 selectedWindowsColor = BorderColor "#00ffff" "#00ffff"
 
 decreaseVolume = do
@@ -1057,6 +1086,10 @@ bindings = do
     justMod $ spawnX "set-backlight.sh 0.01"
     rawMask shiftMask $ spawnX "set-backlight.sh 0"
 
+  bind xF86XK_Display $ do
+    noMod toggleTabletMode
+    justMod toggleTabletMode
+
   -- Button bindings. These are bindings to buttons on my mouse.
   --
   -- I usre a G502 SE HERO Gaming Mouse. This mouse has 13 buttons on it. The
@@ -1109,6 +1142,11 @@ bindings = do
       doc "Media next" $
         noWindow mediaNext
 
+  bind syntheticKeyStartDrag $
+    noMod $
+      subbind $ do
+        bind button1 $ noMod $ noWindow D.dragWindow
+
   let button14Binder = do
         bind button3 $
           noMod $
@@ -1357,6 +1395,47 @@ bindings = do
 
   localKeys
 
+data RdeBasicCommand where
+  Goto :: String -> RdeBasicCommand
+  Shift :: String -> String -> RdeBasicCommand
+  Wheel :: RdeBasicCommand
+  ToNextLayout :: RdeBasicCommand
+  SyntheticKeySym :: ButtonMask -> KeySym -> RdeBasicCommand
+
+rdeBasicCommandHandler :: CommandHandler RdeBasicCommand
+rdeBasicCommandHandler =
+  CommandHandler
+    ( \str -> case words str of
+        ["goto", s] -> Just $ Goto s
+        ["shift", s1, s2] -> Just $ Shift s1 s2
+        ["wheel"] -> Just Wheel
+        ["next-layout"] -> Just ToNextLayout
+        ["keysym", w] | Just w' <- parseNumber w -> Just (SyntheticKeySym 0 w')
+        ["keysym", m, w] | Just m' <- parseNumber m, Just w' <- parseNumber w -> Just (SyntheticKeySym m' w')
+        _ -> Nothing
+    )
+    ( \c -> pushPendingBuffer "" $ case c of
+        Wheel -> displayWorkspaceWheelInCenter
+        Goto w -> runMaybeT_ $ do
+          ws <- workspaceForStringT w
+          lift $ do
+            logs Info "Goto Workspace: %s" (fromMaybe "?" $ workspaceName ws)
+            gotoWorkspaceFn ws
+        Shift wins ws -> runMaybeT_ $ do
+          wins <- locationSetForStringT wins
+          workspace <- workspaceForStringT ws
+          lift $ do
+            movement <- moveWindowsToWorkspaceFn workspace (mapMaybe locationWindow wins)
+            windows movement
+        SyntheticKeySym mask keySym -> do
+          logs Info "Got synthetic keysym mask %s %s" (show mask) (show keySym)
+          keyMap <- asks (\c -> keys (config c) (config c))
+          sequence_ $ Map.lookup (mask, keySym) keyMap
+        ToNextLayout -> sendMessage toNextLayout
+    )
+
+commandHandler = rdeBasicCommandHandler <<>> tabletModeCommandHandler
+
 cornersConfig :: Map ScreenCorner (X ())
 cornersConfig =
   Map.fromList