mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-02 13:11:53 -07:00
Compare commits
33 Commits
Author | SHA1 | Date | |
---|---|---|---|
|
b605fd9fce | ||
|
85202ebd47 | ||
|
328c660ce7 | ||
|
b185a439b1 | ||
|
0016e06984 | ||
|
339b2d0097 | ||
|
5f4d63ba71 | ||
|
942572c830 | ||
|
46ac2ca24b | ||
|
3830d7a571 | ||
|
5b3eaf663a | ||
|
c93b7c7c3b | ||
|
42dee4768e | ||
|
e847b350ed | ||
|
cccbfa21e4 | ||
|
870b3ad282 | ||
|
ab30d76578 | ||
|
d8d636e573 | ||
|
ba3987f299 | ||
|
5a19425e79 | ||
|
28431e18c8 | ||
|
43c2d26cdb | ||
|
c24016882e | ||
|
9dae87c537 | ||
|
b67026dd02 | ||
|
aa58eea6dc | ||
|
7db13a2a45 | ||
|
029e668dbc | ||
|
6f61c83623 | ||
|
bcbccbfafc | ||
|
04c8d62361 | ||
|
4890116e49 | ||
|
708084dd48 |
6
Main.hs
6
Main.hs
@@ -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
21
README
@@ -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:
|
||||
|
@@ -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
|
||||
|
@@ -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
|
||||
|
145
XMonad/Layout.hs
145
XMonad/Layout.hs
@@ -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'
|
||||
|
@@ -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
|
@@ -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)
|
||||
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 @@ 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
|
||||
|
@@ -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,8 +484,8 @@ 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),
|
||||
ey - fromIntegral (wa_y 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
|
||||
|
@@ -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
|
||||
|
||||
|
@@ -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,
|
||||
|
@@ -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)
|
||||
|
@@ -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
|
||||
|
||||
|
Reference in New Issue
Block a user