{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}
module XMonad.Prompt
(
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
, mkUnmanagedWindow
, fillDrawable
, mkComplFunFromList
, mkComplFunFromList'
, getNextOfLastWord
, getNextCompletion
, getLastWord
, skipLastWord
, splitInSubListsAt
, breakAtSpace
, uniqSort
, historyCompletion
, historyCompletionP
, deleteAllDuplicates
, deleteConsecutive
, HistoryMatches
, initMatches
, historyUpMatching
, historyDownMatching
, 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
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)
, 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
, XPConfig -> String
bgColor :: String
, XPConfig -> String
fgColor :: String
, XPConfig -> String
bgHLight :: String
, XPConfig -> String
fgHLight :: String
, XPConfig -> String
borderColor :: String
, XPConfig -> Window
promptBorderWidth :: !Dimension
, XPConfig -> XPPosition
position :: XPPosition
, XPConfig -> Bool
alwaysHighlight :: !Bool
, XPConfig -> Window
height :: !Dimension
, XPConfig -> Maybe Window
maxComplRows :: Maybe Dimension
, XPConfig -> Int
historySize :: !Int
, XPConfig -> [String] -> [String]
historyFilter :: [String] -> [String]
, XPConfig -> Map (KeyMask, Window) (XP ())
promptKeymap :: M.Map (KeyMask,KeySym) (XP ())
, XPConfig -> (KeyMask, Window)
completionKey :: (KeyMask, KeySym)
, XPConfig -> Window
changeModeKey :: KeySym
, XPConfig -> String
defaultText :: String
, XPConfig -> Maybe Int
autoComplete :: Maybe Int
, XPConfig -> Bool
showCompletionOnTab :: Bool
, XPConfig -> String -> String -> Bool
searchPredicate :: String -> String -> Bool
, XPConfig -> String -> String
defaultPrompter :: String -> String
, XPConfig -> String -> [String] -> [String]
sorter :: String -> [String] -> [String]
}
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
class XPrompt t where
showXPrompt :: t -> String
nextCompletion :: t -> String -> [String] -> String
nextCompletion = t -> String -> [String] -> String
forall t. XPrompt t => t -> String -> [String] -> String
getNextOfLastWord
commandToComplete :: t -> String -> String
commandToComplete _ = String -> String
getLastWord
completionToCommand :: t -> String -> String
completionToCommand _ c :: String
c = String
c
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"]
modeAction :: t -> String -> String -> X ()
modeAction _ _ _ = () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
data XPPosition = Top
| Bottom
| CenteredAt { XPPosition -> Rational
xpCenterY :: Rational
, XPPosition -> Rational
xpWidth :: Rational
}
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
, XPColor -> String
fgNormal :: String
, XPColor -> String
bgHighlight :: String
, XPColor -> String
fgHighlight :: String
, XPColor -> String
border :: String
}
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
-> Window
-> XPPosition
-> Bool
-> Window
-> Maybe Window
-> 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 = "xft:Monospace:size=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 :: Window
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 :: Window
height = 18
, maxComplRows :: Maybe Window
maxComplRows = Maybe Window
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 :: Window
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)
, 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
}
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
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
(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]}}
_ -> XPState
st
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
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
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}
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
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
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
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
}
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 }
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
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
setBorderColor :: String -> XPColor -> XPColor
setBorderColor :: String -> XPColor -> XPColor
setBorderColor bc :: String
bc xpc :: XPColor
xpc = XPColor
xpc { border :: String
border = String
bc }
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 }
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
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
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 }
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
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
False -> XPState -> String
command XPState
st'
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
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 ()
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
, up :: [XPType]
W.up = []
, down :: [XPType]
W.down = [XPType] -> [XPType]
forall a. [a] -> [a]
tail [XPType]
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."
else () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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
([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'
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)
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)
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 -> Window
ev_event_type Event
ev Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
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)
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)
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 ()
handleMain :: KeyStroke -> Event -> XP ()
handleMain :: KeyStroke -> Event -> XP ()
handleMain stroke :: KeyStroke
stroke@(keysym :: Window
keysym,_) (KeyEvent {ev_event_type :: Event -> Window
ev_event_type = Window
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
Bool -> XP () -> XP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
t Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
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
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
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
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
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
}
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
}
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
}
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 -> Window
ev_event_type = Window
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 (Window
t Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
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
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 -> Window
ev_event_type = Window
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 (Window
t Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
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 }
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)
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)
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
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
(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
(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
defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
defaultXPKeymap :: Map (KeyMask, Window) (XP ())
defaultXPKeymap = (Char -> Bool) -> Map (KeyMask, Window) (XP ())
defaultXPKeymap' Char -> Bool
isSpace
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)
[ (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)
, (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)
]
emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
emacsLikeXPKeymap :: Map (KeyMask, Window) (XP ())
emacsLikeXPKeymap = (Char -> Bool) -> Map (KeyMask, Window) (XP ())
emacsLikeXPKeymap' Char -> Bool
isSpace
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)
[ (Window
xK_z, XP ()
killBefore)
, (Window
xK_k, XP ()
killAfter)
, (Window
xK_a, XP ()
startOfLine)
, (Window
xK_e, XP ()
endOfLine)
, (Window
xK_d, Direction1D -> XP ()
deleteString Direction1D
Next)
, (Window
xK_b, Direction1D -> XP ()
moveCursor Direction1D
Prev)
, (Window
xK_f, Direction1D -> XP ()
moveCursor Direction1D
Next)
, (Window
xK_BackSpace, (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
p Direction1D
Prev)
, (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)
[ (Window
xK_BackSpace, (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
p Direction1D
Prev)
, (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)
, (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)
, (Window
xK_d, (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
p Direction1D
Next)
, (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)
[ (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)
]
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
vimLikeXPKeymap' :: (XPColor -> XPColor)
-> (String -> String)
-> (String -> String)
-> (Char -> Bool)
-> 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)
, (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)
]
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 }
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 }
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 }
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
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 }
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
killWord :: Direction1D -> XP ()
killWord :: Direction1D -> XP ()
killWord = (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
isSpace
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)
(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}
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
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)}
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 }
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}
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
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
pasteString :: XP ()
pasteString :: XP ()
pasteString = (String -> String) -> XP ()
pasteString' String -> String
forall a. a -> a
id
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
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
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
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)
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
moveWord :: Direction1D -> XP ()
moveWord :: Direction1D -> XP ()
moveWord = (Char -> Bool) -> Direction1D -> XP ()
moveWord' Char -> Bool
isSpace
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 }
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
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}
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 :: Window
y) = case XPConfig -> XPPosition
position XPConfig
c of
Top -> (0,0)
Bottom -> (0, Rectangle -> Window
rect_height Rectangle
s Window -> Window -> Window
forall a. Num a => a -> a -> a
- XPConfig -> Window
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
$ (Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi (Window -> Rational) -> Window -> Rational
forall a b. (a -> b) -> a -> b
$ Rectangle -> Window
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 -> Window
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Window) -> Rational -> Window
forall a b. (a -> b) -> a -> b
$ Rational
py Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Window
rect_height Rectangle
s) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi (XPConfig -> Window
height XPConfig
c) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ 2))
width :: Window
width = case XPConfig -> XPPosition
position XPConfig
c of
CenteredAt _ w :: Rational
w -> Rational -> Window
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Window) -> Rational -> Window
forall a b. (a -> b) -> a -> b
$ Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Window
rect_width Rectangle
s) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
w
_ -> Rectangle -> Window
rect_width Rectangle
s
Window
w <- Display
-> Screen
-> Window
-> Position
-> Position
-> Window
-> Window
-> 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
+ Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi Window
y) Window
width (XPConfig -> Window
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 :: Window
wh = case XPConfig -> XPPosition
position XPConfig
c of
CenteredAt _ wd :: Rational
wd -> Rational -> Window
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Window) -> Rational -> Window
forall a b. (a -> b) -> a -> b
$ Rational
wd Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi (Screen -> Window
widthOfScreen Screen
scr)
_ -> Screen -> Window
widthOfScreen Screen
scr
ht :: Window
ht = XPConfig -> Window
height XPConfig
c
bw :: Window
bw = XPConfig -> Window
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 -> Window -> Window -> GrabStatus -> IO Window
createPixmap Display
d Window
w Window
wh Window
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
-> Window
-> Window
-> Window
-> IO ()
fillDrawable Display
d Window
p GC
gc Window
borderC Window
bgcolor (Window -> Window
forall a b. (Integral a, Num b) => a -> b
fi Window
bw) Window
wh Window
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
-> Window
-> Window
-> Position
-> Position
-> IO ()
copyArea Display
d Window
p Window
w GC
gc 0 0 Window
wh Window
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
(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, " ","")
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 :: Window
ht = XPConfig -> Window
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 = Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Window -> Position) -> Window -> Position
forall a b. (a -> b) -> a -> b
$ ((Window
ht Window -> Window -> Window
forall a. Num a => a -> a -> a
- Position -> Window
forall a b. (Integral a, Num b) => a -> b
fi (Position
asc Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
desc)) Window -> Window -> Window
forall a. Integral a => a -> a -> a
`div` 2) Window -> Window -> Window
forall a. Num a => a -> a -> a
+ Position -> Window
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
String -> String -> Position -> Position -> String -> XP ()
draw (XPColor -> String
fgNormal XPColor
cr) (XPColor -> String
bgNormal XPColor
cr) Position
x Position
y String
f
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
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
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
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 :: Window
wh,ht :: Window
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
-> Window
-> Window
-> IO Window
mkUnmanagedWindow Display
d Screen
scr (XPState -> Window
rootw XPState
st)
Position
x Position
y Window
wh Window
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 :: Window
wh = case XPConfig -> XPPosition
position XPConfig
c of
CenteredAt _ w :: Rational
w -> Rational -> Window
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Window) -> Rational -> Window
forall a b. (a -> b) -> a -> b
$ Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Window
rect_width Rectangle
scr) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
w
_ -> Rectangle -> Window
rect_width Rectangle
scr
ht :: Window
ht = XPConfig -> Window
height XPConfig
c
bw :: Window
bw = XPConfig -> Window
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 ((Window -> Int
forall a b. (Integral a, Num b) => a -> b
fi Window
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 :: Window
columns = Window -> Window -> Window
forall a. Ord a => a -> a -> a
max 1 (Window -> Window) -> Window -> Window
forall a b. (a -> b) -> a -> b
$ Window
wh Window -> Window -> Window
forall a. Integral a => a -> a -> a
`div` Position -> Window
forall a b. (Integral a, Num b) => a -> b
fi Position
max_compl_len
rem_height :: Window
rem_height = Rectangle -> Window
rect_height Rectangle
scr Window -> Window -> Window
forall a. Num a => a -> a -> a
- Window
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` Window -> Int
forall a b. (Integral a, Num b) => a -> b
fi Window
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 :: Window -> Window
limit_max_number = case XPConfig -> Maybe Window
maxComplRows XPConfig
c of
Nothing -> Window -> Window
forall a. a -> a
id
Just m :: Window
m -> Window -> Window -> Window
forall a. Ord a => a -> a -> a
min Window
m
actual_max_number_of_rows :: Window
actual_max_number_of_rows = Window -> Window
limit_max_number (Window -> Window) -> Window -> Window
forall a b. (a -> b) -> a -> b
$ Window
rem_height Window -> Window -> Window
forall a. Integral a => a -> a -> a
`div` Window
ht
actual_rows :: Window
actual_rows = Window -> Window -> Window
forall a. Ord a => a -> a -> a
min Window
actual_max_number_of_rows (Int -> Window
forall a b. (Integral a, Num b) => a -> b
fi Int
needed_rows)
actual_height :: Window
actual_height = Window
actual_rows Window -> Window -> Window
forall a. Num a => a -> a -> a
* Window
ht
(x :: Position
x,y :: Window
y) = case XPConfig -> XPPosition
position XPConfig
c of
Top -> (0,Window
ht Window -> Window -> Window
forall a. Num a => a -> a -> a
- Window
bw)
Bottom -> (0, (0 Window -> Window -> Window
forall a. Num a => a -> a -> a
+ Window
rem_height Window -> Window -> Window
forall a. Num a => a -> a -> a
- Window
actual_height Window -> Window -> Window
forall a. Num a => a -> a -> a
+ Window
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
$ Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Window
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 -> Window
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
py Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Window
rect_height Rectangle
scr) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Window
ht)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/2) Window -> Window -> Window
forall a. Num a => a -> a -> a
- Window
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
$ Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Window
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 -> Window
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
py Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Window
rect_height Rectangle
scr) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (Window -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Window
ht)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/2) Window -> Window -> Window
forall a. Num a => a -> a -> a
- Window
actual_height Window -> Window -> Window
forall a. Num a => a -> a -> a
+ Window
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 :: Window
yp = Window -> Window
forall a b. (Integral a, Num b) => a -> b
fi (Window -> Window) -> Window -> Window
forall a b. (a -> b) -> a -> b
$ (Window
ht Window -> Window -> Window
forall a. Num a => a -> a -> a
+ Position -> Window
forall a b. (Integral a, Num b) => a -> b
fi (Position
asc Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
desc)) Window -> Window -> Window
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 = (Window -> Position) -> [Window] -> Columns
forall a b. (a -> b) -> [a] -> [b]
map Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi ([Window] -> Columns)
-> ([Window] -> [Window]) -> [Window] -> Columns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Window] -> [Window]
forall a. Int -> [a] -> [a]
take (Window -> Int
forall a b. (Integral a, Num b) => a -> b
fi Window
actual_rows) ([Window] -> Columns) -> [Window] -> Columns
forall a b. (a -> b) -> a -> b
$ [Window
yp,(Window
yp Window -> Window -> Window
forall a. Num a => a -> a -> a
+ Window
ht)..]
xx :: Columns
xx = Int -> Columns -> Columns
forall a. Int -> [a] -> [a]
take (Window -> Int
forall a b. (Integral a, Num b) => a -> b
fi Window
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
+ Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi Window
y, Window
wh, Window
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 :: Window
bw = XPConfig -> Window
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 :: Window
wh,ht :: Window
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 -> Window -> Window -> GrabStatus -> IO Window
createPixmap Display
d Window
w Window
wh Window
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
-> Window
-> Window
-> Window
-> IO ()
fillDrawable Display
d Window
p GC
gc Window
borderC Window
bgcolor (Window -> Window
forall a b. (Integral a, Num b) => a -> b
fi Window
bw) Window
wh Window
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
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
-> Window
-> Window
-> Position
-> Position
-> IO ()
copyArea Display
d Window
p Window
w GC
gc 0 0 Window
wh Window
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
then Window -> [String] -> XP ()
drawComplWin Window
w [String]
compl
else XP ()
recreate
Nothing -> XP ()
recreate
Nothing -> XP ()
recreate
else XP ()
destroyComplWin
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 ->
let
(colIndex :: Int
colIndex,rowIndex :: Int
rowIndex) = String -> [[String]] -> (Int, Int)
findComplIndex String
item [[String]]
sss
in
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 ->
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
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
fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel
-> Dimension -> Dimension -> Dimension -> IO ()
fillDrawable :: Display
-> Window
-> GC
-> Window
-> Window
-> Window
-> Window
-> Window
-> IO ()
fillDrawable d :: Display
d drw :: Window
drw gc :: GC
gc borderC :: Window
borderC bgcolor :: Window
bgcolor bw :: Window
bw wh :: Window
wh ht :: Window
ht = do
Display -> GC -> Window -> IO ()
setForeground Display
d GC
gc Window
borderC
Display
-> Window
-> GC
-> Position
-> Position
-> Window
-> Window
-> IO ()
fillRectangle Display
d Window
drw GC
gc 0 0 Window
wh Window
ht
Display -> GC -> Window -> IO ()
setForeground Display
d GC
gc Window
bgcolor
Display
-> Window
-> GC
-> Position
-> Position
-> Window
-> Window
-> IO ()
fillRectangle Display
d Window
drw GC
gc (Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi Window
bw) (Window -> Position
forall a b. (Integral a, Num b) => a -> b
fi Window
bw) (Window
wh Window -> Window -> Window
forall a. Num a => a -> a -> a
- (Window
bw Window -> Window -> Window
forall a. Num a => a -> a -> a
* 2)) (Window
ht Window -> Window -> Window
forall a. Num a => a -> a -> a
- (Window
bw Window -> Window -> Window
forall a. Num a => a -> a -> a
* 2))
mkUnmanagedWindow :: Display -> Screen -> Window -> Position
-> Position -> Dimension -> Dimension -> IO Window
mkUnmanagedWindow :: Display
-> Screen
-> Window
-> Position
-> Position
-> Window
-> Window
-> IO Window
mkUnmanagedWindow d :: Display
d s :: Screen
s rw :: Window
rw x :: Position
x y :: Position
y w :: Window
w h :: Window
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
-> Window
-> Window
-> GrabStatus
-> GrabStatus
-> GrabStatus
-> Visual
-> Window
-> Ptr SetWindowAttributes
-> IO Window
createWindow Display
d Window
rw Position
x Position
y Window
w Window
h 0 (Screen -> GrabStatus
defaultDepthOfScreen Screen
s)
GrabStatus
inputOutput Visual
visual Window
attrmask Ptr SetWindowAttributes
attributes
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
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
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
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
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
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
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 :: ComplFunction
historyCompletion :: ComplFunction
historyCompletion = (String -> Bool) -> ComplFunction
historyCompletionP (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True)
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]
(++) []
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
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)))
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
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
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'