X.Prompt: write updateWindows in terms of redrawWindows

Also document the functions because they dearly need it.
This commit is contained in:
slotThe 2021-04-14 20:22:00 +02:00
parent 0af9435d58
commit b7dbc277a7

View File

@ -738,7 +738,7 @@ handleCompletion cs = do
alwaysHlight <- gets $ alwaysHighlight . config alwaysHlight <- gets $ alwaysHighlight . config
st <- get st <- get
let updateWins l = redrawWindows l let updateWins l = redrawWindows (pure ()) l
updateState l = if alwaysHlight updateState l = if alwaysHlight
then hlComplete (getLastWord $ command st) l st then hlComplete (getLastWord $ command st) l st
else simpleComplete l st else simpleComplete l st
@ -1389,25 +1389,6 @@ data ComplWindowDim = ComplWindowDim
} }
deriving (Eq) deriving (Eq)
updateWindows :: XP ()
updateWindows = do
d <- gets dpy
drawWin
c <- getCompletions
case c of
[] -> void destroyComplWin
l -> redrawComplWin l
io $ sync d False
redrawWindows :: [String] -> XP ()
redrawWindows c = do
d <- gets dpy
drawWin
case c of
[] -> return ()
l -> redrawComplWin l
io $ sync d False
createPromptWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window createPromptWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window
createPromptWin d rw c s = do createPromptWin d rw c s = do
let (x,y) = case position c of let (x,y) = case position c of
@ -1423,24 +1404,40 @@ createPromptWin d rw c s = do
mapWindow d w mapWindow d w
return w return w
drawWin :: XP () --- | Update all prompt windows.
drawWin = do updateWindows :: XP ()
st <- get updateWindows = redrawWindows (void destroyComplWin) =<< getCompletions
let (c,(cr,(d,(w,gc)))) = (config &&& color &&& dpy &&& win &&& gcon) st
scr = defaultScreenOfDisplay d -- | Draw the main prompt window and, if necessary, redraw the
wh = case position c of -- completion window.
CenteredAt _ wd -> floor $ wd * fi (widthOfScreen scr) redrawWindows
_ -> widthOfScreen scr :: XP () -- ^ What to do if the completions are empty
ht = height c -> [String] -- ^ Given completions
bw = promptBorderWidth c -> XP ()
Just bgcolor <- io $ initColor d (bgNormal cr) redrawWindows emptyAction compls = do
Just borderC <- io $ initColor d (border cr) d <- gets dpy
p <- io $ createPixmap d w wh ht drawWin
(defaultDepthOfScreen scr) case compls of
io $ fillDrawable d p gc borderC bgcolor (fi bw) wh ht [] -> emptyAction
printPrompt p l -> redrawComplWin l
io $ copyArea d p w gc 0 0 wh ht 0 0 io $ sync d False
io $ freePixmap d p where
-- | Draw the main prompt window.
drawWin :: XP () = do
XPS{ config, color, dpy, win, gcon } <- get
let scr = defaultScreenOfDisplay dpy
width = case position config of
CenteredAt _ wd -> floor $ wd * fi (widthOfScreen scr)
_ -> widthOfScreen scr
ht = height config -- height of a single row
bw = promptBorderWidth config
Just bgcolor <- io $ initColor dpy (bgNormal color)
Just borderC <- io $ initColor dpy (border color)
pm <- io $ createPixmap dpy win width ht (defaultDepthOfScreen scr)
io $ fillDrawable dpy pm gcon borderC bgcolor (fi bw) width ht
printPrompt pm
io $ copyArea dpy pm win gcon 0 0 width ht 0 0
io $ freePixmap dpy pm
printPrompt :: Drawable -> XP () printPrompt :: Drawable -> XP ()
printPrompt drw = do printPrompt drw = do