Copyright | (c) 2007 Andrea Rossato 2009 Jan Vornberger 2023 Ilya Portnov |
---|---|
License | BSD-style (see xmonad/LICENSE) |
Maintainer | portnov84@rambler.ru |
Stability | unstable |
Portability | unportable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
This set of modules contains a set of type classes and their implementations which define a flexible and extensible mechanism of window decorations.
Click here for a larger version.
Within this mechanism, there are the following entities which define how decorations will look and work:
- Main object is
DecorationEx
layout modifier. It is from where everything starts. It creates, shows and hides decoration windows (rectangles) when needed. It is parameterized with decoration geometry, decoration engine and theme. It calls these components to do their parts of the work. DecorationGeometry
defines where decoration rectangles should be placed. For example, standard horizontal bar above each window; or tab bar.DecorationEngine
defines how decorations look and how they react on clicks. Different implementations of the decoration engine can use different APIs to draw decorations. Within this package, there is one implementation (TextDecoration
), which uses plain Xlib calls, and displays decoration widgets with text fragments, like[X]
or[_]
. Other engines can, for example, use the Cairo library to draw nice gradients and image-based widgets.- A Decoration widget is an element placed on a window decoration. It defines how it looks and how it responds to clicks. Examples include usual window buttons (minimize, maximize, close), window icon, window title.
- A Decoration theme defines colors and fonts for the decoration engine. It also contains a list of decoration widgets and says where to place them (at the left, at the right or in the center).
This mechanism makes major use of parameterized data types and type families, in order to make it possible to define different types of decorations, and easily combine different aspects of decorations. For example, each decoration engine can be combined with each decoration geometry.
Synopsis
- decorationEx :: (DecorationEngine engine widget a, DecorationGeometry geom a, Shrinker shrinker) => shrinker -> Theme engine widget -> engine widget a -> geom a -> l a -> ModifiedLayout (DecorationEx engine widget geom shrinker) l a
- textDecoration :: Shrinker shrinker => shrinker -> Theme TextDecoration StandardWidget -> l Window -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DefaultGeometry shrinker) l Window
- textTabbed :: Shrinker shrinker => shrinker -> ThemeEx StandardWidget -> l Window -> ModifiedLayout (DecorationEx TextDecoration StandardWidget TabbedGeometry shrinker) l Window
- dwmStyleDeco :: Shrinker shrinker => shrinker -> ThemeEx StandardWidget -> l Window -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window
- data TextDecoration widget a = TextDecoration
- newtype DefaultGeometry a = DefaultGeometry {}
- data TabbedGeometry a
- = HorizontalTabs { }
- | VerticalTabs { }
- data DwmGeometry a = DwmGeometry {}
- data DecorationEx engine widget geom shrinker a
- data BoxBorders a = BoxBorders {}
- type BorderColors = BoxBorders String
- data SimpleStyle = SimpleStyle {}
- data GenericTheme style widget = GenericTheme {
- exActive :: !style
- exInactive :: !style
- exUrgent :: !style
- exPadding :: !(BoxBorders Dimension)
- exFontName :: !String
- exOnDecoClick :: !(Map Int (WidgetCommand widget))
- exDragWindowButtons :: ![Int]
- exWidgetsLeft :: ![widget]
- exWidgetsCenter :: ![widget]
- exWidgetsRight :: ![widget]
- type ThemeEx widget = GenericTheme SimpleStyle widget
- data StandardCommand
- data GenericWidget cmd
- = TitleWidget
- | WindowIcon {
- swCommand :: !cmd
- | GenericWidget {
- swCheckedText :: !String
- swUncheckedText :: !String
- swCommand :: !cmd
- type StandardWidget = GenericWidget StandardCommand
- themeEx :: Default (WidgetCommand widget) => Theme -> ThemeEx widget
- borderColor :: String -> BorderColors
- shadowBorder :: String -> String -> BorderColors
- class (Read s, Show s) => Shrinker s where
- shrinkText :: DefaultShrinker
- titleW :: StandardWidget
- toggleStickyW :: StandardWidget
- minimizeW :: StandardWidget
- maximizeW :: StandardWidget
- closeW :: StandardWidget
- dwmpromoteW :: StandardWidget
- moveToNextGroupW :: StandardWidget
- moveToPrevGroupW :: StandardWidget
Usage:
You can use this module with the following in your
xmonad.hs
:
import XMonad.Layout.DecorationEx
Then edit your layoutHook
by adding the DwmStyle decoration to
your layout:
myTheme = ThemeEx {...} myL = textDecoration shrinkText myTheme (layoutHook def) main = xmonad def { layoutHook = myL }
For more detailed instructions on editing the layoutHook see:
This module exports only some definitions from it's submodules, most likely to be used from user configurations. To define your own decoration types you will likely have to import specific submodules.
Standard decoration settings
:: (DecorationEngine engine widget a, DecorationGeometry geom a, Shrinker shrinker) | |
=> shrinker | Strings shrinker, for example |
-> Theme engine widget | Decoration theme |
-> engine widget a | Decoration engine instance |
-> geom a | Decoration geometry instance |
-> l a | Underlying layout to be decorated |
-> ModifiedLayout (DecorationEx engine widget geom shrinker) l a |
Apply a DecorationEx modifier to an underlying layout
:: Shrinker shrinker | |
=> shrinker | String shrinker, for example |
-> Theme TextDecoration StandardWidget | Decoration theme (font, colors, widgets, etc) |
-> l Window | Layout to be decorated |
-> ModifiedLayout (DecorationEx TextDecoration StandardWidget DefaultGeometry shrinker) l Window |
Add decoration to existing layout. Widgets are indicated by text fragments, like "[+]"
.
Geometry is simple: a horizontal panel at the top of each window, going for the full width
of the window.
:: Shrinker shrinker | |
=> shrinker | Strings shrinker, e.g. |
-> ThemeEx StandardWidget | Decoration theme |
-> l Window | Layout to be decorated |
-> ModifiedLayout (DecorationEx TextDecoration StandardWidget TabbedGeometry shrinker) l Window |
Add tabbed decorations (with default settings) with text-based widgets to a layout.
:: Shrinker shrinker | |
=> shrinker | Strings shrinker, for example |
-> ThemeEx StandardWidget | Decoration theme (font, colors, widgets, etc) |
-> l Window | Layout to be decorated |
-> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window |
Add a decoration to window layout. Widgets are indicated with text fragments using TextDecoration; decoration placement is similar to DWM.
Decoration-related types
data TextDecoration widget a Source #
Decoration engine data type
Instances
newtype DefaultGeometry a Source #
Data type for default implementation of DecorationGeometry
.
This defines simple decorations: a horizontal bar at the top of each window,
running for full width of the window.
Instances
data TabbedGeometry a Source #
HorizontalTabs | |
| |
VerticalTabs | |
|
Instances
data DwmGeometry a Source #
Decoration geometry data type
DwmGeometry | |
|
Instances
data DecorationEx engine widget geom shrinker a Source #
The DecorationEx
LayoutModifier
. This data type is an instance
of the LayoutModifier
class. This data type will be passed,
together with a layout, to the ModifiedLayout
type constructor
to modify the layout by adding decorations according to a
DecorationEngine
.
Instances
(DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker) => LayoutModifier (DecorationEx engine widget geom shrinker) Window Source # | The long In The state is After that we resync the updated state with the windows' list and then we process the resynced stated (as we do with a new state). First we map the decoration windows, we update each decoration to reflect any decorated window's change, and we insert, in the list of windows and rectangles returned by the underlying layout, the decoration for each window. This way xmonad will restack the decorations and their windows accordingly. At the end we remove invisible/stacked windows. Message handling is quite simple: when needed we release the state
component of the |
Defined in XMonad.Layout.DecorationEx.LayoutModifier modifyLayout :: LayoutClass l Window => DecorationEx engine widget geom shrinker Window -> Workspace WorkspaceId (l Window) Window -> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window)) Source # modifyLayoutWithUpdate :: LayoutClass l Window => DecorationEx engine widget geom shrinker Window -> Workspace WorkspaceId (l Window) Window -> Rectangle -> X (([(Window, Rectangle)], Maybe (l Window)), Maybe (DecorationEx engine widget geom shrinker Window)) Source # handleMess :: DecorationEx engine widget geom shrinker Window -> SomeMessage -> X (Maybe (DecorationEx engine widget geom shrinker Window)) Source # handleMessOrMaybeModifyIt :: DecorationEx engine widget geom shrinker Window -> SomeMessage -> X (Maybe (Either (DecorationEx engine widget geom shrinker Window) SomeMessage)) Source # pureMess :: DecorationEx engine widget geom shrinker Window -> SomeMessage -> Maybe (DecorationEx engine widget geom shrinker Window) Source # redoLayout :: DecorationEx engine widget geom shrinker Window -> Rectangle -> Maybe (Stack Window) -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (DecorationEx engine widget geom shrinker Window)) Source # pureModifier :: DecorationEx engine widget geom shrinker Window -> Rectangle -> Maybe (Stack Window) -> [(Window, Rectangle)] -> ([(Window, Rectangle)], Maybe (DecorationEx engine widget geom shrinker Window)) Source # hook :: DecorationEx engine widget geom shrinker Window -> X () Source # unhook :: DecorationEx engine widget geom shrinker Window -> X () Source # modifierDescription :: DecorationEx engine widget geom shrinker Window -> String Source # modifyDescription :: LayoutClass l Window => DecorationEx engine widget geom shrinker Window -> l Window -> String Source # | |
(Read (Theme engine widget), Read shrinker, Read (engine widget a), Read (geom a)) => Read (DecorationEx engine widget geom shrinker a) Source # | |
Defined in XMonad.Layout.DecorationEx.LayoutModifier readsPrec :: Int -> ReadS (DecorationEx engine widget geom shrinker a) # readList :: ReadS [DecorationEx engine widget geom shrinker a] # readPrec :: ReadPrec (DecorationEx engine widget geom shrinker a) # readListPrec :: ReadPrec [DecorationEx engine widget geom shrinker a] # | |
(Show (Theme engine widget), Show shrinker, Show (engine widget a), Show (geom a)) => Show (DecorationEx engine widget geom shrinker a) Source # | |
Defined in XMonad.Layout.DecorationEx.LayoutModifier showsPrec :: Int -> DecorationEx engine widget geom shrinker a -> ShowS # show :: DecorationEx engine widget geom shrinker a -> String # showList :: [DecorationEx engine widget geom shrinker a] -> ShowS # |
Theme types
data BoxBorders a Source #
Generic data type which is used to describe characteristics of rectangle borders.
Instances
Read a => Read (BoxBorders a) Source # | |
Defined in XMonad.Layout.DecorationEx.Common readsPrec :: Int -> ReadS (BoxBorders a) # readList :: ReadS [BoxBorders a] # readPrec :: ReadPrec (BoxBorders a) # readListPrec :: ReadPrec [BoxBorders a] # | |
Show a => Show (BoxBorders a) Source # | |
Defined in XMonad.Layout.DecorationEx.Common showsPrec :: Int -> BoxBorders a -> ShowS # show :: BoxBorders a -> String # showList :: [BoxBorders a] -> ShowS # | |
Eq a => Eq (BoxBorders a) Source # | |
Defined in XMonad.Layout.DecorationEx.Common (==) :: BoxBorders a -> BoxBorders a -> Bool # (/=) :: BoxBorders a -> BoxBorders a -> Bool # |
type BorderColors = BoxBorders String Source #
Convinience data type describing colors of decoration rectangle borders.
data SimpleStyle Source #
Data type describing look of window decoration in particular state (active or inactive)
SimpleStyle | |
|
Instances
data GenericTheme style widget Source #
Generic Theme data type. This is used
by TextEngine
and can be used by other relatively
simple decoration engines.
GenericTheme | |
|
Instances
type ThemeEx widget = GenericTheme SimpleStyle widget Source #
Convience type for themes used by TextDecoration
.
Widget types
data StandardCommand Source #
Standard window commands.
One can extend this list by simply doing
data MyWindowCommand = Std StandardCommand | SomeFancyCommand
instance WindowCommand MyWindowCommand where ...
type MyWidget = GenericWidget MyWindowCommand
FocusWindow | Focus the window |
FocusUp | Move focus to previous window |
FocusDown | Move focus to following window |
MoveToNextGroup | Move the window to the next group (see XMonad.Layout.Groups) |
MoveToPrevGroup | Move the window to the previous group |
DwmPromote | Execute |
ToggleSticky | Make window sticky or unstick it (see XMonad.Actions.CopyWindow) |
ToggleMaximize | Maximize or restore window (see XMonad.Layout.Maximize) |
Minimize | Minimize window (see XMonad.Actions.Minimize) |
CloseWindow | Close the window |
GridWindowMenu | Show window menu via XMonad.Actions.GridSelect (see XMonad.Actions.WindowMenu) |
Instances
Read StandardCommand Source # | |
Defined in XMonad.Layout.DecorationEx.Widgets | |
Show StandardCommand Source # | |
Defined in XMonad.Layout.DecorationEx.Widgets showsPrec :: Int -> StandardCommand -> ShowS # show :: StandardCommand -> String # showList :: [StandardCommand] -> ShowS # | |
Default StandardCommand Source # | |
Defined in XMonad.Layout.DecorationEx.Widgets def :: StandardCommand # | |
Eq StandardCommand Source # | |
Defined in XMonad.Layout.DecorationEx.Widgets (==) :: StandardCommand -> StandardCommand -> Bool # (/=) :: StandardCommand -> StandardCommand -> Bool # | |
WindowCommand StandardCommand Source # | |
Defined in XMonad.Layout.DecorationEx.Widgets executeWindowCommand :: StandardCommand -> Window -> X Bool Source # isCommandChecked :: StandardCommand -> Window -> X Bool Source # | |
TextWidget StandardWidget Source # | |
Defined in XMonad.Layout.DecorationEx.Widgets widgetString :: forall (engine :: Type -> Type -> Type). DrawData engine StandardWidget -> StandardWidget -> X String Source # |
data GenericWidget cmd Source #
Generic data type for decoration widgets.
TitleWidget | Window title (just text label) |
WindowIcon | Window icon with some associated command | Other widgets |
| |
GenericWidget | |
|
Instances
type StandardWidget = GenericWidget StandardCommand Source #
Generic widget type specialized for StandardCommand
Utility functions for themes
themeEx :: Default (WidgetCommand widget) => Theme -> ThemeEx widget Source #
Convert Theme type from XMonad.Layout.Decoration to theme type used by XMonad.Layout.DecorationEx.TextEngine.
borderColor :: String -> BorderColors Source #
shadowBorder :: String -> String -> BorderColors Source #
Convinience re-exports
class (Read s, Show s) => Shrinker s where Source #
Instances
Shrinker CustomShrink Source # | |
Defined in XMonad.Config.Droundy | |
Shrinker DefaultShrinker Source # | |
Defined in XMonad.Layout.Decoration |
Standard widgets
titleW :: StandardWidget Source #
Widget for window title
toggleStickyW :: StandardWidget Source #
Widget for ToggleSticky command.
minimizeW :: StandardWidget Source #
Widget for Minimize command
maximizeW :: StandardWidget Source #
Widget for ToggleMaximize command
closeW :: StandardWidget Source #
Widget for CloseWindow command