{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MultiWayIf #-}
module XMonad.Prompt
(
mkXPrompt
, mkXPromptWithReturn
, mkXPromptWithModes
, def
, amberXPConfig
, greenXPConfig
, XPMode
, XPType (..)
, XPColor (..)
, XPPosition (..)
, XPConfig (..)
, XPrompt (..)
, XP
, defaultXPKeymap, defaultXPKeymap'
, emacsLikeXPKeymap, emacsLikeXPKeymap'
, vimLikeXPKeymap, vimLikeXPKeymap'
, quit
, promptSubmap, promptBuffer, toHeadChar, bufferOne
, killBefore, killAfter, startOfLine, endOfLine
, insertString, pasteString, pasteString'
, clipCursor, moveCursor, moveCursorClip
, setInput, getInput, getOffset
, defaultColor, modifyColor, setColor
, resetColor, setBorderColor
, modifyPrompter, setPrompter, resetPrompter
, selectedCompletion, setCurrentCompletions, getCurrentCompletions
, moveWord, moveWord', killWord, killWord'
, changeWord, deleteString
, moveHistory, setSuccess, setDone, setModeDone
, Direction1D(..)
, ComplFunction
, ComplCaseSensitivity(..)
, 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 XMonad.Prelude hiding (toList, fromList)
import qualified XMonad.StackSet as W
import XMonad.Util.Font
import XMonad.Util.Types
import XMonad.Util.XSelection (getSelection)
import Codec.Binary.UTF8.String (decodeString,isUTF8Encoded)
import Control.Arrow (first, (&&&), (***))
import Control.Concurrent (threadDelay)
import Control.Exception as E hiding (handle)
import Control.Monad.State
import Data.Bifunctor (bimap)
import Data.Bits
import Data.IORef
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.Set (fromList, toList)
import System.IO
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Files
import Data.List.NonEmpty (nonEmpty)
type XP = StateT XPState IO
data XPState =
XPS { XPState -> Display
dpy :: Display
, XPState -> EventMask
rootw :: !Window
, XPState -> EventMask
win :: !Window
, XPState -> Rectangle
screen :: !Rectangle
, XPState -> Dimension
winWidth :: !Dimension
, XPState -> Maybe ComplWindowDim
complWinDim :: Maybe ComplWindowDim
, XPState -> (Int, Int)
complIndex :: !(Int,Int)
, XPState -> IORef (Maybe EventMask)
complWin :: 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 -> KeyMask
cleanMask :: KeyMask -> KeyMask
, XPState -> Bool
done :: Bool
, XPState -> Bool
modeDone :: Bool
, XPState -> XPColor
color :: XPColor
, XPState -> String -> String
prompter :: String -> String
, XPState -> [(EventMask, String, Event)]
eventBuffer :: [(KeySym, String, Event)]
, XPState -> String
inputBuffer :: String
, XPState -> Maybe [String]
currentCompletions :: Maybe [String]
}
data XPConfig =
XPC { XPConfig -> String
font :: String
, XPConfig -> String
bgColor :: String
, XPConfig -> String
fgColor :: String
, XPConfig -> String
bgHLight :: String
, XPConfig -> String
fgHLight :: String
, XPConfig -> String
borderColor :: String
, XPConfig -> Dimension
promptBorderWidth :: !Dimension
, XPConfig -> XPPosition
position :: XPPosition
, XPConfig -> Bool
alwaysHighlight :: !Bool
, XPConfig -> Dimension
height :: !Dimension
, XPConfig -> Maybe Dimension
maxComplRows :: Maybe Dimension
, XPConfig -> Maybe Dimension
maxComplColumns :: Maybe Dimension
, XPConfig -> Int
historySize :: !Int
, XPConfig -> [String] -> [String]
historyFilter :: [String] -> [String]
, XPConfig -> Map (KeyMask, EventMask) (XP ())
promptKeymap :: M.Map (KeyMask,KeySym) (XP ())
, XPConfig -> (KeyMask, EventMask)
completionKey :: (KeyMask, KeySym)
, XPConfig -> (KeyMask, EventMask)
prevCompletionKey :: (KeyMask, KeySym)
, XPConfig -> EventMask
changeModeKey :: KeySym
, XPConfig -> String
defaultText :: String
, XPConfig -> Maybe Int
autoComplete :: Maybe Int
, XPConfig -> Bool
showCompletionOnTab :: Bool
, XPConfig -> ComplCaseSensitivity
complCaseSensitivity :: ComplCaseSensitivity
, 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)
data ComplCaseSensitivity = CaseSensitive | CaseInSensitive
instance Show XPType where
show :: XPType -> String
show (XPT p
p) = forall t. XPrompt t => t -> String
showXPrompt p
p
instance XPrompt XPType where
showXPrompt :: XPType -> String
showXPrompt = forall a. Show a => a -> String
show
nextCompletion :: XPType -> String -> [String] -> String
nextCompletion (XPT p
t) = forall t. XPrompt t => t -> String -> [String] -> String
nextCompletion p
t
commandToComplete :: XPType -> String -> String
commandToComplete (XPT p
t) = forall t. XPrompt t => t -> String -> String
commandToComplete p
t
completionToCommand :: XPType -> String -> String
completionToCommand (XPT p
t) = forall t. XPrompt t => t -> String -> String
completionToCommand p
t
completionFunction :: XPType -> ComplFunction
completionFunction (XPT p
t) = forall t. XPrompt t => t -> ComplFunction
completionFunction p
t
modeAction :: XPType -> String -> String -> X ()
modeAction (XPT p
t) = forall t. XPrompt t => t -> String -> String -> X ()
modeAction p
t
class XPrompt t where
{-# MINIMAL showXPrompt #-}
showXPrompt :: t -> String
nextCompletion :: t -> String -> [String] -> String
nextCompletion = forall t. XPrompt t => t -> String -> [String] -> String
getNextOfLastWord
commandToComplete :: t -> String -> String
commandToComplete t
_ = String -> String
getLastWord
completionToCommand :: t -> String -> String
completionToCommand t
_ String
c = String
c
completionFunction :: t -> ComplFunction
completionFunction t
t = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return [String
"Completions for " forall a. [a] -> [a] -> [a]
++ forall t. XPrompt t => t -> String
showXPrompt t
t forall a. [a] -> [a] -> [a]
++ String
" could not be loaded"]
modeAction :: t -> String -> String -> X ()
modeAction t
_ String
_ String
_ = 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
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]
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, greenXPConfig :: XPConfig
instance Default XPColor where
def :: XPColor
def =
XPColor { bgNormal :: String
bgNormal = String
"grey22"
, fgNormal :: String
fgNormal = String
"grey80"
, bgHighlight :: String
bgHighlight = String
"grey"
, fgHighlight :: String
fgHighlight = String
"black"
, border :: String
border = String
"white"
}
instance Default XPConfig where
def :: XPConfig
def =
#ifdef XFT
XPC { font :: String
font = String
"xft:monospace-12"
#else
XPC { font = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*"
#endif
, bgColor :: String
bgColor = XPColor -> String
bgNormal forall a. Default a => a
def
, fgColor :: String
fgColor = XPColor -> String
fgNormal forall a. Default a => a
def
, bgHLight :: String
bgHLight = XPColor -> String
bgHighlight forall a. Default a => a
def
, fgHLight :: String
fgHLight = XPColor -> String
fgHighlight forall a. Default a => a
def
, borderColor :: String
borderColor = XPColor -> String
border forall a. Default a => a
def
, promptBorderWidth :: Dimension
promptBorderWidth = Dimension
1
, promptKeymap :: Map (KeyMask, EventMask) (XP ())
promptKeymap = Map (KeyMask, EventMask) (XP ())
defaultXPKeymap
, completionKey :: (KeyMask, EventMask)
completionKey = (KeyMask
0, EventMask
xK_Tab)
, prevCompletionKey :: (KeyMask, EventMask)
prevCompletionKey = (KeyMask
shiftMask, EventMask
xK_Tab)
, changeModeKey :: EventMask
changeModeKey = EventMask
xK_grave
, position :: XPPosition
position = XPPosition
Bottom
, height :: Dimension
height = Dimension
18
, maxComplRows :: Maybe Dimension
maxComplRows = forall a. Maybe a
Nothing
, maxComplColumns :: Maybe Dimension
maxComplColumns = forall a. Maybe a
Nothing
, historySize :: Int
historySize = Int
256
, historyFilter :: [String] -> [String]
historyFilter = forall a. a -> a
id
, defaultText :: String
defaultText = []
, autoComplete :: Maybe Int
autoComplete = forall a. Maybe a
Nothing
, showCompletionOnTab :: Bool
showCompletionOnTab = Bool
False
, complCaseSensitivity :: ComplCaseSensitivity
complCaseSensitivity = ComplCaseSensitivity
CaseSensitive
, searchPredicate :: String -> String -> Bool
searchPredicate = forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf
, alwaysHighlight :: Bool
alwaysHighlight = Bool
False
, defaultPrompter :: String -> String
defaultPrompter = forall a. a -> a
id
, sorter :: String -> [String] -> [String]
sorter = forall a b. a -> b -> a
const forall a. a -> a
id
}
greenXPConfig :: XPConfig
greenXPConfig = forall a. Default a => a
def { bgColor :: String
bgColor = String
"black"
, fgColor :: String
fgColor = String
"green"
, promptBorderWidth :: Dimension
promptBorderWidth = Dimension
0
}
amberXPConfig :: XPConfig
amberXPConfig = forall a. Default a => a
def { bgColor :: String
bgColor = String
"black"
, fgColor :: String
fgColor = String
"#ca8f2d"
, fgHLight :: String
fgHLight = String
"#eaaf4c"
}
initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode
-> GC -> XMonadFont -> [String] -> XPConfig -> (KeyMask -> KeyMask)
-> Dimension -> XPState
initState :: Display
-> EventMask
-> EventMask
-> Rectangle
-> XPOperationMode
-> GC
-> XMonadFont
-> [String]
-> XPConfig
-> (KeyMask -> KeyMask)
-> Dimension
-> XPState
initState Display
d EventMask
rw EventMask
w Rectangle
s XPOperationMode
opMode GC
gc XMonadFont
fonts [String]
h XPConfig
c KeyMask -> KeyMask
cm Dimension
width =
XPS { dpy :: Display
dpy = Display
d
, rootw :: EventMask
rootw = EventMask
rw
, win :: EventMask
win = EventMask
w
, screen :: Rectangle
screen = Rectangle
s
, winWidth :: Dimension
winWidth = Dimension
width
, complWinDim :: Maybe ComplWindowDim
complWinDim = forall a. Maybe a
Nothing
, complWin :: IORef (Maybe EventMask)
complWin = forall a. IO a -> a
unsafePerformIO (forall a. a -> IO (IORef a)
newIORef 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 = forall a. Maybe a
Nothing
, gcon :: GC
gcon = GC
gc
, fontS :: XMonadFont
fontS = XMonadFont
fonts
, commandHistory :: Stack String
commandHistory = W.Stack { focus :: String
W.focus = XPConfig -> String
defaultText XPConfig
c
, up :: [String]
W.up = []
, down :: [String]
W.down = [String]
h
}
, complIndex :: (Int, Int)
complIndex = (Int
0,Int
0)
, offset :: Int
offset = forall (t :: * -> *) a. Foldable t => t a -> Int
length (XPConfig -> String
defaultText XPConfig
c)
, config :: XPConfig
config = XPConfig
c
, successful :: Bool
successful = Bool
False
, done :: Bool
done = Bool
False
, modeDone :: Bool
modeDone = Bool
False
, cleanMask :: KeyMask -> KeyMask
cleanMask = KeyMask -> KeyMask
cm
, prompter :: String -> String
prompter = XPConfig -> String -> String
defaultPrompter XPConfig
c
, color :: XPColor
color = XPConfig -> XPColor
defaultColor XPConfig
c
, eventBuffer :: [(EventMask, String, Event)]
eventBuffer = []
, inputBuffer :: String
inputBuffer = String
""
, currentCompletions :: Maybe [String]
currentCompletions = forall a. Maybe a
Nothing
}
currentXPMode :: XPState -> XPType
currentXPMode :: XPState -> XPType
currentXPMode XPState
st = case XPState -> XPOperationMode
operationMode XPState
st of
XPMultipleModes Stack XPType
modes -> forall a. Stack a -> a
W.focus Stack XPType
modes
XPSingleMode ComplFunction
_ XPType
xptype -> XPType
xptype
setNextMode :: XPState -> XPState
setNextMode :: XPState -> XPState
setNextMode XPState
st = case XPState -> XPOperationMode
operationMode XPState
st of
XPMultipleModes Stack XPType
modes -> case forall a. Stack a -> [a]
W.down Stack XPType
modes of
[] -> XPState
st
(XPType
m:[XPType]
ms) -> let
currentMode :: XPType
currentMode = forall a. Stack a -> a
W.focus Stack XPType
modes
in XPState
st { operationMode :: XPOperationMode
operationMode = Stack XPType -> XPOperationMode
XPMultipleModes W.Stack { up :: [XPType]
W.up = [], focus :: XPType
W.focus = XPType
m, down :: [XPType]
W.down = [XPType]
ms forall a. [a] -> [a] -> [a]
++ [XPType
currentMode]}}
XPOperationMode
_ -> XPState
st
highlightedItem :: XPState -> [String] -> Maybe String
highlightedItem :: XPState -> [String] -> Maybe String
highlightedItem XPState
st' [String]
completions = case XPState -> Maybe ComplWindowDim
complWinDim XPState
st' of
Maybe ComplWindowDim
Nothing -> forall a. Maybe a
Nothing
Just ComplWindowDim
winDim ->
let
ComplWindowDim{ [Position]
cwCols :: ComplWindowDim -> [Position]
cwCols :: [Position]
cwCols, [Position]
cwRows :: ComplWindowDim -> [Position]
cwRows :: [Position]
cwRows } = ComplWindowDim
winDim
complMatrix :: [[String]]
complMatrix = forall a. Int -> [a] -> [[a]]
chunksOf (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Position]
cwRows) (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Position]
cwCols forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [Position]
cwRows) [String]
completions)
(Int
col_index,Int
row_index) = XPState -> (Int, Int)
complIndex XPState
st'
in case [String]
completions of
[] -> forall a. Maybe a
Nothing
[String]
_ -> [[String]]
complMatrix forall a. [a] -> Int -> Maybe a
!? Int
col_index forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. [a] -> Int -> Maybe a
!? Int
row_index)
selectedCompletion :: XPState -> String
selectedCompletion :: XPState -> String
selectedCompletion XPState
st
| XPConfig -> Bool
alwaysHighlight (XPState -> XPConfig
config XPState
st) = forall a. a -> Maybe a -> a
fromMaybe (XPState -> String
command XPState
st) forall a b. (a -> b) -> a -> b
$ XPState -> Maybe String
highlightedCompl XPState
st
| Bool
otherwise = XPState -> String
command XPState
st
command :: XPState -> String
command :: XPState -> String
command = forall a. Stack a -> a
W.focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState -> Stack String
commandHistory
setCommand :: String -> XPState -> XPState
setCommand :: String -> XPState -> XPState
setCommand String
xs XPState
s = XPState
s { commandHistory :: Stack String
commandHistory = (XPState -> Stack String
commandHistory XPState
s) { focus :: String
W.focus = String
xs }}
setInput :: String -> XP ()
setInput :: String -> XP ()
setInput = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> XPState -> XPState
setCommand
getInput :: XP String
getInput :: XP String
getInput = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> String
command
getOffset :: XP Int
getOffset :: XP Int
getOffset = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> Int
offset
defaultColor :: XPConfig -> XPColor
defaultColor :: XPConfig -> XPColor
defaultColor XPConfig
c = XPColor { bgNormal :: String
bgNormal = XPConfig -> String
bgColor XPConfig
c
, fgNormal :: String
fgNormal = XPConfig -> String
fgColor XPConfig
c
, bgHighlight :: String
bgHighlight = XPConfig -> String
bgHLight XPConfig
c
, fgHighlight :: String
fgHighlight = XPConfig -> String
fgHLight XPConfig
c
, border :: String
border = XPConfig -> String
borderColor XPConfig
c
}
modifyColor :: (XPColor -> XPColor) -> XP ()
modifyColor :: (XPColor -> XPColor) -> XP ()
modifyColor XPColor -> XPColor
c = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { color :: XPColor
color = XPColor -> XPColor
c forall a b. (a -> b) -> a -> b
$ XPState -> XPColor
color XPState
s }
setColor :: XPColor -> XP ()
setColor :: XPColor -> XP ()
setColor = (XPColor -> XPColor) -> XP ()
modifyColor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
resetColor :: XP ()
resetColor :: XP ()
resetColor = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (XPConfig -> XPColor
defaultColor forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState -> XPConfig
config) 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 String
bc XPColor
xpc = XPColor
xpc { border :: String
border = String
bc }
modifyPrompter :: ((String -> String) -> (String -> String)) -> XP ()
modifyPrompter :: ((String -> String) -> String -> String) -> XP ()
modifyPrompter (String -> String) -> String -> String
p = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { prompter :: String -> String
prompter = (String -> String) -> String -> String
p 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
resetPrompter :: XP ()
resetPrompter :: XP ()
resetPrompter = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (XPConfig -> String -> String
defaultPrompter forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState -> XPConfig
config) 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 Maybe [String]
cs = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { currentCompletions :: Maybe [String]
currentCompletions = Maybe [String]
cs }
getCurrentCompletions :: XP (Maybe [String])
getCurrentCompletions :: XP (Maybe [String])
getCurrentCompletions = 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 :: forall p a.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a)
mkXPromptWithReturn p
t XPConfig
conf ComplFunction
compl String -> X a
action = do
XPState
st' <- String -> XPConfig -> XPOperationMode -> X XPState
mkXPromptImplementation (forall t. XPrompt t => t -> String
showXPrompt p
t) XPConfig
conf (ComplFunction -> XPType -> XPOperationMode
XPSingleMode ComplFunction
compl (forall p. XPrompt p => p -> XPType
XPT p
t))
if XPState -> Bool
successful XPState
st'
then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> X a
action (XPState -> String
selectedCompletion XPState
st')
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt :: forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt p
t XPConfig
conf ComplFunction
compl String -> X ()
action = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall p a.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a)
mkXPromptWithReturn p
t XPConfig
conf ComplFunction
compl String -> X ()
action
mkXPromptWithModes :: [XPType] -> XPConfig -> X ()
mkXPromptWithModes :: [XPType] -> XPConfig -> X ()
mkXPromptWithModes [] XPConfig
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
mkXPromptWithModes (XPType
defaultMode : [XPType]
modes) XPConfig
conf = do
let modeStack :: Stack XPType
modeStack = W.Stack { focus :: XPType
W.focus = XPType
defaultMode
, up :: [XPType]
W.up = []
, down :: [XPType]
W.down = [XPType]
modes
}
om :: XPOperationMode
om = Stack XPType -> XPOperationMode
XPMultipleModes Stack XPType
modeStack
XPState
st' <- String -> XPConfig -> XPOperationMode -> X XPState
mkXPromptImplementation (forall t. XPrompt t => t -> String
showXPrompt XPType
defaultMode) XPConfig
conf { alwaysHighlight :: Bool
alwaysHighlight = Bool
True } XPOperationMode
om
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (XPState -> Bool
successful XPState
st') forall a b. (a -> b) -> a -> b
$
case XPState -> XPOperationMode
operationMode XPState
st' of
XPMultipleModes Stack XPType
ms -> let
action :: String -> String -> X ()
action = forall t. XPrompt t => t -> String -> String -> X ()
modeAction forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> a
W.focus Stack XPType
ms
in String -> String -> X ()
action (XPState -> String
command XPState
st') forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe String
"" (XPState -> Maybe String
highlightedCompl XPState
st')
XPOperationMode
_ -> forall a. HasCallStack => String -> a
error String
"The impossible occurred: This prompt runs with multiple modes but they could not be found."
mkXPromptImplementation :: String -> XPConfig -> XPOperationMode -> X XPState
mkXPromptImplementation :: String -> XPConfig -> XPOperationMode -> X XPState
mkXPromptImplementation String
historyKey XPConfig
conf XPOperationMode
om = do
XConf { display :: XConf -> Display
display = Display
d, theRoot :: XConf -> EventMask
theRoot = EventMask
rw } <- forall r (m :: * -> *). MonadReader r m => m r
ask
Rectangle
s <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
KeyMask -> KeyMask
cleanMask <- X (KeyMask -> KeyMask)
cleanKeyMask
String
cachedir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. Directories' a -> a
cacheDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Directories
directories)
Map String [String]
hist <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ XPConfig -> String -> IO (Map String [String])
readHistory XPConfig
conf String
cachedir
XMonadFont
fs <- String -> X XMonadFont
initXMF (XPConfig -> String
font XPConfig
conf)
let width :: Dimension
width = Rectangle -> XPPosition -> Dimension
getWinWidth Rectangle
s (XPConfig -> XPPosition
position XPConfig
conf)
XPState
st' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(Display
-> EventMask -> XPConfig -> Rectangle -> Dimension -> IO EventMask
createPromptWin Display
d EventMask
rw XPConfig
conf Rectangle
s Dimension
width)
(Display -> EventMask -> IO ()
destroyWindow Display
d)
(\EventMask
w ->
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(Display -> EventMask -> IO GC
createGC Display
d EventMask
w)
(Display -> GC -> IO ()
freeGC Display
d)
(\GC
gc -> do
Display -> EventMask -> EventMask -> IO ()
selectInput Display
d EventMask
w forall a b. (a -> b) -> a -> b
$ EventMask
exposureMask forall a. Bits a => a -> a -> a
.|. EventMask
keyPressMask
Display -> GC -> Bool -> IO ()
setGraphicsExposures Display
d GC
gc Bool
False
let hs :: [String]
hs = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
historyKey Map String [String]
hist
st :: XPState
st = Display
-> EventMask
-> EventMask
-> Rectangle
-> XPOperationMode
-> GC
-> XMonadFont
-> [String]
-> XPConfig
-> (KeyMask -> KeyMask)
-> Dimension
-> XPState
initState Display
d EventMask
rw EventMask
w Rectangle
s XPOperationMode
om GC
gc XMonadFont
fs [String]
hs XPConfig
conf KeyMask -> KeyMask
cleanMask Dimension
width
XPState -> IO XPState
runXP XPState
st))
XMonadFont -> X ()
releaseXMF XMonadFont
fs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (XPState -> Bool
successful XPState
st') forall a b. (a -> b) -> a -> b
$ do
let prune :: [a] -> [a]
prune = forall a. Int -> [a] -> [a]
take (XPConfig -> Int
historySize XPConfig
conf)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ XPConfig -> String -> Map String [String] -> IO ()
writeHistory XPConfig
conf String
cachedir forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith
(\[String]
xs [String]
ys -> forall {a}. [a] -> [a]
prune forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPConfig -> [String] -> [String]
historyFilter XPConfig
conf forall a b. (a -> b) -> a -> b
$ [String]
xs forall a. [a] -> [a] -> [a]
++ [String]
ys)
String
historyKey
(forall {a}. [a] -> [a]
prune forall a b. (a -> b) -> a -> b
$ XPConfig -> [String] -> [String]
historyFilter XPConfig
conf [XPState -> String
selectedCompletion XPState
st'])
Map String [String]
hist
forall (m :: * -> *) a. Monad m => a -> m a
return XPState
st'
where
getWinWidth :: Rectangle -> XPPosition -> Dimension
getWinWidth :: Rectangle -> XPPosition -> Dimension
getWinWidth Rectangle
scr = \case
CenteredAt{ Rational
xpWidth :: Rational
xpWidth :: XPPosition -> Rational
xpWidth } -> forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
scr) forall a. Num a => a -> a -> a
* Rational
xpWidth
XPPosition
_ -> Rectangle -> Dimension
rect_width Rectangle
scr
utf8Decode :: String -> String
utf8Decode :: String -> String
utf8Decode String
str
| String -> Bool
isUTF8Encoded String
str = String -> String
decodeString String
str
| Bool
otherwise = String
str
runXP :: XPState -> IO XPState
runXP :: XPState -> IO XPState
runXP XPState
st = do
let d :: Display
d = XPState -> Display
dpy XPState
st
w :: EventMask
w = XPState -> EventMask
win XPState
st
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(Display
-> EventMask -> Bool -> CInt -> CInt -> EventMask -> IO CInt
grabKeyboard Display
d EventMask
w Bool
True CInt
grabModeAsync CInt
grabModeAsync EventMask
currentTime)
(\CInt
_ -> Display -> EventMask -> IO ()
ungrabKeyboard Display
d EventMask
currentTime)
(\CInt
status ->
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT
(forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
status forall a. Eq a => a -> a -> Bool
== CInt
grabSuccess) forall a b. (a -> b) -> a -> b
$ do
Bool
ah <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (XPConfig -> Bool
alwaysHighlight forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState -> XPConfig
config)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ah forall a b. (a -> b) -> a -> b
$ do
Maybe String
compl <- forall a. [a] -> Maybe a
listToMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XP [String]
getCompletions
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall a b. (a -> b) -> a -> b
$ \XPState
xpst -> XPState
xpst{ highlightedCompl :: Maybe String
highlightedCompl = Maybe String
compl }
XP ()
updateWindows
(KeyStroke -> Event -> XP ()) -> XP Bool -> XP ()
eventLoop KeyStroke -> Event -> XP ()
handleMain XP Bool
evDefaultStop)
XPState
st
forall a b. IO a -> IO b -> IO a
`finally` (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Display -> EventMask -> IO ()
destroyWindow Display
d) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IORef a -> IO a
readIORef (XPState -> IORef (Maybe EventMask)
complWin XPState
st))
forall a b. IO a -> IO b -> IO a
`finally` Display -> Bool -> IO ()
sync Display
d Bool
False)
type KeyStroke = (KeySym, String)
isModifier :: KeyStroke -> Bool
isModifier :: KeyStroke -> Bool
isModifier (EventMask
_, String
keyString) = forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
keyString
eventLoop :: (KeyStroke -> Event -> XP ())
-> XP Bool
-> XP ()
eventLoop :: (KeyStroke -> Event -> XP ()) -> XP Bool -> XP ()
eventLoop KeyStroke -> Event -> XP ()
handle XP Bool
stopAction = do
[(EventMask, String, Event)]
b <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> [(EventMask, String, Event)]
eventBuffer
(EventMask
keysym,String
keystr,Event
event) <- case [(EventMask, String, Event)]
b of
[] -> do
Display
d <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> Display
dpy
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
Display -> EventMask -> XEventPtr -> IO ()
maskEvent Display
d (EventMask
exposureMask forall a. Bits a => a -> a -> a
.|. EventMask
keyPressMask forall a. Bits a => a -> a -> a
.|. EventMask
buttonPressMask) XEventPtr
e
Event
ev <- XEventPtr -> IO Event
getEvent XEventPtr
e
if Event -> Dimension
ev_event_type Event
ev forall a. Eq a => a -> a -> Bool
== Dimension
keyPress
then do (Maybe EventMask
_, String
s) <- XKeyEventPtr -> IO (Maybe EventMask, String)
lookupString forall a b. (a -> b) -> a -> b
$ XEventPtr -> XKeyEventPtr
asKeyEvent XEventPtr
e
EventMask
ks <- Display -> KeyCode -> CInt -> IO EventMask
keycodeToKeysym Display
d (Event -> KeyCode
ev_keycode Event
ev) CInt
0
forall (m :: * -> *) a. Monad m => a -> m a
return (EventMask
ks, String
s, Event
ev)
else forall (m :: * -> *) a. Monad m => a -> m a
return (EventMask
noSymbol, String
"", Event
ev)
((EventMask, String, Event)
l : [(EventMask, String, Event)]
ls) -> do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { eventBuffer :: [(EventMask, String, Event)]
eventBuffer = [(EventMask, String, Event)]
ls }
forall (m :: * -> *) a. Monad m => a -> m a
return (EventMask, String, Event)
l
KeyStroke -> Event -> XP ()
handle (EventMask
keysym,String
keystr) Event
event
XP Bool
stopAction forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
stop -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
stop ((KeyStroke -> Event -> XP ()) -> XP Bool -> XP ()
eventLoop KeyStroke -> Event -> XP ()
handle XP Bool
stopAction)
evDefaultStop :: XP Bool
evDefaultStop :: XP Bool
evDefaultStop = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Bool -> Bool -> Bool
(||) forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState -> Bool
modeDone) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> Bool
done
handleOther :: KeyStroke -> Event -> XP ()
handleOther :: KeyStroke -> Event -> XP ()
handleOther KeyStroke
_ ExposeEvent{ev_window :: Event -> EventMask
ev_window = EventMask
w} = do
XPState
st <- forall s (m :: * -> *). MonadState s m => m s
get
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (XPState -> EventMask
win XPState
st forall a. Eq a => a -> a -> Bool
== EventMask
w) XP ()
updateWindows
handleOther KeyStroke
_ ButtonEvent{ev_event_type :: Event -> Dimension
ev_event_type = Dimension
t} = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Dimension
t forall a. Eq a => a -> a -> Bool
== Dimension
buttonPress) forall a b. (a -> b) -> a -> b
$ do
Display
d <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> Display
dpy
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> CInt -> EventMask -> IO ()
allowEvents Display
d CInt
replayPointer EventMask
currentTime
handleOther KeyStroke
_ Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleMain :: KeyStroke -> Event -> XP ()
handleMain :: KeyStroke -> Event -> XP ()
handleMain stroke :: KeyStroke
stroke@(EventMask
keysym, String
keystr) = \case
KeyEvent{ev_event_type :: Event -> Dimension
ev_event_type = Dimension
t, ev_state :: Event -> KeyMask
ev_state = KeyMask
m} -> do
((KeyMask, EventMask)
prevCompKey, ((KeyMask, EventMask)
compKey, EventMask
modeKey)) <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$
(XPConfig -> (KeyMask, EventMask)
prevCompletionKey forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& XPConfig -> (KeyMask, EventMask)
completionKey forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& XPConfig -> EventMask
changeModeKey) forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState -> XPConfig
config
KeyMask
keymask <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> KeyMask -> KeyMask
cleanMask forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMask
m
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Dimension
t forall a. Eq a => a -> a -> Bool
== Dimension
keyPress) forall a b. (a -> b) -> a -> b
$ if
| (KeyMask
keymask, EventMask
keysym) forall a. Eq a => a -> a -> Bool
== (KeyMask, EventMask)
compKey ->
XP (Maybe [String])
getCurrentCompletions forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction1D -> Maybe [String] -> XP ()
handleCompletionMain Direction1D
Next
| (KeyMask
keymask, EventMask
keysym) forall a. Eq a => a -> a -> Bool
== (KeyMask, EventMask)
prevCompKey ->
XP (Maybe [String])
getCurrentCompletions forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction1D -> Maybe [String] -> XP ()
handleCompletionMain Direction1D
Prev
| Bool
otherwise -> do
Map (KeyMask, EventMask) (XP ())
keymap <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (XPConfig -> Map (KeyMask, EventMask) (XP ())
promptKeymap forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState -> XPConfig
config)
let mbAction :: Maybe (XP ())
mbAction = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (KeyMask
keymask, EventMask
keysym) Map (KeyMask, EventMask) (XP ())
keymap
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (KeyStroke -> Bool
isModifier KeyStroke
stroke Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe (XP ())
mbAction) forall a b. (a -> b) -> a -> b
$ do
Maybe [String] -> XP ()
setCurrentCompletions forall a. Maybe a
Nothing
if EventMask
keysym forall a. Eq a => a -> a -> Bool
== EventMask
modeKey
then forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify XPState -> XPState
setNextMode forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XP ()
updateWindows
else KeyMask -> Maybe (XP ()) -> XP ()
handleInput KeyMask
keymask Maybe (XP ())
mbAction
Event
event -> KeyStroke -> Event -> XP ()
handleOther KeyStroke
stroke Event
event
where
handleInput :: KeyMask -> Maybe (XP ()) -> XP ()
handleInput :: KeyMask -> Maybe (XP ()) -> XP ()
handleInput KeyMask
keymask = \case
Just XP ()
action -> XP ()
action forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XP ()
updateWindows
Maybe (XP ())
Nothing -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KeyMask
keymask forall a. Bits a => a -> a -> a
.&. KeyMask
controlMask forall a. Eq a => a -> a -> Bool
== KeyMask
0) forall a b. (a -> b) -> a -> b
$ do
String -> XP ()
insertString forall a b. (a -> b) -> a -> b
$ String -> String
utf8Decode String
keystr
XP ()
updateWindows
XP ()
updateHighlightedCompl
Bool
complete <- XP Bool
tryAutoComplete
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
complete XP ()
acceptSelection
handleCompletionMain :: Direction1D -> Maybe [String] -> XP ()
handleCompletionMain :: Direction1D -> Maybe [String] -> XP ()
handleCompletionMain Direction1D
dir Maybe [String]
compls = case Maybe [String]
compls of
Just [String]
cs -> Direction1D -> [String] -> XP ()
handleCompletion Direction1D
dir [String]
cs
Maybe [String]
Nothing -> do
[String]
cs <- XP [String]
getCompletions
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
cs forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { showComplWin :: Bool
showComplWin = Bool
True }
Maybe [String] -> XP ()
setCurrentCompletions forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [String]
cs
Direction1D -> [String] -> XP ()
handleCompletion Direction1D
dir [String]
cs
handleCompletion :: Direction1D -> [String] -> XP ()
handleCompletion :: Direction1D -> [String] -> XP ()
handleCompletion Direction1D
dir [String]
cs = do
Bool
alwaysHlight <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ XPConfig -> Bool
alwaysHighlight forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState -> XPConfig
config
XPState
st <- forall s (m :: * -> *). MonadState s m => m s
get
let updateWins :: [String] -> XP ()
updateWins = XP () -> [String] -> XP ()
redrawWindows (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
updateState :: [String] -> XP ()
updateState [String]
l = if Bool
alwaysHlight
then String -> [String] -> XPState -> XP ()
hlComplete (String -> String
getLastWord forall a b. (a -> b) -> a -> b
$ XPState -> String
command XPState
st) [String]
l XPState
st
else [String] -> XPState -> XP ()
simpleComplete [String]
l XPState
st
case [String]
cs of
[] -> XP ()
updateWindows
[String
x] -> do [String] -> XP ()
updateState [String
x]
[String]
cs' <- XP [String]
getCompletions
[String] -> XP ()
updateWins [String]
cs'
Maybe [String] -> XP ()
setCurrentCompletions forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [String]
cs'
[String]
l -> [String] -> XP ()
updateState [String]
l 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 [String]
l XPState
st = do
let newCommand :: String
newCommand = forall t. XPrompt t => t -> String -> [String] -> String
nextCompletion (XPState -> XPType
currentXPMode XPState
st) (XPState -> String
command XPState
st) [String]
l
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> String -> XPState -> XPState
setCommand String
newCommand forall a b. (a -> b) -> a -> b
$
XPState
s { offset :: Int
offset = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
newCommand
, highlightedCompl :: Maybe String
highlightedCompl = forall a. a -> Maybe a
Just String
newCommand
}
hlComplete :: String -> [String] -> XPState -> XP ()
hlComplete :: String -> [String] -> XPState -> XP ()
hlComplete String
prevCompl [String]
l XPState
st
|
Bool
isSuffixOfCmd Bool -> Bool -> Bool
&& Bool
isProperSuffixOfLast = String -> XP ()
replaceCompletion String
prevCompl
|
Just (String
ch :| []) <- forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [String]
cs =
if XPState -> String
command XPState
st forall a. Eq a => a -> a -> Bool
== String
hlCompl
then forall s (m :: * -> *). MonadState s m => s -> m ()
put XPState
st
else String -> XP ()
replaceCompletion String
ch
| Bool
isSuffixOfCmd =
String -> [String] -> XPState -> XP ()
hlComplete String
hlCompl [String]
l forall a b. (a -> b) -> a -> b
$ XPState
st{ complIndex :: (Int, Int)
complIndex = (Int, Int)
complIndex'
, highlightedCompl :: Maybe String
highlightedCompl = Maybe String
nextHlCompl
}
| Bool
otherwise = String -> XP ()
replaceCompletion String
prevCompl
where
String
hlCompl :: String = forall a. a -> Maybe a -> a
fromMaybe (XPState -> String
command XPState
st) forall a b. (a -> b) -> a -> b
$ XPState -> [String] -> Maybe String
highlightedItem XPState
st [String]
l
(Int, Int)
complIndex' :: (Int, Int) = Direction1D -> XPState -> (Int, Int)
computeComplIndex Direction1D
dir XPState
st
Maybe String
nextHlCompl :: Maybe String = XPState -> [String] -> Maybe String
highlightedItem XPState
st{ complIndex :: (Int, Int)
complIndex = (Int, Int)
complIndex' } [String]
cs
Bool
isSuffixOfCmd :: Bool = String
hlCompl forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` XPState -> String
command XPState
st
Bool
isProperSuffixOfLast :: Bool = String
hlCompl forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
prevCompl
Bool -> Bool -> Bool
&& Bool -> Bool
not (String
prevCompl forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
hlCompl)
String -> XP ()
replaceCompletion :: String -> XP () = \String
str -> do
forall s (m :: * -> *). MonadState s m => s -> m ()
put XPState
st
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
str) forall a b. (a -> b) -> a -> b
$ Direction1D -> XP ()
killWord Direction1D
Prev
String -> XP ()
insertString' String
hlCompl
XP ()
endOfLine
promptSubmap :: XP ()
-> M.Map (KeyMask, KeySym) (XP ())
-> XP ()
promptSubmap :: XP () -> Map (KeyMask, EventMask) (XP ()) -> XP ()
promptSubmap XP ()
defaultAction Map (KeyMask, EventMask) (XP ())
keymap = do
Bool
md <- 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, EventMask) (XP ()) -> KeyStroke -> Event -> XP ()
handleSubmap XP ()
defaultAction Map (KeyMask, EventMask) (XP ())
keymap) XP Bool
evDefaultStop
Bool -> XP ()
setModeDone Bool
md
handleSubmap :: XP ()
-> M.Map (KeyMask, KeySym) (XP ())
-> KeyStroke
-> Event
-> XP ()
handleSubmap :: XP ()
-> Map (KeyMask, EventMask) (XP ()) -> KeyStroke -> Event -> XP ()
handleSubmap XP ()
defaultAction Map (KeyMask, EventMask) (XP ())
keymap KeyStroke
stroke KeyEvent{ev_event_type :: Event -> Dimension
ev_event_type = Dimension
t, ev_state :: Event -> KeyMask
ev_state = KeyMask
m} = do
KeyMask
keymask <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> KeyMask -> KeyMask
cleanMask forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMask
m
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Dimension
t forall a. Eq a => a -> a -> Bool
== Dimension
keyPress) forall a b. (a -> b) -> a -> b
$ XP ()
-> Map (KeyMask, EventMask) (XP ())
-> KeyMask
-> KeyStroke
-> XP ()
handleInputSubmap XP ()
defaultAction Map (KeyMask, EventMask) (XP ())
keymap KeyMask
keymask KeyStroke
stroke
handleSubmap XP ()
_ Map (KeyMask, EventMask) (XP ())
_ KeyStroke
stroke Event
event = KeyStroke -> Event -> XP ()
handleOther KeyStroke
stroke Event
event
handleInputSubmap :: XP ()
-> M.Map (KeyMask, KeySym) (XP ())
-> KeyMask
-> KeyStroke
-> XP ()
handleInputSubmap :: XP ()
-> Map (KeyMask, EventMask) (XP ())
-> KeyMask
-> KeyStroke
-> XP ()
handleInputSubmap XP ()
defaultAction Map (KeyMask, EventMask) (XP ())
keymap KeyMask
keymask stroke :: KeyStroke
stroke@(EventMask
keysym, String
_) =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (KeyMask
keymask,EventMask
keysym) Map (KeyMask, EventMask) (XP ())
keymap of
Just XP ()
action -> XP ()
action forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XP ()
updateWindows
Maybe (XP ())
Nothing -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (KeyStroke -> Bool
isModifier KeyStroke
stroke) forall a b. (a -> b) -> a -> b
$ XP ()
defaultAction 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 String -> String -> (Bool, Bool)
f = do
Bool
md <- 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> String
inputBuffer
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { inputBuffer :: String
inputBuffer = String
"" }
Bool -> XP ()
setModeDone Bool
md
forall (m :: * -> *) a. Monad m => a -> m a
return String
buff
handleBuffer :: (String -> String -> (Bool,Bool))
-> KeyStroke
-> Event
-> XP ()
handleBuffer :: (String -> String -> (Bool, Bool)) -> KeyStroke -> Event -> XP ()
handleBuffer String -> String -> (Bool, Bool)
f KeyStroke
stroke event :: Event
event@KeyEvent{ev_event_type :: Event -> Dimension
ev_event_type = Dimension
t, ev_state :: Event -> KeyMask
ev_state = KeyMask
m} = do
KeyMask
keymask <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> KeyMask -> KeyMask
cleanMask forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMask
m
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Dimension
t forall a. Eq a => a -> a -> Bool
== Dimension
keyPress) forall a b. (a -> b) -> a -> b
$ (String -> String -> (Bool, Bool))
-> KeyMask -> KeyStroke -> Event -> XP ()
handleInputBuffer String -> String -> (Bool, Bool)
f KeyMask
keymask KeyStroke
stroke Event
event
handleBuffer String -> String -> (Bool, Bool)
_ KeyStroke
stroke Event
event = KeyStroke -> Event -> XP ()
handleOther KeyStroke
stroke Event
event
handleInputBuffer :: (String -> String -> (Bool,Bool))
-> KeyMask
-> KeyStroke
-> Event
-> XP ()
handleInputBuffer :: (String -> String -> (Bool, Bool))
-> KeyMask -> KeyStroke -> Event -> XP ()
handleInputBuffer String -> String -> (Bool, Bool)
f KeyMask
keymask stroke :: KeyStroke
stroke@(EventMask
keysym, String
keystr) Event
event =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (KeyStroke -> Bool
isModifier KeyStroke
stroke Bool -> Bool -> Bool
|| KeyMask
keymask forall a. Bits a => a -> a -> a
.&. KeyMask
controlMask forall a. Eq a => a -> a -> Bool
/= KeyMask
0) forall a b. (a -> b) -> a -> b
$ do
([(EventMask, String, Event)]
evB,String
inB) <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (XPState -> [(EventMask, String, Event)]
eventBuffer forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& XPState -> String
inputBuffer)
let keystr' :: String
keystr' = String -> String
utf8Decode String
keystr
let (Bool
cont,Bool
keep) = String -> String -> (Bool, Bool)
f String
inB String
keystr'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
keep forall a b. (a -> b) -> a -> b
$
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { inputBuffer :: String
inputBuffer = String
inB forall a. [a] -> [a] -> [a]
++ String
keystr' }
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
cont forall a b. (a -> b) -> a -> b
$
Bool -> XP ()
setModeDone Bool
True
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
cont Bool -> Bool -> Bool
|| Bool
keep) forall a b. (a -> b) -> a -> b
$
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { eventBuffer :: [(EventMask, String, Event)]
eventBuffer = (EventMask
keysym,String
keystr,Event
event) forall a. a -> [a] -> [a]
: [(EventMask, String, Event)]
evB }
bufferOne :: String -> String -> (Bool,Bool)
bufferOne :: String -> String -> (Bool, Bool)
bufferOne String
xs String
x = (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x,Bool
True)
computeComplIndex :: Direction1D -> XPState -> (Int, Int)
computeComplIndex :: Direction1D -> XPState -> (Int, Int)
computeComplIndex Direction1D
dir XPState
st = case XPState -> Maybe ComplWindowDim
complWinDim XPState
st of
Maybe ComplWindowDim
Nothing -> (Int
0, Int
0)
Just ComplWindowDim{ [Position]
cwCols :: [Position]
cwCols :: ComplWindowDim -> [Position]
cwCols, [Position]
cwRows :: [Position]
cwRows :: ComplWindowDim -> [Position]
cwRows } ->
if Int
rowm forall a. Eq a => a -> a -> Bool
== Int
currentrow forall a. Num a => a -> a -> a
+ Int
direction
then (Int
currentcol, Int
rowm)
else (Int
colm, Int
rowm)
where
(Int
currentcol, Int
currentrow) = XPState -> (Int, Int)
complIndex XPState
st
(Int
colm, Int
rowm) =
( (Int
currentcol forall a. Num a => a -> a -> a
+ Int
direction) forall a. Integral a => a -> a -> a
`mod` forall (t :: * -> *) a. Foldable t => t a -> Int
length [Position]
cwCols
, (Int
currentrow forall a. Num a => a -> a -> a
+ Int
direction) forall a. Integral a => a -> a -> a
`mod` forall (t :: * -> *) a. Foldable t => t a -> Int
length [Position]
cwRows
)
direction :: Int
direction = case Direction1D
dir of
Direction1D
Next -> Int
1
Direction1D
Prev -> -Int
1
tryAutoComplete :: XP Bool
tryAutoComplete :: XP Bool
tryAutoComplete = do
Maybe Int
ac <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (XPConfig -> Maybe Int
autoComplete forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState -> XPConfig
config)
case Maybe Int
ac of
Just Int
d -> do [String]
cs <- XP [String]
getCompletions
case [String]
cs of
[String
c] -> String -> Int -> XP Bool
runCompleted String
c Int
d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
[String]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
where runCompleted :: String -> Int -> XP Bool
runCompleted String
cmd Int
delay = do
XPState
st <- forall s (m :: * -> *). MonadState s m => m s
get
let new_command :: String
new_command = forall t. XPrompt t => t -> String -> [String] -> String
nextCompletion (XPState -> XPType
currentXPMode XPState
st) (XPState -> String
command XPState
st) [String
cmd]
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ String -> XPState -> XPState
setCommand String
"autocompleting..."
XP ()
updateWindows
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
delay
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ String -> XPState -> XPState
setCommand String
new_command
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
defaultXPKeymap :: Map (KeyMask, EventMask) (XP ())
defaultXPKeymap = (Char -> Bool) -> Map (KeyMask, EventMask) (XP ())
defaultXPKeymap' Char -> Bool
isSpace
defaultXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())
defaultXPKeymap' :: (Char -> Bool) -> Map (KeyMask, EventMask) (XP ())
defaultXPKeymap' Char -> Bool
p = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ (,) KeyMask
controlMask)
[ (EventMask
xK_u, XP ()
killBefore)
, (EventMask
xK_k, XP ()
killAfter)
, (EventMask
xK_a, XP ()
startOfLine)
, (EventMask
xK_e, XP ()
endOfLine)
, (EventMask
xK_y, XP ()
pasteString)
, (EventMask
xK_Right, (Char -> Bool) -> Direction1D -> XP ()
moveWord' Char -> Bool
p Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Direction1D -> XP ()
moveCursor Direction1D
Next)
, (EventMask
xK_Left, Direction1D -> XP ()
moveCursor Direction1D
Prev forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Direction1D -> XP ()
moveWord' Char -> Bool
p Direction1D
Prev)
, (EventMask
xK_Delete, (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
p Direction1D
Next)
, (EventMask
xK_BackSpace, (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
p Direction1D
Prev)
, (EventMask
xK_w, (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
p Direction1D
Prev)
, (EventMask
xK_g, XP ()
quit)
, (EventMask
xK_bracketleft, XP ()
quit)
] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ (,) KeyMask
0)
[ (EventMask
xK_Return, XP ()
acceptSelection)
, (EventMask
xK_KP_Enter, XP ()
acceptSelection)
, (EventMask
xK_BackSpace, Direction1D -> XP ()
deleteString Direction1D
Prev)
, (EventMask
xK_Delete, Direction1D -> XP ()
deleteString Direction1D
Next)
, (EventMask
xK_Left, Direction1D -> XP ()
moveCursor Direction1D
Prev)
, (EventMask
xK_Right, Direction1D -> XP ()
moveCursor Direction1D
Next)
, (EventMask
xK_Home, XP ()
startOfLine)
, (EventMask
xK_End, XP ()
endOfLine)
, (EventMask
xK_Down, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusUp')
, (EventMask
xK_Up, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusDown')
, (EventMask
xK_Escape, XP ()
quit)
]
emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
emacsLikeXPKeymap :: Map (KeyMask, EventMask) (XP ())
emacsLikeXPKeymap = (Char -> Bool) -> Map (KeyMask, EventMask) (XP ())
emacsLikeXPKeymap' Char -> Bool
isSpace
emacsLikeXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())
emacsLikeXPKeymap' :: (Char -> Bool) -> Map (KeyMask, EventMask) (XP ())
emacsLikeXPKeymap' Char -> Bool
p = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ (,) KeyMask
controlMask)
[ (EventMask
xK_z, XP ()
killBefore)
, (EventMask
xK_k, XP ()
killAfter)
, (EventMask
xK_a, XP ()
startOfLine)
, (EventMask
xK_e, XP ()
endOfLine)
, (EventMask
xK_d, Direction1D -> XP ()
deleteString Direction1D
Next)
, (EventMask
xK_b, Direction1D -> XP ()
moveCursor Direction1D
Prev)
, (EventMask
xK_f, Direction1D -> XP ()
moveCursor Direction1D
Next)
, (EventMask
xK_BackSpace, (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
p Direction1D
Prev)
, (EventMask
xK_y, XP ()
pasteString)
, (EventMask
xK_g, XP ()
quit)
, (EventMask
xK_bracketleft, XP ()
quit)
, (EventMask
xK_t, XP ()
transposeChars)
, (EventMask
xK_m, XP ()
acceptSelection)
] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ (,) KeyMask
mod1Mask)
[ (EventMask
xK_BackSpace, (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
p Direction1D
Prev)
, (EventMask
xK_f, (Char -> Bool) -> Direction1D -> XP ()
moveWord' Char -> Bool
p Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Direction1D -> XP ()
moveCursor Direction1D
Next)
, (EventMask
xK_b, Direction1D -> XP ()
moveCursor Direction1D
Prev forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Direction1D -> XP ()
moveWord' Char -> Bool
p Direction1D
Prev)
, (EventMask
xK_d, (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
p Direction1D
Next)
, (EventMask
xK_n, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusUp')
, (EventMask
xK_p, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusDown')
]
forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ (,) KeyMask
0)
[ (EventMask
xK_Return, XP ()
acceptSelection)
, (EventMask
xK_KP_Enter, XP ()
acceptSelection)
, (EventMask
xK_BackSpace, Direction1D -> XP ()
deleteString Direction1D
Prev)
, (EventMask
xK_Delete, Direction1D -> XP ()
deleteString Direction1D
Next)
, (EventMask
xK_Left, Direction1D -> XP ()
moveCursor Direction1D
Prev)
, (EventMask
xK_Right, Direction1D -> XP ()
moveCursor Direction1D
Next)
, (EventMask
xK_Home, XP ()
startOfLine)
, (EventMask
xK_End, XP ()
endOfLine)
, (EventMask
xK_Down, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusUp')
, (EventMask
xK_Up, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusDown')
, (EventMask
xK_Escape, XP ()
quit)
]
vimLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ())
vimLikeXPKeymap :: Map (KeyMask, EventMask) (XP ())
vimLikeXPKeymap = (XPColor -> XPColor)
-> (String -> String)
-> (String -> String)
-> (Char -> Bool)
-> Map (KeyMask, EventMask) (XP ())
vimLikeXPKeymap' (String -> XPColor -> XPColor
setBorderColor String
"grey22") forall a. a -> a
id 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, EventMask) (XP ())
vimLikeXPKeymap' XPColor -> XPColor
fromColor String -> String
promptF String -> String
pasteFilter Char -> Bool
notWord = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ (,) KeyMask
controlMask)
[ (EventMask
xK_m, XP ()
acceptSelection)
] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ (,) KeyMask
0)
[ (EventMask
xK_Return, XP ()
acceptSelection)
, (EventMask
xK_KP_Enter, XP ()
acceptSelection)
, (EventMask
xK_BackSpace, Direction1D -> XP ()
deleteString Direction1D
Prev)
, (EventMask
xK_Delete, Direction1D -> XP ()
deleteString Direction1D
Next)
, (EventMask
xK_Left, Direction1D -> XP ()
moveCursor Direction1D
Prev)
, (EventMask
xK_Right, Direction1D -> XP ()
moveCursor Direction1D
Next)
, (EventMask
xK_Home, XP ()
startOfLine)
, (EventMask
xK_End, XP ()
endOfLine)
, (EventMask
xK_Down, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusUp')
, (EventMask
xK_Up, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusDown')
, (EventMask
xK_Escape, Direction1D -> XP ()
moveCursor Direction1D
Prev
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (XPColor -> XPColor) -> XP ()
modifyColor XPColor -> XPColor
fromColor
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> String) -> XP ()
setPrompter String -> String
promptF
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XP () -> Map (KeyMask, EventMask) (XP ()) -> XP ()
promptSubmap (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Map (KeyMask, EventMask) (XP ())
normalVimXPKeymap
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XP ()
resetColor
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XP ()
resetPrompter
)
] where
normalVimXPKeymap :: Map (KeyMask, EventMask) (XP ())
normalVimXPKeymap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ (,) KeyMask
0)
[ (EventMask
xK_i, Bool -> XP ()
setModeDone Bool
True)
, (EventMask
xK_a, Direction1D -> XP ()
moveCursor Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setModeDone Bool
True)
, (EventMask
xK_s, Direction1D -> XP ()
deleteString Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setModeDone Bool
True)
, (EventMask
xK_x, Direction1D -> XP ()
deleteString Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XP ()
clipCursor)
, (EventMask
xK_Delete, Direction1D -> XP ()
deleteString Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XP ()
clipCursor)
, (EventMask
xK_p, Direction1D -> XP ()
moveCursor Direction1D
Next
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> String) -> XP ()
pasteString' String -> String
pasteFilter
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Direction1D -> XP ()
moveCursor Direction1D
Prev
)
, (EventMask
xK_0, XP ()
startOfLine)
, (EventMask
xK_Escape, XP ()
quit)
, (EventMask
xK_Down, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusUp')
, (EventMask
xK_j, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusUp')
, (EventMask
xK_Up, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusDown')
, (EventMask
xK_k, (Stack String -> Stack String) -> XP ()
moveHistory forall a. Stack a -> Stack a
W.focusDown')
, (EventMask
xK_Right, Direction1D -> XP ()
moveCursorClip Direction1D
Next)
, (EventMask
xK_l, Direction1D -> XP ()
moveCursorClip Direction1D
Next)
, (EventMask
xK_h, Direction1D -> XP ()
moveCursorClip Direction1D
Prev)
, (EventMask
xK_Left, Direction1D -> XP ()
moveCursorClip Direction1D
Prev)
, (EventMask
xK_BackSpace, Direction1D -> XP ()
moveCursorClip Direction1D
Prev)
, (EventMask
xK_e, Direction1D -> XP ()
moveCursorClip Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Direction1D -> XP ()
moveWord' Char -> Bool
notWord Direction1D
Next)
, (EventMask
xK_b, Direction1D -> XP ()
moveCursorClip Direction1D
Prev forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Direction1D -> XP ()
moveWord' Char -> Bool
notWord Direction1D
Prev)
, (EventMask
xK_w, (Char -> Bool) -> Direction1D -> XP ()
moveWord' (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
notWord) Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Direction1D -> XP ()
moveCursorClip Direction1D
Next)
, (EventMask
xK_f, (String -> String -> (Bool, Bool)) -> XP String
promptBuffer String -> String -> (Bool, Bool)
bufferOne forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction1D -> String -> XP ()
toHeadChar Direction1D
Next)
, (EventMask
xK_d, XP () -> Map (KeyMask, EventMask) (XP ()) -> XP ()
promptSubmap (Bool -> XP ()
setModeDone Bool
True) Map (KeyMask, EventMask) (XP ())
deleteVimXPKeymap)
, (EventMask
xK_c, XP () -> Map (KeyMask, EventMask) (XP ()) -> XP ()
promptSubmap (Bool -> XP ()
setModeDone Bool
True) Map (KeyMask, EventMask) (XP ())
changeVimXPKeymap
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setModeDone Bool
True
)
, (EventMask
xK_Return, XP ()
acceptSelection)
, (EventMask
xK_KP_Enter, XP ()
acceptSelection)
] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ (,) KeyMask
shiftMask)
[ (EventMask
xK_dollar, XP ()
endOfLine forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Direction1D -> XP ()
moveCursor Direction1D
Prev)
, (EventMask
xK_D, XP ()
killAfter forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Direction1D -> XP ()
moveCursor Direction1D
Prev)
, (EventMask
xK_C, XP ()
killAfter forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setModeDone Bool
True)
, (EventMask
xK_P, (String -> String) -> XP ()
pasteString' String -> String
pasteFilter forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Direction1D -> XP ()
moveCursor Direction1D
Prev)
, (EventMask
xK_A, XP ()
endOfLine forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setModeDone Bool
True)
, (EventMask
xK_I, XP ()
startOfLine forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setModeDone Bool
True)
, (EventMask
xK_F, (String -> String -> (Bool, Bool)) -> XP String
promptBuffer String -> String -> (Bool, Bool)
bufferOne forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction1D -> String -> XP ()
toHeadChar Direction1D
Prev)
]
deleteVimXPKeymap :: Map (KeyMask, EventMask) (XP ())
deleteVimXPKeymap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (KeyMask
0 ,) (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setModeDone Bool
True))
[ (EventMask
xK_e, Direction1D -> XP ()
deleteString Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
notWord Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XP ()
clipCursor)
, (EventMask
xK_w, (Char -> Bool) -> Direction1D -> XP ()
killWord' (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
notWord) Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XP ()
clipCursor)
, (EventMask
xK_0, XP ()
killBefore)
, (EventMask
xK_b, (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
notWord Direction1D
Prev)
, (EventMask
xK_d, String -> XP ()
setInput String
"")
] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (KeyMask
shiftMask ,) (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setModeDone Bool
True))
[ (EventMask
xK_dollar, XP ()
killAfter forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Direction1D -> XP ()
moveCursor Direction1D
Prev)
]
changeVimXPKeymap :: Map (KeyMask, EventMask) (XP ())
changeVimXPKeymap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (KeyMask
0 ,) (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setModeDone Bool
True))
[ (EventMask
xK_e, Direction1D -> XP ()
deleteString Direction1D
Next forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
notWord Direction1D
Next)
, (EventMask
xK_0, XP ()
killBefore)
, (EventMask
xK_b, (Char -> Bool) -> Direction1D -> XP ()
killWord' Char -> Bool
notWord Direction1D
Prev)
, (EventMask
xK_c, String -> XP ()
setInput String
"")
, (EventMask
xK_w, (Char -> Bool) -> XP ()
changeWord Char -> Bool
notWord)
] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (KeyMask
shiftMask, ) (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setModeDone Bool
True))
[ (EventMask
xK_dollar, XP ()
killAfter)
]
setSuccess :: Bool -> XP ()
setSuccess :: Bool -> XP ()
setSuccess Bool
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { successful :: Bool
successful = Bool
b }
setDone :: Bool -> XP ()
setDone :: Bool -> XP ()
setDone Bool
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { done :: Bool
done = Bool
b }
setModeDone :: Bool -> XP ()
setModeDone :: Bool -> XP ()
setModeDone Bool
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { modeDone :: Bool
modeDone = Bool
b }
acceptSelection :: StateT XPState IO ()
acceptSelection :: XP ()
acceptSelection = Bool -> XP ()
setSuccess Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setDone Bool
True
quit :: XP ()
quit :: XP ()
quit = XP ()
flushString forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setSuccess Bool
False forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setDone Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> XP ()
setModeDone Bool
True
killBefore :: XP ()
killBefore :: XP ()
killBefore =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> String -> XPState -> XPState
setCommand (forall a. Int -> [a] -> [a]
drop (XPState -> Int
offset XPState
s) (XPState -> String
command XPState
s)) forall a b. (a -> b) -> a -> b
$ XPState
s { offset :: Int
offset = Int
0 }
killAfter :: XP ()
killAfter :: XP ()
killAfter =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> String -> XPState -> XPState
setCommand (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' Char -> Bool
p Direction1D
d = do
Int
o <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> Int
offset
String
c <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> String
command
let (String
f,String
ss) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
o String
c
delNextWord :: String -> String
delNextWord = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
p
delPrevWord :: String -> String
delPrevWord = forall {a}. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
delNextWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [a] -> [a]
reverse
(String
ncom,Int
noff) =
case Direction1D
d of
Direction1D
Next -> (String
f forall a. [a] -> [a] -> [a]
++ String -> String
delNextWord String
ss, Int
o)
Direction1D
Prev -> (String -> String
delPrevWord String
f forall a. [a] -> [a] -> [a]
++ String
ss, forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ String -> String
delPrevWord String
f)
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> String -> XPState -> XPState
setCommand String
ncom forall a b. (a -> b) -> a -> b
$ XPState
s { offset :: Int
offset = Int
noff}
changeWord :: (Char -> Bool) -> XP ()
changeWord :: (Char -> Bool) -> XP ()
changeWord Char -> Bool
p = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ String -> Int -> (Char -> Bool) -> XP ()
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XP String
getInput forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XP Int
getOffset forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Char -> Bool
p
where
f :: String -> Int -> (Char -> Bool) -> XP ()
f :: String -> Int -> (Char -> Bool) -> XP ()
f String
str Int
off Char -> Bool
_ | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str forall a. Ord a => a -> a -> Bool
<= Int
off Bool -> Bool -> Bool
||
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str = forall (m :: * -> *) a. Monad m => a -> m a
return ()
f String
str Int
off Char -> Bool
p'| Char -> Bool
p' forall a b. (a -> b) -> a -> b
$ String
str forall a. [a] -> Int -> a
!! Int
off = (Char -> Bool) -> Direction1D -> XP ()
killWord' (Bool -> Bool
not 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
transposeChars :: XP ()
transposeChars :: XP ()
transposeChars = do
Int
off <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> Int
offset
String
cmd <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> String
command
let (String
beforeCursor, String
afterCursor) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
off String
cmd
(String
ncom, Int
noff) = forall a. a -> Maybe a -> a
fromMaybe (String
cmd, Int
off) (forall a. [a] -> [a] -> Int -> Maybe ([a], Int)
go String
beforeCursor String
afterCursor Int
off)
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> String -> XPState -> XPState
setCommand String
ncom forall a b. (a -> b) -> a -> b
$ XPState
s{ offset :: Int
offset = Int
noff }
where
go :: [a] -> [a] -> Int -> Maybe ([a], Int)
go :: forall a. [a] -> [a] -> Int -> Maybe ([a], Int)
go (forall {a}. [a] -> [a]
reverse -> (a
b1 : a
b2 : [a]
bs)) [] Int
offset =
forall a. a -> Maybe a
Just (forall {a}. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ a
b2 forall a. a -> [a] -> [a]
: a
b1 forall a. a -> [a] -> [a]
: [a]
bs, Int
offset)
go (forall {a}. [a] -> [a]
reverse -> (a
b : [a]
bs)) (a
a : [a]
as) Int
offset =
forall a. a -> Maybe a
Just (forall {a}. [a] -> [a]
reverse (a
a forall a. a -> [a] -> [a]
: [a]
bs) forall a. [a] -> [a] -> [a]
++ a
b forall a. a -> [a] -> [a]
: [a]
as, Int
offset forall a. Num a => a -> a -> a
+ Int
1)
go [a]
_ [a]
_ Int
_ = forall a. Maybe a
Nothing
endOfLine :: XP ()
endOfLine :: XP ()
endOfLine =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { offset :: Int
offset = forall (t :: * -> *) a. Foldable t => t a -> Int
length (XPState -> String
command XPState
s)}
startOfLine :: XP ()
startOfLine :: XP ()
startOfLine =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { offset :: Int
offset = Int
0 }
flushString :: XP ()
flushString :: XP ()
flushString = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> String -> XPState -> XPState
setCommand String
"" forall a b. (a -> b) -> a -> b
$ XPState
s { offset :: Int
offset = Int
0}
resetComplIndex :: XPState -> XPState
resetComplIndex :: XPState -> XPState
resetComplIndex XPState
st = if XPConfig -> Bool
alwaysHighlight (XPState -> XPConfig
config XPState
st) then XPState
st { complIndex :: (Int, Int)
complIndex = (Int
0,Int
0) } else XPState
st
insertString :: String -> XP ()
insertString :: String -> XP ()
insertString String
str = do
String -> XP ()
insertString' String
str
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify XPState -> XPState
resetComplIndex
insertString' :: String -> XP ()
insertString' :: String -> XP ()
insertString' String
str =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> let
cmd :: String
cmd = String -> Int -> String
c (XPState -> String
command XPState
s) (XPState -> Int
offset XPState
s)
st :: XPState
st = XPState
s { offset :: Int
offset = Int -> Int
o (XPState -> Int
offset XPState
s)}
in String -> XPState -> XPState
setCommand String
cmd XPState
st
where o :: Int -> Int
o Int
oo = Int
oo forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str
c :: String -> Int -> String
c String
oc Int
oo | Int
oo forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length String
oc = String
oc forall a. [a] -> [a] -> [a]
++ String
str
| Bool
otherwise = String
f forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
ss
where (String
f,String
ss) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
oo String
oc
pasteString :: XP ()
pasteString :: XP ()
pasteString = (String -> String) -> XP ()
pasteString' forall a. a -> a
id
pasteString' :: (String -> String) -> XP ()
pasteString' :: (String -> String) -> XP ()
pasteString' String -> String
f = String -> XP ()
insertString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => m String
getSelection
deleteString :: Direction1D -> XP ()
deleteString :: Direction1D -> XP ()
deleteString Direction1D
d =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> String -> XPState -> XPState
setCommand (forall {a}. [a] -> Int -> [a]
c (XPState -> String
command XPState
s) (XPState -> Int
offset XPState
s)) forall a b. (a -> b) -> a -> b
$ XPState
s { offset :: Int
offset = forall {a}. (Ord a, Num a) => a -> a
o (XPState -> Int
offset XPState
s)}
where o :: a -> a
o a
oo = if Direction1D
d forall a. Eq a => a -> a -> Bool
== Direction1D
Prev then forall a. Ord a => a -> a -> a
max a
0 (a
oo forall a. Num a => a -> a -> a
- a
1) else a
oo
c :: [a] -> Int -> [a]
c [a]
oc Int
oo
| Int
oo forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
oc Bool -> Bool -> Bool
&& Direction1D
d forall a. Eq a => a -> a -> Bool
== Direction1D
Prev = forall a. Int -> [a] -> [a]
take (Int
oo forall a. Num a => a -> a -> a
- Int
1) [a]
oc
| Int
oo forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
oc Bool -> Bool -> Bool
&& Direction1D
d forall a. Eq a => a -> a -> Bool
== Direction1D
Prev = forall a. Int -> [a] -> [a]
take (Int
oo forall a. Num a => a -> a -> a
- Int
1) [a]
f forall a. [a] -> [a] -> [a]
++ [a]
ss
| Int
oo forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
oc Bool -> Bool -> Bool
&& Direction1D
d forall a. Eq a => a -> a -> Bool
== Direction1D
Next = [a]
f forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop Int
1 [a]
ss
| Bool
otherwise = [a]
oc
where ([a]
f,[a]
ss) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
oo [a]
oc
clipCursor :: XP ()
clipCursor :: XP ()
clipCursor = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { offset :: Int
offset = 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 Int
oo t a
c = forall a. Ord a => a -> a -> a
min (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
c forall a. Num a => a -> a -> a
- Int
1) Int
oo
moveCursor :: Direction1D -> XP ()
moveCursor :: Direction1D -> XP ()
moveCursor Direction1D
d =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { offset :: Int
offset = 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 Int
oo t a
c = if Direction1D
d forall a. Eq a => a -> a -> Bool
== Direction1D
Prev then forall a. Ord a => a -> a -> a
max Int
0 (Int
oo forall a. Num a => a -> a -> a
- Int
1) else forall a. Ord a => a -> a -> a
min (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
c) (Int
oo forall a. Num a => a -> a -> a
+ Int
1)
moveCursorClip :: Direction1D -> XP ()
moveCursorClip :: Direction1D -> XP ()
moveCursorClip = (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XP ()
clipCursor) 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' Char -> Bool
p Direction1D
d = do
String
c <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> String
command
Int
o <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> Int
offset
let (String
f,String
ss) = forall a. Int -> [a] -> ([a], [a])
splitOn Int
o String
c
splitOn :: Int -> [a] -> ([a], [a])
splitOn Int
n [a]
xs = (forall a. Int -> [a] -> [a]
take (Int
nforall a. Num a => a -> a -> a
+Int
1) [a]
xs, forall a. Int -> [a] -> [a]
drop Int
n [a]
xs)
gap :: Int
gap = case Direction1D
d of
Direction1D
Prev -> forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ (Int
o forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c
Direction1D
Next -> Int
0
len :: String -> Int
len = forall a. Ord a => a -> a -> a
max Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
gap forall a. Num a => a -> a -> a
+)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Num a => a -> a -> a
(+)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
p
newoff :: Int
newoff = case Direction1D
d of
Direction1D
Prev -> Int
o forall a. Num a => a -> a -> a
- String -> Int
len (forall {a}. [a] -> [a]
reverse String
f)
Direction1D
Next -> Int
o forall a. Num a => a -> a -> a
+ String -> Int
len String
ss
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s { offset :: Int
offset = Int
newoff }
moveHistory :: (W.Stack String -> W.Stack String) -> XP ()
moveHistory :: (Stack String -> Stack String) -> XP ()
moveHistory Stack String -> Stack String
f = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> let ch :: Stack String
ch = Stack String -> Stack String
f 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> a
W.focus Stack String
ch
, complIndex :: (Int, Int)
complIndex = (Int
0,Int
0) }
XP ()
updateWindows
XP ()
updateHighlightedCompl
toHeadChar :: Direction1D -> String -> XP ()
toHeadChar :: Direction1D -> String -> XP ()
toHeadChar Direction1D
_ String
"" = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
toHeadChar Direction1D
d (Char
c : String
_) = do
String
cmd <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> String
command
Int
off <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> Int
offset
let off' :: Int
off' = (if Direction1D
d forall a. Eq a => a -> a -> Bool
== Direction1D
Prev then forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst else forall a b. (a, b) -> b
snd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {a}. [a] -> [a]
reverse forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. Int -> [a] -> [a]
drop Int
1)
forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> ([a], [a])
splitAt Int
off String
cmd
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
st -> XPState
st { offset :: Int
offset = XPState -> Int
offset XPState
st forall a. Num a => a -> a -> a
+ Int
off' }
updateHighlightedCompl :: XP ()
updateHighlightedCompl :: XP ()
updateHighlightedCompl = do
XPState
st <- forall s (m :: * -> *). MonadState s m => m s
get
[String]
cs <- XP [String]
getCompletions
Bool
alwaysHighlight' <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ XPConfig -> Bool
alwaysHighlight forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState -> XPConfig
config
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alwaysHighlight' forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XPState
s -> XPState
s {highlightedCompl :: Maybe String
highlightedCompl = XPState -> [String] -> Maybe String
highlightedItem XPState
st [String]
cs}
data ComplWindowDim = ComplWindowDim
{ ComplWindowDim -> Position
cwX :: !Position
, ComplWindowDim -> Position
cwY :: !Position
, ComplWindowDim -> Dimension
cwWidth :: !Dimension
, ComplWindowDim -> Dimension
cwRowHeight :: !Dimension
, ComplWindowDim -> [Position]
cwCols :: ![Position]
, ComplWindowDim -> [Position]
cwRows :: ![Position]
}
deriving (ComplWindowDim -> ComplWindowDim -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComplWindowDim -> ComplWindowDim -> Bool
$c/= :: ComplWindowDim -> ComplWindowDim -> Bool
== :: ComplWindowDim -> ComplWindowDim -> Bool
$c== :: ComplWindowDim -> ComplWindowDim -> Bool
Eq)
createPromptWin :: Display -> Window -> XPConfig -> Rectangle -> Dimension -> IO Window
createPromptWin :: Display
-> EventMask -> XPConfig -> Rectangle -> Dimension -> IO EventMask
createPromptWin Display
dpy EventMask
rootw XPC{ XPPosition
position :: XPPosition
position :: XPConfig -> XPPosition
position, Dimension
height :: Dimension
height :: XPConfig -> Dimension
height } Rectangle
scn Dimension
width = do
EventMask
w <- Display
-> Screen
-> EventMask
-> Position
-> Position
-> Dimension
-> Dimension
-> IO EventMask
mkUnmanagedWindow Display
dpy (Display -> Screen
defaultScreenOfDisplay Display
dpy) EventMask
rootw
(Rectangle -> Position
rect_x Rectangle
scn forall a. Num a => a -> a -> a
+ Position
x) (Rectangle -> Position
rect_y Rectangle
scn forall a. Num a => a -> a -> a
+ Position
y) Dimension
width Dimension
height
Display -> EventMask -> ClassHint -> IO ()
setClassHint Display
dpy EventMask
w (String -> String -> ClassHint
ClassHint String
"xmonad-prompt" String
"xmonad")
Display -> EventMask -> IO ()
mapWindow Display
dpy EventMask
w
forall (m :: * -> *) a. Monad m => a -> m a
return EventMask
w
where
(Position
x, Position
y) :: (Position, Position) = forall a b. (Integral a, Num b) => a -> b
fi forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case XPPosition
position of
XPPosition
Top -> (Position
0, Dimension
0)
XPPosition
Bottom -> (Position
0, Rectangle -> Dimension
rect_height Rectangle
scn forall a. Num a => a -> a -> a
- Dimension
height)
CenteredAt Rational
py Rational
w ->
( forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
scn) forall a. Num a => a -> a -> a
* ((Rational
1 forall a. Num a => a -> a -> a
- Rational
w) forall a. Fractional a => a -> a -> a
/ Rational
2)
, forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Rational
py forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
scn) forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fi Dimension
height forall a. Fractional a => a -> a -> a
/ Rational
2)
)
updateComplWin :: Maybe Window -> Maybe ComplWindowDim -> XP ()
updateComplWin :: Maybe EventMask -> Maybe ComplWindowDim -> XP ()
updateComplWin Maybe EventMask
win Maybe ComplWindowDim
winDim = do
IORef (Maybe EventMask)
cwr <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> IORef (Maybe EventMask)
complWin
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe EventMask)
cwr Maybe EventMask
win
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\XPState
s -> XPState
s { complWinDim :: Maybe ComplWindowDim
complWinDim = Maybe ComplWindowDim
winDim })
updateWindows :: XP ()
updateWindows :: XP ()
updateWindows = XP () -> [String] -> XP ()
redrawWindows (forall (f :: * -> *) a. Functor f => f a -> f ()
void XP ()
destroyComplWin) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< XP [String]
getCompletions
redrawWindows
:: XP ()
-> [String]
-> XP ()
redrawWindows :: XP () -> [String] -> XP ()
redrawWindows XP ()
emptyAction [String]
compls = do
Display
d <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> Display
dpy
XP ()
drawWin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XP ()
emptyAction NonEmpty String -> XP ()
redrawComplWin (forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [String]
compls)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Bool -> IO ()
sync Display
d Bool
False
where
XP ()
drawWin :: XP () = do
XPS{ XPColor
color :: XPColor
color :: XPState -> XPColor
color, Display
dpy :: Display
dpy :: XPState -> Display
dpy, EventMask
win :: EventMask
win :: XPState -> EventMask
win, GC
gcon :: GC
gcon :: XPState -> GC
gcon, Dimension
winWidth :: Dimension
winWidth :: XPState -> Dimension
winWidth } <- forall s (m :: * -> *). MonadState s m => m s
get
XPC{ Dimension
height :: Dimension
height :: XPConfig -> Dimension
height, Dimension
promptBorderWidth :: Dimension
promptBorderWidth :: XPConfig -> Dimension
promptBorderWidth } <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XPState -> XPConfig
config
let scr :: Screen
scr = Display -> Screen
defaultScreenOfDisplay Display
dpy
ht :: Dimension
ht = Dimension
height
bw :: Dimension
bw = Dimension
promptBorderWidth
Just EventMask
bgcolor <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> String -> IO (Maybe EventMask)
initColor Display
dpy (XPColor -> String
bgNormal XPColor
color)
Just EventMask
borderC <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> String -> IO (Maybe EventMask)
initColor Display
dpy (XPColor -> String
border XPColor
color)
EventMask
pm <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> EventMask -> Dimension -> Dimension -> CInt -> IO EventMask
createPixmap Display
dpy EventMask
win Dimension
winWidth Dimension
ht (Screen -> CInt
defaultDepthOfScreen Screen
scr)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> EventMask
-> GC
-> EventMask
-> EventMask
-> Dimension
-> Dimension
-> Dimension
-> IO ()
fillDrawable Display
dpy EventMask
pm GC
gcon EventMask
borderC EventMask
bgcolor (forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Dimension
winWidth Dimension
ht
EventMask -> XP ()
printPrompt EventMask
pm
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> EventMask
-> EventMask
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> Position
-> Position
-> IO ()
copyArea Display
dpy EventMask
pm EventMask
win GC
gcon Position
0 Position
0 Dimension
winWidth Dimension
ht Position
0 Position
0
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> IO ()
freePixmap Display
dpy EventMask
pm
redrawComplWin :: NonEmpty String -> XP ()
redrawComplWin :: NonEmpty String -> XP ()
redrawComplWin NonEmpty String
compl = do
XPS{ Bool
showComplWin :: Bool
showComplWin :: XPState -> Bool
showComplWin, Maybe ComplWindowDim
complWinDim :: Maybe ComplWindowDim
complWinDim :: XPState -> Maybe ComplWindowDim
complWinDim, IORef (Maybe EventMask)
complWin :: IORef (Maybe EventMask)
complWin :: XPState -> IORef (Maybe EventMask)
complWin } <- forall s (m :: * -> *). MonadState s m => m s
get
ComplWindowDim
nwi <- NonEmpty String -> XP ComplWindowDim
getComplWinDim NonEmpty String
compl
let recreate :: XP ()
recreate = do XP ()
destroyComplWin
EventMask
w <- ComplWindowDim -> StateT XPState IO EventMask
createComplWin ComplWindowDim
nwi
EventMask -> NonEmpty String -> XP ()
drawComplWin EventMask
w NonEmpty String
compl
if Bool
showComplWin
then forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (forall a. IORef a -> IO a
readIORef IORef (Maybe EventMask)
complWin) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just EventMask
w -> case Maybe ComplWindowDim
complWinDim of
Just ComplWindowDim
wi -> if ComplWindowDim
nwi forall a. Eq a => a -> a -> Bool
== ComplWindowDim
wi
then EventMask -> NonEmpty String -> XP ()
drawComplWin EventMask
w NonEmpty String
compl
else XP ()
recreate
Maybe ComplWindowDim
Nothing -> XP ()
recreate
Maybe EventMask
Nothing -> XP ()
recreate
else XP ()
destroyComplWin
where
createComplWin :: ComplWindowDim -> XP Window
createComplWin :: ComplWindowDim -> StateT XPState IO EventMask
createComplWin wi :: ComplWindowDim
wi@ComplWindowDim{ Position
cwX :: Position
cwX :: ComplWindowDim -> Position
cwX, Position
cwY :: Position
cwY :: ComplWindowDim -> Position
cwY, Dimension
cwWidth :: Dimension
cwWidth :: ComplWindowDim -> Dimension
cwWidth, Dimension
cwRowHeight :: Dimension
cwRowHeight :: ComplWindowDim -> Dimension
cwRowHeight } = do
XPS{ Display
dpy :: Display
dpy :: XPState -> Display
dpy, EventMask
rootw :: EventMask
rootw :: XPState -> EventMask
rootw } <- forall s (m :: * -> *). MonadState s m => m s
get
let scr :: Screen
scr = Display -> Screen
defaultScreenOfDisplay Display
dpy
EventMask
w <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Screen
-> EventMask
-> Position
-> Position
-> Dimension
-> Dimension
-> IO EventMask
mkUnmanagedWindow Display
dpy Screen
scr EventMask
rootw Position
cwX Position
cwY Dimension
cwWidth Dimension
cwRowHeight
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> IO ()
mapWindow Display
dpy EventMask
w
Maybe EventMask -> Maybe ComplWindowDim -> XP ()
updateComplWin (forall a. a -> Maybe a
Just EventMask
w) (forall a. a -> Maybe a
Just ComplWindowDim
wi)
forall (m :: * -> *) a. Monad m => a -> m a
return EventMask
w
printPrompt :: Drawable -> XP ()
printPrompt :: EventMask -> XP ()
printPrompt EventMask
drw = do
st :: XPState
st@XPS{ String -> String
prompter :: String -> String
prompter :: XPState -> String -> String
prompter, XPColor
color :: XPColor
color :: XPState -> XPColor
color, GC
gcon :: GC
gcon :: XPState -> GC
gcon, XPConfig
config :: XPConfig
config :: XPState -> XPConfig
config, Display
dpy :: Display
dpy :: XPState -> Display
dpy, XMonadFont
fontS :: XMonadFont
fontS :: XPState -> XMonadFont
fontS, Int
offset :: Int
offset :: XPState -> Int
offset } <- forall s (m :: * -> *). MonadState s m => m s
get
let
(String
prt, String
com) = (String -> String
prompter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState -> XPType
currentXPMode forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& XPState -> String
command) XPState
st
str :: String
str = String
prt forall a. [a] -> [a] -> [a]
++ String
com
(String
preCursor, String
cursor, String
postCursor) = if Int
offset forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length String
com
then (String
str, String
" ",String
"")
else let (String
a, String
b) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
offset String
com
in (String
prt forall a. [a] -> [a] -> [a]
++ String
a, forall a. Int -> [a] -> [a]
take Int
1 String
b, forall a. Int -> [a] -> [a]
drop Int
1 String
b)
(Position
asc, Position
desc) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Position, Position)
textExtentsXMF XMonadFont
fontS String
str
let y :: Position
y = forall a b. (Integral a, Num b) => a -> b
fi ((XPConfig -> Dimension
height XPConfig
config forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (Position
asc forall a. Num a => a -> a -> a
+ Position
desc)) forall a. Integral a => a -> a -> a
`div` Dimension
2) forall a. Num a => a -> a -> a
+ Position
asc
x :: Position
x = (Position
asc forall a. Num a => a -> a -> a
+ Position
desc) forall a. Integral a => a -> a -> a
`div` Position
2
Int
pcFont <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
dpy XMonadFont
fontS String
preCursor
Int
cFont <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
dpy XMonadFont
fontS String
cursor
let draw :: String -> String -> Position -> Position -> String -> XP ()
draw = forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> EventMask
-> XMonadFont
-> GC
-> String
-> String
-> Position
-> Position
-> String
-> m ()
printStringXMF Display
dpy EventMask
drw XMonadFont
fontS GC
gcon
String -> String -> Position -> Position -> String -> XP ()
draw (XPColor -> String
fgNormal XPColor
color) (XPColor -> String
bgNormal XPColor
color) Position
x Position
y String
preCursor
String -> String -> Position -> Position -> String -> XP ()
draw (XPColor -> String
bgNormal XPColor
color) (XPColor -> String
fgNormal XPColor
color) (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Int
pcFont) Position
y String
cursor
String -> String -> Position -> Position -> String -> XP ()
draw (XPColor -> String
fgNormal XPColor
color) (XPColor -> String
bgNormal XPColor
color) (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Int
pcFont forall a. Num a => a -> a -> a
+ Int
cFont)) Position
y String
postCursor
getCompletions :: XP [String]
getCompletions :: XP [String]
getCompletions = do
st :: XPState
st@XPS{ XPConfig
config :: XPConfig
config :: XPState -> XPConfig
config } <- forall s (m :: * -> *). MonadState s m => m s
get
let cmd :: String
cmd = forall t. XPrompt t => t -> String -> String
commandToComplete (XPState -> XPType
currentXPMode XPState
st) (XPState -> String
command XPState
st)
compl :: ComplFunction
compl = XPState -> ComplFunction
getCompletionFunction XPState
st
srt :: String -> [String] -> [String]
srt = XPConfig -> String -> [String] -> [String]
sorter XPConfig
config
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ (String -> [String] -> [String]
srt String
cmd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComplFunction
compl String
cmd) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return []
where
getCompletionFunction :: XPState -> ComplFunction
getCompletionFunction :: XPState -> ComplFunction
getCompletionFunction XPState
st = case XPState -> XPOperationMode
operationMode XPState
st of
XPSingleMode ComplFunction
compl XPType
_ -> ComplFunction
compl
XPMultipleModes Stack XPType
modes -> forall t. XPrompt t => t -> ComplFunction
completionFunction forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> a
W.focus Stack XPType
modes
destroyComplWin :: XP ()
destroyComplWin :: XP ()
destroyComplWin = do
XPS{ Display
dpy :: Display
dpy :: XPState -> Display
dpy, IORef (Maybe EventMask)
complWin :: IORef (Maybe EventMask)
complWin :: XPState -> IORef (Maybe EventMask)
complWin } <- forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (forall a. IORef a -> IO a
readIORef IORef (Maybe EventMask)
complWin) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just EventMask
w -> do forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> IO ()
destroyWindow Display
dpy EventMask
w
Maybe EventMask -> Maybe ComplWindowDim -> XP ()
updateComplWin forall a. Maybe a
Nothing forall a. Maybe a
Nothing
Maybe EventMask
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
getComplWinDim :: NonEmpty String -> XP ComplWindowDim
getComplWinDim :: NonEmpty String -> XP ComplWindowDim
getComplWinDim NonEmpty String
compl = do
XPS{ config :: XPState -> XPConfig
config = XPConfig
cfg, screen :: XPState -> Rectangle
screen = Rectangle
scr, fontS :: XPState -> XMonadFont
fontS = XMonadFont
fs, Display
dpy :: Display
dpy :: XPState -> Display
dpy, Dimension
winWidth :: Dimension
winWidth :: XPState -> Dimension
winWidth } <- forall s (m :: * -> *). MonadState s m => m s
get
let
ht :: Dimension
ht = XPConfig -> Dimension
height XPConfig
cfg
bw :: Dimension
bw = XPConfig -> Dimension
promptBorderWidth XPConfig
cfg
NonEmpty Int
tws <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
dpy XMonadFont
fs) NonEmpty String
compl
let
maxComplLen :: Int
maxComplLen = (forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht forall a. Integral a => a -> a -> a
`div` Int
2) forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum NonEmpty Int
tws
remHeight :: Dimension
remHeight = Rectangle -> Dimension
rect_height Rectangle
scr forall a. Num a => a -> a -> a
- Dimension
ht
maxColumns :: Dimension -> Dimension
maxColumns = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. Ord a => a -> a -> a
min (XPConfig -> Maybe Dimension
maxComplColumns XPConfig
cfg)
columns :: Dimension
columns = forall a. Ord a => a -> a -> a
max Dimension
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension -> Dimension
maxColumns forall a b. (a -> b) -> a -> b
$ Dimension
winWidth forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fi Int
maxComplLen
columnWidth :: Dimension
columnWidth = Dimension
winWidth forall a. Integral a => a -> a -> a
`div` Dimension
columns
(Int
fullRows, Int
lastRow) = forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty String
compl forall a. Integral a => a -> a -> (a, a)
`divMod` forall a b. (Integral a, Num b) => a -> b
fi Dimension
columns
allRows :: Int
allRows = forall a. Ord a => a -> a -> a
max Int
1 (Int
fullRows forall a. Num a => a -> a -> a
+ if Int
lastRow forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
1)
maxRows :: Dimension
maxRows = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. Ord a => a -> a -> a
min (XPConfig -> Maybe Dimension
maxComplRows XPConfig
cfg) (Dimension
remHeight forall a. Integral a => a -> a -> a
`div` Dimension
ht)
rows :: Dimension
rows = forall a. Ord a => a -> a -> a
min Dimension
maxRows (forall a b. (Integral a, Num b) => a -> b
fi Int
allRows)
rowHeight :: Dimension
rowHeight = Dimension
rows forall a. Num a => a -> a -> a
* Dimension
ht
(Position
x, Position
y) = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Rectangle -> Position
rect_x Rectangle
scr forall a. Num a => a -> a -> a
+) ((Rectangle -> Position
rect_y Rectangle
scr forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fi) forall a b. (a -> b) -> a -> b
$ case XPConfig -> XPPosition
position XPConfig
cfg of
XPPosition
Top -> (Position
0, Dimension
ht forall a. Num a => a -> a -> a
- Dimension
bw)
XPPosition
Bottom -> (Position
0, Dimension
remHeight forall a. Num a => a -> a -> a
- Dimension
rowHeight forall a. Num a => a -> a -> a
+ Dimension
bw)
CenteredAt Rational
py Rational
w
| Rational
py forall a. Ord a => a -> a -> Bool
<= Rational
1forall a. Fractional a => a -> a -> a
/Rational
2 ->
( forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
scr) forall a. Num a => a -> a -> a
* ((Rational
1 forall a. Num a => a -> a -> a
- Rational
w) forall a. Fractional a => a -> a -> a
/ Rational
2)
, forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
py forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
scr) forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht forall a. Fractional a => a -> a -> a
/ Rational
2)) forall a. Num a => a -> a -> a
- Dimension
bw
)
| Bool
otherwise ->
( forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
scr) forall a. Num a => a -> a -> a
* ((Rational
1 forall a. Num a => a -> a -> a
- Rational
w) forall a. Fractional a => a -> a -> a
/ Rational
2)
, forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
py forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
scr) forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht forall a. Fractional a => a -> a -> a
/ Rational
2)) forall a. Num a => a -> a -> a
- Dimension
rowHeight forall a. Num a => a -> a -> a
+ Dimension
bw
)
(Position
asc, Position
desc) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Position, Position)
textExtentsXMF XMonadFont
fs forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.head NonEmpty String
compl
let yp :: Position
yp = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ (Dimension
ht forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Position
asc forall a. Num a => a -> a -> a
- Position
desc)) forall a. Integral a => a -> a -> a
`div` Dimension
2
yRows :: [Position]
yRows = forall a. Int -> [a] -> [a]
take (forall a b. (Integral a, Num b) => a -> b
fi Dimension
rows) [Position
yp, Position
yp forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht ..]
xp :: Position
xp = (Position
asc forall a. Num a => a -> a -> a
+ Position
desc) forall a. Integral a => a -> a -> a
`div` Position
2
xCols :: [Position]
xCols = forall a. Int -> [a] -> [a]
take (forall a b. (Integral a, Num b) => a -> b
fi Dimension
columns) [Position
xp, Position
xp forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
columnWidth ..]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Position
-> Position
-> Dimension
-> Dimension
-> [Position]
-> [Position]
-> ComplWindowDim
ComplWindowDim Position
x Position
y Dimension
winWidth Dimension
rowHeight [Position]
xCols [Position]
yRows
drawComplWin :: Window -> NonEmpty String -> XP ()
drawComplWin :: EventMask -> NonEmpty String -> XP ()
drawComplWin EventMask
w NonEmpty String
entries = do
XPS{ XPConfig
config :: XPConfig
config :: XPState -> XPConfig
config, XPColor
color :: XPColor
color :: XPState -> XPColor
color, Display
dpy :: Display
dpy :: XPState -> Display
dpy, GC
gcon :: GC
gcon :: XPState -> GC
gcon } <- forall s (m :: * -> *). MonadState s m => m s
get
let scr :: Screen
scr = Display -> Screen
defaultScreenOfDisplay Display
dpy
bw :: Dimension
bw = XPConfig -> Dimension
promptBorderWidth XPConfig
config
Just EventMask
bgcolor <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> String -> IO (Maybe EventMask)
initColor Display
dpy (XPColor -> String
bgNormal XPColor
color)
Just EventMask
borderC <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> String -> IO (Maybe EventMask)
initColor Display
dpy (XPColor -> String
border XPColor
color)
cwd :: ComplWindowDim
cwd@ComplWindowDim{ Dimension
cwWidth :: Dimension
cwWidth :: ComplWindowDim -> Dimension
cwWidth, Dimension
cwRowHeight :: Dimension
cwRowHeight :: ComplWindowDim -> Dimension
cwRowHeight } <- NonEmpty String -> XP ComplWindowDim
getComplWinDim NonEmpty String
entries
EventMask
p <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> EventMask -> Dimension -> Dimension -> CInt -> IO EventMask
createPixmap Display
dpy EventMask
w Dimension
cwWidth Dimension
cwRowHeight (Screen -> CInt
defaultDepthOfScreen Screen
scr)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> EventMask
-> GC
-> EventMask
-> EventMask
-> Dimension
-> Dimension
-> Dimension
-> IO ()
fillDrawable Display
dpy EventMask
p GC
gcon EventMask
borderC EventMask
bgcolor (forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Dimension
cwWidth Dimension
cwRowHeight
Display
-> EventMask
-> GC
-> String
-> String
-> NonEmpty String
-> ComplWindowDim
-> XP ()
printComplEntries Display
dpy EventMask
p GC
gcon (XPColor -> String
fgNormal XPColor
color) (XPColor -> String
bgNormal XPColor
color) NonEmpty String
entries ComplWindowDim
cwd
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> EventMask
-> EventMask
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> Position
-> Position
-> IO ()
copyArea Display
dpy EventMask
p EventMask
w GC
gcon Position
0 Position
0 Dimension
cwWidth Dimension
cwRowHeight Position
0 Position
0
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> IO ()
freePixmap Display
dpy EventMask
p
printComplEntries
:: Display
-> Drawable
-> GC
-> String
-> String
-> NonEmpty String
-> ComplWindowDim
-> XP ()
printComplEntries :: Display
-> EventMask
-> GC
-> String
-> String
-> NonEmpty String
-> ComplWindowDim
-> XP ()
printComplEntries Display
dpy EventMask
drw GC
gc String
fc String
bc NonEmpty String
entries ComplWindowDim{ [Position]
cwCols :: [Position]
cwCols :: ComplWindowDim -> [Position]
cwCols, [Position]
cwRows :: [Position]
cwRows :: ComplWindowDim -> [Position]
cwRows } = do
st :: XPState
st@XPS{ XPColor
color :: XPColor
color :: XPState -> XPColor
color, (Int, Int)
complIndex :: (Int, Int)
complIndex :: XPState -> (Int, Int)
complIndex, config :: XPState -> XPConfig
config = XPC{ Bool
alwaysHighlight :: Bool
alwaysHighlight :: XPConfig -> Bool
alwaysHighlight } } <- forall s (m :: * -> *). MonadState s m => m s
get
let printItemAt :: Position -> Position -> String -> XP ()
printItemAt :: Position -> Position -> String -> XP ()
printItemAt Position
x Position
y String
item =
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> EventMask
-> XMonadFont
-> GC
-> String
-> String
-> Position
-> Position
-> String
-> m ()
printStringXMF Display
dpy EventMask
drw (XPState -> XMonadFont
fontS XPState
st) GC
gc String
fgCol String
bgCol Position
x Position
y String
item
where
(String
fgCol, String
bgCol)
|
Bool
alwaysHighlight, (Int, Int)
complIndex forall a. Eq a => a -> a -> Bool
== String -> (Int, Int)
findComplIndex String
item
= (XPColor -> String
fgHighlight XPColor
color, XPColor -> String
bgHighlight XPColor
color)
|
forall t. XPrompt t => t -> String -> String
completionToCommand (XPState -> XPType
currentXPMode XPState
st) String
item forall a. Eq a => a -> a -> Bool
== forall t. XPrompt t => t -> String -> String
commandToComplete (XPState -> XPType
currentXPMode XPState
st) (XPState -> String
command XPState
st)
= (XPColor -> String
fgHighlight XPColor
color, XPColor -> String
bgHighlight XPColor
color)
|
Bool
otherwise = (String
fc, String
bc)
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\Position
x -> forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (Position -> Position -> String -> XP ()
printItemAt Position
x) [Position]
cwRows) [Position]
cwCols [[String]]
complMat
where
[[String]]
complMat :: [[String]]
= forall a. Int -> [a] -> [[a]]
chunksOf (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Position]
cwRows) (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Position]
cwCols forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [Position]
cwRows) (forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
entries))
findComplIndex :: String -> (Int, Int)
findComplIndex :: String -> (Int, Int)
findComplIndex String
item = (Int
colIndex, Int
rowIndex)
where
colIndex :: Int
colIndex = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\[String]
cols -> String
item forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
cols) [[String]]
complMat
rowIndex :: Int
rowIndex = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
item forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [[String]]
complMat forall a. [a] -> Int -> Maybe a
!? Int
colIndex
type History = M.Map String [String]
emptyHistory :: History
emptyHistory :: Map String [String]
emptyHistory = forall k a. Map k a
M.empty
getHistoryFile :: FilePath -> FilePath
getHistoryFile :: String -> String
getHistoryFile String
cachedir = String
cachedir forall a. [a] -> [a] -> [a]
++ String
"/prompt-history"
readHistory :: XPConfig -> FilePath -> IO History
readHistory :: XPConfig -> String -> IO (Map String [String])
readHistory (XPC { historySize :: XPConfig -> Int
historySize = Int
0 }) String
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Map String [String]
emptyHistory
readHistory XPConfig
_ String
cachedir = IO (Map String [String])
readHist forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Map String [String]
emptyHistory
where
readHist :: IO (Map String [String])
readHist = do
let path :: String
path = String -> String
getHistoryFile String
cachedir
String
xs <- forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
ReadMode Handle -> IO String
hGetLine
forall a. Read a => String -> IO a
readIO String
xs
writeHistory :: XPConfig -> FilePath -> History -> IO ()
writeHistory :: XPConfig -> String -> Map String [String] -> IO ()
writeHistory (XPC { historySize :: XPConfig -> Int
historySize = Int
0 }) String
_ Map String [String]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeHistory XPConfig
_ String
cachedir Map String [String]
hist = do
let path :: String
path = String -> String
getHistoryFile String
cachedir
filtered :: Map String [String]
filtered = forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) Map String [String]
hist
String -> String -> IO ()
writeFile String
path (forall a. Show a => a -> String
show Map String [String]
filtered) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException e
e) ->
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"error writing history: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show e
e)
String -> FileMode -> IO ()
setFileMode String
path FileMode
mode
where mode :: FileMode
mode = FileMode
ownerReadMode forall a. Bits a => a -> a -> a
.|. FileMode
ownerWriteMode
fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel
-> Dimension -> Dimension -> Dimension -> IO ()
fillDrawable :: Display
-> EventMask
-> GC
-> EventMask
-> EventMask
-> Dimension
-> Dimension
-> Dimension
-> IO ()
fillDrawable Display
d EventMask
drw GC
gc EventMask
borderC EventMask
bgcolor Dimension
bw Dimension
wh Dimension
ht = do
Display -> GC -> EventMask -> IO ()
setForeground Display
d GC
gc EventMask
borderC
Display
-> EventMask
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
fillRectangle Display
d EventMask
drw GC
gc Position
0 Position
0 Dimension
wh Dimension
ht
Display -> GC -> EventMask -> IO ()
setForeground Display
d GC
gc EventMask
bgcolor
Display
-> EventMask
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
fillRectangle Display
d EventMask
drw GC
gc (forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) (Dimension
wh forall a. Num a => a -> a -> a
- (Dimension
bw forall a. Num a => a -> a -> a
* Dimension
2)) (Dimension
ht forall a. Num a => a -> a -> a
- (Dimension
bw forall a. Num a => a -> a -> a
* Dimension
2))
mkUnmanagedWindow :: Display -> Screen -> Window -> Position
-> Position -> Dimension -> Dimension -> IO Window
mkUnmanagedWindow :: Display
-> Screen
-> EventMask
-> Position
-> Position
-> Dimension
-> Dimension
-> IO EventMask
mkUnmanagedWindow Display
d Screen
s EventMask
rw Position
x Position
y Dimension
w Dimension
h = do
let visual :: Visual
visual = Screen -> Visual
defaultVisualOfScreen Screen
s
attrmask :: EventMask
attrmask = EventMask
cWOverrideRedirect
forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
allocaSetWindowAttributes forall a b. (a -> b) -> a -> b
$
\Ptr SetWindowAttributes
attributes -> do
Ptr SetWindowAttributes -> Bool -> IO ()
set_override_redirect Ptr SetWindowAttributes
attributes Bool
True
Display
-> EventMask
-> Position
-> Position
-> Dimension
-> Dimension
-> CInt
-> CInt
-> CInt
-> Visual
-> EventMask
-> Ptr SetWindowAttributes
-> IO EventMask
createWindow Display
d EventMask
rw Position
x Position
y Dimension
w Dimension
h CInt
0 (Screen -> CInt
defaultDepthOfScreen Screen
s)
CInt
inputOutput Visual
visual EventMask
attrmask Ptr SetWindowAttributes
attributes
mkComplFunFromList :: XPConfig -> [String] -> String -> IO [String]
mkComplFunFromList :: XPConfig -> [String] -> ComplFunction
mkComplFunFromList XPConfig
_ [String]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
mkComplFunFromList XPConfig
c [String]
l String
s =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (XPConfig -> String -> String -> Bool
searchPredicate XPConfig
c String
s) [String]
l
mkComplFunFromList' :: XPConfig -> [String] -> String -> IO [String]
mkComplFunFromList' :: XPConfig -> [String] -> ComplFunction
mkComplFunFromList' XPConfig
_ [String]
l [] = forall (m :: * -> *) a. Monad m => a -> m a
return [String]
l
mkComplFunFromList' XPConfig
c [String]
l String
s =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (XPConfig -> String -> String -> Bool
searchPredicate XPConfig
c String
s) [String]
l
getNextOfLastWord :: XPrompt t => t -> String -> [String] -> String
getNextOfLastWord :: forall t. XPrompt t => t -> String -> [String] -> String
getNextOfLastWord t
t String
c [String]
l = String -> String
skipLastWord String
c forall a. [a] -> [a] -> [a]
++ forall t. XPrompt t => t -> String -> String
completionToCommand t
t ([String]
l forall a. [a] -> Int -> a
!! Int
ni)
where ni :: Int
ni = case forall t. XPrompt t => t -> String -> String
commandToComplete t
t String
c forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` forall a b. (a -> b) -> [a] -> [b]
map (forall t. XPrompt t => t -> String -> String
completionToCommand t
t) [String]
l of
Just Int
i -> if Int
i forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
l forall a. Num a => a -> a -> a
- Int
1 then Int
0 else Int
i forall a. Num a => a -> a -> a
+ Int
1
Maybe Int
Nothing -> Int
0
getNextCompletion :: String -> [String] -> String
getNextCompletion :: String -> [String] -> String
getNextCompletion String
c [String]
l = [String]
l forall a. [a] -> Int -> a
!! Int
idx
where idx :: Int
idx = case String
c forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [String]
l of
Just Int
i -> if Int
i forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
l forall a. Num a => a -> a -> a
- Int
1 then Int
0 else Int
i forall a. Num a => a -> a -> a
+ Int
1
Maybe Int
Nothing -> Int
0
splitInSubListsAt :: Int -> [a] -> [[a]]
splitInSubListsAt :: forall a. Int -> [a] -> [[a]]
splitInSubListsAt = forall a. Int -> [a] -> [[a]]
chunksOf
{-# DEPRECATED splitInSubListsAt "Use XMonad.Prelude.chunksOf instead." #-}
getLastWord :: String -> String
getLastWord :: String -> String
getLastWord = forall {a}. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
breakAtSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [a] -> [a]
reverse
skipLastWord :: String -> String
skipLastWord :: String -> String
skipLastWord = forall {a}. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
breakAtSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [a] -> [a]
reverse
breakAtSpace :: String -> (String, String)
breakAtSpace :: String -> (String, String)
breakAtSpace String
s
| String
" \\" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s2 = (String
s1 forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
s1', String
s2')
| Bool
otherwise = (String
s1, String
s2)
where (String
s1, String
s2 ) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
s
(String
s1',String
s2') = String -> (String, String)
breakAtSpace forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 String
s2
historyCompletion :: XPConfig -> X ComplFunction
historyCompletion :: XPConfig -> X ComplFunction
historyCompletion XPConfig
conf = XPConfig -> (String -> Bool) -> X ComplFunction
historyCompletionP XPConfig