    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE MultiParamTypeClasses #-}

    ----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Main
    -- Copyright   :  (c) Spencer Janssen 2007
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  spencerjanssen@gmail.com
    -- Stability   :  unstable
    -- Portability :  not portable, uses mtl, X11, posix
    --
    -- xmonad, a minimalist, tiling window manager for X11
    --
    -----------------------------------------------------------------------------

    module XMonad.Main (xmonad, buildLaunch, launch) where

    import System.Locale.SetLocale
    import qualified Control.Exception as E
    import Data.Bits
    import Data.List ((\\))
    import Data.Foldable (traverse_)
    import qualified Data.Map as M
    import qualified Data.Set as S
    import Control.Monad.Reader
    import Control.Monad.State
    import Control.Monad (filterM, guard, unless, void, when)
    import Data.Maybe (fromMaybe, isJust)
    import Data.Monoid (getAll)

    import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
    import Graphics.X11.Xlib.Extras

    import XMonad.Core
    import qualified XMonad.Config as Default
    import XMonad.StackSet (new, floating, member)
    import qualified XMonad.StackSet as W
    import XMonad.Operations

    import System.IO
    import System.Directory
    import System.Info
    import System.Environment (getArgs, getProgName, withArgs)
    import System.Posix.Process (executeFile)
    import System.Exit (exitFailure)
    import System.FilePath

    import Paths_xmonad (version)
    import Data.Version (showVersion)

    import Graphics.X11.Xinerama (compiledWithXinerama)
    import Graphics.X11.Xrandr (xrrQueryExtension, xrrUpdateConfiguration)

    ------------------------------------------------------------------------

    -- |
    -- | The entry point into xmonad. Attempts to compile any custom main
    -- for xmonad, and if it doesn't find one, just launches the default.
    xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
    xmonad :: forall (l :: * -> *).
    (LayoutClass l KeySym, Read (l KeySym)) =>
    XConfig l -> IO ()
    xmonad XConfig l
    conf = do
        IO ()
    forall (m :: * -> *). MonadIO m => m ()
    installSignalHandlers -- important to ignore SIGCHLD to avoid zombies

        dirs <- IO Directories
    getDirectories
        let launch' [String]
    args = do
                  IO () -> IO ()
    forall (m :: * -> *). MonadIO m => IO () -> m ()
    catchIO (Directories -> IO ()
    buildLaunch Directories
    dirs)
                  conf'@XConfig { layoutHook = Layout l }
                      <- XConfig l -> [String] -> XConfig Layout -> IO (XConfig Layout)
    forall (l :: * -> *).
    XConfig l -> [String] -> XConfig Layout -> IO (XConfig Layout)
    handleExtraArgs XConfig l
    conf [String]
    args XConfig l
    conf{ layoutHook = Layout (layoutHook conf) }
                  withArgs [] $ launch (conf' { layoutHook = l }) dirs

        args <- getArgs
        case args of
            [String
    "--help"]            -> IO ()
    usage
            [String
    "--recompile"]       -> Directories -> Bool -> IO Bool
    forall (m :: * -> *). MonadIO m => Directories -> Bool -> m Bool
    recompile Directories
    dirs Bool
    True IO Bool -> (Bool -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Bool -> IO () -> IO ()) -> IO () -> Bool -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless IO ()
    forall a. IO a
    exitFailure
            [String
    "--restart"]         -> IO ()
    sendRestart
            [String
    "--version"]         -> String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unwords [String]
    shortVersion
            [String
    "--verbose-version"] -> String -> IO ()
    putStrLn (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    unwords ([String] -> IO ()) -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String]
    shortVersion [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    longVersion
            String
    "--replace" : [String]
    args'   -> IO ()
    sendReplace IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [String] -> IO ()
    launch' [String]
    args'
            [String]
    _                     -> [String] -> IO ()
    launch' [String]
    args
     where
        shortVersion :: [String]
    shortVersion = [String
    "xmonad", Version -> String
    showVersion Version
    version]
        longVersion :: [String]
    longVersion  = [ String
    "compiled by", String
    compilerName, Version -> String
    showVersion Version
    compilerVersion
                       , String
    "for",  String
    arch String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    os
                       , String
    "\nXinerama:", Bool -> String
    forall a. Show a => a -> String
    show Bool
    compiledWithXinerama ]

    usage :: IO ()
    usage :: IO ()
    usage = do
        self <- IO String
    getProgName
        putStr . unlines $
            [ "Usage: " <> self <> " [OPTION]"
            , "Options:"
            , "  --help                       Print this message"
            , "  --version                    Print the version number"
            , "  --recompile                  Recompile your xmonad.hs"
            , "  --replace                    Replace the running window manager with xmonad"
            , "  --restart                    Request a running xmonad process to restart"
            ]

    -- | Build the xmonad configuration file with ghc, then execute it.
    -- If there are no errors, this function does not return.  An
    -- exception is raised in any of these cases:
    --
    --   * ghc missing
    --
    --   * both the configuration file and executable are missing
    --
    --   * xmonad.hs fails to compile
    --
    --      ** wrong ghc in path (fails to compile)
    --
    --      ** type error, syntax error, ..
    --
    --   * Missing XMonad\/XMonadContrib modules due to ghc upgrade
    --
    buildLaunch :: Directories -> IO ()
    buildLaunch :: Directories -> IO ()
    buildLaunch Directories
    dirs = do
        whoami <- IO String
    getProgName
        let bin = Directories -> String
    binFileName Directories
    dirs
        let compiledConfig = String -> String
    takeFileName String
    bin
        unless (whoami == compiledConfig) $ do
          trace $ concat
            [ "XMonad is recompiling and replacing itself with another XMonad process because the current process is called "
            , show whoami
            , " but the compiled configuration should be called "
            , show compiledConfig
            ]
          recompile dirs False
          args <- getArgs
          executeFile bin False args Nothing

    -- | Entry point into xmonad for custom builds.
    --
    -- This function isn't meant to be called by the typical xmonad user
    -- because it:
    --
    --   * Does not process any command line arguments.
    --
    --   * Therefore doesn't know how to restart a running xmonad.
    --
    --   * Does not compile your configuration file since it assumes it's
    --     actually running from within your compiled configuration.
    --
    -- Unless you know what you are doing, you should probably be using
    -- the 'xmonad' function instead.
    --
    -- However, if you are using a custom build environment (such as
    -- stack, cabal, make, etc.) you will likely want to call this
    -- function instead of 'xmonad'.  You probably also want to have a key
    -- binding to the 'XMonad.Operations.restart` function that restarts
    -- your custom binary with the resume flag set to @True@.
    launch :: (LayoutClass l Window, Read (l Window)) => XConfig l -> Directories -> IO ()
    launch :: forall (l :: * -> *).
    (LayoutClass l KeySym, Read (l KeySym)) =>
    XConfig l -> Directories -> IO ()
    launch XConfig l
    initxmc Directories
    drs = do
        -- setup locale information from environment
        Category -> Maybe String -> IO (Maybe String)
    setLocale Category
    LC_ALL (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "")
        -- ignore SIGPIPE and SIGCHLD
        IO ()
    forall (m :: * -> *). MonadIO m => m ()
    installSignalHandlers
        -- First, wrap the layout in an existential, to keep things pretty:
        let xmc :: XConfig Layout
    xmc = XConfig l
    initxmc { layoutHook = Layout $ layoutHook initxmc }
        dpy   <- String -> IO Display
    openDisplay String
    ""
        let dflt = Display -> EventType
    defaultScreen Display
    dpy

        rootw  <- rootWindow dpy dflt

        -- If another WM is running, a BadAccess error will be returned.  The
        -- default error handler will write the exception to stderr and exit with
        -- an error.
        selectInput dpy rootw $ rootMask initxmc

        sync dpy False -- sync to ensure all outstanding errors are delivered

        -- turn off the default handler in favor of one that ignores all errors
        -- (ugly, I know)
        xSetErrorHandler -- in C, I'm too lazy to write the binding: dons

        xinesc <- getCleanedScreenInfo dpy

        nbc    <- do v         <- initColor dpy $ normalBorderColor  xmc
                     Just nbc_ <- initColor dpy $ normalBorderColor Default.def
                     return (fromMaybe nbc_ v)

        fbc    <- do v <- initColor dpy $ focusedBorderColor xmc
                     Just fbc_ <- initColor dpy $ focusedBorderColor Default.def
                     return (fromMaybe fbc_ v)

        hSetBuffering stdout NoBuffering

        let layout = XConfig Layout -> Layout KeySym
    forall (l :: * -> *). XConfig l -> l KeySym
    layoutHook XConfig Layout
    xmc
            initialWinset = let padToLen :: Int -> [String] -> [String]
    padToLen Int
    n [String]
    xs = Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    n ([String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    xs)) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    xs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ String -> [String]
    forall a. a -> [a]
    repeat String
    ""
                in Layout KeySym
    -> [String]
    -> [ScreenDetail]
    -> StackSet String (Layout KeySym) a ScreenId ScreenDetail
    forall s l i sd a.
    Integral s =>
    l -> [i] -> [sd] -> StackSet i l a s sd
    new Layout KeySym
    layout (Int -> [String] -> [String]
    padToLen ([Rectangle] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Rectangle]
    xinesc) (XConfig Layout -> [String]
    forall (l :: * -> *). XConfig l -> [String]
    workspaces XConfig Layout
    xmc)) ([ScreenDetail]
     -> StackSet String (Layout KeySym) a ScreenId ScreenDetail)
    -> [ScreenDetail]
    -> StackSet String (Layout KeySym) a ScreenId ScreenDetail
    forall a b. (a -> b) -> a -> b
    $ (Rectangle -> ScreenDetail) -> [Rectangle] -> [ScreenDetail]
    forall a b. (a -> b) -> [a] -> [b]
    map Rectangle -> ScreenDetail
    SD [Rectangle]
    xinesc

            cf = XConf
                { display :: Display
    display       = Display
    dpy
                , config :: XConfig Layout
    config        = XConfig Layout
    xmc
                , theRoot :: KeySym
    theRoot       = KeySym
    rootw
                , normalBorder :: KeySym
    normalBorder  = KeySym
    nbc
                , focusedBorder :: KeySym
    focusedBorder = KeySym
    fbc
                , keyActions :: Map (ButtonMask, KeySym) (X ())
    keyActions    = XConfig Layout -> XConfig Layout -> Map (ButtonMask, KeySym) (X ())
    forall (l :: * -> *).
    XConfig l -> XConfig Layout -> Map (ButtonMask, KeySym) (X ())
    keys XConfig Layout
    xmc XConfig Layout
    xmc
                , buttonActions :: Map (ButtonMask, EventType) (KeySym -> X ())
    buttonActions = XConfig Layout
    -> XConfig Layout -> Map (ButtonMask, EventType) (KeySym -> X ())
    forall (l :: * -> *).
    XConfig l
    -> XConfig Layout -> Map (ButtonMask, EventType) (KeySym -> X ())
    mouseBindings XConfig Layout
    xmc XConfig Layout
    xmc
                , mouseFocused :: Bool
    mouseFocused  = Bool
    False
                , mousePosition :: Maybe (Position, Position)
    mousePosition = Maybe (Position, Position)
    forall a. Maybe a
    Nothing
                , currentEvent :: Maybe Event
    currentEvent  = Maybe Event
    forall a. Maybe a
    Nothing
                , directories :: Directories
    directories   = Directories
    drs
                }

            st = XState
                { windowset :: WindowSet
    windowset       = WindowSet
    forall {a}. StackSet String (Layout KeySym) a ScreenId ScreenDetail
    initialWinset
                , numberlockMask :: ButtonMask
    numberlockMask  = ButtonMask
    0
                , mapped :: Set KeySym
    mapped          = Set KeySym
    forall a. Set a
    S.empty
                , waitingUnmap :: Map KeySym Int
    waitingUnmap    = Map KeySym Int
    forall k a. Map k a
    M.empty
                , dragging :: Maybe (Position -> Position -> X (), X ())
    dragging        = Maybe (Position -> Position -> X (), X ())
    forall a. Maybe a
    Nothing
                , extensibleState :: Map String (Either String StateExtension)
    extensibleState = Map String (Either String StateExtension)
    forall k a. Map k a
    M.empty
                }

        allocaXEvent $ \XEventPtr
    e ->
            XConf -> XState -> X (ZonkAny 0) -> IO (ZonkAny 0, XState)
    forall a. XConf -> XState -> X a -> IO (a, XState)
    runX XConf
    cf XState
    st (X (ZonkAny 0) -> IO (ZonkAny 0, XState))
    -> X (ZonkAny 0) -> IO (ZonkAny 0, XState)
    forall a b. (a -> b) -> a -> b
    $ do
                -- check for serialized state in a file.
                serializedSt <- do
                    path <- (XConf -> String) -> X String
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ((XConf -> String) -> X String) -> (XConf -> String) -> X String
    forall a b. (a -> b) -> a -> b
    $ Directories -> String
    stateFileName (Directories -> String)
    -> (XConf -> Directories) -> XConf -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> Directories
    directories
                    exists <- io (doesFileExist path)
                    if exists then readStateFile initxmc else return Nothing

                -- restore extensibleState if we read it from a file.
                let extst = Map String (Either String StateExtension)
    -> (XState -> Map String (Either String StateExtension))
    -> Maybe XState
    -> Map String (Either String StateExtension)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Map String (Either String StateExtension)
    forall k a. Map k a
    M.empty XState -> Map String (Either String StateExtension)
    extensibleState Maybe XState
    serializedSt
                modify (\XState
    s -> XState
    s {extensibleState = extst})

                cacheNumlockMask
                grabKeys
                grabButtons

                io $ sync dpy False

                ws <- io $ scan dpy rootw

                -- bootstrap the windowset, Operations.windows will identify all
                -- the windows in winset as new and set initial properties for
                -- those windows.  Remove all windows that are no longer top-level
                -- children of the root, they may have disappeared since
                -- restarting.
                let winset = WindowSet -> (XState -> WindowSet) -> Maybe XState -> WindowSet
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe WindowSet
    forall {a}. StackSet String (Layout KeySym) a ScreenId ScreenDetail
    initialWinset XState -> WindowSet
    windowset Maybe XState
    serializedSt
                windows . const . foldr W.delete winset $ W.allWindows winset \\ ws

                -- manage the as-yet-unmanaged windows
                mapM_ manage (ws \\ W.allWindows winset)

                userCode $ startupHook initxmc

                rrData <- io $ xrrQueryExtension dpy

                -- main loop, for all you HOF/recursion fans out there.
                -- forever $ prehandle =<< io (nextEvent dpy e >> rrUpdate e >> getEvent e)
                -- sadly, 9.2.{1,2,3} join points mishandle the above and trash the heap (see #389)
                mainLoop dpy e rrData

        return ()
          where
            -- if the event gives us the position of the pointer, set mousePosition
            prehandle :: Event -> X ()
    prehandle Event
    e = let mouse :: Maybe (Position, Position)
    mouse = do Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Event -> EventType
    ev_event_type Event
    e EventType -> [EventType] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [EventType]
    evs)
                                         (Position, Position) -> Maybe (Position, Position)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Event -> CInt
    ev_x_root Event
    e)
                                                ,CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Event -> CInt
    ev_y_root Event
    e))
                          in (XConf -> XConf) -> X () -> X ()
    forall a. (XConf -> XConf) -> X a -> X a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\XConf
    c -> XConf
    c { mousePosition = mouse, currentEvent = Just e }) (Event -> X ()
    handleWithHook Event
    e)
            evs :: [EventType]
    evs = [ EventType
    keyPress, EventType
    keyRelease, EventType
    enterNotify, EventType
    leaveNotify
                  , EventType
    buttonPress, EventType
    buttonRelease]
            rrUpdate :: XEventPtr -> Maybe a -> IO ()
    rrUpdate XEventPtr
    e Maybe a
    r = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe a -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe a
    r) (IO CInt -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (XEventPtr -> IO CInt
    xrrUpdateConfiguration XEventPtr
    e))
            mainLoop :: Display -> XEventPtr -> Maybe a -> X b
    mainLoop Display
    d XEventPtr
    e Maybe a
    r = IO Event -> X Event
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (Display -> XEventPtr -> IO ()
    nextEvent Display
    d XEventPtr
    e IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XEventPtr -> Maybe a -> IO ()
    forall {a}. XEventPtr -> Maybe a -> IO ()
    rrUpdate XEventPtr
    e Maybe a
    r IO () -> IO Event -> IO Event
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XEventPtr -> IO Event
    getEvent XEventPtr
    e) X Event -> (Event -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Event -> X ()
    prehandle X () -> X b -> X b
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Display -> XEventPtr -> Maybe a -> X b
    mainLoop Display
    d XEventPtr
    e Maybe a
    r

    -- | Runs handleEventHook from the configuration and runs the default handler
    -- function if it returned True.
    handleWithHook :: Event -> X ()
    handleWithHook :: Event -> X ()
    handleWithHook Event
    e = do
      evHook <- (XConf -> Event -> X All) -> X (Event -> X All)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (XConfig Layout -> Event -> X All
    forall (l :: * -> *). XConfig l -> Event -> X All
    handleEventHook (XConfig Layout -> Event -> X All)
    -> (XConf -> XConfig Layout) -> XConf -> Event -> X All
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config)
      whenX (userCodeDef True $ getAll `fmap` evHook e) (handle e)

    -- ---------------------------------------------------------------------
    -- | Event handler. Map X events onto calls into Operations.hs, which
    -- modify our internal model of the window manager state.
    --
    -- Events dwm handles that we don't:
    --
    --    [ButtonPress]    = buttonpress,
    --    [Expose]         = expose,
    --    [PropertyNotify] = propertynotify,
    --
    handle :: Event -> X ()

    -- run window manager command
    handle :: Event -> X ()
    handle (KeyEvent {ev_event_type :: Event -> EventType
    ev_event_type = EventType
    t, ev_state :: Event -> ButtonMask
    ev_state = ButtonMask
    m, ev_keycode :: Event -> KeyCode
    ev_keycode = KeyCode
    code})
        | EventType
    t EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventType
    keyPress = (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
    dpy -> do
            s  <- IO KeySym -> X KeySym
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO KeySym -> X KeySym) -> IO KeySym -> X KeySym
    forall a b. (a -> b) -> a -> b
    $ Display -> KeyCode -> CInt -> IO KeySym
    keycodeToKeysym Display
    dpy KeyCode
    code CInt
    0
            mClean <- cleanMask m
            ks <- asks keyActions
            userCodeDef () $ whenJust (M.lookup (mClean, s) ks) id

    -- manage a new window
    handle (MapRequestEvent    {ev_window :: Event -> KeySym
    ev_window = KeySym
    w}) = (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
    dpy -> do
        Display -> KeySym -> (WindowAttributes -> X ()) -> X ()
    withWindowAttributes Display
    dpy KeySym
    w ((WindowAttributes -> X ()) -> X ())
    -> (WindowAttributes -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \WindowAttributes
    wa -> do -- ignore override windows
          -- need to ignore mapping requests by managed windows not on the current workspace
          managed <- KeySym -> X Bool
    isClient KeySym
    w
          when (not (wa_override_redirect wa) && not managed) $ manage w

    -- window destroyed, unmanage it
    -- window gone,      unmanage it
    -- broadcast to layouts
    handle e :: Event
    e@(DestroyWindowEvent {ev_window :: Event -> KeySym
    ev_window = KeySym
    w}) = do
      X Bool -> X () -> X ()
    whenX (KeySym -> X Bool
    isClient KeySym
    w) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
        KeySym -> X ()
    unmanage KeySym
    w
        (XState -> XState) -> X ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\XState
    s -> XState
    s { mapped       = S.delete w (mapped s)
                        , waitingUnmap = M.delete w (waitingUnmap s)})
      -- the window is already unmanged, but we broadcast the event to all layouts
      -- to trigger garbage-collection in case they hold window-specific resources
      Event -> X ()
    forall a. Message a => a -> X ()
    broadcastMessage Event
    e

    -- We track expected unmap events in waitingUnmap.  We ignore this event unless
    -- it is synthetic or we are not expecting an unmap notification from a window.
    handle (UnmapEvent {ev_window :: Event -> KeySym
    ev_window = KeySym
    w, ev_send_event :: Event -> Bool
    ev_send_event = Bool
    synthetic}) = X Bool -> X () -> X ()
    whenX (KeySym -> X Bool
    isClient KeySym
    w) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
        e <- (XState -> Int) -> X Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Maybe Int -> Int) -> (XState -> Maybe Int) -> XState -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KeySym -> Map KeySym Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup KeySym
    w (Map KeySym Int -> Maybe Int)
    -> (XState -> Map KeySym Int) -> XState -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState -> Map KeySym Int
    waitingUnmap)
        if synthetic || e == 0
            then unmanage w
            else modify (\XState
    s -> XState
    s { waitingUnmap = M.update mpred w (waitingUnmap s) })
     where mpred :: a -> Maybe a
    mpred a
    1 = Maybe a
    forall a. Maybe a
    Nothing
           mpred a
    n = a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ a -> a
    forall a. Enum a => a -> a
    pred a
    n

    -- set keyboard mapping
    handle e :: Event
    e@(MappingNotifyEvent {}) = do
        IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Event -> IO ()
    refreshKeyboardMapping Event
    e
        Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Event -> CInt
    ev_request Event
    e CInt -> [CInt] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [CInt
    mappingKeyboard, CInt
    mappingModifier]) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
            X ()
    cacheNumlockMask
            X ()
    grabKeys

    -- handle button release, which may finish dragging.
    handle e :: Event
    e@(ButtonEvent {ev_event_type :: Event -> EventType
    ev_event_type = EventType
    t})
        | EventType
    t EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventType
    buttonRelease = do
        drag <- (XState -> Maybe (Position -> Position -> X (), X ()))
    -> X (Maybe (Position -> Position -> X (), X ()))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> Maybe (Position -> Position -> X (), X ())
    dragging
        case drag of
            -- we're done dragging and have released the mouse:
            Just (Position -> Position -> X ()
    _,X ()
    f) -> (XState -> XState) -> X ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\XState
    s -> XState
    s { dragging = Nothing }) X () -> X () -> X ()
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> X ()
    f
            Maybe (Position -> Position -> X (), X ())
    Nothing    -> Event -> X ()
    forall a. Message a => a -> X ()
    broadcastMessage Event
    e

    -- handle motionNotify event, which may mean we are dragging.
    handle e :: Event
    e@(MotionEvent {ev_event_type :: Event -> EventType
    ev_event_type = EventType
    _t, ev_x :: Event -> CInt
    ev_x = CInt
    x, ev_y :: Event -> CInt
    ev_y = CInt
    y}) = do
        drag <- (XState -> Maybe (Position -> Position -> X (), X ()))
    -> X (Maybe (Position -> Position -> X (), X ()))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> Maybe (Position -> Position -> X (), X ())
    dragging
        case drag of
            Just (Position -> Position -> X ()
    d,X ()
    _) -> Position -> Position -> X ()
    d (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    x) (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    y) -- we're dragging
            Maybe (Position -> Position -> X (), X ())
    Nothing -> Event -> X ()
    forall a. Message a => a -> X ()
    broadcastMessage Event
    e

    -- click on an unfocused window, makes it focused on this workspace
    handle e :: Event
    e@(ButtonEvent {ev_window :: Event -> KeySym
    ev_window = KeySym
    w,ev_event_type :: Event -> EventType
    ev_event_type = EventType
    t,ev_button :: Event -> EventType
    ev_button = EventType
    b })
        | EventType
    t EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventType
    buttonPress = do
        -- If it's the root window, then it's something we
        -- grabbed in grabButtons. Otherwise, it's click-to-focus.
        dpy <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
        isr <- isRoot w
        m <- cleanMask $ ev_state e
        mact <- asks (M.lookup (m, b) . buttonActions)
        case mact of
            Just KeySym -> X ()
    act | Bool
    isr -> KeySym -> X ()
    act (KeySym -> X ()) -> KeySym -> X ()
    forall a b. (a -> b) -> a -> b
    $ Event -> KeySym
    ev_subwindow Event
    e
            Maybe (KeySym -> X ())
    _              -> do
                KeySym -> X ()
    focus KeySym
    w
                ctf <- (XConf -> Bool) -> X Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (XConfig Layout -> Bool
    forall (l :: * -> *). XConfig l -> Bool
    clickJustFocuses (XConfig Layout -> Bool)
    -> (XConf -> XConfig Layout) -> XConf -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config)
                unless ctf $ io (allowEvents dpy replayPointer currentTime)
        broadcastMessage e -- Always send button events.

    -- entered a normal window: focus it if focusFollowsMouse is set to
    -- True in the user's config.
    handle e :: Event
    e@(CrossingEvent {ev_window :: Event -> KeySym
    ev_window = KeySym
    w, ev_event_type :: Event -> EventType
    ev_event_type = EventType
    t})
        | EventType
    t EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventType
    enterNotify Bool -> Bool -> Bool
    && Event -> CInt
    ev_mode   Event
    e CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    == CInt
    notifyNormal
        = X Bool -> X () -> X ()
    whenX ((XConf -> Bool) -> X Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ((XConf -> Bool) -> X Bool) -> (XConf -> Bool) -> X Bool
    forall a b. (a -> b) -> a -> b
    $ XConfig Layout -> Bool
    forall (l :: * -> *). XConfig l -> Bool
    focusFollowsMouse (XConfig Layout -> Bool)
    -> (XConf -> XConfig Layout) -> XConf -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
            dpy <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
            root <- asks theRoot
            (_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root
            -- when Xlib cannot find a child that contains the pointer,
            -- it returns None(0)
            when (w' == 0 || w == w') (focus w)

    -- left a window, check if we need to focus root
    handle e :: Event
    e@(CrossingEvent {ev_event_type :: Event -> EventType
    ev_event_type = EventType
    t})
        | EventType
    t EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventType
    leaveNotify
        = do rootw <- (XConf -> KeySym) -> X KeySym
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> KeySym
    theRoot
             when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw

    -- configure a window
    handle e :: Event
    e@(ConfigureRequestEvent {ev_window :: Event -> KeySym
    ev_window = KeySym
    w}) = (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
    dpy -> do
        ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
        bw <- asks (borderWidth . config)

        if M.member w (floating ws)
            || not (member w ws)
            then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges
                        { wc_x            = ev_x e
                        , wc_y            = ev_y e
                        , wc_width        = ev_width e
                        , wc_height       = ev_height e
                        , wc_border_width = fromIntegral bw
                        , wc_sibling      = ev_above e
                        , wc_stack_mode   = ev_detail e }
                    when (member w ws) (float w)
            else withWindowAttributes dpy w $ \WindowAttributes
    wa -> IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ (XEventPtr -> IO ()) -> IO ()
    forall a. (XEventPtr -> IO a) -> IO a
    allocaXEvent ((XEventPtr -> IO ()) -> IO ()) -> (XEventPtr -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \XEventPtr
    ev -> do
                     XEventPtr -> EventType -> IO ()
    setEventType XEventPtr
    ev EventType
    configureNotify
                     XEventPtr
    -> KeySym
    -> KeySym
    -> CInt
    -> CInt
    -> CInt
    -> CInt
    -> CInt
    -> KeySym
    -> Bool
    -> IO ()
    setConfigureEvent XEventPtr
    ev KeySym
    w KeySym
    w
                         (WindowAttributes -> CInt
    wa_x WindowAttributes
    wa) (WindowAttributes -> CInt
    wa_y WindowAttributes
    wa) (WindowAttributes -> CInt
    wa_width WindowAttributes
    wa)
                         (WindowAttributes -> CInt
    wa_height WindowAttributes
    wa) (Event -> CInt
    ev_border_width Event
    e) KeySym
    none (WindowAttributes -> Bool
    wa_override_redirect WindowAttributes
    wa)
                     Display -> KeySym -> Bool -> KeySym -> XEventPtr -> IO ()
    sendEvent Display
    dpy KeySym
    w Bool
    False KeySym
    0 XEventPtr
    ev
        io $ sync dpy False

    -- configuration changes in the root may mean display settings have changed
    handle (ConfigureEvent {ev_window :: Event -> KeySym
    ev_window = KeySym
    w}) = X Bool -> X () -> X ()
    whenX (KeySym -> X Bool
    isRoot KeySym
    w) X ()
    rescreen

    -- property notify
    handle event :: Event
    event@(PropertyEvent { ev_event_type :: Event -> EventType
    ev_event_type = EventType
    t, ev_atom :: Event -> KeySym
    ev_atom = KeySym
    a })
        | EventType
    t EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventType
    propertyNotify Bool -> Bool -> Bool
    && KeySym
    a KeySym -> KeySym -> Bool
    forall a. Eq a => a -> a -> Bool
    == KeySym
    wM_NAME = (XConf -> X ()) -> X (X ())
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (XConfig Layout -> X ()
    forall (l :: * -> *). XConfig l -> X ()
    logHook (XConfig Layout -> X ())
    -> (XConf -> XConfig Layout) -> XConf -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config) X (X ()) -> (X () -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= () -> X () -> X ()
    forall a. a -> X a -> X a
    userCodeDef () X () -> X () -> X ()
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                                             Event -> X ()
    forall a. Message a => a -> X ()
    broadcastMessage Event
    event

    handle e :: Event
    e@ClientMessageEvent { ev_message_type :: Event -> KeySym
    ev_message_type = KeySym
    mt } = do
        a <- String -> X KeySym
    getAtom String
    "XMONAD_RESTART"
        if mt == a
            then restart "xmonad" True
            else broadcastMessage e

    handle Event
    e = Event -> X ()
    forall a. Message a => a -> X ()
    broadcastMessage Event
    e -- trace (eventName e) -- ignoring

    -- ---------------------------------------------------------------------
    -- IO stuff. Doesn't require any X state
    -- Most of these things run only on startup (bar grabkeys)

    -- | scan for any new windows to manage. If they're already managed,
    -- this should be idempotent.
    scan :: Display -> Window -> IO [Window]
    scan :: Display -> KeySym -> IO [KeySym]
    scan Display
    dpy KeySym
    rootw = do
        (_, _, ws) <- Display -> KeySym -> IO (KeySym, KeySym, [KeySym])
    queryTree Display
    dpy KeySym
    rootw
        filterM (\KeySym
    w -> KeySym -> IO Bool
    ok KeySym
    w IO Bool -> (SomeException -> IO Bool) -> IO Bool
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` SomeException -> IO Bool
    skip) ws
      -- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==
      -- Iconic
      where ok :: KeySym -> IO Bool
    ok KeySym
    w = do wa <- Display -> KeySym -> IO WindowAttributes
    getWindowAttributes Display
    dpy KeySym
    w
                      a  <- internAtom dpy "WM_STATE" False
                      p  <- getWindowProperty32 dpy a w
                      let ic = case Maybe [CLong]
    p of
                                Just (CLong
    3:[CLong]
    _) -> Bool
    True -- 3 for iconified
                                Maybe [CLong]
    _          -> Bool
    False
                      return $ not (wa_override_redirect wa)
                             && (wa_map_state wa == waIsViewable || ic)

            skip :: E.SomeException -> IO Bool
            skip :: SomeException -> IO Bool
    skip SomeException
    _ = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    -- | Grab the keys back
    grabKeys :: X ()
    grabKeys :: X ()
    grabKeys = do
        XConf { display = dpy, theRoot = rootw } <- X XConf
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        io $ ungrabKey dpy anyKey anyModifier rootw
        let grab :: (KeyMask, KeyCode) -> X ()
            grab (ButtonMask
    km, KeyCode
    kc) = IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> KeyCode -> ButtonMask -> KeySym -> Bool -> CInt -> CInt -> IO ()
    grabKey Display
    dpy KeyCode
    kc ButtonMask
    km KeySym
    rootw Bool
    True CInt
    grabModeAsync CInt
    grabModeAsync
        traverse_ grab =<< mkGrabs =<< asks (M.keys . keyActions)

    -- | Grab the buttons
    grabButtons :: X ()
    grabButtons :: X ()
    grabButtons = do
        XConf { display = dpy, theRoot = rootw } <- X XConf
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        let grab EventType
    button ButtonMask
    mask = IO () -> m ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> EventType
    -> ButtonMask
    -> KeySym
    -> Bool
    -> KeySym
    -> CInt
    -> CInt
    -> KeySym
    -> KeySym
    -> IO ()
    grabButton Display
    dpy EventType
    button ButtonMask
    mask KeySym
    rootw Bool
    False KeySym
    buttonPressMask
                                               CInt
    grabModeAsync CInt
    grabModeSync KeySym
    none KeySym
    none
        io $ ungrabButton dpy anyButton anyModifier rootw
        ems <- extraModifiers
        ba <- asks buttonActions
        mapM_ (\(ButtonMask
    m,EventType
    b) -> (ButtonMask -> X ()) -> [ButtonMask] -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (EventType -> ButtonMask -> X ()
    forall {m :: * -> *}. MonadIO m => EventType -> ButtonMask -> m ()
    grab EventType
    b (ButtonMask -> X ())
    -> (ButtonMask -> ButtonMask) -> ButtonMask -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ButtonMask
    m ButtonMask -> ButtonMask -> ButtonMask
    forall a. Bits a => a -> a -> a
    .|.)) [ButtonMask]
    ems) (M.keys ba)