From 1123888c5d395e402e067315800f4e7bf561d023 Mon Sep 17 00:00:00 2001 From: Jan Vornberger Date: Sun, 29 Nov 2009 00:43:10 +0100 Subject: Extended decoration module with more hooks and consolidated some existing ones Ignore-this: 5a23af3009ecca2feb9a84f8c6f8ac33 darcs-hash:20091128234310-594c5-8b6cd110f95678fd49fa1c20b0d4c69ef0fbeec5.gz --- XMonad/Layout/Decoration.hs | 75 +++++++++++++++++++++++---------------- XMonad/Layout/TabBarDecoration.hs | 2 +- XMonad/Layout/Tabbed.hs | 9 +++-- 3 files changed, 50 insertions(+), 36 deletions(-) (limited to 'XMonad/Layout') diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs index 9288d4e..afb2ad6 100644 --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Decoration --- Copyright : (c) 2007 Andrea Rossato +-- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it @@ -32,6 +32,7 @@ module XMonad.Layout.Decoration import Control.Monad (when) import Data.Maybe import Data.List +import Foreign.C.Types(CInt) import XMonad import qualified XMonad.StackSet as W @@ -138,23 +139,29 @@ class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where shrink :: ds a -> Rectangle -> Rectangle -> Rectangle shrink _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh) - -- | The decoration event hook, where the - -- 'decorationMouseFocusHook' and 'decorationMouseDragHook' are - -- called. If you reimplement it those methods will not be - -- called. + -- | The decoration event hook decorationEventHook :: ds a -> DecorationState -> Event -> X () - decorationEventHook ds s e = do decorationMouseFocusHook ds s e - decorationMouseDragHook ds s e - - -- | This method is called when the user clicks the pointer over - -- the decoration. - decorationMouseFocusHook :: ds a -> DecorationState -> Event -> X () - decorationMouseFocusHook _ s e = handleMouseFocusDrag False s e - - -- | This method is called when the user starts grabbing the - -- decoration. - decorationMouseDragHook :: ds a -> DecorationState -> Event -> X () - decorationMouseDragHook _ s e = handleMouseFocusDrag True s e + decorationEventHook ds s e = handleMouseFocusDrag ds s e + + -- | A hook that can be used to catch the cases when the user + -- clicks on the decoration. If you return True here, the click event + -- will be considered as dealt with and no further processing will take place. + decorationCatchClicksHook :: ds a + -> Window + -> Int -- ^ distance from the left where the click happened on the decoration + -> Int -- ^ distance from the right where the click happened on the decoration + -> X Bool + decorationCatchClicksHook _ _ _ _ = return False + + -- | This hook is called while a window is dragged using the decoration. + -- The hook can be overwritten if a different way of handling the dragging + -- is required. + decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () + decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleDraggingInProgress ex ey (mainw, r) x y + + -- | This hoook is called after a window has been dragged using the decoration. + decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X () + decorationAfterDraggingHook _ds (mainw, _r) _decoWin = focus mainw -- | The pure version of the main method, 'decorate'. pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle @@ -285,22 +292,30 @@ handleEvent _ _ _ _ = return () -- | Mouse focus and mouse drag are handled by the same function, this -- way we can start dragging unfocused windows too. -handleMouseFocusDrag :: Bool -> DecorationState -> Event -> X () -handleMouseFocusDrag b (DS dwrs _) ButtonEvent { ev_window = ew - , ev_event_type = et - , ev_x_root = ex - , ev_y_root = ey } +handleMouseFocusDrag :: (DecorationStyle ds a) => ds a -> DecorationState -> Event -> X () +handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window = ew + , ev_event_type = et + , ev_x_root = ex + , ev_y_root = ey } | et == buttonPress - , Just ((mainw,r),_) <- lookFor ew dwrs = do - focus mainw - when b $ mouseDrag (\x y -> do - let rect = Rectangle (x - (fi ex - rect_x r)) - (y - (fi ey - rect_y r)) - (rect_width r) - (rect_height r) - sendMessage (SetGeometry rect)) (return ()) + , Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do + let Just (Rectangle dx _ dwh _) = decoRectM + distFromLeft = ex - fi dx + distFromRight = fi dwh - (ex - fi dx) + dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight) + when (not dealtWith) $ do + mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y) + (decorationAfterDraggingHook ds (mainw, r) ew) handleMouseFocusDrag _ _ _ = return () +handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () +handleDraggingInProgress ex ey (_, r) x y = do + let rect = Rectangle (x - (fi ex - rect_x r)) + (y - (fi ey - rect_y r)) + (rect_width r) + (rect_height r) + sendMessage $ SetGeometry rect + -- | Given a window and the state, if a matching decoration is in the -- state return it with its ('Maybe') 'Rectangle'. lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle)) diff --git a/XMonad/Layout/TabBarDecoration.hs b/XMonad/Layout/TabBarDecoration.hs index 5305428..f8be09c 100644 --- a/XMonad/Layout/TabBarDecoration.hs +++ b/XMonad/Layout/TabBarDecoration.hs @@ -66,7 +66,7 @@ data TabBarDecoration a = TabBar XPPosition deriving (Read, Show) instance Eq a => DecorationStyle TabBarDecoration a where describeDeco _ = "TabBar" shrink _ _ r = r - decorationMouseDragHook _ _ _ = return () + decorationCatchClicksHook _ mainw _ _ = focus mainw >> return True pureDecoration (TabBar p) _ dht (Rectangle x y wh ht) s _ (w,_) = if isInStack s w then Just $ Rectangle nx ny wid (fi dht) else Nothing where wrs = S.integrate s diff --git a/XMonad/Layout/Tabbed.hs b/XMonad/Layout/Tabbed.hs index 469c5d5..288ea2b 100644 --- a/XMonad/Layout/Tabbed.hs +++ b/XMonad/Layout/Tabbed.hs @@ -155,17 +155,16 @@ data TabbedDecoration a = Tabbed TabbarLocation TabbarShown deriving (Read, Show instance Eq a => DecorationStyle TabbedDecoration a where describeDeco (Tabbed Top _ ) = "Tabbed" describeDeco (Tabbed Bottom _ ) = "Tabbed Bottom" - decorationMouseFocusHook _ ds ButtonEvent { ev_window = ew - , ev_event_type = et - , ev_button = eb } + decorationEventHook _ ds ButtonEvent { ev_window = ew + , ev_event_type = et + , ev_button = eb } | et == buttonPress , Just ((w,_),_) <-findWindowByDecoration ew ds = if eb == button2 then killWindow w else focus w - decorationMouseFocusHook _ _ _ = return () + decorationEventHook _ _ _ = return () - decorationMouseDragHook _ _ _ = return () pureDecoration (Tabbed lc sh) _ ht _ s wrs (w,r@(Rectangle x y wh hh)) = if ((sh == Always && numWindows > 0) || numWindows > 1) then Just $ case lc of -- cgit v1.2.3