33 Commits
v0.7 ... v0.8

Author SHA1 Message Date
Spencer Janssen
b605fd9fce Spelling. Any bets on how long this has been there? 2008-09-05 19:52:11 +00:00
Spencer Janssen
85202ebd47 Bump version to 0.8 2008-09-05 19:42:25 +00:00
Spencer Janssen
328c660ce7 Remove obsolete comments about darcs X11 2008-09-05 19:49:15 +00:00
Spencer Janssen
b185a439b1 Recommend latest packages rather than specific versions 2008-09-05 19:48:37 +00:00
Spencer Janssen
0016e06984 Also remove -optl from the executable section 2008-08-20 21:00:23 +00:00
Spencer Janssen
339b2d0097 -optl-Wl,-s is not needed with recent Cabal versions 2008-08-20 20:41:02 +00:00
Malebria
5f4d63ba71 Haddock links 2008-06-01 21:25:15 +00:00
Malebria
942572c830 Haddock syntax for enumeration 2008-06-01 20:49:51 +00:00
Spencer Janssen
46ac2ca24b I prefer the spencerjanssen@gmail.com address now 2008-07-14 20:26:50 +00:00
Trevor Elliott
3830d7a571 Raise windows in the floating layer when moving or resizing 2008-05-21 21:50:57 +00:00
Devin Mullins
5b3eaf663a add currentTag convenience function 2008-05-11 22:42:58 +00:00
Spencer Janssen
c93b7c7c3b Make Mirror a newtype 2008-05-08 10:46:40 +00:00
Spencer Janssen
42dee4768e Comments 2008-05-07 01:31:22 +00:00
Spencer Janssen
e847b350ed Break long line 2008-05-07 01:26:08 +00:00
Spencer Janssen
cccbfa21e4 Style 2008-05-07 01:25:19 +00:00
Spencer Janssen
870b3ad282 Simplify 2008-05-07 01:13:09 +00:00
Spencer Janssen
ab30d76578 Overhaul Choose, fixes issue 183 2008-05-06 22:08:09 +00:00
Klaus Weidner
d8d636e573 Remember if focus changes were caused by mouse actions or by key commands
If the user used the mouse to change window focus (moving into or clicking on a
window), this should be handled differently than focus changes due to keyboard
commands. Specifically, it's inappropriate to discard window enter/leave events
while the mouse is moving. This fixes the bug where a fast mouse motion across
multiple windows resulted in the wrong window keeping focus.

