add customization for prompt position

This commit is contained in:
Bogdan Sinitsyn
2015-12-28 14:49:36 +03:00
parent cc7ddcfa60
commit edd6b8be55

View File

@@ -228,6 +228,8 @@ class XPrompt t where
data XPPosition = Top data XPPosition = Top
| Bottom | Bottom
| CenteredAt { xpHeight :: Rational
, xpWidth :: Rational }
deriving (Show,Read) deriving (Show,Read)
amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig
@@ -842,8 +844,12 @@ createWin d rw c s = do
let (x,y) = case position c of let (x,y) = case position c of
Top -> (0,0) Top -> (0,0)
Bottom -> (0, rect_height s - height c) Bottom -> (0, rect_height s - height c)
CenteredAt py w -> (floor $ fi (rect_width s) * ((1 - w) / 2), floor $ py * fi (rect_height s))
width = case position c of
CenteredAt _ w -> floor $ fi (rect_width s) * w
_ -> rect_width s
w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw
(rect_x s + x) (rect_y s + fi y) (rect_width s) (height c) (rect_x s + x) (rect_y s + fi y) width (height c)
mapWindow d w mapWindow d w
return w return w
@@ -935,7 +941,9 @@ getComplWinDim :: [String] -> XP ComplWindowDim
getComplWinDim compl = do getComplWinDim compl = do
st <- get st <- get
let (c,(scr,fs)) = (config &&& screen &&& fontS) st let (c,(scr,fs)) = (config &&& screen &&& fontS) st
wh = rect_width scr wh = case position c of
CenteredAt _ w -> floor $ fi (rect_width scr) * w
_ -> rect_width scr
ht = height c ht = height c
tws <- mapM (textWidthXMF (dpy st) fs) compl tws <- mapM (textWidthXMF (dpy st) fs) compl
@@ -953,6 +961,7 @@ getComplWinDim compl = do
(x,y) = case position c of (x,y) = case position c of
Top -> (0,ht) Top -> (0,ht)
Bottom -> (0, (0 + rem_height - actual_height)) Bottom -> (0, (0 + rem_height - actual_height))
CenteredAt py w -> (floor $ fi (rect_width scr) * ((1 - w) / 2), ht + floor (py * fi (rect_height scr)))
(asc,desc) <- io $ textExtentsXMF fs $ head compl (asc,desc) <- io $ textExtentsXMF fs $ head compl
let yp = fi $ (ht + fi (asc - desc)) `div` 2 let yp = fi $ (ht + fi (asc - desc)) `div` 2
xp = (asc + desc) `div` 2 xp = (asc + desc) `div` 2