aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJason Creighton <jcreigh@gmail.com>2007-05-31 06:47:33 +0200
committerJason Creighton <jcreigh@gmail.com>2007-05-31 06:47:33 +0200
commitb1047e049301158332132e4fde03c3e817770bee (patch)
tree7aed1cb41e749ce10b1da2c4148593d8c320adb4
parentad48576b8ae1c2ace415fc9d941424965a3186b0 (diff)
downloadxmonad-b1047e049301158332132e4fde03c3e817770bee.tar.gz
xmonad-b1047e049301158332132e4fde03c3e817770bee.tar.xz
xmonad-b1047e049301158332132e4fde03c3e817770bee.zip
first shot at a floating layer
This is a first attempting at a floating layer: mod-button1: move window mod-button2: swapMaster mod-button3: resize window mod-t: make floating window tiled again Moving or resizing a window automatically makes it floating. Known issues: Hard to manage stacking order. You can promote a window to move it to the top, (which you can do with mod-button2) but it should be easier than that. Moving a window by dragging it to a different Xinerama screen does not move it to that workspace. Code is ugly. darcs-hash:20070531044733-b9aa7-c96d5263e1d3447e91f436920f4d047050ce55d9.gz
Diffstat (limited to '')
-rw-r--r--Config.hs2
-rw-r--r--Config.hs-boot2
-rw-r--r--Main.hs45
-rw-r--r--Operations.hs85
-rw-r--r--StackSet.hs30
5 files changed, 128 insertions, 36 deletions
diff --git a/Config.hs b/Config.hs
index 7bb7e37..57750e0 100644
--- a/Config.hs
+++ b/Config.hs
@@ -115,6 +115,8 @@ keys = M.fromList $
, ((modMask, xK_h ), sendMessage Shrink) -- @@ Shrink the master area
, ((modMask, xK_l ), sendMessage Expand) -- @@ Expand the master area
+ , ((modMask, xK_t ), withFocused clearFloating) -- @@ Make floating window tiled
+
-- 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
diff --git a/Config.hs-boot b/Config.hs-boot
index 2d66ae1..681160a 100644
--- a/Config.hs-boot
+++ b/Config.hs-boot
@@ -1,3 +1,5 @@
module Config where
import Graphics.X11.Xlib.Types (Dimension)
+import Graphics.X11.Xlib (KeyMask)
borderWidth :: Dimension
+modMask :: KeyMask
diff --git a/Main.hs b/Main.hs
index df768b7..b0a75e9 100644
--- a/Main.hs
+++ b/Main.hs
@@ -26,7 +26,7 @@ import Graphics.X11.Xinerama (getScreenInfo)
import XMonad
import Config
import StackSet (new)
-import Operations (manage, unmanage, focus, setFocusX, full, isClient, rescreen)
+import Operations (manage, unmanage, focus, setFocusX, full, isClient, rescreen, makeFloating, swapMaster)
--
-- The main entry point
@@ -111,6 +111,41 @@ grabKeys dpy rootw = do
where grab kc m = grabKey dpy kc m rootw True grabModeAsync grabModeAsync
+cleanMask :: KeyMask -> KeyMask
+cleanMask = (complement (numlockMask .|. lockMask) .&.)
+
+mouseDrag :: (XMotionEvent -> IO ()) -> X ()
+mouseDrag f = do
+ XConf { theRoot = root, display = d } <- ask
+ io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask) grabModeAsync grabModeAsync none none currentTime
+
+ io $ allocaXEvent $ \p -> fix $ \again -> do
+ maskEvent d (buttonReleaseMask .|. pointerMotionMask) p
+ et <- get_EventType p
+ when (et == motionNotify) $ get_MotionEvent p >>= f >> again
+
+ io $ ungrabPointer d currentTime
+
+mouseMoveWindow :: Window -> X ()
+mouseMoveWindow w = withDisplay $ \d -> do
+ io $ raiseWindow d w
+ wa <- io $ getWindowAttributes d w
+ (_, _, _, ox, oy, _, _, _) <- io $ queryPointer d w
+ mouseDrag $ \(_, _, _, ex, ey, _, _, _, _, _) ->
+ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox))) (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
+
+ makeFloating w
+
+mouseResizeWindow :: Window -> X ()
+mouseResizeWindow w = withDisplay $ \d -> do
+ io $ raiseWindow d w
+ wa <- io $ getWindowAttributes d w
+ io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
+ mouseDrag $ \(_, _, _, ex, ey, _, _, _, _, _) ->
+ resizeWindow d w (fromIntegral (max 1 (ex - fromIntegral (wa_x wa)))) (fromIntegral (max 1 (ey - fromIntegral (wa_y wa))))
+
+ makeFloating w
+
-- ---------------------------------------------------------------------
-- | Event handler. Map X events onto calls into Operations.hs, which
-- modify our internal model of the window manager state.
@@ -128,7 +163,7 @@ handle :: Event -> X ()
handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
| t == keyPress = withDisplay $ \dpy -> do
s <- io $ keycodeToKeysym dpy code 0
- whenJust (M.lookup (complement (numlockMask .|. lockMask) .&. m,s) keys) id
+ whenJust (M.lookup (cleanMask m,s) keys) id
-- manage a new window
handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
@@ -146,7 +181,11 @@ handle e@(MappingNotifyEvent {ev_window = w}) = do
when (ev_request e == mappingKeyboard) $ withDisplay $ io . flip grabKeys w
-- click on an unfocused window, makes it focused on this workspace
-handle (ButtonEvent {ev_window = w, ev_event_type = t}) | t == buttonPress = focus w
+handle (ButtonEvent {ev_window = w, ev_event_type = t, ev_state = m, ev_button = b })
+ | t == buttonPress && cleanMask m == modMask && b == button1 = mouseMoveWindow w
+ | t == buttonPress && cleanMask m == modMask && b == button2 = focus w >> swapMaster
+ | t == buttonPress && cleanMask m == modMask && b == button3 = mouseResizeWindow w
+ | t == buttonPress = focus w
-- entered a normal window, makes this focused.
handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
diff --git a/Operations.hs b/Operations.hs
index 2d0eac5..ce6e01f 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -15,11 +15,12 @@ module Operations where
import XMonad
import qualified StackSet as W
-import {-# SOURCE #-} Config (borderWidth)
+import {-# SOURCE #-} Config (borderWidth, modMask)
import Data.Maybe
-import Data.List (genericIndex, intersectBy)
+import Data.List (genericIndex, intersectBy, partition, delete)
import Data.Bits ((.|.))
+import Data.Ratio
import qualified Data.Map as M
-- import System.Mem (performGC)
@@ -38,17 +39,29 @@ import Graphics.X11.Xlib.Extras
-- Bring it into focus. If the window is already managed, nothing happens.
--
manage :: Window -> X ()
-manage w = do
- withDisplay $ \d -> io $ do
- selectInput d w $ structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
- mapWindow d w
- setWindowBorderWidth d w borderWidth
- windows $ W.insertUp w
+manage w = withDisplay $ \d -> do
+ io $ selectInput d w $ structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
+ io $ mapWindow d w
+ io $ setWindowBorderWidth d w borderWidth
+
+ -- FIXME: This is pretty awkward. We can't can't let "refresh" happen
+ -- before the call to makeFloating, because that will resize the window and
+ -- lose the default sizing.
+ isTransient <- isJust `liftM` (io $ getTransientForHint d w)
+ if isTransient
+ then do
+ modify $ \s -> s { windowset = W.insertUp w (windowset s) }
+ makeFloating w
+ else windows $ W.insertUp w
-- | unmanage. A window no longer exists, remove it from the window
-- list, on whatever workspace it is.
+--
+-- FIXME: clearFloating should be taken care of in W.delete, but if we do it
+-- there, floating status is lost when moving windows between workspaces,
+-- because W.shift calls W.delete.
unmanage :: Window -> X ()
-unmanage = windows . W.delete
+unmanage w = windows $ W.clearFloating w . W.delete w
-- | focus. focus window up or down. or swap various windows.
focusUp, focusDown, swapUp, swapDown, swapMaster :: X ()
@@ -141,6 +154,7 @@ refresh = do
let n = W.tag (W.workspace w)
this = W.view n ws
Just l = fmap fst $ M.lookup n fls
+ (float, tiled) = partition (flip M.member (W.floating ws)) (W.index this)
(Rectangle sx sy sw sh) = genericIndex xinesc (W.screen w)
(gt,gb,gl,gr) = genericIndex gaps (W.screen w)
@@ -148,11 +162,19 @@ refresh = do
rs <- doLayout l (Rectangle (sx + fromIntegral gl)
(sy + fromIntegral gt)
(sw - fromIntegral (gl + gr))
- (sh - fromIntegral (gt + gb))) (W.index this)
+ (sh - fromIntegral (gt + gb))) tiled
mapM_ (\(win,rect) -> io (tileWindow d win rect)) rs
- -- and raise the focused window if there is one.
- whenJust (W.peek this) $ io . raiseWindow d
+ -- move/resize the floating windows
+ (`mapM_` float) $ \fw -> whenJust (M.lookup fw (W.floating ws)) $ \(W.RationalRect rx ry rw rh) -> do
+ let Rectangle px py pw ph = genericIndex xinesc (W.screen w)
+ io $ tileWindow d fw (Rectangle (px + floor (toRational pw*rx)) (py + floor (toRational ph*ry)) (floor (toRational pw*rw)) (floor (toRational ph*rh)))
+
+ -- urgh. This is required because the fullscreen layout assumes that
+ -- the focused window will be raised.
+ let tiled' = maybe tiled (\x -> if x `elem` tiled then x : delete x tiled else tiled) (W.peek this)
+
+ io $ restackWindows d (float ++ tiled')
setTopFocus
clearEnterEvents
@@ -198,15 +220,13 @@ rescreen = do
-- ---------------------------------------------------------------------
-buttonsToGrab :: [Button]
-buttonsToGrab = [button1, button2, button3]
-
-- | setButtonGrab. Tell whether or not to intercept clicks on a given window
setButtonGrab :: Bool -> Window -> X ()
-setButtonGrab grab w = withDisplay $ \d -> io $ (`mapM_` buttonsToGrab) $ \b ->
- if grab then grabButton d b anyModifier w False (buttonPressMask .|. buttonReleaseMask)
- grabModeAsync grabModeSync none none
- else ungrabButton d b anyModifier w
+setButtonGrab grab w = withDisplay $ \d -> io $ do
+ when (not grab) $ ungrabButton d anyButton anyModifier w
+ grabButton d anyButton mask w False (buttonPressMask .|. buttonReleaseMask)
+ grabModeAsync grabModeSync none none
+ where mask = if grab then anyModifier else modMask
-- ---------------------------------------------------------------------
-- Setting keyboard focus
@@ -239,10 +259,11 @@ setFocusX w = withWorkspace $ \ws -> do
setButtonGrab True otherw
io $ setWindowBorder dpy otherw (color_pixel nbc)
- io $ do setInputFocus dpy w revertToPointerRoot 0
- -- raiseWindow dpy w
- setButtonGrab False w
- io $ setWindowBorder dpy w (color_pixel fbc)
+ whenX (not `liftM` isRoot w) $ do
+ io $ do setInputFocus dpy w revertToPointerRoot 0
+ -- raiseWindow dpy w
+ setButtonGrab False w
+ io $ setWindowBorder dpy w (color_pixel fbc)
-- ---------------------------------------------------------------------
-- Managing layout
@@ -360,3 +381,21 @@ withFocused f = withWorkspace $ \w -> whenJust (W.peek w) f
-- | True if window is under management by us
isClient :: Window -> X Bool
isClient w = withWorkspace $ return . W.member w
+
+-- | Make a floating window tiled
+clearFloating :: Window -> X ()
+clearFloating = windows . W.clearFloating
+
+-- | Make a tiled window floating
+makeFloating :: Window -> X ()
+makeFloating w = withDisplay $ \d -> do
+ xinesc <- gets xineScreens
+ sc <- (genericIndex xinesc . W.screen . W.current) `liftM` gets windowset
+ wa <- io $ getWindowAttributes d w
+ let bw = fI . wa_border_width $ wa
+ windows $ W.makeFloating w
+ (W.RationalRect ((fI (wa_x wa) - fI (rect_x sc)) % fI (rect_width sc))
+ ((fI (wa_y wa) - fI (rect_y sc)) % fI (rect_height sc))
+ (fI (wa_width wa + bw*2) % fI (rect_width sc))
+ (fI (wa_height wa + bw*2) % fI (rect_height sc)))
+ where fI x = fromIntegral x
diff --git a/StackSet.hs b/StackSet.hs
index cae577c..810fa60 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -75,15 +75,15 @@
-- 'delete'.
--
module StackSet (
- StackSet(..), Workspace(..), Screen(..), Stack(..),
+ StackSet(..), Workspace(..), Screen(..), Stack(..), RationalRect(..),
new, view, lookupWorkspace, peek, index, focusUp, focusDown,
focusWindow, member, findIndex, insertUp, delete, shift,
- swapMaster, swapUp, swapDown, modify -- needed by users
+ swapMaster, swapUp, swapDown, modify, makeFloating, clearFloating -- needed by users
) where
import Data.Maybe (listToMaybe)
import qualified Data.List as L (delete,find,genericSplitAt)
-
+import qualified Data.Map as M (Map,insert,delete,empty)
-- API changes from xmonad 0.1:
-- StackSet constructor arguments changed. StackSet workspace window screen
@@ -112,10 +112,11 @@ import qualified Data.List as L (delete,find,genericSplitAt)
-- Xinerama screens, and those workspaces not visible anywhere.
--
data StackSet i a sid =
- StackSet { size :: !i -- number of workspaces
- , current :: !(Screen i a sid) -- currently focused workspace
- , visible :: [Screen i a sid] -- non-focused workspaces, visible in xinerama
- , hidden :: [Workspace i a] -- workspaces not visible anywhere
+ StackSet { size :: !i -- number of workspaces
+ , current :: !(Screen i a sid) -- currently focused workspace
+ , visible :: [Screen i a sid] -- non-focused workspaces, visible in xinerama
+ , hidden :: [Workspace i a] -- workspaces not visible anywhere
+ , floating :: M.Map a RationalRect -- floating windows
} deriving (Show, Read, Eq)
-- Visible workspaces, and their Xinerama screens.
@@ -128,6 +129,9 @@ data Screen i a sid = Screen { workspace :: !(Workspace i a), screen :: !sid }
data Workspace i a = Workspace { tag :: !i, stack :: Stack a }
deriving (Show, Read, Eq)
+data RationalRect = RationalRect Rational Rational Rational Rational
+ deriving (Show, Read, Eq)
+
--
-- A stack is a cursor onto a (possibly empty) window list.
-- The data structure tracks focus by construction, and
@@ -167,7 +171,7 @@ abort x = error $ "xmonad: StackSet: " ++ x
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
--
new :: (Integral i, Integral s) => i -> s -> StackSet i a s
-new n m | n > 0 && m > 0 = StackSet n cur visi unseen
+new n m | n > 0 && m > 0 = StackSet n cur visi unseen M.empty
| otherwise = abort "non-positive arguments to StackSet.new"
where (seen,unseen) = L.genericSplitAt m $ Workspace 0 Empty : [ Workspace i Empty | i <- [1 ..n-1]]
@@ -351,7 +355,7 @@ insertUp a s = if member a s then s else insert
-- * deleting the master window resets it to the newly focused window
-- * otherwise, delete doesn't affect the master.
--
-delete :: (Integral i, Eq a, Eq s) => a -> StackSet i a s -> StackSet i a s
+delete :: (Integral i, Ord a, Eq s) => a -> StackSet i a s -> StackSet i a s
delete w s | Just w == peek s = remove s -- common case.
| otherwise = maybe s (removeWindow.tag.workspace.current $ s) (findIndex w s)
where
@@ -367,6 +371,12 @@ delete w s | Just w == peek s = remove s -- common case.
Node _ [] [] -> Empty
else c { up = w `L.delete` up c, down = w `L.delete` down c }
+makeFloating :: Ord a => a -> RationalRect -> StackSet i a s -> StackSet i a s
+makeFloating w r s = s { floating = M.insert w r (floating s) }
+
+clearFloating :: Ord a => a -> StackSet i a s -> StackSet i a s
+clearFloating w s = s { floating = M.delete w (floating s) }
+
------------------------------------------------------------------------
-- Setting the master window
@@ -390,7 +400,7 @@ swapMaster = modify Empty $ \c -> case c of
-- The actual focused workspace doesn't change. If there is -- no
-- element on the current stack, the original stackSet is returned.
--
-shift :: (Eq a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s
+shift :: (Ord a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s
shift n s = if and [n >= 0,n < size s,n /= tag (workspace (current s))]
then maybe s go (peek s) else s
where go w = foldr ($) s [view (tag (workspace (current s))),insertUp w,view n,delete w]