aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop')
-rw-r--r--src/Rahm/Desktop/Keys.hs83
-rw-r--r--src/Rahm/Desktop/Keys/Wml.hs4
-rw-r--r--src/Rahm/Desktop/Submap.hs1
-rw-r--r--src/Rahm/Desktop/TabletMode.hs7
-rw-r--r--src/Rahm/Desktop/WorkspaceWheel.hs3
-rw-r--r--src/Rahm/Desktop/XMobarLog.hs17
6 files changed, 104 insertions, 11 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
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
"<fc=#f0f0a0><action=`sleep 0.2 && rdectl wheel`> \11096 </action></fc>",
"<fc=#f08080><action=`rdectl shift . _`> ✗ </action></fc>",
"<fc=#808080><action=`rofi -monitor -4 -display-run Execute -show run -normal-window`>\61728 </action></fc>",
- "<fc=#80f080><action=`rdectl next-rotation`> \58183 </action></fc>"
+ "<fc=#80f080><action=`rdectl next-rotation`> \58183 </action></fc>",
+ "<fc=#80f080><action=`sleep 0.2 && rdectl keysym " ++ show syntheticKeyStartDrag ++ "`> \983486 </action></fc>"
]
else "<action=`rdectl tablet-mode on`><fc=#66cc66> \61705 </fc></action>"
)
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 "<fc=%s><fn=3> " pendingBufferColor
tell pendingBuffer
@@ -131,7 +131,8 @@ xMobarLogHook = do
tell $ toAction $ S.tag ws
tell "</fc></fn> "
- tell "<fc=#888888>| </fc>"
+ tell tabletMode
+
tell "<fc=#ff8888><fn=3>"
tell title
tell "</fn></fc>"
@@ -143,7 +144,7 @@ xMobarLogHook = do
| isAsciiUpper ch
|| isAsciiLower ch
|| isDigit ch =
- printf "<action=`xdotool key 'Super_L+g' '%s'` button=1><action=`xdotool key 'Super_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
+ printf "<action=`rdectl goto '%s'` button=1><action=`rdectl shift '.' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
toAction ch = ch
toTheaterAction [ch]
@@ -156,7 +157,7 @@ xMobarLogHook = do
toChangeLayoutAction :: String -> String
toChangeLayoutAction =
printf
- "<action=`xdotool key --delay 50 'Super_L+space' 'Super_L+n'` button=1>\
+ "<action=`rdectl next-layout` button=1>\
\<action=`xdotool key --delay 50 'Super_L+space' 'Super_L+p'` button=3>\
\%s</action></action>"
generated by cgit (git 2.34.1) at 2026-10-19 18:40:27 +0000