----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.AfterDrag -- Description : Allows you to add actions dependent on the current mouse drag. -- Copyright : (c) 2014 Anders Engstrom <ankaan@gmail.com> -- License : BSD3-style (see LICENSE) -- -- Maintainer : Anders Engstrom <ankaan@gmail.com> -- Stability : unstable -- Portability : unportable -- -- Perform an action after the current mouse drag is completed. ----------------------------------------------------------------------------- module XMonad.Actions.AfterDrag ( -- * Usage -- $usage afterDrag, ifClick, ifClick') where import XMonad import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.AfterDrag -- -- Then add appropriate mouse bindings, for example: -- -- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (windows $ W.float w $ W.RationalRect 0 0 1 1))) -- -- This will allow you to resize windows as usual, but if you instead of -- draging click the mouse button the window will be automatically resized to -- fill the whole screen. -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". -- -- More practical examples are available in "XMonad.Actions.FloatSnap". -- | Schedule a task to take place after the current dragging is completed. afterDrag :: X () -- ^ The task to schedule. -> X () afterDrag :: X () -> X () afterDrag X () task = do Maybe (Position -> Position -> X (), X ()) drag <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a gets XState -> Maybe (Position -> Position -> X (), X ()) dragging case Maybe (Position -> Position -> X (), X ()) drag of Maybe (Position -> Position -> X (), X ()) Nothing -> forall (m :: * -> *) a. Monad m => a -> m a return () -- Not dragging Just (Position -> Position -> X () motion, X () cleanup) -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify forall a b. (a -> b) -> a -> b $ \XState s -> XState s { dragging :: Maybe (Position -> Position -> X (), X ()) dragging = forall a. a -> Maybe a Just(Position -> Position -> X () motion, X () cleanup forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> X () task) } -- | Take an action if the current dragging can be considered a click, -- supposing the drag just started before this function is called. -- A drag is considered a click if it is completed within 300 ms. ifClick :: X () -- ^ The action to take if the dragging turned out to be a click. -> X () ifClick :: X () -> X () ifClick X () action = Int -> X () -> X () -> X () ifClick' Int 300 X () action (forall (m :: * -> *) a. Monad m => a -> m a return ()) -- | Take an action if the current dragging is completed within a certain time (in milliseconds.) ifClick' :: Int -- ^ Maximum time of dragging for it to be considered a click (in milliseconds.) -> X () -- ^ The action to take if the dragging turned out to be a click. -> X () -- ^ The action to take if the dragging turned out to not be a click. -> X () ifClick' :: Int -> X () -> X () -> X () ifClick' Int ms X () click X () drag = do UTCTime start <- forall (m :: * -> *) a. MonadIO m => IO a -> m a io IO UTCTime getCurrentTime X () -> X () afterDrag forall a b. (a -> b) -> a -> b $ do UTCTime stop <- forall (m :: * -> *) a. MonadIO m => IO a -> m a io IO UTCTime getCurrentTime if UTCTime -> UTCTime -> NominalDiffTime diffUTCTime UTCTime stop UTCTime start forall a. Ord a => a -> a -> Bool <= (forall a b. (Integral a, Num b) => a -> b fromIntegral Int ms forall a. Fractional a => a -> a -> a / NominalDiffTime 10forall a b. (Num a, Integral b) => a -> b -> a ^(Integer 3 :: Integer) :: NominalDiffTime) then X () click else X () drag