diff options
Diffstat (limited to 'XMonad')
| -rw-r--r-- | XMonad/Config.hs | 8 | ||||
| -rw-r--r-- | XMonad/Core.hs | 37 | ||||
| -rw-r--r-- | XMonad/Main.hsc | 7 | ||||
| -rw-r--r-- | XMonad/Operations.hs | 29 |
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) |