    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ExistentialQuantification #-}
    -----------------------------------------------------------------------------
    -- |
    -- 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
        , defaultXPConfig
        , 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
        , moveWord, moveWord', killWord, killWord'
        , changeWord, deleteString
        , moveHistory, setSuccess, setDone, setModeDone
        , Direction1D(..)
        , ComplFunction
        -- * 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 qualified XMonad                       as X (numberlockMask)
    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.Applicative          ((<$>))
    import           Control.Arrow                (first, second, (&&&), (***))
    import           Control.Concurrent           (threadDelay)
    import           Control.Exception.Extensible as E hiding (handle)
    import           Control.Monad.State
    import           Data.Bits
    import           Data.Char                    (isSpace)
    import           Data.IORef
    import           Data.List
    import qualified Data.Map                     as M
    import           Data.Maybe                   (fromMaybe)
    import           Data.Set                     (fromList, toList)
    import           System.IO
    import           System.IO.Unsafe             (unsafePerformIO)
    import           System.Posix.Files

    -- $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 -> Window
    rootw                 :: !Window
            , XPState -> Window
    win                   :: !Window
            , XPState -> Rectangle
    screen                :: !Rectangle
            , XPState -> Maybe Window
    complWin              :: Maybe Window
            , XPState -> Maybe ComplWindowDim
    complWinDim           :: Maybe ComplWindowDim
            , XPState -> (Int, Int)
    complIndex            :: !(Int,Int)
            -- | This IORef should always have the same value as
            -- complWin. Its purpose is to enable removal of the
            -- completion window if an exception occurs, since the most
            -- recent value of complWin is not available when handling
            -- exceptions.
            , XPState -> IORef (Maybe Window)
    complWinRef           :: IORef (Maybe Window)
            , 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
    numlockMask           :: KeyMask
            , XPState -> Bool
    done                  :: Bool
            , XPState -> Bool
    modeDone              :: Bool
            , XPState -> XPColor
    color                 :: XPColor
            , XPState -> String -> String
    prompter              :: String -> String
            , XPState -> [(Window, 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. This implies having *one* column of autocompletions only.
            , XPConfig -> Dimension
    height                :: !Dimension   -- ^ Window height
            , XPConfig -> Maybe Dimension
    maxComplRows          :: Maybe Dimension
                                                    -- ^ Just x: maximum number of rows 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, Window) (XP ())
    promptKeymap          :: M.Map (KeyMask,KeySym) (XP ())
                                                    -- ^ Mapping from key combinations to actions
            , XPConfig -> (KeyMask, Window)
    completionKey         :: (KeyMask, KeySym)     -- ^ Key that should trigger completion
            , XPConfig -> Window
    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 -> 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)

    instance Show XPType where
        show :: XPType -> String
    show (XPT p :: 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 t :: p
    t) = p -> String -> [String] -> String
    forall t. XPrompt t => t -> String -> [String] -> String
    nextCompletion      p
    t
        commandToComplete :: XPType -> String -> String
    commandToComplete   (XPT t :: p
    t) = p -> String -> String
    forall t. XPrompt t => t -> String -> String
    commandToComplete   p
    t
        completionToCommand :: XPType -> String -> String
    completionToCommand (XPT t :: p
    t) = p -> String -> String
    forall t. XPrompt t => t -> String -> String
    completionToCommand p
    t
        completionFunction :: XPType -> ComplFunction
    completionFunction  (XPT t :: p
    t) = p -> ComplFunction
    forall t. XPrompt t => t -> ComplFunction
    completionFunction  p
    t
        modeAction :: XPType -> String -> String -> X ()
    modeAction          (XPT t :: p
    t) = p -> String -> String -> X ()
    forall t. XPrompt t => t -> String -> String -> X ()
    modeAction          p
    t

    -- | The class prompt types must be an instance of. In order to
    -- create a prompt you need to create a data type, without parameters,
    -- and make it an instance of this class, by implementing a simple
    -- method, 'showXPrompt', which will be used to print the string to be
    -- displayed in the command line window.
    --
    -- This is an example of a XPrompt instance definition:
    --
    -- >     instance XPrompt Shell where
    -- >          showXPrompt Shell = "Run: "
    class XPrompt t where

        -- | 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 _ = 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 _ c :: 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
    t = \_ -> [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ["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]
    ++ " 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 _ _ _ = () -> X ()
    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 relatave 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
    showList :: [XPPosition] -> String -> String
    $cshowList :: [XPPosition] -> String -> String
    show :: XPPosition -> String
    $cshow :: XPPosition -> String
    showsPrec :: Int -> XPPosition -> String -> String
    $cshowsPrec :: Int -> 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
    readListPrec :: ReadPrec [XPPosition]
    $creadListPrec :: ReadPrec [XPPosition]
    readPrec :: ReadPrec XPPosition
    $creadPrec :: ReadPrec XPPosition
    readList :: ReadS [XPPosition]
    $creadList :: ReadS [XPPosition]
    readsPrec :: Int -> ReadS XPPosition
    $creadsPrec :: Int -> ReadS 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, defaultXPConfig, greenXPConfig :: XPConfig

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

    instance Default XPConfig where
      def :: XPConfig
    def =
        $WXPC :: String
    -> String
    -> String
    -> String
    -> String
    -> String
    -> Dimension
    -> XPPosition
    -> Bool
    -> Dimension
    -> Maybe Dimension
    -> Int
    -> ([String] -> [String])
    -> Map (KeyMask, Window) (XP ())
    -> (KeyMask, Window)
    -> Window
    -> String
    -> Maybe Int
    -> Bool
    -> (String -> String -> Bool)
    -> (String -> String)
    -> (String -> [String] -> [String])
    -> XPConfig
    XPC { font :: String
    font                  = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*"
            , 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     = 1
            , promptKeymap :: Map (KeyMask, Window) (XP ())
    promptKeymap          = Map (KeyMask, Window) (XP ())
    defaultXPKeymap
            , completionKey :: (KeyMask, Window)
    completionKey         = (0,Window
    xK_Tab)
            , changeModeKey :: Window
    changeModeKey         = Window
    xK_grave
            , position :: XPPosition
    position              = XPPosition
    Bottom
            , height :: Dimension
    height                = 18
            , maxComplRows :: Maybe Dimension
    maxComplRows          = Maybe Dimension
    forall a. Maybe a
    Nothing
            , historySize :: Int
    historySize           = 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
            , 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
            }
    {-# DEPRECATED defaultXPConfig "Use def (from Data.Default, and re-exported from XMonad.Prompt) instead." #-}
    defaultXPConfig :: XPConfig
    defaultXPConfig = XPConfig
    forall a. Default a => a
    def
    greenXPConfig :: XPConfig
    greenXPConfig = XPConfig
    forall a. Default a => a
    def { bgColor :: String
    bgColor           = "black"
                        , fgColor :: String
    fgColor           = "green"
                        , promptBorderWidth :: Dimension
    promptBorderWidth = 0
                        }
    amberXPConfig :: XPConfig
    amberXPConfig = XPConfig
    forall a. Default a => a
    def { bgColor :: String
    bgColor   = "black"
                        , fgColor :: String
    fgColor   = "#ca8f2d"
                        , fgHLight :: String
    fgHLight  = "#eaaf4c"
                        }

    initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode
              -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> XPState
    initState :: Display
    -> Window
    -> Window
    -> Rectangle
    -> XPOperationMode
    -> GC
    -> XMonadFont
    -> [String]
    -> XPConfig
    -> KeyMask
    -> XPState
    initState d :: Display
    d rw :: Window
    rw w :: Window
    w s :: Rectangle
    s opMode :: XPOperationMode
    opMode gc :: GC
    gc fonts :: XMonadFont
    fonts h :: [String]
    h c :: XPConfig
    c nm :: KeyMask
    nm =
        $WXPS :: Display
    -> Window
    -> Window
    -> Rectangle
    -> Maybe Window
    -> Maybe ComplWindowDim
    -> (Int, Int)
    -> IORef (Maybe Window)
    -> Bool
    -> XPOperationMode
    -> Maybe String
    -> GC
    -> XMonadFont
    -> Stack String
    -> Int
    -> XPConfig
    -> Bool
    -> KeyMask
    -> Bool
    -> Bool
    -> XPColor
    -> (String -> String)
    -> [(Window, String, Event)]
    -> String
    -> Maybe [String]
    -> XPState
    XPS { dpy :: Display
    dpy                   = Display
    d
            , rootw :: Window
    rootw                 = Window
    rw
            , win :: Window
    win                   = Window
    w
            , screen :: Rectangle
    screen                = Rectangle
    s
            , complWin :: Maybe Window
    complWin              = Maybe Window
    forall a. Maybe a
    Nothing
            , complWinDim :: Maybe ComplWindowDim
    complWinDim           = Maybe ComplWindowDim
    forall a. Maybe a
    Nothing
            , complWinRef :: IORef (Maybe Window)
    complWinRef        = IO (IORef (Maybe Window)) -> IORef (Maybe Window)
    forall a. IO a -> a
    unsafePerformIO (Maybe Window -> IO (IORef (Maybe Window))
    forall a. a -> IO (IORef a)
    newIORef Maybe Window
    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        = $WStack :: forall a. a -> [a] -> [a] -> Stack a
    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            = (0,0) --(column index, row index), used when `alwaysHighlight` in XPConfig is True
            , offset :: Int
    offset                = String -> 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
            , numlockMask :: KeyMask
    numlockMask           = KeyMask
    nm
            , prompter :: String -> String
    prompter              = XPConfig -> String -> String
    defaultPrompter XPConfig
    c
            , color :: XPColor
    color                 = XPConfig -> XPColor
    defaultColor XPConfig
    c
            , eventBuffer :: [(Window, String, Event)]
    eventBuffer           = []
            , inputBuffer :: String
    inputBuffer           = ""
            , currentCompletions :: Maybe [String]
    currentCompletions    = Maybe [String]
    forall a. Maybe a
    Nothing
            }

    -- Returns the current XPType
    currentXPMode :: XPState -> XPType
    currentXPMode :: XPState -> XPType
    currentXPMode st :: XPState
    st = case XPState -> XPOperationMode
    operationMode XPState
    st of
      XPMultipleModes modes :: Stack XPType
    modes -> Stack XPType -> XPType
    forall a. Stack a -> a
    W.focus Stack XPType
    modes
      XPSingleMode _ xptype :: 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 st :: XPState
    st = case XPState -> XPOperationMode
    operationMode XPState
    st of
      XPMultipleModes modes :: 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
        (m :: XPType
    m:ms :: [XPType]
    ms) -> let
          currentMode :: XPType
    currentMode = Stack XPType -> XPType
    forall a. Stack a -> a
    W.focus Stack XPType
    modes
          in XPState
    st { operationMode :: XPOperationMode
    operationMode = Stack XPType -> XPOperationMode
    XPMultipleModes $WStack :: forall a. a -> [a] -> [a] -> Stack a
    W.Stack { up :: [XPType]
    W.up = [], focus :: XPType
    W.focus = XPType
    m, down :: [XPType]
    W.down = [XPType]
    ms [XPType] -> [XPType] -> [XPType]
    forall a. [a] -> [a] -> [a]
    ++ [XPType
    currentMode]}} --set next and move previous current mode to the of the stack
      _ -> 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 st' :: XPState
    st' completions :: [String]
    completions = case XPState -> Maybe ComplWindowDim
    complWinDim XPState
    st' of
      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 winDim :: ComplWindowDim
    winDim ->
        let
          (_,_,_,_,xx :: Columns
    xx,yy :: Columns
    yy) = ComplWindowDim
    winDim
          complMatrix :: [[String]]
    complMatrix = Int -> [String] -> [[String]]
    forall a. Int -> [a] -> [[a]]
    splitInSubListsAt (Columns -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Columns
    yy) (Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take (Columns -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Columns
    xx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Columns -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Columns
    yy) [String]
    completions)
          (col_index :: Int
    col_index,row_index :: Int
    row_index) = (XPState -> (Int, Int)
    complIndex XPState
    st')
        in case [String]
    completions of
          [] -> Maybe String
    forall a. Maybe a
    Nothing
          _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [[String]]
    complMatrix [[String]] -> Int -> [String]
    forall a. [a] -> Int -> a
    !! Int
    col_index [String] -> Int -> String
    forall a. [a] -> Int -> a
    !! Int
    row_index

    -- 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 xs :: String
    xs s :: XPState
    s = XPState
    s { commandHistory :: Stack String
    commandHistory = (XPState -> Stack String
    commandHistory XPState
    s) { focus :: String
    W.focus = String
    xs }}

    setHighlightedCompl :: Maybe String -> XPState -> XPState
    setHighlightedCompl :: Maybe String -> XPState -> XPState
    setHighlightedCompl hc :: Maybe String
    hc st :: XPState
    st = XPState
    st { highlightedCompl :: Maybe String
    highlightedCompl = Maybe String
    hc}

    -- | 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. Intented 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 c :: XPConfig
    c = XPColor :: String -> String -> String -> String -> String -> XPColor
    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 c :: 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
    $ \s :: XPState
    s -> XPState
    s { color :: XPColor
    color = XPColor -> XPColor
    c (XPColor -> XPColor) -> XPColor -> XPColor
    forall a b. (a -> b) -> a -> b
    $ XPState -> XPColor
    color XPState
    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 (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 bc :: String
    bc xpc :: XPColor
    xpc = XPColor
    xpc { border :: String
    border = String
    bc }

    -- | Modify the prompter, i.e. for chaining prompters.
    modifyPrompter :: ((String -> String) -> (String -> String)) -> XP ()
    modifyPrompter :: ((String -> String) -> String -> String) -> XP ()
    modifyPrompter p :: (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
    $ \s :: XPState
    s -> XPState
    s { prompter :: String -> String
    prompter = (String -> String) -> String -> String
    p ((String -> String) -> String -> String)
    -> (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ XPState -> String -> String
    prompter XPState
    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 (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 cs :: 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
    $ \s :: XPState
    s -> XPState
    s { currentCompletions :: Maybe [String]
    currentCompletions = Maybe [String]
    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 :: p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a)
    mkXPromptWithReturn t :: p
    t conf :: XPConfig
    conf compl :: ComplFunction
    compl action :: 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 do
          let selectedCompletion :: String
    selectedCompletion =
                case XPConfig -> Bool
    alwaysHighlight (XPState -> XPConfig
    config XPState
    st') of
                  -- When alwaysHighlight is True, autocompletion is
                  -- handled with indexes.
                  False -> XPState -> String
    command XPState
    st'
                  -- When it is false, it is handled depending on the
                  -- prompt buffer's value.
                  True -> 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'
          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 String
    selectedCompletion
        else Maybe a -> X (Maybe 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 :: p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
    mkXPrompt t :: p
    t conf :: XPConfig
    conf compl :: ComplFunction
    compl action :: String -> X ()
    action = 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 X (Maybe ()) -> X () -> X ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> X ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | 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 modes :: [XPType]
    modes conf :: XPConfig
    conf = do
      let defaultMode :: XPType
    defaultMode = [XPType] -> XPType
    forall a. [a] -> a
    head [XPType]
    modes
          modeStack :: Stack XPType
    modeStack = $WStack :: forall a. a -> [a] -> [a] -> Stack a
    W.Stack { focus :: XPType
    W.focus = XPType
    defaultMode -- Current mode
                              , up :: [XPType]
    W.up = []
                              , down :: [XPType]
    W.down = [XPType] -> [XPType]
    forall a. [a] -> [a]
    tail [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 :: Bool
    alwaysHighlight = Bool
    True } XPOperationMode
    om
      if XPState -> Bool
    successful XPState
    st'
        then do
          case XPState -> XPOperationMode
    operationMode XPState
    st' of
            XPMultipleModes ms :: 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 "" (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ XPState -> Maybe String
    highlightedCompl XPState
    st')
            _ -> String -> X ()
    forall a. HasCallStack => String -> a
    error "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
        else () -> X ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- Internal function used to implement 'mkXPromptWithReturn' and
    -- 'mkXPromptWithModes'.
    mkXPromptImplementation :: String -> XPConfig -> XPOperationMode -> X XPState
    mkXPromptImplementation :: String -> XPConfig -> XPOperationMode -> X XPState
    mkXPromptImplementation historyKey :: String
    historyKey conf :: XPConfig
    conf om :: XPOperationMode
    om = do
      XConf { display :: XConf -> Display
    display = Display
    d, theRoot :: XConf -> Window
    theRoot = Window
    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 Window) Window ScreenId ScreenDetail
    -> ScreenDetail
    forall i l a sid sd. Screen i l a sid sd -> sd
    W.screenDetail (Screen String (Layout Window) Window ScreenId ScreenDetail
     -> ScreenDetail)
    -> (XState
        -> Screen String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Screen String (Layout Window) Window 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 Window) Window ScreenId ScreenDetail
     -> Screen String (Layout Window) Window ScreenId ScreenDetail)
    -> (XState
        -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset
      KeyMask
    numlock <- (XState -> KeyMask) -> X KeyMask
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> KeyMask
    X.numberlockMask
      History
    hist <- IO History -> X History
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io IO History
    readHistory
      XMonadFont
    fs <- String -> X XMonadFont
    initXMF (XPConfig -> String
    font 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 Window
    -> (Window -> IO ()) -> (Window -> IO XPState) -> IO XPState
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
          (Display -> Window -> XPConfig -> Rectangle -> IO Window
    createWin Display
    d Window
    rw XPConfig
    conf Rectangle
    s)
          (Display -> Window -> IO ()
    destroyWindow Display
    d)
          (\w :: Window
    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 -> Window -> IO GC
    createGC Display
    d Window
    w)
              (Display -> GC -> IO ()
    freeGC Display
    d)
              (\gc :: GC
    gc -> do
                Display -> Window -> Window -> IO ()
    selectInput Display
    d Window
    w (Window -> IO ()) -> Window -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Window
    exposureMask Window -> Window -> Window
    forall a. Bits a => a -> a -> a
    .|. Window
    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 -> History -> Maybe [String]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    historyKey History
    hist
                    st :: XPState
    st = Display
    -> Window
    -> Window
    -> Rectangle
    -> XPOperationMode
    -> GC
    -> XMonadFont
    -> [String]
    -> XPConfig
    -> KeyMask
    -> XPState
    initState Display
    d Window
    rw Window
    w Rectangle
    s XPOperationMode
    om GC
    gc XMonadFont
    fs [String]
    hs XPConfig
    conf KeyMask
    numlock
                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
    $ History -> IO ()
    writeHistory (History -> IO ()) -> History -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          ([String] -> [String] -> [String])
    -> String -> [String] -> History -> History
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith
          (\xs :: [String]
    xs ys :: [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
    command XPState
    st'])
          History
    hist
      XPState -> X XPState
    forall (m :: * -> *) a. Monad m => a -> m a
    return XPState
    st'

    -- | Removes numlock and capslock from a keymask.
    -- Duplicate of cleanMask from core, but in the
    -- XP monad instead of X.
    cleanMask :: KeyMask -> XP KeyMask
    cleanMask :: KeyMask -> XP KeyMask
    cleanMask msk :: KeyMask
    msk = do
      KeyMask
    numlock <- (XPState -> KeyMask) -> XP KeyMask
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> KeyMask
    numlockMask
      let highMasks :: KeyMask
    highMasks = 1 KeyMask -> Int -> KeyMask
    forall a. Bits a => a -> Int -> a
    `shiftL` 12 KeyMask -> KeyMask -> KeyMask
    forall a. Num a => a -> a -> a
    - 1
      KeyMask -> XP KeyMask
    forall (m :: * -> *) a. Monad m => a -> m a
    return (KeyMask -> KeyMask
    forall a. Bits a => a -> a
    complement (KeyMask
    numlock KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .|. KeyMask
    lockMask) KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .&. KeyMask
    msk KeyMask -> KeyMask -> KeyMask
    forall a. Bits a => a -> a -> a
    .&. KeyMask
    highMasks)

    -- | 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 str :: 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 st :: XPState
    st = do
      let d :: Display
    d = XPState -> Display
    dpy XPState
    st
          w :: Window
    w = XPState -> Window
    win XPState
    st
      XPState
    st' <- IO GrabStatus
    -> (GrabStatus -> IO ())
    -> (GrabStatus -> IO XPState)
    -> IO XPState
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket
        (Display
    -> Window
    -> Bool
    -> GrabStatus
    -> GrabStatus
    -> Window
    -> IO GrabStatus
    grabKeyboard Display
    d Window
    w Bool
    True GrabStatus
    grabModeAsync GrabStatus
    grabModeAsync Window
    currentTime)
        (\_ -> Display -> Window -> IO ()
    ungrabKeyboard Display
    d Window
    currentTime)
        (\status :: GrabStatus
    status ->
          ((XP () -> XPState -> IO XPState) -> XPState -> XP () -> IO XPState
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip XP () -> XPState -> IO XPState
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
    execStateT XPState
    st (XP () -> IO XPState) -> XP () -> IO XPState
    forall a b. (a -> b) -> a -> b
    $ do
            Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (GrabStatus
    status GrabStatus -> GrabStatus -> Bool
    forall a. Eq a => a -> a -> Bool
    == GrabStatus
    grabSuccess) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ do
              XP ()
    updateWindows
              (KeyStroke -> Event -> XP ()) -> XP Bool -> XP ()
    eventLoop KeyStroke -> Event -> XP ()
    handleMain XP Bool
    evDefaultStop)
          IO XPState -> IO () -> IO XPState
    forall a b. IO a -> IO b -> IO a
    `finally` ((Window -> IO ()) -> Maybe Window -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Display -> Window -> IO ()
    destroyWindow Display
    d) (Maybe Window -> IO ()) -> IO (Maybe Window) -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IORef (Maybe Window) -> IO (Maybe Window)
    forall a. IORef a -> IO a
    readIORef (XPState -> IORef (Maybe Window)
    complWinRef 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)
      XPState -> IO XPState
    forall (m :: * -> *) a. Monad m => a -> m a
    return XPState
    st'

    type KeyStroke = (KeySym, String)

    -- | Main event "loop". Gives priority to events from the state's event buffer.
    eventLoop :: (KeyStroke -> Event -> XP ())
              -> XP Bool
              -> XP ()
    eventLoop :: (KeyStroke -> Event -> XP ()) -> XP Bool -> XP ()
    eventLoop handle :: KeyStroke -> Event -> XP ()
    handle stopAction :: XP Bool
    stopAction = do
        [(Window, String, Event)]
    b <- (XPState -> [(Window, String, Event)])
    -> StateT XPState IO [(Window, String, Event)]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> [(Window, String, Event)]
    eventBuffer
        (keysym :: Window
    keysym,keystr :: String
    keystr,event :: Event
    event) <- case [(Window, 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 (Window, String, Event)
    -> StateT XPState IO (Window, String, Event)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Window, String, Event)
     -> StateT XPState IO (Window, String, Event))
    -> IO (Window, String, Event)
    -> StateT XPState IO (Window, String, Event)
    forall a b. (a -> b) -> a -> b
    $ (XEventPtr -> IO (Window, String, Event))
    -> IO (Window, String, Event)
    forall a. (XEventPtr -> IO a) -> IO a
    allocaXEvent ((XEventPtr -> IO (Window, String, Event))
     -> IO (Window, String, Event))
    -> (XEventPtr -> IO (Window, String, Event))
    -> IO (Window, String, Event)
    forall a b. (a -> b) -> a -> b
    $ \e :: XEventPtr
    e -> do
                        Display -> Window -> XEventPtr -> IO ()
    maskEvent Display
    d (Window
    exposureMask Window -> Window -> Window
    forall a. Bits a => a -> a -> a
    .|. Window
    keyPressMask) XEventPtr
    e
                        Event
    ev <- XEventPtr -> IO Event
    getEvent XEventPtr
    e
                        (ks :: Maybe Window
    ks,s :: String
    s) <- if Event -> Dimension
    ev_event_type Event
    ev Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    keyPress
                                  then XKeyEventPtr -> IO (Maybe Window, String)
    lookupString (XKeyEventPtr -> IO (Maybe Window, String))
    -> XKeyEventPtr -> IO (Maybe Window, String)
    forall a b. (a -> b) -> a -> b
    $ XEventPtr -> XKeyEventPtr
    asKeyEvent XEventPtr
    e
                                  else (Maybe Window, String) -> IO (Maybe Window, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Window
    forall a. Maybe a
    Nothing, "")
                        (Window, String, Event) -> IO (Window, String, Event)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Window -> Maybe Window -> Window
    forall a. a -> Maybe a -> a
    fromMaybe Window
    xK_VoidSymbol Maybe Window
    ks,String
    s,Event
    ev)
            l :: [(Window, String, Event)]
    l   -> 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
    $ \s :: XPState
    s -> XPState
    s { eventBuffer :: [(Window, String, Event)]
    eventBuffer = [(Window, String, Event)] -> [(Window, String, Event)]
    forall a. [a] -> [a]
    tail [(Window, String, Event)]
    l }
                    (Window, String, Event)
    -> StateT XPState IO (Window, String, Event)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Window, String, Event)
     -> StateT XPState IO (Window, String, Event))
    -> (Window, String, Event)
    -> StateT XPState IO (Window, String, Event)
    forall a b. (a -> b) -> a -> b
    $ [(Window, String, Event)] -> (Window, String, Event)
    forall a. [a] -> a
    head [(Window, String, Event)]
    l
        KeyStroke -> Event -> XP ()
    handle (Window
    keysym,String
    keystr) Event
    event
        XP Bool
    stopAction XP Bool -> (Bool -> XP ()) -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Bool -> XP () -> XP ()) -> XP () -> Bool -> XP ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ((KeyStroke -> Event -> XP ()) -> XP Bool -> XP ()
    eventLoop KeyStroke -> Event -> XP ()
    handle XP Bool
    stopAction)

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

    -- | Common patterns shared by all event handlers. Expose events can be
    -- triggered by switching virtual consoles.
    handleOther :: KeyStroke -> Event -> XP ()
    handleOther :: KeyStroke -> Event -> XP ()
    handleOther _ (ExposeEvent {ev_window :: Event -> Window
    ev_window = Window
    w}) = do
        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 -> Window
    win XPState
    st Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    w) XP ()
    updateWindows
    handleOther _ _ = () -> XP ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | 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@(keysym :: Window
    keysym,_) (KeyEvent {ev_event_type :: Event -> Dimension
    ev_event_type = Dimension
    t, ev_state :: Event -> KeyMask
    ev_state = KeyMask
    m}) = do
        (compKey :: (KeyMask, Window)
    compKey,modeKey :: Window
    modeKey) <- (XPState -> ((KeyMask, Window), Window))
    -> StateT XPState IO ((KeyMask, Window), Window)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XPState -> ((KeyMask, Window), Window))
     -> StateT XPState IO ((KeyMask, Window), Window))
    -> (XPState -> ((KeyMask, Window), Window))
    -> StateT XPState IO ((KeyMask, Window), Window)
    forall a b. (a -> b) -> a -> b
    $ (XPConfig -> (KeyMask, Window)
    completionKey (XPConfig -> (KeyMask, Window))
    -> (XPConfig -> Window) -> XPConfig -> ((KeyMask, Window), Window)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPConfig -> Window
    changeModeKey) (XPConfig -> ((KeyMask, Window), Window))
    -> (XPState -> XPConfig) -> XPState -> ((KeyMask, Window), Window)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> XPConfig
    config
        KeyMask
    keymask <- KeyMask -> XP KeyMask
    cleanMask 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,Window
    keysym) (KeyMask, Window) -> (KeyMask, Window) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (KeyMask, Window)
    compKey
               then XP (Maybe [String])
    getCurrentCompletions XP (Maybe [String]) -> (Maybe [String] -> XP ()) -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe [String] -> XP ()
    handleCompletionMain
               else do
                    Maybe [String] -> XP ()
    setCurrentCompletions Maybe [String]
    forall a. Maybe a
    Nothing
                    if (Window
    keysym Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    modeKey)
                       then (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify XPState -> XPState
    setNextMode XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    updateWindows
                       else KeyMask -> KeyStroke -> XP ()
    handleInputMain KeyMask
    keymask KeyStroke
    stroke
    handleMain stroke :: KeyStroke
    stroke event :: Event
    event = KeyStroke -> Event -> XP ()
    handleOther KeyStroke
    stroke Event
    event

    -- | Prompt input handler for the main loop.
    handleInputMain :: KeyMask -> KeyStroke -> XP ()
    handleInputMain :: KeyMask -> KeyStroke -> XP ()
    handleInputMain keymask :: KeyMask
    keymask (keysym :: Window
    keysym,keystr :: String
    keystr) = do
        Map (KeyMask, Window) (XP ())
    keymap <- (XPState -> Map (KeyMask, Window) (XP ()))
    -> StateT XPState IO (Map (KeyMask, Window) (XP ()))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (XPConfig -> Map (KeyMask, Window) (XP ())
    promptKeymap (XPConfig -> Map (KeyMask, Window) (XP ()))
    -> (XPState -> XPConfig)
    -> XPState
    -> Map (KeyMask, Window) (XP ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPState -> XPConfig
    config)
        case (KeyMask, Window) -> Map (KeyMask, Window) (XP ()) -> Maybe (XP ())
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (KeyMask
    keymask,Window
    keysym) Map (KeyMask, Window) (XP ())
    keymap of
            -- 'null keystr' i.e. when only a modifier was pressed
            Just action :: XP ()
    action -> XP ()
    action XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    updateWindows
            Nothing     -> Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    keystr) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $
                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
    == 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 <- XP Bool
    tryAutoComplete
                    Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    complete (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> XP ()
    setSuccess Bool
    True XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setDone Bool
    True

    -- 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 :: Maybe [String] -> XP ()
    handleCompletionMain :: Maybe [String] -> XP ()
    handleCompletionMain Nothing   = do
        [String]
    cs <- XP [String]
    getCompletions
        Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([String] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    cs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 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
    $ \s :: XPState
    s -> XPState
    s { showComplWin :: Bool
    showComplWin = Bool
    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
        [String] -> XP ()
    handleCompletion [String]
    cs
    handleCompletionMain (Just cs :: [String]
    cs) = [String] -> XP ()
    handleCompletion [String]
    cs

    handleCompletion :: [String] -> XP ()
    handleCompletion :: [String] -> XP ()
    handleCompletion cs :: [String]
    cs = do
        Bool
    alwaysHlight <- (XPState -> Bool) -> XP Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XPState -> Bool) -> XP Bool) -> (XPState -> Bool) -> XP 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  l :: [String]
    l = [String] -> XP ()
    redrawWindows [String]
    l
            updateState :: [String] -> XP ()
    updateState l :: [String]
    l = case Bool
    alwaysHlight of
                False                                           -> [String] -> XPState -> XP ()
    simpleComplete [String]
    l XPState
    st
                True | String -> Maybe String
    forall a. a -> Maybe a
    Just (XPState -> String
    command XPState
    st) Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= XPState -> Maybe String
    highlightedCompl XPState
    st -> XPState -> XP ()
    alwaysHighlightCurrent XPState
    st
                     | Bool
    otherwise                                -> [String] -> XPState -> XP ()
    alwaysHighlightNext [String]
    l XPState
    st

        case [String]
    cs of
          []  -> XP ()
    updateWindows
          [x :: String
    x] -> do [String] -> XP ()
    updateState [String
    x]
                    [String]
    cs' <- XP [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'
          l :: [String]
    l   -> [String] -> XP ()
    updateState [String]
    l   XP () -> XP () -> XP ()
    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 l :: [String]
    l st :: 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
    $ \s :: XPState
    s -> String -> XPState -> XPState
    setCommand String
    newCommand (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $
                             XPState
    s { offset :: Int
    offset = String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    newCommand
                               , highlightedCompl :: Maybe String
    highlightedCompl = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    newCommand
                               }

            -- If alwaysHighlight is on, and this is the first use of the
            -- completion key, update the buffer so that it contains the
            -- current completion item.
            alwaysHighlightCurrent :: XPState -> XP ()
            alwaysHighlightCurrent :: XPState -> XP ()
    alwaysHighlightCurrent st :: XPState
    st = do
              let newCommand :: String
    newCommand = 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]
    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
    $ \s :: XPState
    s -> String -> XPState -> XPState
    setCommand String
    newCommand (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $
                             Maybe String -> XPState -> XPState
    setHighlightedCompl (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    newCommand) (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $
                             XPState
    s { offset :: Int
    offset = String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    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
            alwaysHighlightNext :: [String] -> XPState -> XP ()
            alwaysHighlightNext :: [String] -> XPState -> XP ()
    alwaysHighlightNext l :: [String]
    l st :: XPState
    st = do
              let complIndex' :: (Int, Int)
    complIndex' = XPState -> Int -> (Int, Int)
    nextComplIndex XPState
    st ([String] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    l)
                  highlightedCompl' :: Maybe String
    highlightedCompl' = XPState -> [String] -> Maybe String
    highlightedItem XPState
    st { complIndex :: (Int, Int)
    complIndex = (Int, Int)
    complIndex'} [String]
    cs
                  newCommand :: String
    newCommand = 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
    $ Maybe String
    highlightedCompl'
              (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
    $ \s :: XPState
    s -> Maybe String -> XPState -> XPState
    setHighlightedCompl Maybe String
    highlightedCompl' (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $
                             String -> XPState -> XPState
    setCommand String
    newCommand (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $
                             XPState
    s { complIndex :: (Int, Int)
    complIndex = (Int, Int)
    complIndex'
                               , offset :: Int
    offset = String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    newCommand
                               }

    -- | 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, Window) (XP ()) -> XP ()
    promptSubmap defaultAction :: XP ()
    defaultAction keymap :: Map (KeyMask, Window) (XP ())
    keymap = do
        Bool
    md <- (XPState -> Bool) -> XP 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 ()) -> XP Bool -> XP ()
    eventLoop (XP ()
    -> Map (KeyMask, Window) (XP ()) -> KeyStroke -> Event -> XP ()
    handleSubmap XP ()
    defaultAction Map (KeyMask, Window) (XP ())
    keymap) XP Bool
    evDefaultStop
        Bool -> XP ()
    setModeDone Bool
    md

    handleSubmap :: XP ()
                 -> M.Map (KeyMask, KeySym) (XP ())
                 -> KeyStroke
                 -> Event
                 -> XP ()
    handleSubmap :: XP ()
    -> Map (KeyMask, Window) (XP ()) -> KeyStroke -> Event -> XP ()
    handleSubmap defaultAction :: XP ()
    defaultAction keymap :: Map (KeyMask, Window) (XP ())
    keymap stroke :: KeyStroke
    stroke (KeyEvent {ev_event_type :: Event -> Dimension
    ev_event_type = Dimension
    t, ev_state :: Event -> KeyMask
    ev_state = KeyMask
    m}) = do
        KeyMask
    keymask <- KeyMask -> XP KeyMask
    cleanMask 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, Window) (XP ()) -> KeyMask -> KeyStroke -> XP ()
    handleInputSubmap XP ()
    defaultAction Map (KeyMask, Window) (XP ())
    keymap KeyMask
    keymask KeyStroke
    stroke
    handleSubmap _ _ stroke :: KeyStroke
    stroke event :: Event
    event = KeyStroke -> Event -> XP ()
    handleOther KeyStroke
    stroke Event
    event

    handleInputSubmap :: XP ()
                      -> M.Map (KeyMask, KeySym) (XP ())
                      -> KeyMask
                      -> KeyStroke
                      -> XP ()
    handleInputSubmap :: XP ()
    -> Map (KeyMask, Window) (XP ()) -> KeyMask -> KeyStroke -> XP ()
    handleInputSubmap defaultAction :: XP ()
    defaultAction keymap :: Map (KeyMask, Window) (XP ())
    keymap keymask :: KeyMask
    keymask (keysym :: Window
    keysym,keystr :: String
    keystr) = do
        case (KeyMask, Window) -> Map (KeyMask, Window) (XP ()) -> Maybe (XP ())
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (KeyMask
    keymask,Window
    keysym) Map (KeyMask, Window) (XP ())
    keymap of
            Just action :: XP ()
    action -> XP ()
    action XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    updateWindows
            Nothing     -> Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    keystr) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ XP ()
    defaultAction XP () -> XP () -> XP ()
    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 f :: String -> String -> (Bool, Bool)
    f = do
        Bool
    md <- (XPState -> Bool) -> XP Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Bool
    modeDone
        Bool -> XP ()
    setModeDone Bool
    False
        (KeyStroke -> Event -> XP ()) -> XP Bool -> XP ()
    eventLoop ((String -> String -> (Bool, Bool)) -> KeyStroke -> Event -> XP ()
    handleBuffer String -> String -> (Bool, Bool)
    f) XP 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
    $ \s :: XPState
    s -> XPState
    s { inputBuffer :: String
    inputBuffer = "" }
        Bool -> XP ()
    setModeDone Bool
    md
        String -> XP String
    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 f :: String -> String -> (Bool, Bool)
    f stroke :: 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 <- KeyMask -> XP KeyMask
    cleanMask 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 _ stroke :: KeyStroke
    stroke event :: 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 f :: String -> String -> (Bool, Bool)
    f keymask :: KeyMask
    keymask (keysym :: Window
    keysym,keystr :: String
    keystr) event :: Event
    event = do
        Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    keystr 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
    /= 0) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ do
            (evB :: [(Window, String, Event)]
    evB,inB :: String
    inB) <- (XPState -> ([(Window, String, Event)], String))
    -> StateT XPState IO ([(Window, String, Event)], String)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (XPState -> [(Window, String, Event)]
    eventBuffer (XPState -> [(Window, String, Event)])
    -> (XPState -> String)
    -> XPState
    -> ([(Window, String, Event)], String)
    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 (cont :: Bool
    cont,keep :: 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
    $ \s :: XPState
    s -> XPState
    s { inputBuffer :: String
    inputBuffer = String
    inB String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    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
    $ \s :: XPState
    s -> XPState
    s { eventBuffer :: [(Window, String, Event)]
    eventBuffer = (Window
    keysym,String
    keystr,Event
    event) (Window, String, Event)
    -> [(Window, String, Event)] -> [(Window, String, Event)]
    forall a. a -> [a] -> [a]
    : [(Window, String, 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 xs :: String
    xs x :: String
    x = (String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    xs Bool -> Bool -> Bool
    && String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    x,Bool
    True)

    --Receives an state of the prompt, the size of the autocompletion list and returns the column,row
    --which should be highlighted next
    nextComplIndex :: XPState -> Int -> (Int,Int)
    nextComplIndex :: XPState -> Int -> (Int, Int)
    nextComplIndex st :: XPState
    st nitems :: Int
    nitems = case XPState -> Maybe ComplWindowDim
    complWinDim XPState
    st of
      Nothing -> (0,0) --no window dims (just destroyed or not created)
      Just (_,_,_,_,xx :: Columns
    xx,yy :: Columns
    yy) -> let
        (ncols :: Int
    ncols,nrows :: Int
    nrows) = (Columns -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Columns
    xx, Columns -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Columns
    yy)
        (currentcol :: Int
    currentcol,currentrow :: Int
    currentrow) = XPState -> (Int, Int)
    complIndex XPState
    st
        in if (Int
    currentcol Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    ncols) then --hlight is in the last column
             if (Int
    currentrow Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    nrows ) then --hlight is still not at the last row
               (Int
    currentcol, Int
    currentrow Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1)
             else
               (0,0)
           else if(Int
    currentrow Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    nrows) then --hlight not at the last row
                  (Int
    currentcol, Int
    currentrow Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1)
                else
                  (Int
    currentcol Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1, 0)

    tryAutoComplete :: XP Bool
    tryAutoComplete :: XP 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 d :: Int
    d -> do [String]
    cs <- XP [String]
    getCompletions
                         case [String]
    cs of
                             [c :: String
    c] -> String -> Int -> XP Bool
    runCompleted String
    c Int
    d XP Bool -> XP Bool -> XP Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                             _   -> Bool -> XP Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            Nothing    -> Bool -> XP Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      where runCompleted :: String -> Int -> XP Bool
    runCompleted cmd :: String
    cmd delay :: 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 "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 -> XP Bool
    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, Window) (XP ())
    defaultXPKeymap = (Char -> Bool) -> Map (KeyMask, Window) (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, Window) (XP ())
    defaultXPKeymap' p :: Char -> Bool
    p = [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ()))
    -> [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall a b. (a -> b) -> a -> b
    $
      ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    controlMask) -- control + <key>
      [ (Window
    xK_u, XP ()
    killBefore)
      , (Window
    xK_k, XP ()
    killAfter)
      , (Window
    xK_a, XP ()
    startOfLine)
      , (Window
    xK_e, XP ()
    endOfLine)
      , (Window
    xK_y, XP ()
    pasteString)
      -- Retain the pre-0.14 moveWord' behavior:
      , (Window
    xK_Right, (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    p Direction1D
    Next XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Next)
      , (Window
    xK_Left, Direction1D -> XP ()
    moveCursor Direction1D
    Prev XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    p Direction1D
    Prev)
      , (Window
    xK_Delete, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Next)
      , (Window
    xK_BackSpace, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Prev)
      , (Window
    xK_w, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Prev)
      , (Window
    xK_g, XP ()
    quit)
      , (Window
    xK_bracketleft, XP ()
    quit)
      ] [((KeyMask, Window), XP ())]
    -> [((KeyMask, Window), XP ())] -> [((KeyMask, Window), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
      ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) 0)
      [ (Window
    xK_Return, Bool -> XP ()
    setSuccess Bool
    True XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setDone Bool
    True)
      , (Window
    xK_KP_Enter, Bool -> XP ()
    setSuccess Bool
    True XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setDone Bool
    True)
      , (Window
    xK_BackSpace, Direction1D -> XP ()
    deleteString Direction1D
    Prev)
      , (Window
    xK_Delete, Direction1D -> XP ()
    deleteString Direction1D
    Next)
      , (Window
    xK_Left, Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
      , (Window
    xK_Right, Direction1D -> XP ()
    moveCursor Direction1D
    Next)
      , (Window
    xK_Home, XP ()
    startOfLine)
      , (Window
    xK_End, XP ()
    endOfLine)
      , (Window
    xK_Down, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
      , (Window
    xK_Up, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
      , (Window
    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, Window) (XP ())
    emacsLikeXPKeymap = (Char -> Bool) -> Map (KeyMask, Window) (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, Window) (XP ())
    emacsLikeXPKeymap' p :: Char -> Bool
    p = [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ()))
    -> [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall a b. (a -> b) -> a -> b
    $
      ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    controlMask) -- control + <key>
      [ (Window
    xK_z, XP ()
    killBefore) --kill line backwards
      , (Window
    xK_k, XP ()
    killAfter) -- kill line fowards
      , (Window
    xK_a, XP ()
    startOfLine) --move to the beginning of the line
      , (Window
    xK_e, XP ()
    endOfLine) -- move to the end of the line
      , (Window
    xK_d, Direction1D -> XP ()
    deleteString Direction1D
    Next) -- delete a character foward
      , (Window
    xK_b, Direction1D -> XP ()
    moveCursor Direction1D
    Prev) -- move cursor forward
      , (Window
    xK_f, Direction1D -> XP ()
    moveCursor Direction1D
    Next) -- move cursor backward
      , (Window
    xK_BackSpace, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Prev) -- kill the previous word
      , (Window
    xK_y, XP ()
    pasteString)
      , (Window
    xK_g, XP ()
    quit)
      , (Window
    xK_bracketleft, XP ()
    quit)
      ] [((KeyMask, Window), XP ())]
    -> [((KeyMask, Window), XP ())] -> [((KeyMask, Window), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
      ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    mod1Mask) -- meta key + <key>
      [ (Window
    xK_BackSpace, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Prev)
      -- Retain the pre-0.14 moveWord' behavior:
      , (Window
    xK_f, (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    p Direction1D
    Next XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Next) -- move a word forward
      , (Window
    xK_b, Direction1D -> XP ()
    moveCursor Direction1D
    Prev XP () -> XP () -> XP ()
    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
      , (Window
    xK_d, (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    p Direction1D
    Next) -- kill the next word
      , (Window
    xK_n, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
      , (Window
    xK_p, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
      ]
      [((KeyMask, Window), XP ())]
    -> [((KeyMask, Window), XP ())] -> [((KeyMask, Window), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
      ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) 0) -- <key>
      [ (Window
    xK_Return, Bool -> XP ()
    setSuccess Bool
    True XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setDone Bool
    True)
      , (Window
    xK_KP_Enter, Bool -> XP ()
    setSuccess Bool
    True XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setDone Bool
    True)
      , (Window
    xK_BackSpace, Direction1D -> XP ()
    deleteString Direction1D
    Prev)
      , (Window
    xK_Delete, Direction1D -> XP ()
    deleteString Direction1D
    Next)
      , (Window
    xK_Left, Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
      , (Window
    xK_Right, Direction1D -> XP ()
    moveCursor Direction1D
    Next)
      , (Window
    xK_Home, XP ()
    startOfLine)
      , (Window
    xK_End, XP ()
    endOfLine)
      , (Window
    xK_Down, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
      , (Window
    xK_Up, (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
      , (Window
    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, Window) (XP ())
    vimLikeXPKeymap = (XPColor -> XPColor)
    -> (String -> String)
    -> (String -> String)
    -> (Char -> Bool)
    -> Map (KeyMask, Window) (XP ())
    vimLikeXPKeymap' (String -> XPColor -> XPColor
    setBorderColor "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, Window) (XP ())
    vimLikeXPKeymap' fromColor :: XPColor -> XPColor
    fromColor promptF :: String -> String
    promptF pasteFilter :: String -> String
    pasteFilter notWord :: Char -> Bool
    notWord = [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ()))
    -> [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall a b. (a -> b) -> a -> b
    $
        ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) 0)
        [ (Window
    xK_Return,       Bool -> XP ()
    setSuccess Bool
    True XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setDone Bool
    True)
        , (Window
    xK_KP_Enter,     Bool -> XP ()
    setSuccess Bool
    True XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setDone Bool
    True)
        , (Window
    xK_BackSpace,    Direction1D -> XP ()
    deleteString Direction1D
    Prev)
        , (Window
    xK_Delete,       Direction1D -> XP ()
    deleteString Direction1D
    Next)
        , (Window
    xK_Left,         Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
        , (Window
    xK_Right,        Direction1D -> XP ()
    moveCursor Direction1D
    Next)
        , (Window
    xK_Home,         XP ()
    startOfLine)
        , (Window
    xK_End,          XP ()
    endOfLine)
        , (Window
    xK_Down,         (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
        , (Window
    xK_Up,           (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
        , (Window
    xK_Escape,       Direction1D -> XP ()
    moveCursor Direction1D
    Prev
                                XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (XPColor -> XPColor) -> XP ()
    modifyColor XPColor -> XPColor
    fromColor
                                XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (String -> String) -> XP ()
    setPrompter String -> String
    promptF
                                XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP () -> Map (KeyMask, Window) (XP ()) -> XP ()
    promptSubmap (() -> XP ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) Map (KeyMask, Window) (XP ())
    normalVimXPKeymap
                                XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    resetColor
                                XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    resetPrompter
          )
        ] where
        normalVimXPKeymap :: Map (KeyMask, Window) (XP ())
    normalVimXPKeymap = [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ()))
    -> [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall a b. (a -> b) -> a -> b
    $
            ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) 0)
            [ (Window
    xK_i,            Bool -> XP ()
    setModeDone Bool
    True)
            , (Window
    xK_a,            Direction1D -> XP ()
    moveCursor Direction1D
    Next XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True)
            , (Window
    xK_s,            Direction1D -> XP ()
    deleteString Direction1D
    Next XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True)
            , (Window
    xK_x,            Direction1D -> XP ()
    deleteString Direction1D
    Next XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    clipCursor)
            , (Window
    xK_Delete,       Direction1D -> XP ()
    deleteString Direction1D
    Next XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    clipCursor)
            , (Window
    xK_p,            Direction1D -> XP ()
    moveCursor Direction1D
    Next
                                    XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (String -> String) -> XP ()
    pasteString' String -> String
    pasteFilter
                                    XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Prev
              )
            , (Window
    xK_0,            XP ()
    startOfLine)
            , (Window
    xK_Escape,       XP ()
    quit)
            , (Window
    xK_Down,         (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
            , (Window
    xK_j,            (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp')
            , (Window
    xK_Up,           (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
            , (Window
    xK_k,            (Stack String -> Stack String) -> XP ()
    moveHistory Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusDown')
            , (Window
    xK_Right,        Direction1D -> XP ()
    moveCursorClip Direction1D
    Next)
            , (Window
    xK_l,            Direction1D -> XP ()
    moveCursorClip Direction1D
    Next)
            , (Window
    xK_h,            Direction1D -> XP ()
    moveCursorClip Direction1D
    Prev)
            , (Window
    xK_Left,         Direction1D -> XP ()
    moveCursorClip Direction1D
    Prev)
            , (Window
    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)
            , (Window
    xK_e,            Direction1D -> XP ()
    moveCursorClip Direction1D
    Next XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    notWord Direction1D
    Next)
            , (Window
    xK_b,            Direction1D -> XP ()
    moveCursorClip Direction1D
    Prev XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char -> Bool) -> Direction1D -> XP ()
    moveWord' Char -> Bool
    notWord Direction1D
    Prev)
            , (Window
    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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursorClip Direction1D
    Next)
            , (Window
    xK_f,            (String -> String -> (Bool, Bool)) -> XP String
    promptBuffer String -> String -> (Bool, Bool)
    bufferOne XP String -> (String -> XP ()) -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Direction1D -> String -> XP ()
    toHeadChar Direction1D
    Next)
            , (Window
    xK_d,            XP () -> Map (KeyMask, Window) (XP ()) -> XP ()
    promptSubmap (Bool -> XP ()
    setModeDone Bool
    True) Map (KeyMask, Window) (XP ())
    deleteVimXPKeymap)
            , (Window
    xK_c,            XP () -> Map (KeyMask, Window) (XP ()) -> XP ()
    promptSubmap (Bool -> XP ()
    setModeDone Bool
    True) Map (KeyMask, Window) (XP ())
    changeVimXPKeymap
                                    XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True
              )
            ] [((KeyMask, Window), XP ())]
    -> [((KeyMask, Window), XP ())] -> [((KeyMask, Window), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
            ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    shiftMask)
            [ (Window
    xK_dollar,       XP ()
    endOfLine XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
            , (Window
    xK_D,            XP ()
    killAfter XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
            , (Window
    xK_C,            XP ()
    killAfter XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True)
            , (Window
    xK_P,            (String -> String) -> XP ()
    pasteString' String -> String
    pasteFilter XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
            , (Window
    xK_A,            XP ()
    endOfLine XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True)
            , (Window
    xK_I,            XP ()
    startOfLine XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setModeDone Bool
    True)
            , (Window
    xK_F,            (String -> String -> (Bool, Bool)) -> XP String
    promptBuffer String -> String -> (Bool, Bool)
    bufferOne XP String -> (String -> XP ()) -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Direction1D -> String -> XP ()
    toHeadChar Direction1D
    Prev)
            ]
        deleteVimXPKeymap :: Map (KeyMask, Window) (XP ())
    deleteVimXPKeymap = [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ()))
    -> [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall a b. (a -> b) -> a -> b
    $
            ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map (((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) 0) ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> ((Window, XP ()) -> (Window, XP ()))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ()))
    -> (XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ())
    forall a b. (a -> b) -> a -> b
    $ (XP () -> XP () -> XP ()) -> XP () -> XP () -> XP ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    (>>) (Bool -> XP ()
    setModeDone Bool
    True)))
            [ (Window
    xK_e,            Direction1D -> XP ()
    deleteString Direction1D
    Next XP () -> XP () -> XP ()
    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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    clipCursor)
            , (Window
    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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> XP ()
    clipCursor)
            , (Window
    xK_0,            XP ()
    killBefore)
            , (Window
    xK_b,            (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    notWord Direction1D
    Prev)
            , (Window
    xK_d,            String -> XP ()
    setInput "")
            ] [((KeyMask, Window), XP ())]
    -> [((KeyMask, Window), XP ())] -> [((KeyMask, Window), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
            ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map (((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    shiftMask) ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> ((Window, XP ()) -> (Window, XP ()))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ()))
    -> (XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ())
    forall a b. (a -> b) -> a -> b
    $ (XP () -> XP () -> XP ()) -> XP () -> XP () -> XP ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    (>>) (Bool -> XP ()
    setModeDone Bool
    True)))
            [ (Window
    xK_dollar,       XP ()
    killAfter XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Direction1D -> XP ()
    moveCursor Direction1D
    Prev)
            ]
        changeVimXPKeymap :: Map (KeyMask, Window) (XP ())
    changeVimXPKeymap = [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ()))
    -> [((KeyMask, Window), XP ())] -> Map (KeyMask, Window) (XP ())
    forall a b. (a -> b) -> a -> b
    $
            ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map (((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) 0) ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> ((Window, XP ()) -> (Window, XP ()))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ()))
    -> (XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ())
    forall a b. (a -> b) -> a -> b
    $ (XP () -> XP () -> XP ()) -> XP () -> XP () -> XP ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    (>>) (Bool -> XP ()
    setModeDone Bool
    True)))
            [ (Window
    xK_e,            Direction1D -> XP ()
    deleteString Direction1D
    Next XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    notWord Direction1D
    Next)
            , (Window
    xK_0,            XP ()
    killBefore)
            , (Window
    xK_b,            (Char -> Bool) -> Direction1D -> XP ()
    killWord' Char -> Bool
    notWord Direction1D
    Prev)
            , (Window
    xK_c,            String -> XP ()
    setInput "")
            , (Window
    xK_w,            (Char -> Bool) -> XP ()
    changeWord Char -> Bool
    notWord)
            ] [((KeyMask, Window), XP ())]
    -> [((KeyMask, Window), XP ())] -> [((KeyMask, Window), XP ())]
    forall a. [a] -> [a] -> [a]
    ++
            ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> [(Window, XP ())] -> [((KeyMask, Window), XP ())]
    forall a b. (a -> b) -> [a] -> [b]
    map (((Window -> (KeyMask, Window))
    -> (Window, XP ()) -> ((KeyMask, Window), XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Window -> (KeyMask, Window))
     -> (Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> (Window -> (KeyMask, Window))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall a b. (a -> b) -> a -> b
    $ (,) KeyMask
    shiftMask) ((Window, XP ()) -> ((KeyMask, Window), XP ()))
    -> ((Window, XP ()) -> (Window, XP ()))
    -> (Window, XP ())
    -> ((KeyMask, Window), XP ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ())
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ()))
    -> (XP () -> XP ()) -> (Window, XP ()) -> (Window, XP ())
    forall a b. (a -> b) -> a -> b
    $ (XP () -> XP () -> XP ()) -> XP () -> XP () -> XP ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    (>>) (Bool -> XP ()
    setModeDone Bool
    True)))
            [ (Window
    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 b :: 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
    $ \s :: XPState
    s -> XPState
    s { successful :: Bool
    successful = Bool
    b }

    -- | Set @True@ to leave all event loops, no matter how nested.
    setDone :: Bool -> XP ()
    setDone :: Bool -> XP ()
    setDone b :: 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
    $ \s :: XPState
    s -> XPState
    s { done :: Bool
    done = Bool
    b }

    -- | Set @True@ to leave the current event loop, i.e. submaps.
    setModeDone :: Bool -> XP ()
    setModeDone :: Bool -> XP ()
    setModeDone b :: 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
    $ \s :: XPState
    s -> XPState
    s { modeDone :: Bool
    modeDone = Bool
    b }

    -- KeyPress and State

    -- | Quit.
    quit :: XP ()
    quit :: XP ()
    quit = XP ()
    flushString XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setSuccess Bool
    False XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> XP ()
    setDone Bool
    True XP () -> XP () -> XP ()
    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
    $ \s :: 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 :: Int
    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
    $ \s :: 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' p :: Char -> Bool
    p d :: 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 (f :: String
    f,ss :: String
    ss)        = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    o String
    c
          delNextWord :: String -> String
    delNextWord   = (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
    . (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    p (String -> (String, 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
          (ncom :: String
    ncom,noff :: Int
    noff)   =
              case Direction1D
    d of
                Next -> (String
    f String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    delNextWord String
    ss, Int
    o)
                Prev -> (String -> String
    delPrevWord String
    f String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ss, String -> 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
    $ \s :: XPState
    s -> String -> XPState -> XPState
    setCommand String
    ncom (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $ XPState
    s { offset :: Int
    offset = Int
    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 p :: Char -> Bool
    p = 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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ((Char -> Bool) -> StateT XPState IO (Char -> Bool)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Char -> Bool
    p) StateT XPState IO (XP ()) -> (XP () -> XP ()) -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= XP () -> XP ()
    forall a. a -> a
    id
        where
            f :: String -> Int -> (Char -> Bool) -> XP ()
            f :: String -> Int -> (Char -> Bool) -> XP ()
    f str :: String
    str off :: Int
    off _ | String -> 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 -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    str Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0       = () -> XP ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            f str :: String
    str off :: Int
    off p' :: Char -> Bool
    p'| Char -> Bool
    p' (Char -> Bool) -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ String
    str String -> Int -> Char
    forall a. [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

    -- | 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
    $ \s :: XPState
    s -> XPState
    s { offset :: Int
    offset = String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (XPState -> String
    command XPState
    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
    $ \s :: XPState
    s -> XPState
    s { offset :: Int
    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
    $ \s :: XPState
    s -> String -> XPState -> XPState
    setCommand "" (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $ XPState
    s { offset :: Int
    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 st :: XPState
    st = if (XPConfig -> Bool
    alwaysHighlight (XPConfig -> Bool) -> XPConfig -> Bool
    forall a b. (a -> b) -> a -> b
    $ XPState -> XPConfig
    config XPState
    st) then XPState
    st { complIndex :: (Int, Int)
    complIndex = (0,0) } else XPState
    st

    -- | Insert a character at the cursor position
    insertString :: String -> XP ()
    insertString :: String -> XP ()
    insertString str :: 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
    $ \s :: XPState
    s -> let
        cmd :: String
    cmd = (String -> Int -> String
    c (XPState -> String
    command XPState
    s) (XPState -> Int
    offset XPState
    s))
        st :: XPState
    st = XPState -> XPState
    resetComplIndex (XPState -> XPState) -> XPState -> XPState
    forall a b. (a -> b) -> a -> b
    $ XPState
    s { offset :: Int
    offset = Int -> Int
    o (XPState -> Int
    offset XPState
    s)}
        in String -> XPState -> XPState
    setCommand String
    cmd XPState
    st
      where o :: Int -> Int
    o oo :: Int
    oo = Int
    oo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    str
            c :: String -> Int -> String
    c oc :: String
    oc oo :: Int
    oo | Int
    oo Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= String -> 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 (f :: String
    f,ss :: 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' f :: String -> String
    f = 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
    $ IO (XP ()) -> StateT XPState IO (XP ())
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (XP ()) -> StateT XPState IO (XP ()))
    -> IO (XP ()) -> StateT XPState IO (XP ())
    forall a b. (a -> b) -> a -> b
    $ (String -> XP ()) -> IO String -> IO (XP ())
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (String -> XP ()
    insertString (String -> XP ()) -> (String -> String) -> String -> XP ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    f) IO String
    forall (m :: * -> *). MonadIO m => m String
    getSelection

    -- | Remove a character at the cursor position
    deleteString :: Direction1D -> XP ()
    deleteString :: Direction1D -> XP ()
    deleteString d :: 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
    $ \s :: 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 :: Int
    offset = Int -> Int
    forall p. (Ord p, Num p) => p -> p
    o (XPState -> Int
    offset XPState
    s)}
      where o :: p -> p
    o oo :: p
    oo = if Direction1D
    d Direction1D -> Direction1D -> Bool
    forall a. Eq a => a -> a -> Bool
    == Direction1D
    Prev then p -> p -> p
    forall a. Ord a => a -> a -> a
    max 0 (p
    oo p -> p -> p
    forall a. Num a => a -> a -> a
    - 1) else p
    oo
            c :: [a] -> Int -> [a]
    c oc :: [a]
    oc oo :: Int
    oo
                | Int
    oo Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= [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
    - 1) [a]
    oc
                | Int
    oo Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <  [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
    - 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 (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]
    ++ [a] -> [a]
    forall a. [a] -> [a]
    tail [a]
    ss
                | Bool
    otherwise = [a]
    oc
                where (f :: [a]
    f,ss :: [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
    $ \s :: XPState
    s -> XPState
    s { offset :: Int
    offset = Int -> String -> Int
    forall (t :: * -> *) a. Foldable t => Int -> t a -> Int
    o (XPState -> Int
    offset XPState
    s) (XPState -> String
    command XPState
    s)}
        where o :: Int -> t a -> Int
    o oo :: Int
    oo c :: 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 0 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ 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
    - 1) Int
    oo

    -- | Move the cursor one position.
    moveCursor :: Direction1D -> XP ()
    moveCursor :: Direction1D -> XP ()
    moveCursor d :: 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
    $ \s :: XPState
    s -> XPState
    s { offset :: Int
    offset = Int -> String -> Int
    forall (t :: * -> *) a. Foldable t => Int -> t a -> Int
    o (XPState -> Int
    offset XPState
    s) (XPState -> String
    command XPState
    s)}
      where o :: Int -> t a -> Int
    o oo :: Int
    oo c :: 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 0 (Int
    oo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1) else Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (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
    + 1)

    -- | Move the cursor one position, but not beyond the command.
    moveCursorClip :: Direction1D -> XP ()
    moveCursorClip :: Direction1D -> XP ()
    moveCursorClip = (XP () -> XP () -> XP ()
    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' p :: Char -> Bool
    p d :: 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 (f :: String
    f,ss :: String
    ss) = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitOn Int
    o String
    c
          splitOn :: Int -> [a] -> ([a], [a])
    splitOn n :: Int
    n xs :: [a]
    xs = (Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1) [a]
    xs, Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop Int
    n [a]
    xs)
          gap :: Int
    gap = case Direction1D
    d of
                    Prev -> Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max 0 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ (Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    c)
                    Next -> 0
          len :: String -> Int
    len = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max 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 (-) 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 (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int)
    -> (String -> Int) -> (String, String) -> (Int, Int)
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** (String -> 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
    . (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
    . (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break 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])
    break (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    p)
          newoff :: Int
    newoff = case Direction1D
    d of
                    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)
                    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
    $ \s :: XPState
    s -> XPState
    s { offset :: Int
    offset = Int
    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 f :: 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
    $ \s :: 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 :: Stack String
    commandHistory = Stack String
    ch
                          , offset :: Int
    offset         = String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> String -> Int
    forall a b. (a -> b) -> a -> b
    $ Stack String -> String
    forall a. Stack a -> a
    W.focus Stack String
    ch
                          , complIndex :: (Int, Int)
    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 d :: Direction1D
    d s :: String
    s = Bool -> XP () -> XP ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s) (XP () -> XP ()) -> XP () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ 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 c :: Char
    c = String -> Char
    forall a. [a] -> a
    head String
    s
            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 b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    (***) (Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe 0 (Maybe Int -> Int) -> (String -> Maybe Int) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int) -> Maybe Int -> Maybe Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +1) (Maybe Int -> Maybe Int)
    -> (String -> Maybe Int) -> String -> Maybe 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 b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop 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
    $ \st :: XPState
    st -> XPState
    st { offset :: Int
    offset = XPState -> Int
    offset XPState
    st Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    off' }

    updateHighlightedCompl :: XP ()
    updateHighlightedCompl :: XP ()
    updateHighlightedCompl = do
      XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      [String]
    cs <- XP [String]
    getCompletions
      Bool
    alwaysHighlight' <- (XPState -> Bool) -> XP Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XPState -> Bool) -> XP Bool) -> (XPState -> Bool) -> XP 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
    $ \s :: XPState
    s -> XPState
    s {highlightedCompl :: Maybe String
    highlightedCompl = XPState -> [String] -> Maybe String
    highlightedItem XPState
    st [String]
    cs}

    -- X Stuff

    updateWindows :: XP ()
    updateWindows :: XP ()
    updateWindows = 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
      [String]
    c <- XP [String]
    getCompletions
      case [String]
    c  of
        [] -> XP ()
    destroyComplWin XP () -> XP () -> XP ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> XP ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        l :: [String]
    l  -> [String] -> XP ()
    redrawComplWin [String]
    l
      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

    redrawWindows :: [String] -> XP ()
    redrawWindows :: [String] -> XP ()
    redrawWindows c :: [String]
    c = 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
      case [String]
    c of
        [] -> () -> XP ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        l :: [String]
    l  -> [String] -> XP ()
    redrawComplWin [String]
    l
      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

    createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window
    createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window
    createWin d :: Display
    d rw :: Window
    rw c :: XPConfig
    c s :: Rectangle
    s = do
      let (x :: Position
    x,y :: Dimension
    y) = case XPConfig -> XPPosition
    position XPConfig
    c of
                    Top -> (0,0)
                    Bottom -> (0, Rectangle -> Dimension
    rect_height Rectangle
    s Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - XPConfig -> Dimension
    height XPConfig
    c)
                    CenteredAt py :: Rational
    py w :: Rational
    w -> (Rational -> Position
    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 (Dimension -> Rational) -> Dimension -> Rational
    forall a b. (a -> b) -> a -> b
    $ Rectangle -> Dimension
    rect_width Rectangle
    s) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * ((1 Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    w) Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / 2), Rational -> Dimension
    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
    s) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - (Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi (XPConfig -> Dimension
    height XPConfig
    c) Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / 2))
          width :: Dimension
    width = case XPConfig -> XPPosition
    position XPConfig
    c of
                    CenteredAt _ w :: Rational
    w -> Rational -> Dimension
    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
    s) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    w
                    _              -> Rectangle -> Dimension
    rect_width Rectangle
    s
      Window
    w <- Display
    -> Screen
    -> Window
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO Window
    mkUnmanagedWindow Display
    d (Display -> Screen
    defaultScreenOfDisplay Display
    d) Window
    rw
                          (Rectangle -> Position
    rect_x Rectangle
    s Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    x) (Rectangle -> Position
    rect_y Rectangle
    s Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    y) Dimension
    width (XPConfig -> Dimension
    height XPConfig
    c)
      Display -> Window -> IO ()
    mapWindow Display
    d Window
    w
      Window -> IO Window
    forall (m :: * -> *) a. Monad m => a -> m a
    return Window
    w

    drawWin :: XP ()
    drawWin :: XP ()
    drawWin = do
      XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let (c :: XPConfig
    c,(cr :: XPColor
    cr,(d :: Display
    d,(w :: Window
    w,gc :: GC
    gc)))) = (XPState -> XPConfig
    config (XPState -> XPConfig)
    -> (XPState -> (XPColor, (Display, (Window, GC))))
    -> XPState
    -> (XPConfig, (XPColor, (Display, (Window, GC))))
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> XPColor
    color (XPState -> XPColor)
    -> (XPState -> (Display, (Window, GC)))
    -> XPState
    -> (XPColor, (Display, (Window, GC)))
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> Display
    dpy (XPState -> Display)
    -> (XPState -> (Window, GC)) -> XPState -> (Display, (Window, GC))
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> Window
    win (XPState -> Window) -> (XPState -> GC) -> XPState -> (Window, GC)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> GC
    gcon) XPState
    st
          scr :: Screen
    scr = Display -> Screen
    defaultScreenOfDisplay Display
    d
          wh :: Dimension
    wh = case XPConfig -> XPPosition
    position XPConfig
    c of
                 CenteredAt _ wd :: Rational
    wd -> Rational -> Dimension
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Rational -> Dimension) -> Rational -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Rational
    wd Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fi (Screen -> Dimension
    widthOfScreen Screen
    scr)
                 _               -> Screen -> Dimension
    widthOfScreen Screen
    scr
          ht :: Dimension
    ht = XPConfig -> Dimension
    height XPConfig
    c
          bw :: Dimension
    bw = XPConfig -> Dimension
    promptBorderWidth XPConfig
    c
      Just bgcolor :: Window
    bgcolor <- IO (Maybe Window) -> StateT XPState IO (Maybe Window)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe Window) -> StateT XPState IO (Maybe Window))
    -> IO (Maybe Window) -> StateT XPState IO (Maybe Window)
    forall a b. (a -> b) -> a -> b
    $ Display -> String -> IO (Maybe Window)
    initColor Display
    d (XPColor -> String
    bgNormal XPColor
    cr)
      Just borderC :: Window
    borderC <- IO (Maybe Window) -> StateT XPState IO (Maybe Window)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe Window) -> StateT XPState IO (Maybe Window))
    -> IO (Maybe Window) -> StateT XPState IO (Maybe Window)
    forall a b. (a -> b) -> a -> b
    $ Display -> String -> IO (Maybe Window)
    initColor Display
    d (XPColor -> String
    border XPColor
    cr)
      Window
    p <- IO Window -> StateT XPState IO Window
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Window -> StateT XPState IO Window)
    -> IO Window -> StateT XPState IO Window
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Window -> Dimension -> Dimension -> GrabStatus -> IO Window
    createPixmap Display
    d Window
    w Dimension
    wh Dimension
    ht
                             (Screen -> GrabStatus
    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
    -> Window
    -> GC
    -> Window
    -> Window
    -> Dimension
    -> Dimension
    -> Dimension
    -> IO ()
    fillDrawable Display
    d Window
    p GC
    gc Window
    borderC Window
    bgcolor (Dimension -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    bw) Dimension
    wh Dimension
    ht
      Window -> XP ()
    printPrompt Window
    p
      IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Window
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> Position
    -> Position
    -> IO ()
    copyArea Display
    d Window
    p Window
    w GC
    gc 0 0 Dimension
    wh Dimension
    ht 0 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 -> Window -> IO ()
    freePixmap Display
    d Window
    p

    printPrompt :: Drawable -> XP ()
    printPrompt :: Window -> XP ()
    printPrompt drw :: Window
    drw = do
      XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let (pr :: String -> String
    pr,(cr :: XPColor
    cr,gc :: GC
    gc)) = (XPState -> String -> String
    prompter (XPState -> String -> String)
    -> (XPState -> (XPColor, GC))
    -> XPState
    -> (String -> String, (XPColor, GC))
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> XPColor
    color (XPState -> XPColor) -> (XPState -> GC) -> XPState -> (XPColor, GC)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> GC
    gcon) XPState
    st
          (c :: XPConfig
    c,(d :: Display
    d,fs :: XMonadFont
    fs)) = (XPState -> XPConfig
    config (XPState -> XPConfig)
    -> (XPState -> (Display, XMonadFont))
    -> XPState
    -> (XPConfig, (Display, XMonadFont))
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> Display
    dpy (XPState -> Display)
    -> (XPState -> XMonadFont) -> XPState -> (Display, XMonadFont)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> XMonadFont
    fontS) XPState
    st
          (prt :: String
    prt,(com :: String
    com,off :: Int
    off)) = (String -> String
    pr (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, Int)) -> XPState -> (String, (String, Int))
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> String
    command (XPState -> String) -> (XPState -> Int) -> XPState -> (String, Int)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> Int
    offset) 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
          (f :: String
    f,p :: String
    p,ss :: String
    ss) = if Int
    off Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    com
                     then (String
    str, " ","") -- add a space: it will be our cursor ;-)
                     else let (a :: String
    a,b :: String
    b) = (Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    off String
    com)
                          in (String
    prt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    a, [String -> Char
    forall a. [a] -> a
    head String
    b], String -> String
    forall a. [a] -> [a]
    tail String
    b)
          ht :: Dimension
    ht = XPConfig -> Dimension
    height XPConfig
    c
      Int
    fsl <- 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 (XPState -> Display
    dpy XPState
    st) XMonadFont
    fs String
    f
      Int
    psl <- 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 (XPState -> Display
    dpy XPState
    st) XMonadFont
    fs String
    p
      (asc :: Position
    asc,desc :: 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
    str
      let y :: Position
    y = 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` 2) Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    + Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi 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` 2

      let draw :: String -> String -> Position -> Position -> String -> XP ()
    draw = Display
    -> Window
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> XP ()
    forall (m :: * -> *).
    (Functor m, MonadIO m) =>
    Display
    -> Window
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> m ()
    printStringXMF Display
    d Window
    drw XMonadFont
    fs GC
    gc
      -- print the first part
      String -> String -> Position -> Position -> String -> XP ()
    draw (XPColor -> String
    fgNormal XPColor
    cr) (XPColor -> String
    bgNormal XPColor
    cr) Position
    x Position
    y String
    f
      -- reverse the colors and print the "cursor" ;-)
      String -> String -> Position -> Position -> String -> XP ()
    draw (XPColor -> String
    bgNormal XPColor
    cr) (XPColor -> String
    fgNormal XPColor
    cr) (Position
    x Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    fsl) Position
    y String
    p
      -- reverse the colors and print the rest of the string
      String -> String -> Position -> Position -> String -> XP ()
    draw (XPColor -> String
    fgNormal XPColor
    cr) (XPColor -> String
    bgNormal XPColor
    cr) (Position
    x Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    fsl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    psl)) Position
    y String
    ss

    -- get the current completion function depending on the active mode
    getCompletionFunction :: XPState -> ComplFunction
    getCompletionFunction :: XPState -> ComplFunction
    getCompletionFunction st :: XPState
    st = case XPState -> XPOperationMode
    operationMode XPState
    st of
      XPSingleMode compl :: ComplFunction
    compl _ -> ComplFunction
    compl
      XPMultipleModes modes :: 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

    -- Completions
    getCompletions :: XP [String]
    getCompletions :: XP [String]
    getCompletions = do
      XPState
    s <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let q :: String
    q     = XPType -> String -> String
    forall t. XPrompt t => t -> String -> String
    commandToComplete (XPState -> XPType
    currentXPMode XPState
    s) (XPState -> String
    command XPState
    s)
          compl :: ComplFunction
    compl = XPState -> ComplFunction
    getCompletionFunction XPState
    s
          srt :: String -> [String] -> [String]
    srt   = XPConfig -> String -> [String] -> [String]
    sorter (XPState -> XPConfig
    config XPState
    s)
      IO [String] -> XP [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [String] -> XP [String]) -> IO [String] -> XP [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> [String] -> [String]
    srt String
    q ([String] -> [String]) -> IO [String] -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ComplFunction
    compl String
    q) IO [String] -> (SomeException -> IO [String]) -> IO [String]
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \(SomeException _) -> [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    setComplWin :: Window -> ComplWindowDim -> XP ()
    setComplWin :: Window -> ComplWindowDim -> XP ()
    setComplWin w :: Window
    w wi :: ComplWindowDim
    wi = do
      IORef (Maybe Window)
    wr <- (XPState -> IORef (Maybe Window))
    -> StateT XPState IO (IORef (Maybe Window))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> IORef (Maybe Window)
    complWinRef
      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 Window) -> Maybe Window -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe Window)
    wr (Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    w)
      (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\s :: XPState
    s -> XPState
    s { complWin :: Maybe Window
    complWin = Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    w, complWinDim :: Maybe ComplWindowDim
    complWinDim = ComplWindowDim -> Maybe ComplWindowDim
    forall a. a -> Maybe a
    Just ComplWindowDim
    wi })

    destroyComplWin :: XP ()
    destroyComplWin :: XP ()
    destroyComplWin = do
      Display
    d  <- (XPState -> Display) -> StateT XPState IO Display
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Display
    dpy
      Maybe Window
    cw <- (XPState -> Maybe Window) -> StateT XPState IO (Maybe Window)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> Maybe Window
    complWin
      IORef (Maybe Window)
    wr <- (XPState -> IORef (Maybe Window))
    -> StateT XPState IO (IORef (Maybe Window))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XPState -> IORef (Maybe Window)
    complWinRef
      case Maybe Window
    cw of
        Just w :: Window
    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 -> Window -> IO ()
    destroyWindow Display
    d Window
    w
                     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 Window) -> Maybe Window -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe Window)
    wr Maybe Window
    forall a. Maybe a
    Nothing
                     (XPState -> XPState) -> XP ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\s :: XPState
    s -> XPState
    s { complWin :: Maybe Window
    complWin = Maybe Window
    forall a. Maybe a
    Nothing, complWinDim :: Maybe ComplWindowDim
    complWinDim = Maybe ComplWindowDim
    forall a. Maybe a
    Nothing })
        Nothing -> () -> XP ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    type ComplWindowDim = (Position,Position,Dimension,Dimension,Columns,Rows)
    type Rows = [Position]
    type Columns = [Position]

    createComplWin :: ComplWindowDim -> XP Window
    createComplWin :: ComplWindowDim -> StateT XPState IO Window
    createComplWin wi :: ComplWindowDim
    wi@(x :: Position
    x,y :: Position
    y,wh :: Dimension
    wh,ht :: Dimension
    ht,_,_) = do
      XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let d :: Display
    d = XPState -> Display
    dpy XPState
    st
          scr :: Screen
    scr = Display -> Screen
    defaultScreenOfDisplay Display
    d
      Window
    w <- IO Window -> StateT XPState IO Window
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Window -> StateT XPState IO Window)
    -> IO Window -> StateT XPState IO Window
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Screen
    -> Window
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO Window
    mkUnmanagedWindow Display
    d Screen
    scr (XPState -> Window
    rootw XPState
    st)
                          Position
    x Position
    y Dimension
    wh Dimension
    ht
      IO () -> XP ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> XP ()) -> IO () -> XP ()
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> IO ()
    mapWindow Display
    d Window
    w
      Window -> ComplWindowDim -> XP ()
    setComplWin Window
    w ComplWindowDim
    wi
      Window -> StateT XPState IO Window
    forall (m :: * -> *) a. Monad m => a -> m a
    return Window
    w

    getComplWinDim :: [String] -> XP ComplWindowDim
    getComplWinDim :: [String] -> XP ComplWindowDim
    getComplWinDim compl :: [String]
    compl = do
      XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let (c :: XPConfig
    c,(scr :: Rectangle
    scr,fs :: XMonadFont
    fs)) = (XPState -> XPConfig
    config (XPState -> XPConfig)
    -> (XPState -> (Rectangle, XMonadFont))
    -> XPState
    -> (XPConfig, (Rectangle, XMonadFont))
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> Rectangle
    screen (XPState -> Rectangle)
    -> (XPState -> XMonadFont) -> XPState -> (Rectangle, XMonadFont)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& XPState -> XMonadFont
    fontS) XPState
    st
          wh :: Dimension
    wh = case XPConfig -> XPPosition
    position XPConfig
    c of
                 CenteredAt _ w :: Rational
    w -> Rational -> Dimension
    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
    w
                 _ -> Rectangle -> Dimension
    rect_width Rectangle
    scr
          ht :: Dimension
    ht = XPConfig -> Dimension
    height XPConfig
    c
          bw :: Dimension
    bw = XPConfig -> Dimension
    promptBorderWidth XPConfig
    c

      [Int]
    tws <- (String -> XP Int) -> [String] -> StateT XPState IO [Int]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Display -> XMonadFont -> String -> XP Int
    forall (m :: * -> *).
    MonadIO m =>
    Display -> XMonadFont -> String -> m Int
    textWidthXMF (XPState -> Display
    dpy XPState
    st) XMonadFont
    fs) [String]
    compl
      let max_compl_len :: Position
    max_compl_len =  Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((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` 2) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [Int]
    tws)
          columns :: Dimension
    columns = Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    max 1 (Dimension -> Dimension) -> Dimension -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Dimension
    wh Dimension -> Dimension -> Dimension
    forall a. Integral a => a -> a -> a
    `div` Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    max_compl_len
          rem_height :: Dimension
    rem_height =  Rectangle -> Dimension
    rect_height Rectangle
    scr Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    ht
          (rows :: Int
    rows,r :: Int
    r) = [String] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [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
          needed_rows :: Int
    needed_rows = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max 1 (Int
    rows Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + if Int
    r Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then 0 else 1)
          limit_max_number :: Dimension -> Dimension
    limit_max_number = case XPConfig -> Maybe Dimension
    maxComplRows XPConfig
    c of
                               Nothing -> Dimension -> Dimension
    forall a. a -> a
    id
                               Just m :: Dimension
    m -> Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    min Dimension
    m
          actual_max_number_of_rows :: Dimension
    actual_max_number_of_rows = Dimension -> Dimension
    limit_max_number (Dimension -> Dimension) -> Dimension -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Dimension
    rem_height Dimension -> Dimension -> Dimension
    forall a. Integral a => a -> a -> a
    `div` Dimension
    ht
          actual_rows :: Dimension
    actual_rows = Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    min Dimension
    actual_max_number_of_rows (Int -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    needed_rows)
          actual_height :: Dimension
    actual_height = Dimension
    actual_rows Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    * Dimension
    ht
          (x :: Position
    x,y :: Dimension
    y) = case XPConfig -> XPPosition
    position XPConfig
    c of
                    Top -> (0,Dimension
    ht Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    bw)
                    Bottom -> (0, (0 Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    + Dimension
    rem_height Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    actual_height Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    + Dimension
    bw))
                    CenteredAt py :: Rational
    py w :: Rational
    w
                      | Rational
    py Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 1Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    /2 -> (Rational -> Position
    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
    * ((1 Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    w) Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / 2), Rational -> Dimension
    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
    /2) Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    bw)
                      | Bool
    otherwise -> (Rational -> Position
    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
    * ((1 Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    w) Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / 2), Rational -> Dimension
    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
    /2) Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    actual_height Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    + Dimension
    bw)
      (asc :: Position
    asc,desc :: 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
    $ [String] -> String
    forall a. [a] -> a
    head [String]
    compl
      let yp :: Dimension
    yp = Dimension -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (Dimension -> Dimension) -> Dimension -> Dimension
    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` 2
          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` 2
          yy :: Columns
    yy = (Dimension -> Position) -> [Dimension] -> Columns
    forall a b. (a -> b) -> [a] -> [b]
    map Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi ([Dimension] -> Columns)
    -> ([Dimension] -> [Dimension]) -> [Dimension] -> Columns
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Dimension] -> [Dimension]
    forall a. Int -> [a] -> [a]
    take (Dimension -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    actual_rows) ([Dimension] -> Columns) -> [Dimension] -> Columns
    forall a b. (a -> b) -> a -> b
    $ [Dimension
    yp,(Dimension
    yp Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    + Dimension
    ht)..]
          xx :: Columns
    xx = Int -> Columns -> Columns
    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
    + Position
    max_compl_len)..]

      ComplWindowDim -> XP ComplWindowDim
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Rectangle -> Position
    rect_x Rectangle
    scr Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    x, Rectangle -> Position
    rect_y Rectangle
    scr Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    y, Dimension
    wh, Dimension
    actual_height, Columns
    xx, Columns
    yy)

    drawComplWin :: Window -> [String] -> XP ()
    drawComplWin :: Window -> [String] -> XP ()
    drawComplWin w :: Window
    w compl :: [String]
    compl = do
      XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let c :: XPConfig
    c   = XPState -> XPConfig
    config XPState
    st
          cr :: XPColor
    cr  = XPState -> XPColor
    color XPState
    st
          d :: Display
    d   = XPState -> Display
    dpy XPState
    st
          scr :: Screen
    scr = Display -> Screen
    defaultScreenOfDisplay Display
    d
          bw :: Dimension
    bw  = XPConfig -> Dimension
    promptBorderWidth XPConfig
    c
          gc :: GC
    gc  = XPState -> GC
    gcon XPState
    st
      Just bgcolor :: Window
    bgcolor <- IO (Maybe Window) -> StateT XPState IO (Maybe Window)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe Window) -> StateT XPState IO (Maybe Window))
    -> IO (Maybe Window) -> StateT XPState IO (Maybe Window)
    forall a b. (a -> b) -> a -> b
    $ Display -> String -> IO (Maybe Window)
    initColor Display
    d (XPColor -> String
    bgNormal XPColor
    cr)
      Just borderC :: Window
    borderC <- IO (Maybe Window) -> StateT XPState IO (Maybe Window)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe Window) -> StateT XPState IO (Maybe Window))
    -> IO (Maybe Window) -> StateT XPState IO (Maybe Window)
    forall a b. (a -> b) -> a -> b
    $ Display -> String -> IO (Maybe Window)
    initColor Display
    d (XPColor -> String
    border XPColor
    cr)

      (_,_,wh :: Dimension
    wh,ht :: Dimension
    ht,xx :: Columns
    xx,yy :: Columns
    yy) <- [String] -> XP ComplWindowDim
    getComplWinDim [String]
    compl

      Window
    p <- IO Window -> StateT XPState IO Window
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Window -> StateT XPState IO Window)
    -> IO Window -> StateT XPState IO Window
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Window -> Dimension -> Dimension -> GrabStatus -> IO Window
    createPixmap Display
    d Window
    w Dimension
    wh Dimension
    ht
                             (Screen -> GrabStatus
    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
    -> Window
    -> GC
    -> Window
    -> Window
    -> Dimension
    -> Dimension
    -> Dimension
    -> IO ()
    fillDrawable Display
    d Window
    p GC
    gc Window
    borderC Window
    bgcolor (Dimension -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    bw) Dimension
    wh Dimension
    ht
      let ac :: [[String]]
    ac = Int -> [String] -> [[String]]
    forall a. Int -> [a] -> [[a]]
    splitInSubListsAt (Columns -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Columns
    yy) (Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take (Columns -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Columns
    xx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Columns -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Columns
    yy) [String]
    compl)

      Display
    -> Window
    -> GC
    -> String
    -> String
    -> Columns
    -> Columns
    -> [[String]]
    -> XP ()
    printComplList Display
    d Window
    p GC
    gc (XPColor -> String
    fgNormal XPColor
    cr) (XPColor -> String
    bgNormal XPColor
    cr) Columns
    xx Columns
    yy [[String]]
    ac
      --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
    -> Window
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> Position
    -> Position
    -> IO ()
    copyArea Display
    d Window
    p Window
    w GC
    gc 0 0 Dimension
    wh Dimension
    ht 0 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 -> Window -> IO ()
    freePixmap Display
    d Window
    p

    redrawComplWin ::  [String] -> XP ()
    redrawComplWin :: [String] -> XP ()
    redrawComplWin compl :: [String]
    compl = do
      XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
      ComplWindowDim
    nwi <- [String] -> XP ComplWindowDim
    getComplWinDim [String]
    compl
      let recreate :: XP ()
    recreate = do XP ()
    destroyComplWin
                        Window
    w <- ComplWindowDim -> StateT XPState IO Window
    createComplWin ComplWindowDim
    nwi
                        Window -> [String] -> XP ()
    drawComplWin Window
    w [String]
    compl
      if [String]
    compl [String] -> [String] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [] Bool -> Bool -> Bool
    && XPState -> Bool
    showComplWin XPState
    st
         then case XPState -> Maybe Window
    complWin XPState
    st of
                Just w :: Window
    w -> case XPState -> Maybe ComplWindowDim
    complWinDim XPState
    st of
                            Just wi :: ComplWindowDim
    wi -> if ComplWindowDim
    nwi ComplWindowDim -> ComplWindowDim -> Bool
    forall a. Eq a => a -> a -> Bool
    == ComplWindowDim
    wi -- complWinDim did not change
                                       then Window -> [String] -> XP ()
    drawComplWin Window
    w [String]
    compl -- so update
                                       else XP ()
    recreate
                            Nothing -> XP ()
    recreate
                Nothing -> XP ()
    recreate
         else XP ()
    destroyComplWin

    -- Finds the column and row indexes in which a string appears.
    -- if the string is not in the matrix, the indexes default to (0,0)
    findComplIndex :: String -> [[String]] -> (Int,Int)
    findComplIndex :: String -> [[String]] -> (Int, Int)
    findComplIndex x :: String
    x xss :: [[String]]
    xss = let
      colIndex :: Int
    colIndex = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe 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 (\cols :: [String]
    cols -> String
    x String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    cols) [[String]]
    xss
      rowIndex :: Int
    rowIndex = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe 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
    x ([String] -> Maybe Int) -> [String] -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ [[String]] -> Int -> [String]
    forall a. [a] -> Int -> a
    (!!) [[String]]
    xss Int
    colIndex
      in (Int
    colIndex,Int
    rowIndex)

    printComplList :: Display -> Drawable -> GC -> String -> String
                   -> [Position] -> [Position] -> [[String]] -> XP ()
    printComplList :: Display
    -> Window
    -> GC
    -> String
    -> String
    -> Columns
    -> Columns
    -> [[String]]
    -> XP ()
    printComplList d :: Display
    d drw :: Window
    drw gc :: GC
    gc fc :: String
    fc bc :: String
    bc xs :: Columns
    xs ys :: Columns
    ys sss :: [[String]]
    sss =
        (Position -> [String] -> XP ()) -> Columns -> [[String]] -> XP ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ (\x :: Position
    x ss :: [String]
    ss ->
            (Position -> String -> XP ()) -> Columns -> [String] -> XP ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ (\y :: Position
    y item :: String
    item -> do
                XPState
    st <- StateT XPState IO XPState
    forall s (m :: * -> *). MonadState s m => m s
    get
                Bool
    alwaysHlight <- (XPState -> Bool) -> XP Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XPState -> Bool) -> XP Bool) -> (XPState -> Bool) -> XP 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
                let (f :: String
    f,b :: String
    b) = case Bool
    alwaysHlight of
                      True -> -- default to the first item, the one in (0,0)
                        let
                          (colIndex :: Int
    colIndex,rowIndex :: Int
    rowIndex) = String -> [[String]] -> (Int, Int)
    findComplIndex String
    item [[String]]
    sss
                        in -- assign some colors
                         if ((XPState -> (Int, Int)
    complIndex XPState
    st) (Int, Int) -> (Int, Int) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int
    colIndex,Int
    rowIndex))
                         then (XPColor -> String
    fgHighlight (XPColor -> String) -> XPColor -> String
    forall a b. (a -> b) -> a -> b
    $ XPState -> XPColor
    color XPState
    st,XPColor -> String
    bgHighlight (XPColor -> String) -> XPColor -> String
    forall a b. (a -> b) -> a -> b
    $ XPState -> XPColor
    color XPState
    st)
                         else (String
    fc,String
    bc)
                      False ->
                        -- compare item with buffer's value
                        if 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)
                        then (XPColor -> String
    fgHighlight (XPColor -> String) -> XPColor -> String
    forall a b. (a -> b) -> a -> b
    $ XPState -> XPColor
    color XPState
    st,XPColor -> String
    bgHighlight (XPColor -> String) -> XPColor -> String
    forall a b. (a -> b) -> a -> b
    $ XPState -> XPColor
    color XPState
    st)
                        else (String
    fc,String
    bc)
                Display
    -> Window
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> XP ()
    forall (m :: * -> *).
    (Functor m, MonadIO m) =>
    Display
    -> Window
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> m ()
    printStringXMF Display
    d Window
    drw (XPState -> XMonadFont
    fontS XPState
    st) GC
    gc String
    f String
    b Position
    x Position
    y String
    item)
            Columns
    ys [String]
    ss) Columns
    xs [[String]]
    sss

    -- History

    type History = M.Map String [String]

    emptyHistory :: History
    emptyHistory :: History
    emptyHistory = History
    forall k a. Map k a
    M.empty

    getHistoryFile :: IO FilePath
    getHistoryFile :: IO String
    getHistoryFile = (String -> String) -> IO String -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "/prompt-history") IO String
    forall (m :: * -> *). MonadIO m => m String
    getXMonadCacheDir

    readHistory :: IO History
    readHistory :: IO History
    readHistory = IO History
    readHist IO History -> (SomeException -> IO History) -> IO History
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \(SomeException _) -> History -> IO History
    forall (m :: * -> *) a. Monad m => a -> m a
    return History
    emptyHistory
     where
        readHist :: IO History
    readHist = do
            String
    path <- IO String
    getHistoryFile
            String
    xs <- IO Handle
    -> (Handle -> IO ()) -> (Handle -> IO String) -> IO String
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket (String -> IOMode -> IO Handle
    openFile String
    path IOMode
    ReadMode) Handle -> IO ()
    hClose Handle -> IO String
    hGetLine
            String -> IO History
    forall a. Read a => String -> IO a
    readIO String
    xs

    writeHistory :: History -> IO ()
    writeHistory :: History -> IO ()
    writeHistory hist :: History
    hist = do
      String
    path <- IO String
    getHistoryFile
      let filtered :: History
    filtered = ([String] -> Bool) -> History -> History
    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 (t :: * -> *) a. Foldable t => t a -> Bool
    null) History
    hist
      String -> String -> IO ()
    writeFile String
    path (History -> String
    forall a. Show a => a -> String
    show History
    filtered) IO () -> (SomeException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \(SomeException e :: e
    e) ->
                              Handle -> String -> IO ()
    hPutStrLn Handle
    stderr ("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
    -> Window
    -> GC
    -> Window
    -> Window
    -> Dimension
    -> Dimension
    -> Dimension
    -> IO ()
    fillDrawable d :: Display
    d drw :: Window
    drw gc :: GC
    gc borderC :: Window
    borderC bgcolor :: Window
    bgcolor bw :: Dimension
    bw wh :: Dimension
    wh ht :: Dimension
    ht = do
      -- we start with the border
      Display -> GC -> Window -> IO ()
    setForeground Display
    d GC
    gc Window
    borderC
      Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO ()
    fillRectangle Display
    d Window
    drw GC
    gc 0 0 Dimension
    wh Dimension
    ht
      -- here foreground means the background of the text
      Display -> GC -> Window -> IO ()
    setForeground Display
    d GC
    gc Window
    bgcolor
      Display
    -> Window
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO ()
    fillRectangle Display
    d Window
    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
    * 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
    * 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
    -> Window
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO Window
    mkUnmanagedWindow d :: Display
    d s :: Screen
    s rw :: Window
    rw x :: Position
    x y :: Position
    y w :: Dimension
    w h :: Dimension
    h = do
      let visual :: Visual
    visual = Screen -> Visual
    defaultVisualOfScreen Screen
    s
          attrmask :: Window
    attrmask = Window
    cWOverrideRedirect
      (Ptr SetWindowAttributes -> IO Window) -> IO Window
    forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
    allocaSetWindowAttributes ((Ptr SetWindowAttributes -> IO Window) -> IO Window)
    -> (Ptr SetWindowAttributes -> IO Window) -> IO Window
    forall a b. (a -> b) -> a -> b
    $
             \attributes :: Ptr SetWindowAttributes
    attributes -> do
               Ptr SetWindowAttributes -> Bool -> IO ()
    set_override_redirect Ptr SetWindowAttributes
    attributes Bool
    True
               Display
    -> Window
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> GrabStatus
    -> GrabStatus
    -> GrabStatus
    -> Visual
    -> Window
    -> Ptr SetWindowAttributes
    -> IO Window
    createWindow Display
    d Window
    rw Position
    x Position
    y Dimension
    w Dimension
    h 0 (Screen -> GrabStatus
    defaultDepthOfScreen Screen
    s)
                            GrabStatus
    inputOutput Visual
    visual Window
    attrmask Ptr SetWindowAttributes
    attributes

    -- $utils

    -- | This function takes a list of possible completions and returns a
    -- completions function to be used with 'mkXPrompt'
    mkComplFunFromList :: [String] -> String -> IO [String]
    mkComplFunFromList :: [String] -> ComplFunction
    mkComplFunFromList _ [] = [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    mkComplFunFromList l :: [String]
    l s :: String
    s =
      [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\x :: String
    x -> Int -> String -> String
    forall a. Int -> [a] -> [a]
    take (String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s) String
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == 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' :: [String] -> String -> IO [String]
    mkComplFunFromList' :: [String] -> ComplFunction
    mkComplFunFromList' l :: [String]
    l [] = [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String]
    l
    mkComplFunFromList' l :: [String]
    l s :: String
    s =
      [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\x :: String
    x -> Int -> String -> String
    forall a. Int -> [a] -> [a]
    take (String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s) String
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == 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 :: t -> String -> [String] -> String
    getNextOfLastWord t :: t
    t c :: String
    c l :: [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. [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 i :: Int
    i -> if Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= [String] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1 then 0 else Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1
                     Nothing -> 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 c :: String
    c l :: [String]
    l = [String]
    l [String] -> Int -> String
    forall a. [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 i :: Int
    i  -> if Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= [String] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1 then 0 else Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1
                      Nothing -> 0

    -- | Given a maximum length, splits a list into sublists
    splitInSubListsAt :: Int -> [a] -> [[a]]
    splitInSubListsAt :: Int -> [a] -> [[a]]
    splitInSubListsAt _ [] = []
    splitInSubListsAt i :: Int
    i x :: [a]
    x = [a]
    f [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : Int -> [a] -> [[a]]
    forall a. Int -> [a] -> [[a]]
    splitInSubListsAt Int
    i [a]
    rest
        where (f :: [a]
    f,rest :: [a]
    rest) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    i [a]
    x

    -- | 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 s :: String
    s
        | " \\" 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
    forall a. [a] -> [a] -> [a]
    ++ String
    s1', String
    s2')
        | Bool
    otherwise = (String
    s1, String
    s2)
          where (s1 :: String
    s1, s2 :: String
    s2 ) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    isSpace String
    s
                (s1' :: String
    s1',s2' :: String
    s2') = String -> (String, String)
    breakAtSpace (String -> (String, String)) -> String -> (String, String)
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. [a] -> [a]
    tail 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 :: ComplFunction
    historyCompletion :: ComplFunction
    historyCompletion = (String -> Bool) -> 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) -> ComplFunction
    historyCompletionP :: (String -> Bool) -> ComplFunction
    historyCompletionP p :: String -> Bool
    p x :: String
    x = (History -> [String]) -> IO History -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (History -> [String]
    forall k. Map k [String] -> [String]
    toComplList (History -> [String])
    -> (History -> History) -> History -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> [String] -> Bool) -> History -> History
    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)) IO History
    readHistory
        where 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]
    (++) []

    -- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off
    --   laziness and stability for efficiency.
    uniqSort :: Ord a => [a] -> [a]
    uniqSort :: [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 [String] -> String
    forall a. [a] -> a
    head ([[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

    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 :: 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 (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 ref :: IORef ([String], Maybe (Stack String))
    ref) next :: Stack String -> Stack String
    next = do
      (completed :: [String]
    completed,completions :: 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    completed
         then case Maybe (Stack String)
    completions of
                Just cs :: 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
    $ \s :: XPState
    s -> XPState
    s { offset :: Int
    offset = String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    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)
                Nothing -> () -> XP ()
    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 prefix :: 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 hm :: 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 hm :: HistoryMatches
    hm = HistoryMatches -> (Stack String -> Stack String) -> XP ()
    historyNextMatching HistoryMatches
    hm Stack String -> Stack String
    forall a. Stack a -> Stack a
    W.focusUp'