    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# LANGUAGE MultiWayIf #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Prompt
    -- Copyright   :  (C) 2007 Andrea Rossato, 2015 Evgeny Kurnevsky
    --                    2015 Sibi Prabakaran, 2018 Yclept Nemo
    -- License     :  BSD3
    --
    -- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- A module for writing graphical prompts for XMonad
    --
    -----------------------------------------------------------------------------

    -----------------------------------------------------------------------------
    -- Bugs:
    -- if 'alwaysHighlight' is True, and
    --  1 type several characters
    --  2 tab-complete past several entries
    --  3 backspace back to the several characters
    --  4 tab-complete once (results in the entry past the one in [2])
    --  5 tab-complete against this shorter list of completions
    -- then the prompt will freeze (XMonad continues however).
    -----------------------------------------------------------------------------

    module XMonad.Prompt
        ( -- * Usage
          -- $usage
          mkXPrompt
        , mkXPromptWithReturn
        , mkXPromptWithModes
        , def
        , amberXPConfig
        , greenXPConfig
        , XPMode
        , XPType (..)
        , XPColor (..)
        , XPPosition (..)
        , XPConfig (..)
        , XPrompt (..)
        , XP
        , defaultXPKeymap, defaultXPKeymap'
        , emacsLikeXPKeymap, emacsLikeXPKeymap'
        , vimLikeXPKeymap, vimLikeXPKeymap'
        , quit
        , promptSubmap, promptBuffer, toHeadChar, bufferOne
        , killBefore, killAfter, startOfLine, endOfLine
        , insertString, pasteString, pasteString'
        , clipCursor, moveCursor, moveCursorClip
        , setInput, getInput, getOffset
        , defaultColor, modifyColor, setColor
        , resetColor, setBorderColor
        , modifyPrompter, setPrompter, resetPrompter
        , selectedCompletion, setCurrentCompletions, getCurrentCompletions
        , moveWord, moveWord', killWord, killWord'
        , changeWord, deleteString
        , moveHistory, setSuccess, setDone, setModeDone
        , Direction1D(..)
        , ComplFunction
        , ComplCaseSensitivity(..)
        -- * X Utilities
        -- $xutils
        , mkUnmanagedWindow
        , fillDrawable
        -- * Other Utilities
        -- $utils
        , mkComplFunFromList
        , mkComplFunFromList'
        -- * @nextCompletion@ implementations
        , getNextOfLastWord
        , getNextCompletion
        -- * List utilities
        , getLastWord
        , skipLastWord
        , splitInSubListsAt
        , breakAtSpace
        , uniqSort
        , historyCompletion
        , historyCompletionP
        -- * History filters
        , deleteAllDuplicates
        , deleteConsecutive
        , HistoryMatches
        , initMatches
        , historyUpMatching
        , historyDownMatching
        -- * Types
        , XPState
        ) where

    import           XMonad                       hiding (cleanMask, config)
    import           XMonad.Prelude               hiding (toList, fromList)
    import qualified XMonad.StackSet              as W
    import           XMonad.Util.Font
    import           XMonad.Util.Types
    import           XMonad.Util.XSelection       (getSelection)

    import           Codec.Binary.UTF8.String     (decodeString,isUTF8Encoded)
    import           Control.Arrow                (first, (&&&), (***))
    import           Control.Concurrent           (threadDelay)
    import           Control.Exception            as E hiding (handle)
    import           Control.Monad.State
    import           Data.Bifunctor               (bimap)
    import           Data.Bits
    import           Data.IORef
    import qualified Data.List.NonEmpty           as NE
    import qualified Data.Map                     as M
    import           Data.Set                     (fromList, toList)
    import           System.IO
    import           System.IO.Unsafe             (unsafePerformIO)
    import           System.Posix.Files
    import Data.List.NonEmpty (nonEmpty)

    -- $usage
    -- For usage examples see "XMonad.Prompt.Shell",
    -- "XMonad.Prompt.XMonad" or "XMonad.Prompt.Ssh"
    --
    -- TODO:
    --
    -- * scrolling the completions that don't fit in the window (?)

    type XP = StateT XPState IO

    data XPState =
        XPS { XPState -> Display
    dpy                   :: Display
            , XPState -> EventMask
    rootw                 :: !Window
            , XPState -> EventMask
    win                   :: !Window
            , XPState -> Rectangle
    screen                :: !Rectangle
            , XPState -> Dimension
    winWidth              :: !Dimension -- ^ Width of the prompt window
            , XPState -> Maybe ComplWindowDim
    complWinDim           :: Maybe ComplWindowDim
            , XPState -> (Int, Int)
    complIndex            :: !(Int,Int)
            , XPState -> IORef (Maybe EventMask)
    complWin              :: IORef (Maybe Window)
            -- ^ This is an 'IORef' to enable removal of the completion
            -- window if an exception occurs, since otherwise the most
            -- recent value of 'complWin' would not be available.
            , XPState -> Bool
    showComplWin          :: Bool
            , XPState -> XPOperationMode
    operationMode         :: XPOperationMode
            , XPState -> Maybe String
    highlightedCompl      :: Maybe String
            , XPState -> GC
    gcon                  :: !GC
            , XPState -> XMonadFont
    fontS                 :: !XMonadFont
            , XPState -> Stack String
    commandHistory        :: W.Stack String
            , XPState -> Int
    offset                :: !Int
            , XPState -> XPConfig
    config                :: XPConfig
            , XPState -> Bool
    successful            :: Bool
            , XPState -> KeyMask -> KeyMask
    cleanMask             :: KeyMask -> KeyMask
            , XPState -> Bool
    done                  :: Bool
            , XPState -> Bool
    modeDone              :: Bool
            , XPState -> XPColor
    color                 :: XPColor
            , XPState -> String -> String
    prompter              :: String -> String
            , XPState -> [(EventMask, String, Event)]
    eventBuffer           :: [(KeySym, String, Event)]
            , XPState -> String
    inputBuffer           :: String
            , XPState -> Maybe [String]
    currentCompletions    :: Maybe [String]
            }

    data XPConfig =
        XPC { XPConfig -> String
    font                  :: String       -- ^ Font. For TrueType fonts, use something like
                                                    -- @"xft:Hack:pixelsize=1"@. Alternatively, use X Logical Font
                                                    -- Description, i.e. something like
                                                    -- @"-*-dejavu sans mono-medium-r-normal--*-80-*-*-*-*-iso10646-1"@.
            , XPConfig -> String
    bgColor               :: String       -- ^ Background color
            , XPConfig -> String
    fgColor               :: String       -- ^ Font color
            , XPConfig -> String
    bgHLight              :: String       -- ^ Background color of a highlighted completion entry
            , XPConfig -> String
    fgHLight              :: String       -- ^ Font color of a highlighted completion entry
            , XPConfig -> String
    borderColor           :: String       -- ^ Border color
            , XPConfig -> Dimension
    promptBorderWidth     :: !Dimension   -- ^ Border width
            , XPConfig -> XPPosition
    position              :: XPPosition   -- ^ Position: 'Top', 'Bottom', or 'CenteredAt'
            , XPConfig -> Bool
    alwaysHighlight       :: !Bool        -- ^ Always highlight an item, overriden to True with multiple modes
            , XPConfig -> Dimension
    height                :: !Dimension   -- ^ Window height
            , XPConfig -> Maybe Dimension
    maxComplRows          :: Maybe Dimension
                                                    -- ^ Just x: maximum number of rows to show in completion window
            , XPConfig -> Maybe Dimension
    maxComplColumns       :: Maybe Dimension
                                                    -- ^ Just x: maximum number of columns to show in completion window
            , XPConfig -> Int
    historySize           :: !Int         -- ^ The number of history entries to be saved
            , XPConfig -> [String] -> [String]
    historyFilter         :: [String] -> [String]
                                                    -- ^ a filter to determine which
                                                    -- history entries to remember
            , XPConfig -> Map (KeyMask, EventMask) (XP ())
    promptKeymap          :: M.Map (KeyMask,KeySym) (XP ())
                                                    -- ^ Mapping from key combinations to actions
            , XPConfig -> (KeyMask, EventMask)
    completionKey         :: (KeyMask, KeySym)     -- ^ Key to trigger forward completion
            , XPConfig -> (KeyMask, EventMask)
    prevCompletionKey     :: (KeyMask, KeySym)     -- ^ Key to trigger backward completion
            , XPConfig -> EventMask
    changeModeKey         :: KeySym       -- ^ Key to change mode (when the prompt has multiple modes)
            , XPConfig -> String
    defaultText           :: String       -- ^ The text by default in the prompt line
            , XPConfig -> Maybe Int
    autoComplete          :: Maybe Int    -- ^ Just x: if only one completion remains, auto-select it,
                                                    --   and delay by x microseconds
            , XPConfig -> Bool
    showCompletionOnTab   :: Bool         -- ^ Only show list of completions when Tab was pressed
            , XPConfig -> ComplCaseSensitivity
    complCaseSensitivity  :: ComplCaseSensitivity
                                                    -- ^ Perform completion in a case-sensitive manner
            , XPConfig -> String -> String -> Bool
    searchPredicate       :: String -> String -> Bool
                                                    -- ^ Given the typed string and a possible
                                                    --   completion, is the completion valid?
            , XPConfig -> String -> String
    defaultPrompter       :: String -> String
                                                    -- ^ Modifies the prompt given by 'showXPrompt'
            , XPConfig -> String -> [String] -> [String]
    sorter                :: String -> [String] -> [String]
                                                    -- ^ Used to sort the possible completions by how well they
                                                    --   match the search string (see X.P.FuzzyMatch for an
                                                    --   example).
            }

    data XPType = forall p . XPrompt p => XPT p
    type ComplFunction = String -> IO [String]
    type XPMode = XPType
    data XPOperationMode = XPSingleMode ComplFunction XPType | XPMultipleModes (W.Stack XPType)

    data ComplCaseSensitivity = CaseSensitive | CaseInSensitive

    instance Show XPType where
        show :: XPType -> String
    show (XPT p
    p) = p -> String
    forall t. XPrompt t => t -> String
    showXPrompt p
    p

    instance XPrompt XPType where
        showXPrompt :: XPType -> String
    showXPrompt                 = XPType -> String
    forall a. Show a => a -> String
    show
        nextCompletion :: XPType -> String -> [String] -> String
    nextCompletion      (XPT p
    t) = p -> String -> [String] -> String
    forall t. XPrompt t => t -> String -> [String] -> String
    nextCompletion      p
    t
        commandToComplete :: XPType -> String -> String
    commandToComplete   (XPT p
    t) = p -> String -> String
    forall t. XPrompt t => t -> String -> String
    commandToComplete   p
    t
        completionToCommand :: XPType -> String -> String
    completionToCommand (XPT p
    t) = p -> String -> String
    forall t. XPrompt t => t -> String -> String
    completionToCommand p
    t
        completionFunction :: XPType -> ComplFunction
    completionFunction  (XPT p
    t) = p -> ComplFunction
    forall t. XPrompt t => t -> ComplFunction
    completionFunction  p
    t
        modeAction :: XPType -> String -> String -> X ()
    modeAction          (XPT p
    t) = p -> String -> String -> X ()
    forall t. XPrompt t => t -> String -> String -> X ()
    modeAction          p
    t

    -- | A class for an abstract prompt. In order for your data type to be a
    -- valid prompt you _must_ make it an instance of this class.
    --
    -- The minimal complete definition is just 'showXPrompt', i.e. the name
    -- of the prompt. This string will be displayed in the command line
    -- window (before the cursor).
    --
    -- As an example of a complete 'XPrompt' instance definition, we can
    -- look at the 'XMonad.Prompt.Shell.Shell' prompt from
    -- "XMonad.Prompt.Shell":
    --
    -- >     data Shell = Shell
    -- >
    -- >     instance XPrompt Shell where
    -- >          showXPrompt Shell = "Run: "
    class XPrompt t where
        {-# MINIMAL showXPrompt #-}

        -- | This method is used to print the string to be
        -- displayed in the command line window.
        showXPrompt :: t -> String

        -- | This method is used to generate the next completion to be
        -- printed in the command line when tab is pressed, given the
        -- string presently in the command line and the list of
        -- completion.
        -- This function is not used when in multiple modes (because alwaysHighlight in XPConfig is True)
        nextCompletion :: t -> String -> [String] -> String
        nextCompletion = t -> String -> [String] -> String
    forall t. XPrompt t => t -> String -> [String] -> String
    getNextOfLastWord

        -- | This method is used to generate the string to be passed to
        -- the completion function.
        commandToComplete :: t -> String -> String
        commandToComplete t
    _ = String -> String
    getLastWord

        -- | This method is used to process each completion in order to
        -- generate the string that will be compared with the command
        -- presently displayed in the command line. If the prompt is using
        -- 'getNextOfLastWord' for implementing 'nextCompletion' (the
        -- default implementation), this method is also used to generate,
        -- from the returned completion, the string that will form the
        -- next command line when tab is pressed.
        completionToCommand :: t -> String -> String
        completionToCommand t
    _ String
    c = String
    c

        -- | When the prompt has multiple modes, this is the function
        -- used to generate the autocompletion list.
        -- The argument passed to this function is given by `commandToComplete`
        -- The default implementation shows an error message.
        completionFunction :: t -> ComplFunction
        completionFunction t
    t = IO [String] -> ComplFunction
    forall a b. a -> b -> a
    const (IO [String] -> ComplFunction) -> IO [String] -> ComplFunction
    forall a b. (a -> b) -> a -> b
    $ [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String
    "Completions for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ t -> String
    forall t. XPrompt t => t -> String
    showXPrompt t
    t String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " could not be loaded"]

        -- | When the prompt has multiple modes (created with mkXPromptWithModes), this function is called
        -- when the user picks an item from the autocompletion list.
        -- The first argument is the prompt (or mode) on which the item was picked
        -- The first string argument is the autocompleted item's text.
        -- The second string argument is the query made by the user (written in the prompt's buffer).
        -- See XMonad/Actions/Launcher.hs for a usage example.
        modeAction :: t -> String -> String -> X ()
        modeAction t
    _ String
    _ String
    _ = () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    data XPPosition = Top
                    | Bottom
                    -- | Prompt will be placed in the center horizontally and
                    --   in the certain place of screen vertically. If it's in the upper
                    --   part of the screen, completion window will be placed below (like
                    --   in 'Top') and otherwise above (like in 'Bottom')
                    | CenteredAt { XPPosition -> Rational
    xpCenterY :: Rational
                                 -- ^ Rational between 0 and 1, giving
                                 -- y coordinate of center of the prompt relative to the screen height.
                                 , XPPosition -> Rational
    xpWidth  :: Rational
                                 -- ^ Rational between 0 and 1, giving
                                 -- width of the prompt relative to the screen width.
                                 }
                      deriving (Int -> XPPosition -> String -> String
    [XPPosition] -> String -> String
    XPPosition -> String
    (Int -> XPPosition -> String -> String)
    -> (XPPosition -> String)
    -> ([XPPosition] -> String -> String)
    -> Show XPPosition
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> XPPosition -> String -> String
    showsPrec :: Int -> XPPosition -> String -> String
    $cshow :: XPPosition -> String
    show :: XPPosition -> String
    $cshowList :: [XPPosition] -> String -> String
    showList :: [XPPosition] -> String -> String
    Show,ReadPrec [XPPosition]
    ReadPrec XPPosition
    Int -> ReadS XPPosition
    ReadS [XPPosition]
    (Int -> ReadS XPPosition)
    -> ReadS [XPPosition]
    -> ReadPrec XPPosition
    -> ReadPrec [XPPosition]
    -> Read XPPosition
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS XPPosition
    readsPrec :: Int -> ReadS XPPosition
    $creadList :: ReadS [XPPosition]
    readList :: ReadS [XPPosition]
    $creadPrec :: ReadPrec XPPosition
    readPrec :: ReadPrec XPPosition
    $creadListPrec :: ReadPrec [XPPosition]
    readListPrec :: ReadPrec [XPPosition]
    Read)

    data XPColor =
        XPColor { XPColor -> String
    bgNormal      :: String   -- ^ Background color
                , XPColor -> String
    fgNormal      :: String   -- ^ Font color
                , XPColor -> String
    bgHighlight   :: String   -- ^ Background color of a highlighted completion entry
                , XPColor -> String
    fgHighlight   :: String   -- ^ Font color of a highlighted completion entry
                , XPColor -> String
    border        :: String   -- ^ Border color
                }

    amberXPConfig, greenXPConfig :: XPConfig

    instance Default XPColor where
        def :: XPColor
    def =
            XPColor { bgNormal :: String
    bgNormal    = String
    "grey22"
                    , fgNormal :: String
    fgNormal    = String
    "grey80"
                    , bgHighlight :: String
    bgHighlight = String
    "grey"
                    , fgHighlight :: String
    fgHighlight = String
    "black"
                    , border :: String
    border      = String
    "white"
                    }

    instance Default XPConfig where
      def :: XPConfig
    def =
    #ifdef XFT
        XPC { font :: String
    font                  = String
    "xft:monospace-12"
    #else
        XPC { font                  = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*"
    #endif
            , bgColor :: String
    bgColor               = XPColor -> String
    bgNormal XPColor
    forall a. Default a => a
    def
            , fgColor :: String
    fgColor               = XPColor -> String
    fgNormal XPColor
    forall a. Default a => a
    def
            , bgHLight :: String
    bgHLight              = XPColor -> String
    bgHighlight XPColor
    forall a. Default a => a
    def
            , fgHLight :: String
    fgHLight              = XPColor -> String
    fgHighlight XPColor
    forall a. Default a => a
    def
            , borderColor :: String
    borderColor           = XPColor -> String
    border XPColor
    forall a. Default a => a
    def
            , promptBorderWidth :: Dimension
    promptBorderWidth     = Dimension
    1
            , promptKeymap :: Map (KeyMask, EventMask) (XP ())
    promptKeymap          = Map (KeyMask, EventMask) (XP ())
    defaultXPKeymap
            , completionKey :: (KeyMask, EventMask)
    completionKey         = (KeyMask
    0, EventMask
    xK_Tab)
            , prevCompletionKey :: (KeyMask, EventMask)
    prevCompletionKey     = (KeyMask
    shiftMask, EventMask
    xK_Tab)
            , changeModeKey :: EventMask
    changeModeKey         = EventMask
    xK_grave
            , position :: XPPosition
    position              = XPPosition
    Bottom
            , height :: Dimension
    height                = Dimension
    18
            , maxComplRows :: Maybe Dimension
    maxComplRows          = Maybe Dimension
    forall a. Maybe a
    Nothing
            , maxComplColumns :: Maybe Dimension
    maxComplColumns       = Maybe Dimension
    forall a. Maybe a
    Nothing
            , historySize :: Int
    historySize           = Int
    256
            , historyFilter :: [String] -> [String]
    historyFilter         = [String] -> [String]
    forall a. a -> a
    id
            , defaultText :: String
    defaultText           = []
            , autoComplete :: Maybe Int
    autoComplete          = Maybe Int
    forall a. Maybe a
    Nothing
            , showCompletionOnTab :: Bool
    showCompletionOnTab   = Bool
    False
            , complCaseSensitivity :: ComplCaseSensitivity
    complCaseSensitivity  = ComplCaseSensitivity
    CaseSensitive
            , searchPredicate :: String -> String -> Bool
    searchPredicate       = String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf
            , alwaysHighlight :: Bool
    alwaysHighlight       = Bool
    False
            , defaultPrompter :: String -> String
    defaultPrompter       = String -> String
    forall a. a -> a
    id
            , sorter :: String -> [String] -> [String]
    sorter                = ([String] -> [String]) -> String -> [String] -> [String]
    forall a b. a -> b -> a
    const [String] -> [String]
    forall a. a -> a
    id
            }
    greenXPConfig :: XPConfig
    greenXPConfig = XPConfig
    forall a. Default a => a
    def { bgColor           = "black"
                        , fgColor           = "green"
                        , promptBorderWidth = 0
                        }
    amberXPConfig :: XPConfig
    amberXPConfig = XPConfig
    forall a. Default a => a
    def { bgColor   = "black"
                        , fgColor   = "#ca8f2d"
                        , fgHLight  = "#eaaf4c"
                        }

    initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode
              -> GC -> XMonadFont -> [String] -> XPConfig -> (KeyMask -> KeyMask)
              -> Dimension -> XPState
    initState :: Display
    -> EventMask
    -> EventMask
    -> Rectangle
    -> XPOperationMode
    -> GC
    -> XMonadFont
    -> [String]
    -> XPConfig
    -> (KeyMask -> KeyMask)
    -> Dimension
    -> XPState
    initState Display
    d EventMask
    rw EventMask
    w Rectangle
    s XPOperationMode
    opMode GC
    gc XMonadFont
    fonts [String]
    h XPConfig
    c KeyMask -> KeyMask
    cm Dimension
    width =
        XPS { dpy :: Display
    dpy                   = Display
    d
            , rootw :: EventMask
    rootw                 = EventMask
    rw
            , win :: EventMask
    win                   = EventMask
    w
            , screen :: Rectangle
    screen                = Rectangle
    s
            , winWidth :: Dimension
    winWidth              = Dimension
    width
            , complWinDim :: Maybe ComplWindowDim
    complWinDim           = Maybe ComplWindowDim
    forall a. Maybe a
    Nothing
            , complWin :: IORef (Maybe EventMask)
    complWin              = IO (IORef (Maybe EventMask)) -> IORef (Maybe EventMask)
    forall a. IO a -> a
    unsafePerformIO (Maybe EventMask -> IO (IORef (Maybe EventMask))
    forall a. a -> IO (IORef a)
    newIORef Maybe EventMask
    forall a. Maybe a
    Nothing)
            , showComplWin :: Bool
    showComplWin          = Bool -> Bool
    not (XPConfig -> Bool
    showCompletionOnTab XPConfig
    c)
            , operationMode :: XPOperationMode
    operationMode         = XPOperationMode
    opMode
            , highlightedCompl :: Maybe String
    highlightedCompl      = Maybe String
    forall a. Maybe a
    Nothing
            , gcon :: GC
    gcon                  = GC
    gc
            , fontS :: XMonadFont
    fontS                 = XMonadFont
    fonts
            , commandHistory :: Stack String
    commandHistory        = W.Stack { focus :: String
    W.focus = XPConfig -> String
    defaultText XPConfig
    c
                                              , up :: [String]
    W.up    = []
                                              , down :: [String]
    W.down  = [String]
    h
                                              }
            , complIndex :: (Int, Int)
    complIndex            = (Int
    0,Int
    0) --(column index, row index), used when `alwaysHighlight` in XPConfig is True
            , offset :: Int
    offset                = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (XPConfig -> String
    defaultText XPConfig
    c)
            , config :: XPConfig
    config                = XPConfig
    c
            , successful :: Bool
    successful            = Bool
    False
            , done :: Bool
    done                  = Bool
    False
            , modeDone :: Bool
    modeDone              = Bool
    False
            , cleanMask :: KeyMask -> KeyMask
    cleanMask             = KeyMask -> KeyMask
    cm
            , prompter :: String -> String
    prompter              = XPConfig -> String -> String
    defaultPrompter XPConfig
    c
            , color :: XPColor
    color                 = XPConfig -> XPColor
    defaultColor XPConfig
    c
            , eventBuffer :: [(EventMask, String, Event)]
    eventBuffer           = []
            , inputBuffer :: String
    inputBuffer           = String
    ""
            , currentCompletions :: Maybe [String]
    currentCompletions    = Maybe [String]
    forall a. Maybe a
    Nothing
            }

    -- Returns the current XPType
    currentXPMode :: XPState -> XPType
    currentXPMode :: XPState -> XPType
    currentXPMode XPState
    st = case XPState -> XPOperationMode
    operationMode XPState
    st of
      XPMultipleModes Stack XPType
    modes -> Stack XPType -> XPType
    forall a. Stack a -> a
    W.focus Stack XPType
    modes
      XPSingleMode ComplFunction
    _ XPType
    xptype -> XPType
    xptype

    -- When in multiple modes, this function sets the next mode
    -- in the list of modes as active
    setNextMode :: XPState -> XPState
    setNextMode :: XPState -> XPState
    setNextMode XPState
    st = case XPState -> XPOperationMode
    operationMode XPState
    st of
      XPMultipleModes Stack XPType
    modes -> case Stack XPType -> [XPType]
    forall a. Stack a -> [a]
    W.down Stack XPType
    modes of
        [] -> XPState
    st -- there is no next mode, return same state
        (XPType
    m:[XPType]
    ms) -> let
          currentMode :: XPType
    currentMode = Stack XPType -> XPType
    forall a. Stack a -> a
    W.focus Stack XPType
    modes
          in XPState
    st { operationMode = XPMultipleModes W.Stack { W.up = [], W.focus = m, W.down = ms ++ [currentMode]}} --set next and move previous current mode to the of the stack
      XPOperationMode
    _ -> XPState
    st --nothing to do, the prompt's operation has only one mode

    -- Returns the highlighted item
    highlightedItem :: XPState -> [String] -> Maybe String
    highlightedItem :: XPState -> [String] -> Maybe String
    highlightedItem XPState
    st' [String]
    completions = case XPState -> Maybe ComplWindowDim
    complWinDim XPState
    st' of
      Maybe ComplWindowDim
    Nothing -> Maybe String
    forall a. Maybe a
    Nothing -- when there isn't any compl win, we can't say how many cols,rows there are
      Just ComplWindowDim
    winDim ->
        let
          ComplWindowDim{ [Position]
    cwCols :: [Position]
    cwCols :: ComplWindowDim -> [Position]
    cwCols, [Position]
    cwRows :: [Position]
    cwRows :: ComplWindowDim -> [Position]
    cwRows } = ComplWindowDim
    winDim
          complMatrix :: [[String]]
    complMatrix = Int -> [String] -> [[String]]
    forall a. Int -> [a] -> [[a]]
    chunksOf ([Position] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Position]
    cwRows) (Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take ([Position] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Position]
    cwCols Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * [Position] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Position]
    cwRows) [String]
    completions)
          (Int
    col_index,Int
    row_index) = XPState -> (Int, Int)
    complIndex XPState
    st'
        in case [String]
    completions of
          [] -> Maybe String
    forall a. Maybe a
    Nothing
          [String]
    _  -> [[String]]
    complMatrix [[String]] -> Int -> Maybe [String]
    forall a. [a] -> Int -> Maybe a
    !? Int
    col_index Maybe [String] -> ([String] -> Maybe String) -> Maybe String
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ([String] -> Int -> Maybe String
    forall a. [a] -> Int -> Maybe a
    !? Int
    row_index)

    -- | Return the selected completion, i.e. the 'String' we actually act
    -- upon after the user confirmed their selection (by pressing @Enter@).
    selectedCompletion :: XPState -> String
    selectedCompletion :: XPState -> String
    selectedCompletion XPState
    st
        -- If 'alwaysHighlight' is used, look at the currently selected item (if any)
      | XPConfig -> Bool
    alwaysHighlight (XPState -> XPConfig
    config XPState
    st) = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe (XPState -> String
    command XPState
    st) (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ XPState -> Maybe String
    highlightedCompl XPState
    st
        -- Otherwise, look at what the user actually wrote so far
      | Bool
    otherwise                   = XPState -> String
    command XPState
    st

    -- this would be much easier with functional references
    command :: XPState -> String
    command :: XPState -> String
    command = Stack String -> String
    forall a. Stack a -> a
    W.focus (Stack String -> String)
    -> (XPState -> Stack String) -> XPState -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> Stack String
    commandHistory

    setCommand :: String -> XPState -> XPState
    setCommand :: String -> XPState -> XPState
    setCommand String
    xs XPState
    s = XPState
    s { commandHistory = (commandHistory s) { W.focus = xs }}

    -- | Sets the input string to the given value.
    setInput :: String -> XP ()
    setInput :: String -> XP ()
    setInput = (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ())
    -> (String -> XPState -> XPState) -> String -> XP ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> XPState -> XPState
    setCommand

    -- | Returns the current input string. Intended for use in custom keymaps
    -- where 'get' or similar can't be used to retrieve it.
    getInput :: XP String
    getInput :: XP String
    getInput = (XPState -> String) -> XP String
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> String
    command

    -- | Returns the offset of the current input string. Intended for use in custom
    -- keys where 'get' or similar can't be used to retrieve it.
    getOffset :: XP Int
    getOffset :: XP Int
    getOffset = (XPState -> Int) -> XP Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Int
    offset

    -- | Accessor encapsulating disparate color fields of 'XPConfig' into an
    -- 'XPColor' (the configuration provides default values).
    defaultColor :: XPConfig -> XPColor
    defaultColor :: XPConfig -> XPColor
    defaultColor XPConfig
    c = XPColor { bgNormal :: String
    bgNormal     = XPConfig -> String
    bgColor XPConfig
    c
                             , fgNormal :: String
    fgNormal     = XPConfig -> String
    fgColor XPConfig
    c
                             , bgHighlight :: String
    bgHighlight  = XPConfig -> String
    bgHLight XPConfig
    c
                             , fgHighlight :: String
    fgHighlight  = XPConfig -> String
    fgHLight XPConfig
    c
                             , border :: String
    border       = XPConfig -> String
    borderColor XPConfig
    c
                             }

    -- | Modify the prompt colors.
    modifyColor :: (XPColor -> XPColor) -> XP ()
    modifyColor :: (XPColor -> XPColor) -> XP ()
    modifyColor XPColor -> XPColor
    c = (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { color = c $ color s }

    -- | Set the prompt colors.
    setColor :: XPColor -> XP ()
    setColor :: XPColor -> XP ()
    setColor = (XPColor -> XPColor) -> XP ()
    modifyColor ((XPColor -> XPColor) -> XP ())
    -> (XPColor -> XPColor -> XPColor) -> XPColor -> XP ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPColor -> XPColor -> XPColor
    forall a b. a -> b -> a
    const

    -- | Reset the prompt colors to those from 'XPConfig'.
    resetColor :: XP ()
    resetColor :: XP ()
    resetColor = (XPState -> XPColor) -> StateT XPState IO XPColor
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (XPConfig -> XPColor
    defaultColor (XPConfig -> XPColor)
    -> (XPState -> XPConfig) -> XPState -> XPColor
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> XPConfig
    config) StateT XPState IO XPColor -> (XPColor -> XP ()) -> XP ()
    forall a b.
    StateT XPState IO a
    -> (a -> StateT XPState IO b) -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= XPColor -> XP ()
    setColor

    -- | Set the prompt border color.
    setBorderColor :: String -> XPColor -> XPColor
    setBorderColor :: String -> XPColor -> XPColor
    setBorderColor String
    bc XPColor
    xpc = XPColor
    xpc { border = bc }

    -- | Modify the prompter, i.e. for chaining prompters.
    modifyPrompter :: ((String -> String) -> (String -> String)) -> XP ()
    modifyPrompter :: ((String -> String) -> String -> String) -> XP ()
    modifyPrompter (String -> String) -> String -> String
    p = (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { prompter = p $ prompter s }

    -- | Set the prompter.
    setPrompter :: (String -> String) -> XP ()
    setPrompter :: (String -> String) -> XP ()
    setPrompter = ((String -> String) -> String -> String) -> XP ()
    modifyPrompter (((String -> String) -> String -> String) -> XP ())
    -> ((String -> String) -> (String -> String) -> String -> String)
    -> (String -> String)
    -> XP ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> (String -> String) -> String -> String
    forall a b. a -> b -> a
    const

    -- | Reset the prompter to the one from 'XPConfig'.
    resetPrompter :: XP ()
    resetPrompter :: XP ()
    resetPrompter = (XPState -> String -> String)
    -> StateT XPState IO (String -> String)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (XPConfig -> String -> String
    defaultPrompter (XPConfig -> String -> String)
    -> (XPState -> XPConfig) -> XPState -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> XPConfig
    config) StateT XPState IO (String -> String)
    -> ((String -> String) -> XP ()) -> XP ()
    forall a b.
    StateT XPState IO a
    -> (a -> StateT XPState IO b) -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String -> String) -> XP ()
    setPrompter

    -- | Set the current completion list, or 'Nothing' to invalidate the current
    -- completions.
    setCurrentCompletions :: Maybe [String] -> XP ()
    setCurrentCompletions :: Maybe [String] -> XP ()
    setCurrentCompletions Maybe [String]
    cs = (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { currentCompletions = cs }

    -- | Get the current completion list.
    getCurrentCompletions :: XP (Maybe [String])
    getCurrentCompletions :: XP (Maybe [String])
    getCurrentCompletions = (XPState -> Maybe [String]) -> XP (Maybe [String])
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Maybe [String]
    currentCompletions

    -- | Same as 'mkXPrompt', except that the action function can have
    --   type @String -> X a@, for any @a@, and the final action returned
    --   by 'mkXPromptWithReturn' will have type @X (Maybe a)@.  @Nothing@
    --   is yielded if the user cancels the prompt (by e.g. hitting Esc or
    --   Ctrl-G).  For an example of use, see the 'XMonad.Prompt.Input'
    --   module.
    mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a)  -> X (Maybe a)
    mkXPromptWithReturn :: forall p a.
    XPrompt p =>
    p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a)
    mkXPromptWithReturn p
    t XPConfig
    conf ComplFunction
    compl String -> X a
    action = do
      XPState
    st' <- String -> XPConfig -> XPOperationMode -> X XPState
    mkXPromptImplementation (p -> String
    forall t. XPrompt t => t -> String
    showXPrompt p
    t) XPConfig
    conf (ComplFunction -> XPType -> XPOperationMode
    XPSingleMode ComplFunction
    compl (p -> XPType
    forall p. XPrompt p => p -> XPType
    XPT p
    t))
      if XPState -> Bool
    successful XPState
    st'
        then a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> X a -> X (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> X a
    action (XPState -> String
    selectedCompletion XPState
    st')
        else Maybe a -> X (Maybe a)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing

    -- | Creates a prompt given:
    --
    -- * a prompt type, instance of the 'XPrompt' class.
    --
    -- * a prompt configuration ('def' can be used as a starting point)
    --
    -- * a completion function ('mkComplFunFromList' can be used to
    -- create a completions function given a list of possible completions)
    --
    -- * an action to be run: the action must take a string and return 'XMonad.X' ()
    mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
    mkXPrompt :: forall p.
    XPrompt p =>
    p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
    mkXPrompt p
    t XPConfig
    conf ComplFunction
    compl String -> X ()
    action = X (Maybe ()) -> X ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (X (Maybe ()) -> X ()) -> X (Maybe ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ p -> XPConfig -> ComplFunction -> (String -> X ()) -> X (Maybe ())
    forall p a.
    XPrompt p =>
    p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a)
    mkXPromptWithReturn p
    t XPConfig
    conf ComplFunction
    compl String -> X ()
    action

    -- | Creates a prompt with multiple modes given:
    --
    -- * A non-empty list of modes
    -- * A prompt configuration
    --
    -- The created prompt allows to switch between modes with `changeModeKey` in `conf`. The modes are
    -- instances of XPrompt. See XMonad.Actions.Launcher for more details
    --
    -- The argument supplied to the action to execute is always the current highlighted item,
    -- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True.
    mkXPromptWithModes :: [XPType] -> XPConfig -> X ()
    mkXPromptWithModes :: [XPType] -> XPConfig -> X ()
    mkXPromptWithModes [] XPConfig
    _ = () -> X ()
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    mkXPromptWithModes (XPType
    defaultMode : [XPType]
    modes) XPConfig
    conf = do
      let modeStack :: Stack XPType
    modeStack = W.Stack { focus :: XPType
    W.focus = XPType
    defaultMode -- Current mode
                              , up :: [XPType]
    W.up = []
                              , down :: [XPType]
    W.down = [XPType]
    modes -- Other modes
                              }
          om :: XPOperationMode
    om = Stack XPType -> XPOperationMode
    XPMultipleModes Stack XPType
    modeStack
      XPState
    st' <- String -> XPConfig -> XPOperationMode -> X XPState
    mkXPromptImplementation (XPType -> String
    forall t. XPrompt t => t -> String
    showXPrompt XPType
    defaultMode) XPConfig
    conf { alwaysHighlight = True } XPOperationMode
    om
      Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (XPState -> Bool
    successful XPState
    st') (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $
        case XPState -> XPOperationMode
    operationMode XPState
    st' of
          XPMultipleModes Stack XPType
    ms -> let
            action :: String -> String -> X ()
    action = XPType -> String -> String -> X ()
    forall t. XPrompt t => t -> String -> String -> X ()
    modeAction (XPType -> String -> String -> X ())
    -> XPType -> String -> String -> X ()
    forall a b. (a -> b) -> a -> b
    $ Stack XPType -> XPType
    forall a. Stack a -> a
    W.focus Stack XPType
    ms
            in String -> String -> X ()
    action (XPState -> String
    command XPState
    st') (String -> X ()) -> String -> X ()
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "" (XPState -> Maybe String
    highlightedCompl XPState
    st')
          XPOperationMode
    _ -> String -> X ()
    forall a. HasCallStack => String -> a
    error String
    "The impossible occurred: This prompt runs with multiple modes but they could not be found." --we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode

    -- Internal function used to implement 'mkXPromptWithReturn' and
    -- 'mkXPromptWithModes'.
    mkXPromptImplementation :: String -> XPConfig -> XPOperationMode -> X XPState
    mkXPromptImplementation :: String -> XPConfig -> XPOperationMode -> X XPState
    mkXPromptImplementation String
    historyKey XPConfig
    conf XPOperationMode
    om = do
      XConf { display :: XConf -> Display
    display = Display
    d, theRoot :: XConf -> EventMask
    theRoot = EventMask
    rw } <- X XConf
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      Rectangle
    s <- (XState -> Rectangle) -> X Rectangle
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XState -> Rectangle) -> X Rectangle)
    -> (XState -> Rectangle) -> X Rectangle
    forall a b. (a -> b) -> a -> b
    $ ScreenDetail -> Rectangle
    screenRect (ScreenDetail -> Rectangle)
    -> (XState -> ScreenDetail) -> XState -> Rectangle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen String (Layout EventMask) EventMask ScreenId ScreenDetail
    -> ScreenDetail
    forall i l a sid sd. Screen i l a sid sd -> sd
    W.screenDetail (Screen String (Layout EventMask) EventMask ScreenId ScreenDetail
     -> ScreenDetail)
    -> (XState
        -> Screen
             String (Layout EventMask) EventMask ScreenId ScreenDetail)
    -> XState
    -> ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet String (Layout EventMask) EventMask ScreenId ScreenDetail
    -> Screen String (Layout EventMask) EventMask ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current (StackSet String (Layout EventMask) EventMask ScreenId ScreenDetail
     -> Screen
          String (Layout EventMask) EventMask ScreenId ScreenDetail)
    -> (XState
        -> StackSet
             String (Layout EventMask) EventMask ScreenId ScreenDetail)
    -> XState
    -> Screen String (Layout EventMask) EventMask ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet
         String (Layout EventMask) EventMask ScreenId ScreenDetail
    windowset
      KeyMask -> KeyMask
    cleanMask <- X (KeyMask -> KeyMask)
    cleanKeyMask
      String
    cachedir <- (XConf -> String) -> X String
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (Directories' String -> String
    forall a. Directories' a -> a
    cacheDir (Directories' String -> String)
    -> (XConf -> Directories' String) -> XConf -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> Directories' String
    directories)
      Map String [String]
    hist <- IO (Map String [String]) -> X (Map String [String])
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Map String [String]) -> X (Map String [String]))
    -> IO (Map String [String]) -> X (Map String [String])
    forall a b. (a -> b) -> a -> b
    $ String -> IO (Map String [String])
    readHistory String
    cachedir
      XMonadFont
    fs <- String -> X XMonadFont
    initXMF (XPConfig -> String
    font XPConfig
    conf)
      let width :: Dimension
    width = Rectangle -> XPPosition -> Dimension
    getWinWidth Rectangle
    s (XPConfig -> XPPosition
    position XPConfig
    conf)
      XPState
    st' <- IO XPState -> X XPState
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO XPState -> X XPState) -> IO XPState -> X XPState
    forall a b. (a -> b) -> a -> b
    $
        IO EventMask
    -> (EventMask -> IO ()) -> (EventMask -> IO XPState) -> IO XPState
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
          (Display
    -> EventMask -> XPConfig -> Rectangle -> Dimension -> IO EventMask
    createPromptWin Display
    d EventMask
    rw XPConfig
    conf Rectangle
    s Dimension
    width)
          (Display -> EventMask -> IO ()
    destroyWindow Display
    d)
          (\EventMask
    w ->
            IO GC -> (GC -> IO ()) -> (GC -> IO XPState) -> IO XPState
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
              (Display -> EventMask -> IO GC
    createGC Display
    d EventMask
    w)
              (Display -> GC -> IO ()
    freeGC Display
    d)
              (\GC
    gc -> do
                Display -> EventMask -> EventMask -> IO ()
    selectInput Display
    d EventMask
    w (EventMask -> IO ()) -> EventMask -> IO ()
    forall a b. (a -> b) -> a -> b
    $ EventMask
    exposureMask EventMask -> EventMask -> EventMask
    forall a. Bits a => a -> a -> a
    .|. EventMask
    keyPressMask
                Display -> GC -> Bool -> IO ()
    setGraphicsExposures Display
    d GC
    gc Bool
    False
                let hs :: [String]
    hs = [String] -> Maybe [String] -> [String]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [String] -> [String]) -> Maybe [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> Map String [String] -> Maybe [String]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    historyKey Map String [String]
    hist
                    st :: XPState
    st = Display
    -> EventMask
    -> EventMask
    -> Rectangle
    -> XPOperationMode
    -> GC
    -> XMonadFont
    -> [String]
    -> XPConfig
    -> (KeyMask -> KeyMask)
    -> Dimension
    -> XPState
    initState Display
    d EventMask
    rw EventMask
    w Rectangle
    s XPOperationMode
    om GC
    gc XMonadFont
    fs [String]
    hs XPConfig
    conf KeyMask -> KeyMask
    cleanMask Dimension
    width
                XPState -> IO XPState
    runXP XPState
    st))
      XMonadFont -> X ()
    releaseXMF XMonadFont
    fs
      Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (XPState -> Bool
    successful XPState
    st') (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
        let prune :: [a] -> [a]
    prune = Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take (XPConfig -> Int
    historySize XPConfig
    conf)
        IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ String -> Map String [String] -> IO ()
    writeHistory String
    cachedir (Map String [String] -> IO ()) -> Map String [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          ([String] -> [String] -> [String])
    -> String -> [String] -> Map String [String] -> Map String [String]
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith
          (\[String]
    xs [String]
    ys -> [String] -> [String]
    forall {a}. [a] -> [a]
    prune ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPConfig -> [String] -> [String]
    historyFilter XPConfig
    conf ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    xs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    ys)
          String
    historyKey
          -- We need to apply historyFilter before as well, since
          -- otherwise the filter would not be applied if there is no
          -- history
          ([String] -> [String]
    forall {a}. [a] -> [a]
    prune ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ XPConfig -> [String] -> [String]
    historyFilter XPConfig
    conf [XPState -> String
    selectedCompletion XPState
    st'])
          Map String [String]
    hist
      XPState -> X XPState
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return XPState
    st'
     where
      -- | Based on the ultimate position of the prompt and the screen
      -- dimensions, calculate its width.
      getWinWidth :: Rectangle -> XPPosition -> Dimension
      getWinWidth :: Rectangle -> XPPosition -> Dimension
    getWinWidth Rectangle
    scr = \case
        CenteredAt{ Rational
    xpWidth :: XPPosition -> Rational
    xpWidth :: Rational
    xpWidth } -> Rational -> Dimension
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Rational -> Dimension) -> Rational -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi (Rectangle -> Dimension
    rect_width Rectangle
    scr) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    xpWidth
        XPPosition
    _                     -> Rectangle -> Dimension
    rect_width Rectangle
    scr

    -- | Inverse of 'Codec.Binary.UTF8.String.utf8Encode', that is, a convenience
    -- function that checks to see if the input string is UTF8 encoded before
    -- decoding.
    utf8Decode :: String -> String
    utf8Decode :: String -> String
    utf8Decode String
    str
        | String -> Bool
    isUTF8Encoded String
    str = String -> String
    decodeString String
    str
        | Bool
    otherwise         = String
    str

    runXP :: XPState -> IO XPState
    runXP :: XPState -> IO XPState
    runXP XPState
    st = do
      let d :: Display
    d = XPState -> Display
    dpy XPState
    st
          w :: EventMask
    w = XPState -> EventMask
    win XPState
    st
      IO CInt -> (CInt -> IO ()) -> (CInt -> IO XPState) -> IO XPState
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
        (Display
    -> EventMask -> Bool -> CInt -> CInt -> EventMask -> IO CInt
    grabKeyboard Display
    d EventMask
    w Bool
    True CInt
    grabModeAsync CInt
    grabModeAsync EventMask
    currentTime)
        (\CInt
    _ -> Display -> EventMask -> IO ()
    ungrabKeyboard Display
    d EventMask
    currentTime)
        (\CInt
    status ->
          XP () -> XPState -> IO XPState
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
    execStateT
            (Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CInt
    status CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    == CInt
    grabSuccess) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ do
              Bool
    ah <- (XPState -> Bool) -> StateT XPState IO Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (XPConfig -> Bool
    alwaysHighlight (XPConfig -> Bool) -> (XPState -> XPConfig) -> XPState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> XPConfig
    config)
              Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    ah (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ do
                Maybe String
    compl <- [String] -> Maybe String
    forall a. [a] -> Maybe a
    listToMaybe ([String] -> Maybe String)
    -> StateT XPState IO [String] -> StateT XPState IO (Maybe String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT XPState IO [String]
    getCompletions
                (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify' ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    xpst -> XPState
    xpst{ highlightedCompl = compl }
              XP ()
    updateWindows
              (KeyStroke -> Event -> XP ()) -> StateT XPState IO Bool -> XP ()
    eventLoop KeyStroke -> Event -> XP ()
    handleMain StateT XPState IO Bool
    evDefaultStop)
            XPState
    st
          IO XPState -> IO () -> IO XPState
    forall a b. IO a -> IO b -> IO a
    `finally` ((EventMask -> IO ()) -> Maybe EventMask -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Display -> EventMask -> IO ()
    destroyWindow Display
    d) (Maybe EventMask -> IO ()) -> IO (Maybe EventMask) -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IORef (Maybe EventMask) -> IO (Maybe EventMask)
    forall a. IORef a -> IO a
    readIORef (XPState -> IORef (Maybe EventMask)
    complWin XPState
    st))
          IO XPState -> IO () -> IO XPState
    forall a b. IO a -> IO b -> IO a
    `finally` Display -> Bool -> IO ()
    sync Display
    d Bool
    False)

    type KeyStroke = (KeySym, String)

    -- | Check whether the given key stroke is a modifier.
    isModifier :: KeyStroke -> Bool
    isModifier :: KeyStroke -> Bool
    isModifier (EventMask
    _, String
    keyString) = String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    keyString

    -- | Main event "loop". Gives priority to events from the state's event buffer.
    eventLoop :: (KeyStroke -> Event -> XP ())
              -> XP Bool
              -> XP ()
    eventLoop :: (KeyStroke -> Event -> XP ()) -> StateT XPState IO Bool -> XP ()
    eventLoop KeyStroke -> Event -> XP ()
    handle StateT XPState IO Bool
    stopAction = do
        [(EventMask, String, Event)]
    b <- (XPState -> [(EventMask, String, Event)])
    -> StateT XPState IO [(EventMask, String, Event)]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> [(EventMask, String, Event)]
    eventBuffer
        (EventMask
    keysym,String
    keystr,Event
    event) <- case [(EventMask, String, Event)]
    b of
            []  -> do
                    Display
    d <- (XPState -> Display) -> StateT XPState IO Display
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Display
    dpy
                    IO (EventMask, String, Event)
    -> StateT XPState IO (EventMask, String, Event)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (EventMask, String, Event)
     -> StateT XPState IO (EventMask, String, Event))
    -> IO (EventMask, String, Event)
    -> StateT XPState IO (EventMask, String, Event)
    forall a b. (a -> b) -> a -> b
    $ (XEventPtr -> IO (EventMask, String, Event))
    -> IO (EventMask, String, Event)
    forall a. (XEventPtr -> IO a) -> IO a
    allocaXEvent ((XEventPtr -> IO (EventMask, String, Event))
     -> IO (EventMask, String, Event))
    -> (XEventPtr -> IO (EventMask, String, Event))
    -> IO (EventMask, String, Event)
    forall a b. (a -> b) -> a -> b
    $ \XEventPtr
    e -> do
                        -- Also capture @buttonPressMask@, see Note [Allow ButtonEvents]
                        Display -> EventMask -> XEventPtr -> IO ()
    maskEvent Display
    d (EventMask
    exposureMask EventMask -> EventMask -> EventMask
    forall a. Bits a => a -> a -> a
    .|. EventMask
    keyPressMask EventMask -> EventMask -> EventMask
    forall a. Bits a => a -> a -> a
    .|. EventMask
    buttonPressMask) XEventPtr
    e
                        Event
    ev <- XEventPtr -> IO Event
    getEvent XEventPtr
    e
                        if Event -> Dimension
    ev_event_type Event
    ev Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    keyPress
                            then do (Maybe EventMask
    _, String
    s) <- XKeyEventPtr -> IO (Maybe EventMask, String)
    lookupString (XKeyEventPtr -> IO (Maybe EventMask, String))
    -> XKeyEventPtr -> IO (Maybe EventMask, String)
    forall a b. (a -> b) -> a -> b
    $ XEventPtr -> XKeyEventPtr
    asKeyEvent XEventPtr
    e
                                    EventMask
    ks <- Display -> KeyCode -> CInt -> IO EventMask
    keycodeToKeysym Display
    d (Event -> KeyCode
    ev_keycode Event
    ev) CInt
    0
                                    (EventMask, String, Event) -> IO (EventMask, String, Event)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EventMask
    ks, String
    s, Event
    ev)
                            else (EventMask, String, Event) -> IO (EventMask, String, Event)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EventMask
    noSymbol, String
    "", Event
    ev)
            ((EventMask, String, Event)
    l : [(EventMask, String, Event)]
    ls) -> do
                    (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { eventBuffer = ls }
                    (EventMask, String, Event)
    -> StateT XPState IO (EventMask, String, Event)
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EventMask, String, Event)
    l
        KeyStroke -> Event -> XP ()
    handle (EventMask
    keysym,String
    keystr) Event
    event
        StateT XPState IO Bool
    stopAction StateT XPState IO Bool -> (Bool -> XP ()) -> XP ()
    forall a b.
    StateT XPState IO a
    -> (a -> StateT XPState IO b) -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Bool
    stop -> Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    stop ((KeyStroke -> Event -> XP ()) -> StateT XPState IO Bool -> XP ()
    eventLoop KeyStroke -> Event -> XP ()
    handle StateT XPState IO Bool
    stopAction)

    -- | Default event loop stop condition.
    evDefaultStop :: XP Bool
    evDefaultStop :: StateT XPState IO Bool
    evDefaultStop = (XPState -> Bool -> Bool) -> StateT XPState IO (Bool -> Bool)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Bool -> Bool -> Bool
    (||) (Bool -> Bool -> Bool)
    -> (XPState -> Bool) -> XPState -> Bool -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> Bool
    modeDone) StateT XPState IO (Bool -> Bool)
    -> StateT XPState IO Bool -> StateT XPState IO Bool
    forall a b.
    StateT XPState IO (a -> b)
    -> StateT XPState IO a -> StateT XPState IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (XPState -> Bool) -> StateT XPState IO Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Bool
    done

    -- | Common patterns shared by all event handlers.
    handleOther :: KeyStroke -> Event -> XP ()
    handleOther :: KeyStroke -> Event -> XP ()
    handleOther KeyStroke
    _ ExposeEvent{ev_window :: Event -> EventMask
    ev_window = EventMask
    w} = do
        -- Expose events can be triggered by switching virtual consoles.
        XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
        Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (XPState -> EventMask
    win XPState
    st EventMask -> EventMask -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventMask
    w) XP ()
    updateWindows
    handleOther KeyStroke
    _ ButtonEvent{ev_event_type :: Event -> Dimension
    ev_event_type = Dimension
    t} = do
        -- See Note [Allow ButtonEvents]
        Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Dimension
    t Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    buttonPress) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ do
            Display
    d <- (XPState -> Display) -> StateT XPState IO Display
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Display
    dpy
            IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display -> CInt -> EventMask -> IO ()
    allowEvents Display
    d CInt
    replayPointer EventMask
    currentTime
    handleOther KeyStroke
    _ Event
    _ = () -> XP ()
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    {- Note [Allow ButtonEvents]

    Some settings (like @clickJustFocuses = False@) set up the passive
    pointer grabs that xmonad makes to intercept clicks to unfocused windows
    with @pointer_mode = grabModeSync@ and @keyboard_mode = grabModeSync@.
    This means that any click in an unfocused window leads to a
    pointer/keyboard grab that freezes both devices until 'allowEvents' is
    called. But "XMonad.Prompt" has its own X event loop, so 'allowEvents'
    is never called and everything remains frozen indefinitely.

    This does not happen when the grabs are made with @grabModeAsync@, as
    pointer events processing is not frozen and the grab only lasts as long
    as the mouse button is pressed.

    Hence, in this situation we call 'allowEvents' in the prompts event loop
    whenever a button event is received, releasing the pointer grab. In this
    case, 'replayPointer' takes care of the fact that these events are not
    merely discarded, but passed to the respective application window.
    -}

    -- | Prompt event handler for the main loop. Dispatches to input, completion
    -- and mode switching handlers.
    handleMain :: KeyStroke -> Event -> XP ()
    handleMain :: KeyStroke -> Event -> XP ()
    handleMain stroke :: KeyStroke
    stroke@(EventMask
    keysym, String
    keystr) = \case
        KeyEvent{ev_event_type :: Event -> Dimension
    ev_event_type = Dimension
    t, ev_state :: Event -> KeyMask
    ev_state = KeyMask
    m} -> do
          ((KeyMask, EventMask)
    prevCompKey, ((KeyMask, EventMask)
    compKey, EventMask
    modeKey)) <- (XPState
     -> ((KeyMask, EventMask), ((KeyMask, EventMask), EventMask)))
    -> StateT
         XPState
         IO
         ((KeyMask, EventMask), ((KeyMask, EventMask), EventMask))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XPState
      -> ((KeyMask, EventMask), ((KeyMask, EventMask), EventMask)))
     -> StateT
          XPState
          IO
          ((KeyMask, EventMask), ((KeyMask, EventMask), EventMask)))
    -> (XPState
        -> ((KeyMask, EventMask), ((KeyMask, EventMask), EventMask)))
    -> StateT
         XPState
         IO
         ((KeyMask, EventMask), ((KeyMask, EventMask), EventMask))
    forall a b. (a -> b) -> a -> b
    $
              (XPConfig -> (KeyMask, EventMask)
    prevCompletionKey (XPConfig -> (KeyMask, EventMask))
    -> (XPConfig -> ((KeyMask, EventMask), EventMask))
    -> XPConfig
    -> ((KeyMask, EventMask), ((KeyMask, EventMask), EventMask))
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPConfig -> (KeyMask, EventMask)
    completionKey (XPConfig -> (KeyMask, EventMask))
    -> (XPConfig -> EventMask)
    -> XPConfig
    -> ((KeyMask, EventMask), EventMask)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPConfig -> EventMask
    changeModeKey) (XPConfig
     -> ((KeyMask, EventMask), ((KeyMask, EventMask), EventMask)))
    -> (XPState -> XPConfig)
    -> XPState
    -> ((KeyMask, EventMask), ((KeyMask, EventMask), EventMask))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> XPConfig
    config
          KeyMask
    keymask <- (XPState -> KeyMask -> KeyMask)
    -> StateT XPState IO (KeyMask -> KeyMask)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> KeyMask -> KeyMask
    cleanMask StateT XPState IO (KeyMask -> KeyMask)
    -> StateT XPState IO KeyMask -> StateT XPState IO KeyMask
    forall a b.
    StateT XPState IO (a -> b)
    -> StateT XPState IO a -> StateT XPState IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> KeyMask -> StateT XPState IO KeyMask
    forall a. a -> StateT XPState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure KeyMask
    m
          -- haven't subscribed to keyRelease, so just in case
          Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Dimension
    t Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    keyPress) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ if
              | (KeyMask
    keymask, EventMask
    keysym) (KeyMask, EventMask) -> (KeyMask, EventMask) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (KeyMask, EventMask)
    compKey ->
                   XP (Maybe [String])
    getCurrentCompletions XP (Maybe [String]) -> (Maybe [String] -> XP ()) -> XP ()
    forall a b.
    StateT XPState IO a
    -> (a -> StateT XPState IO b) -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Direction1D -> Maybe [String] -> XP ()
    handleCompletionMain Direction1D
    Next
              | (KeyMask
    keymask, EventMask
    keysym) (KeyMask, EventMask) -> (KeyMask, EventMask) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (KeyMask, EventMask)
    prevCompKey ->
                   XP (Maybe [String])
    getCurrentCompletions XP (Maybe [String]) -> (Maybe [String] -> XP ()) -> XP ()
    forall a b.
    StateT XPState IO a
    -> (a -> StateT XPState IO b) -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Direction1D -> Maybe [String] -> XP ()
    handleCompletionMain Direction1D
    Prev
              | Bool
    otherwise -> do
                   Map (KeyMask, EventMask) (XP ())
    keymap <- (XPState -> Map (KeyMask, EventMask) (XP ()))
    -> StateT XPState IO (Map (KeyMask, EventMask) (XP ()))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (XPConfig -> Map (KeyMask, EventMask) (XP ())
    promptKeymap (XPConfig -> Map (KeyMask, EventMask) (XP ()))
    -> (XPState -> XPConfig)
    -> XPState
    -> Map (KeyMask, EventMask) (XP ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> XPConfig
    config)
                   let mbAction :: Maybe (XP ())
    mbAction = (KeyMask, EventMask)
    -> Map (KeyMask, EventMask) (XP ()) -> Maybe (XP ())
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (KeyMask
    keymask, EventMask
    keysym) Map (KeyMask, EventMask) (XP ())
    keymap
                   -- Either run when we can insert a valid character, or the
                   -- pressed key has an action associated to it.
                   Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (KeyStroke -> Bool
    isModifier KeyStroke
    stroke Bool -> Bool -> Bool
    && Maybe (XP ()) -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe (XP ())
    mbAction) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ do
                       Maybe [String] -> XP ()
    setCurrentCompletions Maybe [String]
    forall a. Maybe a
    Nothing
                       if EventMask
    keysym EventMask -> EventMask -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventMask
    modeKey
                          then (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify XPState -> XPState
    setNextMode XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    updateWindows
                          else KeyMask -> Maybe (XP ()) -> XP ()
    handleInput KeyMask
    keymask Maybe (XP ())
    mbAction
        Event
    event -> KeyStroke -> Event -> XP ()
    handleOther KeyStroke
    stroke Event
    event
      where
        -- Prompt input handler for the main loop.
        handleInput :: KeyMask -> Maybe (XP ()) -> XP ()
        handleInput :: KeyMask -> Maybe (XP ()) -> XP ()
    handleInput KeyMask
    keymask = \case
            Just XP ()
    action -> XP ()
    action XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    updateWindows
            Maybe (XP ())
    Nothing     -> Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (KeyMask
    keymask KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .&. KeyMask
    controlMask KeyMask -> KeyMask -> Bool
    forall a. Eq a => a -> a -> Bool
    == KeyMask
    0) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ do
                String -> XP ()
    insertString (String -> XP ()) -> String -> XP ()
    forall a b. (a -> b) -> a -> b
    $ String -> String
    utf8Decode String
    keystr
                XP ()
    updateWindows
                XP ()
    updateHighlightedCompl
                Bool
    complete <- StateT XPState IO Bool
    tryAutoComplete
                Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    complete XP ()
    acceptSelection

    -- There are two options to store the completion list during the main loop:
    -- * Use the State monad, with 'Nothing' as the initial state.
    -- * Join the output of the event loop handler to the input of the (same)
    --   subsequent handler, using 'Nothing' as the initial input.
    -- Both approaches are, under the hood, equivalent.
    --
    -- | Prompt completion handler for the main loop. Given 'Nothing', generate the
    -- current completion list. With the current list, trigger a completion.
    handleCompletionMain :: Direction1D -> Maybe [String] -> XP ()
    handleCompletionMain :: Direction1D -> Maybe [String] -> XP ()
    handleCompletionMain Direction1D
    dir Maybe [String]
    compls = case Maybe [String]
    compls of
       Just [String]
    cs -> Direction1D -> [String] -> XP ()
    handleCompletion Direction1D
    dir [String]
    cs
       Maybe [String]
    Nothing -> do
           [String]
    cs <- StateT XPState IO [String]
    getCompletions
           Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    cs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $
               (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { showComplWin = True }
           Maybe [String] -> XP ()
    setCurrentCompletions (Maybe [String] -> XP ()) -> Maybe [String] -> XP ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> Maybe [String]
    forall a. a -> Maybe a
    Just [String]
    cs
           Direction1D -> [String] -> XP ()
    handleCompletion Direction1D
    dir [String]
    cs

    handleCompletion :: Direction1D -> [String] -> XP ()
    handleCompletion :: Direction1D -> [String] -> XP ()
    handleCompletion Direction1D
    dir [String]
    cs = do
        Bool
    alwaysHlight <- (XPState -> Bool) -> StateT XPState IO Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XPState -> Bool) -> StateT XPState IO Bool)
    -> (XPState -> Bool) -> StateT XPState IO Bool
    forall a b. (a -> b) -> a -> b
    $ XPConfig -> Bool
    alwaysHighlight (XPConfig -> Bool) -> (XPState -> XPConfig) -> XPState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> XPConfig
    config
        XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get

        let updateWins :: [String] -> XP ()
    updateWins    = XP () -> [String] -> XP ()
    redrawWindows (() -> XP ()
    forall a. a -> StateT XPState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())
            updateState :: [String] -> XP ()
    updateState [String]
    l = if Bool
    alwaysHlight
                then String -> [String] -> XPState -> XP ()
    hlComplete (String -> String
    getLastWord (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ XPState -> String
    command XPState
    st) [String]
    l XPState
    st
                else [String] -> XPState -> XP ()
    simpleComplete                        [String]
    l XPState
    st

        case [String]
    cs of
          []  -> XP ()
    updateWindows
          [String
    x] -> do [String] -> XP ()
    updateState [String
    x]
                    [String]
    cs' <- StateT XPState IO [String]
    getCompletions
                    [String] -> XP ()
    updateWins [String]
    cs'
                    Maybe [String] -> XP ()
    setCurrentCompletions (Maybe [String] -> XP ()) -> Maybe [String] -> XP ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> Maybe [String]
    forall a. a -> Maybe a
    Just [String]
    cs'
          [String]
    l   -> [String] -> XP ()
    updateState [String]
    l   XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [String] -> XP ()
    updateWins [String]
    l
        where
            -- When alwaysHighlight is off, just complete based on what the
            -- user has typed so far.
            simpleComplete :: [String] -> XPState -> XP ()
            simpleComplete :: [String] -> XPState -> XP ()
    simpleComplete [String]
    l XPState
    st = do
              let newCommand :: String
    newCommand = XPType -> String -> [String] -> String
    forall t. XPrompt t => t -> String -> [String] -> String
    nextCompletion (XPState -> XPType
    currentXPMode XPState
    st) (XPState -> String
    command XPState
    st) [String]
    l
              (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> String -> XPState -> XPState
    setCommand String
    newCommand (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $
                             XPState
    s { offset = length newCommand
                               , highlightedCompl = Just newCommand
                               }

            -- If alwaysHighlight is on, and the user wants the next
            -- completion, move to the next completion item and update the
            -- buffer to reflect that.
            --
            --TODO: Scroll or paginate results
            hlComplete :: String -> [String] -> XPState -> XP ()
            hlComplete :: String -> [String] -> XPState -> XP ()
    hlComplete String
    prevCompl [String]
    l XPState
    st
              | -- The current suggestion matches the command and is a
                -- proper suffix of the last suggestion, so replace it.
                Bool
    isSuffixOfCmd Bool -> Bool -> Bool
    && Bool
    isProperSuffixOfLast = String -> XP ()
    replaceCompletion String
    prevCompl

              | -- We only have one suggestion, so we need to be a little
                -- bit smart in order to avoid a loop.
                Just (String
    ch :| []) <- [String] -> Maybe (NonEmpty String)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty [String]
    cs =
                  if XPState -> String
    command XPState
    st String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    hlCompl
                  then XPState -> XP ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put XPState
    st
                  else String -> XP ()
    replaceCompletion String
    ch

                -- The current suggestion matches the command, so advance
                -- to the next completion and try again.
              | Bool
    isSuffixOfCmd =
                  String -> [String] -> XPState -> XP ()
    hlComplete String
    hlCompl [String]
    l (XPState -> XP ()) -> XPState -> XP ()
    forall a b. (a -> b) -> a -> b
    $ XPState
    st{ complIndex = complIndex'
                                           , highlightedCompl = nextHlCompl
                                           }

                -- If nothing matches at all, delete the suggestion and
                -- highlight the next one.
              | Bool
    otherwise = String -> XP ()
    replaceCompletion String
    prevCompl
             where
              String
    hlCompl     :: String       = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe (XPState -> String
    command XPState
    st) (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ XPState -> [String] -> Maybe String
    highlightedItem XPState
    st [String]
    l
              (Int, Int)
    complIndex' :: (Int, Int)   = Direction1D -> XPState -> (Int, Int)
    computeComplIndex Direction1D
    dir XPState
    st
              Maybe String
    nextHlCompl :: Maybe String = XPState -> [String] -> Maybe String
    highlightedItem XPState
    st{ complIndex = complIndex' } [String]
    cs

              Bool
    isSuffixOfCmd        :: Bool = String
    hlCompl String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` XPState -> String
    command XPState
    st
              Bool
    isProperSuffixOfLast :: Bool =      String
    hlCompl   String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    prevCompl
                                          Bool -> Bool -> Bool
    && Bool -> Bool
    not (String
    prevCompl String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    hlCompl)

              String -> XP ()
    replaceCompletion :: String -> XP () = \String
    str -> do
                  XPState -> XP ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put XPState
    st
                  Int -> XP () -> XP ()
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
    replicateM_ ([String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([String] -> Int) -> [String] -> Int
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    words String
    str) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Direction1D -> XP ()
    killWord Direction1D
    Prev
                  String -> XP ()
    insertString' String
    hlCompl
                  XP ()
    endOfLine

    -- | Initiate a prompt sub-map event loop. Submaps are intended to provide
    -- alternate keybindings. Accepts a default action and a mapping from key
    -- combinations to actions. If no entry matches, the default action is run.
    promptSubmap :: XP ()
                 -> M.Map (KeyMask, KeySym) (XP ())
                 -> XP ()
    promptSubmap :: XP () -> Map (KeyMask, EventMask) (XP ()) -> XP ()
    promptSubmap XP ()
    defaultAction Map (KeyMask, EventMask) (XP ())
    keymap = do
        Bool
    md <- (XPState -> Bool) -> StateT XPState IO Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Bool
    modeDone
        Bool -> XP ()
    setModeDone Bool
    False
        XP ()
    updateWindows
        (KeyStroke -> Event -> XP ()) -> StateT XPState IO Bool -> XP ()
    eventLoop (XP ()
    -> Map (KeyMask, EventMask) (XP ()) -> KeyStroke -> Event -> XP ()
    handleSubmap XP ()
    defaultAction Map (KeyMask, EventMask) (XP ())
    keymap) StateT XPState IO Bool
    evDefaultStop
        Bool -> XP ()
    setModeDone Bool
    md

    handleSubmap :: XP ()
                 -> M.Map (KeyMask, KeySym) (XP ())
                 -> KeyStroke
                 -> Event
                 -> XP ()
    handleSubmap :: XP ()
    -> Map (KeyMask, EventMask) (XP ()) -> KeyStroke -> Event -> XP ()
    handleSubmap XP ()
    defaultAction Map (KeyMask, EventMask) (XP ())
    keymap KeyStroke
    stroke KeyEvent{ev_event_type :: Event -> Dimension
    ev_event_type = Dimension
    t, ev_state :: Event -> KeyMask
    ev_state = KeyMask
    m} = do
        KeyMask
    keymask <- (XPState -> KeyMask -> KeyMask)
    -> StateT XPState IO (KeyMask -> KeyMask)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> KeyMask -> KeyMask
    cleanMask StateT XPState IO (KeyMask -> KeyMask)
    -> StateT XPState IO KeyMask -> StateT XPState IO KeyMask
    forall a b.
    StateT XPState IO (a -> b)
    -> StateT XPState IO a -> StateT XPState IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> KeyMask -> StateT XPState IO KeyMask
    forall a. a -> StateT XPState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure KeyMask
    m
        Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Dimension
    t Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    keyPress) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ XP ()
    -> Map (KeyMask, EventMask) (XP ())
    -> KeyMask
    -> KeyStroke
    -> XP ()
    handleInputSubmap XP ()
    defaultAction Map (KeyMask, EventMask) (XP ())
    keymap KeyMask
    keymask KeyStroke
    stroke
    handleSubmap XP ()
    _ Map (KeyMask, EventMask) (XP ())
    _ KeyStroke
    stroke Event
    event = KeyStroke -> Event -> XP ()
    handleOther KeyStroke
    stroke Event
    event

    handleInputSubmap :: XP ()
                      -> M.Map (KeyMask, KeySym) (XP ())
                      -> KeyMask
                      -> KeyStroke
                      -> XP ()
    handleInputSubmap :: XP ()
    -> Map (KeyMask, EventMask) (XP ())
    -> KeyMask
    -> KeyStroke
    -> XP ()
    handleInputSubmap XP ()
    defaultAction Map (KeyMask, EventMask) (XP ())
    keymap KeyMask
    keymask stroke :: KeyStroke
    stroke@(EventMask
    keysym, String
    _) =
        case (KeyMask, EventMask)
    -> Map (KeyMask, EventMask) (XP ()) -> Maybe (XP ())
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (KeyMask
    keymask,EventMask
    keysym) Map (KeyMask, EventMask) (XP ())
    keymap of
            Just XP ()
    action -> XP ()
    action XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    updateWindows
            Maybe (XP ())
    Nothing     -> Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (KeyStroke -> Bool
    isModifier KeyStroke
    stroke) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ XP ()
    defaultAction XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    updateWindows

    -- | Initiate a prompt input buffer event loop. Input is sent to a buffer and
    -- bypasses the prompt. The provided function is given the existing buffer and
    -- the input keystring. The first field of the result determines whether the
    -- input loop continues (if @True@). The second field determines whether the
    -- input is appended to the buffer, or dropped (if @False@). If the loop is to
    -- stop without keeping input - that is, @(False,False)@ - the event is
    -- prepended to the event buffer to be processed by the parent loop. This
    -- allows loop to process both fixed and indeterminate inputs.
    --
    -- Result given @(continue,keep)@:
    --
    -- * cont and keep
    --
    --      * grow input buffer
    --
    -- * stop and keep
    --
    --      * grow input buffer
    --      * stop loop
    --
    -- * stop and drop
    --
    --      * buffer event
    --      * stop loop
    --
    -- * cont and drop
    --
    --      * do nothing
    promptBuffer :: (String -> String -> (Bool,Bool)) -> XP String
    promptBuffer :: (String -> String -> (Bool, Bool)) -> XP String
    promptBuffer String -> String -> (Bool, Bool)
    f = do
        Bool
    md <- (XPState -> Bool) -> StateT XPState IO Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Bool
    modeDone
        Bool -> XP ()
    setModeDone Bool
    False
        (KeyStroke -> Event -> XP ()) -> StateT XPState IO Bool -> XP ()
    eventLoop ((String -> String -> (Bool, Bool)) -> KeyStroke -> Event -> XP ()
    handleBuffer String -> String -> (Bool, Bool)
    f) StateT XPState IO Bool
    evDefaultStop
        String
    buff <- (XPState -> String) -> XP String
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> String
    inputBuffer
        (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { inputBuffer = "" }
        Bool -> XP ()
    setModeDone Bool
    md
        String -> XP String
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    buff

    handleBuffer :: (String -> String -> (Bool,Bool))
                 -> KeyStroke
                 -> Event
                 -> XP ()
    handleBuffer :: (String -> String -> (Bool, Bool)) -> KeyStroke -> Event -> XP ()
    handleBuffer String -> String -> (Bool, Bool)
    f KeyStroke
    stroke event :: Event
    event@KeyEvent{ev_event_type :: Event -> Dimension
    ev_event_type = Dimension
    t, ev_state :: Event -> KeyMask
    ev_state = KeyMask
    m} = do
        KeyMask
    keymask <- (XPState -> KeyMask -> KeyMask)
    -> StateT XPState IO (KeyMask -> KeyMask)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> KeyMask -> KeyMask
    cleanMask StateT XPState IO (KeyMask -> KeyMask)
    -> StateT XPState IO KeyMask -> StateT XPState IO KeyMask
    forall a b.
    StateT XPState IO (a -> b)
    -> StateT XPState IO a -> StateT XPState IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> KeyMask -> StateT XPState IO KeyMask
    forall a. a -> StateT XPState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure KeyMask
    m
        Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Dimension
    t Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    keyPress) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ (String -> String -> (Bool, Bool))
    -> KeyMask -> KeyStroke -> Event -> XP ()
    handleInputBuffer String -> String -> (Bool, Bool)
    f KeyMask
    keymask KeyStroke
    stroke Event
    event
    handleBuffer String -> String -> (Bool, Bool)
    _ KeyStroke
    stroke Event
    event = KeyStroke -> Event -> XP ()
    handleOther KeyStroke
    stroke Event
    event

    handleInputBuffer :: (String -> String -> (Bool,Bool))
                      -> KeyMask
                      -> KeyStroke
                      -> Event
                      -> XP ()
    handleInputBuffer :: (String -> String -> (Bool, Bool))
    -> KeyMask -> KeyStroke -> Event -> XP ()
    handleInputBuffer String -> String -> (Bool, Bool)
    f KeyMask
    keymask stroke :: KeyStroke
    stroke@(EventMask
    keysym, String
    keystr) Event
    event =
        Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (KeyStroke -> Bool
    isModifier KeyStroke
    stroke Bool -> Bool -> Bool
    || KeyMask
    keymask KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .&. KeyMask
    controlMask KeyMask -> KeyMask -> Bool
    forall a. Eq a => a -> a -> Bool
    /= KeyMask
    0) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ do
            ([(EventMask, String, Event)]
    evB,String
    inB) <- (XPState -> ([(EventMask, String, Event)], String))
    -> StateT XPState IO ([(EventMask, String, Event)], String)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (XPState -> [(EventMask, String, Event)]
    eventBuffer (XPState -> [(EventMask, String, Event)])
    -> (XPState -> String)
    -> XPState
    -> ([(EventMask, String, Event)], String)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> String
    inputBuffer)
            let keystr' :: String
    keystr' = String -> String
    utf8Decode String
    keystr
            let (Bool
    cont,Bool
    keep) = String -> String -> (Bool, Bool)
    f String
    inB String
    keystr'
            Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    keep (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $
                (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { inputBuffer = inB ++ keystr' }
            Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    cont (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $
                Bool -> XP ()
    setModeDone Bool
    True
            Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Bool
    cont Bool -> Bool -> Bool
    || Bool
    keep) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $
                (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { eventBuffer = (keysym,keystr,event) : evB }

    -- | Predicate instructing 'promptBuffer' to get (and keep) a single non-empty
    -- 'KeyEvent'.
    bufferOne :: String -> String -> (Bool,Bool)
    bufferOne :: String -> String -> (Bool, Bool)
    bufferOne String
    xs String
    x = (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    xs Bool -> Bool -> Bool
    && String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    x,Bool
    True)

    -- | Return the @(column, row)@ of the desired highlight, or @(0, 0)@ if
    -- there is no prompt window or a wrap-around occurs.
    computeComplIndex :: Direction1D -> XPState -> (Int, Int)
    computeComplIndex :: Direction1D -> XPState -> (Int, Int)
    computeComplIndex Direction1D
    dir XPState
    st = case XPState -> Maybe ComplWindowDim
    complWinDim XPState
    st of
      Maybe ComplWindowDim
    Nothing -> (Int
    0, Int
    0)  -- no window dimensions (just destroyed or not created)
      Just ComplWindowDim{ [Position]
    cwCols :: ComplWindowDim -> [Position]
    cwCols :: [Position]
    cwCols, [Position]
    cwRows :: ComplWindowDim -> [Position]
    cwRows :: [Position]
    cwRows } ->
        if Int
    rowm Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    currentrow Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    direction
        then (Int
    currentcol, Int
    rowm)  -- We are not in the last row, so advance the row
        else (Int
    colm, Int
    rowm)        -- otherwise advance to the respective column
       where
        (Int
    currentcol, Int
    currentrow) = XPState -> (Int, Int)
    complIndex XPState
    st
        (Int
    colm, Int
    rowm) =
          ( (Int
    currentcol Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    direction) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` [Position] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Position]
    cwCols
          , (Int
    currentrow Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    direction) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` [Position] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Position]
    cwRows
          )
        direction :: Int
    direction = case Direction1D
    dir of
          Direction1D
    Next ->  Int
    1
          Direction1D
    Prev -> -Int
    1

    tryAutoComplete :: XP Bool
    tryAutoComplete :: StateT XPState IO Bool
    tryAutoComplete = do
        Maybe Int
    ac <- (XPState -> Maybe Int) -> StateT XPState IO (Maybe Int)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (XPConfig -> Maybe Int
    autoComplete (XPConfig -> Maybe Int)
    -> (XPState -> XPConfig) -> XPState -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> XPConfig
    config)
        case Maybe Int
    ac of
            Just Int
    d -> do [String]
    cs <- StateT XPState IO [String]
    getCompletions
                         case [String]
    cs of
                             [String
    c] -> String -> Int -> StateT XPState IO Bool
    runCompleted String
    c Int
    d StateT XPState IO Bool
    -> StateT XPState IO Bool -> StateT XPState IO Bool
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> StateT XPState IO Bool
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                             [String]
    _   -> Bool -> StateT XPState IO Bool
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            Maybe Int
    Nothing    -> Bool -> StateT XPState IO Bool
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      where runCompleted :: String -> Int -> StateT XPState IO Bool
    runCompleted String
    cmd Int
    delay = do
                XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
                let new_command :: String
    new_command = XPType -> String -> [String] -> String
    forall t. XPrompt t => t -> String -> [String] -> String
    nextCompletion (XPState -> XPType
    currentXPMode XPState
    st) (XPState -> String
    command XPState
    st) [String
    cmd]
                (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ String -> XPState -> XPState
    setCommand String
    "autocompleting..."
                XP ()
    updateWindows
                IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Int -> IO ()
    threadDelay Int
    delay
                (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ String -> XPState -> XPState
    setCommand String
    new_command
                Bool -> StateT XPState IO Bool
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    -- KeyPresses

    -- | Default key bindings for prompts.  Click on the \"Source\" link
    --   to the right to see the complete list.  See also 'defaultXPKeymap''.
    defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
    defaultXPKeymap :: Map (KeyMask, EventMask) (XP ())
    defaultXPKeymap = (Char -> Bool) -> Map (KeyMask, EventMask) (XP ())
    defaultXPKeymap' Char -> Bool
    isSpace

    -- | A variant of 'defaultXPKeymap' which lets you specify a custom
    --   predicate for identifying non-word characters, which affects all
    --   the word-oriented commands (move\/kill word).  The default is
    --   'isSpace'.  For example, by default a path like @foo\/bar\/baz@
    --   would be considered as a single word.  You could use a predicate
    --   like @(\\c -> isSpace c || c == \'\/\')@ to move through or
    --   delete components of the path one at a time.
    defaultXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())
    defaultXPKeymap' :: (Char -> Bool) -> Map (KeyMask, EventMask) (XP ())
    defaultXPKeymap' Char -> Bool
    p = [((KeyMask, EventMask), XP ())] -> Map (KeyMask, EventMask) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, EventMask), XP ())]
     -> Map (KeyMask, EventMask) (XP ()))
    -> [((KeyMask, EventMask), XP ())]
    -> Map (KeyMask, EventMask) (XP ())
    forall a b. (a -> b) -> a -> b
    $
      ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ())
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((EventMask -> (KeyMask, EventMask))
     -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> (EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    controlMask) -- control + <key>
      [ (EventMask
    xK_u, XP ()
    killBefore)
      , (EventMask
    xK_k, XP ()
    killAfter)
      , (EventMask
    xK_a, XP ()
    startOfLine)
      , (EventMask
    xK_e, XP ()
    endOfLine)
      , (EventMask
    xK_y, XP ()
    pasteString)
      -- Retain the pre-0.14 moveWord' behavior:
      , (EventMask
    xK_Right, (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    p Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Next)
      , (EventMask
    xK_Left, Direction1D -> XP ()
    moveCursor Direction1D
    Prev XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    p Direction1D
    Prev)
      , (EventMask
    xK_Delete, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Next)
      , (EventMask
    xK_BackSpace, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Prev)
      , (EventMask
    xK_w, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Prev)
      , (EventMask
    xK_g, XP ()
    quit)
      , (EventMask
    xK_bracketleft, XP ()
    quit)
      ] [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
      ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ())
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((EventMask -> (KeyMask, EventMask))
     -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> (EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    0)
      [ (EventMask
    xK_Return, XP ()
    acceptSelection)
      , (EventMask
    xK_KP_Enter, XP ()
    acceptSelection)
      , (EventMask
    xK_BackSpace, Direction1D -> XP ()
    deleteString Direction1D
    Prev)
      , (EventMask
    xK_Delete, Direction1D -> XP ()
    deleteString Direction1D
    Next)
      , (EventMask
    xK_Left, Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
      , (EventMask
    xK_Right, Direction1D -> XP ()
    moveCursor Direction1D
    Next)
      , (EventMask
    xK_Home, XP ()
    startOfLine)
      , (EventMask
    xK_End, XP ()
    endOfLine)
      , (EventMask
    xK_Down, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
      , (EventMask
    xK_Up, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
      , (EventMask
    xK_Escape, XP ()
    quit)
      ]

    -- | A keymap with many emacs-like key bindings.  Click on the
    --   \"Source\" link to the right to see the complete list.
    --   See also 'emacsLikeXPKeymap''.
    emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
    emacsLikeXPKeymap :: Map (KeyMask, EventMask) (XP ())
    emacsLikeXPKeymap = (Char -> Bool) -> Map (KeyMask, EventMask) (XP ())
    emacsLikeXPKeymap' Char -> Bool
    isSpace

    -- | A variant of 'emacsLikeXPKeymap' which lets you specify a custom
    --   predicate for identifying non-word characters, which affects all
    --   the word-oriented commands (move\/kill word).  The default is
    --   'isSpace'.  For example, by default a path like @foo\/bar\/baz@
    --   would be considered as a single word.  You could use a predicate
    --   like @(\\c -> isSpace c || c == \'\/\')@ to move through or
    --   delete components of the path one at a time.
    emacsLikeXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())
    emacsLikeXPKeymap' :: (Char -> Bool) -> Map (KeyMask, EventMask) (XP ())
    emacsLikeXPKeymap' Char -> Bool
    p = [((KeyMask, EventMask), XP ())] -> Map (KeyMask, EventMask) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, EventMask), XP ())]
     -> Map (KeyMask, EventMask) (XP ()))
    -> [((KeyMask, EventMask), XP ())]
    -> Map (KeyMask, EventMask) (XP ())
    forall a b. (a -> b) -> a -> b
    $
      ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ())
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((EventMask -> (KeyMask, EventMask))
     -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> (EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    controlMask) -- control + <key>
      [ (EventMask
    xK_z, XP ()
    killBefore) --kill line backwards
      , (EventMask
    xK_k, XP ()
    killAfter) -- kill line fowards
      , (EventMask
    xK_a, XP ()
    startOfLine) --move to the beginning of the line
      , (EventMask
    xK_e, XP ()
    endOfLine) -- move to the end of the line
      , (EventMask
    xK_d, Direction1D -> XP ()
    deleteString Direction1D
    Next) -- delete a character foward
      , (EventMask
    xK_b, Direction1D -> XP ()
    moveCursor Direction1D
    Prev) -- move cursor forward
      , (EventMask
    xK_f, Direction1D -> XP ()
    moveCursor Direction1D
    Next) -- move cursor backward
      , (EventMask
    xK_BackSpace, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Prev) -- kill the previous word
      , (EventMask
    xK_y, XP ()
    pasteString)
      , (EventMask
    xK_g, XP ()
    quit)
      , (EventMask
    xK_bracketleft, XP ()
    quit)
      , (EventMask
    xK_t, XP ()
    transposeChars)
      , (EventMask
    xK_m, XP ()
    acceptSelection)
      ] [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
      ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ())
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((EventMask -> (KeyMask, EventMask))
     -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> (EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    mod1Mask) -- meta key + <key>
      [ (EventMask
    xK_BackSpace, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Prev)
      -- Retain the pre-0.14 moveWord' behavior:
      , (EventMask
    xK_f, (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    p Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Next) -- move a word forward
      , (EventMask
    xK_b, Direction1D -> XP ()
    moveCursor Direction1D
    Prev XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    p Direction1D
    Prev) -- move a word backward
      , (EventMask
    xK_d, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Next) -- kill the next word
      , (EventMask
    xK_n, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
      , (EventMask
    xK_p, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
      ]
      [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
      ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ())
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((EventMask -> (KeyMask, EventMask))
     -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> (EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    0) -- <key>
      [ (EventMask
    xK_Return, XP ()
    acceptSelection)
      , (EventMask
    xK_KP_Enter, XP ()
    acceptSelection)
      , (EventMask
    xK_BackSpace, Direction1D -> XP ()
    deleteString Direction1D
    Prev)
      , (EventMask
    xK_Delete, Direction1D -> XP ()
    deleteString Direction1D
    Next)
      , (EventMask
    xK_Left, Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
      , (EventMask
    xK_Right, Direction1D -> XP ()
    moveCursor Direction1D
    Next)
      , (EventMask
    xK_Home, XP ()
    startOfLine)
      , (EventMask
    xK_End, XP ()
    endOfLine)
      , (EventMask
    xK_Down, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
      , (EventMask
    xK_Up, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
      , (EventMask
    xK_Escape, XP ()
    quit)
      ]

    -- | Vim-ish key bindings. Click on the \"Source\" link to the right to see the
    -- complete list. See also 'vimLikeXPKeymap''.
    vimLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
    vimLikeXPKeymap :: Map (KeyMask, EventMask) (XP ())
    vimLikeXPKeymap = (XPColor -> XPColor)
    -> (String -> String)
    -> (String -> String)
    -> (Char -> Bool)
    -> Map (KeyMask, EventMask) (XP ())
    vimLikeXPKeymap' (String -> XPColor -> XPColor
    setBorderColor String
    "grey22") String -> String
    forall a. a -> a
    id String -> String
    forall a. a -> a
    id Char -> Bool
    isSpace

    -- | A variant of 'vimLikeXPKeymap' with customizable aspects:
    vimLikeXPKeymap' :: (XPColor -> XPColor)
                        -- ^ Modifies the prompt color when entering normal mode.
                        -- The default is @setBorderColor "grey22"@ - same color as
                        -- the default background color.
                     -> (String -> String)
                        -- ^ Prompter to use in normal mode. The default of 'id'
                        -- balances 'defaultPrompter' but @("[n] " ++)@ is a good
                        -- alternate with 'defaultPrompter' as @("[i] " ++)@.
                     -> (String -> String)
                        -- ^ Filter applied to the X Selection before pasting. The
                        -- default is 'id' but @filter isPrint@ is a good
                        -- alternate.
                     -> (Char -> Bool)
                        -- ^ Predicate identifying non-word characters. The default
                        -- is 'isSpace'. See the documentation of other keymaps for
                        -- alternates.
                     -> M.Map (KeyMask,KeySym) (XP ())
    vimLikeXPKeymap' :: (XPColor -> XPColor)
    -> (String -> String)
    -> (String -> String)
    -> (Char -> Bool)
    -> Map (KeyMask, EventMask) (XP ())
    vimLikeXPKeymap' XPColor -> XPColor
    fromColor String -> String
    promptF String -> String
    pasteFilter Char -> Bool
    notWord = [((KeyMask, EventMask), XP ())] -> Map (KeyMask, EventMask) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, EventMask), XP ())]
     -> Map (KeyMask, EventMask) (XP ()))
    -> [((KeyMask, EventMask), XP ())]
    -> Map (KeyMask, EventMask) (XP ())
    forall a b. (a -> b) -> a -> b
    $
        ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ())
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((EventMask -> (KeyMask, EventMask))
     -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> (EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    controlMask) -- control + <key>
        [ (EventMask
    xK_m, XP ()
    acceptSelection)
        ] [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
        ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ())
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((EventMask -> (KeyMask, EventMask))
     -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> (EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    0)
        [ (EventMask
    xK_Return,       XP ()
    acceptSelection)
        , (EventMask
    xK_KP_Enter,     XP ()
    acceptSelection)
        , (EventMask
    xK_BackSpace,    Direction1D -> XP ()
    deleteString Direction1D
    Prev)
        , (EventMask
    xK_Delete,       Direction1D -> XP ()
    deleteString Direction1D
    Next)
        , (EventMask
    xK_Left,         Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
        , (EventMask
    xK_Right,        Direction1D -> XP ()
    moveCursor Direction1D
    Next)
        , (EventMask
    xK_Home,         XP ()
    startOfLine)
        , (EventMask
    xK_End,          XP ()
    endOfLine)
        , (EventMask
    xK_Down,         (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
        , (EventMask
    xK_Up,           (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
        , (EventMask
    xK_Escape,       Direction1D -> XP ()
    moveCursor Direction1D
    Prev
                                XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (XPColor -> XPColor) -> XP ()
    modifyColor XPColor -> XPColor
    fromColor
                                XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (String -> String) -> XP ()
    setPrompter String -> String
    promptF
                                XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP () -> Map (KeyMask, EventMask) (XP ()) -> XP ()
    promptSubmap (() -> XP ()
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) Map (KeyMask, EventMask) (XP ())
    normalVimXPKeymap
                                XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    resetColor
                                XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    resetPrompter
          )
        ] where
        normalVimXPKeymap :: Map (KeyMask, EventMask) (XP ())
    normalVimXPKeymap = [((KeyMask, EventMask), XP ())] -> Map (KeyMask, EventMask) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, EventMask), XP ())]
     -> Map (KeyMask, EventMask) (XP ()))
    -> [((KeyMask, EventMask), XP ())]
    -> Map (KeyMask, EventMask) (XP ())
    forall a b. (a -> b) -> a -> b
    $
            ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ())
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((EventMask -> (KeyMask, EventMask))
     -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> (EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    0)
            [ (EventMask
    xK_i,            Bool -> XP ()
    setModeDone Bool
    True)
            , (EventMask
    xK_a,            Direction1D -> XP ()
    moveCursor Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True)
            , (EventMask
    xK_s,            Direction1D -> XP ()
    deleteString Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True)
            , (EventMask
    xK_x,            Direction1D -> XP ()
    deleteString Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    clipCursor)
            , (EventMask
    xK_Delete,       Direction1D -> XP ()
    deleteString Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    clipCursor)
            , (EventMask
    xK_p,            Direction1D -> XP ()
    moveCursor Direction1D
    Next
                                    XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (String -> String) -> XP ()
    pasteString' String -> String
    pasteFilter
                                    XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Prev
              )
            , (EventMask
    xK_0,            XP ()
    startOfLine)
            , (EventMask
    xK_Escape,       XP ()
    quit)
            , (EventMask
    xK_Down,         (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
            , (EventMask
    xK_j,            (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
            , (EventMask
    xK_Up,           (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
            , (EventMask
    xK_k,            (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
            , (EventMask
    xK_Right,        Direction1D -> XP ()
    moveCursorClip Direction1D
    Next)
            , (EventMask
    xK_l,            Direction1D -> XP ()
    moveCursorClip Direction1D
    Next)
            , (EventMask
    xK_h,            Direction1D -> XP ()
    moveCursorClip Direction1D
    Prev)
            , (EventMask
    xK_Left,         Direction1D -> XP ()
    moveCursorClip Direction1D
    Prev)
            , (EventMask
    xK_BackSpace,    Direction1D -> XP ()
    moveCursorClip Direction1D
    Prev)
            -- Implementation using the original 'moveWord'':
            --, (xK_e,            moveCursor Next >> moveWord' notWord Next >> moveCursor Prev)
            --, (xK_b,            moveWord' notWord Prev)
            --, (xK_w,            moveWord' (not . notWord) Next >> clipCursor)
            , (EventMask
    xK_e,            Direction1D -> XP ()
    moveCursorClip Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    notWord Direction1D
    Next)
            , (EventMask
    xK_b,            Direction1D -> XP ()
    moveCursorClip Direction1D
    Prev XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    notWord Direction1D
    Prev)
            , (EventMask
    xK_w,            (Char -> Bool) -> Direction1D -> XP ()
    moveWord' (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    notWord) Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursorClip Direction1D
    Next)
            , (EventMask
    xK_f,            (String -> String -> (Bool, Bool)) -> XP String
    promptBuffer String -> String -> (Bool, Bool)
    bufferOne XP String -> (String -> XP ()) -> XP ()
    forall a b.
    StateT XPState IO a
    -> (a -> StateT XPState IO b) -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Direction1D -> String -> XP ()
    toHeadChar Direction1D
    Next)
            , (EventMask
    xK_d,            XP () -> Map (KeyMask, EventMask) (XP ()) -> XP ()
    promptSubmap (Bool -> XP ()
    setModeDone Bool
    True) Map (KeyMask, EventMask) (XP ())
    deleteVimXPKeymap)
            , (EventMask
    xK_c,            XP () -> Map (KeyMask, EventMask) (XP ()) -> XP ()
    promptSubmap (Bool -> XP ()
    setModeDone Bool
    True) Map (KeyMask, EventMask) (XP ())
    changeVimXPKeymap
                                    XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True
              )
            , (EventMask
    xK_Return,       XP ()
    acceptSelection)
            , (EventMask
    xK_KP_Enter,     XP ()
    acceptSelection)
            ] [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
            ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ())
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((EventMask -> (KeyMask, EventMask))
     -> (EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> (EventMask -> (KeyMask, EventMask))
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    shiftMask)
            [ (EventMask
    xK_dollar,       XP ()
    endOfLine XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
            , (EventMask
    xK_D,            XP ()
    killAfter XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
            , (EventMask
    xK_C,            XP ()
    killAfter XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True)
            , (EventMask
    xK_P,            (String -> String) -> XP ()
    pasteString' String -> String
    pasteFilter XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
            , (EventMask
    xK_A,            XP ()
    endOfLine XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True)
            , (EventMask
    xK_I,            XP ()
    startOfLine XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True)
            , (EventMask
    xK_F,            (String -> String -> (Bool, Bool)) -> XP String
    promptBuffer String -> String -> (Bool, Bool)
    bufferOne XP String -> (String -> XP ()) -> XP ()
    forall a b.
    StateT XPState IO a
    -> (a -> StateT XPState IO b) -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Direction1D -> String -> XP ()
    toHeadChar Direction1D
    Prev)
            ]
        deleteVimXPKeymap :: Map (KeyMask, EventMask) (XP ())
    deleteVimXPKeymap = [((KeyMask, EventMask), XP ())] -> Map (KeyMask, EventMask) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, EventMask), XP ())]
     -> Map (KeyMask, EventMask) (XP ()))
    -> [((KeyMask, EventMask), XP ())]
    -> Map (KeyMask, EventMask) (XP ())
    forall a b. (a -> b) -> a -> b
    $
            ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (XP () -> XP ())
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap (KeyMask
    0 ,) (XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True))
            [ (EventMask
    xK_e,            Direction1D -> XP ()
    deleteString Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    notWord Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    clipCursor)
            , (EventMask
    xK_w,            (Char -> Bool) -> Direction1D -> XP ()
    killWord' (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    notWord) Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    clipCursor)
            , (EventMask
    xK_0,            XP ()
    killBefore)
            , (EventMask
    xK_b,            (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    notWord Direction1D
    Prev)
            , (EventMask
    xK_d,            String -> XP ()
    setInput String
    "")
            ] [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
            ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (XP () -> XP ())
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap (KeyMask
    shiftMask ,) (XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True))
            [ (EventMask
    xK_dollar,       XP ()
    killAfter XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
            ]
        changeVimXPKeymap :: Map (KeyMask, EventMask) (XP ())
    changeVimXPKeymap = [((KeyMask, EventMask), XP ())] -> Map (KeyMask, EventMask) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, EventMask), XP ())]
     -> Map (KeyMask, EventMask) (XP ()))
    -> [((KeyMask, EventMask), XP ())]
    -> Map (KeyMask, EventMask) (XP ())
    forall a b. (a -> b) -> a -> b
    $
            ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (XP () -> XP ())
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap (KeyMask
    0 ,) (XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True))
            [ (EventMask
    xK_e,            Direction1D -> XP ()
    deleteString Direction1D
    Next XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    notWord Direction1D
    Next)
            , (EventMask
    xK_0,            XP ()
    killBefore)
            , (EventMask
    xK_b,            (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    notWord Direction1D
    Prev)
            , (EventMask
    xK_c,            String -> XP ()
    setInput String
    "")
            , (EventMask
    xK_w,            (Char -> Bool) -> XP ()
    changeWord Char -> Bool
    notWord)
            ] [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    -> [((KeyMask, EventMask), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
            ((EventMask, XP ()) -> ((KeyMask, EventMask), XP ()))
    -> [(EventMask, XP ())] -> [((KeyMask, EventMask), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EventMask -> (KeyMask, EventMask))
    -> (XP () -> XP ())
    -> (EventMask, XP ())
    -> ((KeyMask, EventMask), XP ())
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap (KeyMask
    shiftMask, ) (XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True))
            [ (EventMask
    xK_dollar,       XP ()
    killAfter)
            ]

    -- Useful for exploring off-by-one issues.
    --testOffset :: XP ()
    --testOffset = do
    --    off <- getOffset
    --    str <- getInput
    --    setInput $ str ++ "|" ++ (show off) ++ ":" ++ (show $ length str)

    -- | Set @True@ to save the prompt's entry to history and run it via the
    -- provided action.
    setSuccess :: Bool -> XP ()
    setSuccess :: Bool -> XP ()
    setSuccess Bool
    b = (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { successful = b }

    -- | Set @True@ to leave all event loops, no matter how nested.
    setDone :: Bool -> XP ()
    setDone :: Bool -> XP ()
    setDone Bool
    b = (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { done = b }

    -- | Set @True@ to leave the current event loop, i.e. submaps.
    setModeDone :: Bool -> XP ()
    setModeDone :: Bool -> XP ()
    setModeDone Bool
    b = (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { modeDone = b }

    -- KeyPress and State

    -- | Accept the current selection and exit.
    acceptSelection :: StateT XPState IO ()
    acceptSelection :: XP ()
    acceptSelection = Bool -> XP ()
    setSuccess Bool
    True XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setDone Bool
    True

    -- | Quit.
    quit :: XP ()
    quit :: XP ()
    quit = XP ()
    flushString XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setSuccess Bool
    False XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setDone Bool
    True XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True

    -- | Kill the portion of the command before the cursor
    killBefore :: XP ()
    killBefore :: XP ()
    killBefore =
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> String -> XPState -> XPState
    setCommand (Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop (XPState -> Int
    offset XPState
    s) (XPState -> String
    command XPState
    s)) (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $ XPState
    s { offset  = 0 }

    -- | Kill the portion of the command including and after the cursor
    killAfter :: XP ()
    killAfter :: XP ()
    killAfter =
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> String -> XPState -> XPState
    setCommand (Int -> String -> String
    forall a. Int -> [a] -> [a]
    take (XPState -> Int
    offset XPState
    s) (XPState -> String
    command XPState
    s)) XPState
    s

    -- | Kill the next\/previous word, using 'isSpace' as the default
    --   predicate for non-word characters.  See 'killWord''.
    killWord :: Direction1D -> XP ()
    killWord :: Direction1D -> XP ()
    killWord = (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    isSpace

    -- | Kill the next\/previous word, given a predicate to identify
    --   non-word characters. First delete any consecutive non-word
    --   characters; then delete consecutive word characters, stopping
    --   just before the next non-word character.
    --
    --   For example, by default (using 'killWord') a path like
    --   @foo\/bar\/baz@ would be deleted in its entirety.  Instead you can
    --   use something like @killWord' (\\c -> isSpace c || c == \'\/\')@ to
    --   delete the path one component at a time.
    killWord' :: (Char -> Bool) -> Direction1D -> XP ()
    killWord' :: (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    d = do
      Int
    o <- (XPState -> Int) -> XP Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Int
    offset
      String
    c <- (XPState -> String) -> XP String
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> String
    command
      let (String
    f,String
    ss)        = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    o String
    c
          delNextWord :: String -> String
    delNextWord   = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    p) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    p
          delPrevWord :: String -> String
    delPrevWord   = String -> String
    forall {a}. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    delNextWord (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall {a}. [a] -> [a]
    reverse
          (String
    ncom,Int
    noff)   =
              case Direction1D
    d of
                Direction1D
    Next -> (String
    f String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    delNextWord String
    ss, Int
    o)
                Direction1D
    Prev -> (String -> String
    delPrevWord String
    f String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ss, String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> String -> Int
    forall a b. (a -> b) -> a -> b
    $ String -> String
    delPrevWord String
    f) -- laziness!!
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> String -> XPState -> XPState
    setCommand String
    ncom (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $ XPState
    s { offset = noff}

    -- | From Vim's @:help cw@:
    --
    -- * Special case: When the cursor is in a word, "cw" and "cW" do not include
    --   the white space after a word, they only change up to the end of the word.
    changeWord :: (Char -> Bool) -> XP ()
    changeWord :: (Char -> Bool) -> XP ()
    changeWord Char -> Bool
    p = StateT XPState IO (XP ()) -> XP ()
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (StateT XPState IO (XP ()) -> XP ())
    -> StateT XPState IO (XP ()) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ String -> Int -> (Char -> Bool) -> XP ()
    f (String -> Int -> (Char -> Bool) -> XP ())
    -> XP String -> StateT XPState IO (Int -> (Char -> Bool) -> XP ())
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> XP String
    getInput StateT XPState IO (Int -> (Char -> Bool) -> XP ())
    -> XP Int -> StateT XPState IO ((Char -> Bool) -> XP ())
    forall a b.
    StateT XPState IO (a -> b)
    -> StateT XPState IO a -> StateT XPState IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> XP Int
    getOffset StateT XPState IO ((Char -> Bool) -> XP ())
    -> StateT XPState IO (Char -> Bool) -> StateT XPState IO (XP ())
    forall a b.
    StateT XPState IO (a -> b)
    -> StateT XPState IO a -> StateT XPState IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Char -> Bool) -> StateT XPState IO (Char -> Bool)
    forall a. a -> StateT XPState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Char -> Bool
    p
        where
            f :: String -> Int -> (Char -> Bool) -> XP ()
            f :: String -> Int -> (Char -> Bool) -> XP ()
    f String
    str Int
    off Char -> Bool
    _ | String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    str Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    off Bool -> Bool -> Bool
    ||
                          String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    str              = () -> XP ()
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            f String
    str Int
    off Char -> Bool
    p'| Char -> Bool
    p' (Char -> Bool) -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ String
    str String -> Int -> Char
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    off       = (Char -> Bool) -> Direction1D -> XP ()
    killWord' (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    p') Direction1D
    Next
                        | Bool
    otherwise             = (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p' Direction1D
    Next

    -- | Interchange characters around point, moving forward one character
    --   if not at the end of the input.
    transposeChars :: XP ()
    transposeChars :: XP ()
    transposeChars = do
      Int
    off <- (XPState -> Int) -> XP Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Int
    offset
      String
    cmd <- (XPState -> String) -> XP String
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> String
    command
      let (String
    beforeCursor, String
    afterCursor) = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    off String
    cmd
          (String
    ncom, Int
    noff) = (String, Int) -> Maybe (String, Int) -> (String, Int)
    forall a. a -> Maybe a -> a
    fromMaybe (String
    cmd, Int
    off) (String -> String -> Int -> Maybe (String, Int)
    forall a. [a] -> [a] -> Int -> Maybe ([a], Int)
    go String
    beforeCursor String
    afterCursor Int
    off)
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> String -> XPState -> XPState
    setCommand String
    ncom (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $ XPState
    s{ offset = noff }
     where
      go :: [a] -> [a] -> Int -> Maybe ([a], Int)
      go :: forall a. [a] -> [a] -> Int -> Maybe ([a], Int)
    go ([a] -> [a]
    forall {a}. [a] -> [a]
    reverse -> (a
    b1 : a
    b2 : [a]
    bs)) [] Int
    offset =  -- end of line
        ([a], Int) -> Maybe ([a], Int)
    forall a. a -> Maybe a
    Just ([a] -> [a]
    forall {a}. [a] -> [a]
    reverse ([a] -> [a]) -> [a] -> [a]
    forall a b. (a -> b) -> a -> b
    $ a
    b2 a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : a
    b1 a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    bs, Int
    offset)
      go ([a] -> [a]
    forall {a}. [a] -> [a]
    reverse -> (a
    b : [a]
    bs)) (a
    a : [a]
    as) Int
    offset =  -- middle of line
        ([a], Int) -> Maybe ([a], Int)
    forall a. a -> Maybe a
    Just ([a] -> [a]
    forall {a}. [a] -> [a]
    reverse (a
    a a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    bs) [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ a
    b a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    as, Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
      go [a]
    _ [a]
    _ Int
    _ = Maybe ([a], Int)
    forall a. Maybe a
    Nothing

    -- | Put the cursor at the end of line
    endOfLine :: XP ()
    endOfLine :: XP ()
    endOfLine  =
        (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { offset = length (command s)}

    -- | Put the cursor at the start of line
    startOfLine :: XP ()
    startOfLine :: XP ()
    startOfLine  =
        (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { offset = 0 }

    -- |  Flush the command string and reset the offset
    flushString :: XP ()
    flushString :: XP ()
    flushString = (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> String -> XPState -> XPState
    setCommand String
    "" (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $ XPState
    s { offset = 0}

    --reset index if config has `alwaysHighlight`. The inserted char could imply fewer autocompletions.
    --If the current index was column 2, row 1 and now there are only 4 autocompletion rows with 1 column, what should we highlight? Set it to the first and start navigation again
    resetComplIndex :: XPState -> XPState
    resetComplIndex :: XPState -> XPState
    resetComplIndex XPState
    st = if XPConfig -> Bool
    alwaysHighlight (XPState -> XPConfig
    config XPState
    st) then XPState
    st { complIndex = (0,0) } else XPState
    st

    -- | Insert a character at the cursor position
    insertString :: String -> XP ()
    insertString :: String -> XP ()
    insertString String
    str = do
      String -> XP ()
    insertString' String
    str
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify XPState -> XPState
    resetComplIndex

    insertString' :: String -> XP ()
    insertString' :: String -> XP ()
    insertString' String
    str =
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> let
        cmd :: String
    cmd = String -> Int -> String
    c (XPState -> String
    command XPState
    s) (XPState -> Int
    offset XPState
    s)
        st :: XPState
    st = XPState
    s { offset = o (offset s)}
        in String -> XPState -> XPState
    setCommand String
    cmd XPState
    st
      where o :: Int -> Int
    o Int
    oo = Int
    oo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    str
            c :: String -> Int -> String
    c String
    oc Int
    oo | Int
    oo Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    oc = String
    oc String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    str
                    | Bool
    otherwise = String
    f String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    str String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ss
                    where (String
    f,String
    ss) = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    oo String
    oc

    -- | Insert the current X selection string at the cursor position. The X
    -- selection is not modified.
    pasteString :: XP ()
    pasteString :: XP ()
    pasteString = (String -> String) -> XP ()
    pasteString' String -> String
    forall a. a -> a
    id

    -- | A variant of 'pasteString' which allows modifying the X selection before
    -- pasting.
    pasteString' :: (String -> String) -> XP ()
    pasteString' :: (String -> String) -> XP ()
    pasteString' String -> String
    f = String -> XP ()
    insertString (String -> XP ()) -> (String -> String) -> String -> XP ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    f (String -> XP ()) -> XP String -> XP ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< XP String
    forall (m :: * -> *). MonadIO m => m String
    getSelection

    -- | Remove a character at the cursor position
    deleteString :: Direction1D -> XP ()
    deleteString :: Direction1D -> XP ()
    deleteString Direction1D
    d =
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> String -> XPState -> XPState
    setCommand (String -> Int -> String
    forall {a}. [a] -> Int -> [a]
    c (XPState -> String
    command XPState
    s) (XPState -> Int
    offset XPState
    s)) (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $ XPState
    s { offset = o (offset s)}
      where o :: a -> a
    o a
    oo = if Direction1D
    d Direction1D -> Direction1D -> Bool
    forall a. Eq a => a -> a -> Bool
    == Direction1D
    Prev then a -> a -> a
    forall a. Ord a => a -> a -> a
    max a
    0 (a
    oo a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1) else a
    oo
            c :: [a] -> Int -> [a]
    c [a]
    oc Int
    oo
                | Int
    oo Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    oc Bool -> Bool -> Bool
    && Direction1D
    d Direction1D -> Direction1D -> Bool
    forall a. Eq a => a -> a -> Bool
    == Direction1D
    Prev = Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take (Int
    oo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) [a]
    oc
                | Int
    oo Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <  [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    oc Bool -> Bool -> Bool
    && Direction1D
    d Direction1D -> Direction1D -> Bool
    forall a. Eq a => a -> a -> Bool
    == Direction1D
    Prev = Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take (Int
    oo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) [a]
    f [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    ss
                | Int
    oo Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <  [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    oc Bool -> Bool -> Bool
    && Direction1D
    d Direction1D -> Direction1D -> Bool
    forall a. Eq a => a -> a -> Bool
    == Direction1D
    Next = [a]
    f [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [a]
    ss
                | Bool
    otherwise = [a]
    oc
                where ([a]
    f,[a]
    ss) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    oo [a]
    oc

    -- | Ensure the cursor remains over the command by shifting left if necessary.
    clipCursor :: XP ()
    clipCursor :: XP ()
    clipCursor = (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { offset = o (offset s) (command s)}
        where o :: Int -> t a -> Int
    o Int
    oo t a
    c = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int
    oo

    -- | Move the cursor one position.
    moveCursor :: Direction1D -> XP ()
    moveCursor :: Direction1D -> XP ()
    moveCursor Direction1D
    d =
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { offset = o (offset s) (command s)}
      where o :: Int -> t a -> Int
    o Int
    oo t a
    c = if Direction1D
    d Direction1D -> Direction1D -> Bool
    forall a. Eq a => a -> a -> Bool
    == Direction1D
    Prev then Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int
    oo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) else Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    c) (Int
    oo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

    -- | Move the cursor one position, but not beyond the command.
    moveCursorClip :: Direction1D -> XP ()
    moveCursorClip :: Direction1D -> XP ()
    moveCursorClip = (XP () -> XP () -> XP ()
    forall a b.
    StateT XPState IO a -> StateT XPState IO b -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    clipCursor) (XP () -> XP ()) -> (Direction1D -> XP ()) -> Direction1D -> XP ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Direction1D -> XP ()
    moveCursor
    --  modify $ \s -> s { offset = o (offset s) (command s)}
    --  where o oo c = if d == Prev then max 0 (oo - 1) else min (max 0 $ length c - 1) (oo + 1)

    -- | Move the cursor one word, using 'isSpace' as the default
    --   predicate for non-word characters.  See 'moveWord''.
    moveWord :: Direction1D -> XP ()
    moveWord :: Direction1D -> XP ()
    moveWord = (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    isSpace

    -- | Given a direction, move the cursor to just before the next
    -- (predicate,not-predicate) character transition. This means a (not-word,word)
    -- transition should be followed by a 'moveCursorClip' action. Always considers
    -- the character under the current cursor position.  This means a
    -- (word,not-word) transition should be preceded by a 'moveCursorClip' action.
    -- Calculated as the length of consecutive non-predicate characters starting
    -- from the cursor position, plus the length of subsequent consecutive
    -- predicate characters, plus when moving backwards the distance of the cursor
    -- beyond the input. Reduced by one to avoid jumping off either end of the
    -- input, when present.
    --
    -- Use these identities to retain the pre-0.14 behavior:
    --
    -- @
    --     (oldMoveWord' p Prev) = (moveCursor Prev >> moveWord' p Prev)
    -- @
    --
    -- @
    --     (oldMoveWord' p Next) = (moveWord' p Next >> moveCursor Next)
    -- @
    moveWord' :: (Char -> Bool) -> Direction1D -> XP ()
    moveWord' :: (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    p Direction1D
    d = do
      String
    c <- (XPState -> String) -> XP String
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> String
    command
      Int
    o <- (XPState -> Int) -> XP Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Int
    offset
      let (String
    f,String
    ss) = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitOn Int
    o String
    c
          splitOn :: Int -> [a] -> ([a], [a])
    splitOn Int
    n [a]
    xs = (Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) [a]
    xs, Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop Int
    n [a]
    xs)
          gap :: Int
    gap = case Direction1D
    d of
                    Direction1D
    Prev -> Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ (Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    c
                    Direction1D
    Next -> Int
    0
          len :: String -> Int
    len = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int -> Int) -> (String -> Int) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int -> Int) -> Int -> Int -> Int
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (-) Int
    1 (Int -> Int) -> (String -> Int) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int
    gap Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +)
              (Int -> Int) -> (String -> Int) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int -> Int) -> (Int, Int) -> Int
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+)
              ((Int, Int) -> Int) -> (String -> (Int, Int)) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int)
    -> (String -> Int) -> (String, String) -> (Int, Int)
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> (String -> String) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    p)))
              ((String, String) -> (Int, Int))
    -> (String -> (String, String)) -> String -> (Int, Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Char -> Bool
    p
          newoff :: Int
    newoff = case Direction1D
    d of
                    Direction1D
    Prev -> Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    len (String -> String
    forall {a}. [a] -> [a]
    reverse String
    f)
                    Direction1D
    Next -> Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    len String
    ss
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { offset = newoff }

    -- | Set the prompt's input to an entry further up or further down the history
    -- stack. Use 'Stack' functions from 'XMonad.StackSet', i.e. 'focusUp'' or
    -- 'focusDown''.
    moveHistory :: (W.Stack String -> W.Stack String) -> XP ()
    moveHistory :: (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    f = do
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> let ch :: Stack String
    ch = Stack String -> Stack String
    f (Stack String -> Stack String) -> Stack String -> Stack String
    forall a b. (a -> b) -> a -> b
    $ XPState -> Stack String
    commandHistory XPState
    s
                     in XPState
    s { commandHistory = ch
                          , offset         = length $ W.focus ch
                          , complIndex     = (0,0) }
      XP ()
    updateWindows
      XP ()
    updateHighlightedCompl

    -- | Move the cursor in the given direction to the first instance of the first
    -- character of the given string, assuming the string is not empty. The
    -- starting cursor character is not considered, and the cursor is placed over
    -- the matching character.
    toHeadChar :: Direction1D -> String -> XP ()
    toHeadChar :: Direction1D -> String -> XP ()
    toHeadChar Direction1D
    _ String
    ""      = () -> XP ()
    forall a. a -> StateT XPState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
    toHeadChar Direction1D
    d (Char
    c : String
    _) = do
        String
    cmd <- (XPState -> String) -> XP String
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> String
    command
        Int
    off <- (XPState -> Int) -> XP Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Int
    offset
        let off' :: Int
    off' = (if Direction1D
    d Direction1D -> Direction1D -> Bool
    forall a. Eq a => a -> a -> Bool
    == Direction1D
    Prev then Int -> Int
    forall a. Num a => a -> a
    negate (Int -> Int) -> ((Int, Int) -> Int) -> (Int, Int) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst else (Int, Int) -> Int
    forall a b. (a, b) -> b
    snd)
                 ((Int, Int) -> Int)
    -> ((String, String) -> (Int, Int)) -> (String, String) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String -> Int)
     -> (String -> Int) -> (String, String) -> (Int, Int))
    -> (String -> Int) -> (String, String) -> (Int, Int)
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (String -> Int)
    -> (String -> Int) -> (String, String) -> (Int, Int)
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    (***) (Int -> (Int -> Int) -> Maybe Int -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    0 (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (Maybe Int -> Int) -> (String -> Maybe Int) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> String -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    elemIndex Char
    c)
                 ((String, String) -> (Int, Int))
    -> ((String, String) -> (String, String))
    -> (String, String)
    -> (Int, Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String
    forall {a}. [a] -> [a]
    reverse (String -> String)
    -> (String -> String) -> (String, String) -> (String, String)
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    1)
                 ((String, String) -> Int) -> (String, String) -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    off String
    cmd
        (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    st -> XPState
    st { offset = offset st + off' }

    updateHighlightedCompl :: XP ()
    updateHighlightedCompl :: XP ()
    updateHighlightedCompl = do
      XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      [String]
    cs <- StateT XPState IO [String]
    getCompletions
      Bool
    alwaysHighlight' <- (XPState -> Bool) -> StateT XPState IO Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XPState -> Bool) -> StateT XPState IO Bool)
    -> (XPState -> Bool) -> StateT XPState IO Bool
    forall a b. (a -> b) -> a -> b
    $ XPConfig -> Bool
    alwaysHighlight (XPConfig -> Bool) -> (XPState -> XPConfig) -> XPState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> XPConfig
    config
      Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    alwaysHighlight' (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s {highlightedCompl = highlightedItem st cs}

    ------------------------------------------------------------------------
    -- X Stuff

    -- | The completion windows in its entirety.
    data ComplWindowDim = ComplWindowDim
      { ComplWindowDim -> Position
    cwX         :: !Position    -- ^ Starting x position
      , ComplWindowDim -> Position
    cwY         :: !Position    -- ^ Starting y position
      , ComplWindowDim -> Dimension
    cwWidth     :: !Dimension   -- ^ Width of the entire prompt
      , ComplWindowDim -> Dimension
    cwRowHeight :: !Dimension   -- ^ Height of a single row
      , ComplWindowDim -> [Position]
    cwCols      :: ![Position]  -- ^ Starting position of all columns
      , ComplWindowDim -> [Position]
    cwRows      :: ![Position]  -- ^ Starting positions of all rows
      }
      deriving (ComplWindowDim -> ComplWindowDim -> Bool
    (ComplWindowDim -> ComplWindowDim -> Bool)
    -> (ComplWindowDim -> ComplWindowDim -> Bool) -> Eq ComplWindowDim
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ComplWindowDim -> ComplWindowDim -> Bool
    == :: ComplWindowDim -> ComplWindowDim -> Bool
    $c/= :: ComplWindowDim -> ComplWindowDim -> Bool
    /= :: ComplWindowDim -> ComplWindowDim -> Bool
    Eq)

    -- | Create the prompt window.
    createPromptWin :: Display -> Window -> XPConfig -> Rectangle -> Dimension -> IO Window
    createPromptWin :: Display
    -> EventMask -> XPConfig -> Rectangle -> Dimension -> IO EventMask
    createPromptWin Display
    dpy EventMask
    rootw XPC{ XPPosition
    position :: XPConfig -> XPPosition
    position :: XPPosition
    position, Dimension
    height :: XPConfig -> Dimension
    height :: Dimension
    height } Rectangle
    scn Dimension
    width = do
      EventMask
    w <- Display
    -> Screen
    -> EventMask
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO EventMask
    mkUnmanagedWindow Display
    dpy (Display -> Screen
    defaultScreenOfDisplay Display
    dpy) EventMask
    rootw
                          (Rectangle -> Position
    rect_x Rectangle
    scn Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    x) (Rectangle -> Position
    rect_y Rectangle
    scn Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    y) Dimension
    width Dimension
    height
      Display -> EventMask -> ClassHint -> IO ()
    setClassHint Display
    dpy EventMask
    w (String -> String -> ClassHint
    ClassHint String
    "xmonad-prompt" String
    "xmonad")
      Display -> EventMask -> IO ()
    mapWindow Display
    dpy EventMask
    w
      EventMask -> IO EventMask
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EventMask
    w
     where
      (Position
    x, Position
    y) :: (Position, Position) = Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (Dimension -> Position)
    -> (Position, Dimension) -> (Position, Position)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> case XPPosition
    position of
        XPPosition
    Top             -> (Position
    0, Dimension
    0)
        XPPosition
    Bottom          -> (Position
    0, Rectangle -> Dimension
    rect_height Rectangle
    scn Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    height)
        CenteredAt Rational
    py Rational
    w ->
          ( Rational -> Position
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Rational -> Position) -> Rational -> Position
    forall a b. (a -> b) -> a -> b
    $ Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi (Rectangle -> Dimension
    rect_width Rectangle
    scn) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * ((Rational
    1 Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    w) Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / Rational
    2)
          , Rational -> Dimension
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Rational -> Dimension) -> Rational -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Rational
    py Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi (Rectangle -> Dimension
    rect_height Rectangle
    scn) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - (Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    height Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / Rational
    2)
          )

    -- | Update the state of the completion window.
    updateComplWin :: Maybe Window -> Maybe ComplWindowDim -> XP ()
    updateComplWin :: Maybe EventMask -> Maybe ComplWindowDim -> XP ()
    updateComplWin Maybe EventMask
    win Maybe ComplWindowDim
    winDim = do
      IORef (Maybe EventMask)
    cwr <- (XPState -> IORef (Maybe EventMask))
    -> StateT XPState IO (IORef (Maybe EventMask))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> IORef (Maybe EventMask)
    complWin
      IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Maybe EventMask) -> Maybe EventMask -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe EventMask)
    cwr Maybe EventMask
    win
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify' (\XPState
    s -> XPState
    s { complWinDim = winDim })

    --- | Update all prompt windows.
    updateWindows :: XP ()
    updateWindows :: XP ()
    updateWindows = XP () -> [String] -> XP ()
    redrawWindows (XP () -> XP ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void XP ()
    destroyComplWin) ([String] -> XP ()) -> StateT XPState IO [String] -> XP ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< StateT XPState IO [String]
    getCompletions

    -- | Draw the main prompt window and, if necessary, redraw the
    -- completion window.
    redrawWindows
      :: XP ()     -- ^ What to do if the completions are empty
      -> [String]  -- ^ Given completions
      -> XP ()
    redrawWindows :: XP () -> [String] -> XP ()
    redrawWindows XP ()
    emptyAction [String]
    compls = do
      Display
    d <- (XPState -> Display) -> StateT XPState IO Display
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Display
    dpy
      XP ()
    drawWin
      XP ()
    -> (NonEmpty String -> XP ()) -> Maybe (NonEmpty String) -> XP ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe XP ()
    emptyAction NonEmpty String -> XP ()
    redrawComplWin ([String] -> Maybe (NonEmpty String)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty [String]
    compls)
      IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display -> Bool -> IO ()
    sync Display
    d Bool
    False
     where
      -- | Draw the main prompt window.
      XP ()
    drawWin :: XP () = do
        XPS{ XPColor
    color :: XPState -> XPColor
    color :: XPColor
    color, Display
    dpy :: XPState -> Display
    dpy :: Display
    dpy, EventMask
    win :: XPState -> EventMask
    win :: EventMask
    win, GC
    gcon :: XPState -> GC
    gcon :: GC
    gcon, Dimension
    winWidth :: XPState -> Dimension
    winWidth :: Dimension
    winWidth } <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
        XPC{ Dimension
    height :: XPConfig -> Dimension
    height :: Dimension
    height, Dimension
    promptBorderWidth :: XPConfig -> Dimension
    promptBorderWidth :: Dimension
    promptBorderWidth } <- (XPState -> XPConfig) -> StateT XPState IO XPConfig
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> XPConfig
    config
        let scr :: Screen
    scr = Display -> Screen
    defaultScreenOfDisplay Display
    dpy
            ht :: Dimension
    ht  = Dimension
    height            -- height of a single row
            bw :: Dimension
    bw  = Dimension
    promptBorderWidth
        Just EventMask
    bgcolor <- IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask))
    -> IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask)
    forall a b. (a -> b) -> a -> b
    $ Display -> String -> IO (Maybe EventMask)
    initColor Display
    dpy (XPColor -> String
    bgNormal XPColor
    color)
        Just EventMask
    borderC <- IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask))
    -> IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask)
    forall a b. (a -> b) -> a -> b
    $ Display -> String -> IO (Maybe EventMask)
    initColor Display
    dpy (XPColor -> String
    border XPColor
    color)
        EventMask
    pm <- IO EventMask -> StateT XPState IO EventMask
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO EventMask -> StateT XPState IO EventMask)
    -> IO EventMask -> StateT XPState IO EventMask
    forall a b. (a -> b) -> a -> b
    $ Display
    -> EventMask -> Dimension -> Dimension -> CInt -> IO EventMask
    createPixmap Display
    dpy EventMask
    win Dimension
    winWidth Dimension
    ht (Screen -> CInt
    defaultDepthOfScreen Screen
    scr)
        IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> EventMask
    -> GC
    -> EventMask
    -> EventMask
    -> Dimension
    -> Dimension
    -> Dimension
    -> IO ()
    fillDrawable Display
    dpy EventMask
    pm GC
    gcon EventMask
    borderC EventMask
    bgcolor (Dimension -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    bw) Dimension
    winWidth Dimension
    ht
        EventMask -> XP ()
    printPrompt EventMask
    pm
        IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> EventMask
    -> EventMask
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> Position
    -> Position
    -> IO ()
    copyArea Display
    dpy EventMask
    pm EventMask
    win GC
    gcon Position
    0 Position
    0 Dimension
    winWidth Dimension
    ht Position
    0 Position
    0
        IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display -> EventMask -> IO ()
    freePixmap Display
    dpy EventMask
    pm

    -- | Redraw the completion window, if necessary.
    redrawComplWin ::  NonEmpty String -> XP ()
    redrawComplWin :: NonEmpty String -> XP ()
    redrawComplWin NonEmpty String
    compl = do
      XPS{ Bool
    showComplWin :: XPState -> Bool
    showComplWin :: Bool
    showComplWin, Maybe ComplWindowDim
    complWinDim :: XPState -> Maybe ComplWindowDim
    complWinDim :: Maybe ComplWindowDim
    complWinDim, IORef (Maybe EventMask)
    complWin :: XPState -> IORef (Maybe EventMask)
    complWin :: IORef (Maybe EventMask)
    complWin } <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      ComplWindowDim
    nwi <- NonEmpty String -> XP ComplWindowDim
    getComplWinDim NonEmpty String
    compl
      let recreate :: XP ()
    recreate = do XP ()
    destroyComplWin
                        EventMask
    w <- ComplWindowDim -> StateT XPState IO EventMask
    createComplWin ComplWindowDim
    nwi
                        EventMask -> NonEmpty String -> XP ()
    drawComplWin EventMask
    w NonEmpty String
    compl
      if Bool
    showComplWin
         then IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IORef (Maybe EventMask) -> IO (Maybe EventMask)
    forall a. IORef a -> IO a
    readIORef IORef (Maybe EventMask)
    complWin) StateT XPState IO (Maybe EventMask)
    -> (Maybe EventMask -> XP ()) -> XP ()
    forall a b.
    StateT XPState IO a
    -> (a -> StateT XPState IO b) -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                Just EventMask
    w -> case Maybe ComplWindowDim
    complWinDim of
                            Just ComplWindowDim
    wi -> if ComplWindowDim
    nwi ComplWindowDim -> ComplWindowDim -> Bool
    forall a. Eq a => a -> a -> Bool
    == ComplWindowDim
    wi -- complWinDim did not change
                                       then EventMask -> NonEmpty String -> XP ()
    drawComplWin EventMask
    w NonEmpty String
    compl -- so update
                                       else XP ()
    recreate
                            Maybe ComplWindowDim
    Nothing -> XP ()
    recreate
                Maybe EventMask
    Nothing -> XP ()
    recreate
         else XP ()
    destroyComplWin
     where
      createComplWin :: ComplWindowDim -> XP Window
      createComplWin :: ComplWindowDim -> StateT XPState IO EventMask
    createComplWin wi :: ComplWindowDim
    wi@ComplWindowDim{ Position
    cwX :: ComplWindowDim -> Position
    cwX :: Position
    cwX, Position
    cwY :: ComplWindowDim -> Position
    cwY :: Position
    cwY, Dimension
    cwWidth :: ComplWindowDim -> Dimension
    cwWidth :: Dimension
    cwWidth, Dimension
    cwRowHeight :: ComplWindowDim -> Dimension
    cwRowHeight :: Dimension
    cwRowHeight } = do
        XPS{ Display
    dpy :: XPState -> Display
    dpy :: Display
    dpy, EventMask
    rootw :: XPState -> EventMask
    rootw :: EventMask
    rootw } <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
        let scr :: Screen
    scr = Display -> Screen
    defaultScreenOfDisplay Display
    dpy
        EventMask
    w <- IO EventMask -> StateT XPState IO EventMask
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO EventMask -> StateT XPState IO EventMask)
    -> IO EventMask -> StateT XPState IO EventMask
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Screen
    -> EventMask
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO EventMask
    mkUnmanagedWindow Display
    dpy Screen
    scr EventMask
    rootw Position
    cwX Position
    cwY Dimension
    cwWidth Dimension
    cwRowHeight
        IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display -> EventMask -> IO ()
    mapWindow Display
    dpy EventMask
    w
        Maybe EventMask -> Maybe ComplWindowDim -> XP ()
    updateComplWin (EventMask -> Maybe EventMask
    forall a. a -> Maybe a
    Just EventMask
    w) (ComplWindowDim -> Maybe ComplWindowDim
    forall a. a -> Maybe a
    Just ComplWindowDim
    wi)
        EventMask -> StateT XPState IO EventMask
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EventMask
    w

    -- | Print the main part of the prompt: the prompter, as well as the
    -- command line (including the current input) and the cursor.
    printPrompt :: Drawable -> XP ()
    printPrompt :: EventMask -> XP ()
    printPrompt EventMask
    drw = do
      st :: XPState
    st@XPS{ String -> String
    prompter :: XPState -> String -> String
    prompter :: String -> String
    prompter, XPColor
    color :: XPState -> XPColor
    color :: XPColor
    color, GC
    gcon :: XPState -> GC
    gcon :: GC
    gcon, XPConfig
    config :: XPState -> XPConfig
    config :: XPConfig
    config, Display
    dpy :: XPState -> Display
    dpy :: Display
    dpy, XMonadFont
    fontS :: XPState -> XMonadFont
    fontS :: XMonadFont
    fontS, Int
    offset :: XPState -> Int
    offset :: Int
    offset } <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let -- (prompt-specific text before the command, the entered command)
          (String
    prt, String
    com) = (String -> String
    prompter (String -> String) -> (XPState -> String) -> XPState -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPType -> String
    forall a. Show a => a -> String
    show (XPType -> String) -> (XPState -> XPType) -> XPState -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> XPType
    currentXPMode (XPState -> String)
    -> (XPState -> String) -> XPState -> (String, String)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> String
    command) XPState
    st
          str :: String
    str = String
    prt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    com
          -- break the string in 3 parts: till the cursor, the cursor and the rest
          (String
    preCursor, String
    cursor, String
    postCursor) = if Int
    offset Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    com
                     then (String
    str, String
    " ",String
    "") -- add a space: it will be our cursor ;-)
                     else let (String
    a, String
    b) = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    offset String
    com
                          in (String
    prt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    a, Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    1 String
    b, Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    1 String
    b)

      -- vertical and horizontal text alignment
      (Position
    asc, Position
    desc) <- IO (Position, Position) -> StateT XPState IO (Position, Position)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Position, Position) -> StateT XPState IO (Position, Position))
    -> IO (Position, Position)
    -> StateT XPState IO (Position, Position)
    forall a b. (a -> b) -> a -> b
    $ XMonadFont -> String -> IO (Position, Position)
    forall (m :: * -> *).
    MonadIO m =>
    XMonadFont -> String -> m (Position, Position)
    textExtentsXMF XMonadFont
    fontS String
    str  -- font ascent and descent
      let y :: Position
    y = Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi ((XPConfig -> Dimension
    height XPConfig
    config Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (Position
    asc Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    desc)) Dimension -> Dimension -> Dimension
    forall a. Integral a => a -> a -> a
    `div` Dimension
    2) Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    asc
          x :: Position
    x = (Position
    asc Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    desc) Position -> Position -> Position
    forall a. Integral a => a -> a -> a
    `div` Position
    2

      Int
    pcFont <- IO Int -> XP Int
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Int -> XP Int) -> IO Int -> XP 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
    fontS String
    preCursor
      Int
    cFont  <- IO Int -> XP Int
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Int -> XP Int) -> IO Int -> XP 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
    fontS String
    cursor
      let draw :: String -> String -> Position -> Position -> String -> XP ()
    draw = Display
    -> EventMask
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> XP ()
    forall (m :: * -> *).
    (Functor m, MonadIO m) =>
    Display
    -> EventMask
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> m ()
    printStringXMF Display
    dpy EventMask
    drw XMonadFont
    fontS GC
    gcon
      -- print the first part
      String -> String -> Position -> Position -> String -> XP ()
    draw (XPColor -> String
    fgNormal XPColor
    color) (XPColor -> String
    bgNormal XPColor
    color) Position
    x Position
    y String
    preCursor
      -- reverse the colors and print the "cursor" ;-)
      String -> String -> Position -> Position -> String -> XP ()
    draw (XPColor -> String
    bgNormal XPColor
    color) (XPColor -> String
    fgNormal XPColor
    color) (Position
    x Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    pcFont) Position
    y String
    cursor
      -- flip back to the original colors and print the rest of the string
      String -> String -> Position -> Position -> String -> XP ()
    draw (XPColor -> String
    fgNormal XPColor
    color) (XPColor -> String
    bgNormal XPColor
    color) (Position
    x Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (Int
    pcFont Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    cFont)) Position
    y String
    postCursor

    -- | Get all available completions for the current input.
    getCompletions :: XP [String]
    getCompletions :: StateT XPState IO [String]
    getCompletions = do
      st :: XPState
    st@XPS{ XPConfig
    config :: XPState -> XPConfig
    config :: XPConfig
    config } <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let cmd :: String
    cmd   = XPType -> String -> String
    forall t. XPrompt t => t -> String -> String
    commandToComplete (XPState -> XPType
    currentXPMode XPState
    st) (XPState -> String
    command XPState
    st)
          compl :: ComplFunction
    compl = XPState -> ComplFunction
    getCompletionFunction XPState
    st
          srt :: String -> [String] -> [String]
    srt   = XPConfig -> String -> [String] -> [String]
    sorter XPConfig
    config
      IO [String] -> StateT XPState IO [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [String] -> StateT XPState IO [String])
    -> IO [String] -> StateT XPState IO [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> [String] -> [String]
    srt String
    cmd ([String] -> [String]) -> IO [String] -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ComplFunction
    compl String
    cmd) IO [String] -> (SomeException -> IO [String]) -> IO [String]
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \(SomeException e
    _) -> [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
     where
      -- | Get the current completion function depending on the active mode.
      getCompletionFunction :: XPState -> ComplFunction
      getCompletionFunction :: XPState -> ComplFunction
    getCompletionFunction XPState
    st = case XPState -> XPOperationMode
    operationMode XPState
    st of
        XPSingleMode ComplFunction
    compl XPType
    _ -> ComplFunction
    compl
        XPMultipleModes Stack XPType
    modes -> XPType -> ComplFunction
    forall t. XPrompt t => t -> ComplFunction
    completionFunction (XPType -> ComplFunction) -> XPType -> ComplFunction
    forall a b. (a -> b) -> a -> b
    $ Stack XPType -> XPType
    forall a. Stack a -> a
    W.focus Stack XPType
    modes

    -- | Destroy the currently drawn completion window, if there is one.
    destroyComplWin :: XP ()
    destroyComplWin :: XP ()
    destroyComplWin = do
      XPS{ Display
    dpy :: XPState -> Display
    dpy :: Display
    dpy, IORef (Maybe EventMask)
    complWin :: XPState -> IORef (Maybe EventMask)
    complWin :: IORef (Maybe EventMask)
    complWin } <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IORef (Maybe EventMask) -> IO (Maybe EventMask)
    forall a. IORef a -> IO a
    readIORef IORef (Maybe EventMask)
    complWin) StateT XPState IO (Maybe EventMask)
    -> (Maybe EventMask -> XP ()) -> XP ()
    forall a b.
    StateT XPState IO a
    -> (a -> StateT XPState IO b) -> StateT XPState IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Just EventMask
    w -> do IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display -> EventMask -> IO ()
    destroyWindow Display
    dpy EventMask
    w
                     Maybe EventMask -> Maybe ComplWindowDim -> XP ()
    updateComplWin Maybe EventMask
    forall a. Maybe a
    Nothing Maybe ComplWindowDim
    forall a. Maybe a
    Nothing
        Maybe EventMask
    Nothing -> () -> XP ()
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Given the completions that we would like to show, calculate the
    -- required dimensions for the completion windows.
    getComplWinDim :: NonEmpty String -> XP ComplWindowDim
    getComplWinDim :: NonEmpty String -> XP ComplWindowDim
    getComplWinDim NonEmpty String
    compl = do
      XPS{ config :: XPState -> XPConfig
    config = XPConfig
    cfg, screen :: XPState -> Rectangle
    screen = Rectangle
    scr, fontS :: XPState -> XMonadFont
    fontS = XMonadFont
    fs, Display
    dpy :: XPState -> Display
    dpy :: Display
    dpy, Dimension
    winWidth :: XPState -> Dimension
    winWidth :: Dimension
    winWidth } <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let -- Height of a single completion row
          ht :: Dimension
    ht = XPConfig -> Dimension
    height XPConfig
    cfg
          bw :: Dimension
    bw = XPConfig -> Dimension
    promptBorderWidth XPConfig
    cfg

      NonEmpty Int
    tws <- (String -> XP Int)
    -> NonEmpty String -> StateT XPState IO (NonEmpty Int)
    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) -> NonEmpty a -> m (NonEmpty b)
    mapM (Display -> XMonadFont -> String -> XP Int
    forall (m :: * -> *).
    MonadIO m =>
    Display -> XMonadFont -> String -> m Int
    textWidthXMF Display
    dpy XMonadFont
    fs) NonEmpty String
    compl
      let -- Length of widest completion we will print
          maxComplLen :: Int
    maxComplLen = (Dimension -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    ht Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum NonEmpty Int
    tws
          -- Height of the screen rectangle _without_ the prompt window
          remHeight :: Dimension
    remHeight   = Rectangle -> Dimension
    rect_height Rectangle
    scr Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    ht

          maxColumns :: Dimension -> Dimension
    maxColumns  = (Dimension -> Dimension)
    -> (Dimension -> Dimension -> Dimension)
    -> Maybe Dimension
    -> Dimension
    -> Dimension
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Dimension -> Dimension
    forall a. a -> a
    id Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    min (XPConfig -> Maybe Dimension
    maxComplColumns XPConfig
    cfg)
          columns :: Dimension
    columns     = Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    max Dimension
    1 (Dimension -> Dimension)
    -> (Dimension -> Dimension) -> Dimension -> Dimension
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dimension -> Dimension
    maxColumns (Dimension -> Dimension) -> Dimension -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Dimension
    winWidth Dimension -> Dimension -> Dimension
    forall a. Integral a => a -> a -> a
    `div` Int -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    maxComplLen
          columnWidth :: Dimension
    columnWidth = Dimension
    winWidth Dimension -> Dimension -> Dimension
    forall a. Integral a => a -> a -> a
    `div` Dimension
    columns

          (Int
    fullRows, Int
    lastRow) = NonEmpty String -> Int
    forall a. NonEmpty a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length NonEmpty String
    compl Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Dimension -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    columns
          allRows :: Int
    allRows   = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    1 (Int
    fullRows Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + if Int
    lastRow Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then Int
    0 else Int
    1)
          -- Maximum number of rows allowed by the config and the screen dimensions
          maxRows :: Dimension
    maxRows   = (Dimension -> Dimension)
    -> (Dimension -> Dimension -> Dimension)
    -> Maybe Dimension
    -> Dimension
    -> Dimension
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Dimension -> Dimension
    forall a. a -> a
    id Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    min (XPConfig -> Maybe Dimension
    maxComplRows XPConfig
    cfg) (Dimension
    remHeight Dimension -> Dimension -> Dimension
    forall a. Integral a => a -> a -> a
    `div` Dimension
    ht)
          -- Actual number of rows to be drawn
          rows :: Dimension
    rows      = Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    min Dimension
    maxRows (Int -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    allRows)
          rowHeight :: Dimension
    rowHeight = Dimension
    rows Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    * Dimension
    ht

          -- Starting x and y position of the completion windows.
          (Position
    x, Position
    y) = (Position -> Position)
    -> (Dimension -> Position)
    -> (Position, Dimension)
    -> (Position, Position)
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap (Rectangle -> Position
    rect_x Rectangle
    scr Position -> Position -> Position
    forall a. Num a => a -> a -> a
    +) ((Rectangle -> Position
    rect_y Rectangle
    scr Position -> Position -> Position
    forall a. Num a => a -> a -> a
    +) (Position -> Position)
    -> (Dimension -> Position) -> Dimension -> Position
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi) ((Position, Dimension) -> (Position, Position))
    -> (Position, Dimension) -> (Position, Position)
    forall a b. (a -> b) -> a -> b
    $ case XPConfig -> XPPosition
    position XPConfig
    cfg of
            XPPosition
    Top    -> (Position
    0, Dimension
    ht Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    bw)
            XPPosition
    Bottom -> (Position
    0, Dimension
    remHeight Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    rowHeight Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    + Dimension
    bw)
            CenteredAt Rational
    py Rational
    w
              | Rational
    py Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Rational
    1Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    /Rational
    2 ->
                  ( Rational -> Position
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Rational -> Position) -> Rational -> Position
    forall a b. (a -> b) -> a -> b
    $ Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi (Rectangle -> Dimension
    rect_width Rectangle
    scr) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * ((Rational
    1 Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    w) Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / Rational
    2)
                  , Rational -> Dimension
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Rational
    py Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi (Rectangle -> Dimension
    rect_height Rectangle
    scr) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    + (Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    ht Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / Rational
    2)) Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    bw
                  )
              | Bool
    otherwise ->
                  ( Rational -> Position
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Rational -> Position) -> Rational -> Position
    forall a b. (a -> b) -> a -> b
    $ Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi (Rectangle -> Dimension
    rect_width Rectangle
    scr) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * ((Rational
    1 Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    w) Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / Rational
    2)
                  , Rational -> Dimension
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Rational
    py Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi (Rectangle -> Dimension
    rect_height Rectangle
    scr) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - (Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    ht Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / Rational
    2)) Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    rowHeight Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    + Dimension
    bw
                  )

      -- Get font ascent and descent.  Coherence condition: we will print
      -- everything using the same font.
      (Position
    asc, Position
    desc) <- IO (Position, Position) -> StateT XPState IO (Position, Position)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Position, Position) -> StateT XPState IO (Position, Position))
    -> IO (Position, Position)
    -> StateT XPState IO (Position, Position)
    forall a b. (a -> b) -> a -> b
    $ XMonadFont -> String -> IO (Position, Position)
    forall (m :: * -> *).
    MonadIO m =>
    XMonadFont -> String -> m (Position, Position)
    textExtentsXMF XMonadFont
    fs (String -> IO (Position, Position))
    -> String -> IO (Position, Position)
    forall a b. (a -> b) -> a -> b
    $ NonEmpty String -> String
    forall a. NonEmpty a -> a
    NE.head NonEmpty String
    compl
      let yp :: Position
    yp    = Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (Dimension -> Position) -> Dimension -> Position
    forall a b. (a -> b) -> a -> b
    $ (Dimension
    ht Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    + Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (Position
    asc Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    desc)) Dimension -> Dimension -> Dimension
    forall a. Integral a => a -> a -> a
    `div` Dimension
    2 -- y position of the first row
          yRows :: [Position]
    yRows = Int -> [Position] -> [Position]
    forall a. Int -> [a] -> [a]
    take (Dimension -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    rows) [Position
    yp, Position
    yp Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    ht ..]  -- y positions of all rows

          xp :: Position
    xp    = (Position
    asc Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    desc) Position -> Position -> Position
    forall a. Integral a => a -> a -> a
    `div` Position
    2                           -- x position of the first column
          xCols :: [Position]
    xCols = Int -> [Position] -> [Position]
    forall a. Int -> [a] -> [a]
    take (Dimension -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    columns) [Position
    xp, Position
    xp Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    columnWidth ..] -- x positions of all columns

      ComplWindowDim -> XP ComplWindowDim
    forall a. a -> StateT XPState IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ComplWindowDim -> XP ComplWindowDim)
    -> ComplWindowDim -> XP ComplWindowDim
    forall a b. (a -> b) -> a -> b
    $ Position
    -> Position
    -> Dimension
    -> Dimension
    -> [Position]
    -> [Position]
    -> ComplWindowDim
    ComplWindowDim Position
    x Position
    y Dimension
    winWidth Dimension
    rowHeight [Position]
    xCols [Position]
    yRows

    -- | Draw the completion window.
    drawComplWin :: Window -> NonEmpty String -> XP ()
    drawComplWin :: EventMask -> NonEmpty String -> XP ()
    drawComplWin EventMask
    w NonEmpty String
    entries = do
      XPS{ XPConfig
    config :: XPState -> XPConfig
    config :: XPConfig
    config, XPColor
    color :: XPState -> XPColor
    color :: XPColor
    color, Display
    dpy :: XPState -> Display
    dpy :: Display
    dpy, GC
    gcon :: XPState -> GC
    gcon :: GC
    gcon } <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let scr :: Screen
    scr = Display -> Screen
    defaultScreenOfDisplay Display
    dpy
          bw :: Dimension
    bw  = XPConfig -> Dimension
    promptBorderWidth XPConfig
    config
      Just EventMask
    bgcolor <- IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask))
    -> IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask)
    forall a b. (a -> b) -> a -> b
    $ Display -> String -> IO (Maybe EventMask)
    initColor Display
    dpy (XPColor -> String
    bgNormal XPColor
    color)
      Just EventMask
    borderC <- IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask))
    -> IO (Maybe EventMask) -> StateT XPState IO (Maybe EventMask)
    forall a b. (a -> b) -> a -> b
    $ Display -> String -> IO (Maybe EventMask)
    initColor Display
    dpy (XPColor -> String
    border XPColor
    color)
      cwd :: ComplWindowDim
    cwd@ComplWindowDim{ Dimension
    cwWidth :: ComplWindowDim -> Dimension
    cwWidth :: Dimension
    cwWidth, Dimension
    cwRowHeight :: ComplWindowDim -> Dimension
    cwRowHeight :: Dimension
    cwRowHeight } <- NonEmpty String -> XP ComplWindowDim
    getComplWinDim NonEmpty String
    entries

      EventMask
    p <- IO EventMask -> StateT XPState IO EventMask
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO EventMask -> StateT XPState IO EventMask)
    -> IO EventMask -> StateT XPState IO EventMask
    forall a b. (a -> b) -> a -> b
    $ Display
    -> EventMask -> Dimension -> Dimension -> CInt -> IO EventMask
    createPixmap Display
    dpy EventMask
    w Dimension
    cwWidth Dimension
    cwRowHeight (Screen -> CInt
    defaultDepthOfScreen Screen
    scr)
      IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> EventMask
    -> GC
    -> EventMask
    -> EventMask
    -> Dimension
    -> Dimension
    -> Dimension
    -> IO ()
    fillDrawable Display
    dpy EventMask
    p GC
    gcon EventMask
    borderC EventMask
    bgcolor (Dimension -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    bw) Dimension
    cwWidth Dimension
    cwRowHeight
      Display
    -> EventMask
    -> GC
    -> String
    -> String
    -> NonEmpty String
    -> ComplWindowDim
    -> XP ()
    printComplEntries Display
    dpy EventMask
    p GC
    gcon (XPColor -> String
    fgNormal XPColor
    color) (XPColor -> String
    bgNormal XPColor
    color) NonEmpty String
    entries ComplWindowDim
    cwd
      --lift $ spawn $ "xmessage " ++ " ac: " ++ show ac  ++ " xx: " ++ show xx ++ " length xx: " ++ show (length xx) ++ " yy: " ++ show (length yy)
      IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> EventMask
    -> EventMask
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> Position
    -> Position
    -> IO ()
    copyArea Display
    dpy EventMask
    p EventMask
    w GC
    gcon Position
    0 Position
    0 Dimension
    cwWidth Dimension
    cwRowHeight Position
    0 Position
    0
      IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display -> EventMask -> IO ()
    freePixmap Display
    dpy EventMask
    p

    -- | Print all of the completion entries.
    printComplEntries
      :: Display
      -> Drawable
      -> GC
      -> String         -- ^ Default foreground color
      -> String         -- ^ Default background color
      -> NonEmpty String -- ^ Entries to be printed...
      -> ComplWindowDim -- ^ ...into a window of this size
      -> XP ()
    printComplEntries :: Display
    -> EventMask
    -> GC
    -> String
    -> String
    -> NonEmpty String
    -> ComplWindowDim
    -> XP ()
    printComplEntries Display
    dpy EventMask
    drw GC
    gc String
    fc String
    bc NonEmpty String
    entries ComplWindowDim{ [Position]
    cwCols :: ComplWindowDim -> [Position]
    cwCols :: [Position]
    cwCols, [Position]
    cwRows :: ComplWindowDim -> [Position]
    cwRows :: [Position]
    cwRows } = do
      st :: XPState
    st@XPS{ XPColor
    color :: XPState -> XPColor
    color :: XPColor
    color, (Int, Int)
    complIndex :: XPState -> (Int, Int)
    complIndex :: (Int, Int)
    complIndex, config :: XPState -> XPConfig
    config = XPC{ Bool
    alwaysHighlight :: XPConfig -> Bool
    alwaysHighlight :: Bool
    alwaysHighlight } } <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let printItemAt :: Position -> Position -> String -> XP ()
          printItemAt :: Position -> Position -> String -> XP ()
    printItemAt Position
    x Position
    y String
    item =
            Display
    -> EventMask
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> XP ()
    forall (m :: * -> *).
    (Functor m, MonadIO m) =>
    Display
    -> EventMask
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> m ()
    printStringXMF Display
    dpy EventMask
    drw (XPState -> XMonadFont
    fontS XPState
    st) GC
    gc String
    fgCol String
    bgCol Position
    x Position
    y String
    item
           where
            (String
    fgCol, String
    bgCol)
              | -- default to the first item, the one in (0, 0)
                Bool
    alwaysHighlight, (Int, Int)
    complIndex (Int, Int) -> (Int, Int) -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> (Int, Int)
    findComplIndex String
    item
              = (XPColor -> String
    fgHighlight XPColor
    color, XPColor -> String
    bgHighlight XPColor
    color)
              | -- compare item with buffer's value
                XPType -> String -> String
    forall t. XPrompt t => t -> String -> String
    completionToCommand (XPState -> XPType
    currentXPMode XPState
    st) String
    item String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == XPType -> String -> String
    forall t. XPrompt t => t -> String -> String
    commandToComplete (XPState -> XPType
    currentXPMode XPState
    st) (XPState -> String
    command XPState
    st)
              = (XPColor -> String
    fgHighlight XPColor
    color, XPColor -> String
    bgHighlight XPColor
    color)
              | -- if nothing matches, use default colors
                Bool
    otherwise = (String
    fc, String
    bc)
      (Position -> [String] -> XP ())
    -> [Position] -> [[String]] -> XP ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ (\Position
    x -> (Position -> String -> XP ()) -> [Position] -> [String] -> XP ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ (Position -> Position -> String -> XP ()
    printItemAt Position
    x) [Position]
    cwRows) [Position]
    cwCols [[String]]
    complMat
     where
      -- | Create the completion matrix to be printed.
      [[String]]
    complMat :: [[String]]
        = Int -> [String] -> [[String]]
    forall a. Int -> [a] -> [[a]]
    chunksOf ([Position] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Position]
    cwRows) (Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take ([Position] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Position]
    cwCols Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * [Position] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Position]
    cwRows) (NonEmpty String -> [String]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty String
    entries))

      -- | Find the column and row indexes in which a string appears.
      -- If the string is not in the matrix, the indices default to @(0, 0)@.
      findComplIndex :: String -> (Int, Int)
      findComplIndex :: String -> (Int, Int)
    findComplIndex String
    item = (Int
    colIndex, Int
    rowIndex)
       where
        colIndex :: Int
    colIndex = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ ([String] -> Bool) -> [[String]] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex (\[String]
    cols -> String
    item String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    cols) [[String]]
    complMat
        rowIndex :: Int
    rowIndex = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    elemIndex String
    item ([String] -> Maybe Int) -> Maybe [String] -> Maybe Int
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [[String]]
    complMat [[String]] -> Int -> Maybe [String]
    forall a. [a] -> Int -> Maybe a
    !? Int
    colIndex

    -- History

    type History = M.Map String [String]

    emptyHistory :: History
    emptyHistory :: Map String [String]
    emptyHistory = Map String [String]
    forall k a. Map k a
    M.empty

    getHistoryFile :: FilePath -> FilePath
    getHistoryFile :: String -> String
    getHistoryFile String
    cachedir = String
    cachedir String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/prompt-history"

    readHistory :: FilePath -> IO History
    readHistory :: String -> IO (Map String [String])
    readHistory String
    cachedir = IO (Map String [String])
    readHist IO (Map String [String])
    -> (SomeException -> IO (Map String [String]))
    -> IO (Map String [String])
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \(SomeException e
    _) -> Map String [String] -> IO (Map String [String])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Map String [String]
    emptyHistory
     where
        readHist :: IO (Map String [String])
    readHist = do
            let path :: String
    path = String -> String
    getHistoryFile String
    cachedir
            String
    xs <- String -> IOMode -> (Handle -> IO String) -> IO String
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withFile String
    path IOMode
    ReadMode Handle -> IO String
    hGetLine
            String -> IO (Map String [String])
    forall a. Read a => String -> IO a
    readIO String
    xs

    writeHistory :: FilePath -> History -> IO ()
    writeHistory :: String -> Map String [String] -> IO ()
    writeHistory String
    cachedir Map String [String]
    hist = do
      let path :: String
    path = String -> String
    getHistoryFile String
    cachedir
          filtered :: Map String [String]
    filtered = ([String] -> Bool) -> Map String [String] -> Map String [String]
    forall a k. (a -> Bool) -> Map k a -> Map k a
    M.filter (Bool -> Bool
    not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) Map String [String]
    hist
      String -> String -> IO ()
    writeFile String
    path (Map String [String] -> String
    forall a. Show a => a -> String
    show Map String [String]
    filtered) IO () -> (SomeException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \(SomeException e
    e) ->
                              Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String
    "error writing history: "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++e -> String
    forall a. Show a => a -> String
    show e
    e)
      String -> FileMode -> IO ()
    setFileMode String
    path FileMode
    mode
        where mode :: FileMode
    mode = FileMode
    ownerReadMode FileMode -> FileMode -> FileMode
    forall a. Bits a => a -> a -> a
    .|. FileMode
    ownerWriteMode

    -- $xutils

    -- | Fills a 'Drawable' with a rectangle and a border
    fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel
                 -> Dimension -> Dimension -> Dimension -> IO ()
    fillDrawable :: Display
    -> EventMask
    -> GC
    -> EventMask
    -> EventMask
    -> Dimension
    -> Dimension
    -> Dimension
    -> IO ()
    fillDrawable Display
    d EventMask
    drw GC
    gc EventMask
    borderC EventMask
    bgcolor Dimension
    bw Dimension
    wh Dimension
    ht = do
      -- we start with the border
      Display -> GC -> EventMask -> IO ()
    setForeground Display
    d GC
    gc EventMask
    borderC
      Display
    -> EventMask
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO ()
    fillRectangle Display
    d EventMask
    drw GC
    gc Position
    0 Position
    0 Dimension
    wh Dimension
    ht
      -- here foreground means the background of the text
      Display -> GC -> EventMask -> IO ()
    setForeground Display
    d GC
    gc EventMask
    bgcolor
      Display
    -> EventMask
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO ()
    fillRectangle Display
    d EventMask
    drw GC
    gc (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    bw) (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    bw) (Dimension
    wh Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - (Dimension
    bw Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    * Dimension
    2)) (Dimension
    ht Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - (Dimension
    bw Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    * Dimension
    2))

    -- | Creates a window with the attribute override_redirect set to True.
    -- Windows Managers should not touch this kind of windows.
    mkUnmanagedWindow :: Display -> Screen -> Window -> Position
                      -> Position -> Dimension -> Dimension -> IO Window
    mkUnmanagedWindow :: Display
    -> Screen
    -> EventMask
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO EventMask
    mkUnmanagedWindow Display
    d Screen
    s EventMask
    rw Position
    x Position
    y Dimension
    w Dimension
    h = do
      let visual :: Visual
    visual = Screen -> Visual
    defaultVisualOfScreen Screen
    s
          attrmask :: EventMask
    attrmask = EventMask
    cWOverrideRedirect
      (Ptr SetWindowAttributes -> IO EventMask) -> IO EventMask
    forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
    allocaSetWindowAttributes ((Ptr SetWindowAttributes -> IO EventMask) -> IO EventMask)
    -> (Ptr SetWindowAttributes -> IO EventMask) -> IO EventMask
    forall a b. (a -> b) -> a -> b
    $
             \Ptr SetWindowAttributes
    attributes -> do
               Ptr SetWindowAttributes -> Bool -> IO ()
    set_override_redirect Ptr SetWindowAttributes
    attributes Bool
    True
               Display
    -> EventMask
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> CInt
    -> CInt
    -> CInt
    -> Visual
    -> EventMask
    -> Ptr SetWindowAttributes
    -> IO EventMask
    createWindow Display
    d EventMask
    rw Position
    x Position
    y Dimension
    w Dimension
    h CInt
    0 (Screen -> CInt
    defaultDepthOfScreen Screen
    s)
                            CInt
    inputOutput Visual
    visual EventMask
    attrmask Ptr SetWindowAttributes
    attributes

    -- $utils

    -- | This function takes a list of possible completions and returns a
    -- completions function to be used with 'mkXPrompt'
    mkComplFunFromList :: XPConfig -> [String] -> String -> IO [String]
    mkComplFunFromList :: XPConfig -> [String] -> ComplFunction
    mkComplFunFromList XPConfig
    _ [String]
    _ [] = [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    mkComplFunFromList XPConfig
    c [String]
    l String
    s =
      [String] -> IO [String]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (XPConfig -> String -> String -> Bool
    searchPredicate XPConfig
    c String
    s) [String]
    l

    -- | This function takes a list of possible completions and returns a
    -- completions function to be used with 'mkXPrompt'. If the string is
    -- null it will return all completions.
    mkComplFunFromList' :: XPConfig -> [String] -> String -> IO [String]
    mkComplFunFromList' :: XPConfig -> [String] -> ComplFunction
    mkComplFunFromList' XPConfig
    _ [String]
    l [] = [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String]
    l
    mkComplFunFromList' XPConfig
    c [String]
    l String
    s =
      [String] -> IO [String]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (XPConfig -> String -> String -> Bool
    searchPredicate XPConfig
    c String
    s) [String]
    l

    -- | Given the prompt type, the command line and the completion list,
    -- return the next completion in the list for the last word of the
    -- command line. This is the default 'nextCompletion' implementation.
    getNextOfLastWord :: XPrompt t => t -> String -> [String] -> String
    getNextOfLastWord :: forall t. XPrompt t => t -> String -> [String] -> String
    getNextOfLastWord t
    t String
    c [String]
    l = String -> String
    skipLastWord String
    c String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ t -> String -> String
    forall t. XPrompt t => t -> String -> String
    completionToCommand t
    t ([String]
    l [String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    ni)
        where ni :: Int
    ni = case t -> String -> String
    forall t. XPrompt t => t -> String -> String
    commandToComplete t
    t String
    c String -> [String] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    `elemIndex` (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (t -> String -> String
    forall t. XPrompt t => t -> String -> String
    completionToCommand t
    t) [String]
    l of
                     Just Int
    i -> if Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 then Int
    0 else Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                     Maybe Int
    Nothing -> Int
    0

    -- | An alternative 'nextCompletion' implementation: given a command
    -- and a completion list, get the next completion in the list matching
    -- the whole command line.
    getNextCompletion :: String -> [String] -> String
    getNextCompletion :: String -> [String] -> String
    getNextCompletion String
    c [String]
    l = [String]
    l [String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    idx
        where idx :: Int
    idx = case String
    c String -> [String] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    `elemIndex` [String]
    l of
                      Just Int
    i  -> if Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 then Int
    0 else Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                      Maybe Int
    Nothing -> Int
    0

    -- | Given a maximum length, splits a list into sublists
    splitInSubListsAt :: Int -> [a] -> [[a]]
    splitInSubListsAt :: forall a. Int -> [a] -> [[a]]
    splitInSubListsAt = Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    chunksOf
    {-# DEPRECATED splitInSubListsAt "Use XMonad.Prelude.chunksOf instead." #-}

    -- | Gets the last word of a string or the whole string if formed by
    -- only one word
    getLastWord :: String -> String
    getLastWord :: String -> String
    getLastWord = String -> String
    forall {a}. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, String) -> String
    forall a b. (a, b) -> a
    fst ((String, String) -> String)
    -> (String -> (String, String)) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> (String, String)
    breakAtSpace (String -> (String, String))
    -> (String -> String) -> String -> (String, String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall {a}. [a] -> [a]
    reverse

    -- | Skips the last word of the string, if the string is composed by
    -- more then one word. Otherwise returns the string.
    skipLastWord :: String -> String
    skipLastWord :: String -> String
    skipLastWord = String -> String
    forall {a}. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, String) -> String
    forall a b. (a, b) -> b
    snd ((String, String) -> String)
    -> (String -> (String, String)) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> (String, String)
    breakAtSpace (String -> (String, String))
    -> (String -> String) -> String -> (String, String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall {a}. [a] -> [a]
    reverse

    breakAtSpace :: String -> (String, String)
    breakAtSpace :: String -> (String, String)
    breakAtSpace String
    s
        | String
    " \\" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s2 = (String
    s1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s1', String
    s2')
        | Bool
    otherwise = (String
    s1, String
    s2)
          where (String
    s1, String
    s2 ) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    isSpace String
    s
                (String
    s1',String
    s2') = String -> (String, String)
    breakAtSpace (String -> (String, String)) -> String -> (String, String)
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    1 String
    s2

    -- | 'historyCompletion' provides a canned completion function much like
    --   'getShellCompl'; you pass it to mkXPrompt, and it will make completions work
    --   from the query history stored in the XMonad cache directory.
    historyCompletion :: X ComplFunction
    historyCompletion :: X ComplFunction
    historyCompletion = (String -> Bool) -> X ComplFunction
    historyCompletionP (Bool -> String -> Bool
    forall a b. a -> b -> a
    const Bool
    True)

    -- | Like 'historyCompletion' but only uses history data from Prompts whose
    -- name satisfies the given predicate.
    historyCompletionP :: (String -> Bool) -> X ComplFunction
    historyCompletionP :: (String -> Bool) -> X ComplFunction
    historyCompletionP String -> Bool
    p = do
        String
    cd <- (XConf -> String) -> X String
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (Directories' String -> String
    forall a. Directories' a -> a
    cacheDir (Directories' String -> String)
    -> (XConf -> Directories' String) -> XConf -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> Directories' String
    directories)
        ComplFunction -> X ComplFunction
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ComplFunction -> X ComplFunction)
    -> ComplFunction -> X ComplFunction
    forall a b. (a -> b) -> a -> b
    $ \String
    x ->
            let toComplList :: Map k [String] -> [String]
    toComplList = [String] -> [String]
    deleteConsecutive ([String] -> [String])
    -> (Map k [String] -> [String]) -> Map k [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isInfixOf String
    x) ([String] -> [String])
    -> (Map k [String] -> [String]) -> Map k [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String] -> [String] -> [String])
    -> [String] -> Map k [String] -> [String]
    forall a b k. (a -> b -> b) -> b -> Map k a -> b
    M.foldr [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    (++) []
             in Map String [String] -> [String]
    forall {k}. Map k [String] -> [String]
    toComplList (Map String [String] -> [String])
    -> (Map String [String] -> Map String [String])
    -> Map String [String]
    -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> [String] -> Bool)
    -> Map String [String] -> Map String [String]
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    M.filterWithKey (Bool -> [String] -> Bool
    forall a b. a -> b -> a
    const (Bool -> [String] -> Bool)
    -> (String -> Bool) -> String -> [String] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    p) (Map String [String] -> [String])
    -> IO (Map String [String]) -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Map String [String])
    readHistory String
    cd

    -- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off
    --   laziness and stability for efficiency.
    uniqSort :: Ord a => [a] -> [a]
    uniqSort :: forall a. Ord a => [a] -> [a]
    uniqSort = Set a -> [a]
    forall a. Set a -> [a]
    toList (Set a -> [a]) -> ([a] -> Set a) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Set a
    forall a. Ord a => [a] -> Set a
    fromList

    -- | Functions to be used with the 'historyFilter' setting.
    -- 'deleteAllDuplicates' will remove all duplicate entries.
    -- 'deleteConsecutive' will only remove duplicate elements
    -- immediately next to each other.
    deleteAllDuplicates, deleteConsecutive :: [String] -> [String]
    deleteAllDuplicates :: [String] -> [String]
    deleteAllDuplicates = [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub
    deleteConsecutive :: [String] -> [String]
    deleteConsecutive = ([String] -> String) -> [[String]] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (NonEmpty String -> String
    forall a. NonEmpty a -> a
    NE.head (NonEmpty String -> String)
    -> ([String] -> NonEmpty String) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> NonEmpty String
    forall a. HasCallStack => [a] -> NonEmpty a
    notEmpty) ([[String]] -> [String])
    -> ([String] -> [[String]]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [[String]]
    forall a. Eq a => [a] -> [[a]]
    group
    -- The elements of group will always have at least one element.

    newtype HistoryMatches = HistoryMatches (IORef ([String],Maybe (W.Stack String)))

    -- | Initializes a new HistoryMatches structure to be passed
    -- to historyUpMatching
    initMatches :: (Functor m, MonadIO m) => m HistoryMatches
    initMatches :: forall (m :: * -> *). (Functor m, MonadIO m) => m HistoryMatches
    initMatches = IORef ([String], Maybe (Stack String)) -> HistoryMatches
    HistoryMatches (IORef ([String], Maybe (Stack String)) -> HistoryMatches)
    -> m (IORef ([String], Maybe (Stack String))) -> m HistoryMatches
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (IORef ([String], Maybe (Stack String)))
    -> m (IORef ([String], Maybe (Stack String)))
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (([String], Maybe (Stack String))
    -> IO (IORef ([String], Maybe (Stack String)))
    forall a. a -> IO (IORef a)
    newIORef ([],Maybe (Stack String)
    forall a. Maybe a
    Nothing))

    historyNextMatching :: HistoryMatches -> (W.Stack String -> W.Stack String) -> XP ()
    historyNextMatching :: HistoryMatches -> (Stack String -> Stack String) -> XP ()
    historyNextMatching hm :: HistoryMatches
    hm@(HistoryMatches IORef ([String], Maybe (Stack String))
    ref) Stack String -> Stack String
    next = do
      ([String]
    completed,Maybe (Stack String)
    completions) <- IO ([String], Maybe (Stack String))
    -> StateT XPState IO ([String], Maybe (Stack String))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO ([String], Maybe (Stack String))
     -> StateT XPState IO ([String], Maybe (Stack String)))
    -> IO ([String], Maybe (Stack String))
    -> StateT XPState IO ([String], Maybe (Stack String))
    forall a b. (a -> b) -> a -> b
    $ IORef ([String], Maybe (Stack String))
    -> IO ([String], Maybe (Stack String))
    forall a. IORef a -> IO a
    readIORef IORef ([String], Maybe (Stack String))
    ref
      String
    input <- XP String
    getInput
      if String
    input String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    completed
         then case Maybe (Stack String)
    completions of
                Just Stack String
    cs -> do
                    let cmd :: String
    cmd = Stack String -> String
    forall a. Stack a -> a
    W.focus Stack String
    cs
                    (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ String -> XPState -> XPState
    setCommand String
    cmd
                    (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((XPState -> XPState) -> XP ()) -> (XPState -> XPState) -> XP ()
    forall a b. (a -> b) -> a -> b
    $ \XPState
    s -> XPState
    s { offset = length cmd }
                    IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ IORef ([String], Maybe (Stack String))
    -> ([String], Maybe (Stack String)) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef ([String], Maybe (Stack String))
    ref (String
    cmdString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    completed,Stack String -> Maybe (Stack String)
    forall a. a -> Maybe a
    Just (Stack String -> Maybe (Stack String))
    -> Stack String -> Maybe (Stack String)
    forall a b. (a -> b) -> a -> b
    $ Stack String -> Stack String
    next Stack String
    cs)
                Maybe (Stack String)
    Nothing -> () -> XP ()
    forall a. a -> StateT XPState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
         else do -- the user typed something new, recompute completions
           IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ())
    -> (Stack String -> IO ()) -> Stack String -> XP ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IORef ([String], Maybe (Stack String))
    -> ([String], Maybe (Stack String)) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef ([String], Maybe (Stack String))
    ref (([String], Maybe (Stack String)) -> IO ())
    -> (Stack String -> ([String], Maybe (Stack String)))
    -> Stack String
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String
    input] ,) (Maybe (Stack String) -> ([String], Maybe (Stack String)))
    -> (Stack String -> Maybe (Stack String))
    -> Stack String
    -> ([String], Maybe (Stack String))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Stack String -> Maybe (Stack String)
    filterMatching String
    input (Stack String -> XP ())
    -> StateT XPState IO (Stack String) -> XP ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (XPState -> Stack String) -> StateT XPState IO (Stack String)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Stack String
    commandHistory
           HistoryMatches -> (Stack String -> Stack String) -> XP ()
    historyNextMatching HistoryMatches
    hm Stack String -> Stack String
    next
        where filterMatching :: String -> W.Stack String -> Maybe (W.Stack String)
              filterMatching :: String -> Stack String -> Maybe (Stack String)
    filterMatching String
    prefix = (String -> Bool) -> Stack String -> Maybe (Stack String)
    forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
    W.filter (String
    prefix String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) (Stack String -> Maybe (Stack String))
    -> (Stack String -> Stack String)
    -> Stack String
    -> Maybe (Stack String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Stack String -> Stack String
    next

    -- | Retrieve the next history element that starts with
    -- the current input. Pass it the result of initMatches
    -- when creating the prompt. Example:
    --
    -- > ..
    -- > ((modMask,xK_p), shellPrompt . myPrompt =<< initMatches)
    -- > ..
    -- > myPrompt ref = def
    -- >   { promptKeymap = M.union [((0,xK_Up), historyUpMatching ref)
    -- >                            ,((0,xK_Down), historyDownMatching ref)]
    -- >                            (promptKeymap def)
    -- >   , .. }
    --
    historyUpMatching, historyDownMatching :: HistoryMatches -> XP ()
    historyUpMatching :: HistoryMatches -> XP ()
    historyUpMatching HistoryMatches
    hm = HistoryMatches -> (Stack String -> Stack String) -> XP ()
    historyNextMatching HistoryMatches
    hm Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown'
    historyDownMatching :: HistoryMatches -> XP ()
    historyDownMatching HistoryMatches
    hm = HistoryMatches -> (Stack String -> Stack String) -> XP ()
    historyNextMatching HistoryMatches
    hm Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp'