From 4640ebf48af5ca56e162016b43bbd20f689dd5da Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 27 Apr 2026 14:35:18 -0600 Subject: [feat] better use of rdectl in xmobar. --- src/Rahm/Desktop/Keys.hs | 83 +++++++++++++++++++++++++++++++++++++- src/Rahm/Desktop/Keys/Wml.hs | 4 ++ src/Rahm/Desktop/Submap.hs | 1 + src/Rahm/Desktop/TabletMode.hs | 7 +++- src/Rahm/Desktop/WorkspaceWheel.hs | 3 ++ src/Rahm/Desktop/XMobarLog.hs | 17 ++++---- 6 files changed, 104 insertions(+), 11 deletions(-) (limited to 'src/Rahm') 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 diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs index e64c6e0..2d4562a 100644 --- a/src/Rahm/Desktop/Keys/Wml.hs +++ b/src/Rahm/Desktop/Keys/Wml.hs @@ -41,6 +41,7 @@ module Rahm.Desktop.Keys.Wml workspaceForStringT, workspaceForString, locationSetForKeysT, + locationSetForStringT, locationSetForKeys, readNextWorkspaceName, workspaceName, @@ -459,6 +460,9 @@ workspaceForStringT = workspaceForKeysT . map (\c -> (def, def, [c])) workspaceForString :: String -> X (Maybe Workspace) workspaceForString = runMaybeT . workspaceForStringT +locationSetForStringT :: String -> MaybeT X [Location] +locationSetForStringT = locationSetForKeysT . map (\c -> (def, def, [c])) + -- Like the above, but unwrap the MaybeT locationSetForKeysT :: KeyString -> MaybeT X [Location] locationSetForKeysT s = runKeyFeedWithKeys s readNextLocationSet diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs index 46508d7..15166fd 100644 --- a/src/Rahm/Desktop/Submap.hs +++ b/src/Rahm/Desktop/Submap.hs @@ -124,6 +124,7 @@ data ButtonOrKeyEvent event_keycode :: KeyCode, event_string :: String } + deriving (Show) nextButtonOrKeyEvent :: MaybeT X ButtonOrKeyEvent nextButtonOrKeyEvent = do diff --git a/src/Rahm/Desktop/TabletMode.hs b/src/Rahm/Desktop/TabletMode.hs index e0f490a..b13e919 100644 --- a/src/Rahm/Desktop/TabletMode.hs +++ b/src/Rahm/Desktop/TabletMode.hs @@ -30,6 +30,7 @@ module Rahm.Desktop.TabletMode RotationAngle (..), tabletModeXMobarString, tabletModeCommandHandler, + syntheticKeyStartDrag, ) where @@ -64,6 +65,9 @@ import XMonad import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.Run (runProcessWithInput) +syntheticKeyStartDrag :: KeySym +syntheticKeyStartDrag = 0x1100000000000011 + -- | Rotation angle for the display data RotationAngle = -- | Normal orientation (0°) @@ -257,7 +261,8 @@ tabletModeXMobarString = do " \11096 ", " ✗ ", "\61728 ", - " \58183 " + " \58183 ", + " \983486 " ] else " \61705 " ) diff --git a/src/Rahm/Desktop/WorkspaceWheel.hs b/src/Rahm/Desktop/WorkspaceWheel.hs index a89dc6a..b5cba52 100644 --- a/src/Rahm/Desktop/WorkspaceWheel.hs +++ b/src/Rahm/Desktop/WorkspaceWheel.hs @@ -31,6 +31,7 @@ import Text.Printf (printf) import XMonad import qualified XMonad.Operations as X import XMonad.Util.Run (spawnPipe) +import Rahm.Desktop.Logger (logs, LogLevel (Debug)) dzenSize :: (Integral a) => a dzenSize = 100 @@ -117,6 +118,8 @@ displayWorkspaceWheelAtPoint wheelType px py = do let stop = return () let retry = recur ring + logs Debug "Workspace Wheel Event: %s" (show evt) + case evt of Nothing -> return stop -- timeout Just (ButtonPress _ b) diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs index 980cbe7..b624301 100644 --- a/src/Rahm/Desktop/XMobarLog.hs +++ b/src/Rahm/Desktop/XMobarLog.hs @@ -31,6 +31,7 @@ import XMonad (X) import qualified XMonad as X (XState (windowset), gets, io) import XMonad.Util.NamedWindows (getName) import XMonad.Util.Run (runProcessWithInput, spawnPipe) +import Rahm.Desktop.TabletMode (tabletModeXMobarString) newtype XMobarLog = XMobarLog Handle @@ -48,10 +49,7 @@ spawnXMobar :: IO XMobarLog spawnXMobar = do putStrLn "get dpi" dpi <- getDPI - let scale = dpi / 120 - - putStrLn $ "DPI: " ++ show dpi - putStrLn $ "scale: " ++ show scale + let scale = dpi / 144 pipe <- spawnPipe $ @@ -83,6 +81,8 @@ xMobarLogHook = do uname <- getUname unameRef + tabletMode <- tabletModeXMobarString + let pendingBufferSize = max 10 $ length uname let (pendingBufferColor, pendingBuffer') = @@ -98,7 +98,7 @@ xMobarLogHook = do let wss = getPopulatedWorkspaces winset - let log = trunc 80 $ + let log = trunc 120 $ execWriter $ do tell $ printf " " pendingBufferColor tell pendingBuffer @@ -131,7 +131,8 @@ xMobarLogHook = do tell $ toAction $ S.tag ws tell " " - tell "| " + tell tabletMode + tell "" tell title tell "" @@ -143,7 +144,7 @@ xMobarLogHook = do | isAsciiUpper ch || isAsciiLower ch || isDigit ch = - printf "%s" [ch] [ch] [ch] + printf "%s" [ch] [ch] [ch] toAction ch = ch toTheaterAction [ch] @@ -156,7 +157,7 @@ xMobarLogHook = do toChangeLayoutAction :: String -> String toChangeLayoutAction = printf - "\ + "\ \\ \%s" -- cgit