From c6f882fe85e3766464cc68d4edd2abe9bd08217a Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 18 Mar 2022 10:15:13 -0600 Subject: Ability to submap the mouse. Added bindings for my Logitech G502 Hero. --- src/Internal/Keys.hs | 136 +++++++++++++++++++++++++++++++++++++++---------- src/Internal/Logger.hs | 36 +++++++++++++ src/Internal/Submap.hs | 31 ++++++++++- 3 files changed, 175 insertions(+), 28 deletions(-) create mode 100644 src/Internal/Logger.hs diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 8731f42..0fd3d52 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -43,10 +43,49 @@ import qualified XMonad.StackSet as W import Internal.Lib import Internal.DMenu import Internal.PassMenu +import Internal.Logger type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ()) + +decreaseVolume = spawn "pactl set-sink-volume @DEFAULT_SINK@ -5%" +increaseVolume = spawn "pactl set-sink-volume @DEFAULT_SINK@ +5%" +playPause = spawn "spotify-control play" +mediaPrev = spawn "spotify-control prev" +mediaNext = spawn "spotify-control next" + + +button6 :: Button +button6 = 6 + +button7 :: Button +button7 = 7 + +button8 :: Button +button8 = 8 + +button9 :: Button +button9 = 9 + +button10 :: Button +button10 = 10 + +button11 :: Button +button11 = 11 + +button12 :: Button +button12 = 12 + +button13 :: Button +button13 = 13 + +button14 :: Button +button14 = 14 + +button15 :: Button +button15 = 15 + keymap :: KeyMap l keymap = runKeys $ do config <- getConfig @@ -76,7 +115,7 @@ keymap = runKeys $ do -- Button programmed on mouse rawMask shiftMask $ click >> withFocused (windows . W.sink) - shiftMod $ spawn "spotify-control play" + shiftMod playPause bind xK_F2 $ -- Button programmed on mouse @@ -91,18 +130,18 @@ keymap = runKeys $ do -- I Don't really use these, but they could be bound to something cool! bind xK_F2 $ - rawMask shiftMask $ spawn "spotify-control next" + rawMask shiftMask mediaNext bind xK_F3 $ - rawMask shiftMask $ spawn "spotify-control prev" + rawMask shiftMask mediaPrev bind xK_F10 $ do - justMod $ spawn "spotify-control play" + justMod playPause bind xK_F11 $ do - justMod $ spawn "spotify-control prev" + justMod mediaPrev bind xK_F12 $ do - justMod $ spawn "spotify-control next" + justMod mediaNext bind xK_Return $ do justMod swapMaster @@ -205,7 +244,7 @@ keymap = runKeys $ do bind xK_t $ do justMod $ spawn (terminal config) - shiftMod $ withFocused $ windows . W.sink + shiftMod $ withFocused $ windows . W.sink altMod $ spawn (terminal config ++ " -t Floating\\ Term") bind xK_v $ @@ -214,12 +253,12 @@ keymap = runKeys $ do justMod $ fix $ \recur -> subkeys $ do bind xK_h $ do justMod $ do - spawn "pactl set-sink-volume @DEFAULT_SINK@ -5%" + decreaseVolume recur bind xK_l $ do justMod $ do - spawn "pactl set-sink-volume @DEFAULT_SINK@ +5%" + increaseVolume recur bind xK_v $ do @@ -234,7 +273,7 @@ keymap = runKeys $ do bind xK_z $ do justMod $ subkeys $ do - + bind xK_g $ do (justMod -|- noMod) $ mapNextString $ \_ s -> case s of @@ -247,6 +286,9 @@ keymap = runKeys $ do str (show (map ord str)) + bind xK_t $ do + (justMod -|- noMod) $ logs "Test Log" + bind xK_n $ do (justMod -|- noMod) $ spawn (terminal config ++ " -t Notes -e notes new") @@ -269,7 +311,6 @@ keymap = runKeys $ do bind xK_v $ do (justMod -|- noMod) $ spawn "set-volume.sh" (shiftMod -|- rawMask shiftMask) $ spawn "set-volume.sh -a" - -- Double-tap Z to toggle zoom. bind xK_z $ do @@ -277,41 +318,50 @@ keymap = runKeys $ do -- Z is reserved to create sub keybindings to do various things. -- I don't really use these at the moment. - bind xK_h $ do - noMod $ spawn "spotify-control prev" + bind xK_h $ noMod mediaPrev - bind xK_l $ do - noMod $ spawn "spotify-control next" + bind xK_l $ noMod mediaNext -- Centers the current focused window. i.e. toggles the Zoom layout -- modifier. shiftMod $ sendMessage ToggleZoom + bind xF86XK_Calculator $ do + noMod $ spawn $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3" + bind xF86XK_AudioLowerVolume $ do noMod $ spawn "pactl set-sink-volume @DEFAULT_SINK@ -1%" - justMod $ spawn "spotify-control prev" + justMod mediaPrev bind xF86XK_AudioRaiseVolume $ do noMod $ spawn "pactl set-sink-volume @DEFAULT_SINK@ +1%" - justMod $ spawn "spotify-control next" + justMod mediaNext bind xF86XK_AudioMute $ do noMod $ spawn "pactl set-sink-mute @DEFAULT_SINK@ toggle" bind xF86XK_AudioPlay $ do - noMod $ spawn "spotify-control play" + noMod playPause bind xF86XK_AudioNext $ do - noMod $ spawn "spotify-control next" + noMod mediaNext bind xF86XK_AudioPrev $ do - noMod $ spawn "spotify-control prev" + noMod mediaPrev bind xF86XK_AudioPrev $ do - noMod $ spawn "spotify-control prev" + noMod mediaPrev mouseMap :: ButtonsMap l mouseMap = runButtons $ do + config <- getConfig + + let x button = Map.lookup button (mouseMap config) + + let defaultButtons button = fromMaybe (\w -> return ()) $ + Map.lookup button (mouseMap config) + subMouse = submapButtonsWithKey defaultButtons . flip runButtons config + bind button1 $ do justMod $ \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster @@ -321,17 +371,49 @@ mouseMap = runButtons $ do bind button3 $ do justMod $ \w -> focus w >> mouseResizeWindow w >> windows W.shiftMaster - bind (6 :: Button) $ + bind button6 $ justMod $ const (relativeWorkspaceShift prev) - bind (7 :: Button) $ + bind button7 $ justMod $ const (relativeWorkspaceShift next) - bind (8 :: Button) $ - justMod $ const $ spawn "spotify-control prev" + bind button8 $ + justMod $ const mediaPrev + + bind button9 $ + justMod $ const mediaNext + + bind button14 $ do + noMod $ subMouse $ do + + bind button13 $ do + noMod $ \_ -> click >> CopyWindow.kill1 + + bind button14 $ do + noMod $ \_ -> click >> sendMessage ToggleZoom + + let mediaButtons = [ + (button4, increaseVolume), + (button5, decreaseVolume), + (button2, playPause), + (button9, mediaNext), + (button8, mediaPrev), + (button6, mediaPrev), + (button7, mediaNext) + ] + + let continuous :: [(Button, X ())] -> Button -> Window -> X () + continuous actions button w = do + case find ((==button) . fst) actions of + Just (_, action) -> action + Nothing -> return () + + (subMouse $ + forM_ (map fst mediaButtons) $ \b -> + bind b $ noMod $ \w -> continuous actions b w) w - bind (9 :: Button) $ - justMod $ const $ spawn "spotify-control next" + forM_ (map fst mediaButtons) $ \b -> + bind b $ noMod $ continuous mediaButtons b applyKeys :: XConfig l -> IO (XConfig l) applyKeys config = diff --git a/src/Internal/Logger.hs b/src/Internal/Logger.hs new file mode 100644 index 0000000..f1960fb --- /dev/null +++ b/src/Internal/Logger.hs @@ -0,0 +1,36 @@ +module Internal.Logger where + +import XMonad +import qualified XMonad.Util.ExtensibleState as XS +import System.IO + +data LoggerState = + LoggerState { + logHandle :: Maybe Handle + } + +instance Read LoggerState where + readsPrec i s = map (\(_, s) -> (LoggerState Nothing, s)) (readsPrec i s :: [((), String)]) + +instance Show LoggerState where + show _ = show () + +instance ExtensionClass LoggerState where + initialValue = LoggerState Nothing + +logs :: String -> X () +logs s = do + LoggerState handle' <- XS.get + + handle <- + case handle' of + Nothing -> do + handle <- io $ openFile "/tmp/xmonad.log" AppendMode + XS.put $ LoggerState (Just handle) + return handle + + Just h -> return h + + io $ do + hPutStrLn handle s + hFlush handle diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs index cdc2f95..40becdc 100644 --- a/src/Internal/Submap.hs +++ b/src/Internal/Submap.hs @@ -1,7 +1,13 @@ -module Internal.Submap (mapNextString, module X) where +module Internal.Submap ( + mapNextString, + submapButtonsWithKey, + nextButton, + module X) where import XMonad hiding (keys) import Control.Monad.Fix (fix) +import qualified Data.Map as Map +import Data.Map (Map) import XMonad.Actions.Submap as X @@ -26,3 +32,26 @@ mapNextString fn = do io $ ungrabKeyboard d currentTime fn m str + +nextButton :: X (ButtonMask, Button) +nextButton = do + XConf { theRoot = root, display = d } <- ask + io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime + + ret <- io $ allocaXEvent $ \xEv -> do + maskEvent d buttonPressMask xEv + ButtonEvent { ev_button = button, ev_state = m } <- getEvent xEv + return (m, button) + + io $ ungrabPointer d currentTime + + return ret + +submapButtonsWithKey :: + ((ButtonMask, Button) -> Window -> X ()) -> (Map (ButtonMask, Button) (Window -> X ())) -> Window -> X () +submapButtonsWithKey defaultAction actions window = do + arg <- nextButton + + case Map.lookup arg actions of + Nothing -> defaultAction arg window + Just fn -> fn window -- cgit From b810758e6a418db3eb6c5d1ab504273f01b7b00d Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 18 Mar 2022 10:17:09 -0600 Subject: Minor fixes to weather and bluetooth scripts. --- extras/HOME/.xmonad/xmobar-bluetooth | 24 +++++++++++-------- extras/HOME/.xmonad/xmobar-weather | 46 ++++++++++++++++++------------------ 2 files changed, 37 insertions(+), 33 deletions(-) diff --git a/extras/HOME/.xmonad/xmobar-bluetooth b/extras/HOME/.xmonad/xmobar-bluetooth index 9b4f5cc..16a6d70 100755 --- a/extras/HOME/.xmonad/xmobar-bluetooth +++ b/extras/HOME/.xmonad/xmobar-bluetooth @@ -2,17 +2,21 @@ cur="" -bluetoothctl -- info | while read line ; do - key=${line%%: *} - value=${line//*: } +if [ -d /sys/class/bluetooth ] ; then - if [ "$key" == "Name" ] ; then - cur="$value" - fi + bluetoothctl -- info | while read line ; do + key=${line%%: *} + value=${line//*: } - if [ "$key" == "Connected" -a "$value" == "yes" ] ; then - exec echo "$cur │ " - fi -done + if [ "$key" == "Name" ] ; then + cur="$value" + fi + + if [ "$key" == "Connected" -a "$value" == "yes" ] ; then + exec echo "$cur │ " + fi + done + +fi exec echo "│ " diff --git a/extras/HOME/.xmonad/xmobar-weather b/extras/HOME/.xmonad/xmobar-weather index 6b5c409..0fee524 100755 --- a/extras/HOME/.xmonad/xmobar-weather +++ b/extras/HOME/.xmonad/xmobar-weather @@ -69,30 +69,30 @@ if ($current_str gt $sunrise_str and $current_str lt $sunset_str) { $dir=%directions{$wind_direction}; %conditions_day = ( - clear => "", - sunny => "", - mostly_clear => "", - mostly_sunny => "", - partly_sunny => "", - fair => "🌑", - cloudy =>"摒", - overcast =>"", - partly_cloudy => "杖", - mostly_cloudy => "", - considerable_cloudiness => "ﭽ" ); + clear => "", + sunny => "", + mostly_clear => "", + mostly_sunny => "", + partly_sunny => "", + fair => "🌑", + cloudy =>"摒", + overcast =>"", + partly_cloudy => "杖", + mostly_cloudy => "", + considerable_cloudiness => "ﭽ" ); %conditions_night = ( - clear => "", - sunny => "", - mostly_clear => "", - mostly_sunny => "", - partly_sunny => "", - fair => "🌑", - cloudy =>"摒", - overcast =>"", - partly_cloudy => "", - mostly_cloudy => "", - considerable_cloudiness => "ﭽ" ); + clear => "", + sunny => "", + mostly_clear => "", + mostly_sunny => "", + partly_sunny => "", + fair => "🌑", + cloudy =>"摒", + overcast =>"", + partly_cloudy => "", + mostly_cloudy => "", + considerable_cloudiness => "ﭽ" ); if ($is_day) { $conditions = %conditions_day{$sky_conditions}; @@ -100,4 +100,4 @@ if ($is_day) { $conditions = %conditions_night{$sky_conditions}; } -printf("$city $dir ${wind_speed} $conditions %.0f°F\n", $temp); +printf("$city $dir ${wind_speed} $conditions %.0f°F\n", $temp); -- cgit From a87cbc7357566b26c7dca7538d4b03da5f8b999a Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 18 Mar 2022 17:47:40 -0600 Subject: Add experimental motion events. Not super useful at the moment, but might be in the future. --- package.yaml | 1 + src/Internal/Keys.hs | 17 ++++++++++++++++- src/Internal/Submap.hs | 15 +++++++++++++++ src/Main.hs | 1 + 4 files changed, 33 insertions(+), 1 deletion(-) diff --git a/package.yaml b/package.yaml index 318a3af..b07f2df 100644 --- a/package.yaml +++ b/package.yaml @@ -21,3 +21,4 @@ dependencies: - split - mtl - transformers + - monad-loops diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 0fd3d52..195e12f 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -1,6 +1,7 @@ {-# LANGUAGE RankNTypes #-} module Internal.Keys (applyKeys) where +import Control.Monad.Loops (iterateWhile) import Control.Monad.Fix (fix) import Graphics.X11.ExtraTypes.XF86; import Internal.KeysM @@ -230,6 +231,19 @@ keymap = runKeys $ do bind xK_q $ do shiftMod $ spawn "xmonad --recompile && xmonad --restart" + + justMod $ subkeys $ do + + bind xK_q $ + (justMod -|- noMod) $ do + firstMotion@(x, y) <- nextMotion + (x', y') <- iterateWhile (==firstMotion) nextMotion + + logs $ printf "Motion: (%d, %d) (%d, %d)" x y x' y' + + if (x' - x) < 0 + then mediaPrev + else mediaNext bind xK_r $ do justMod runDMenu @@ -319,7 +333,7 @@ keymap = runKeys $ do -- Z is reserved to create sub keybindings to do various things. -- I don't really use these at the moment. bind xK_h $ noMod mediaPrev - + bind xK_j $ noMod playPause bind xK_l $ noMod mediaNext -- Centers the current focused window. i.e. toggles the Zoom layout @@ -402,6 +416,7 @@ mouseMap = runButtons $ do (button7, mediaNext) ] + let continuous :: [(Button, X ())] -> Button -> Window -> X () continuous actions button w = do case find ((==button) . fst) actions of diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs index 40becdc..e5968ff 100644 --- a/src/Internal/Submap.hs +++ b/src/Internal/Submap.hs @@ -2,6 +2,7 @@ module Internal.Submap ( mapNextString, submapButtonsWithKey, nextButton, + nextMotion, module X) where import XMonad hiding (keys) @@ -47,6 +48,20 @@ nextButton = do return ret +nextMotion :: X (Int, Int) +nextMotion = do + XConf { theRoot = root, display = d } <- ask + io $ grabPointer d root False pointerMotionMask grabModeAsync grabModeAsync 0 0 currentTime + + ret <- io $ allocaXEvent $ \xEv -> do + maskEvent d pointerMotionMask xEv + MotionEvent { ev_x = x, ev_y = y } <- getEvent xEv + return (fromIntegral x, fromIntegral y) + + io $ ungrabPointer d currentTime + + return ret + submapButtonsWithKey :: ((ButtonMask, Button) -> Window -> X ()) -> (Map (ButtonMask, Button) (Window -> X ())) -> Window -> X () submapButtonsWithKey defaultAction actions window = do diff --git a/src/Main.hs b/src/Main.hs index f70496c..cda3ae2 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -13,6 +13,7 @@ import Data.Monoid import Internal.XMobarLog import Internal.Keys import Internal.Layout +import Internal.Logger import Internal.DMenu (menuCommandString) import qualified XMonad as X -- cgit