summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2013-09-17 01:36:14 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2013-09-17 01:36:14 +0200
commitc04271bf6b9126f635b9b9baf173b2af5380fd84 (patch)
tree7638dd803464631c8014a6a6a425d9b5fcb91e98
parent43759844f5fb4d8e5280e6b697b6f7efcadf0c6b (diff)
downloadmetatile-c04271bf6b9126f635b9b9baf173b2af5380fd84.tar
metatile-c04271bf6b9126f635b9b9baf173b2af5380fd84.zip
Add layout modifier for floating layer support
-rw-r--r--MetaTile/Config.hs23
-rw-r--r--MetaTile/Core.hs2
-rw-r--r--MetaTile/Layout.hs1
-rw-r--r--MetaTile/Layout/Floating.hs105
-rw-r--r--MetaTile/Layout/LayoutModifier.hs2
-rw-r--r--MetaTile/Main.hsc5
-rw-r--r--MetaTile/ManageHook.hs2
-rw-r--r--MetaTile/Operations.hs35
-rw-r--r--MetaTile/StackSet.hs17
-rw-r--r--metatile.cabal2
10 files changed, 130 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.
diff --git a/metatile.cabal b/metatile.cabal
index da71120..ace7065 100644
--- a/metatile.cabal
+++ b/metatile.cabal
@@ -37,6 +37,7 @@ library
MetaTile.Core
MetaTile.Config
MetaTile.Layout
+ MetaTile.Layout.Floating
MetaTile.Layout.LayoutModifier
MetaTile.ManageHook
MetaTile.Operations
@@ -67,6 +68,7 @@ executable metatile
MetaTile.Core
MetaTile.Config
MetaTile.Layout
+ MetaTile.Layout.Floating
MetaTile.Layout.LayoutModifier
MetaTile.ManageHook
MetaTile.Operations