X.Prompt: Make ComplWindowDim a proper type

This commit is contained in:
slotThe 2021-04-14 20:19:56 +02:00
parent 402d29b306
commit 0af9435d58

View File

@ -3,6 +3,7 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Prompt -- Module : XMonad.Prompt
@ -410,8 +411,8 @@ highlightedItem st' completions = case complWinDim st' of
Nothing -> Nothing -- when there isn't any compl win, we can't say how many cols,rows there are Nothing -> Nothing -- when there isn't any compl win, we can't say how many cols,rows there are
Just winDim -> Just winDim ->
let let
(_,_,_,_,xx,yy) = winDim ComplWindowDim{ cwCols, cwRows } = winDim
complMatrix = chunksOf (length yy) (take (length xx * length yy) completions) complMatrix = chunksOf (length cwRows) (take (length cwCols * length cwRows) completions)
(col_index,row_index) = complIndex st' (col_index,row_index) = complIndex st'
in case completions of in case completions of
[] -> Nothing [] -> Nothing
@ -908,8 +909,8 @@ bufferOne xs x = (null xs && null x,True)
nextComplIndex :: XPState -> (Int,Int) nextComplIndex :: XPState -> (Int,Int)
nextComplIndex st = case complWinDim st of nextComplIndex st = case complWinDim st of
Nothing -> (0,0) --no window dims (just destroyed or not created) Nothing -> (0,0) --no window dims (just destroyed or not created)
Just (_,_,_,_,xx,yy) -> let Just ComplWindowDim{ cwCols, cwRows } -> let
(ncols,nrows) = (length xx, length yy) (ncols,nrows) = (length cwCols, length cwRows)
(currentcol,currentrow) = complIndex st (currentcol,currentrow) = complIndex st
in if currentcol + 1 >= ncols then --hlight is in the last column in if currentcol + 1 >= ncols then --hlight is in the last column
if currentrow + 1 < nrows then --hlight is still not at the last row if currentrow + 1 < nrows then --hlight is still not at the last row
@ -1374,8 +1375,20 @@ updateHighlightedCompl = do
alwaysHighlight' <- gets $ alwaysHighlight . config alwaysHighlight' <- gets $ alwaysHighlight . config
when alwaysHighlight' $ modify $ \s -> s {highlightedCompl = highlightedItem st cs} when alwaysHighlight' $ modify $ \s -> s {highlightedCompl = highlightedItem st cs}
------------------------------------------------------------------------
-- X Stuff -- X Stuff
-- | The completion windows in its entirety.
data ComplWindowDim = ComplWindowDim
{ cwX :: !Position -- ^ Starting x position
, cwY :: !Position -- ^ Starting y position
, cwWidth :: !Dimension -- ^ Width of the entire prompt
, cwRowHeight :: !Dimension -- ^ Height of a single row
, cwCols :: ![Position] -- ^ Starting position of all columns
, cwRows :: ![Position] -- ^ Starting positions of all rows
}
deriving (Eq)
updateWindows :: XP () updateWindows :: XP ()
updateWindows = do updateWindows = do
d <- gets dpy d <- gets dpy
@ -1488,17 +1501,12 @@ destroyComplWin = do
modify (\s -> s { complWin = Nothing, complWinDim = Nothing }) modify (\s -> s { complWin = Nothing, complWinDim = Nothing })
Nothing -> return () Nothing -> return ()
type ComplWindowDim = (Position,Position,Dimension,Dimension,Columns,Rows)
type Rows = [Position]
type Columns = [Position]
createComplWin :: ComplWindowDim -> XP Window createComplWin :: ComplWindowDim -> XP Window
createComplWin wi@(x,y,wh,ht,_,_) = do createComplWin wi@ComplWindowDim{ cwX, cwY, cwWidth, cwRowHeight } = do
st <- get st <- get
let d = dpy st let d = dpy st
scr = defaultScreenOfDisplay d scr = defaultScreenOfDisplay d
w <- io $ mkUnmanagedWindow d scr (rootw st) w <- io $ mkUnmanagedWindow d scr (rootw st) cwX cwY cwWidth cwRowHeight
x y wh ht
io $ mapWindow d w io $ mapWindow d w
setComplWin w wi setComplWin w wi
return w return w
@ -1537,7 +1545,7 @@ getComplWinDim compl = do
yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..] yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..]
xx = take (fi columns) [xp,(xp + fi column_width)..] xx = take (fi columns) [xp,(xp + fi column_width)..]
return (rect_x scr + x, rect_y scr + fi y, wh, actual_height, xx, yy) return $ ComplWindowDim (rect_x scr + x) (rect_y scr + fi y) wh actual_height xx yy
drawComplWin :: Window -> [String] -> XP () drawComplWin :: Window -> [String] -> XP ()
drawComplWin w compl = do drawComplWin w compl = do
@ -1551,16 +1559,16 @@ drawComplWin w compl = do
Just bgcolor <- io $ initColor d (bgNormal cr) Just bgcolor <- io $ initColor d (bgNormal cr)
Just borderC <- io $ initColor d (border cr) Just borderC <- io $ initColor d (border cr)
(_,_,wh,ht,xx,yy) <- getComplWinDim compl ComplWindowDim{cwWidth,cwRowHeight,cwCols,cwRows} <- getComplWinDim compl
p <- io $ createPixmap d w wh ht p <- io $ createPixmap d w cwWidth cwRowHeight
(defaultDepthOfScreen scr) (defaultDepthOfScreen scr)
io $ fillDrawable d p gc borderC bgcolor (fi bw) wh ht io $ fillDrawable d p gc borderC bgcolor (fi bw) cwWidth cwRowHeight
let ac = chunksOf (length yy) (take (length xx * length yy) compl) let ac = chunksOf (length cwRows) (take (length cwCols * length cwRows) compl)
printComplList d p gc (fgNormal cr) (bgNormal cr) xx yy ac printComplList d p gc (fgNormal cr) (bgNormal cr) cwCols cwRows ac
--lift $ spawn $ "xmessage " ++ " ac: " ++ show ac ++ " xx: " ++ show xx ++ " length xx: " ++ show (length xx) ++ " yy: " ++ show (length yy) --lift $ spawn $ "xmessage " ++ " ac: " ++ show ac ++ " xx: " ++ show xx ++ " length xx: " ++ show (length xx) ++ " yy: " ++ show (length yy)
io $ copyArea d p w gc 0 0 wh ht 0 0 io $ copyArea d p w gc 0 0 cwWidth cwRowHeight 0 0
io $ freePixmap d p io $ freePixmap d p
redrawComplWin :: [String] -> XP () redrawComplWin :: [String] -> XP ()