Merge branch 'v017' of git.josher.dev:rde into v017

3 files changed, 206 insertions, 29 deletions

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index ab8869e..58d2ecb 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
@@ -43,10 +44,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 +116,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 +131,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
@@ -191,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
@@ -205,7 +258,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 +267,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 +287,7 @@ keymap = runKeys $ do
   bind xK_z $ do
 
     justMod $ subkeys $ do
-      
+
       bind xK_g $ do
         (justMod -|- noMod) $ mapNextString $ \_ s ->
           case s of
@@ -247,6 +300,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 +325,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,38 +332,39 @@ 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_l $ do
-        noMod $ spawn "spotify-control next"
+      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
     -- 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
 
   bind xF86XK_MonBrightnessUp $ do
     noMod $ spawn "set-backlight.sh +0.05"
@@ -321,6 +377,14 @@ keymap = runKeys $ do
 
 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
 
@@ -330,17 +394,50 @@ 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..e5968ff 100644
--- a/src/Internal/Submap.hs
+++ b/src/Internal/Submap.hs
@@ -1,7 +1,14 @@
-module Internal.Submap (mapNextString, module X) where
+module Internal.Submap (
+    mapNextString,
+    submapButtonsWithKey,
+    nextButton,
+    nextMotion,
+    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 +33,40 @@ 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
+
+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
+  arg <- nextButton
+
+  case Map.lookup arg actions of
+    Nothing -> defaultAction arg window
+    Just fn -> fn window