diff options
Diffstat (limited to 'MetaTile')
| -rw-r--r-- | MetaTile/Config.hs | 23 | ||||
| -rw-r--r-- | MetaTile/Core.hs | 2 | ||||
| -rw-r--r-- | MetaTile/Layout.hs | 1 | ||||
| -rw-r--r-- | MetaTile/Layout/Floating.hs | 105 | ||||
| -rw-r--r-- | MetaTile/Layout/LayoutModifier.hs | 2 | ||||
| -rw-r--r-- | MetaTile/Main.hsc | 5 | ||||
| -rw-r--r-- | MetaTile/ManageHook.hs | 2 | ||||
| -rw-r--r-- | MetaTile/Operations.hs | 35 | ||||
| -rw-r--r-- | MetaTile/StackSet.hs | 17 |
9 files changed, 128 insertions, 64 deletions
diff --git a/MetaTile/Config.hs b/MetaTile/Config.hs index 71706d8..b553bd4 100644 --- a/MetaTile/Config.hs +++ b/MetaTile/Config.hs @@ -20,7 +20,7 @@ -- ------------------------------------------------------------------------ -module MetaTile.Config (defaultConfig, Default(..)) where +module MetaTile.Config (Default(..)) where -- -- Useful imports @@ -34,7 +34,10 @@ import qualified MetaTile.Core as MetaTile ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,defaultBorderWidth,focusFollowsMouse ,handleEventHook,clickJustFocuses,rootMask,frameMask,clientMask) +import Prelude hiding (Floating) import MetaTile.Layout +import MetaTile.Layout.Floating +import MetaTile.Layout.LayoutModifier import MetaTile.Operations import qualified MetaTile.StackSet as W import Data.Bits ((.|.)) @@ -128,7 +131,7 @@ startupHook = return () -- | The available layouts. Note that each layout is separated by |||, which -- denotes layout choice. -layout = tiled ||| Mirror tiled ||| Full +layout = floating $ tiled ||| Mirror tiled ||| Full where -- default tiling algorithm partitions the screen into two panes tiled = Tall nmaster delta ratio @@ -209,6 +212,9 @@ keys conf@(XConfig {MetaTile.modMask = modMask}) = M.fromList $ , ((modMask, xK_h ), sendMessage Shrink) -- %! Shrink the master area , ((modMask, xK_l ), sendMessage Expand) -- %! Expand the master area + -- floating layer support + , ((modMask, xK_t ), withFocused sink) -- %! Push window back into tiling + -- increase or decrease number of windows in the master area , ((modMask , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area , ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area @@ -237,12 +243,16 @@ keys conf@(XConfig {MetaTile.modMask = modMask}) = M.fromList $ -- | Mouse bindings: default actions bound to mouse events mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) mouseBindings (XConfig {MetaTile.modMask = modMask}) = M.fromList + -- mod-button1 %! Set the window to floating mode and move by dragging + [ ((modMask, button1), \w -> focus w >> mouseMoveWindow w) -- mod-button2 %! Raise the window to the top of the stack - [ ((modMask, button2), windows . (W.shiftMaster .) . W.focusWindow) + , ((modMask, button2), windows . (W.shiftMaster .) . W.focusWindow) + -- mod-button3 %! Set the window to floating mode and resize by dragging + , ((modMask, button3), \w -> focus w >> mouseResizeWindow w) -- you may also bind events to the mouse scroll wheel (button4 and button5) ] -instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) where +instance (a ~ ModifiedLayout Floating (Choose Tall (Choose (Mirror Tall) Full))) => Default (XConfig a) where def = XConfig { MetaTile.workspaces = workspaces , MetaTile.layoutHook = layout @@ -264,11 +274,6 @@ instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) wh , MetaTile.rootMask = rootMask } --- | The default set of configuration values itself -{-# DEPRECATED defaultConfig "Use def (from Data.Default, and re-exported by MetaTile and MetaTile.Config) instead." #-} -defaultConfig :: XConfig (Choose Tall (Choose (Mirror Tall) Full)) -defaultConfig = def - -- | Finally, a copy of the default bindings in simple textual tabular format. help :: String help = unlines ["The default modifier key is 'alt'. Default keybindings:", diff --git a/MetaTile/Core.hs b/MetaTile/Core.hs index 79611fd..3d84ea3 100644 --- a/MetaTile/Core.hs +++ b/MetaTile/Core.hs @@ -22,7 +22,7 @@ module MetaTile.Core ( XConf(..), XConfig(..), LayoutClass(..), Layout(..), readsLayout, Typeable, Message, SomeMessage(..), fromMessage, LayoutMessages(..), - StateExtension(..), ExtensionClass(..), + StateExtension(..), ExtensionClass(..), Window, Rectangle(..), runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers, withDisplay, withWindowSet, isRoot, runOnWorkspaces, getWindowState, getsWindowState, setWindowState, modifyWindowState, diff --git a/MetaTile/Layout.hs b/MetaTile/Layout.hs index 93b9408..ad65f32 100644 --- a/MetaTile/Layout.hs +++ b/MetaTile/Layout.hs @@ -26,7 +26,6 @@ module MetaTile.Layout ( import MetaTile.Core -import Graphics.X11 (Rectangle(..)) import qualified MetaTile.StackSet as W import Control.Arrow ((***), second) import Control.Monad diff --git a/MetaTile/Layout/Floating.hs b/MetaTile/Layout/Floating.hs new file mode 100644 index 0000000..48abc7f --- /dev/null +++ b/MetaTile/Layout/Floating.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, DeriveDataTypeable #-} + +module MetaTile.Layout.Floating ( + Floating, floating, + float, sink, mouseMoveWindow, mouseResizeWindow + ) where + +import Prelude hiding (Floating) + +import MetaTile.Core +import MetaTile.Layout.LayoutModifier +import MetaTile.Operations +import qualified MetaTile.StackSet as W +import qualified MetaTile.Util.ExtensibleState as XS + +import Control.Arrow ((&&&), first) +import Control.Monad.Reader +import Control.Monad.State +import Data.Functor +import qualified Data.Map as M +import Data.Maybe +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + + +data FloatingStorage = FloatingStorage { + floatingWindows :: M.Map Window Rectangle + } deriving (Show, Read, Typeable) + +instance ExtensionClass FloatingStorage where + initialValue = FloatingStorage M.empty + extensionType = PersistentExtension + + +data Floating a = Floating deriving (Show, Read) + +instance LayoutModifier Floating Window where + modifyLayout _ (w@W.Workspace { W.stack = stack }) r = do + bw <- asks (defaultBorderWidth . config) + ws <- gets windowset + FloatingStorage { floatingWindows = fw } <- XS.get + let fw' = M.filterWithKey (\k _ -> k `W.member` ws) fw + tiled = stack >>= W.filter (`M.notMember` fw') + fwLayout = [(a, ar, bw) | (a, ar) <- catMaybes . map (maybeSecond . (id &&& flip M.lookup fw')) $ W.integrate' stack] + XS.put $ FloatingStorage fw' + first (fwLayout ++) <$> runBorderLayout (w { W.stack = tiled }) r + where + maybeSecond :: (a, Maybe b) -> Maybe (a, b) + maybeSecond (a, Just b) = Just (a, b) + maybeSecond (_, Nothing) = Nothing + +floating :: l Window -> ModifiedLayout Floating l Window +floating = ModifiedLayout Floating + + +------------------------------------------------------------------------ +-- | Floating layer support + +-- | Given a window, find the screen it is located on, and compute +-- the geometry of that window wrt. that screen. +floatLocation :: Window -> X (ScreenId, Rectangle) +floatLocation w = withDisplay $ \d -> do + ws <- gets windowset + frame <- getsWindowState wsFrame w + wa <- io $ getWindowAttributes d frame + sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) + let sr = screenRect . W.screenDetail $ sc + rr = Rectangle ((fi $ wa_x wa) - (fi $ rect_x sr)) ((fi $ wa_y wa) - (fi $ rect_y sr)) (fi $ wa_width wa) (fi $ wa_height wa) + return (W.screen sc, rr) + where fi x = fromIntegral x + +-- | Make a tiled window floating, using its suggested rectangle +float :: Window -> X () +float w = do + (_, r) <- floatLocation w + XS.modify $ \(FloatingStorage fw) -> FloatingStorage (M.insert w r fw) + refresh + +-- | Make a tiled window floating, using its suggested rectangle +sink :: Window -> X () +sink w = do + XS.modify $ \(FloatingStorage fw) -> FloatingStorage (M.delete w fw) + refresh + + +-- | XXX comment me +mouseMoveWindow :: Window -> X () +mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do + frame <- getsWindowState wsFrame w + io $ raiseWindow d frame + wa <- io $ getWindowAttributes d frame + (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d frame + let ox = fromIntegral ox' + oy = fromIntegral oy' + mouseDrag (\ex ey -> (io $ moveWindow d frame (fromIntegral (fromIntegral (wa_x wa) + (ex - ox))) (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))) >> reveal w) (float w) + +-- | XXX comment me +mouseResizeWindow :: Window -> X () +mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do + frame <- getsWindowState wsFrame w + io $ raiseWindow d frame + wa <- io $ getWindowAttributes d frame + sh <- io $ getWMNormalHints d w + io $ warpPointer d none frame 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) + mouseDrag (\ex ey -> (io $ resizeWindow d frame `uncurry` applySizeHintsContents sh (ex - fromIntegral (wa_x wa), ey - fromIntegral (wa_y wa))) >> reveal w) (float w) diff --git a/MetaTile/Layout/LayoutModifier.hs b/MetaTile/Layout/LayoutModifier.hs index 5d97467..7b66586 100644 --- a/MetaTile/Layout/LayoutModifier.hs +++ b/MetaTile/Layout/LayoutModifier.hs @@ -31,7 +31,7 @@ module MetaTile.Layout.LayoutModifier ( import Control.Monad -import MetaTile +import MetaTile.Core import MetaTile.StackSet ( Stack, Workspace (..) ) -- $usage diff --git a/MetaTile/Main.hsc b/MetaTile/Main.hsc index 426e78f..92692a3 100644 --- a/MetaTile/Main.hsc +++ b/MetaTile/Main.hsc @@ -24,6 +24,7 @@ import Control.Monad.Reader import Control.Monad.State import Data.Maybe (fromMaybe) import Data.Monoid (getAll) +import Data.Traversable (traverse) import Foreign.C import Foreign.Ptr @@ -252,8 +253,10 @@ handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b }) isr <- isRoot w m <- cleanMask $ ev_state e mact <- asks (M.lookup (m, b) . buttonActions) + trace $ show (ev_subwindow e) + getsFrameState fsWindow (ev_subwindow e) >>= trace . show case mact of - Just act | isr -> act $ ev_subwindow e + Just act | isr -> getsFrameState fsWindow (ev_subwindow e) >>= traverse act >> return () _ -> do focus w ctf <- asks (clickJustFocuses . config) diff --git a/MetaTile/ManageHook.hs b/MetaTile/ManageHook.hs index c7140c4..8dad704 100644 --- a/MetaTile/ManageHook.hs +++ b/MetaTile/ManageHook.hs @@ -20,7 +20,7 @@ module MetaTile.ManageHook where import MetaTile.Core import Graphics.X11.Xlib.Extras -import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME) +import Graphics.X11.Xlib (Display, internAtom, wM_NAME) import Control.Exception.Extensible (bracket, SomeException(..)) import Control.Monad.Reader import Data.Maybe diff --git a/MetaTile/Operations.hs b/MetaTile/Operations.hs index b45403f..4edf67b 100644 --- a/MetaTile/Operations.hs +++ b/MetaTile/Operations.hs @@ -25,7 +25,6 @@ import Data.Maybe import Data.Monoid (Endo(..)) import Data.List (nub, (\\), find) import Data.Bits ((.|.), (.&.), complement, testBit) -import Data.Ratio import qualified Data.Map as M import Control.Applicative @@ -160,12 +159,6 @@ windows f = do setWindowBackground d frame p clearWindow d frame --- | Produce the actual rectangle from a screen and a ratio on that screen. -scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle -scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh) - = Rectangle (sx + scale sw rx) (sy + scale sh ry) (scale sw rw) (scale sh rh) - where scale s r = floor (toRational s * r) - -- | setWMState. set the WM_STATE property setWMState :: Window -> Int -> X () setWMState w v = withDisplay $ \dpy -> do @@ -255,6 +248,7 @@ tileWindow w r bw = withDisplay $ \d -> do modifyFrameState (\fs -> fs {fsBorderWidth = bw}) frame io $ moveResizeWindow d frame (rect_x r) (rect_y r) (least $ rect_width r) (least $ rect_height r) + -- --------------------------------------------------------------------- -- | Returns 'True' if the first rectangle is contained within, but not equal @@ -453,22 +447,6 @@ restart prog resume = do -- | Given a window, find the screen it is located on, and compute -- the geometry of that window wrt. that screen. -floatLocation :: Window -> X (ScreenId, W.RationalRect) -floatLocation w = withDisplay $ \d -> do - ws <- gets windowset - wa <- io $ getWindowAttributes d w - let bw = (fromIntegral . wa_border_width) wa - sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) - - let sr = screenRect . W.screenDetail $ sc - rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr)) - ((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr)) - (fi (wa_width wa + bw*2) % fi (rect_width sr)) - (fi (wa_height wa + bw*2) % fi (rect_height sr)) - - return (W.screen sc, rr) - where fi x = fromIntegral x - -- | Given a point, determine the screen (if any) that contains it. pointScreen :: Position -> Position -> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)) @@ -483,17 +461,6 @@ pointWithin x y r = x >= rect_x r && y >= rect_y r && y < rect_y r + fromIntegral (rect_height r) --- | Make a tiled window floating, using its suggested rectangle -{-float :: Window -> X () -float w = do - (sc, rr) <- floatLocation w - windows $ \ws -> W.float w rr . fromMaybe ws $ do - i <- W.findTag w ws - guard $ i `elem` concatMap (map W.tag . W.screenWorkspaces) (W.screens ws) - f <- W.peek ws - sw <- W.lookupWorkspace sc ws - return (W.focusWindow f . W.shiftWin sw w $ ws)-} - -- --------------------------------------------------------------------- -- Mouse handling diff --git a/MetaTile/StackSet.hs b/MetaTile/StackSet.hs index 907840c..d37f7c8 100644 --- a/MetaTile/StackSet.hs +++ b/MetaTile/StackSet.hs @@ -24,7 +24,7 @@ module MetaTile.StackSet ( -- ** Master and Focus -- $focus - StackSet(..), Workspace(..), Screen(..), Stack(..), RationalRect(..), + StackSet(..), Workspace(..), Screen(..), Stack(..), -- * Construction -- $construction new, view, greedyView, @@ -148,10 +148,6 @@ data Screen i l a sid sd = Screen { screenWorkspace :: !(Workspace i l a) data Workspace i l a = Workspace { tag :: !i, layout :: l, stack :: Maybe (Stack a) } deriving (Show, Read, Eq) --- | A structure for window geometries -data RationalRect = RationalRect Rational Rational Rational Rational - deriving (Show, Read, Eq) - -- | -- A stack is a cursor onto a window list. -- The data structure tracks focus by construction, and @@ -481,17 +477,6 @@ delete w s = mapWorkspace removeFromWorkspace s where removeFromWorkspace ws = ws { stack = stack ws >>= filter (/=w) } ------------------------------------------------------------------------ - --- | Given a window, and its preferred rectangle, set it as floating --- A floating window should already be managed by the 'StackSet'. ---float :: Ord a => a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd ---float w r s = s { floating = M.insert w r (floating s) } - --- | Clear the floating status of a window ---sink :: Ord a => a -> StackSet i l a s sd -> StackSet i l a s sd ---sink w s = s { floating = M.delete w (floating s) } - ------------------------------------------------------------------------- -- $settingMW -- | /O(s)/. Set the master window to the focused window. |