It's also helpful information for contrib modules such as UpdatePointer - it's
supposed to move the mouse pointer only in response to keyboard actions, not if
the user was moving the mouse.
2008-05-02 17:56:03 +00:00
Spencer Janssen
ba3987f299 Wibble 2008-05-06 20:38:40 +00:00
Ivan N. Veselov
5a19425e79 Added doShift function for more user-friendly hooks 2008-05-06 18:57:57 +00:00
Don Stewart
28431e18c8 use named colours. fixes startup failure on the XO 2008-05-02 21:01:49 +00:00
Spencer Janssen
43c2d26cdb Set focus *after* revealing windows 2008-04-07 22:25:59 +00:00
Spencer Janssen
c24016882e Reveal windows after moving/resizing them.
This should reduce the number of repaints for newly visible windows.
2008-04-07 22:07:56 +00:00
Spencer Janssen
9dae87c537 Hide newly created but non-visible windows (fixes bug #172) 2008-04-30 01:40:12 +00:00
Don Stewart
b67026dd02 formatting, eta expansion 2008-04-18 18:43:37 +00:00
Lukas Mai
aa58eea6dc XMonad.ManageHook: add 'appName', another name for 'resource' 2008-04-06 01:20:06 +00:00
Lukas Mai
7db13a2a45 XMonad.ManageHook: make 'title' locale-aware; haddock cleanup
The code for 'title' was stolen from getname.patch (bug #44).
2008-04-06 01:13:38 +00:00
Lukas Mai
029e668dbc XMonad.Main: call setlocale on startup 2008-04-06 01:12:34 +00:00
robreim
6f61c83623 floats always use current screen (with less bugs) 2008-04-05 13:50:09 +00:00
Lukas Mai
bcbccbfafc XMonad.Operations: applySizeHint reshuffle
Make applySizeHints take window borders into account. Move old functionality
to applySizeHintsContents. Add new mkAdjust function that generates a custom
autohinter for a window.
2008-04-04 21:56:15 +00:00
Lukas Mai
04c8d62361 XMonad.Layout: documentation cleanup 2008-04-04 21:54:44 +00:00
Spencer Janssen
4890116e49 Remove gaps from the example config 2008-03-29 23:29:59 +00:00
Spencer Janssen
708084dd48 Remove gaps 2008-03-25 09:15:26 +00:00
12 changed files with 264 additions and 230 deletions

View File

@@ -62,11 +62,17 @@ usage = do
-- | 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 ()

21
README
View File

@@ -24,7 +24,7 @@ For the full story, read on.
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 @@ Building:
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:
@@ -97,19 +97,6 @@ Building:
------------------------------------------------------------------------
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.
------------------------------------------------------------------------
Running xmonad:
Add:

View File

@@ -26,12 +26,10 @@ module XMonad.Config (defaultConfig) where
--
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 @@ borderWidth = 1
-- | 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 @@ manageHook = composeAll
-- | 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 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
, ((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 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
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 @@ mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $
defaultConfig = XConfig
{ XMonad.borderWidth = borderWidth
, XMonad.workspaces = workspaces
, XMonad.defaultGaps = defaultGaps
, XMonad.layoutHook = layout
, XMonad.terminal = terminal
, XMonad.normalBorderColor = normalBorderColor

View File

@@ -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 @@ data XConf = XConf
-- ^ 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 @@ data XConfig l = XConfig
, 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 @@ type WorkspaceId = String
-- | 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 @@ instance Monoid a => Monoid (Query a) where
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 @@ catchX job errcase = do
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 @@ instance Message LayoutMessages
-- ---------------------------------------------------------------------
-- | 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 @@ catchIO f = io (f `catch` \e -> hPrint stderr e >> hFlush stderr)
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 @@ doubleFork m = io $ do
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 @@ getXMonadDir = io $ getAppUserDataDirectory "xmonad"
-- | '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 @@ getXMonadDir = io $ getAppUserDataDirectory "xmonad"
-- 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 @@ recompile force = io $ do
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

View File

@@ -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 Control.Monad
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 @@ instance LayoutClass Tall a where
description _ = "Tall"
-- | tile. Compute the positions for windows using the default 2 pane tiling algorithm.
-- | Compute the positions for windows using the default two-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.
--
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 @@ splitHorizontallyBy f (Rectangle sx sy sw sh) =
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 @@ instance LayoutClass l a => LayoutClass (Mirror l) a where
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 @@ mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
-- 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 @@ instance Message ChangeLayout
-- | 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
-- | 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)
-- | 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
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)
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 (SLeft _ l) = description l
description (SRight _ r) = description r
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)
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'

View File

@@ -1,11 +1,11 @@
{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, ForeignFunctionInterface #-}
----------------------------------------------------------------------------
-- |
-- Module : XMonad.Main
-- 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 mtl, X11, posix
--
@@ -23,6 +23,9 @@ 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
@@ -37,11 +40,23 @@ 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:
@@ -64,7 +79,7 @@ xmonad initxmc = do
let layout = layoutHook xmc
lreads = readsLayout layout
initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps
initialWinset = new layout (workspaces xmc) $ map SD xinesc
maybeRead reads' s = case reads' s of
[(x, "")] -> Just x
@@ -76,8 +91,6 @@ xmonad initxmc = do
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
@@ -85,7 +98,8 @@ xmonad initxmc = do
, normalBorder = nbc
, focusedBorder = fbc
, keyActions = keys xmc xmc
, buttonActions = mouseBindings xmc xmc }
, buttonActions = mouseBindings xmc xmc
, mouseFocused = False }
st = XState
{ windowset = initialWinset
, mapped = S.empty

View File

@@ -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 @@ liftX = Query . lift
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)
-- | 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 ""
-- | 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,
-- | 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 @@ doFloat = ask >>= \w -> doF . W.float w . snd =<< liftX (floatLocation w)
-- | 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

View File

@@ -57,7 +57,7 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
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 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
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 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
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 :: (WindowSet -> WindowSet) -> X ()
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 @@ windows f = do
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 @@ windows f = do
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 @@ setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
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 @@ tileWindow w r = withDisplay $ \d -> do
| 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 @@ rescreen = do
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 @@ setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.p
-- 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 @@ setFocusX w = withWindowSet $ \ws -> do
------------------------------------------------------------------------
-- 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 @@ setLayout l = do
------------------------------------------------------------------------
-- 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 @@ cleanMask km = do
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,7 +484,7 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
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),
applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
ey - fromIntegral (wa_y wa)))
(float w)
@@ -502,10 +493,26 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
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

View File

@@ -31,7 +31,7 @@ module XMonad.StackSet (
-- * 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 @@ import qualified Data.Map as M (Map,insert,delete,empty)
-- 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 @@ new _ _ _ = abort "non-positive argument to StackSet.new"
-- |
-- /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 @@ new _ _ _ = abort "non-positive argument to StackSet.new"
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 @@ greedyView w ws
-- $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 :: b -> (Stack a -> b) -> StackSet i l a s sd -> b
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 @@ modify' f = modify Nothing (Just . f)
-- |
-- /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 @@ differentiate (x:xs) = Just $ Stack x [] xs
-- |
-- /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 @@ focusWindow w s | Just w == peek s = s
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 @@ ensureTags l allt st = et allt (map tag (workspaces st) \\ allt) st
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 @@ insertUp a s = if member a s then s else insert
-- /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 @@ delete' w s = s { current = removeFromScreen (current s)
------------------------------------------------------------------------
-- | 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 :: (Ord a, Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
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 @@ shiftWin n w s | from == Nothing = s -- not found
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

View File

@@ -60,20 +60,6 @@ myWorkspaces = ["1","2","3","4","5","6","7","8","9"]
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 @@ myKeys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
, ((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 @@ defaults = defaultConfig {
workspaces = myWorkspaces,
normalBorderColor = myNormalBorderColor,
focusedBorderColor = myFocusedBorderColor,
defaultGaps = myDefaultGaps,
-- key bindings
keys = myKeys,

View File

@@ -378,6 +378,9 @@ prop_findIndex (x :: T) =
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 @@ main = do
,("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)

View File

@@ -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 @@ library
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 @@ executable xmonad
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