summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--XMonad/Config.hs8
-rw-r--r--XMonad/Core.hs37
-rw-r--r--XMonad/Main.hsc7
-rw-r--r--XMonad/Operations.hs29
4 files changed, 62 insertions, 19 deletions
diff --git a/XMonad/Config.hs b/XMonad/Config.hs
index 1a2c378..7524368 100644
--- a/XMonad/Config.hs
+++ b/XMonad/Config.hs
@@ -27,11 +27,11 @@ module XMonad.Config (defaultConfig, Default(..)) where
--
import XMonad.Core as XMonad hiding
(workspaces,manageHook,keys,logHook,startupHook,mouseBindings
- ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
+ ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,defaultBorderWidth,focusFollowsMouse
,handleEventHook,clickJustFocuses,rootMask,clientMask)
import qualified XMonad.Core as XMonad
(workspaces,manageHook,keys,logHook,startupHook,mouseBindings
- ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
+ ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,defaultBorderWidth,focusFollowsMouse
,handleEventHook,clickJustFocuses,rootMask,clientMask)
import XMonad.Layout
@@ -71,6 +71,9 @@ normalBorderColor, focusedBorderColor :: String
normalBorderColor = "gray" -- "#dddddd"
focusedBorderColor = "red" -- "#ff0000" don't use hex, not <24 bit safe
+defaultBorderWidth :: BorderWidth
+defaultBorderWidth = BorderWidth 1 1 1 1
+
------------------------------------------------------------------------
-- Window rules
@@ -242,6 +245,7 @@ instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) wh
, XMonad.terminal = terminal
, XMonad.normalBorderColor = normalBorderColor
, XMonad.focusedBorderColor = focusedBorderColor
+ , XMonad.defaultBorderWidth = defaultBorderWidth
, XMonad.modMask = defaultModMask
, XMonad.keys = keys
, XMonad.logHook = logHook
diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index 4171060..483bc28 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -17,7 +17,7 @@
-----------------------------------------------------------------------------
module XMonad.Core (
- X, WindowSet, WindowSpace, WorkspaceId, WindowState(..),
+ X, WindowSet, WindowSpace, WorkspaceId, BorderWidth(..), WindowState(..),
ScreenId(..), ScreenDetail(..), XState(..),
XConf(..), XConfig(..), LayoutClass(..),
Layout(..), readsLayout, Typeable, Message,
@@ -35,9 +35,11 @@ import Prelude hiding ( catch )
import Codec.Binary.UTF8.String (encodeString)
import Control.Exception.Extensible (catch, fromException, try, bracket, throw, finally, SomeException(..))
import Control.Applicative
+import Control.Arrow ((&&&))
import Control.Monad.State
import Control.Monad.Reader
import Data.Default
+import Data.Function (on)
import System.FilePath
import System.IO
import System.Info
@@ -58,11 +60,22 @@ import Data.Monoid
import qualified Data.Map as M
+data BorderWidth = BorderWidth
+ { bwTop :: !Dimension
+ , bwRight :: !Dimension
+ , bwBottom :: !Dimension
+ , bwLeft :: !Dimension
+ } deriving Show
+
data WindowState = WindowState
{ wsMapped :: !Bool
, wsWaitingUnmap :: !Int -- ^ the number of expected UnmapEvents
, wsFrame :: !Window
- } deriving (Show, Eq)
+ , wsBorderWidth :: !BorderWidth
+ } deriving Show
+
+instance Eq WindowState where
+ (==) = (==) `on` (wsMapped &&& wsWaitingUnmap &&& wsFrame)
-- | XState, the (mutable) window manager state.
@@ -101,6 +114,7 @@ data XConf = XConf
data XConfig l = XConfig
{ normalBorderColor :: !String -- ^ Non focused windows border color. Default: \"#dddddd\"
, focusedBorderColor :: !String -- ^ Focused windows border color. Default: \"#ff0000\"
+ , defaultBorderWidth :: !BorderWidth
, terminal :: !String -- ^ The preferred terminal application. Default: \"xterm\"
, layoutHook :: !(l Window) -- ^ The available layouts
, manageHook :: !ManageHook -- ^ The action to run when a new window is opened
@@ -218,20 +232,25 @@ isRoot w = (w==) <$> asks theRoot
getAtom :: String -> X Atom
getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False
-emptyWindowState :: WindowState
-emptyWindowState = WindowState False 0 0
+emptyWindowState :: X WindowState
+emptyWindowState = asks (defaultBorderWidth . config) >>= return . WindowState False 0 0
getWindowState :: Window -> X WindowState
-getWindowState w = gets $ M.findWithDefault emptyWindowState w . windowState
+getWindowState w = do
+ ws <- gets $ (M.lookup w) . windowState
+ case ws of
+ Just s -> return s
+ Nothing -> emptyWindowState
getsWindowState :: (WindowState -> a) -> Window -> X a
getsWindowState f w = f <$> getWindowState w
setWindowState :: Window -> WindowState -> X ()
-setWindowState w ws = modify $ \s -> s { windowState = f (windowState s) }
- where
- f | ws == emptyWindowState = M.delete w
- | otherwise = M.insert w ws
+setWindowState w ws = do
+ emptyState <- emptyWindowState
+ let f | ws == emptyState = M.delete w
+ | otherwise = M.insert w ws
+ modify $ \s -> s { windowState = f (windowState s) }
modifyWindowState :: (WindowState -> WindowState) -> Window -> X ()
modifyWindowState f w = getWindowState w >>= return . f >>= setWindowState w
diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc
index b5a2bf2..d09e024 100644
--- a/XMonad/Main.hsc
+++ b/XMonad/Main.hsc
@@ -215,7 +215,7 @@ handle (DestroyWindowEvent {ev_window = w}) = do
handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
e <- getsWindowState wsWaitingUnmap w
if (synthetic || e == 0)
- then unmanage w
+ then unmanage w >> hideParent w
else modifyWindowState (\ws -> ws { wsWaitingUnmap = (wsWaitingUnmap ws) - 1 }) w
-- set keyboard mapping
@@ -326,6 +326,11 @@ reparent w = withDisplay $ \dpy -> do
reparentWindow dpy w frame 0 0
modifyWindowState (\ws -> ws { wsFrame = frame }) w
+hideParent :: Window -> X ()
+hideParent w = withDisplay $ \dpy -> do
+ frame <- getsWindowState wsFrame w
+ when (frame /= 0) $ io $ unmapWindow dpy frame
+
unparent :: Window -> X ()
unparent w = withDisplay $ \dpy -> do
trace $ "unparent: " ++ show w
diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs
index a88ce06..ad6f8b1 100644
--- a/XMonad/Operations.hs
+++ b/XMonad/Operations.hs
@@ -29,6 +29,7 @@ import Data.Ratio
import qualified Data.Map as M
import Control.Applicative
+import Control.Arrow ((&&&))
import Control.Monad.Reader
import Control.Monad.State
import qualified Control.Exception.Extensible as C
@@ -91,10 +92,11 @@ windows f = do
let oldvisible = concatMap (W.integrate' . W.stack . W.screenWorkspace) $ W.screens old
newwindows = W.allWindows ws \\ W.allWindows old
ws = f old
- XConf { display = d } <- ask
+ XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask
mapM_ setInitialProperties newwindows
+ whenJust (W.peek old) $ \otherw -> setFrameBackground d otherw nbc
modify (\s -> s { windowset = ws })
-- notify non visibility
@@ -127,6 +129,8 @@ windows f = do
mapM_ (uncurry tileWindow) rects
+ whenJust (W.peek ws) $ \w -> setFrameBackground d w fbc
+
mapM_ reveal visible
setTopFocus
@@ -142,6 +146,13 @@ windows f = do
isMouseFocused <- asks mouseFocused
unless isMouseFocused $ clearEvents enterWindowMask
asks (logHook . config) >>= userCodeDef ()
+ where
+ setFrameBackground :: Display -> Window -> Pixel -> X ()
+ setFrameBackground d w p = do
+ frame <- getsWindowState wsFrame w
+ io $ 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
@@ -178,15 +189,20 @@ reveal w = withDisplay $ \d -> do
setWMState w normalState
io $ mapWindow d w
whenX (isClient w) $ do
- frame <- getsWindowState wsFrame w
+ (frame, bw) <- getsWindowState (wsFrame &&& wsBorderWidth) w
io $ do
mapWindow d frame
(_, x, y, width, height, _, _) <- getGeometry d frame
- moveResizeWindow d w 0 0 width height
+ let least1 n = max 1 n
+ x' = x + (fi $ bwLeft bw)
+ y' = y + (fi $ bwTop bw)
+ width' = least1 (width - bwLeft bw - bwRight bw)
+ height' = least1 (height - bwTop bw - bwBottom bw)
+ moveResizeWindow d w (fi $ bwLeft bw) (fi $ bwTop bw) width' height'
-- send absolute ConfigureNotify
allocaXEvent $ \event -> do
setEventType event configureNotify
- setConfigureEvent event w w (fi x) (fi y) (fi width) (fi height) 0 0 False
+ setConfigureEvent event w w (fi x') (fi y') (fi width') (fi height') 0 0 False
sendEvent d w False structureNotifyMask event
modifyWindowState (\ws -> ws { wsMapped = True }) w
where
@@ -221,10 +237,9 @@ clearEvents mask = withDisplay $ \d -> io $ do
-- rectangle, including its border.
tileWindow :: Window -> Rectangle -> X ()
tileWindow w r = withDisplay $ \d -> do
- let bw = 0
-- give all windows at least 1x1 pixels
- let least x | x <= bw*2 = 1
- | otherwise = x - bw*2
+ let least x | x <= 0 = 1
+ | otherwise = x
frame <- getsWindowState wsFrame w
io $ moveResizeWindow d frame (rect_x r) (rect_y r) (least $ rect_width r) (least $ rect_height r)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 01:54:26 +0100