xmonad 0.7 → 0.8
raw patch · 14 files changed
+561/−525 lines, 14 files
Files
- Main.hs +6/−0
- README +4/−17
- XMonad/Config.hs +11/−25
- XMonad/Core.hs +21/−20
- XMonad/Layout.hs +80/−65
- XMonad/Main.hs +0/−300
- XMonad/Main.hsc +314/−0
- XMonad/ManageHook.hs +38/−14
- XMonad/Operations.hs +43/−36
- XMonad/StackSet.hs +33/−26
- man/xmonad.hs +1/−18
- man/xmonad.html +3/−1
- tests/Properties.hs +4/−0
- xmonad.cabal +3/−3
Main.hs view
@@ -62,11 +62,17 @@ -- | Build "~/.xmonad/xmonad.hs" with ghc, then execute it. If there are no -- errors, this function does not return. An exception is raised in any of -- these cases:+-- -- * ghc missing+-- -- * ~/.xmonad/xmonad.hs missing+-- -- * xmonad.hs fails to compile+-- -- ** wrong ghc in path (fails to compile)+-- -- ** type error, syntax error, ..+-- -- * Missing xmonad/XMonadContrib modules due to ghc upgrade -- buildLaunch :: IO ()
README view
@@ -24,7 +24,7 @@ Building: - Building is quite straightforward, and requries a basic Haskell toolchain.+ Building is quite straightforward, and requires a basic Haskell toolchain. On many systems xmonad is available as a binary package in your package system (e.g. on debian or gentoo). If at all possible, use this in preference to a source build, as the dependency resolution will be@@ -80,9 +80,9 @@ provided. To check whether you've got a package run 'ghc-pkg list some_package_name'. You will need the following packages: - mtl http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mtl-1.0- unix http://hackage.haskell.org/cgi-bin/hackage-scripts/package/unix-2.0 - X11 http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11-1.4.1+ mtl http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mtl+ unix http://hackage.haskell.org/cgi-bin/hackage-scripts/package/unix+ X11 http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11 * Build xmonad: @@ -94,19 +94,6 @@ runhaskell Setup.lhs install --user And you're done!----------------------------------------------------------------------------Notes for using the darcs version-- If you're building the darcs version of xmonad, be sure to also- use the darcs version of the X11 library, which is developed- concurrently with xmonad.-- darcs get http://darcs.haskell.org/X11-- Not using X11 from darcs is the most common reason for the- darcs version of xmonad to fail to build. ------------------------------------------------------------------------
XMonad/Config.hs view
@@ -26,12 +26,10 @@ -- import XMonad.Core as XMonad hiding (workspaces,manageHook,numlockMask,keys,logHook,startupHook,borderWidth,mouseBindings- ,defaultGaps,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor- ,focusFollowsMouse)+ ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse) import qualified XMonad.Core as XMonad (workspaces,manageHook,numlockMask,keys,logHook,startupHook,borderWidth,mouseBindings- ,defaultGaps,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor- ,focusFollowsMouse)+ ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse) import XMonad.Layout import XMonad.Operations@@ -86,23 +84,8 @@ -- | Border colors for unfocused and focused windows, respectively. -- normalBorderColor, focusedBorderColor :: String-normalBorderColor = "#dddddd"-focusedBorderColor = "#ff0000"---- | Default offset of drawable screen boundaries from each physical--- screen. Anything non-zero here will leave a gap of that many pixels--- on the given edge, on the that screen. A useful gap at top of screen--- for a menu bar (e.g. 15)------ An example, to set a top gap on monitor 1, and a gap on the bottom of--- monitor 2, you'd use a list of geometries like so:------ > defaultGaps = [(18,0,0,0),(0,18,0,0)] -- 2 gaps on 2 monitors------ Fields are: top, bottom, left, right.----defaultGaps :: [(Int,Int,Int,Int)]-defaultGaps = [(0,0,0,0)] -- 15 for default dzen font+normalBorderColor = "gray" -- "#dddddd"+focusedBorderColor = "red" -- "#ff0000" don't use hex, not <24 bit safe ------------------------------------------------------------------------ -- Window rules@@ -126,7 +109,9 @@ -- | Perform an arbitrary action on each internal state change or X event. -- Examples include:+-- -- * do nothing+-- -- * log the state to stdout -- -- See the 'DynamicLog' extension for examples.@@ -216,7 +201,7 @@ , ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area -- toggle the status bar gap- , ((modMask , xK_b ), modifyGap (\i n -> let x = (XMonad.defaultGaps conf ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap+ --, ((modMask , xK_b ), modifyGap (\i n -> let x = (XMonad.defaultGaps conf ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap -- quit, or restart , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad@@ -240,11 +225,13 @@ mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $ -- mod-button1 %! Set the window to floating mode and move by dragging- [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))+ [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w+ >> windows W.swapMaster)) -- mod-button2 %! Raise the window to the top of the stack , ((modMask, button2), (\w -> focus w >> windows W.swapMaster)) -- mod-button3 %! Set the window to floating mode and resize by dragging- , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w))+ , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w+ >> windows W.swapMaster)) -- you may also bind events to the mouse scroll wheel (button4 and button5) ] @@ -252,7 +239,6 @@ defaultConfig = XConfig { XMonad.borderWidth = borderWidth , XMonad.workspaces = workspaces- , XMonad.defaultGaps = defaultGaps , XMonad.layoutHook = layout , XMonad.terminal = terminal , XMonad.normalBorderColor = normalBorderColor
XMonad/Core.hs view
@@ -9,11 +9,11 @@ -- Copyright : (c) Spencer Janssen 2007 -- License : BSD3-style (see LICENSE) ----- Maintainer : sjanssen@cse.unl.edu+-- Maintainer : spencerjanssen@gmail.com -- Stability : unstable -- Portability : not portable, uses cunning newtype deriving ----- The X monad, a state monad transformer over IO, for the window+-- The 'X' monad, a state monad transformer over 'IO', for the window -- manager state, and support routines. -- -----------------------------------------------------------------------------@@ -69,6 +69,7 @@ -- ^ a mapping of key presses to actions , buttonActions :: !(M.Map (KeyMask, Button) (Window -> X ())) -- ^ a mapping of button presses to actions+ , mouseFocused :: !Bool -- ^ was refocus caused by mouse action? } -- todo, better name@@ -79,7 +80,6 @@ , layoutHook :: !(l Window) -- ^ The available layouts , manageHook :: !ManageHook -- ^ The action to run when a new window is opened , workspaces :: ![String] -- ^ The list of workspaces' names- , defaultGaps :: ![(Int,Int,Int,Int)] -- ^ The list of gaps, per screen , numlockMask :: !KeyMask -- ^ The numlock modifier , modMask :: !KeyMask -- ^ the mod modifier , keys :: !(XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()))@@ -102,20 +102,18 @@ -- | Physical screen indices newtype ScreenId = S Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real) --- | The 'Rectangle' with screen dimensions and the list of gaps-data ScreenDetail = SD { screenRect :: !Rectangle- , statusGap :: !(Int,Int,Int,Int) -- ^ gaps on the sides of the screen that shouldn't be tiled, usually for status bars- } deriving (Eq,Show, Read)+-- | The 'Rectangle' with screen dimensions+data ScreenDetail = SD { screenRect :: !Rectangle } deriving (Eq,Show, Read) ------------------------------------------------------------------------ --- | The X monad, ReaderT and StateT transformers over IO+-- | The X monad, 'ReaderT' and 'StateT' transformers over 'IO' -- encapsulating the window manager configuration and state, -- respectively. -- -- Dynamic components may be retrieved with 'get', static components -- with 'ask'. With newtype deriving we get readers and state monads--- instantiated on XConf and XState automatically.+-- instantiated on 'XConf' and 'XState' automatically. -- newtype X a = X (ReaderT XConf (StateT XState IO) a) #ifndef __HADDOCK__@@ -143,12 +141,12 @@ mempty = return mempty mappend = liftM2 mappend --- | Run the X monad, given a chunk of X monad code, and an initial state+-- | Run the 'X' monad, given a chunk of 'X' monad code, and an initial state -- Return the result, and final state runX :: XConf -> XState -> X a -> IO (a, XState) runX c st (X a) = runStateT (runReaderT a c) st --- | Run in the X monad, and in case of exception, and catch it and log it+-- | Run in the 'X' monad, and in case of exception, and catch it and log it -- to stderr, and run the error case. catchX :: X a -> X a -> X a catchX job errcase = do@@ -161,7 +159,7 @@ return a -- | Execute the argument, catching all exceptions. Either this function or--- catchX should be used at all callsites of user customized code.+-- 'catchX' should be used at all callsites of user customized code. userCode :: X () -> X () userCode a = catchX (a >> return ()) (return ()) @@ -330,11 +328,11 @@ -- --------------------------------------------------------------------- -- | General utilities ----- Lift an IO action into the X monad+-- Lift an 'IO' action into the 'X' monad io :: MonadIO m => IO a -> m a io = liftIO --- | Lift an IO action into the X monad. If the action results in an IO+-- | Lift an 'IO' action into the 'X' monad. If the action results in an 'IO' -- exception, log the exception to stderr and continue normal execution. catchIO :: MonadIO m => IO () -> m () catchIO f = io (f `catch` \e -> hPrint stderr e >> hFlush stderr)@@ -343,7 +341,7 @@ spawn :: MonadIO m => String -> m () spawn x = doubleFork $ executeFile "/bin/sh" False ["-c", x] Nothing --- | Double fork and execute an IO action (usually one of the exec family of+-- | Double fork and execute an 'IO' action (usually one of the exec family of -- functions) doubleFork :: MonadIO m => IO () -> m () doubleFork m = io $ do@@ -353,7 +351,7 @@ getProcessStatus True False pid return () --- | This is basically a map function, running a function in the X monad on+-- | This is basically a map function, running a function in the 'X' monad on -- each workspace with the output of that function being the modified workspace. runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X () runOnWorkspaces job = do@@ -369,8 +367,11 @@ -- | 'recompile force', recompile @~\/.xmonad\/xmonad.hs@ when any of the -- following apply:--- * force is True+--+-- * force is 'True'+-- -- * the xmonad executable does not exist+-- -- * the xmonad executable is older than xmonad.hs -- -- The -i flag is used to restrict recompilation to the xmonad.hs file only.@@ -379,7 +380,7 @@ -- GHC indicates failure with a non-zero exit code, an xmessage displaying -- that file is spawned. ----- False is returned if there are compilation errors.+-- 'False' is returned if there are compilation errors. -- recompile :: MonadIO m => Bool -> m Bool recompile force = io $ do@@ -415,11 +416,11 @@ whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () whenJust mg f = maybe (return ()) f mg --- | Conditionally run an action, using a X event to decide+-- | Conditionally run an action, using a 'X' event to decide whenX :: X Bool -> X () -> X () whenX a f = a >>= \b -> when b f --- | A 'trace' for the X monad. Logs a string to stderr. The result may+-- | A 'trace' for the 'X' monad. Logs a string to stderr. The result may -- be found in your .xsession-errors file trace :: MonadIO m => String -> m () trace = io . hPutStrLn stderr
XMonad/Layout.hs view
@@ -7,7 +7,7 @@ -- Copyright : (c) Spencer Janssen 2007 -- License : BSD3-style (see LICENSE) ----- Maintainer : sjanssen@cse.unl.edu+-- Maintainer : spencerjanssen@gmail.com -- Stability : unstable -- Portability : not portable, Typeable deriving, mtl, posix --@@ -16,8 +16,9 @@ ----------------------------------------------------------------------------- module XMonad.Layout (- ChangeLayout(..), Choose, (|||), Resize(..), IncMasterN(..),- Full(..), Tall(..), Mirror(..), mirrorRect, splitVertically,+ Full(..), Tall(..), Mirror(..),+ Resize(..), IncMasterN(..), Choose, (|||), ChangeLayout(..),+ mirrorRect, splitVertically, splitHorizontally, splitHorizontallyBy, splitVerticallyBy, tile@@ -33,30 +34,23 @@ import Data.Maybe (fromMaybe) --------------------------------------------------------------------------- | Builtin basic layout algorithms:------ > fullscreen mode--- > tall mode------ The latter algorithms support the following operations:------ > Shrink--- > Expand---++-- | Change the size of the master pane. data Resize = Shrink | Expand deriving Typeable --- | You can also increase the number of clients in the master pane+-- | Increase the number of clients in the master pane. data IncMasterN = IncMasterN !Int deriving Typeable instance Message Resize instance Message IncMasterN --- | Simple fullscreen mode, just render all windows fullscreen.+-- | Simple fullscreen mode. Renders the focused window fullscreen. data Full a = Full deriving (Show, Read) instance LayoutClass Full a --- | The builtin tiling mode of xmonad, and its operations.+-- | The builtin tiling mode of xmonad. Supports 'Shrink', 'Expand' and+-- 'IncMasterN'. data Tall a = Tall !Int !Rational !Rational deriving (Show, Read) -- TODO should be capped [0..1] .. @@ -76,20 +70,18 @@ description _ = "Tall" --- | tile. Compute the positions for windows using the default 2 pane tiling algorithm.------ The screen is divided (currently) into two panes. all clients are--- then partioned between these two panes. one pane, the `master', by--- convention has the least number of windows in it (by default, 1).--- the variable `nmaster' controls how many windows are rendered in the--- master pane.------ `delta' specifies the ratio of the screen to resize by.------ 'frac' specifies what proportion of the screen to devote to the--- master area.+-- | Compute the positions for windows using the default two-pane tiling+-- algorithm. ---tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]+-- The screen is divided into two panes. All clients are+-- then partioned between these two panes. One pane, the master, by+-- convention has the least number of windows in it.+tile+ :: Rational -- ^ @frac@, what proportion of the screen to devote to the master area+ -> Rectangle -- ^ @r@, the rectangle representing the screen+ -> Int -- ^ @nmaster@, the number of windows in the master pane+ -> Int -- ^ @n@, the total number of windows to tile+ -> [Rectangle] tile f r nmaster n = if n <= nmaster || nmaster == 0 then splitVertically n r else splitVertically nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns@@ -118,10 +110,9 @@ splitVerticallyBy f = (mirrorRect *** mirrorRect) . splitHorizontallyBy f . mirrorRect --------------------------------------------------------------------------- | Mirror a layout, compute its 90 degree rotated form. -- | Mirror a layout, compute its 90 degree rotated form.-data Mirror l a = Mirror (l a) deriving (Show, Read)+newtype Mirror l a = Mirror (l a) deriving (Show, Read) instance LayoutClass l a => LayoutClass (Mirror l) a where runLayout (W.Workspace i (Mirror l) ms) r = (map (second mirrorRect) *** fmap Mirror)@@ -129,7 +120,7 @@ handleMessage (Mirror l) = fmap (fmap Mirror) . handleMessage l description (Mirror l) = "Mirror "++ description l --- | Mirror a rectangle+-- | Mirror a rectangle. mirrorRect :: Rectangle -> Rectangle mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw) @@ -137,8 +128,6 @@ -- LayoutClass selection manager -- Layouts that transition between other layouts --- | A layout that allows users to switch between various layout options.- -- | Messages to change the current layout. data ChangeLayout = FirstLayout | NextLayout deriving (Eq, Show, Typeable) @@ -146,47 +135,73 @@ -- | The layout choice combinator (|||) :: (LayoutClass l a, LayoutClass r a) => l a -> r a -> Choose l r a-(|||) = flip SLeft+(|||) = Choose L infixr 5 ||| -data Choose l r a = SLeft (r a) (l a)- | SRight (l a) (r a) deriving (Read, Show)+-- | A layout that allows users to switch between various layout options.+data Choose l r a = Choose LR (l a) (r a) deriving (Read, Show) +-- | Are we on the left or right sub-layout?+data LR = L | R deriving (Read, Show, Eq)+ data NextNoWrap = NextNoWrap deriving (Eq, Show, Typeable) instance Message NextNoWrap --- This has lots of pseudo duplicated code, we must find a better way-instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where- runLayout (W.Workspace i (SLeft r l) ms) =- fmap (second . fmap $ SLeft r) . runLayout (W.Workspace i l ms)- runLayout (W.Workspace i (SRight l r) ms) =- fmap (second . fmap $ SRight l) . runLayout (W.Workspace i r ms)+-- | A small wrapper around handleMessage, as it is tedious to write+-- SomeMessage repeatedly.+handle :: (LayoutClass l a, Message m) => l a -> m -> X (Maybe (l a))+handle l m = handleMessage l (SomeMessage m) - description (SLeft _ l) = description l- description (SRight _ r) = description r+-- | A smart constructor that takes some potential modifications, returns a+-- new structure if any fields have changed, and performs any necessary cleanup+-- on newly non-visible layouts.+choose :: (LayoutClass l a, LayoutClass r a)+ => Choose l r a-> LR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))+choose (Choose d _ _) d' Nothing Nothing | d == d' = return Nothing+choose (Choose d l r) d' ml mr = f lr+ where+ (l', r') = (fromMaybe l ml, fromMaybe r mr)+ lr = case (d, d') of+ (L, R) -> (hide l' , return r')+ (R, L) -> (return l', hide r' )+ (_, _) -> (return l', return r')+ f (x,y) = fmap Just $ liftM2 (Choose d') x y+ hide x = fmap (fromMaybe x) $ handle x Hide - handleMessage lr m | Just FirstLayout <- fromMessage m = case lr of- SLeft {} -> return Nothing- SRight l r -> fmap (Just . flip SLeft l . fromMaybe r)- $ handleMessage r (SomeMessage Hide)+instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where+ runLayout (W.Workspace i (Choose L l r) ms) =+ fmap (second . fmap $ flip (Choose L) $ r) . runLayout (W.Workspace i l ms)+ runLayout (W.Workspace i (Choose R l r) ms) =+ fmap (second . fmap $ Choose R l) . runLayout (W.Workspace i r ms) + description (Choose L l _) = description l+ description (Choose R _ r) = description r+ handleMessage lr m | Just NextLayout <- fromMessage m = do- mlr <- handleMessage lr $ SomeMessage NextNoWrap- maybe (handleMessage lr $ SomeMessage FirstLayout) (return . Just) mlr+ mlr' <- handle lr NextNoWrap+ maybe (handle lr FirstLayout) (return . Just) mlr' - handleMessage (SLeft r l) m | Just NextNoWrap <- fromMessage m = do- handleMessage l (SomeMessage Hide)- mr <- handleMessage r (SomeMessage FirstLayout)- return . Just . SRight l $ fromMaybe r mr+ handleMessage c@(Choose d l r) m | Just NextNoWrap <- fromMessage m =+ case d of+ L -> do+ ml <- handle l NextNoWrap+ case ml of+ Just _ -> choose c L ml Nothing+ Nothing -> choose c R Nothing =<< handle r FirstLayout - handleMessage lr m | Just ReleaseResources <- fromMessage m =- liftM2 ((Just .) . cons)- (fmap (fromMaybe l) $ handleMessage l m)- (fmap (fromMaybe r) $ handleMessage r m)- where (cons, l, r) = case lr of- (SLeft r' l') -> (flip SLeft, l', r')- (SRight l' r') -> (SRight, l', r')+ R -> choose c R Nothing =<< handle r NextNoWrap - -- The default cases for left and right:- handleMessage (SLeft r l) m = fmap (fmap $ SLeft r) $ handleMessage l m- handleMessage (SRight l r) m = fmap (fmap $ SRight l) $ handleMessage r m+ handleMessage c@(Choose _ l _) m | Just FirstLayout <- fromMessage m = do + flip (choose c L) Nothing =<< handle l FirstLayout++ handleMessage c@(Choose d l r) m | Just ReleaseResources <- fromMessage m =+ join $ liftM2 (choose c d) (handle l ReleaseResources) (handle r ReleaseResources)++ handleMessage c@(Choose d l r) m = do+ ml' <- case d of+ L -> handleMessage l m+ R -> return Nothing+ mr' <- case d of+ L -> return Nothing+ R -> handleMessage r m+ choose c d ml' mr'
− XMonad/Main.hs
@@ -1,300 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}-------------------------------------------------------------------------------- |--- Module : XMonad.Main--- Copyright : (c) Spencer Janssen 2007--- License : BSD3-style (see LICENSE)------ Maintainer : sjanssen@cse.unl.edu--- Stability : unstable--- Portability : not portable, uses mtl, X11, posix------ xmonad, a minimalist, tiling window manager for X11-----------------------------------------------------------------------------------module XMonad.Main (xmonad) where--import Data.Bits-import Data.List ((\\))-import qualified Data.Map as M-import qualified Data.Set as S-import Control.Monad.Reader-import Control.Monad.State-import Data.Maybe (fromMaybe)--import System.Environment (getArgs)-import System.Posix.Signals--import Graphics.X11.Xlib hiding (refreshKeyboardMapping)-import Graphics.X11.Xlib.Extras--import XMonad.Core-import qualified XMonad.Config as Default-import XMonad.StackSet (new, floating, member)-import qualified XMonad.StackSet as W-import XMonad.Operations--import System.IO---- |--- The main entry point----xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()-xmonad initxmc = do- -- ignore SIGPIPE- installHandler openEndedPipe Ignore Nothing- -- First, wrap the layout in an existential, to keep things pretty:- let xmc = initxmc { layoutHook = Layout $ layoutHook initxmc }- dpy <- openDisplay ""- let dflt = defaultScreen dpy-- rootw <- rootWindow dpy dflt- xinesc <- getCleanedScreenInfo dpy- nbc <- do v <- initColor dpy $ normalBorderColor xmc- ~(Just nbc_) <- initColor dpy $ normalBorderColor Default.defaultConfig- return (fromMaybe nbc_ v)-- fbc <- do v <- initColor dpy $ focusedBorderColor xmc- ~(Just fbc_) <- initColor dpy $ focusedBorderColor Default.defaultConfig- return (fromMaybe fbc_ v)-- hSetBuffering stdout NoBuffering- args <- getArgs-- let layout = layoutHook xmc- lreads = readsLayout layout- initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps-- maybeRead reads' s = case reads' s of- [(x, "")] -> Just x- _ -> Nothing-- winset = fromMaybe initialWinset $ do- ("--resume" : s : _) <- return args- ws <- maybeRead reads s- return . W.ensureTags layout (workspaces xmc)- $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws-- gaps = take (length xinesc) $ defaultGaps xmc ++ repeat (0,0,0,0)-- cf = XConf- { display = dpy- , config = xmc- , theRoot = rootw- , normalBorder = nbc- , focusedBorder = fbc- , keyActions = keys xmc xmc- , buttonActions = mouseBindings xmc xmc }- st = XState- { windowset = initialWinset- , mapped = S.empty- , waitingUnmap = M.empty- , dragging = Nothing }-- xSetErrorHandler -- in C, I'm too lazy to write the binding: dons-- -- setup initial X environment- sync dpy False- selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask- .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask-- allocaXEvent $ \e ->- runX cf st $ do-- grabKeys- grabButtons-- io $ sync dpy False-- ws <- io $ scan dpy rootw-- -- bootstrap the windowset, Operations.windows will identify all- -- the windows in winset as new and set initial properties for- -- those windows. Remove all windows that are no longer top-level- -- children of the root, they may have disappeared since- -- restarting.- windows . const . foldr W.delete winset $ W.allWindows winset \\ ws-- -- manage the as-yet-unmanaged windows- mapM_ manage (ws \\ W.allWindows winset)-- userCode $ startupHook initxmc-- -- main loop, for all you HOF/recursion fans out there.- forever_ $ handle =<< io (nextEvent dpy e >> getEvent e)-- return ()- where forever_ a = a >> forever_ a----- ------------------------------------------------------------------------ | Event handler. Map X events onto calls into Operations.hs, which--- modify our internal model of the window manager state.------ Events dwm handles that we don't:------ [ButtonPress] = buttonpress,--- [Expose] = expose,--- [PropertyNotify] = propertynotify,----handle :: Event -> X ()---- run window manager command-handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})- | t == keyPress = withDisplay $ \dpy -> do- s <- io $ keycodeToKeysym dpy code 0- mClean <- cleanMask m- ks <- asks keyActions- userCode $ whenJust (M.lookup (mClean, s) ks) id---- manage a new window-handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do- wa <- io $ getWindowAttributes dpy w -- ignore override windows- -- need to ignore mapping requests by managed windows not on the current workspace- managed <- isClient w- when (not (wa_override_redirect wa) && not managed) $ do manage w---- window destroyed, unmanage it--- window gone, unmanage it-handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ do- unmanage w- modify (\s -> s { mapped = S.delete w (mapped s)- , waitingUnmap = M.delete w (waitingUnmap s)})---- We track expected unmap events in waitingUnmap. We ignore this event unless--- it is synthetic or we are not expecting an unmap notification from a window.-handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do- e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)- if (synthetic || e == 0)- then unmanage w- else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) })- where mpred 1 = Nothing- mpred n = Just $ pred n---- set keyboard mapping-handle e@(MappingNotifyEvent {}) = do- io $ refreshKeyboardMapping e- when (ev_request e == mappingKeyboard) grabKeys---- handle button release, which may finish dragging.-handle e@(ButtonEvent {ev_event_type = t})- | t == buttonRelease = do- drag <- gets dragging- case drag of- -- we're done dragging and have released the mouse:- Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f- Nothing -> broadcastMessage e---- handle motionNotify event, which may mean we are dragging.-handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do- drag <- gets dragging- case drag of- Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging- Nothing -> broadcastMessage e---- click on an unfocused window, makes it focused on this workspace-handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })- | t == buttonPress = do- -- If it's the root window, then it's something we- -- grabbed in grabButtons. Otherwise, it's click-to-focus.- isr <- isRoot w- m <- cleanMask $ ev_state e- ba <- asks buttonActions- if isr then userCode $ whenJust (M.lookup (m, b) ba) ($ ev_subwindow e)- else focus w- broadcastMessage e -- Always send button events.---- entered a normal window: focus it if focusFollowsMouse is set to--- True in the user's config.-handle e@(CrossingEvent {ev_window = w, ev_event_type = t})- | t == enterNotify && ev_mode e == notifyNormal- && ev_detail e /= notifyInferior- = whenX (asks $ focusFollowsMouse . config) (focus w)---- left a window, check if we need to focus root-handle e@(CrossingEvent {ev_event_type = t})- | t == leaveNotify- = do rootw <- asks theRoot- when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw---- configure a window-handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do- ws <- gets windowset- wa <- io $ getWindowAttributes dpy w-- bw <- asks (borderWidth . config)-- if M.member w (floating ws)- || not (member w ws)- then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges- { wc_x = ev_x e- , wc_y = ev_y e- , wc_width = ev_width e- , wc_height = ev_height e- , wc_border_width = fromIntegral bw- , wc_sibling = ev_above e- , wc_stack_mode = ev_detail e }- when (member w ws) (float w)- else io $ allocaXEvent $ \ev -> do- setEventType ev configureNotify- setConfigureEvent ev w w- (wa_x wa) (wa_y wa) (wa_width wa)- (wa_height wa) (ev_border_width e) none (wa_override_redirect wa)- sendEvent dpy w False 0 ev- io $ sync dpy False---- configuration changes in the root may mean display settings have changed-handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen---- property notify-handle PropertyEvent { ev_event_type = t, ev_atom = a }- | t == propertyNotify && a == wM_NAME = userCode =<< asks (logHook . config)--handle e = broadcastMessage e -- trace (eventName e) -- ignoring----- ------------------------------------------------------------------------ IO stuff. Doesn't require any X state--- Most of these things run only on startup (bar grabkeys)---- | scan for any new windows to manage. If they're already managed,--- this should be idempotent.-scan :: Display -> Window -> IO [Window]-scan dpy rootw = do- (_, _, ws) <- queryTree dpy rootw- filterM ok ws- -- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==- -- Iconic- where ok w = do wa <- getWindowAttributes dpy w- a <- internAtom dpy "WM_STATE" False- p <- getWindowProperty32 dpy a w- let ic = case p of- Just (3:_) -> True -- 3 for iconified- _ -> False- return $ not (wa_override_redirect wa)- && (wa_map_state wa == waIsViewable || ic)---- | Grab the keys back-grabKeys :: X ()-grabKeys = do- XConf { display = dpy, theRoot = rootw } <- ask- let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync- io $ ungrabKey dpy anyKey anyModifier rootw- ks <- asks keyActions- forM_ (M.keys ks) $ \(mask,sym) -> do- kc <- io $ keysymToKeycode dpy sym- -- "If the specified KeySym is not defined for any KeyCode,- -- XKeysymToKeycode() returns zero."- when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) =<< extraModifiers---- | XXX comment me-grabButtons :: X ()-grabButtons = do- XConf { display = dpy, theRoot = rootw } <- ask- let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask- grabModeAsync grabModeSync none none- io $ ungrabButton dpy anyButton anyModifier rootw- ems <- extraModifiers- ba <- asks buttonActions- mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)
+ XMonad/Main.hsc view
@@ -0,0 +1,314 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, ForeignFunctionInterface #-}+----------------------------------------------------------------------------+-- |+-- Module : XMonad.Main+-- Copyright : (c) Spencer Janssen 2007+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : spencerjanssen@gmail.com+-- Stability : unstable+-- Portability : not portable, uses mtl, X11, posix+--+-- xmonad, a minimalist, tiling window manager for X11+--+-----------------------------------------------------------------------------++module XMonad.Main (xmonad) where++import Data.Bits+import Data.List ((\\))+import qualified Data.Map as M+import qualified Data.Set as S+import Control.Monad.Reader+import Control.Monad.State+import Data.Maybe (fromMaybe)++import Foreign.C+import Foreign.Ptr++import System.Environment (getArgs)+import System.Posix.Signals++import Graphics.X11.Xlib hiding (refreshKeyboardMapping)+import Graphics.X11.Xlib.Extras++import XMonad.Core+import qualified XMonad.Config as Default+import XMonad.StackSet (new, floating, member)+import qualified XMonad.StackSet as W+import XMonad.Operations++import System.IO++------------------------------------------------------------------------+-- Locale support++#include <locale.h>++foreign import ccall unsafe "locale.h setlocale"+ c_setlocale :: CInt -> Ptr CChar -> IO (Ptr CChar)++------------------------------------------------------------------------++-- |+-- The main entry point+--+xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()+xmonad initxmc = do+ -- setup locale information from environment+ withCString "" $ c_setlocale (#const LC_ALL)+ -- ignore SIGPIPE+ installHandler openEndedPipe Ignore Nothing+ -- First, wrap the layout in an existential, to keep things pretty:+ let xmc = initxmc { layoutHook = Layout $ layoutHook initxmc }+ dpy <- openDisplay ""+ let dflt = defaultScreen dpy++ rootw <- rootWindow dpy dflt+ xinesc <- getCleanedScreenInfo dpy+ nbc <- do v <- initColor dpy $ normalBorderColor xmc+ ~(Just nbc_) <- initColor dpy $ normalBorderColor Default.defaultConfig+ return (fromMaybe nbc_ v)++ fbc <- do v <- initColor dpy $ focusedBorderColor xmc+ ~(Just fbc_) <- initColor dpy $ focusedBorderColor Default.defaultConfig+ return (fromMaybe fbc_ v)++ hSetBuffering stdout NoBuffering+ args <- getArgs++ let layout = layoutHook xmc+ lreads = readsLayout layout+ initialWinset = new layout (workspaces xmc) $ map SD xinesc++ maybeRead reads' s = case reads' s of+ [(x, "")] -> Just x+ _ -> Nothing++ winset = fromMaybe initialWinset $ do+ ("--resume" : s : _) <- return args+ ws <- maybeRead reads s+ return . W.ensureTags layout (workspaces xmc)+ $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws++ cf = XConf+ { display = dpy+ , config = xmc+ , theRoot = rootw+ , normalBorder = nbc+ , focusedBorder = fbc+ , keyActions = keys xmc xmc+ , buttonActions = mouseBindings xmc xmc+ , mouseFocused = False }+ st = XState+ { windowset = initialWinset+ , mapped = S.empty+ , waitingUnmap = M.empty+ , dragging = Nothing }++ xSetErrorHandler -- in C, I'm too lazy to write the binding: dons++ -- setup initial X environment+ sync dpy False+ selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask+ .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask++ allocaXEvent $ \e ->+ runX cf st $ do++ grabKeys+ grabButtons++ io $ sync dpy False++ ws <- io $ scan dpy rootw++ -- bootstrap the windowset, Operations.windows will identify all+ -- the windows in winset as new and set initial properties for+ -- those windows. Remove all windows that are no longer top-level+ -- children of the root, they may have disappeared since+ -- restarting.+ windows . const . foldr W.delete winset $ W.allWindows winset \\ ws++ -- manage the as-yet-unmanaged windows+ mapM_ manage (ws \\ W.allWindows winset)++ userCode $ startupHook initxmc++ -- main loop, for all you HOF/recursion fans out there.+ forever_ $ handle =<< io (nextEvent dpy e >> getEvent e)++ return ()+ where forever_ a = a >> forever_ a+++-- ---------------------------------------------------------------------+-- | Event handler. Map X events onto calls into Operations.hs, which+-- modify our internal model of the window manager state.+--+-- Events dwm handles that we don't:+--+-- [ButtonPress] = buttonpress,+-- [Expose] = expose,+-- [PropertyNotify] = propertynotify,+--+handle :: Event -> X ()++-- run window manager command+handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})+ | t == keyPress = withDisplay $ \dpy -> do+ s <- io $ keycodeToKeysym dpy code 0+ mClean <- cleanMask m+ ks <- asks keyActions+ userCode $ whenJust (M.lookup (mClean, s) ks) id++-- manage a new window+handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do+ wa <- io $ getWindowAttributes dpy w -- ignore override windows+ -- need to ignore mapping requests by managed windows not on the current workspace+ managed <- isClient w+ when (not (wa_override_redirect wa) && not managed) $ do manage w++-- window destroyed, unmanage it+-- window gone, unmanage it+handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ do+ unmanage w+ modify (\s -> s { mapped = S.delete w (mapped s)+ , waitingUnmap = M.delete w (waitingUnmap s)})++-- We track expected unmap events in waitingUnmap. We ignore this event unless+-- it is synthetic or we are not expecting an unmap notification from a window.+handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do+ e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)+ if (synthetic || e == 0)+ then unmanage w+ else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) })+ where mpred 1 = Nothing+ mpred n = Just $ pred n++-- set keyboard mapping+handle e@(MappingNotifyEvent {}) = do+ io $ refreshKeyboardMapping e+ when (ev_request e == mappingKeyboard) grabKeys++-- handle button release, which may finish dragging.+handle e@(ButtonEvent {ev_event_type = t})+ | t == buttonRelease = do+ drag <- gets dragging+ case drag of+ -- we're done dragging and have released the mouse:+ Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f+ Nothing -> broadcastMessage e++-- handle motionNotify event, which may mean we are dragging.+handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do+ drag <- gets dragging+ case drag of+ Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging+ Nothing -> broadcastMessage e++-- click on an unfocused window, makes it focused on this workspace+handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })+ | t == buttonPress = do+ -- If it's the root window, then it's something we+ -- grabbed in grabButtons. Otherwise, it's click-to-focus.+ isr <- isRoot w+ m <- cleanMask $ ev_state e+ ba <- asks buttonActions+ if isr then userCode $ whenJust (M.lookup (m, b) ba) ($ ev_subwindow e)+ else focus w+ broadcastMessage e -- Always send button events.++-- entered a normal window: focus it if focusFollowsMouse is set to+-- True in the user's config.+handle e@(CrossingEvent {ev_window = w, ev_event_type = t})+ | t == enterNotify && ev_mode e == notifyNormal+ && ev_detail e /= notifyInferior+ = whenX (asks $ focusFollowsMouse . config) (focus w)++-- left a window, check if we need to focus root+handle e@(CrossingEvent {ev_event_type = t})+ | t == leaveNotify+ = do rootw <- asks theRoot+ when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw++-- configure a window+handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do+ ws <- gets windowset+ wa <- io $ getWindowAttributes dpy w++ bw <- asks (borderWidth . config)++ if M.member w (floating ws)+ || not (member w ws)+ then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges+ { wc_x = ev_x e+ , wc_y = ev_y e+ , wc_width = ev_width e+ , wc_height = ev_height e+ , wc_border_width = fromIntegral bw+ , wc_sibling = ev_above e+ , wc_stack_mode = ev_detail e }+ when (member w ws) (float w)+ else io $ allocaXEvent $ \ev -> do+ setEventType ev configureNotify+ setConfigureEvent ev w w+ (wa_x wa) (wa_y wa) (wa_width wa)+ (wa_height wa) (ev_border_width e) none (wa_override_redirect wa)+ sendEvent dpy w False 0 ev+ io $ sync dpy False++-- configuration changes in the root may mean display settings have changed+handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen++-- property notify+handle PropertyEvent { ev_event_type = t, ev_atom = a }+ | t == propertyNotify && a == wM_NAME = userCode =<< asks (logHook . config)++handle e = broadcastMessage e -- trace (eventName e) -- ignoring+++-- ---------------------------------------------------------------------+-- IO stuff. Doesn't require any X state+-- Most of these things run only on startup (bar grabkeys)++-- | scan for any new windows to manage. If they're already managed,+-- this should be idempotent.+scan :: Display -> Window -> IO [Window]+scan dpy rootw = do+ (_, _, ws) <- queryTree dpy rootw+ filterM ok ws+ -- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==+ -- Iconic+ where ok w = do wa <- getWindowAttributes dpy w+ a <- internAtom dpy "WM_STATE" False+ p <- getWindowProperty32 dpy a w+ let ic = case p of+ Just (3:_) -> True -- 3 for iconified+ _ -> False+ return $ not (wa_override_redirect wa)+ && (wa_map_state wa == waIsViewable || ic)++-- | Grab the keys back+grabKeys :: X ()+grabKeys = do+ XConf { display = dpy, theRoot = rootw } <- ask+ let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync+ io $ ungrabKey dpy anyKey anyModifier rootw+ ks <- asks keyActions+ forM_ (M.keys ks) $ \(mask,sym) -> do+ kc <- io $ keysymToKeycode dpy sym+ -- "If the specified KeySym is not defined for any KeyCode,+ -- XKeysymToKeycode() returns zero."+ when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) =<< extraModifiers++-- | XXX comment me+grabButtons :: X ()+grabButtons = do+ XConf { display = dpy, theRoot = rootw } <- ask+ let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask+ grabModeAsync grabModeSync none none+ io $ ungrabButton dpy anyButton anyModifier rootw+ ems <- extraModifiers+ ba <- asks buttonActions+ mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)
XMonad/ManageHook.hs view
@@ -6,7 +6,7 @@ -- Copyright : (c) Spencer Janssen 2007 -- License : BSD3-style (see LICENSE) ----- Maintainer : sjanssen@cse.unl.edu+-- Maintainer : spencerjanssen@gmail.com -- Stability : unstable -- Portability : not portable, uses cunning newtype deriving --@@ -18,15 +18,18 @@ module XMonad.ManageHook where +import Prelude hiding (catch) import XMonad.Core import Graphics.X11.Xlib.Extras-import Graphics.X11.Xlib (Display,Window)+import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME)+import Control.Exception (bracket, catch) import Control.Monad.Reader import Data.Maybe import Data.Monoid import qualified XMonad.StackSet as W import XMonad.Operations (floatLocation, reveal) +-- | Lift an 'X' action to a 'Query'. liftX :: X a -> Query a liftX = Query . lift @@ -34,39 +37,56 @@ idHook :: ManageHook idHook = doF id --- | Compose two 'ManageHook's+-- | Compose two 'ManageHook's. (<+>) :: ManageHook -> ManageHook -> ManageHook (<+>) = mappend --- | Compose the list of 'ManageHook's+-- | Compose the list of 'ManageHook's. composeAll :: [ManageHook] -> ManageHook composeAll = mconcat --- | 'p --> x'. If 'p' returns 'True', execute the 'ManageHook'.+-- | @p --> x@. If @p@ returns 'True', execute the 'ManageHook'. (-->) :: Query Bool -> ManageHook -> ManageHook p --> f = p >>= \b -> if b then f else mempty --- | 'q =? x'. if the result of 'q' equals 'x', return 'True'.+-- | @q =? x@. if the result of @q@ equals @x@, return 'True'. (=?) :: Eq a => Query a -> a -> Query Bool q =? x = fmap (== x) q infixr 3 <&&>, <||> --- | 'p <&&> q'. '&&' lifted to a Monad.+-- | '&&' lifted to a 'Monad'. (<&&>) :: Monad m => m Bool -> m Bool -> m Bool (<&&>) = liftM2 (&&) --- | 'p <||> q'. '||' lifted to a Monad.+-- | '||' lifted to a 'Monad'. (<||>) :: Monad m => m Bool -> m Bool -> m Bool (<||>) = liftM2 (||) --- | Queries that return the window title, resource, or class.-title, resource, className :: Query String-title = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe "") $ io $ fetchName d w)-resource = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClassHint d w)-className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getClassHint d w)+-- | Return the window title.+title :: Query String+title = ask >>= \w -> liftX $ do+ d <- asks display+ let+ getProp =+ (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w)+ `catch` \_ -> getTextProperty d w wM_NAME+ extract = fmap head . wcTextPropertyToTextList d+ io $ bracket getProp (xFree . tp_value) extract `catch` \_ -> return "" --- | A query that can return an arbitrary X property of type String,+-- | Return the application name.+appName :: Query String+appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClassHint d w)++-- | Backwards compatible alias for 'appName'.+resource :: Query String+resource = appName++-- | Return the resource class.+className :: Query String+className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getClassHint d w)++-- | A query that can return an arbitrary X property of type 'String', -- identified by name. stringProperty :: String -> Query String stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe "") $ getStringProperty d w p)@@ -88,3 +108,7 @@ -- | Map the window and remove it from the 'WindowSet'. doIgnore :: ManageHook doIgnore = ask >>= \w -> liftX (reveal w) >> doF (W.delete w)++-- | Move the window to a given workspace+doShift :: WorkspaceId -> ManageHook+doShift = doF . W.shift
XMonad/Operations.hs view
@@ -57,7 +57,7 @@ let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh isTransient <- isJust <$> io (getTransientForHint d w) - (sc, rr) <- floatLocation w+ rr <- snd `fmap` floatLocation w -- ensure that float windows don't go over the edge of the screen let adjust (W.RationalRect x y wid h) | x + wid > 1 || y + h > 1 || x < 0 || y < 0 = W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h@@ -65,7 +65,7 @@ f ws | isFixedSize || isTransient = W.float w (adjust rr) . W.insertUp w . W.view i $ ws | otherwise = W.insertUp w ws- where i = fromMaybe (W.tag . W.workspace . W.current $ ws) $ W.lookupWorkspace sc ws+ where i = W.tag $ W.workspace $ W.current ws mh <- asks (manageHook . config) g <- fmap appEndo (runQuery mh w) `catchX` return id@@ -77,15 +77,6 @@ unmanage :: Window -> X () unmanage = windows . W.delete --- | Modify the size of the status gap at the top of the current screen--- Taking a function giving the current screen, and current geometry.-modifyGap :: (Int -> (Int,Int,Int,Int) -> (Int,Int,Int,Int)) -> X ()-modifyGap f = do- windows $ \ws@(W.StackSet { W.current = c@(W.Screen { W.screenDetail = sd }) }) ->- let n = fromIntegral . W.screen $ c- g = f n . statusGap $ sd- in ws { W.current = c { W.screenDetail = sd { statusGap = g } } }- -- | Kill the currently focused client. If we do kill it, we'll get a -- delete notify back from X. --@@ -112,10 +103,11 @@ windows f = do XState { windowset = old } <- get let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old+ newwindows = W.allWindows ws \\ W.allWindows old ws = f old XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask - mapM_ setInitialProperties (W.allWindows ws \\ W.allWindows old)+ mapM_ setInitialProperties newwindows whenJust (W.peek old) $ \otherw -> io $ setWindowBorder d otherw nbc modify (\s -> s { windowset = ws })@@ -136,10 +128,7 @@ tiled = (W.stack . W.workspace . W.current $ this) >>= W.filter (`M.notMember` W.floating ws) >>= W.filter (`notElem` vis)- (SD (Rectangle sx sy sw sh)- (gt,gb,gl,gr)) = W.screenDetail w- viewrect = Rectangle (sx + fromIntegral gl) (sy + fromIntegral gt)- (sw - fromIntegral (gl + gr)) (sh - fromIntegral (gt + gb))+ viewrect@(Rectangle sx sy sw sh) = screenRect $ W.screenDetail w -- just the tiled windows: -- now tile the windows on this workspace, modified by the gap@@ -162,19 +151,22 @@ return vs whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc- setTopFocus asks (logHook . config) >>= userCode + mapM_ reveal visible+ setTopFocus+ -- hide every window that was potentially visible before, but is not -- given a position by a layout now.- mapM_ hide (nub oldvisible \\ visible)+ mapM_ hide (nub (oldvisible ++ newwindows) \\ visible) -- all windows that are no longer in the windowset are marked as -- withdrawn, it is important to do this after the above, otherwise 'hide' -- will overwrite withdrawnState with iconicState mapM_ (flip setWMState withdrawnState) (W.allWindows old \\ W.allWindows ws) - clearEvents enterWindowMask+ isMouseFocused <- asks mouseFocused+ unless isMouseFocused $ clearEvents enterWindowMask -- | setWMState. set the WM_STATE property setWMState :: Window -> Int -> X ()@@ -218,7 +210,7 @@ io $ setWindowBorder d w nb -- | refresh. Render the currently visible workspaces, as determined by--- the StackSet. Also, set focus to the focused window.+-- the 'StackSet'. Also, set focus to the focused window. -- -- This is our 'view' operation (MVC), in that it pretty prints our model -- with X calls.@@ -244,11 +236,10 @@ | otherwise = x - bw*2 io $ moveResizeWindow d w (rect_x r) (rect_y r) (least $ rect_width r) (least $ rect_height r)- reveal w -- --------------------------------------------------------------------- --- | Returns True if the first rectangle is contained within, but not equal+-- | Returns 'True' if the first rectangle is contained within, but not equal -- to the second. containedIn :: Rectangle -> Rectangle -> Bool containedIn r1@(Rectangle x1 y1 w1 h1) r2@(Rectangle x2 y2 w2 h2)@@ -276,9 +267,7 @@ windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) -> let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs- (a:as) = zipWith3 W.Screen xs [0..] $ zipWith SD xinesc gs- sgs = map (statusGap . W.screenDetail) (v:vs)- gs = take (length xinesc) (sgs ++ repeat (0,0,0,0))+ (a:as) = zipWith3 W.Screen xs [0..] $ map SD xinesc in ws { W.current = a , W.visible = as , W.hidden = ys }@@ -306,7 +295,9 @@ -- the mouse to a new screen). focus :: Window -> X () focus w = withWindowSet $ \s -> do- if W.member w s then when (W.peek s /= Just w) $ windows (W.focusWindow w)+ if W.member w s then when (W.peek s /= Just w) $ do+ local (\c -> c { mouseFocused = True }) $ do+ windows (W.focusWindow w) else whenX (isRoot w) $ setFocusX w -- | Call X to set the keyboard focus details.@@ -327,7 +318,7 @@ ------------------------------------------------------------------------ -- Message handling --- | Throw a message to the current LayoutClass possibly modifying how we+-- | Throw a message to the current 'LayoutClass' possibly modifying how we -- layout the windows, then refresh. sendMessage :: Message a => a -> X () sendMessage a = do@@ -367,15 +358,15 @@ ------------------------------------------------------------------------ -- Utilities --- | Return workspace visible on screen 'sc', or Nothing.+-- | Return workspace visible on screen 'sc', or 'Nothing'. screenWorkspace :: ScreenId -> X (Maybe WorkspaceId) screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc --- | Apply an X operation to the currently focused window, if there is one.+-- | Apply an 'X' operation to the currently focused window, if there is one. withFocused :: (Window -> X ()) -> X () withFocused f = withWindowSet $ \w -> whenJust (W.peek w) f --- | True if window is under management by us+-- | 'True' if window is under management by us isClient :: Window -> X Bool isClient w = withWindowSet $ return . W.member w @@ -392,7 +383,7 @@ nlm <- asks (numlockMask . config) return (complement (nlm .|. lockMask) .&. km) --- | Get the Pixel value for a named color+-- | Get the 'Pixel' value for a named color initColor :: Display -> String -> IO (Maybe Pixel) initColor dpy c = C.handle (\_ -> return Nothing) $ (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c@@ -493,8 +484,8 @@ io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) mouseDrag (\ex ey -> do io $ resizeWindow d w `uncurry`- applySizeHints sh (ex - fromIntegral (wa_x wa),- ey - fromIntegral (wa_y wa)))+ applySizeHintsContents sh (ex - fromIntegral (wa_x wa),+ ey - fromIntegral (wa_y wa))) (float w) -- ---------------------------------------------------------------------@@ -502,10 +493,26 @@ type D = (Dimension, Dimension) +-- | Given a window, build an adjuster function that will reduce the given+-- dimensions according to the window's border width and size hints.+mkAdjust :: Window -> X (D -> D)+mkAdjust w = withDisplay $ \d -> liftIO $ do+ sh <- getWMNormalHints d w+ bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w+ return $ applySizeHints bw sh++-- | Reduce the dimensions if needed to comply to the given SizeHints, taking+-- window borders into account.+applySizeHints :: Integral a => Dimension -> SizeHints -> (a, a) -> D+applySizeHints bw sh =+ tmap (+ 2 * bw) . applySizeHintsContents sh . tmap (subtract $ 2 * fromIntegral bw)+ where+ tmap f (x, y) = (f x, f y)+ -- | Reduce the dimensions if needed to comply to the given SizeHints.-applySizeHints :: Integral a => SizeHints -> (a,a) -> D-applySizeHints sh (w,h) = applySizeHints' sh (fromIntegral $ max 1 w,- fromIntegral $ max 1 h)+applySizeHintsContents :: Integral a => SizeHints -> (a, a) -> D+applySizeHintsContents sh (w, h) =+ applySizeHints' sh (fromIntegral $ max 1 w, fromIntegral $ max 1 h) -- | XXX comment me applySizeHints' :: SizeHints -> D -> D
XMonad/StackSet.hs view
@@ -31,7 +31,7 @@ -- * Xinerama operations -- $xinerama lookupWorkspace,- screens, workspaces, allWindows,+ screens, workspaces, allWindows, currentTag, -- * Operations on the current stack -- $stackOperations peek, index, integrate, integrate', differentiate,@@ -111,7 +111,7 @@ -- receive keyboard events), other workspaces may be passively -- viewable. We thus need to track which virtual workspaces are -- associated (viewed) on which physical screens. To keep track of--- this, StackSet keeps separate lists of visible but non-focused+-- this, 'StackSet' keeps separate lists of visible but non-focused -- workspaces, and non-visible workspaces. -- $focus@@ -202,7 +202,7 @@ -- | -- /O(w)/. Set focus to the workspace with index \'i\'.--- If the index is out of range, return the original StackSet.+-- If the index is out of range, return the original 'StackSet'. -- -- Xinerama: If the workspace is not visible on any Xinerama screen, it -- becomes the current screen. If it is in the visible list, it becomes@@ -210,7 +210,7 @@ view :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd view i s- | i == tag (workspace (current s)) = s -- current+ | i == currentTag s = s -- current | Just x <- L.find ((i==).tag.workspace) (visible s) -- if it is visible, it is just raised@@ -252,7 +252,7 @@ -- $xinerama -- | Find the tag of the workspace visible on Xinerama screen 'sc'.--- Nothing if screen is out of bounds.+-- 'Nothing' if screen is out of bounds. lookupWorkspace :: Eq s => s -> StackSet i l a s sd -> Maybe i lookupWorkspace sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible w, s == sc ] @@ -269,7 +269,7 @@ with dflt f = maybe dflt f . stack . workspace . current -- |--- Apply a function, and a default value for Nothing, to modify the current stack.+-- Apply a function, and a default value for 'Nothing', to modify the current stack. -- modify :: Maybe (Stack a) -> (Stack a -> Maybe (Stack a)) -> StackSet i l a s sd -> StackSet i l a s sd modify d f s = s { current = (current s)@@ -284,13 +284,13 @@ -- | -- /O(1)/. Extract the focused element of the current stack.--- Return Just that element, or Nothing for an empty stack.+-- Return 'Just' that element, or 'Nothing' for an empty stack. -- peek :: StackSet i l a s sd -> Maybe a peek = with Nothing (return . focus) -- |--- /O(n)/. Flatten a Stack into a list.+-- /O(n)/. Flatten a 'Stack' into a list. -- integrate :: Stack a -> [a] integrate (Stack x l r) = reverse l ++ x : r@@ -310,7 +310,7 @@ -- | -- /O(n)/. 'filter p s' returns the elements of 's' such that 'p' evaluates to--- True. Order is preserved, and focus moves as described for 'delete'.+-- 'True'. Order is preserved, and focus moves as described for 'delete'. -- filter :: (a -> Bool) -> Stack a -> Maybe (Stack a) filter p (Stack f ls rs) = case L.filter p (f:rs) of@@ -368,23 +368,27 @@ n <- findTag w s return $ until ((Just w ==) . peek) focusUp (view n s) --- | Get a list of all screens in the StackSet.+-- | Get a list of all screens in the 'StackSet'. screens :: StackSet i l a s sd -> [Screen i l a s sd] screens s = current s : visible s --- | Get a list of all workspaces in the StackSet.+-- | Get a list of all workspaces in the 'StackSet'. workspaces :: StackSet i l a s sd -> [Workspace i l a] workspaces s = workspace (current s) : map workspace (visible s) ++ hidden s --- | Get a list of all windows in the StackSet in no particular order+-- | Get a list of all windows in the 'StackSet' in no particular order allWindows :: Eq a => StackSet i l a s sd -> [a] allWindows = L.nub . concatMap (integrate' . stack) . workspaces --- | Is the given tag present in the StackSet?+-- | Get the tag of the currently focused workspace.+currentTag :: StackSet i l a s sd -> i+currentTag = tag . workspace . current++-- | Is the given tag present in the 'StackSet'? tagMember :: Eq i => i -> StackSet i l a s sd -> Bool tagMember t = elem t . map tag . workspaces --- | Rename a given tag if present in the StackSet.+-- | Rename a given tag if present in the 'StackSet'. renameTag :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd renameTag o n = mapWorkspace rename where rename w = if tag w == o then w { tag = n } else w@@ -399,27 +403,27 @@ et (i:is) [] s = et is [] (s { hidden = Workspace i l Nothing : hidden s }) et (i:is) (r:rs) s = et is rs $ renameTag r i s --- | Map a function on all the workspaces in the StackSet.+-- | Map a function on all the workspaces in the 'StackSet'. mapWorkspace :: (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd mapWorkspace f s = s { current = updScr (current s) , visible = map updScr (visible s) , hidden = map f (hidden s) } where updScr scr = scr { workspace = f (workspace scr) } --- | Map a function on all the layouts in the StackSet.+-- | Map a function on all the layouts in the 'StackSet'. mapLayout :: (l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd mapLayout f (StackSet v vs hs m) = StackSet (fScreen v) (map fScreen vs) (map fWorkspace hs) m where fScreen (Screen ws s sd) = Screen (fWorkspace ws) s sd fWorkspace (Workspace t l s) = Workspace t (f l) s --- | /O(n)/. Is a window in the StackSet?+-- | /O(n)/. Is a window in the 'StackSet'? member :: Eq a => a -> StackSet i l a s sd -> Bool member a s = isJust (findTag a s) -- | /O(1) on current window, O(n) in general/.--- Return Just the workspace tag of the given window, or Nothing--- if the window is not in the StackSet.+-- Return 'Just' the workspace tag of the given window, or 'Nothing'+-- if the window is not in the 'StackSet'. findTag :: Eq a => a -> StackSet i l a s sd -> Maybe i findTag a s = listToMaybe [ tag w | w <- workspaces s, has a (stack w) ]@@ -454,21 +458,25 @@ -- /O(1) on current window, O(n) in general/. Delete window 'w' if it exists. -- There are 4 cases to consider: ----- * delete on an Nothing workspace leaves it Nothing+-- * delete on an 'Nothing' workspace leaves it Nothing+-- -- * otherwise, try to move focus to the down+-- -- * otherwise, try to move focus to the up--- * otherwise, you've got an empty workspace, becomes Nothing --+-- * otherwise, you've got an empty workspace, becomes 'Nothing'+-- -- Behaviour with respect to the master: -- -- * deleting the master window resets it to the newly focused window+-- -- * otherwise, delete doesn't affect the master. -- delete :: (Ord a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd delete w = sink w . delete' w -- | Only temporarily remove the window from the stack, thereby not destroying special--- information saved in the Stackset+-- information saved in the 'Stackset' delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd delete' w s = s { current = removeFromScreen (current s) , visible = map removeFromScreen (visible s)@@ -479,7 +487,7 @@ ------------------------------------------------------------------------ -- | Given a window, and its preferred rectangle, set it as floating--- A floating window should already be managed by the StackSet.+-- 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) } @@ -520,7 +528,7 @@ shift n s | n `tagMember` s && n /= curtag = maybe s go (peek s) | otherwise = s where go w = view curtag . insertUp w . view n . delete' w $ s- curtag = tag (workspace (current s))+ curtag = currentTag s -- | /O(n)/. shiftWin. Searches for the specified window 'w' on all workspaces -- of the stackSet and moves it to stack 'n', leaving it as the focused@@ -536,6 +544,5 @@ where from = findTag w s go = on n (insertUp w) . on (fromJust from) (delete' w) $ s- curtag = tag (workspace (current s))- on i f = view curtag . f . view i+ on i f = view (currentTag s) . f . view i
man/xmonad.hs view
@@ -60,20 +60,6 @@ myNormalBorderColor = "#dddddd" myFocusedBorderColor = "#ff0000" --- Default offset of drawable screen boundaries from each physical--- screen. Anything non-zero here will leave a gap of that many pixels--- on the given edge, on the that screen. A useful gap at top of screen--- for a menu bar (e.g. 15)------ An example, to set a top gap on monitor 1, and a gap on the bottom of--- monitor 2, you'd use a list of geometries like so:------ > defaultGaps = [(18,0,0,0),(0,18,0,0)] -- 2 gaps on 2 monitors------ Fields are: top, bottom, left, right.----myDefaultGaps = [(0,0,0,0)]- ------------------------------------------------------------------------ -- Key bindings. Add, modify or remove key bindings here. --@@ -137,9 +123,7 @@ , ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- toggle the status bar gap- , ((modMask , xK_b ),- modifyGap (\i n -> let x = (XMonad.defaultGaps conf ++ repeat (0,0,0,0)) !! i- in if n == x then (0,0,0,0) else x))+ -- TODO, update this binding with avoidStruts , ((modMask , xK_b ), -- Quit xmonad , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess))@@ -280,7 +264,6 @@ workspaces = myWorkspaces, normalBorderColor = myNormalBorderColor, focusedBorderColor = myFocusedBorderColor,- defaultGaps = myDefaultGaps, -- key bindings keys = myKeys,
man/xmonad.html view
@@ -1,3 +1,5 @@+Content-type: text/html+ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <HTML><HEAD><TITLE>Man page of xmonad</TITLE> </HEAD><BODY>@@ -178,6 +180,6 @@ This document was created by <A HREF="/cgi-bin/man/man2html">man2html</A>, using the manual pages.<BR>-Time: 20:25:33 GMT, March 29, 2008+Time: 19:46:11 GMT, September 05, 2008 </BODY> </HTML>
tests/Properties.hs view
@@ -378,6 +378,9 @@ prop_allWindowsMember w (x :: T) = (w `elem` allWindows x) ==> member w x +prop_currentTag (x :: T) =+ currentTag x == tag (workspace (current x))+ -- --------------------------------------------------------------------- -- 'insert' @@ -895,6 +898,7 @@ ,("findTag" , mytest prop_findIndex) ,("allWindows/member" , mytest prop_allWindowsMember)+ ,("currentTag" , mytest prop_currentTag) ,("insert: invariant" , mytest prop_insertUp_I) ,("insert/new" , mytest prop_insert_empty)
xmonad.cabal view
@@ -1,5 +1,5 @@ name: xmonad-version: 0.7+version: 0.8 homepage: http://xmonad.org synopsis: A tiling window manager description:@@ -46,7 +46,7 @@ build-depends: base < 3 build-depends: X11>=1.4.1, mtl, unix - ghc-options: -funbox-strict-fields -Wall -optl-Wl,-s+ ghc-options: -funbox-strict-fields -Wall ghc-prof-options: -prof -auto-all extensions: CPP @@ -64,7 +64,7 @@ XMonad.Operations XMonad.StackSet - ghc-options: -funbox-strict-fields -Wall -optl-Wl,-s+ ghc-options: -funbox-strict-fields -Wall ghc-prof-options: -prof -auto-all extensions: CPP