Portability | not portable, uses cunning newtype deriving |
---|---|
Stability | unstable |
Maintainer | spencerjanssen@gmail.com |
Safe Haskell | None |
- data X a
- type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
- type WindowSpace = Workspace WorkspaceId (Layout Window) Window
- type WorkspaceId = String
- newtype ScreenId = S Int
- data ScreenDetail = SD {
- screenRect :: !Rectangle
- data XState = XState {}
- data XConf = XConf {
- display :: Display
- config :: !(XConfig Layout)
- theRoot :: !Window
- normalBorder :: !Pixel
- focusedBorder :: !Pixel
- keyActions :: !(Map (KeyMask, KeySym) (X ()))
- buttonActions :: !(Map (KeyMask, Button) (Window -> X ()))
- mouseFocused :: !Bool
- mousePosition :: !(Maybe (Position, Position))
- currentEvent :: !(Maybe Event)
- data XConfig l = XConfig {
- normalBorderColor :: !String
- focusedBorderColor :: !String
- terminal :: !String
- layoutHook :: !(l Window)
- manageHook :: !ManageHook
- handleEventHook :: !(Event -> X All)
- workspaces :: ![String]
- modMask :: !KeyMask
- keys :: !(XConfig Layout -> Map (ButtonMask, KeySym) (X ()))
- mouseBindings :: !(XConfig Layout -> Map (ButtonMask, Button) (Window -> X ()))
- borderWidth :: !Dimension
- logHook :: !(X ())
- startupHook :: !(X ())
- focusFollowsMouse :: !Bool
- clickJustFocuses :: !Bool
- class Show (layout a) => LayoutClass layout a where
- runLayout :: Workspace WorkspaceId (layout a) a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
- doLayout :: layout a -> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))
- pureLayout :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
- emptyLayout :: layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
- handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))
- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
- description :: layout a -> String
- data Layout a = forall l . (LayoutClass l a, Read (l a)) => Layout (l a)
- readsLayout :: Layout a -> String -> [(Layout a, String)]
- class Typeable a
- class Typeable a => Message a
- data SomeMessage = forall a . Message a => SomeMessage a
- fromMessage :: Message m => SomeMessage -> Maybe m
- data LayoutMessages
- = Hide
- | ReleaseResources
- data StateExtension
- = forall a . ExtensionClass a => StateExtension a
- | forall a . (Read a, Show a, ExtensionClass a) => PersistentExtension a
- class Typeable a => ExtensionClass a where
- initialValue :: a
- extensionType :: a -> StateExtension
- runX :: XConf -> XState -> X a -> IO (a, XState)
- catchX :: X a -> X a -> X a
- userCode :: X a -> X (Maybe a)
- userCodeDef :: a -> X a -> X a
- io :: MonadIO m => IO a -> m a
- catchIO :: MonadIO m => IO () -> m ()
- installSignalHandlers :: MonadIO m => m ()
- uninstallSignalHandlers :: MonadIO m => m ()
- withDisplay :: (Display -> X a) -> X a
- withWindowSet :: (WindowSet -> X a) -> X a
- isRoot :: Window -> X Bool
- runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
- getAtom :: String -> X Atom
- spawn :: MonadIO m => String -> m ()
- spawnPID :: MonadIO m => String -> m ProcessID
- xfork :: MonadIO m => IO () -> m ProcessID
- getXMonadDir :: MonadIO m => m String
- recompile :: MonadIO m => Bool -> m Bool
- trace :: MonadIO m => String -> m ()
- whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
- whenX :: X Bool -> X () -> X ()
- atom_WM_STATE :: X Atom
- atom_WM_PROTOCOLS :: X Atom
- atom_WM_DELETE_WINDOW :: X Atom
- atom_WM_TAKE_FOCUS :: X Atom
- type ManageHook = Query (Endo WindowSet)
- newtype Query a = Query (ReaderT Window X a)
- runQuery :: Query a -> Window -> X a
Documentation
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.
type WindowSpace = Workspace WorkspaceId (Layout Window) WindowSource
type WorkspaceId = StringSource
Virtual workspace indices
Physical screen indices
XState, the (mutable) window manager state.
XState | |
|
XConf, the (read-only) window manager configuration.
XConf | |
|
XConfig | |
|
class Show (layout a) => LayoutClass layout a whereSource
Every layout must be an instance of LayoutClass
, which defines
the basic layout operations along with a sensible default for each.
Minimal complete definition:
-
runLayout
|| ((doLayout
||pureLayout
) &&emptyLayout
), and -
handleMessage
||pureMessage
You should also strongly consider implementing description
,
although it is not required.
Note that any code which uses LayoutClass
methods should only
ever call runLayout
, handleMessage
, and description
! In
other words, the only calls to doLayout
, pureMessage
, and other
such methods should be from the default implementations of
runLayout
, handleMessage
, and so on. This ensures that the
proper methods will be used, regardless of the particular methods
that any LayoutClass
instance chooses to define.
runLayout :: Workspace WorkspaceId (layout a) a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))Source
By default, runLayout
calls doLayout
if there are any
windows to be laid out, and emptyLayout
otherwise. Most
instances of LayoutClass
probably do not need to implement
runLayout
; it is only useful for layouts which wish to make
use of more of the Workspace
information (for example,
XMonad.Layout.PerWorkspace).
doLayout :: layout a -> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))Source
Given a Rectangle
in which to place the windows, and a Stack
of windows, return a list of windows and their corresponding
Rectangles. If an element is not given a Rectangle by
doLayout
, then it is not shown on screen. The order of
windows in this list should be the desired stacking order.
Also possibly return a modified layout (by returning Just
newLayout
), if this layout needs to be modified (e.g. if it
keeps track of some sort of state). Return Nothing
if the
layout does not need to be modified.
Layouts which do not need access to the X
monad (IO
, window
manager state, or configuration) and do not keep track of their
own state should implement pureLayout
instead of doLayout
.
pureLayout :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)]Source
This is a pure version of doLayout
, for cases where we
don't need access to the X
monad to determine how to lay out
the windows, and we don't need to modify the layout itself.
emptyLayout :: layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))Source
emptyLayout
is called when there are no windows.
handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))Source
handleMessage
performs message handling. If
handleMessage
returns Nothing
, then the layout did not
respond to the message and the screen is not refreshed.
Otherwise, handleMessage
returns an updated layout and the
screen is refreshed.
Layouts which do not need access to the X
monad to decide how
to handle messages should implement pureMessage
instead of
handleMessage
(this restricts the risk of error, and makes
testing much easier).
pureMessage :: layout a -> SomeMessage -> Maybe (layout a)Source
Respond to a message by (possibly) changing our layout, but taking no other action. If the layout changes, the screen will be refreshed.
description :: layout a -> StringSource
This should be a human-readable string that is used when
selecting layouts by name. The default implementation is
show
, which is in some cases a poor default.
LayoutClass Layout Window | |
Show (Tall a) => LayoutClass Tall a | |
Show (Full a) => LayoutClass Full a | |
(Show (Mirror l a), LayoutClass l a) => LayoutClass (Mirror l) a | |
(Show (Choose l r a), LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a |
An existential type that can hold any object that is in Read
and LayoutClass
.
forall l . (LayoutClass l a, Read (l a)) => Layout (l a) |
class Typeable a
The class Typeable
allows a concrete representation of a type to
be calculated.
class Typeable a => Message a Source
Based on ideas in /An Extensible Dynamically-Typed Hierarchy of
Exceptions/, Simon Marlow, 2006. Use extensible messages to the
handleMessage
handler.
User-extensible messages must be a member of this class.
data SomeMessage Source
A wrapped value of some type in the Message
class.
forall a . Message a => SomeMessage a |
fromMessage :: Message m => SomeMessage -> Maybe mSource
And now, unwrap a given, unknown Message
type, performing a (dynamic)
type check on the result.
data LayoutMessages Source
LayoutMessages
are core messages that all layouts (especially stateful
layouts) should consider handling.
Hide | sent when a layout becomes non-visible |
ReleaseResources | sent when xmonad is exiting or restarting |
data StateExtension Source
Existential type to store a state extension.
forall a . ExtensionClass a => StateExtension a | Non-persistent state extension |
forall a . (Read a, Show a, ExtensionClass a) => PersistentExtension a | Persistent extension |
class Typeable a => ExtensionClass a whereSource
Every module must make the data it wants to store an instance of this class.
Minimal complete definition: initialValue
initialValue :: aSource
Defines an initial value for the state extension
extensionType :: a -> StateExtensionSource
Specifies whether the state extension should be
persistent. Setting this method to PersistentExtension
will make the stored data survive restarts, but
requires a to be an instance of Read and Show.
It defaults to StateExtension
, i.e. no persistence.
catchX :: X a -> X a -> X aSource
Run in the X
monad, and in case of exception, and catch it and log it
to stderr, and run the error case.
userCode :: X a -> X (Maybe a)Source
Execute the argument, catching all exceptions. Either this function or
catchX
should be used at all callsites of user customized code.
userCodeDef :: a -> X a -> X aSource
Same as userCode but with a default argument to return instead of using Maybe, provided for convenience.
installSignalHandlers :: MonadIO m => m ()Source
Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to avoid zombie processes, and clean up any extant zombie processes.
uninstallSignalHandlers :: MonadIO m => m ()Source
withDisplay :: (Display -> X a) -> X aSource
Run a monad action with the current display settings
withWindowSet :: (WindowSet -> X a) -> X aSource
Run a monadic action with the current stack set
runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()Source
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.
spawn :: MonadIO m => String -> m ()Source
spawn. Launch an external application. Specifically, it double-forks and
runs the String
you pass as a command to /bin/sh.
Note this function assumes your locale uses utf8.
xfork :: MonadIO m => IO () -> m ProcessIDSource
A replacement for forkProcess
which resets default signal handlers.
getXMonadDir :: MonadIO m => m StringSource
Return the path to ~/.xmonad
.
recompile :: MonadIO m => Bool -> m BoolSource
'recompile force', recompile ~/.xmonad/xmonad.hs
when any of the
following apply:
- force is
True
- the xmonad executable does not exist
- the xmonad executable is older than xmonad.hs or any file in ~/.xmonad/lib
The -i flag is used to restrict recompilation to the xmonad.hs file only, and any files in the ~/.xmonad/lib directory.
Compilation errors (if any) are logged to ~/.xmonad/xmonad.errors. If GHC indicates failure with a non-zero exit code, an xmessage displaying that file is spawned.
False
is returned if there are compilation errors.
whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()Source
Conditionally run an action, using a Maybe a
to decide.
Common non-predefined atoms
atom_WM_PROTOCOLS :: X AtomSource
Common non-predefined atoms
atom_WM_DELETE_WINDOW :: X AtomSource
Common non-predefined atoms
atom_WM_TAKE_FOCUS :: X AtomSource
Common non-predefined atoms
type ManageHook = Query (Endo WindowSet)Source