mirror of
https://github.com/xmonad/xmonad.git
synced 2025-07-27 02:01:52 -07:00
Compare commits
56 Commits
Author | SHA1 | Date | |
---|---|---|---|
|
5edfb1d262 | ||
|
0fecae0abc | ||
|
26f4f734f9 | ||
|
5e7df396b9 | ||
|
314ba78335 | ||
|
7aa78ecc75 | ||
|
ba8e26458e | ||
|
c627e8cc4d | ||
|
04f894275d | ||
|
edb752136f | ||
|
2b463a632f | ||
|
ca122dd2cb | ||
|
77657b65f9 | ||
|
28c57a837a | ||
|
afda20b56d | ||
|
0cc7b12fd0 | ||
|
15a78ae715 | ||
|
18444799e0 | ||
|
cc60fa73ad | ||
|
8881e2ac78 | ||
|
533031e3d6 | ||
|
76d4af15e4 | ||
|
74c6dd2721 | ||
|
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 |
4
CONFIG
4
CONFIG
@@ -51,9 +51,9 @@ Ok, looks good.
|
||||
|
||||
To have xmonad start using your settings, type 'mod-q'. xmonad will
|
||||
then load this new file, and run it. If it is unable to, the defaults
|
||||
are used.
|
||||
are used.
|
||||
|
||||
To load succesfully, both 'xmonad' and 'ghc' must be in your $PATH
|
||||
To load successfully, both 'xmonad' and 'ghc' must be in your $PATH
|
||||
environment variable. If GHC isn't in your path, for some reason, you
|
||||
can compile the xmonad.hs file yourself:
|
||||
|
||||
|
13
Main.hs
13
Main.hs
@@ -32,6 +32,7 @@ import qualified Properties
|
||||
-- for xmonad, and if it doesn't find one, just launches the default.
|
||||
main :: IO ()
|
||||
main = do
|
||||
installSignalHandlers -- important to ignore SIGCHLD to avoid zombies
|
||||
args <- getArgs
|
||||
let launch = catchIO buildLaunch >> xmonad defaultConfig
|
||||
case args of
|
||||
@@ -59,15 +60,21 @@ usage = do
|
||||
#endif
|
||||
[]
|
||||
|
||||
-- | Build "~/.xmonad/xmonad.hs" with ghc, then execute it. If there are no
|
||||
-- | 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\/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
|
||||
--
|
||||
-- * Missing XMonad\/XMonadContrib modules due to ghc upgrade
|
||||
--
|
||||
buildLaunch :: IO ()
|
||||
buildLaunch = do
|
||||
|
37
README
37
README
@@ -24,18 +24,18 @@ 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
|
||||
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
|
||||
simpler.
|
||||
|
||||
We'll now walk through the complete list of toolchain dependencies.
|
||||
|
||||
* GHC: the Glasgow Haskell Compiler
|
||||
|
||||
|
||||
You first need a Haskell compiler. Your distribution's package
|
||||
system will have binaries of GHC (the Glasgow Haskell Compiler), the
|
||||
system will have binaries of GHC (the Glasgow Haskell Compiler), the
|
||||
compiler we use, so install that first. If your operating system's
|
||||
package system doesn't provide a binary version of GHC, you can find
|
||||
them here:
|
||||
@@ -46,7 +46,7 @@ Building:
|
||||
|
||||
apt-get install ghc6
|
||||
|
||||
It shouldn't be necessary to compile GHC from source -- every common
|
||||
It shouldn't be necessary to compile GHC from source -- every common
|
||||
system has a pre-build binary version.
|
||||
|
||||
* X11 libraries:
|
||||
@@ -60,7 +60,7 @@ Building:
|
||||
Typically you need: libXinerama libXext libX11
|
||||
|
||||
* Cabal
|
||||
|
||||
|
||||
xmonad requires a recent version of Cabal, >= 1.2.0. If you're using
|
||||
GHC 6.8, then it comes bundled with the right version. If you're
|
||||
using GHC 6.6.x, you'll need to build and install Cabal from hackage
|
||||
@@ -80,11 +80,11 @@ 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:
|
||||
* Build xmonad:
|
||||
|
||||
Once you've got all the dependencies in place (which should be
|
||||
straightforward), 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:
|
||||
@@ -141,14 +128,14 @@ XMonadContrib
|
||||
|
||||
Other useful programs:
|
||||
|
||||
A nicer xterm replacment, that supports resizing better:
|
||||
A nicer xterm replacement, that supports resizing better:
|
||||
|
||||
urxvt http://software.schmorp.de/pkg/rxvt-unicode.html
|
||||
|
||||
For custom status bars:
|
||||
|
||||
dzen http://gotmor.googlepages.com/dzen
|
||||
xmobar http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar
|
||||
xmobar http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar
|
||||
|
||||
For a program dispatch menu:
|
||||
|
||||
|
4
STYLE
4
STYLE
@@ -2,7 +2,7 @@
|
||||
== Coding guidelines for contributing to
|
||||
== xmonad and the xmonad contributed extensions
|
||||
|
||||
* Comment every top level function (particularly exported funtions), and
|
||||
* Comment every top level function (particularly exported functions), and
|
||||
provide a type signature; use Haddock syntax in the comments.
|
||||
|
||||
* Follow the coding style of the other modules.
|
||||
@@ -15,7 +15,7 @@
|
||||
* Tabs are illegal. Use 4 spaces for indenting.
|
||||
|
||||
* Any pure function added to the core should have QuickCheck properties
|
||||
precisely defining its behaviour.
|
||||
precisely defining its behavior.
|
||||
|
||||
* New modules should identify the author, and be submitted under
|
||||
the same license as xmonad (BSD3 license or freer).
|
||||
|
4
TODO
4
TODO
@@ -1,7 +1,7 @@
|
||||
- Write down invariants for the window life cycle, especially:
|
||||
- When are borders set? Prove that the current handling is sufficient.
|
||||
|
||||
- current floating layer handling is unoptimal. FocusUp should raise,
|
||||
- current floating layer handling is nonoptimal. FocusUp should raise,
|
||||
for example
|
||||
|
||||
- Issues still with stacking order.
|
||||
@@ -15,7 +15,7 @@
|
||||
* double check README build instructions
|
||||
* test core with 6.6 and 6.8
|
||||
* bump xmonad.cabal version and X11 version
|
||||
* upload X11 and xmonad to hackage
|
||||
* upload X11 and xmonad to Hackage
|
||||
* check examples/text in user-facing Config.hs
|
||||
* check tour.html and intro.html are up to date, and mention all core bindings
|
||||
* confirm template config is type correct
|
||||
|
@@ -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.shiftMaster))
|
||||
-- mod-button2 %! Raise the window to the top of the stack
|
||||
, ((modMask, button2), (\w -> focus w >> windows W.swapMaster))
|
||||
, ((modMask, button2), (\w -> focus w >> windows W.shiftMaster))
|
||||
-- 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.shiftMaster))
|
||||
-- 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.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -24,29 +24,33 @@ module XMonad.Core (
|
||||
XConf(..), XConfig(..), LayoutClass(..),
|
||||
Layout(..), readsLayout, Typeable, Message,
|
||||
SomeMessage(..), fromMessage, LayoutMessages(..),
|
||||
runX, catchX, userCode, io, catchIO, doubleFork,
|
||||
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers,
|
||||
withDisplay, withWindowSet, isRoot, runOnWorkspaces,
|
||||
getAtom, spawn, getXMonadDir, recompile, trace, whenJust, whenX,
|
||||
getAtom, spawn, spawnPID, getXMonadDir, recompile, trace, whenJust, whenX,
|
||||
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, ManageHook, Query(..), runQuery
|
||||
) where
|
||||
|
||||
import XMonad.StackSet hiding (modify)
|
||||
|
||||
import Prelude hiding ( catch )
|
||||
import Control.Exception (catch, bracket, throw, Exception(ExitException))
|
||||
import Control.Exception (catch, try, bracket, throw, Exception(ExitException))
|
||||
import Control.Applicative
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Reader
|
||||
import System.IO
|
||||
import System.Info
|
||||
import System.Posix.Process (executeFile, forkProcess, getProcessStatus, createSession)
|
||||
import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus)
|
||||
import System.Posix.Signals
|
||||
import System.Posix.Types (ProcessID)
|
||||
import System.Process
|
||||
import System.Directory
|
||||
import System.Exit
|
||||
import Graphics.X11.Xlib
|
||||
import Graphics.X11.Xlib.Extras (Event)
|
||||
import Data.Typeable
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Monoid
|
||||
import Data.Maybe (fromMaybe)
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
@@ -69,6 +73,10 @@ 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?
|
||||
, mousePosition :: !(Maybe (Position, Position))
|
||||
-- ^ position of the mouse according to
|
||||
-- the event currently being processed
|
||||
}
|
||||
|
||||
-- todo, better name
|
||||
@@ -79,7 +87,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 +109,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 +148,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,9 +166,14 @@ 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.
|
||||
userCode :: X () -> X ()
|
||||
userCode a = catchX (a >> return ()) (return ())
|
||||
-- 'catchX' should be used at all callsites of user customized code.
|
||||
userCode :: X a -> X (Maybe a)
|
||||
userCode a = catchX (Just `liftM` a) (return Nothing)
|
||||
|
||||
-- | Same as userCode but with a default argument to return instead of using
|
||||
-- Maybe, provided for convenience.
|
||||
userCodeDef :: a -> X a -> X a
|
||||
userCodeDef def a = fromMaybe def `liftM` userCode a
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Convenient wrappers to state
|
||||
@@ -330,30 +340,24 @@ 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)
|
||||
|
||||
-- | spawn. Launch an external application
|
||||
-- | spawn. Launch an external application. Specifically, it double-forks and
|
||||
-- runs the 'String' you pass as a command to /bin/sh.
|
||||
spawn :: MonadIO m => String -> m ()
|
||||
spawn x = doubleFork $ executeFile "/bin/sh" False ["-c", x] Nothing
|
||||
spawn x = spawnPID x >> return ()
|
||||
|
||||
-- | Double fork and execute an IO action (usually one of the exec family of
|
||||
-- functions)
|
||||
doubleFork :: MonadIO m => IO () -> m ()
|
||||
doubleFork m = io $ do
|
||||
pid <- forkProcess $ do
|
||||
forkProcess (createSession >> m)
|
||||
exitWith ExitSuccess
|
||||
getProcessStatus True False pid
|
||||
return ()
|
||||
spawnPID :: MonadIO m => String -> m ProcessID
|
||||
spawnPID x = io $ forkProcess $ executeFile "/bin/sh" False ["-c", x] Nothing
|
||||
|
||||
-- | 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 +373,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 +386,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
|
||||
@@ -393,10 +400,15 @@ recompile force = io $ do
|
||||
binT <- getModTime bin
|
||||
if (force || srcT > binT)
|
||||
then do
|
||||
-- temporarily disable SIGCHLD ignoring:
|
||||
installHandler sigCHLD Default Nothing
|
||||
status <- bracket (openFile err WriteMode) hClose $ \h -> do
|
||||
waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-no-recomp", "-v0", "-o",binn] (Just dir)
|
||||
Nothing Nothing Nothing (Just h)
|
||||
|
||||
-- re-enable SIGCHLD:
|
||||
installSignalHandlers
|
||||
|
||||
-- now, if it fails, run xmessage to let the user know:
|
||||
when (status /= ExitSuccess) $ do
|
||||
ghcErr <- readFile err
|
||||
@@ -406,7 +418,8 @@ recompile force = io $ do
|
||||
-- nb, the ordering of printing, then forking, is crucial due to
|
||||
-- lazy evaluation
|
||||
hPutStrLn stderr msg
|
||||
doubleFork $ executeFile "xmessage" True ["-default", "okay", msg] Nothing
|
||||
forkProcess $ executeFile "xmessage" True ["-default", "okay", msg] Nothing
|
||||
return ()
|
||||
return (status == ExitSuccess)
|
||||
else return True
|
||||
where getModTime f = catch (Just <$> getModificationTime f) (const $ return Nothing)
|
||||
@@ -415,11 +428,22 @@ 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
|
||||
|
||||
-- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to
|
||||
-- avoid zombie processes, and clean up any extant zombie processes.
|
||||
installSignalHandlers :: MonadIO m => m ()
|
||||
installSignalHandlers = io $ do
|
||||
installHandler openEndedPipe Ignore Nothing
|
||||
installHandler sigCHLD Ignore Nothing
|
||||
try $ fix $ \more -> do
|
||||
x <- getAnyProcessStatus False False
|
||||
when (isJust x) more
|
||||
return ()
|
||||
|
150
XMonad/Layout.hs
150
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,31 +34,27 @@ 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.
|
||||
data Tall a = Tall !Int !Rational !Rational deriving (Show, Read)
|
||||
-- | The builtin tiling mode of xmonad. Supports 'Shrink', 'Expand' and
|
||||
-- 'IncMasterN'.
|
||||
data Tall a = Tall !Int -- ^ The default number of windows in the master pane (default: 1)
|
||||
!Rational -- ^ Default proportion of screen occupied by master pane (default: 1/2)
|
||||
!Rational -- ^ Percent of screen to increment by when resizing panes (default: 3/100)
|
||||
deriving (Show, Read)
|
||||
-- TODO should be capped [0..1] ..
|
||||
|
||||
-- a nice pure layout, lots of properties for the layout, and its messages, in Properties.hs
|
||||
@@ -76,20 +73,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 +113,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 +123,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 +131,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 +138,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,8 +23,10 @@ import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import Data.Maybe (fromMaybe)
|
||||
|
||||
import Foreign.C
|
||||
import Foreign.Ptr
|
||||
|
||||
import System.Environment (getArgs)
|
||||
import System.Posix.Signals
|
||||
|
||||
import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
|
||||
import Graphics.X11.Xlib.Extras
|
||||
@@ -37,19 +39,44 @@ 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
|
||||
-- ignore SIGPIPE
|
||||
installHandler openEndedPipe Ignore Nothing
|
||||
-- setup locale information from environment
|
||||
withCString "" $ c_setlocale (#const LC_ALL)
|
||||
-- ignore SIGPIPE and SIGCHLD
|
||||
installSignalHandlers
|
||||
-- First, wrap the layout in an existential, to keep things pretty:
|
||||
let xmc = initxmc { layoutHook = Layout $ layoutHook initxmc }
|
||||
dpy <- openDisplay ""
|
||||
let dflt = defaultScreen dpy
|
||||
|
||||
rootw <- rootWindow dpy dflt
|
||||
|
||||
-- If another WM is running, a BadAccess error will be returned. The
|
||||
-- default error handler will write the exception to stderr and exit with
|
||||
-- an error.
|
||||
selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask
|
||||
.|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
|
||||
.|. buttonPressMask
|
||||
sync dpy False -- sync to ensure all outstanding errors are delivered
|
||||
|
||||
-- turn off the default handler in favor of one that ignores all errors
|
||||
-- (ugly, I know)
|
||||
xSetErrorHandler -- in C, I'm too lazy to write the binding: dons
|
||||
|
||||
xinesc <- getCleanedScreenInfo dpy
|
||||
nbc <- do v <- initColor dpy $ normalBorderColor xmc
|
||||
~(Just nbc_) <- initColor dpy $ normalBorderColor Default.defaultConfig
|
||||
@@ -64,7 +91,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 +103,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,20 +110,15 @@ xmonad initxmc = do
|
||||
, normalBorder = nbc
|
||||
, focusedBorder = fbc
|
||||
, keyActions = keys xmc xmc
|
||||
, buttonActions = mouseBindings xmc xmc }
|
||||
, buttonActions = mouseBindings xmc xmc
|
||||
, mouseFocused = False
|
||||
, mousePosition = Nothing }
|
||||
st = XState
|
||||
{ windowset = initialWinset
|
||||
, mapped = S.empty
|
||||
, waitingUnmap = M.empty
|
||||
, dragging = Nothing }
|
||||
|
||||
xSetErrorHandler -- in C, I'm too lazy to write the binding: dons
|
||||
|
||||
-- setup initial X environment
|
||||
sync dpy False
|
||||
selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask
|
||||
.|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
|
||||
|
||||
allocaXEvent $ \e ->
|
||||
runX cf st $ do
|
||||
|
||||
@@ -122,10 +142,19 @@ xmonad initxmc = do
|
||||
userCode $ startupHook initxmc
|
||||
|
||||
-- main loop, for all you HOF/recursion fans out there.
|
||||
forever_ $ handle =<< io (nextEvent dpy e >> getEvent e)
|
||||
forever_ $ prehandle =<< io (nextEvent dpy e >> getEvent e)
|
||||
|
||||
return ()
|
||||
where forever_ a = a >> forever_ a
|
||||
where
|
||||
forever_ a = a >> forever_ a
|
||||
|
||||
-- if the event gives us the position of the pointer, set mousePosition
|
||||
prehandle e = let mouse = do guard (ev_event_type e `elem` evs)
|
||||
return (fromIntegral (ev_x_root e)
|
||||
,fromIntegral (ev_y_root e))
|
||||
in local (\c -> c { mousePosition = mouse }) (handle e)
|
||||
evs = [ keyPress, keyRelease, enterNotify, leaveNotify
|
||||
, buttonPress, buttonRelease]
|
||||
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
@@ -146,7 +175,7 @@ handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
|
||||
s <- io $ keycodeToKeysym dpy code 0
|
||||
mClean <- cleanMask m
|
||||
ks <- asks keyActions
|
||||
userCode $ whenJust (M.lookup (mClean, s) ks) id
|
||||
userCodeDef () $ whenJust (M.lookup (mClean, s) ks) id
|
||||
|
||||
-- manage a new window
|
||||
handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
|
||||
@@ -200,16 +229,16 @@ handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
|
||||
-- grabbed in grabButtons. Otherwise, it's click-to-focus.
|
||||
isr <- isRoot w
|
||||
m <- cleanMask $ ev_state e
|
||||
ba <- asks buttonActions
|
||||
if isr then userCode $ whenJust (M.lookup (m, b) ba) ($ ev_subwindow e)
|
||||
else focus w
|
||||
mact <- asks (M.lookup (m, b) . buttonActions)
|
||||
case mact of
|
||||
(Just act) | isr -> act $ ev_subwindow e
|
||||
_ -> focus w
|
||||
broadcastMessage e -- Always send button events.
|
||||
|
||||
-- entered a normal window: focus it if focusFollowsMouse is set to
|
||||
-- True in the user's config.
|
||||
handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
|
||||
| t == enterNotify && ev_mode e == notifyNormal
|
||||
&& ev_detail e /= notifyInferior
|
||||
= whenX (asks $ focusFollowsMouse . config) (focus w)
|
||||
|
||||
-- left a window, check if we need to focus root
|
||||
@@ -249,7 +278,7 @@ handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen
|
||||
|
||||
-- property notify
|
||||
handle PropertyEvent { ev_event_type = t, ev_atom = a }
|
||||
| t == propertyNotify && a == wM_NAME = userCode =<< asks (logHook . config)
|
||||
| t == propertyNotify && a == wM_NAME = userCodeDef () =<< asks (logHook . config)
|
||||
|
||||
handle e = broadcastMessage e -- trace (eventName e) -- ignoring
|
||||
|
@@ -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
|
||||
|
@@ -23,7 +23,7 @@ import XMonad.Layout (Full(..))
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import Data.Maybe
|
||||
import Data.Monoid (appEndo)
|
||||
import Data.Monoid (Endo(..))
|
||||
import Data.List (nub, (\\), find)
|
||||
import Data.Bits ((.|.), (.&.), complement)
|
||||
import Data.Ratio
|
||||
@@ -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,10 +65,10 @@ 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
|
||||
g <- fmap appEndo $ userCodeDef (Endo id) (runQuery mh w)
|
||||
windows (g . f)
|
||||
|
||||
-- | unmanage. A window no longer exists, remove it from the window
|
||||
@@ -77,23 +77,14 @@ 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
|
||||
-- | Kill the specified window. If we do kill it, we'll get a
|
||||
-- delete notify back from X.
|
||||
--
|
||||
-- There are two ways to delete a window. Either just kill it, or if it
|
||||
-- supports the delete protocol, send a delete event (e.g. firefox)
|
||||
--
|
||||
kill :: X ()
|
||||
kill = withDisplay $ \d -> withFocused $ \w -> do
|
||||
killWindow :: Window -> X ()
|
||||
killWindow w = withDisplay $ \d -> do
|
||||
wmdelt <- atom_WM_DELETE_WINDOW ; wmprot <- atom_WM_PROTOCOLS
|
||||
|
||||
protocols <- io $ getWMProtocols d w
|
||||
@@ -104,6 +95,10 @@ kill = withDisplay $ \d -> withFocused $ \w -> do
|
||||
sendEvent d w False noEventMask ev
|
||||
else killClient d w >> return ()
|
||||
|
||||
-- | Kill the currently focused client.
|
||||
kill :: X ()
|
||||
kill = withFocused killWindow
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Managing windows
|
||||
|
||||
@@ -112,10 +107,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 })
|
||||
@@ -128,53 +124,58 @@ windows f = do
|
||||
-- for each workspace, layout the currently visible workspaces
|
||||
let allscreens = W.screens ws
|
||||
summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.workspace) allscreens
|
||||
visible <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do
|
||||
rects <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do
|
||||
let wsp = W.workspace w
|
||||
this = W.view n ws
|
||||
n = W.tag wsp
|
||||
flt = filter (flip M.member (W.floating ws)) (W.index this)
|
||||
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 = screenRect $ W.screenDetail w
|
||||
|
||||
-- just the tiled windows:
|
||||
-- now tile the windows on this workspace, modified by the gap
|
||||
(rs, ml') <- runLayout wsp { W.stack = tiled } viewrect `catchX`
|
||||
runLayout wsp { W.stack = tiled, W.layout = Layout Full } viewrect
|
||||
mapM_ (uncurry tileWindow) rs
|
||||
updateLayout n ml'
|
||||
|
||||
-- now the floating windows:
|
||||
-- move/resize the floating windows, if there are any
|
||||
forM_ flt $ \fw -> whenJust (M.lookup fw (W.floating ws)) $
|
||||
\(W.RationalRect rx ry rw rh) -> do
|
||||
tileWindow fw $ Rectangle
|
||||
(sx + floor (toRational sw*rx)) (sy + floor (toRational sh*ry))
|
||||
(floor (toRational sw*rw)) (floor (toRational sh*rh))
|
||||
let m = W.floating ws
|
||||
flt = [(fw, scaleRationalRect viewrect r)
|
||||
| fw <- filter (flip M.member m) (W.index this)
|
||||
, Just r <- [M.lookup fw m]]
|
||||
vs = flt ++ rs
|
||||
|
||||
let vs = flt ++ map fst rs
|
||||
io $ restackWindows d vs
|
||||
io $ restackWindows d (map fst vs)
|
||||
-- return the visible windows for this workspace:
|
||||
return vs
|
||||
|
||||
let visible = map fst rects
|
||||
|
||||
mapM_ (uncurry tileWindow) rects
|
||||
|
||||
whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc
|
||||
setTopFocus
|
||||
asks (logHook . config) >>= userCode
|
||||
|
||||
-- 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)
|
||||
|
||||
mapM_ reveal visible
|
||||
setTopFocus
|
||||
|
||||
-- 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
|
||||
asks (logHook . config) >>= userCodeDef ()
|
||||
|
||||
-- | Produce the actual rectangle from a screen and a ratio on that screen.
|
||||
scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle
|
||||
scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh)
|
||||
= Rectangle (sx + scale sw rx) (sy + scale sh ry) (scale sw rw) (scale sh rh)
|
||||
where scale s r = floor (toRational s * r)
|
||||
|
||||
-- | setWMState. set the WM_STATE property
|
||||
setWMState :: Window -> Int -> X ()
|
||||
@@ -218,7 +219,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 +245,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 +276,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 }
|
||||
@@ -305,9 +303,17 @@ setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.p
|
||||
-- This happens if X notices we've moved the mouse (and perhaps moved
|
||||
-- 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)
|
||||
else whenX (isRoot w) $ setFocusX w
|
||||
focus w = local (\c -> c { mouseFocused = True }) $ withWindowSet $ \s -> do
|
||||
let stag = W.tag . W.workspace
|
||||
curr = stag $ W.current s
|
||||
mnew <- maybe (return Nothing) (fmap (fmap stag) . uncurry pointScreen)
|
||||
=<< asks mousePosition
|
||||
root <- asks theRoot
|
||||
case () of
|
||||
_ | W.member w s && W.peek s /= Just w -> windows (W.focusWindow w)
|
||||
| Just new <- mnew, w == root && curr /= new
|
||||
-> windows (W.view new)
|
||||
| otherwise -> return ()
|
||||
|
||||
-- | Call X to set the keyboard focus details.
|
||||
setFocusX :: Window -> X ()
|
||||
@@ -327,7 +333,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 +373,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 +398,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
|
||||
@@ -421,10 +427,9 @@ floatLocation w = withDisplay $ \d -> do
|
||||
ws <- gets windowset
|
||||
wa <- io $ getWindowAttributes d w
|
||||
bw <- fi <$> asks (borderWidth . config)
|
||||
sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
|
||||
|
||||
-- XXX horrible
|
||||
let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.screens ws
|
||||
sr = screenRect . W.screenDetail $ sc
|
||||
let sr = screenRect . W.screenDetail $ sc
|
||||
rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
|
||||
((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
|
||||
(fi (wa_width wa + bw*2) % fi (rect_width sr))
|
||||
@@ -432,11 +437,20 @@ floatLocation w = withDisplay $ \d -> do
|
||||
|
||||
return (W.screen $ sc, rr)
|
||||
where fi x = fromIntegral x
|
||||
pointWithin :: Integer -> Integer -> Rectangle -> Bool
|
||||
pointWithin x y r = x >= fi (rect_x r) &&
|
||||
x < fi (rect_x r) + fi (rect_width r) &&
|
||||
y >= fi (rect_y r) &&
|
||||
y < fi (rect_y r) + fi (rect_height r)
|
||||
|
||||
-- | Given a point, determine the screen (if any) that contains it.
|
||||
pointScreen :: Position -> Position
|
||||
-> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
|
||||
pointScreen x y = withWindowSet $ return . find p . W.screens
|
||||
where p = pointWithin x y . screenRect . W.screenDetail
|
||||
|
||||
-- | @pointWithin x y r@ returns 'True' if the @(x, y)@ co-ordinate is within
|
||||
-- @r@.
|
||||
pointWithin :: Position -> Position -> Rectangle -> Bool
|
||||
pointWithin x y r = x >= rect_x r &&
|
||||
x < rect_x r + fromIntegral (rect_width r) &&
|
||||
y >= rect_y r &&
|
||||
y < rect_y r + fromIntegral (rect_height r)
|
||||
|
||||
-- | Make a tiled window floating, using its suggested rectangle
|
||||
float :: Window -> X ()
|
||||
@@ -493,8 +507,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 +516,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,18 +31,18 @@ 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,
|
||||
focusUp, focusDown, focusMaster, focusWindow,
|
||||
focusUp, focusDown, focusUp', focusDown', focusMaster, focusWindow,
|
||||
tagMember, renameTag, ensureTags, member, findTag, mapWorkspace, mapLayout,
|
||||
-- * Modifying the stackset
|
||||
-- $modifyStackset
|
||||
insertUp, delete, delete', filter,
|
||||
-- * Setting the master window
|
||||
-- $settingMW
|
||||
swapUp, swapDown, swapMaster, modify, modify', float, sink, -- needed by users
|
||||
swapUp, swapDown, swapMaster, shiftMaster, modify, modify', float, sink, -- needed by users
|
||||
-- * Composite operations
|
||||
-- $composite
|
||||
shift, shiftWin,
|
||||
@@ -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
|
||||
@@ -342,15 +342,19 @@ index = with [] integrate
|
||||
--
|
||||
focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd
|
||||
focusUp = modify' focusUp'
|
||||
focusDown = modify' (reverseStack . focusUp' . reverseStack)
|
||||
focusDown = modify' focusDown'
|
||||
|
||||
swapUp = modify' swapUp'
|
||||
swapDown = modify' (reverseStack . swapUp' . reverseStack)
|
||||
|
||||
focusUp', swapUp' :: Stack a -> Stack a
|
||||
-- | Variants of 'focusUp' and 'focusDown' that work on a
|
||||
-- 'Stack' rather than an entire 'StackSet'.
|
||||
focusUp', focusDown' :: Stack a -> Stack a
|
||||
focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)
|
||||
focusUp' (Stack t [] rs) = Stack x xs [] where (x:xs) = reverse (t:rs)
|
||||
focusDown' = reverseStack . focusUp' . reverseStack
|
||||
|
||||
swapUp' :: Stack a -> Stack a
|
||||
swapUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)
|
||||
swapUp' (Stack t [] rs) = Stack t (reverse rs) []
|
||||
|
||||
@@ -368,23 +372,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 +407,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 +462,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 +491,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) }
|
||||
|
||||
@@ -500,6 +512,15 @@ swapMaster = modify' $ \c -> case c of
|
||||
|
||||
-- natural! keep focus, move current to the top, move top to current.
|
||||
|
||||
-- | /O(s)/. Set the master window to the focused window.
|
||||
-- The other windows are kept in order and shifted down on the stack, as if you
|
||||
-- just hit mod-shift-k a bunch of times.
|
||||
-- Focus stays with the item moved.
|
||||
shiftMaster :: StackSet i l a s sd -> StackSet i l a s sd
|
||||
shiftMaster = modify' $ \c -> case c of
|
||||
Stack _ [] _ -> c -- already master.
|
||||
Stack t ls rs -> Stack t [] (reverse ls ++ rs)
|
||||
|
||||
-- | /O(s)/. Set focus to the master window.
|
||||
focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
|
||||
focusMaster = modify' $ \c -> case c of
|
||||
@@ -520,7 +541,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 +557,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
|
||||
|
||||
|
@@ -36,5 +36,7 @@ xmonad
|
||||
to your \fI~/.xinitrc\fR file
|
||||
.SH CUSTOMIZATION
|
||||
\fBxmonad\fR is customized in ~/.xmonad/xmonad.hs, and then restarting with mod-q.
|
||||
.PP
|
||||
You can find many extensions to the core feature set in the xmonad-contrib package, available through your package manager or from http://xmonad.org/.
|
||||
.SH BUGS
|
||||
Probably. If you find any, please report them: http://code.google.com/p/xmonad/issues/list
|
||||
|
@@ -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))
|
||||
@@ -173,13 +157,15 @@ myKeys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
|
||||
myMouseBindings (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.shiftMaster))
|
||||
|
||||
-- mod-button2, Raise the window to the top of the stack
|
||||
, ((modMask, button2), (\w -> focus w >> windows W.swapMaster))
|
||||
, ((modMask, button2), (\w -> focus w >> windows W.shiftMaster))
|
||||
|
||||
-- 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.shiftMaster))
|
||||
|
||||
-- you may also bind events to the mouse scroll wheel (button4 and button5)
|
||||
]
|
||||
@@ -280,7 +266,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'
|
||||
|
||||
@@ -525,6 +528,18 @@ prop_shift_reversible i (x :: T) =
|
||||
y = swapMaster x
|
||||
n = tag (workspace $ current y)
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- shiftMaster
|
||||
|
||||
-- focus/local/idempotent same as swapMaster:
|
||||
prop_shift_master_focus (x :: T) = peek x == (peek $ shiftMaster x)
|
||||
prop_shift_master_local (x :: T) = hidden_spaces x == hidden_spaces (shiftMaster x)
|
||||
prop_shift_master_idempotent (x :: T) = shiftMaster (shiftMaster x) == shiftMaster x
|
||||
-- ordering is constant modulo the focused window:
|
||||
prop_shift_master_ordering (x :: T) = case peek x of
|
||||
Nothing -> True
|
||||
Just m -> L.delete m (index x) == L.delete m (index $ shiftMaster x)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- shiftWin
|
||||
|
||||
@@ -895,6 +910,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)
|
||||
@@ -929,6 +945,11 @@ main = do
|
||||
,("swapUp is local" , mytest prop_swap_left_local)
|
||||
,("swapDown is local" , mytest prop_swap_right_local)
|
||||
|
||||
,("shiftMaster id on focus", mytest prop_shift_master_focus)
|
||||
,("shiftMaster is local", mytest prop_shift_master_local)
|
||||
,("shiftMaster is idempotent", mytest prop_shift_master_idempotent)
|
||||
,("shiftMaster preserves ordering", mytest prop_shift_master_ordering)
|
||||
|
||||
,("shift: invariant" , mytest prop_shift_I)
|
||||
,("shift is reversible" , mytest prop_shift_reversible)
|
||||
,("shiftWin: invariant" , mytest prop_shift_win_I)
|
||||
|
10
xmonad.cabal
10
xmonad.cabal
@@ -1,5 +1,5 @@
|
||||
name: xmonad
|
||||
version: 0.7
|
||||
version: 0.8.1
|
||||
homepage: http://xmonad.org
|
||||
synopsis: A tiling window manager
|
||||
description:
|
||||
@@ -41,12 +41,12 @@ library
|
||||
XMonad.StackSet
|
||||
|
||||
if flag(small_base)
|
||||
build-depends: base >= 3, containers, directory, process
|
||||
build-depends: base < 4 && >=3, containers, directory, process
|
||||
else
|
||||
build-depends: base < 3
|
||||
build-depends: X11>=1.4.1, mtl, unix
|
||||
build-depends: X11>=1.4.3, 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