twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-01 20:51:52 -07:00
Code Issues Packages Projects Releases Wiki Activity

GridSelect: remove tabs

Browse Source
This commit is contained in:
Roman Cheplyaka
2008-11-11 05:36:47 +00:00
parent dcde384f1a
commit a5ffb70fc6
1 changed files with 61 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

122
XMonad/Actions/GridSelect.hs
View File

@@ -60,11 +60,11 @@ data GSConfig = GSConfig {
type TwoDPosition = (Integer, Integer) type TwoDPosition = (Integer, Integer)
data TwoDState = TwoDState { td_curpos :: TwoDPosition, data TwoDState = TwoDState { td_curpos :: TwoDPosition,
td_windowmap :: [(TwoDPosition,(String,Window))], td_windowmap :: [(TwoDPosition,(String,Window))],
td_gsconfig :: GSConfig, td_gsconfig :: GSConfig,
td_font :: XMonadFont, td_font :: XMonadFont,
td_paneX :: Integer, td_paneX :: Integer,
td_paneY :: Integer } td_paneY :: Integer }
type TwoD a = StateT TwoDState X a type TwoD a = StateT TwoDState X a
@@ -72,8 +72,8 @@ type TwoD a = StateT TwoDState X a
diamondLayer :: (Enum b', Num b') => b' -> [(b', b')] diamondLayer :: (Enum b', Num b') => b' -> [(b', b')]
-- FIXME remove nub -- FIXME remove nub
diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ] diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ]
in nub $ ul ++ (map (negate *** id) ul) ++ in nub $ ul ++ (map (negate *** id) ul) ++
(map (negate *** negate) ul) ++ (map (negate *** negate) ul) ++
(map (id *** negate) ul) (map (id *** negate) ul)
diamond :: (Enum a, Num a) => [(a, a)] diamond :: (Enum a, Num a) => [(a, a)]
@@ -87,9 +87,9 @@ diamond = concatMap diamondLayer [0..]
diamondRestrict :: (Enum t, Num t, Ord t) => t -> t -> [(t, t)] diamondRestrict :: (Enum t, Num t, Ord t) => t -> t -> [(t, t)]
diamondRestrict x y = L.filter f diamond diamondRestrict x y = L.filter f diamond
where f (x',y') = (x' <= x) && where f (x',y') = (x' <= x) &&
(x' >= -x) && (x' >= -x) &&
(y' <= y) && (y' <= y) &&
(y' >= -y) (y' >= -y)
tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1) tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1)
tupadd (a,b) (c,d) = (a+c,b+d) tupadd (a,b) (c,d) = (a+c,b+d)
@@ -110,9 +110,9 @@ drawWinBox dpy win font (fg,bg) ch cw text x y cp = do
fillRectangle dpy win gc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch) fillRectangle dpy win gc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch) drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
stext <- shrinkWhile (shrinkIt shrinkText) stext <- shrinkWhile (shrinkIt shrinkText)
(\n -> do size <- liftIO $ textWidthXMF dpy font n (\n -> do size <- liftIO $ textWidthXMF dpy font n
return $ size > (fromInteger (cw-(2*cp)))) return $ size > (fromInteger (cw-(2*cp))))
text text
printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext
liftIO $ freeGC dpy gc liftIO $ freeGC dpy gc
liftIO $ freeGC dpy bordergc liftIO $ freeGC dpy bordergc
@@ -121,30 +121,30 @@ updateWindows :: Display -> Window -> TwoD ()
updateWindows dpy win = do updateWindows dpy win = do
(TwoDState curpos windowList gsconfig font paneX paneY) <- get (TwoDState curpos windowList gsconfig font paneX paneY) <- get
let cellwidth = gs_cellwidth gsconfig let cellwidth = gs_cellwidth gsconfig
cellheight = gs_cellheight gsconfig cellheight = gs_cellheight gsconfig
paneX' = div (paneX-cellwidth) 2 paneX' = div (paneX-cellwidth) 2
paneY' = div (paneY-cellheight) 2 paneY' = div (paneY-cellheight) 2
updateWindow (pos@(x,y),(text, clientwindow)) = lift $ do updateWindow (pos@(x,y),(text, clientwindow)) = lift $ do
colors <- (gs_colorizer gsconfig) clientwindow (pos == curpos) colors <- (gs_colorizer gsconfig) clientwindow (pos == curpos)
drawWinBox dpy win font drawWinBox dpy win font
colors colors
(gs_cellheight gsconfig) (gs_cellheight gsconfig)
(gs_cellwidth gsconfig) text (gs_cellwidth gsconfig) text
(paneX'+x*cellwidth) (paneX'+x*cellwidth)
(paneY'+y*cellheight) (paneY'+y*cellheight)
(gs_cellpadding gsconfig) (gs_cellpadding gsconfig)
mapM updateWindow windowList mapM updateWindow windowList
return () return ()
eventLoop :: Display -> Window -> TwoD (Maybe Window) eventLoop :: Display -> Window -> TwoD (Maybe Window)
eventLoop d win = do eventLoop d win = do
(keysym,string,event) <- liftIO $ allocaXEvent $ \e -> do (keysym,string,event) <- liftIO $ allocaXEvent $ \e -> do
nextEvent d e nextEvent d e
ev <- getEvent e ev <- getEvent e
(ks,s) <- if ev_event_type ev == keyPress (ks,s) <- if ev_event_type ev == keyPress
then lookupString $ asKeyEvent e then lookupString $ asKeyEvent e
else return (Nothing, "") else return (Nothing, "")
return (ks,s,ev) return (ks,s,ev)
handle d win (fromMaybe xK_VoidSymbol keysym,string) event handle d win (fromMaybe xK_VoidSymbol keysym,string) event
handle :: Display handle :: Display
@@ -162,10 +162,10 @@ handle d win (ks,_) (KeyEvent {ev_event_type = t})
(TwoDState pos win' _ _ _ _) <- get (TwoDState pos win' _ _ _ _) <- get
return $ fmap (snd . snd) $ find ((== pos) . fst) win' return $ fmap (snd . snd) $ find ((== pos) . fst) win'
where diffAndRefresh diff = do where diffAndRefresh diff = do
(TwoDState pos windowlist gsconfig font paneX paneY) <- get (TwoDState pos windowlist gsconfig font paneX paneY) <- get
put $ TwoDState (pos `tupadd` diff) windowlist gsconfig font paneX paneY put $ TwoDState (pos `tupadd` diff) windowlist gsconfig font paneX paneY
updateWindows d win updateWindows d win
eventLoop d win eventLoop d win
handle d win _ _ = do handle d win _ _ = do
updateWindows d win updateWindows d win
@@ -176,26 +176,26 @@ handle d win _ _ = do
hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a) hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
hsv2rgb (h,s,v) = hsv2rgb (h,s,v) =
let hi = (div h 60) `mod` 6 :: Integer let hi = (div h 60) `mod` 6 :: Integer
f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a
q = v * (1-f) q = v * (1-f)
p = v * (1-s) p = v * (1-s)
t = v * (1-(1-f)*s) t = v * (1-(1-f)*s)
in case hi of in case hi of
0 -> (v,t,p) 0 -> (v,t,p)
1 -> (q,v,p) 1 -> (q,v,p)
2 -> (p,v,t) 2 -> (p,v,t)
3 -> (p,q,v) 3 -> (p,q,v)
4 -> (t,p,v) 4 -> (t,p,v)
5 -> (v,p,q) 5 -> (v,p,q)
_ -> error "The world is ending. x mod a >= a." _ -> error "The world is ending. x mod a >= a."
default_colorizer :: Window -> Bool -> X (String, String) default_colorizer :: Window -> Bool -> X (String, String)
default_colorizer w active = do default_colorizer w active = do
classname <- runQuery className w classname <- runQuery className w
let seed x = toInteger (sum $ map ((*x).fromEnum) classname) :: Integer let seed x = toInteger (sum $ map ((*x).fromEnum) classname) :: Integer
(r,g,b) = hsv2rgb ((seed 83) `mod` 360, (r,g,b) = hsv2rgb ((seed 83) `mod` 360,
(fromInteger ((seed 191) `mod` 1000))/2500+0.4, (fromInteger ((seed 191) `mod` 1000))/2500+0.4,
(fromInteger ((seed 121) `mod` 1000))/2500+0.4) (fromInteger ((seed 121) `mod` 1000))/2500+0.4)
if active if active
then return ("#faff69", "black") then return ("#faff69", "black")
else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Integer).(*256)) [r, g, b] ), "white") else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Integer).(*256)) [r, g, b] ), "white")
@@ -218,21 +218,21 @@ gridselect gsconfig =
status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime
font <- initXMF (gs_font gsconfig) font <- initXMF (gs_font gsconfig)
let screenWidth = toInteger $ rect_width s; let screenWidth = toInteger $ rect_width s;
screenHeight = toInteger $ rect_height s; screenHeight = toInteger $ rect_height s;
selectedWindow <- if (status == grabSuccess) then selectedWindow <- if (status == grabSuccess) then
do do
let restrictX = floor $ ((fromInteger screenWidth)/(fromInteger $ gs_cellwidth gsconfig)-1)/2 ; let restrictX = floor $ ((fromInteger screenWidth)/(fromInteger $ gs_cellwidth gsconfig)-1)/2 ;
restrictY = floor $ ((fromInteger screenHeight)/(fromInteger $ gs_cellheight gsconfig)-1)/2 ; restrictY = floor $ ((fromInteger screenHeight)/(fromInteger $ gs_cellheight gsconfig)-1)/2 ;
selectedWindow <- evalStateT (do updateWindows dpy win; eventLoop dpy win) selectedWindow <- evalStateT (do updateWindows dpy win; eventLoop dpy win)
(TwoDState (0,0) (TwoDState (0,0)
(zipWith (,) (diamondRestrict restrictX restrictY) windowList) (zipWith (,) (diamondRestrict restrictX restrictY) windowList)
gsconfig gsconfig
font font
screenWidth screenWidth
screenHeight) screenHeight)
return selectedWindow return selectedWindow
else else
return Nothing return Nothing
liftIO $ do liftIO $ do
unmapWindow dpy win unmapWindow dpy win
destroyWindow dpy win destroyWindow dpy win