    {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE DefaultSignatures #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.DecorationEx.Engine
    -- Description :  Type class and its default implementation for window decoration engines.
    -- 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
    --
    -- This module defines @DecorationEngine@ type class, and default implementation for it.
    -----------------------------------------------------------------------------

    module XMonad.Layout.DecorationEx.Engine (
        -- * DecorationEngine class
        DecorationEngine (..),
        -- * Auxiliary data types
        DrawData (..),
        DecorationLayoutState (..),
        -- * Re-exports from X.L.Decoration
        Shrinker (..), shrinkText,
        -- * Utility functions
        mkDrawData,
        paintDecorationSimple
      ) where

    import Control.Monad
    import Data.Kind
    import Foreign.C.Types (CInt)

    import XMonad
    import XMonad.Prelude
    import qualified XMonad.StackSet as W
    import XMonad.Layout.Decoration (Shrinker (..), shrinkWhile, shrinkText)
    import XMonad.Layout.DraggingVisualizer (DraggingVisualizerMsg (..))
    import XMonad.Layout.DecorationAddons (handleScreenCrossing)
    import XMonad.Util.Font
    import XMonad.Util.NamedWindows (getName)

    import XMonad.Layout.DecorationEx.Common

    -- | Auxiliary type for data which are passed from
    -- decoration layout modifier to decoration engine.
    data DrawData engine widget = DrawData {
        forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> DecorationEngineState engine
    ddEngineState :: !(DecorationEngineState engine)     -- ^ Decoration engine state
      , forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> Style (Theme engine widget)
    ddStyle :: !(Style (Theme engine widget))  -- ^ Graphics style of the decoration. This defines colors, fonts etc
                                                            -- which are to be used for this particular window in it's current state.
      , forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> Window
    ddOrigWindow :: !Window                             -- ^ Original window to be decorated
      , forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> String
    ddWindowTitle :: !String                            -- ^ Original window title (not shrinked yet)
      , forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> Rectangle
    ddDecoRect :: !Rectangle                            -- ^ Decoration rectangle
      , forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> WidgetLayout widget
    ddWidgets :: !(WidgetLayout widget)         -- ^ Widgets to be placed on decoration
      , forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> WidgetLayout WidgetPlace
    ddWidgetPlaces :: !(WidgetLayout WidgetPlace)       -- ^ Places where widgets must be shown
      }

    -- | State of decoration engine
    data DecorationLayoutState engine = DecorationLayoutState {
        forall (engine :: * -> * -> *).
    DecorationLayoutState engine -> DecorationEngineState engine
    dsStyleState :: !(DecorationEngineState engine) -- ^ Engine-specific state
      , forall (engine :: * -> * -> *).
    DecorationLayoutState engine -> [WindowDecoration]
    dsDecorations :: ![WindowDecoration]            -- ^ Mapping between decoration windows and original windows
      }

    -- | Decoration engines type class.
    -- Decoration engine is responsible for drawing something inside decoration rectangle.
    -- It is also responsible for handling X11 events (such as clicks) which happen
    -- within decoration rectangle.
    -- Decoration rectangles are defined by DecorationGeometry implementation.
    class (Read (engine widget a), Show (engine widget a),
           Eq a,
           DecorationWidget widget,
           HasWidgets (Theme engine) widget,
           ClickHandler (Theme engine) widget,
           ThemeAttributes (Theme engine widget))
        => DecorationEngine engine widget a where

        -- | Type of themes used by decoration engine.
        -- This type must be parameterized over a widget type,
        -- because a theme will contain a list of widgets.
        type Theme engine :: Type -> Type

        -- | Type of data used by engine as a context during painting;
        -- for plain X11-based implementation this is Display, Pixmap
        -- and GC.
        type DecorationPaintingContext engine

        -- | Type of state used by the decoration engine.
        -- This can contain some resources that should be initialized
        -- and released at time, such as X11 fonts.
        type DecorationEngineState engine

        -- | Give a name to decoration engine.
        describeEngine :: engine widget a -> String

        -- | Initialize state of the engine.
        initializeState :: engine widget a       -- ^ Decoration engine instance
                        -> geom a                -- ^ Decoration geometry instance
                        -> Theme engine widget   -- ^ Theme to be used
                        -> X (DecorationEngineState engine)

        -- | Release resources held in engine state.
        releaseStateResources :: engine widget a              -- ^ Decoration engine instance
                              -> DecorationEngineState engine -- ^ Engine state
                              -> X ()

        -- | Calculate place which will be occupied by one widget.
        -- NB: X coordinate of the returned rectangle will be ignored, because
        -- the rectangle will be moved to the right or to the left for proper alignment
        -- of widgets.
        calcWidgetPlace :: engine widget a         -- ^ Decoration engine instance
                        -> DrawData engine widget  -- ^ Information about window and decoration
                        -> widget                  -- ^ Widget to be placed
                        -> X WidgetPlace

        -- | Place widgets along the decoration bar.
        placeWidgets :: Shrinker shrinker
                     => engine widget a              -- ^ Decoration engine instance
                     -> Theme engine widget          -- ^ Theme to be used
                     -> shrinker                     -- ^ Strings shrinker
                     -> DecorationEngineState engine -- ^ Current state of the engine
                     -> Rectangle                    -- ^ Decoration rectangle
                     -> Window                       -- ^ Original window to be decorated
                     -> WidgetLayout widget          -- ^ Widgets layout
                     -> X (WidgetLayout WidgetPlace)
        placeWidgets engine widget a
    engine Theme engine widget
    theme shrinker
    _ DecorationEngineState engine
    decoStyle Rectangle
    decoRect Window
    window WidgetLayout widget
    wlayout = do
            let leftWidgets :: [widget]
    leftWidgets = WidgetLayout widget -> [widget]
    forall a. WidgetLayout a -> [a]
    wlLeft WidgetLayout widget
    wlayout
                rightWidgets :: [widget]
    rightWidgets = WidgetLayout widget -> [widget]
    forall a. WidgetLayout a -> [a]
    wlRight WidgetLayout widget
    wlayout
                centerWidgets :: [widget]
    centerWidgets = WidgetLayout widget -> [widget]
    forall a. WidgetLayout a -> [a]
    wlCenter WidgetLayout widget
    wlayout

            DrawData engine widget
    dd <- engine widget a
    -> Theme engine widget
    -> DecorationEngineState engine
    -> Window
    -> Rectangle
    -> X (DrawData engine widget)
    forall (engine :: * -> * -> *) widget a.
    (DecorationEngine engine widget a,
     ThemeAttributes (Theme engine widget),
     HasWidgets (Theme engine) widget) =>
    engine widget a
    -> Theme engine widget
    -> DecorationEngineState engine
    -> Window
    -> Rectangle
    -> X (DrawData engine widget)
    mkDrawData engine widget a
    engine Theme engine widget
    theme DecorationEngineState engine
    decoStyle Window
    window Rectangle
    decoRect
            let paddedDecoRect :: Rectangle
    paddedDecoRect = BoxBorders Dimension -> Rectangle -> Rectangle
    pad (Theme engine widget -> BoxBorders Dimension
    forall theme.
    ThemeAttributes theme =>
    theme -> BoxBorders Dimension
    widgetsPadding Theme engine widget
    theme) (DrawData engine widget -> Rectangle
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> Rectangle
    ddDecoRect DrawData engine widget
    dd)
                paddedDd :: DrawData engine widget
    paddedDd = DrawData engine widget
    dd {ddDecoRect = paddedDecoRect}
            [WidgetPlace]
    rightRects <- engine widget a
    -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a
    -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    alignRight engine widget a
    engine DrawData engine widget
    paddedDd [widget]
    rightWidgets
            [WidgetPlace]
    leftRects <- engine widget a
    -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a
    -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    alignLeft engine widget a
    engine DrawData engine widget
    paddedDd [widget]
    leftWidgets
            let wantedLeftWidgetsWidth :: Dimension
    wantedLeftWidgetsWidth = [Dimension] -> Dimension
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Dimension] -> Dimension) -> [Dimension] -> Dimension
    forall a b. (a -> b) -> a -> b
    $ (WidgetPlace -> Dimension) -> [WidgetPlace] -> [Dimension]
    forall a b. (a -> b) -> [a] -> [b]
    map (Rectangle -> Dimension
    rect_width (Rectangle -> Dimension)
    -> (WidgetPlace -> Rectangle) -> WidgetPlace -> Dimension
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WidgetPlace -> Rectangle
    wpRectangle) [WidgetPlace]
    leftRects
                wantedRightWidgetsWidth :: Dimension
    wantedRightWidgetsWidth = [Dimension] -> Dimension
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Dimension] -> Dimension) -> [Dimension] -> Dimension
    forall a b. (a -> b) -> a -> b
    $ (WidgetPlace -> Dimension) -> [WidgetPlace] -> [Dimension]
    forall a b. (a -> b) -> [a] -> [b]
    map (Rectangle -> Dimension
    rect_width (Rectangle -> Dimension)
    -> (WidgetPlace -> Rectangle) -> WidgetPlace -> Dimension
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WidgetPlace -> Rectangle
    wpRectangle) [WidgetPlace]
    rightRects
                hasShrinkableOnLeft :: Bool
    hasShrinkableOnLeft = (widget -> Bool) -> [widget] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any widget -> Bool
    forall widget. DecorationWidget widget => widget -> Bool
    isShrinkable [widget]
    leftWidgets
                hasShrinkableOnRight :: Bool
    hasShrinkableOnRight = (widget -> Bool) -> [widget] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any widget -> Bool
    forall widget. DecorationWidget widget => widget -> Bool
    isShrinkable [widget]
    rightWidgets
                decoWidth :: Dimension
    decoWidth = Rectangle -> Dimension
    rect_width Rectangle
    decoRect
                (Dimension
    leftWidgetsWidth, Dimension
    rightWidgetsWidth)
                  | Bool
    hasShrinkableOnLeft =
                      (Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    min (Dimension
    decoWidth Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    wantedRightWidgetsWidth) Dimension
    wantedLeftWidgetsWidth,
                          Dimension
    wantedRightWidgetsWidth)
                  | Bool
    hasShrinkableOnRight =
                      (Dimension
    wantedLeftWidgetsWidth,
                          Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    min (Dimension
    decoWidth Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    wantedLeftWidgetsWidth) Dimension
    wantedRightWidgetsWidth)
                  | Bool
    otherwise = (Dimension
    wantedLeftWidgetsWidth, Dimension
    wantedRightWidgetsWidth)
                ddForCenter :: DrawData engine widget
    ddForCenter = DrawData engine widget
    paddedDd {ddDecoRect = padCenter leftWidgetsWidth rightWidgetsWidth paddedDecoRect}
            [WidgetPlace]
    centerRects <- engine widget a
    -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a
    -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    alignCenter engine widget a
    engine DrawData engine widget
    ddForCenter [widget]
    centerWidgets
            let shrinkedLeftRects :: [WidgetPlace]
    shrinkedLeftRects = Position -> [WidgetPlace] -> [WidgetPlace]
    packLeft (Rectangle -> Position
    rect_x Rectangle
    paddedDecoRect) ([WidgetPlace] -> [WidgetPlace]) -> [WidgetPlace] -> [WidgetPlace]
    forall a b. (a -> b) -> a -> b
    $ Dimension -> [(WidgetPlace, Bool)] -> [WidgetPlace]
    shrinkPlaces Dimension
    leftWidgetsWidth ([(WidgetPlace, Bool)] -> [WidgetPlace])
    -> [(WidgetPlace, Bool)] -> [WidgetPlace]
    forall a b. (a -> b) -> a -> b
    $ [WidgetPlace] -> [Bool] -> [(WidgetPlace, Bool)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [WidgetPlace]
    leftRects ((widget -> Bool) -> [widget] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map widget -> Bool
    forall widget. DecorationWidget widget => widget -> Bool
    isShrinkable [widget]
    leftWidgets)
                shrinkedRightRects :: [WidgetPlace]
    shrinkedRightRects = Dimension -> [WidgetPlace] -> [WidgetPlace]
    packRight (Rectangle -> Dimension
    rect_width Rectangle
    paddedDecoRect) ([WidgetPlace] -> [WidgetPlace]) -> [WidgetPlace] -> [WidgetPlace]
    forall a b. (a -> b) -> a -> b
    $ Dimension -> [(WidgetPlace, Bool)] -> [WidgetPlace]
    shrinkPlaces Dimension
    rightWidgetsWidth ([(WidgetPlace, Bool)] -> [WidgetPlace])
    -> [(WidgetPlace, Bool)] -> [WidgetPlace]
    forall a b. (a -> b) -> a -> b
    $ [WidgetPlace] -> [Bool] -> [(WidgetPlace, Bool)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [WidgetPlace]
    rightRects ((widget -> Bool) -> [widget] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map widget -> Bool
    forall widget. DecorationWidget widget => widget -> Bool
    isShrinkable [widget]
    rightWidgets)
            WidgetLayout WidgetPlace -> X (WidgetLayout WidgetPlace)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WidgetLayout WidgetPlace -> X (WidgetLayout WidgetPlace))
    -> WidgetLayout WidgetPlace -> X (WidgetLayout WidgetPlace)
    forall a b. (a -> b) -> a -> b
    $ [WidgetPlace]
    -> [WidgetPlace] -> [WidgetPlace] -> WidgetLayout WidgetPlace
    forall a. [a] -> [a] -> [a] -> WidgetLayout a
    WidgetLayout [WidgetPlace]
    shrinkedLeftRects [WidgetPlace]
    centerRects [WidgetPlace]
    shrinkedRightRects
          where
            shrinkPlaces :: Dimension -> [(WidgetPlace, Bool)] -> [WidgetPlace]
    shrinkPlaces Dimension
    targetWidth [(WidgetPlace, Bool)]
    ps =
              let nShrinkable :: Int
    nShrinkable = [(WidgetPlace, Bool)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (((WidgetPlace, Bool) -> Bool)
    -> [(WidgetPlace, Bool)] -> [(WidgetPlace, Bool)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (WidgetPlace, Bool) -> Bool
    forall a b. (a, b) -> b
    snd [(WidgetPlace, Bool)]
    ps)
                  totalUnshrinkedWidth :: Dimension
    totalUnshrinkedWidth = [Dimension] -> Dimension
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Dimension] -> Dimension) -> [Dimension] -> Dimension
    forall a b. (a -> b) -> a -> b
    $ ((WidgetPlace, Bool) -> Dimension)
    -> [(WidgetPlace, Bool)] -> [Dimension]
    forall a b. (a -> b) -> [a] -> [b]
    map (Rectangle -> Dimension
    rect_width (Rectangle -> Dimension)
    -> ((WidgetPlace, Bool) -> Rectangle)
    -> (WidgetPlace, Bool)
    -> Dimension
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WidgetPlace -> Rectangle
    wpRectangle (WidgetPlace -> Rectangle)
    -> ((WidgetPlace, Bool) -> WidgetPlace)
    -> (WidgetPlace, Bool)
    -> Rectangle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (WidgetPlace, Bool) -> WidgetPlace
    forall a b. (a, b) -> a
    fst) ([(WidgetPlace, Bool)] -> [Dimension])
    -> [(WidgetPlace, Bool)] -> [Dimension]
    forall a b. (a -> b) -> a -> b
    $ ((WidgetPlace, Bool) -> Bool)
    -> [(WidgetPlace, Bool)] -> [(WidgetPlace, Bool)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((WidgetPlace, Bool) -> Bool) -> (WidgetPlace, Bool) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (WidgetPlace, Bool) -> Bool
    forall a b. (a, b) -> b
    snd) [(WidgetPlace, Bool)]
    ps
                  shrinkedWidth :: Dimension
    shrinkedWidth = (Dimension
    targetWidth Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    totalUnshrinkedWidth) Dimension -> Dimension -> Dimension
    forall a. Integral a => a -> a -> a
    `div` Int -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    nShrinkable

                  resetX :: WidgetPlace -> WidgetPlace
    resetX WidgetPlace
    place = WidgetPlace
    place {wpRectangle = (wpRectangle place) {rect_x = 0}}

                  adjust :: (WidgetPlace, Bool) -> WidgetPlace
    adjust (WidgetPlace
    place, Bool
    True) = WidgetPlace -> WidgetPlace
    resetX (WidgetPlace -> WidgetPlace) -> WidgetPlace -> WidgetPlace
    forall a b. (a -> b) -> a -> b
    $ WidgetPlace
    place {wpRectangle = (wpRectangle place) {rect_width = shrinkedWidth}}
                  adjust (WidgetPlace
    place, Bool
    False) = WidgetPlace -> WidgetPlace
    resetX WidgetPlace
    place
              in  ((WidgetPlace, Bool) -> WidgetPlace)
    -> [(WidgetPlace, Bool)] -> [WidgetPlace]
    forall a b. (a -> b) -> [a] -> [b]
    map (WidgetPlace, Bool) -> WidgetPlace
    adjust [(WidgetPlace, Bool)]
    ps

            pad :: BoxBorders Dimension -> Rectangle -> Rectangle
    pad BoxBorders Dimension
    p (Rectangle Position
    _ Position
    _ Dimension
    w Dimension
    h) =
              Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (BoxBorders Dimension -> Dimension
    forall a. BoxBorders a -> a
    bxLeft BoxBorders Dimension
    p)) (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (BoxBorders Dimension -> Dimension
    forall a. BoxBorders a -> a
    bxTop BoxBorders Dimension
    p))
                        (Dimension
    w Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - BoxBorders Dimension -> Dimension
    forall a. BoxBorders a -> a
    bxLeft BoxBorders Dimension
    p Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - BoxBorders Dimension -> Dimension
    forall a. BoxBorders a -> a
    bxRight BoxBorders Dimension
    p)
                        (Dimension
    h Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - BoxBorders Dimension -> Dimension
    forall a. BoxBorders a -> a
    bxTop BoxBorders Dimension
    p Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - BoxBorders Dimension -> Dimension
    forall a. BoxBorders a -> a
    bxBottom BoxBorders Dimension
    p)

            padCenter :: Dimension -> Dimension -> Rectangle -> Rectangle
    padCenter Dimension
    left Dimension
    right (Rectangle Position
    x Position
    y Dimension
    w Dimension
    h) =
              Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (Position
    x Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    left) Position
    y
                        (Dimension
    w Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    left Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    right) Dimension
    h

        -- | Shrink window title so that it would fit in decoration.
        getShrinkedWindowName :: Shrinker shrinker
                              => engine widget a              -- ^ Decoration engine instance
                              -> shrinker                     -- ^ Strings shrinker
                              -> DecorationEngineState engine -- ^ State of decoration engine
                              -> String                       -- ^ Original window title
                              -> Dimension                    -- ^ Width of rectangle in which the title should fit
                              -> Dimension                    -- ^ Height of rectangle in which the title should fit
                              -> X String

        default getShrinkedWindowName :: (Shrinker shrinker, DecorationEngineState engine ~ XMonadFont)
                                      => engine widget a -> shrinker -> DecorationEngineState engine -> String -> Dimension -> Dimension -> X String
        getShrinkedWindowName engine widget a
    _ shrinker
    shrinker DecorationEngineState engine
    font String
    name Dimension
    wh Dimension
    _ = do
          let s :: String -> [String]
    s = shrinker -> String -> [String]
    forall s. Shrinker s => s -> String -> [String]
    shrinkIt shrinker
    shrinker
          Display
    dpy <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
          (String -> [String]) -> (String -> X Bool) -> String -> X String
    shrinkWhile String -> [String]
    s (\String
    n -> do Int
    size <- IO Int -> X Int
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Int -> X Int) -> IO Int -> X Int
    forall a b. (a -> b) -> a -> b
    $ Display -> XMonadFont -> String -> IO Int
    forall (m :: * -> *).
    MonadIO m =>
    Display -> XMonadFont -> String -> m Int
    textWidthXMF Display
    dpy XMonadFont
    DecorationEngineState engine
    font String
    n
                                  Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> X Bool) -> Bool -> X Bool
    forall a b. (a -> b) -> a -> b
    $ Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Dimension -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Dimension
    wh) String
    name

        -- | Mask of X11 events on which the decoration engine should do something.
        -- @exposureMask@ should be included here so that decoration engine could
        -- repaint decorations when they are shown on screen.
        -- @buttonPressMask@ should be included so that decoration engine could
        -- response to mouse clicks.
        -- Other events can be added to custom implementations of DecorationEngine.
        decorationXEventMask :: engine widget a -> EventMask
        decorationXEventMask engine widget a
    _ = Window
    exposureMask Window -> Window -> Window
    forall a. Bits a => a -> a -> a
    .|. Window
    buttonPressMask

        -- | List of X11 window property atoms of original (client) windows,
        -- change of which should trigger repainting of decoration.
        -- For example, if @WM_NAME@ changes it means that we have to redraw
        -- window title.
        propsToRepaintDecoration :: engine widget a -> X [Atom]
        propsToRepaintDecoration engine widget a
    _ =
          (String -> X Window) -> [String] -> X [Window]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM String -> X Window
    getAtom [String
    "WM_NAME", String
    "_NET_WM_NAME", String
    "WM_STATE", String
    "WM_HINTS"]

        -- | Generic event handler, which recieves X11 events on decoration
        -- window.
        -- Default implementation handles mouse clicks and drags.
        decorationEventHookEx :: Shrinker shrinker
                              => engine widget a
                              -> Theme engine widget
                              -> DecorationLayoutState engine
                              -> shrinker
                              -> Event
                              -> X ()
        decorationEventHookEx = engine widget a
    -> Theme engine widget
    -> DecorationLayoutState engine
    -> shrinker
    -> Event
    -> X ()
    forall (engine :: * -> * -> *) widget a shrinker.
    (DecorationEngine engine widget a, Shrinker shrinker) =>
    engine widget a
    -> Theme engine widget
    -> DecorationLayoutState engine
    -> shrinker
    -> Event
    -> X ()
    handleMouseFocusDrag

        -- | Event handler for clicks on decoration window.
        -- This is called from default implementation of "decorationEventHookEx".
        -- This should return True, if the click was handled (something happened
        -- because of that click). If this returns False, the click can be considered
        -- as a beginning of mouse drag.
        handleDecorationClick :: engine widget a      -- ^ Decoration engine instance
                              -> Theme engine widget  -- ^ Decoration theme
                              -> Rectangle            -- ^ Decoration rectangle
                              -> [Rectangle]          -- ^ Rectangles where widgets are placed
                              -> Window               -- ^ Original (client) window
                              -> Int                  -- ^ Mouse click X coordinate
                              -> Int                  -- ^ Mouse click Y coordinate
                              -> Int                  -- ^ Mouse button number
                              -> X Bool
        handleDecorationClick = engine widget a
    -> Theme engine widget
    -> Rectangle
    -> [Rectangle]
    -> Window
    -> Int
    -> Int
    -> Int
    -> X Bool
    forall (engine :: * -> * -> *) widget a.
    (DecorationEngine engine widget a,
     ClickHandler (Theme engine) widget) =>
    engine widget a
    -> Theme engine widget
    -> Rectangle
    -> [Rectangle]
    -> Window
    -> Int
    -> Int
    -> Int
    -> X Bool
    decorationHandler

        -- | Event handler which is called during mouse dragging.
        -- This is called from default implementation of "decorationEventHookEx".
        decorationWhileDraggingHook :: engine widget a      -- ^ Decoration engine instance
                                    -> CInt                 -- ^ Event X coordinate
                                    -> CInt                 -- ^ Event Y coordinate
                                    -> (Window, Rectangle)  -- ^ Original window and it's rectangle
                                    -> Position             -- ^ X coordinate of new pointer position during dragging
                                    -> Position             -- ^ Y coordinate of new pointer position during dragging
                                    -> X ()
        decorationWhileDraggingHook engine widget a
    _ = CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
    handleDraggingInProgress

        -- | This hoook is called after a window has been dragged using the decoration.
        -- This is called from default implementation of "decorationEventHookEx".
        decorationAfterDraggingHook :: engine widget a     -- ^ Decoration engine instance
                                    -> (Window, Rectangle) -- ^ Original window and its rectangle
                                    -> Window              -- ^ Decoration window
                                    -> X ()
        decorationAfterDraggingHook engine widget a
    _ds (Window
    w, Rectangle
    _r) Window
    decoWin = do
          Window -> X ()
    focus Window
    w
          Bool
    hasCrossed <- Window -> Window -> X Bool
    handleScreenCrossing Window
    w Window
    decoWin
          Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    hasCrossed (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
            DraggingVisualizerMsg -> X ()
    forall a. Message a => a -> X ()
    sendMessage DraggingVisualizerMsg
    DraggingStopped
            Window -> X ()
    performWindowSwitching Window
    w

        -- | Draw everything required on the decoration window.
        -- This method should draw background (flat or gradient or whatever),
        -- borders, and call @paintWidget@ method to draw window widgets
        -- (buttons and title).
        paintDecoration :: Shrinker shrinker
                        => engine widget a         -- ^ Decoration engine instance
                        -> a                       -- ^ Decoration window
                        -> Dimension               -- ^ Decoration window width
                        -> Dimension               -- ^ Decoration window height
                        -> shrinker                -- ^ Strings shrinker instance
                        -> DrawData engine widget  -- ^ Details about what to draw
                        -> Bool                    -- ^ True when this method is called during Expose event
                        -> X ()

        -- | Paint one widget on the decoration window.
        paintWidget :: Shrinker shrinker
                    => engine widget a                  -- ^ Decoration engine instance
                    -> DecorationPaintingContext engine -- ^ Decoration painting context
                    -> WidgetPlace                      -- ^ Place (rectangle) where the widget should be drawn
                    -> shrinker                         -- ^ Strings shrinker instance
                    -> DrawData engine widget           -- ^ Details about window decoration
                    -> widget                           -- ^ Widget to be drawn
                    -> Bool                             -- ^ True when this method is called during Expose event
                    -> X ()

    handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
    handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
    handleDraggingInProgress CInt
    ex CInt
    ey (Window
    mainw, Rectangle
    r) Position
    x Position
    y = do
        let rect :: Rectangle
    rect = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (Position
    x Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    ex Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Rectangle -> Position
    rect_x Rectangle
    r))
                             (Position
    y Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    ey Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Rectangle -> Position
    rect_y Rectangle
    r))
                             (Rectangle -> Dimension
    rect_width  Rectangle
    r)
                             (Rectangle -> Dimension
    rect_height Rectangle
    r)
        DraggingVisualizerMsg -> X ()
    forall a. Message a => a -> X ()
    sendMessage (DraggingVisualizerMsg -> X ()) -> DraggingVisualizerMsg -> X ()
    forall a b. (a -> b) -> a -> b
    $ Window -> Rectangle -> DraggingVisualizerMsg
    DraggingWindow Window
    mainw Rectangle
    rect

    performWindowSwitching :: Window -> X ()
    performWindowSwitching :: Window -> X ()
    performWindowSwitching Window
    win =
        (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> do
           Window
    root <- (XConf -> Window) -> X Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Window
    theRoot
           (Bool
    _, Window
    _, Window
    selWin, CInt
    _, CInt
    _, CInt
    _, CInt
    _, Modifier
    _) <- IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
     -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
    -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Window
    -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    queryPointer Display
    d Window
    root
           WindowSet
    ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
           let allWindows :: [Window]
    allWindows = WindowSet -> [Window]
    forall i l a s sd. StackSet i l a s sd -> [a]
    W.index WindowSet
    ws
           -- do a little double check to be sure
           Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((Window
    win Window -> [Window] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Window]
    allWindows) Bool -> Bool -> Bool
    && (Window
    selWin Window -> [Window] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Window]
    allWindows)) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
                    let allWindowsSwitched :: [Window]
    allWindowsSwitched = (Window -> Window) -> [Window] -> [Window]
    forall a b. (a -> b) -> [a] -> [b]
    map (Window -> Window -> Window -> Window
    forall {a}. Eq a => a -> a -> a -> a
    switchEntries Window
    win Window
    selWin) [Window]
    allWindows
                    let ([Window]
    ls, [Window] -> NonEmpty Window
    forall a. HasCallStack => [a] -> NonEmpty a
    notEmpty -> Window
    t :| [Window]
    rs) = (Window -> Bool) -> [Window] -> ([Window], [Window])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Window
    win Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) [Window]
    allWindowsSwitched
                    let newStack :: Stack Window
    newStack = Window -> [Window] -> [Window] -> Stack Window
    forall a. a -> [a] -> [a] -> Stack a
    W.Stack Window
    t ([Window] -> [Window]
    forall a. [a] -> [a]
    reverse [Window]
    ls) [Window]
    rs
                    (WindowSet -> WindowSet) -> X ()
    windows ((WindowSet -> WindowSet) -> X ())
    -> (WindowSet -> WindowSet) -> X ()
    forall a b. (a -> b) -> a -> b
    $ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
    forall a i l s sd.
    (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
    W.modify' ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
    -> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
    forall a b. (a -> b) -> a -> b
    $ Stack Window -> Stack Window -> Stack Window
    forall a b. a -> b -> a
    const Stack Window
    newStack
        where
            switchEntries :: a -> a -> a -> a
    switchEntries a
    a a
    b a
    x
                | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    a    = a
    b
                | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    b    = a
    a
                | Bool
    otherwise = a
    x

    ignoreX :: WidgetPlace -> WidgetPlace
    ignoreX :: WidgetPlace -> WidgetPlace
    ignoreX WidgetPlace
    place = WidgetPlace
    place {wpRectangle = (wpRectangle place) {rect_x = 0}}

    alignLeft :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    alignLeft :: forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a
    -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    alignLeft engine widget a
    engine DrawData engine widget
    dd [widget]
    widgets = do
        [WidgetPlace]
    places <- (widget -> X WidgetPlace) -> [widget] -> X [WidgetPlace]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (engine widget a
    -> DrawData engine widget -> widget -> X WidgetPlace
    forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a
    -> DrawData engine widget -> widget -> X WidgetPlace
    calcWidgetPlace engine widget a
    engine DrawData engine widget
    dd) [widget]
    widgets
        [WidgetPlace] -> X [WidgetPlace]
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([WidgetPlace] -> X [WidgetPlace])
    -> [WidgetPlace] -> X [WidgetPlace]
    forall a b. (a -> b) -> a -> b
    $ Position -> [WidgetPlace] -> [WidgetPlace]
    packLeft (Rectangle -> Position
    rect_x (Rectangle -> Position) -> Rectangle -> Position
    forall a b. (a -> b) -> a -> b
    $ DrawData engine widget -> Rectangle
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> Rectangle
    ddDecoRect DrawData engine widget
    dd) ([WidgetPlace] -> [WidgetPlace]) -> [WidgetPlace] -> [WidgetPlace]
    forall a b. (a -> b) -> a -> b
    $ (WidgetPlace -> WidgetPlace) -> [WidgetPlace] -> [WidgetPlace]
    forall a b. (a -> b) -> [a] -> [b]
    map WidgetPlace -> WidgetPlace
    ignoreX [WidgetPlace]
    places

    packLeft :: Position -> [WidgetPlace] -> [WidgetPlace]
    packLeft :: Position -> [WidgetPlace] -> [WidgetPlace]
    packLeft Position
    _ [] = []
    packLeft Position
    x0 (WidgetPlace
    place : [WidgetPlace]
    places) =
      let rect :: Rectangle
    rect = WidgetPlace -> Rectangle
    wpRectangle WidgetPlace
    place
          x' :: Position
    x' = Position
    x0 Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Rectangle -> Position
    rect_x Rectangle
    rect
          rect' :: Rectangle
    rect' = Rectangle
    rect {rect_x = x'}
          place' :: WidgetPlace
    place' = WidgetPlace
    place {wpRectangle = rect'}
      in  WidgetPlace
    place' WidgetPlace -> [WidgetPlace] -> [WidgetPlace]
    forall a. a -> [a] -> [a]
    : Position -> [WidgetPlace] -> [WidgetPlace]
    packLeft (Position
    x' Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (Rectangle -> Dimension
    rect_width Rectangle
    rect)) [WidgetPlace]
    places

    alignRight :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    alignRight :: forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a
    -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    alignRight engine widget a
    engine DrawData engine widget
    dd [widget]
    widgets = do
        [WidgetPlace]
    places <- (widget -> X WidgetPlace) -> [widget] -> X [WidgetPlace]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (engine widget a
    -> DrawData engine widget -> widget -> X WidgetPlace
    forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a
    -> DrawData engine widget -> widget -> X WidgetPlace
    calcWidgetPlace engine widget a
    engine DrawData engine widget
    dd) [widget]
    widgets
        [WidgetPlace] -> X [WidgetPlace]
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([WidgetPlace] -> X [WidgetPlace])
    -> [WidgetPlace] -> X [WidgetPlace]
    forall a b. (a -> b) -> a -> b
    $ Dimension -> [WidgetPlace] -> [WidgetPlace]
    packRight (Rectangle -> Dimension
    rect_width (Rectangle -> Dimension) -> Rectangle -> Dimension
    forall a b. (a -> b) -> a -> b
    $ DrawData engine widget -> Rectangle
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> Rectangle
    ddDecoRect DrawData engine widget
    dd) ([WidgetPlace] -> [WidgetPlace]) -> [WidgetPlace] -> [WidgetPlace]
    forall a b. (a -> b) -> a -> b
    $ (WidgetPlace -> WidgetPlace) -> [WidgetPlace] -> [WidgetPlace]
    forall a b. (a -> b) -> [a] -> [b]
    map WidgetPlace -> WidgetPlace
    ignoreX [WidgetPlace]
    places

    packRight :: Dimension -> [WidgetPlace] -> [WidgetPlace]
    packRight :: Dimension -> [WidgetPlace] -> [WidgetPlace]
    packRight Dimension
    x0 [WidgetPlace]
    places = [WidgetPlace] -> [WidgetPlace]
    forall a. [a] -> [a]
    reverse ([WidgetPlace] -> [WidgetPlace]) -> [WidgetPlace] -> [WidgetPlace]
    forall a b. (a -> b) -> a -> b
    $ Dimension -> [WidgetPlace] -> [WidgetPlace]
    go Dimension
    x0 [WidgetPlace]
    places
      where
        go :: Dimension -> [WidgetPlace] -> [WidgetPlace]
    go Dimension
    _ [] = []
        go Dimension
    x (WidgetPlace
    place : [WidgetPlace]
    rest) =
          let rect :: Rectangle
    rect = WidgetPlace -> Rectangle
    wpRectangle WidgetPlace
    place
              x' :: Dimension
    x' = Dimension
    x Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Rectangle -> Dimension
    rect_width Rectangle
    rect
              rect' :: Rectangle
    rect' = Rectangle
    rect {rect_x = fi x'}
              place' :: WidgetPlace
    place' = WidgetPlace
    place {wpRectangle = rect'}
          in  WidgetPlace
    place' WidgetPlace -> [WidgetPlace] -> [WidgetPlace]
    forall a. a -> [a] -> [a]
    : Dimension -> [WidgetPlace] -> [WidgetPlace]
    go Dimension
    x' [WidgetPlace]
    rest

    alignCenter :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    alignCenter :: forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a
    -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    alignCenter engine widget a
    engine DrawData engine widget
    dd [widget]
    widgets = do
        [WidgetPlace]
    places <- engine widget a
    -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a
    -> DrawData engine widget -> [widget] -> X [WidgetPlace]
    alignLeft engine widget a
    engine DrawData engine widget
    dd [widget]
    widgets
        let totalWidth :: Dimension
    totalWidth = [Dimension] -> Dimension
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Dimension] -> Dimension) -> [Dimension] -> Dimension
    forall a b. (a -> b) -> a -> b
    $ (WidgetPlace -> Dimension) -> [WidgetPlace] -> [Dimension]
    forall a b. (a -> b) -> [a] -> [b]
    map (Rectangle -> Dimension
    rect_width (Rectangle -> Dimension)
    -> (WidgetPlace -> Rectangle) -> WidgetPlace -> Dimension
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WidgetPlace -> Rectangle
    wpRectangle) [WidgetPlace]
    places
            availableWidth :: Position
    availableWidth = Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (Rectangle -> Dimension
    rect_width (DrawData engine widget -> Rectangle
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> Rectangle
    ddDecoRect DrawData engine widget
    dd)) :: Position
            x0 :: Position
    x0 = Position -> Position -> Position
    forall a. Ord a => a -> a -> a
    max Position
    0 (Position -> Position) -> Position -> Position
    forall a b. (a -> b) -> a -> b
    $ (Position
    availableWidth Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    totalWidth) Position -> Position -> Position
    forall a. Integral a => a -> a -> a
    `div` Position
    2
            places' :: [WidgetPlace]
    places' = (WidgetPlace -> WidgetPlace) -> [WidgetPlace] -> [WidgetPlace]
    forall a b. (a -> b) -> [a] -> [b]
    map (Position -> WidgetPlace -> WidgetPlace
    forall {a}. Integral a => a -> WidgetPlace -> WidgetPlace
    shift Position
    x0) [WidgetPlace]
    places
        [WidgetPlace] -> X [WidgetPlace]
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([WidgetPlace] -> X [WidgetPlace])
    -> [WidgetPlace] -> X [WidgetPlace]
    forall a b. (a -> b) -> a -> b
    $ Dimension -> [WidgetPlace] -> [WidgetPlace]
    pack (Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    availableWidth) [WidgetPlace]
    places'
      where
        shift :: a -> WidgetPlace -> WidgetPlace
    shift a
    x0 WidgetPlace
    place =
          let rect :: Rectangle
    rect = WidgetPlace -> Rectangle
    wpRectangle WidgetPlace
    place
              rect' :: Rectangle
    rect' = Rectangle
    rect {rect_x = rect_x rect + fi x0}
          in  WidgetPlace
    place {wpRectangle = rect'}

        pack :: Dimension -> [WidgetPlace] -> [WidgetPlace]
    pack Dimension
    _ [] = []
        pack Dimension
    available (WidgetPlace
    place : [WidgetPlace]
    places) =
          let rect :: Rectangle
    rect = WidgetPlace -> Rectangle
    wpRectangle WidgetPlace
    place
              placeWidth :: Dimension
    placeWidth = Rectangle -> Dimension
    rect_width Rectangle
    rect
              widthToUse :: Dimension
    widthToUse = Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    min Dimension
    available Dimension
    placeWidth
              remaining :: Dimension
    remaining = Dimension
    available Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    widthToUse
              rect' :: Rectangle
    rect' = Rectangle
    rect {rect_width = widthToUse}
              place' :: WidgetPlace
    place' = WidgetPlace
    place {wpRectangle = rect'}
          in  WidgetPlace
    place' WidgetPlace -> [WidgetPlace] -> [WidgetPlace]
    forall a. a -> [a] -> [a]
    : Dimension -> [WidgetPlace] -> [WidgetPlace]
    pack Dimension
    remaining [WidgetPlace]
    places

    -- | Build an instance of 'DrawData' type.
    mkDrawData :: (DecorationEngine engine widget a, ThemeAttributes (Theme engine widget), HasWidgets (Theme engine) widget)
               => engine widget a
               -> Theme engine widget            -- ^ Decoration theme
               -> DecorationEngineState engine   -- ^ State of decoration engine
               -> Window                         -- ^ Original window (to be decorated)
               -> Rectangle                      -- ^ Decoration rectangle
               -> X (DrawData engine widget)
    mkDrawData :: forall (engine :: * -> * -> *) widget a.
    (DecorationEngine engine widget a,
     ThemeAttributes (Theme engine widget),
     HasWidgets (Theme engine) widget) =>
    engine widget a
    -> Theme engine widget
    -> DecorationEngineState engine
    -> Window
    -> Rectangle
    -> X (DrawData engine widget)
    mkDrawData engine widget a
    _ Theme engine widget
    theme DecorationEngineState engine
    decoState Window
    origWindow Rectangle
    decoRect = do
        -- xmonad-contrib #809
        -- qutebrowser will happily shovel a 389K multiline string into @_NET_WM_NAME@
        -- and the 'defaultShrinker' (a) doesn't handle multiline strings well (b) is
        -- quadratic due to using 'init'
        String
    name  <- (NamedWindow -> String) -> X NamedWindow -> X String
    forall a b. (a -> b) -> X a -> X b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    2048 (String -> String)
    -> (NamedWindow -> String) -> NamedWindow -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n') (String -> String)
    -> (NamedWindow -> String) -> NamedWindow -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedWindow -> String
    forall a. Show a => a -> String
    show) (Window -> X NamedWindow
    getName Window
    origWindow)
        Style (Theme engine widget)
    style <- Theme engine widget -> Window -> X (Style (Theme engine widget))
    forall theme.
    ThemeAttributes theme =>
    theme -> Window -> X (Style theme)
    selectWindowStyle Theme engine widget
    theme Window
    origWindow
        DrawData engine widget -> X (DrawData engine widget)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DrawData engine widget -> X (DrawData engine widget))
    -> DrawData engine widget -> X (DrawData engine widget)
    forall a b. (a -> b) -> a -> b
    $ DrawData {
                       ddEngineState :: DecorationEngineState engine
    ddEngineState = DecorationEngineState engine
    decoState,
                       ddStyle :: Style (Theme engine widget)
    ddStyle = Style (Theme engine widget)
    style,
                       ddOrigWindow :: Window
    ddOrigWindow = Window
    origWindow,
                       ddWindowTitle :: String
    ddWindowTitle = String
    name,
                       ddDecoRect :: Rectangle
    ddDecoRect = Rectangle
    decoRect,
                       ddWidgets :: WidgetLayout widget
    ddWidgets = Theme engine widget -> WidgetLayout widget
    forall (theme :: * -> *) widget.
    HasWidgets theme widget =>
    theme widget -> WidgetLayout widget
    themeWidgets Theme engine widget
    theme,
                       ddWidgetPlaces :: WidgetLayout WidgetPlace
    ddWidgetPlaces = [WidgetPlace]
    -> [WidgetPlace] -> [WidgetPlace] -> WidgetLayout WidgetPlace
    forall a. [a] -> [a] -> [a] -> WidgetLayout a
    WidgetLayout [] [] []
                      }

    -- | Mouse focus and mouse drag are handled by the same function, this
    -- way we can start dragging unfocused windows too.
    handleMouseFocusDrag :: (DecorationEngine engine widget a, Shrinker shrinker) => engine widget a -> Theme engine widget -> DecorationLayoutState engine -> shrinker -> Event -> X ()
    handleMouseFocusDrag :: forall (engine :: * -> * -> *) widget a shrinker.
    (DecorationEngine engine widget a, Shrinker shrinker) =>
    engine widget a
    -> Theme engine widget
    -> DecorationLayoutState engine
    -> shrinker
    -> Event
    -> X ()
    handleMouseFocusDrag engine widget a
    ds Theme engine widget
    theme (DecorationLayoutState {[WindowDecoration]
    dsDecorations :: forall (engine :: * -> * -> *).
    DecorationLayoutState engine -> [WindowDecoration]
    dsDecorations :: [WindowDecoration]
    dsDecorations}) shrinker
    _ (ButtonEvent {Window
    ev_window :: Window
    ev_window :: Event -> Window
    ev_window, CInt
    ev_x_root :: CInt
    ev_x_root :: Event -> CInt
    ev_x_root, CInt
    ev_y_root :: CInt
    ev_y_root :: Event -> CInt
    ev_y_root, Dimension
    ev_event_type :: Dimension
    ev_event_type :: Event -> Dimension
    ev_event_type, Dimension
    ev_button :: Dimension
    ev_button :: Event -> Dimension
    ev_button})
        | Dimension
    ev_event_type Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    buttonPress
        , Just (WindowDecoration {[WidgetPlace]
    Maybe Window
    Maybe Rectangle
    Window
    Rectangle
    wdOrigWindow :: Window
    wdOrigWinRect :: Rectangle
    wdDecoWindow :: Maybe Window
    wdDecoRect :: Maybe Rectangle
    wdWidgets :: [WidgetPlace]
    wdOrigWindow :: WindowDecoration -> Window
    wdOrigWinRect :: WindowDecoration -> Rectangle
    wdDecoWindow :: WindowDecoration -> Maybe Window
    wdDecoRect :: WindowDecoration -> Maybe Rectangle
    wdWidgets :: WindowDecoration -> [WidgetPlace]
    ..}) <- Window -> [WindowDecoration] -> Maybe WindowDecoration
    findDecoDataByDecoWindow Window
    ev_window [WindowDecoration]
    dsDecorations = do
            let decoRect :: Rectangle
    decoRect@(Rectangle Position
    dx Position
    dy Dimension
    _ Dimension
    _) = Maybe Rectangle -> Rectangle
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe Rectangle
    wdDecoRect
                x :: Int
    x = CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi (CInt -> Int) -> CInt -> Int
    forall a b. (a -> b) -> a -> b
    $ CInt
    ev_x_root CInt -> CInt -> CInt
    forall a. Num a => a -> a -> a
    - Position -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    dx
                y :: Int
    y = CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi (CInt -> Int) -> CInt -> Int
    forall a b. (a -> b) -> a -> b
    $ CInt
    ev_y_root CInt -> CInt -> CInt
    forall a. Num a => a -> a -> a
    - Position -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    dy
                button :: Int
    button = Dimension -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    ev_button
            Bool
    dealtWith <- engine widget a
    -> Theme engine widget
    -> Rectangle
    -> [Rectangle]
    -> Window
    -> Int
    -> Int
    -> Int
    -> X Bool
    forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a
    -> Theme engine widget
    -> Rectangle
    -> [Rectangle]
    -> Window
    -> Int
    -> Int
    -> Int
    -> X Bool
    handleDecorationClick engine widget a
    ds Theme engine widget
    theme Rectangle
    decoRect ((WidgetPlace -> Rectangle) -> [WidgetPlace] -> [Rectangle]
    forall a b. (a -> b) -> [a] -> [b]
    map WidgetPlace -> Rectangle
    wpRectangle [WidgetPlace]
    wdWidgets) Window
    wdOrigWindow Int
    x Int
    y Int
    button
            Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    dealtWith (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Theme engine widget -> Int -> Bool
    forall (theme :: * -> *) widget.
    ClickHandler theme widget =>
    theme widget -> Int -> Bool
    isDraggingEnabled Theme engine widget
    theme Int
    button) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $
                (Position -> Position -> X ()) -> X () -> X ()
    mouseDrag (\Position
    dragX Position
    dragY -> Window -> X ()
    focus Window
    wdOrigWindow X () -> X () -> X ()
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> engine widget a
    -> CInt
    -> CInt
    -> (Window, Rectangle)
    -> Position
    -> Position
    -> X ()
    forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a
    -> CInt
    -> CInt
    -> (Window, Rectangle)
    -> Position
    -> Position
    -> X ()
    decorationWhileDraggingHook engine widget a
    ds CInt
    ev_x_root CInt
    ev_y_root (Window
    wdOrigWindow, Rectangle
    wdOrigWinRect) Position
    dragX Position
    dragY)
                          (engine widget a -> (Window, Rectangle) -> Window -> X ()
    forall (engine :: * -> * -> *) widget a.
    DecorationEngine engine widget a =>
    engine widget a -> (Window, Rectangle) -> Window -> X ()
    decorationAfterDraggingHook engine widget a
    ds (Window
    wdOrigWindow, Rectangle
    wdOrigWinRect) Window
    ev_window)
    handleMouseFocusDrag engine widget a
    _ Theme engine widget
    _ DecorationLayoutState engine
    _ shrinker
    _ Event
    _ = () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Given a window and the state, if a matching decoration is in the
    -- state return it with its ('Maybe') 'Rectangle'.
    findDecoDataByDecoWindow :: Window -> [WindowDecoration] -> Maybe WindowDecoration
    findDecoDataByDecoWindow :: Window -> [WindowDecoration] -> Maybe WindowDecoration
    findDecoDataByDecoWindow Window
    decoWin = (WindowDecoration -> Bool)
    -> [WindowDecoration] -> Maybe WindowDecoration
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (\WindowDecoration
    dd -> WindowDecoration -> Maybe Window
    wdDecoWindow WindowDecoration
    dd Maybe Window -> Maybe Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    decoWin)

    decorationHandler :: forall engine widget a.
                         (DecorationEngine engine widget a,
                          ClickHandler (Theme engine) widget)
                      => engine widget a
                      -> Theme engine widget
                      -> Rectangle
                      -> [Rectangle]
                      -> Window
                      -> Int
                      -> Int
                      -> Int
                      -> X Bool
    decorationHandler :: forall (engine :: * -> * -> *) widget a.
    (DecorationEngine engine widget a,
     ClickHandler (Theme engine) widget) =>
    engine widget a
    -> Theme engine widget
    -> Rectangle
    -> [Rectangle]
    -> Window
    -> Int
    -> Int
    -> Int
    -> X Bool
    decorationHandler engine widget a
    _ Theme engine widget
    theme Rectangle
    _ [Rectangle]
    widgetPlaces Window
    window Int
    x Int
    y Int
    button = do
        Bool
    widgetDone <- [(widget, Rectangle)] -> X Bool
    go ([(widget, Rectangle)] -> X Bool)
    -> [(widget, Rectangle)] -> X Bool
    forall a b. (a -> b) -> a -> b
    $ [widget] -> [Rectangle] -> [(widget, Rectangle)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (WidgetLayout widget -> [widget]
    forall a. WidgetLayout a -> [a]
    widgetLayout (WidgetLayout widget -> [widget])
    -> WidgetLayout widget -> [widget]
    forall a b. (a -> b) -> a -> b
    $ Theme engine widget -> WidgetLayout widget
    forall (theme :: * -> *) widget.
    HasWidgets theme widget =>
    theme widget -> WidgetLayout widget
    themeWidgets Theme engine widget
    theme) [Rectangle]
    widgetPlaces
        if Bool
    widgetDone
          then Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
          else case Theme engine widget -> Int -> Maybe (WidgetCommand widget)
    forall (theme :: * -> *) widget.
    ClickHandler theme widget =>
    theme widget -> Int -> Maybe (WidgetCommand widget)
    onDecorationClick Theme engine widget
    theme Int
    button of
                 Just WidgetCommand widget
    cmd -> do
                   WidgetCommand widget -> Window -> X Bool
    forall cmd. WindowCommand cmd => cmd -> Window -> X Bool
    executeWindowCommand WidgetCommand widget
    cmd Window
    window
                 Maybe (WidgetCommand widget)
    Nothing -> Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      where
        go :: [(widget, Rectangle)] -> X Bool
        go :: [(widget, Rectangle)] -> X Bool
    go [] = Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        go ((widget
    w, Rectangle
    rect) : [(widget, Rectangle)]
    rest) = do
          if Position -> Position -> Rectangle -> Bool
    pointWithin (Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    x) (Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    y) Rectangle
    rect
            then do
              WidgetCommand widget -> Window -> X Bool
    forall cmd. WindowCommand cmd => cmd -> Window -> X Bool
    executeWindowCommand (widget -> Int -> WidgetCommand widget
    forall widget.
    DecorationWidget widget =>
    widget -> Int -> WidgetCommand widget
    widgetCommand widget
    w Int
    button) Window
    window
            else [(widget, Rectangle)] -> X Bool
    go [(widget, Rectangle)]
    rest

    -- | Simple implementation of @paintDecoration@ method.
    -- This is used by @TextEngine@ and can be re-used by other decoration
    -- engines.
    paintDecorationSimple :: forall engine shrinker widget.
                              (DecorationEngine engine widget Window,
                               DecorationPaintingContext engine ~ XPaintingContext,
                               Shrinker shrinker,
                               Style (Theme engine widget) ~ SimpleStyle)
                           => engine widget Window
                           -> Window
                           -> Dimension
                           -> Dimension
                           -> shrinker
                           -> DrawData engine widget
                           -> Bool
                           -> X ()
    paintDecorationSimple :: forall (engine :: * -> * -> *) shrinker widget.
    (DecorationEngine engine widget Window,
     DecorationPaintingContext engine ~ XPaintingContext,
     Shrinker shrinker, Style (Theme engine widget) ~ SimpleStyle) =>
    engine widget Window
    -> Window
    -> Dimension
    -> Dimension
    -> shrinker
    -> DrawData engine widget
    -> Bool
    -> X ()
    paintDecorationSimple engine widget Window
    deco Window
    win Dimension
    windowWidth Dimension
    windowHeight shrinker
    shrinker DrawData engine widget
    dd Bool
    isExpose = do
        Display
    dpy <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
        let widgets :: [widget]
    widgets = WidgetLayout widget -> [widget]
    forall a. WidgetLayout a -> [a]
    widgetLayout (WidgetLayout widget -> [widget])
    -> WidgetLayout widget -> [widget]
    forall a b. (a -> b) -> a -> b
    $ DrawData engine widget -> WidgetLayout widget
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> WidgetLayout widget
    ddWidgets DrawData engine widget
    dd
            style :: Style (Theme engine widget)
    style = DrawData engine widget -> Style (Theme engine widget)
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> Style (Theme engine widget)
    ddStyle DrawData engine widget
    dd
        Window
    pixmap  <- IO Window -> X Window
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Window -> X Window) -> IO Window -> X Window
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> Dimension -> Dimension -> CInt -> IO Window
    createPixmap Display
    dpy Window
    win Dimension
    windowWidth Dimension
    windowHeight (Screen -> CInt
    defaultDepthOfScreen (Screen -> CInt) -> Screen -> CInt
    forall a b. (a -> b) -> a -> b
    $ Display -> Screen
    defaultScreenOfDisplay Display
    dpy)
        GC
    gc <- IO GC -> X GC
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO GC -> X GC) -> IO GC -> X GC
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> IO GC
    createGC Display
    dpy Window
    pixmap
        -- draw
        IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display -> GC -> Bool -> IO ()
    setGraphicsExposures Display
    dpy GC
    gc Bool
    False
        Window
    bgColor <- Display -> String -> X Window
    forall (m :: * -> *).
    (Functor m, MonadIO m) =>
    Display -> String -> m Window
    stringToPixel Display
    dpy (SimpleStyle -> String
    sBgColor Style (Theme engine widget)
    SimpleStyle
    style)
        -- we start with the border
        let borderWidth :: Dimension
    borderWidth = SimpleStyle -> Dimension
    sDecoBorderWidth Style (Theme engine widget)
    SimpleStyle
    style
            borderColors :: BorderColors
    borderColors = SimpleStyle -> BorderColors
    sDecorationBorders Style (Theme engine widget)
    SimpleStyle
    style
        Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Dimension
    borderWidth Dimension -> Dimension -> Bool
    forall a. Ord a => a -> a -> Bool
    > Dimension
    0) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
          Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> String
    -> X ()
    forall {m :: * -> *}.
    MonadIO m =>
    Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> String
    -> m ()
    drawLineWith Display
    dpy Window
    pixmap GC
    gc Position
    0 Position
    0 Dimension
    windowWidth Dimension
    borderWidth (BorderColors -> String
    forall a. BoxBorders a -> a
    bxTop BorderColors
    borderColors)
          Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> String
    -> X ()
    forall {m :: * -> *}.
    MonadIO m =>
    Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> String
    -> m ()
    drawLineWith Display
    dpy Window
    pixmap GC
    gc Position
    0 Position
    0 Dimension
    borderWidth Dimension
    windowHeight (BorderColors -> String
    forall a. BoxBorders a -> a
    bxLeft BorderColors
    borderColors)
          Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> String
    -> X ()
    forall {m :: * -> *}.
    MonadIO m =>
    Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> String
    -> m ()
    drawLineWith Display
    dpy Window
    pixmap GC
    gc Position
    0 (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (Dimension
    windowHeight Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    borderWidth)) Dimension
    windowWidth Dimension
    borderWidth (BorderColors -> String
    forall a. BoxBorders a -> a
    bxBottom BorderColors
    borderColors)
          Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> String
    -> X ()
    forall {m :: * -> *}.
    MonadIO m =>
    Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> String
    -> m ()
    drawLineWith Display
    dpy Window
    pixmap GC
    gc (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (Dimension
    windowWidth Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    borderWidth)) Position
    0 Dimension
    borderWidth Dimension
    windowHeight (BorderColors -> String
    forall a. BoxBorders a -> a
    bxRight BorderColors
    borderColors)

        -- and now again
        IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display -> GC -> Window -> IO ()
    setForeground Display
    dpy GC
    gc Window
    bgColor
        IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO ()
    fillRectangle Display
    dpy Window
    pixmap GC
    gc (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    borderWidth) (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    borderWidth) (Dimension
    windowWidth Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - (Dimension
    borderWidth Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    * Dimension
    2)) (Dimension
    windowHeight Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - (Dimension
    borderWidth Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    * Dimension
    2))

        -- paint strings
        [(widget, WidgetPlace)] -> ((widget, WidgetPlace) -> X ()) -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([widget] -> [WidgetPlace] -> [(widget, WidgetPlace)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [widget]
    widgets ([WidgetPlace] -> [(widget, WidgetPlace)])
    -> [WidgetPlace] -> [(widget, WidgetPlace)]
    forall a b. (a -> b) -> a -> b
    $ WidgetLayout WidgetPlace -> [WidgetPlace]
    forall a. WidgetLayout a -> [a]
    widgetLayout (WidgetLayout WidgetPlace -> [WidgetPlace])
    -> WidgetLayout WidgetPlace -> [WidgetPlace]
    forall a b. (a -> b) -> a -> b
    $ DrawData engine widget -> WidgetLayout WidgetPlace
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> WidgetLayout WidgetPlace
    ddWidgetPlaces DrawData engine widget
    dd) (((widget, WidgetPlace) -> X ()) -> X ())
    -> ((widget, WidgetPlace) -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \(widget
    widget, WidgetPlace
    place) ->
            engine widget Window
    -> DecorationPaintingContext engine
    -> WidgetPlace
    -> shrinker
    -> DrawData engine widget
    -> widget
    -> Bool
    -> X ()
    forall shrinker.
    Shrinker shrinker =>
    engine widget Window
    -> DecorationPaintingContext engine
    -> WidgetPlace
    -> shrinker
    -> DrawData engine widget
    -> widget
    -> Bool
    -> X ()
    forall (engine :: * -> * -> *) widget a shrinker.
    (DecorationEngine engine widget a, Shrinker shrinker) =>
    engine widget a
    -> DecorationPaintingContext engine
    -> WidgetPlace
    -> shrinker
    -> DrawData engine widget
    -> widget
    -> Bool
    -> X ()
    paintWidget engine widget Window
    deco (Display
    dpy, Window
    pixmap, GC
    gc) WidgetPlace
    place shrinker
    shrinker DrawData engine widget
    dd widget
    widget Bool
    isExpose

        -- debug
        -- black <- stringToPixel dpy "black"
        -- io $ setForeground dpy gc black
        -- forM_ (ddWidgetPlaces dd) $ \(WidgetPlace {wpRectangle = Rectangle x y w h}) ->
        --   io $ drawRectangle dpy pixmap gc x y w h

        -- copy the pixmap over the window
        IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Window
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> Position
    -> Position
    -> IO ()
    copyArea      Display
    dpy Window
    pixmap Window
    win GC
    gc Position
    0 Position
    0 Dimension
    windowWidth Dimension
    windowHeight Position
    0 Position
    0
        -- free the pixmap and GC
        IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> IO ()
    freePixmap    Display
    dpy Window
    pixmap
        IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display -> GC -> IO ()
    freeGC        Display
    dpy GC
    gc
      where
        drawLineWith :: Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> String
    -> m ()
    drawLineWith Display
    dpy Window
    pixmap GC
    gc Position
    x Position
    y Dimension
    w Dimension
    h String
    colorName = do
          Window
    color <- Display -> String -> m Window
    forall (m :: * -> *).
    (Functor m, MonadIO m) =>
    Display -> String -> m Window
    stringToPixel Display
    dpy String
    colorName
          IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Display -> GC -> Window -> IO ()
    setForeground Display
    dpy GC
    gc Window
    color
          IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO ()
    fillRectangle Display
    dpy Window
    pixmap GC
    gc Position
    x Position
    y Dimension
    w Dimension
    h