X.Prompt: Calculate prompt width once at the start

At the moment, we re-calculate the prompt width every time we want
to (re)draw the prompt window.  This is unnecessary, as the screen
dimensions or the preferred position changing _while the prompt is
active_ is extremely unlikely.

This now calculates the desired width at the start of the prompts event
loop and threads it through to the places that need it.
This commit is contained in:
slotThe 2021-04-17 12:44:05 +02:00
parent 5bc0d9d777
commit f76318ce5f

View File

@ -133,6 +133,7 @@ data XPState =
, rootw :: !Window , rootw :: !Window
, win :: !Window , win :: !Window
, screen :: !Rectangle , screen :: !Rectangle
, winWidth :: !Dimension -- ^ Width of the prompt window
, complWinDim :: Maybe ComplWindowDim , complWinDim :: Maybe ComplWindowDim
, complIndex :: !(Int,Int) , complIndex :: !(Int,Int)
, complWin :: IORef (Maybe Window) , complWin :: IORef (Maybe Window)
@ -355,12 +356,14 @@ amberXPConfig = def { bgColor = "black"
} }
initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode
-> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> XPState -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> Dimension
initState d rw w s opMode gc fonts h c nm = -> XPState
initState d rw w s opMode gc fonts h c nm width =
XPS { dpy = d XPS { dpy = d
, rootw = rw , rootw = rw
, win = w , win = w
, screen = s , screen = s
, winWidth = width
, complWinDim = Nothing , complWinDim = Nothing
, complWin = unsafePerformIO (newIORef Nothing) , complWin = unsafePerformIO (newIORef Nothing)
, showComplWin = not (showCompletionOnTab c) , showComplWin = not (showCompletionOnTab c)
@ -555,9 +558,10 @@ mkXPromptImplementation historyKey conf om = do
cachedir <- asks (cacheDir . directories) cachedir <- asks (cacheDir . directories)
hist <- io $ readHistory cachedir hist <- io $ readHistory cachedir
fs <- initXMF (font conf) fs <- initXMF (font conf)
let width = getWinWidth s (position conf)
st' <- io $ st' <- io $
bracket bracket
(createPromptWin d rw conf s) (createPromptWin d rw conf s width)
(destroyWindow d) (destroyWindow d)
(\w -> (\w ->
bracket bracket
@ -567,7 +571,7 @@ mkXPromptImplementation historyKey conf om = do
selectInput d w $ exposureMask .|. keyPressMask selectInput d w $ exposureMask .|. keyPressMask
setGraphicsExposures d gc False setGraphicsExposures d gc False
let hs = fromMaybe [] $ M.lookup historyKey hist let hs = fromMaybe [] $ M.lookup historyKey hist
st = initState d rw w s om gc fs hs conf numlock st = initState d rw w s om gc fs hs conf numlock width
runXP st)) runXP st))
releaseXMF fs releaseXMF fs
when (successful st') $ do when (successful st') $ do
@ -582,6 +586,13 @@ mkXPromptImplementation historyKey conf om = do
(prune $ historyFilter conf [selectedCompletion st']) (prune $ historyFilter conf [selectedCompletion st'])
hist hist
return st' return st'
where
-- | Based on the ultimate position of the prompt and the screen
-- dimensions, calculate its width.
getWinWidth :: Rectangle -> XPPosition -> Dimension
getWinWidth scr = \case
CenteredAt{ xpWidth } -> floor $ fi (rect_width scr) * xpWidth
_ -> rect_width scr
-- | Removes numlock and capslock from a keymask. -- | Removes numlock and capslock from a keymask.
-- Duplicate of cleanMask from core, but in the -- Duplicate of cleanMask from core, but in the
@ -1383,8 +1394,8 @@ data ComplWindowDim = ComplWindowDim
deriving (Eq) deriving (Eq)
-- | Create the prompt window. -- | Create the prompt window.
createPromptWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window createPromptWin :: Display -> Window -> XPConfig -> Rectangle -> Dimension -> IO Window
createPromptWin dpy rootw XPC{ position, height } scn = do createPromptWin dpy rootw XPC{ position, height } scn width = do
w <- mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw w <- mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw
(rect_x scn + x) (rect_y scn + y) width height (rect_x scn + x) (rect_y scn + y) width height
setClassHint dpy w (ClassHint "xmonad-prompt" "xmonad") setClassHint dpy w (ClassHint "xmonad-prompt" "xmonad")
@ -1398,9 +1409,6 @@ createPromptWin dpy rootw XPC{ position, height } scn = do
( floor $ fi (rect_width scn) * ((1 - w) / 2) ( floor $ fi (rect_width scn) * ((1 - w) / 2)
, floor $ py * fi (rect_height scn) - (fi height / 2) , floor $ py * fi (rect_height scn) - (fi height / 2)
) )
width :: Dimension = case position of
CenteredAt _ w -> floor $ fi (rect_width scn) * w
_ -> rect_width scn
-- | Update the state of the completion window. -- | Update the state of the completion window.
updateComplWin :: Maybe Window -> Maybe ComplWindowDim -> XP () updateComplWin :: Maybe Window -> Maybe ComplWindowDim -> XP ()
@ -1429,19 +1437,17 @@ redrawWindows emptyAction compls = do
where where
-- | Draw the main prompt window. -- | Draw the main prompt window.
drawWin :: XP () = do drawWin :: XP () = do
XPS{ config, color, dpy, win, gcon } <- get XPS{ color, dpy, win, gcon, winWidth } <- get
XPC{ height, promptBorderWidth } <- gets config
let scr = defaultScreenOfDisplay dpy let scr = defaultScreenOfDisplay dpy
width = case position config of ht = height -- height of a single row
CenteredAt _ wd -> floor $ wd * fi (widthOfScreen scr) bw = promptBorderWidth
_ -> widthOfScreen scr
ht = height config -- height of a single row
bw = promptBorderWidth config
Just bgcolor <- io $ initColor dpy (bgNormal color) Just bgcolor <- io $ initColor dpy (bgNormal color)
Just borderC <- io $ initColor dpy (border color) Just borderC <- io $ initColor dpy (border color)
pm <- io $ createPixmap dpy win width ht (defaultDepthOfScreen scr) pm <- io $ createPixmap dpy win winWidth ht (defaultDepthOfScreen scr)
io $ fillDrawable dpy pm gcon borderC bgcolor (fi bw) width ht io $ fillDrawable dpy pm gcon borderC bgcolor (fi bw) winWidth ht
printPrompt pm printPrompt pm
io $ copyArea dpy pm win gcon 0 0 width ht 0 0 io $ copyArea dpy pm win gcon 0 0 winWidth ht 0 0
io $ freePixmap dpy pm io $ freePixmap dpy pm
-- | Redraw the completion window, if necessary. -- | Redraw the completion window, if necessary.
@ -1528,11 +1534,8 @@ destroyComplWin = do
-- required dimensions for the completion windows. -- required dimensions for the completion windows.
getComplWinDim :: [String] -> XP ComplWindowDim getComplWinDim :: [String] -> XP ComplWindowDim
getComplWinDim compl = do getComplWinDim compl = do
XPS{ config = cfg, screen = scr, fontS = fs, dpy } <- get XPS{ config = cfg, screen = scr, fontS = fs, dpy, winWidth } <- get
let winWidth = case position cfg of let -- Height of a single completion row
CenteredAt{ xpWidth } -> floor $ fi (rect_width scr) * xpWidth
_ -> rect_width scr
-- Height of a single completion row
ht = height cfg ht = height cfg
bw = promptBorderWidth cfg bw = promptBorderWidth cfg