{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, TupleSections #-}
module XMonad.Actions.GridSelect (
GSConfig(..),
def,
TwoDPosition,
buildDefaultGSConfig,
gridselect,
gridselectWindow,
withSelectedWindow,
bringSelected,
goToSelected,
gridselectWorkspace,
gridselectWorkspace',
spawnSelected,
runSelectedAction,
HasColorizer(defaultColorizer),
fromClassName,
stringColorizer,
colorRangeFromClassName,
stringToRatio,
TwoD,
makeXEventhandler,
shadowWithKeymap,
defaultNavigation,
substringSearch,
navNSearch,
setPos,
move,
moveNext, movePrev,
select,
cancel,
transformSearchString,
Rearranger,
noRearranger,
searchStringRearrangerGenerator,
TwoDState,
) where
import Control.Arrow ((***))
import Data.Bits
import Data.Ord (comparing)
import Control.Monad.State
import Data.List as L
import qualified Data.Map as M
import XMonad hiding (liftX)
import XMonad.Prelude
import XMonad.Util.Font
import XMonad.Prompt (mkUnmanagedWindow)
import XMonad.StackSet as W
import XMonad.Layout.Decoration
import XMonad.Util.NamedWindows
import XMonad.Actions.WindowBringer (bringWindow)
import Text.Printf
import System.Random (mkStdGen, randomR)
import Data.Word (Word8)
import qualified Data.List.NonEmpty as NE
data GSConfig a = GSConfig {
forall a. GSConfig a -> Integer
gs_cellheight :: Integer,
forall a. GSConfig a -> Integer
gs_cellwidth :: Integer,
forall a. GSConfig a -> Integer
gs_cellpadding :: Integer,
forall a. GSConfig a -> a -> Bool -> X (String, String)
gs_colorizer :: a -> Bool -> X (String, String),
forall a. GSConfig a -> String
gs_font :: String,
forall a. GSConfig a -> TwoD a (Maybe a)
gs_navigate :: TwoD a (Maybe a),
forall a. GSConfig a -> Rearranger a
gs_rearranger :: Rearranger a,
forall a. GSConfig a -> Double
gs_originFractX :: Double,
forall a. GSConfig a -> Double
gs_originFractY :: Double,
forall a. GSConfig a -> String
gs_bordercolor :: String,
forall a. GSConfig a -> Bool
gs_cancelOnEmptyClick :: Bool
}
class HasColorizer a where
defaultColorizer :: a -> Bool -> X (String, String)
instance HasColorizer Window where
defaultColorizer :: Word64 -> Bool -> X (String, String)
defaultColorizer = Word64 -> Bool -> X (String, String)
fromClassName
instance HasColorizer String where
defaultColorizer :: String -> Bool -> X (String, String)
defaultColorizer = String -> Bool -> X (String, String)
stringColorizer
instance {-# OVERLAPPABLE #-} HasColorizer a where
defaultColorizer :: a -> Bool -> X (String, String)
defaultColorizer a
_ Bool
isFg =
let getColor :: XConfig l -> String
getColor = if Bool
isFg then forall (l :: * -> *). XConfig l -> String
focusedBorderColor else forall (l :: * -> *). XConfig l -> String
normalBorderColor
in forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ (, String
"black") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *). XConfig l -> String
getColor forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config
instance HasColorizer a => Default (GSConfig a) where
def :: GSConfig a
def = forall a. (a -> Bool -> X (String, String)) -> GSConfig a
buildDefaultGSConfig forall a. HasColorizer a => a -> Bool -> X (String, String)
defaultColorizer
type TwoDPosition = (Integer, Integer)
type TwoDElementMap a = [(TwoDPosition,(String,a))]
data TwoDState a = TwoDState { forall a. TwoDState a -> TwoDPosition
td_curpos :: TwoDPosition
, forall a. TwoDState a -> [TwoDPosition]
td_availSlots :: [TwoDPosition]
, forall a. TwoDState a -> [(String, a)]
td_elements :: [(String,a)]
, forall a. TwoDState a -> GSConfig a
td_gsconfig :: GSConfig a
, forall a. TwoDState a -> XMonadFont
td_font :: XMonadFont
, forall a. TwoDState a -> Integer
td_paneX :: Integer
, forall a. TwoDState a -> Integer
td_paneY :: Integer
, forall a. TwoDState a -> Word64
td_drawingWin :: Window
, forall a. TwoDState a -> String
td_searchString :: String
, forall a. TwoDState a -> TwoDElementMap a
td_elementmap :: TwoDElementMap a
}
generateElementmap :: TwoDState a -> X (TwoDElementMap a)
generateElementmap :: forall a. TwoDState a -> X (TwoDElementMap a)
generateElementmap TwoDState a
s = do
[(String, a)]
rearrangedElements <- Rearranger a
rearranger String
searchString [(String, a)]
sortedElements
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [TwoDPosition]
positions [(String, a)]
rearrangedElements
where
TwoDState {td_availSlots :: forall a. TwoDState a -> [TwoDPosition]
td_availSlots = [TwoDPosition]
positions,
td_gsconfig :: forall a. TwoDState a -> GSConfig a
td_gsconfig = GSConfig a
gsconfig,
td_searchString :: forall a. TwoDState a -> String
td_searchString = String
searchString} = TwoDState a
s
GSConfig {gs_rearranger :: forall a. GSConfig a -> Rearranger a
gs_rearranger = Rearranger a
rearranger} = GSConfig a
gsconfig
filteredElements :: [(String, a)]
filteredElements = forall a. (a -> Bool) -> [a] -> [a]
L.filter ((String
searchString String -> String -> Bool
`isInfixOfI`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a. TwoDState a -> [(String, a)]
td_elements TwoDState a
s)
sortedElements :: [(String, a)]
sortedElements = forall a. String -> [(String, a)] -> [(String, a)]
orderElementmap String
searchString [(String, a)]
filteredElements
String
needle isInfixOfI :: String -> String -> Bool
`isInfixOfI` String
haystack = String -> String
upper String
needle forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String -> String
upper String
haystack
upper :: String -> String
upper = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper
orderElementmap :: String -> [(String,a)] -> [(String,a)]
orderElementmap :: forall a. String -> [(String, a)] -> [(String, a)]
orderElementmap String
searchString [(String, a)]
elements = if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
searchString then [(String, a)]
sortedElements else [(String, a)]
elements
where
upper :: String -> String
upper = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper
calcScore :: (String, b) -> (Int, (String, b))
calcScore (String, b)
element = ( forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (String -> String
upper String
searchString)) (forall a. [a] -> [[a]]
tails forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
upper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ (String, b)
element)
, (String, b)
element)
compareScore :: (Int, (String, b)) -> (Int, (String, b)) -> Ordering
compareScore = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\(Int
score, (String
str,b
_)) -> (Int
score, String
str))
sortedElements :: [(String, a)]
sortedElements = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall {b}. (Int, (String, b)) -> (Int, (String, b)) -> Ordering
compareScore forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (String, b) -> (Int, (String, b))
calcScore [(String, a)]
elements
newtype TwoD a b = TwoD { forall a b. TwoD a b -> StateT (TwoDState a) X b
unTwoD :: StateT (TwoDState a) X b }
deriving (forall a b. a -> TwoD a b -> TwoD a a
forall a b. (a -> b) -> TwoD a a -> TwoD a b
forall a a b. a -> TwoD a b -> TwoD a a
forall a a b. (a -> b) -> TwoD a a -> TwoD a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TwoD a b -> TwoD a a
$c<$ :: forall a a b. a -> TwoD a b -> TwoD a a
fmap :: forall a b. (a -> b) -> TwoD a a -> TwoD a b
$cfmap :: forall a a b. (a -> b) -> TwoD a a -> TwoD a b
Functor, forall a. Functor (TwoD a)
forall a. a -> TwoD a a
forall a a. a -> TwoD a a
forall a b. TwoD a a -> TwoD a b -> TwoD a a
forall a b. TwoD a a -> TwoD a b -> TwoD a b
forall a b. TwoD a (a -> b) -> TwoD a a -> TwoD a b
forall a a b. TwoD a a -> TwoD a b -> TwoD a a
forall a a b. TwoD a a -> TwoD a b -> TwoD a b
forall a a b. TwoD a (a -> b) -> TwoD a a -> TwoD a b
forall a b c. (a -> b -> c) -> TwoD a a -> TwoD a b -> TwoD a c
forall a a b c. (a -> b -> c) -> TwoD a a -> TwoD a b -> TwoD a c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. TwoD a a -> TwoD a b -> TwoD a a
$c<* :: forall a a b. TwoD a a -> TwoD a b -> TwoD a a
*> :: forall a b. TwoD a a -> TwoD a b -> TwoD a b
$c*> :: forall a a b. TwoD a a -> TwoD a b -> TwoD a b
liftA2 :: forall a b c. (a -> b -> c) -> TwoD a a -> TwoD a b -> TwoD a c
$cliftA2 :: forall a a b c. (a -> b -> c) -> TwoD a a -> TwoD a b -> TwoD a c
<*> :: forall a b. TwoD a (a -> b) -> TwoD a a -> TwoD a b
$c<*> :: forall a a b. TwoD a (a -> b) -> TwoD a a -> TwoD a b
pure :: forall a. a -> TwoD a a
$cpure :: forall a a. a -> TwoD a a
Applicative, forall a. Applicative (TwoD a)
forall a. a -> TwoD a a
forall a a. a -> TwoD a a
forall a b. TwoD a a -> TwoD a b -> TwoD a b
forall a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b
forall a a b. TwoD a a -> TwoD a b -> TwoD a b
forall a a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> TwoD a a
$creturn :: forall a a. a -> TwoD a a
>> :: forall a b. TwoD a a -> TwoD a b -> TwoD a b
$c>> :: forall a a b. TwoD a a -> TwoD a b -> TwoD a b
>>= :: forall a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b
$c>>= :: forall a a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b
Monad, MonadState (TwoDState a))
liftX :: X a1 -> TwoD a a1
liftX :: forall a1 a. X a1 -> TwoD a a1
liftX = forall a b. StateT (TwoDState a) X b -> TwoD a b
TwoD forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
evalTwoD :: TwoD a1 a -> TwoDState a1 -> X a
evalTwoD :: forall a1 a. TwoD a1 a -> TwoDState a1 -> X a
evalTwoD TwoD a1 a
m TwoDState a1
s = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT TwoDState a1
s forall a b. (a -> b) -> a -> b
$ forall a b. TwoD a b -> StateT (TwoDState a) X b
unTwoD TwoD a1 a
m
diamondLayer :: (Enum a, Num a, Eq a) => a -> [(a, a)]
diamondLayer :: forall a. (Enum a, Num a, Eq a) => a -> [(a, a)]
diamondLayer a
0 = [(a
0,a
0)]
diamondLayer a
n =
let tr :: [(a, a)]
tr = [ (a
x,a
nforall a. Num a => a -> a -> a
-a
x) | a
x <- [a
0..a
nforall a. Num a => a -> a -> a
-a
1] ]
r :: [(a, a)]
r = [(a, a)]
tr forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(a
x,a
y) -> (a
y,-a
x)) [(a, a)]
tr
in [(a, a)]
r forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a
negate forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. Num a => a -> a
negate) [(a, a)]
r
diamond :: (Enum a, Num a, Eq a) => Stream (a, a)
diamond :: forall a. (Enum a, Num a, Eq a) => Stream (a, a)
diamond = forall l. IsList l => [Item l] -> l
fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. (Enum a, Num a, Eq a) => a -> [(a, a)]
diamondLayer [a
0..]
diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [TwoDPosition]
diamondRestrict Integer
x Integer
y Integer
originX Integer
originY =
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\(Integer
x',Integer
y') -> forall a. Num a => a -> a
abs Integer
x' forall a. Ord a => a -> a -> Bool
<= Integer
x Bool -> Bool -> Bool
&& forall a. Num a => a -> a
abs Integer
y' forall a. Ord a => a -> a -> Bool
<= Integer
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (\(Integer
x', Integer
y') -> (Integer
x' forall a. Num a => a -> a -> a
+ forall a. Num a => Integer -> a
fromInteger Integer
originX, Integer
y' forall a. Num a => a -> a -> a
+ forall a. Num a => Integer -> a
fromInteger Integer
originY)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Int -> Stream a -> [a]
takeS Int
1000 forall a b. (a -> b) -> a -> b
$ forall a. (Enum a, Num a, Eq a) => Stream (a, a)
diamond
findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
findInElementMap :: forall a b. Eq a => a -> [(a, b)] -> Maybe (a, b)
findInElementMap a
pos = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== a
pos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
drawWinBox :: Window -> XMonadFont -> (String, String) -> String -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
drawWinBox :: Word64
-> XMonadFont
-> (String, String)
-> String
-> Integer
-> Integer
-> String
-> Integer
-> Integer
-> Integer
-> X ()
drawWinBox Word64
win XMonadFont
font (String
fg,String
bg) String
bc Integer
ch Integer
cw String
text Integer
x Integer
y Integer
cp =
forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
GC
gc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Word64 -> IO GC
createGC Display
dpy Word64
win
GC
bordergc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Word64 -> IO GC
createGC Display
dpy Word64
win
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just Word64
fgcolor <- Display -> String -> IO (Maybe Word64)
initColor Display
dpy String
fg
Just Word64
bgcolor <- Display -> String -> IO (Maybe Word64)
initColor Display
dpy String
bg
Just Word64
bordercolor <- Display -> String -> IO (Maybe Word64)
initColor Display
dpy String
bc
Display -> GC -> Word64 -> IO ()
setForeground Display
dpy GC
gc Word64
fgcolor
Display -> GC -> Word64 -> IO ()
setBackground Display
dpy GC
gc Word64
bgcolor
Display -> GC -> Word64 -> IO ()
setForeground Display
dpy GC
bordergc Word64
bordercolor
Display
-> Word64
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
fillRectangle Display
dpy Word64
win GC
gc (forall a. Num a => Integer -> a
fromInteger Integer
x) (forall a. Num a => Integer -> a
fromInteger Integer
y) (forall a. Num a => Integer -> a
fromInteger Integer
cw) (forall a. Num a => Integer -> a
fromInteger Integer
ch)
Display
-> Word64
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
drawRectangle Display
dpy Word64
win GC
bordergc (forall a. Num a => Integer -> a
fromInteger Integer
x) (forall a. Num a => Integer -> a
fromInteger Integer
y) (forall a. Num a => Integer -> a
fromInteger Integer
cw) (forall a. Num a => Integer -> a
fromInteger Integer
ch)
String
stext <- (String -> [String]) -> (String -> X Bool) -> String -> X String
shrinkWhile (forall s. Shrinker s => s -> String -> [String]
shrinkIt DefaultShrinker
shrinkText)
(\String
n -> do Int
size <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
dpy XMonadFont
font String
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
size forall a. Ord a => a -> a -> Bool
> forall a. Num a => Integer -> a
fromInteger (Integer
cwforall a. Num a => a -> a -> a
-(Integer
2forall a. Num a => a -> a -> a
*Integer
cp)))
String
text
(Position
asc,Position
desc) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Position, Position)
textExtentsXMF XMonadFont
font String
stext
let offset :: Integer
offset = ((Integer
ch forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (Position
asc forall a. Num a => a -> a -> a
+ Position
desc)) forall a. Integral a => a -> a -> a
`div` Integer
2) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
asc
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> Word64
-> XMonadFont
-> GC
-> String
-> String
-> Position
-> Position
-> String
-> m ()
printStringXMF Display
dpy Word64
win XMonadFont
font GC
gc String
bg String
fg (forall a. Num a => Integer -> a
fromInteger (Integer
xforall a. Num a => a -> a -> a
+Integer
cp)) (forall a. Num a => Integer -> a
fromInteger (Integer
yforall a. Num a => a -> a -> a
+Integer
offset)) String
stext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> GC -> IO ()
freeGC Display
dpy GC
gc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> GC -> IO ()
freeGC Display
dpy GC
bordergc
updateAllElements :: TwoD a ()
updateAllElements :: forall a. TwoD a ()
updateAllElements =
do
TwoDState a
s <- forall s (m :: * -> *). MonadState s m => m s
get
forall a. TwoDElementMap a -> TwoD a ()
updateElements (forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s)
grayoutElements :: Int -> TwoD a ()
grayoutElements :: forall a. Int -> TwoD a ()
grayoutElements Int
skip =
do
TwoDState a
s <- forall s (m :: * -> *). MonadState s m => m s
get
forall a.
(a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
updateElementsWithColorizer forall {m :: * -> *} {p} {p}.
Monad m =>
p -> p -> m (String, String)
grayOnly forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
skip (forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s)
where grayOnly :: p -> p -> m (String, String)
grayOnly p
_ p
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (String
"#808080", String
"#808080")
updateElements :: TwoDElementMap a -> TwoD a ()
updateElements :: forall a. TwoDElementMap a -> TwoD a ()
updateElements TwoDElementMap a
elementmap = do
TwoDState a
s <- forall s (m :: * -> *). MonadState s m => m s
get
forall a.
(a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
updateElementsWithColorizer (forall a. GSConfig a -> a -> Bool -> X (String, String)
gs_colorizer (forall a. TwoDState a -> GSConfig a
td_gsconfig TwoDState a
s)) TwoDElementMap a
elementmap
updateElementsWithColorizer :: (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
updateElementsWithColorizer :: forall a.
(a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
updateElementsWithColorizer a -> Bool -> X (String, String)
colorizer TwoDElementMap a
elementmap = do
TwoDState { td_curpos :: forall a. TwoDState a -> TwoDPosition
td_curpos = TwoDPosition
curpos,
td_drawingWin :: forall a. TwoDState a -> Word64
td_drawingWin = Word64
win,
td_gsconfig :: forall a. TwoDState a -> GSConfig a
td_gsconfig = GSConfig a
gsconfig,
td_font :: forall a. TwoDState a -> XMonadFont
td_font = XMonadFont
font,
td_paneX :: forall a. TwoDState a -> Integer
td_paneX = Integer
paneX,
td_paneY :: forall a. TwoDState a -> Integer
td_paneY = Integer
paneY} <- forall s (m :: * -> *). MonadState s m => m s
get
let cellwidth :: Integer
cellwidth = forall a. GSConfig a -> Integer
gs_cellwidth GSConfig a
gsconfig
cellheight :: Integer
cellheight = forall a. GSConfig a -> Integer
gs_cellheight GSConfig a
gsconfig
paneX' :: Integer
paneX' = forall a. Integral a => a -> a -> a
div (Integer
paneXforall a. Num a => a -> a -> a
-Integer
cellwidth) Integer
2
paneY' :: Integer
paneY' = forall a. Integral a => a -> a -> a
div (Integer
paneYforall a. Num a => a -> a -> a
-Integer
cellheight) Integer
2
updateElement :: (TwoDPosition, (String, a)) -> TwoD a ()
updateElement (pos :: TwoDPosition
pos@(Integer
x,Integer
y),(String
text, a
element)) = forall a1 a. X a1 -> TwoD a a1
liftX forall a b. (a -> b) -> a -> b
$ do
(String, String)
colors <- a -> Bool -> X (String, String)
colorizer a
element (TwoDPosition
pos forall a. Eq a => a -> a -> Bool
== TwoDPosition
curpos)
Word64
-> XMonadFont
-> (String, String)
-> String
-> Integer
-> Integer
-> String
-> Integer
-> Integer
-> Integer
-> X ()
drawWinBox Word64
win XMonadFont
font
(String, String)
colors
(forall a. GSConfig a -> String
gs_bordercolor GSConfig a
gsconfig)
Integer
cellheight
Integer
cellwidth
String
text
(Integer
paneX'forall a. Num a => a -> a -> a
+Integer
xforall a. Num a => a -> a -> a
*Integer
cellwidth)
(Integer
paneY'forall a. Num a => a -> a -> a
+Integer
yforall a. Num a => a -> a -> a
*Integer
cellheight)
(forall a. GSConfig a -> Integer
gs_cellpadding GSConfig a
gsconfig)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a}. (TwoDPosition, (String, a)) -> TwoD a ()
updateElement TwoDElementMap a
elementmap
stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
stdHandle :: forall a. Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
stdHandle ButtonEvent{ ev_event_type :: Event -> Dimension
ev_event_type = Dimension
t, ev_x :: Event -> CInt
ev_x = CInt
x, ev_y :: Event -> CInt
ev_y = CInt
y } TwoD a (Maybe a)
contEventloop
| Dimension
t forall a. Eq a => a -> a -> Bool
== Dimension
buttonRelease = do
s :: TwoDState a
s@TwoDState{ td_paneX :: forall a. TwoDState a -> Integer
td_paneX = Integer
px
, td_paneY :: forall a. TwoDState a -> Integer
td_paneY = Integer
py
, td_gsconfig :: forall a. TwoDState a -> GSConfig a
td_gsconfig = GSConfig{ gs_cellheight :: forall a. GSConfig a -> Integer
gs_cellheight = Integer
ch
, gs_cellwidth :: forall a. GSConfig a -> Integer
gs_cellwidth = Integer
cw
, gs_cancelOnEmptyClick :: forall a. GSConfig a -> Bool
gs_cancelOnEmptyClick = Bool
cancelOnEmptyClick
}
} <- forall s (m :: * -> *). MonadState s m => m s
get
let gridX :: Integer
gridX = (forall a b. (Integral a, Num b) => a -> b
fi CInt
x forall a. Num a => a -> a -> a
- (Integer
px forall a. Num a => a -> a -> a
- Integer
cw) forall a. Integral a => a -> a -> a
`div` Integer
2) forall a. Integral a => a -> a -> a
`div` Integer
cw
gridY :: Integer
gridY = (forall a b. (Integral a, Num b) => a -> b
fi CInt
y forall a. Num a => a -> a -> a
- (Integer
py forall a. Num a => a -> a -> a
- Integer
ch) forall a. Integral a => a -> a -> a
`div` Integer
2) forall a. Integral a => a -> a -> a
`div` Integer
ch
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Integer
gridX,Integer
gridY) (forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s) of
Just (String
_,a
el) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
el)
Maybe (String, a)
Nothing -> if Bool
cancelOnEmptyClick
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else TwoD a (Maybe a)
contEventloop
| Bool
otherwise = TwoD a (Maybe a)
contEventloop
stdHandle ExposeEvent{} TwoD a (Maybe a)
contEventloop = forall a. TwoD a ()
updateAllElements forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
contEventloop
stdHandle Event
_ TwoD a (Maybe a)
contEventloop = TwoD a (Maybe a)
contEventloop
makeXEventhandler :: ((KeySym, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
makeXEventhandler :: forall a.
((Word64, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
makeXEventhandler (Word64, String, KeyMask) -> TwoD a (Maybe a)
keyhandler = forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \TwoD a (Maybe a)
me -> forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a1 a. X a1 -> TwoD a a1
liftX forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
Display -> Word64 -> XEventPtr -> IO ()
maskEvent Display
d (Word64
exposureMask forall a. Bits a => a -> a -> a
.|. Word64
keyPressMask forall a. Bits a => a -> a -> a
.|. Word64
buttonReleaseMask) XEventPtr
e
Event
ev <- XEventPtr -> IO Event
getEvent XEventPtr
e
if Event -> Dimension
ev_event_type Event
ev forall a. Eq a => a -> a -> Bool
== Dimension
keyPress
then do
(Maybe Word64
_, String
s) <- XKeyEventPtr -> IO (Maybe Word64, String)
lookupString forall a b. (a -> b) -> a -> b
$ XEventPtr -> XKeyEventPtr
asKeyEvent XEventPtr
e
Word64
ks <- Display -> Word8 -> CInt -> IO Word64
keycodeToKeysym Display
d (Event -> Word8
ev_keycode Event
ev) CInt
0
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
KeyMask
mask <- forall a1 a. X a1 -> TwoD a a1
liftX forall a b. (a -> b) -> a -> b
$ X (KeyMask -> KeyMask)
cleanKeyMask forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event -> KeyMask
ev_state Event
ev)
(Word64, String, KeyMask) -> TwoD a (Maybe a)
keyhandler (Word64
ks, String
s, KeyMask
mask)
else
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
stdHandle Event
ev TwoD a (Maybe a)
me
shadowWithKeymap :: M.Map (KeyMask, KeySym) a -> ((KeySym, String, KeyMask) -> a) -> (KeySym, String, KeyMask) -> a
shadowWithKeymap :: forall a.
Map (KeyMask, Word64) a
-> ((Word64, String, KeyMask) -> a)
-> (Word64, String, KeyMask)
-> a
shadowWithKeymap Map (KeyMask, Word64) a
keymap (Word64, String, KeyMask) -> a
dflt keyEvent :: (Word64, String, KeyMask)
keyEvent@(Word64
ks,String
_,KeyMask
m') = forall a. a -> Maybe a -> a
fromMaybe ((Word64, String, KeyMask) -> a
dflt (Word64, String, KeyMask)
keyEvent) (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (KeyMask
m',Word64
ks) Map (KeyMask, Word64) a
keymap)
select :: TwoD a (Maybe a)
select :: forall a. TwoD a (Maybe a)
select = do
TwoDState a
s <- forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe (a, b)
findInElementMap (forall a. TwoDState a -> TwoDPosition
td_curpos TwoDState a
s) (forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s)
cancel :: TwoD a (Maybe a)
cancel :: forall a. TwoD a (Maybe a)
cancel = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
setPos :: (Integer, Integer) -> TwoD a ()
setPos :: forall a. TwoDPosition -> TwoD a ()
setPos TwoDPosition
newPos = do
TwoDState a
s <- forall s (m :: * -> *). MonadState s m => m s
get
let elmap :: TwoDElementMap a
elmap = forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s
newSelectedEl :: Maybe (TwoDPosition, (String, a))
newSelectedEl = forall a b. Eq a => a -> [(a, b)] -> Maybe (a, b)
findInElementMap TwoDPosition
newPos (forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s)
oldPos :: TwoDPosition
oldPos = forall a. TwoDState a -> TwoDPosition
td_curpos TwoDState a
s
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (TwoDPosition, (String, a))
newSelectedEl Bool -> Bool -> Bool
&& TwoDPosition
newPos forall a. Eq a => a -> a -> Bool
/= TwoDPosition
oldPos) forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *). MonadState s m => s -> m ()
put TwoDState a
s { td_curpos :: TwoDPosition
td_curpos = TwoDPosition
newPos }
forall a. TwoDElementMap a -> TwoD a ()
updateElements (forall a. [Maybe a] -> [a]
catMaybes [forall a b. Eq a => a -> [(a, b)] -> Maybe (a, b)
findInElementMap TwoDPosition
oldPos TwoDElementMap a
elmap, Maybe (TwoDPosition, (String, a))
newSelectedEl])
move :: (Integer, Integer) -> TwoD a ()
move :: forall a. TwoDPosition -> TwoD a ()
move (Integer
dx,Integer
dy) = do
TwoDState a
s <- forall s (m :: * -> *). MonadState s m => m s
get
let (Integer
x,Integer
y) = forall a. TwoDState a -> TwoDPosition
td_curpos TwoDState a
s
newPos :: TwoDPosition
newPos = (Integer
xforall a. Num a => a -> a -> a
+Integer
dx,Integer
yforall a. Num a => a -> a -> a
+Integer
dy)
forall a. TwoDPosition -> TwoD a ()
setPos TwoDPosition
newPos
moveNext :: TwoD a ()
moveNext :: forall a. TwoD a ()
moveNext = do
TwoDPosition
position <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TwoDState a -> TwoDPosition
td_curpos
TwoDElementMap a
elems <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TwoDState a -> TwoDElementMap a
td_elementmap
let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length TwoDElementMap a
elems
m :: Maybe Int
m = case forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(TwoDPosition, (String, a))
p -> forall a b. (a, b) -> a
fst (TwoDPosition, (String, a))
p forall a. Eq a => a -> a -> Bool
== TwoDPosition
position) TwoDElementMap a
elems of
Maybe Int
Nothing -> forall a. Maybe a
Nothing
Just Int
k | Int
k forall a. Eq a => a -> a -> Bool
== Int
nforall a. Num a => a -> a -> a
-Int
1 -> forall a. a -> Maybe a
Just Int
0
| Bool
otherwise -> forall a. a -> Maybe a
Just (Int
kforall a. Num a => a -> a -> a
+Int
1)
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Int
m forall a b. (a -> b) -> a -> b
$ \Int
i ->
forall a. TwoDPosition -> TwoD a ()
setPos (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ TwoDElementMap a
elems forall a. [a] -> Int -> a
!! Int
i)
movePrev :: TwoD a ()
movePrev :: forall a. TwoD a ()
movePrev = do
TwoDPosition
position <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TwoDState a -> TwoDPosition
td_curpos
TwoDElementMap a
elems <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. TwoDState a -> TwoDElementMap a
td_elementmap
let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length TwoDElementMap a
elems
m :: Maybe Int
m = case forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(TwoDPosition, (String, a))
p -> forall a b. (a, b) -> a
fst (TwoDPosition, (String, a))
p forall a. Eq a => a -> a -> Bool
== TwoDPosition
position) TwoDElementMap a
elems of
Maybe Int
Nothing -> forall a. Maybe a
Nothing
Just Int
0 -> forall a. a -> Maybe a
Just (Int
nforall a. Num a => a -> a -> a
-Int
1)
Just Int
k -> forall a. a -> Maybe a
Just (Int
kforall a. Num a => a -> a -> a
-Int
1)
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Int
m forall a b. (a -> b) -> a -> b
$ \Int
i ->
forall a. TwoDPosition -> TwoD a ()
setPos (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ TwoDElementMap a
elems forall a. [a] -> Int -> a
!! Int
i)
transformSearchString :: (String -> String) -> TwoD a ()
transformSearchString :: forall a. (String -> String) -> TwoD a ()
transformSearchString String -> String
f = do
TwoDState a
s <- forall s (m :: * -> *). MonadState s m => m s
get
let oldSearchString :: String
oldSearchString = forall a. TwoDState a -> String
td_searchString TwoDState a
s
newSearchString :: String
newSearchString = String -> String
f String
oldSearchString
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
newSearchString forall a. Eq a => a -> a -> Bool
/= String
oldSearchString) forall a b. (a -> b) -> a -> b
$ do
let s' :: TwoDState a
s' = TwoDState a
s { td_searchString :: String
td_searchString = String
newSearchString }
TwoDElementMap a
m <- forall a1 a. X a1 -> TwoD a a1
liftX forall a b. (a -> b) -> a -> b
$ forall a. TwoDState a -> X (TwoDElementMap a)
generateElementmap TwoDState a
s'
let s'' :: TwoDState a
s'' = TwoDState a
s' { td_elementmap :: TwoDElementMap a
td_elementmap = TwoDElementMap a
m }
oldLen :: Int
oldLen = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s
newLen :: Int
newLen = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. TwoDState a -> TwoDElementMap a
td_elementmap TwoDState a
s''
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
newLen forall a. Ord a => a -> a -> Bool
< Int
oldLen) forall a b. (a -> b) -> a -> b
$ forall a. Int -> TwoD a ()
grayoutElements Int
newLen
forall s (m :: * -> *). MonadState s m => s -> m ()
put TwoDState a
s''
forall a. TwoD a ()
updateAllElements
defaultNavigation :: TwoD a (Maybe a)
defaultNavigation :: forall a. TwoD a (Maybe a)
defaultNavigation = forall a.
((Word64, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
makeXEventhandler forall a b. (a -> b) -> a -> b
$ forall a.
Map (KeyMask, Word64) a
-> ((Word64, String, KeyMask) -> a)
-> (Word64, String, KeyMask)
-> a
shadowWithKeymap forall {a}. Map (KeyMask, Word64) (TwoD a (Maybe a))
navKeyMap forall {b} {a}. b -> TwoD a (Maybe a)
navDefaultHandler
where navKeyMap :: Map (KeyMask, Word64) (TwoD a (Maybe a))
navKeyMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
((KeyMask
0,Word64
xK_Escape) , forall a. TwoD a (Maybe a)
cancel)
,((KeyMask
0,Word64
xK_Return) , forall a. TwoD a (Maybe a)
select)
,((KeyMask
0,Word64
xK_slash) , forall a. TwoD a (Maybe a) -> TwoD a (Maybe a)
substringSearch forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
0,Word64
xK_Left) , forall a. TwoDPosition -> TwoD a ()
move (-Integer
1,Integer
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
0,Word64
xK_h) , forall a. TwoDPosition -> TwoD a ()
move (-Integer
1,Integer
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
0,Word64
xK_Right) , forall a. TwoDPosition -> TwoD a ()
move (Integer
1,Integer
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
0,Word64
xK_l) , forall a. TwoDPosition -> TwoD a ()
move (Integer
1,Integer
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
0,Word64
xK_Down) , forall a. TwoDPosition -> TwoD a ()
move (Integer
0,Integer
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
0,Word64
xK_j) , forall a. TwoDPosition -> TwoD a ()
move (Integer
0,Integer
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
0,Word64
xK_Up) , forall a. TwoDPosition -> TwoD a ()
move (Integer
0,-Integer
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
0,Word64
xK_k) , forall a. TwoDPosition -> TwoD a ()
move (Integer
0,-Integer
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
0,Word64
xK_Tab) , forall a. TwoD a ()
moveNext forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
0,Word64
xK_n) , forall a. TwoD a ()
moveNext forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
shiftMask,Word64
xK_Tab), forall a. TwoD a ()
movePrev forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
,((KeyMask
0,Word64
xK_p) , forall a. TwoD a ()
movePrev forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
defaultNavigation)
]
navDefaultHandler :: b -> TwoD a (Maybe a)
navDefaultHandler = forall a b. a -> b -> a
const forall a. TwoD a (Maybe a)
defaultNavigation
navNSearch :: TwoD a (Maybe a)
navNSearch :: forall a. TwoD a (Maybe a)
navNSearch = forall a.
((Word64, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
makeXEventhandler forall a b. (a -> b) -> a -> b
$ forall a.
Map (KeyMask, Word64) a
-> ((Word64, String, KeyMask) -> a)
-> (Word64, String, KeyMask)
-> a
shadowWithKeymap forall {a}. Map (KeyMask, Word64) (TwoD a (Maybe a))
navNSearchKeyMap forall {a} {c} {a}. (a, String, c) -> TwoD a (Maybe a)
navNSearchDefaultHandler
where navNSearchKeyMap :: Map (KeyMask, Word64) (TwoD a (Maybe a))
navNSearchKeyMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
((KeyMask
0,Word64
xK_Escape) , forall a. TwoD a (Maybe a)
cancel)
,((KeyMask
0,Word64
xK_Return) , forall a. TwoD a (Maybe a)
select)
,((KeyMask
0,Word64
xK_Left) , forall a. TwoDPosition -> TwoD a ()
move (-Integer
1,Integer
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
navNSearch)
,((KeyMask
0,Word64
xK_Right) , forall a. TwoDPosition -> TwoD a ()
move (Integer
1,Integer
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
navNSearch)
,((KeyMask
0,Word64
xK_Down) , forall a. TwoDPosition -> TwoD a ()
move (Integer
0,Integer
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
navNSearch)
,((KeyMask
0,Word64
xK_Up) , forall a. TwoDPosition -> TwoD a ()
move (Integer
0,-Integer
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
navNSearch)
,((KeyMask
0,Word64
xK_Tab) , forall a. TwoD a ()
moveNext forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
navNSearch)
,((KeyMask
shiftMask,Word64
xK_Tab), forall a. TwoD a ()
movePrev forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
navNSearch)
,((KeyMask
0,Word64
xK_BackSpace), forall a. (String -> String) -> TwoD a ()
transformSearchString (\String
s -> if String
s forall a. Eq a => a -> a -> Bool
== String
"" then String
"" else forall a. [a] -> [a]
init String
s) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TwoD a (Maybe a)
navNSearch)
]
navNSearchDefaultHandler :: (a, String, c) -> TwoD a (Maybe a)
navNSearchDefaultHandler (a
_,String
s,c
_) = do
forall a. (String -> String) -> TwoD a ()
transformSearchString (forall a. [a] -> [a] -> [a]
++ String
s)
forall a. TwoD a (Maybe a)
navNSearch
substringSearch :: TwoD a (Maybe a) -> TwoD a (Maybe a)
substringSearch :: forall a. TwoD a (Maybe a) -> TwoD a (Maybe a)
substringSearch TwoD a (Maybe a)
returnNavigation = forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \TwoD a (Maybe a)
me ->
let searchKeyMap :: Map (KeyMask, Word64) (TwoD a (Maybe a))
searchKeyMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
((KeyMask
0,Word64
xK_Escape) , forall a. (String -> String) -> TwoD a ()
transformSearchString (forall a b. a -> b -> a
const String
"") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
returnNavigation)
,((KeyMask
0,Word64
xK_Return) , TwoD a (Maybe a)
returnNavigation)
,((KeyMask
0,Word64
xK_BackSpace), forall a. (String -> String) -> TwoD a ()
transformSearchString (\String
s -> if String
s forall a. Eq a => a -> a -> Bool
== String
"" then String
"" else forall a. [a] -> [a]
init String
s) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TwoD a (Maybe a)
me)
]
searchDefaultHandler :: (a, String, c) -> TwoD a (Maybe a)
searchDefaultHandler (a
_,String
s,c
_) = do
forall a. (String -> String) -> TwoD a ()
transformSearchString (forall a. [a] -> [a] -> [a]
++ String
s)
TwoD a (Maybe a)
me
in forall a.
((Word64, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
makeXEventhandler forall a b. (a -> b) -> a -> b
$ forall a.
Map (KeyMask, Word64) a
-> ((Word64, String, KeyMask) -> a)
-> (Word64, String, KeyMask)
-> a
shadowWithKeymap Map (KeyMask, Word64) (TwoD a (Maybe a))
searchKeyMap forall {a} {c}. (a, String, c) -> TwoD a (Maybe a)
searchDefaultHandler
hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
hsv2rgb :: forall a. Fractional a => (Integer, a, a) -> (a, a, a)
hsv2rgb (Integer
h,a
s,a
v) =
let hi :: Integer
hi = forall a. Integral a => a -> a -> a
div Integer
h Integer
60 forall a. Integral a => a -> a -> a
`mod` Integer
6 :: Integer
f :: a
f = ((forall a. Num a => Integer -> a
fromInteger Integer
hforall a. Fractional a => a -> a -> a
/a
60) forall a. Num a => a -> a -> a
- forall a. Num a => Integer -> a
fromInteger Integer
hi) :: Fractional a => a
q :: a
q = a
v forall a. Num a => a -> a -> a
* (a
1forall a. Num a => a -> a -> a
-a
f)
p :: a
p = a
v forall a. Num a => a -> a -> a
* (a
1forall a. Num a => a -> a -> a
-a
s)
t :: a
t = a
v forall a. Num a => a -> a -> a
* (a
1forall a. Num a => a -> a -> a
-(a
1forall a. Num a => a -> a -> a
-a
f)forall a. Num a => a -> a -> a
*a
s)
in case Integer
hi of
Integer
0 -> (a
v,a
t,a
p)
Integer
1 -> (a
q,a
v,a
p)
Integer
2 -> (a
p,a
v,a
t)
Integer
3 -> (a
p,a
q,a
v)
Integer
4 -> (a
t,a
p,a
v)
Integer
5 -> (a
v,a
p,a
q)
Integer
_ -> forall a. HasCallStack => String -> a
error String
"The world is ending. x mod a >= a."
stringColorizer :: String -> Bool -> X (String, String)
stringColorizer :: String -> Bool -> X (String, String)
stringColorizer String
s Bool
active =
let seed :: Int -> Integer
seed Int
x = forall a. Integral a => a -> Integer
toInteger (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Num a => a -> a -> a
*Int
x)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Enum a => a -> Int
fromEnum) String
s) :: Integer
(Double
r,Double
g,Double
b) = forall a. Fractional a => (Integer, a, a) -> (a, a, a)
hsv2rgb (Int -> Integer
seed Int
83 forall a. Integral a => a -> a -> a
`mod` Integer
360,
forall a. Num a => Integer -> a
fromInteger (Int -> Integer
seed Int
191 forall a. Integral a => a -> a -> a
`mod` Integer
1000)forall a. Fractional a => a -> a -> a
/Double
2500forall a. Num a => a -> a -> a
+Double
0.4,
forall a. Num a => Integer -> a
fromInteger (Int -> Integer
seed Int
121 forall a. Integral a => a -> a -> a
`mod` Integer
1000)forall a. Fractional a => a -> a -> a
/Double
2500forall a. Num a => a -> a -> a
+Double
0.4)
in if Bool
active
then forall (m :: * -> *) a. Monad m => a -> m a
return (String
"#faff69", String
"black")
else forall (m :: * -> *) a. Monad m => a -> m a
return (String
"#" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Word8 -> String
twodigitHexforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a b. (RealFrac a, Integral b) => a -> b
round :: Double -> Word8)forall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a. Num a => a -> a -> a
*Double
256)) [Double
r, Double
g, Double
b], String
"white")
fromClassName :: Window -> Bool -> X (String, String)
fromClassName :: Word64 -> Bool -> X (String, String)
fromClassName Word64
w Bool
active = forall a. Query a -> Word64 -> X a
runQuery Query String
className Word64
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. HasColorizer a => a -> Bool -> X (String, String)
defaultColorizer Bool
active
twodigitHex :: Word8 -> String
twodigitHex :: Word8 -> String
twodigitHex = forall r. PrintfType r => String -> r
printf String
"%02x"
colorRangeFromClassName :: (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> Window -> Bool -> X (String, String)
colorRangeFromClassName :: (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> (Word8, Word8, Word8)
-> Word64
-> Bool
-> X (String, String)
colorRangeFromClassName (Word8, Word8, Word8)
startC (Word8, Word8, Word8)
endC (Word8, Word8, Word8)
activeC (Word8, Word8, Word8)
inactiveT (Word8, Word8, Word8)
activeT Word64
w Bool
active =
do String
classname <- forall a. Query a -> Word64 -> X a
runQuery Query String
className Word64
w
if Bool
active
then forall (m :: * -> *) a. Monad m => a -> m a
return ((Word8, Word8, Word8) -> String
rgbToHex (Word8, Word8, Word8)
activeC, (Word8, Word8, Word8) -> String
rgbToHex (Word8, Word8, Word8)
activeT)
else forall (m :: * -> *) a. Monad m => a -> m a
return ((Word8, Word8, Word8) -> String
rgbToHex forall a b. (a -> b) -> a -> b
$ (Word8, Word8, Word8)
-> (Word8, Word8, Word8) -> Double -> (Word8, Word8, Word8)
mix (Word8, Word8, Word8)
startC (Word8, Word8, Word8)
endC
forall a b. (a -> b) -> a -> b
$ String -> Double
stringToRatio String
classname, (Word8, Word8, Word8) -> String
rgbToHex (Word8, Word8, Word8)
inactiveT)
where rgbToHex :: (Word8, Word8, Word8) -> String
rgbToHex :: (Word8, Word8, Word8) -> String
rgbToHex (Word8
r, Word8
g, Word8
b) = Char
'#'forall a. a -> [a] -> [a]
:Word8 -> String
twodigitHex Word8
r
forall a. [a] -> [a] -> [a]
++Word8 -> String
twodigitHex Word8
gforall a. [a] -> [a] -> [a]
++Word8 -> String
twodigitHex Word8
b
mix :: (Word8, Word8, Word8) -> (Word8, Word8, Word8)
-> Double -> (Word8, Word8, Word8)
mix :: (Word8, Word8, Word8)
-> (Word8, Word8, Word8) -> Double -> (Word8, Word8, Word8)
mix (Word8
r1, Word8
g1, Word8
b1) (Word8
r2, Word8
g2, Word8
b2) Double
r = (forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
a -> a -> b
mix' Word8
r1 Word8
r2, forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
a -> a -> b
mix' Word8
g1 Word8
g2, forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
a -> a -> b
mix' Word8
b1 Word8
b2)
where mix' :: a -> a -> b
mix' a
a a
b = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fi a
a forall a. Num a => a -> a -> a
* Double
r) forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi a
b forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
- Double
r))
stringToRatio :: String -> Double
stringToRatio :: String -> Double
stringToRatio String
"" = Double
0
stringToRatio String
s = let gen :: StdGen
gen = Int -> StdGen
mkStdGen forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
t Char
c -> Int
t forall a. Num a => a -> a -> a
* Int
31 forall a. Num a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum Char
c) Int
0 String
s
in forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Double
0, Double
1) StdGen
gen
gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a)
gridselect :: forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
gridselect GSConfig a
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
gridselect GSConfig a
gsconfig [(String, a)]
elements =
forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
Word64
rootw <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Word64
theRoot
Rectangle
scr <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
Word64
win <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display
-> Screen
-> Word64
-> Position
-> Position
-> Dimension
-> Dimension
-> IO Word64
mkUnmanagedWindow Display
dpy (Display -> Screen
defaultScreenOfDisplay Display
dpy) Word64
rootw
(Rectangle -> Position
rect_x Rectangle
scr) (Rectangle -> Position
rect_y Rectangle
scr) (Rectangle -> Dimension
rect_width Rectangle
scr) (Rectangle -> Dimension
rect_height Rectangle
scr)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Word64 -> IO ()
mapWindow Display
dpy Word64
win
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Word64 -> Word64 -> IO ()
selectInput Display
dpy Word64
win (Word64
exposureMask forall a. Bits a => a -> a -> a
.|. Word64
keyPressMask forall a. Bits a => a -> a -> a
.|. Word64
buttonReleaseMask)
CInt
status <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Word64 -> Bool -> CInt -> CInt -> Word64 -> IO CInt
grabKeyboard Display
dpy Word64
win Bool
True CInt
grabModeAsync CInt
grabModeAsync Word64
currentTime
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Word64
-> Bool
-> Word64
-> CInt
-> CInt
-> Word64
-> Word64
-> Word64
-> IO CInt
grabPointer Display
dpy Word64
win Bool
True Word64
buttonReleaseMask CInt
grabModeAsync CInt
grabModeAsync Word64
none Word64
none Word64
currentTime
XMonadFont
font <- String -> X XMonadFont
initXMF (forall a. GSConfig a -> String
gs_font GSConfig a
gsconfig)
let screenWidth :: Integer
screenWidth = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_width Rectangle
scr
screenHeight :: Integer
screenHeight = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_height Rectangle
scr
Maybe a
selectedElement <- if CInt
status forall a. Eq a => a -> a -> Bool
== CInt
grabSuccess then do
let restriction :: Integer -> (GSConfig a -> Integer) -> Double
restriction Integer
ss GSConfig a -> Integer
cs = (forall a. Num a => Integer -> a
fromInteger Integer
ssforall a. Fractional a => a -> a -> a
/forall a. Num a => Integer -> a
fromInteger (GSConfig a -> Integer
cs GSConfig a
gsconfig)forall a. Num a => a -> a -> a
-Double
1)forall a. Fractional a => a -> a -> a
/Double
2 :: Double
restrictX :: Integer
restrictX = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Integer -> (GSConfig a -> Integer) -> Double
restriction Integer
screenWidth forall a. GSConfig a -> Integer
gs_cellwidth
restrictY :: Integer
restrictY = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Integer -> (GSConfig a -> Integer) -> Double
restriction Integer
screenHeight forall a. GSConfig a -> Integer
gs_cellheight
originPosX :: Integer
originPosX = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ (forall a. GSConfig a -> Double
gs_originFractX GSConfig a
gsconfig forall a. Num a => a -> a -> a
- (Double
1forall a. Fractional a => a -> a -> a
/Double
2)) forall a. Num a => a -> a -> a
* Double
2 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
restrictX
originPosY :: Integer
originPosY = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ (forall a. GSConfig a -> Double
gs_originFractY GSConfig a
gsconfig forall a. Num a => a -> a -> a
- (Double
1forall a. Fractional a => a -> a -> a
/Double
2)) forall a. Num a => a -> a -> a
* Double
2 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
restrictY
coords :: [TwoDPosition]
coords = Integer -> Integer -> Integer -> Integer -> [TwoDPosition]
diamondRestrict Integer
restrictX Integer
restrictY Integer
originPosX Integer
originPosY
s :: TwoDState a
s = TwoDState { td_curpos :: TwoDPosition
td_curpos = forall a. NonEmpty a -> a
NE.head (forall a. HasCallStack => [a] -> NonEmpty a
notEmpty [TwoDPosition]
coords),
td_availSlots :: [TwoDPosition]
td_availSlots = [TwoDPosition]
coords,
td_elements :: [(String, a)]
td_elements = [(String, a)]
elements,
td_gsconfig :: GSConfig a
td_gsconfig = GSConfig a
gsconfig,
td_font :: XMonadFont
td_font = XMonadFont
font,
td_paneX :: Integer
td_paneX = Integer
screenWidth,
td_paneY :: Integer
td_paneY = Integer
screenHeight,
td_drawingWin :: Word64
td_drawingWin = Word64
win,
td_searchString :: String
td_searchString = String
"",
td_elementmap :: TwoDElementMap a
td_elementmap = [] }
TwoDElementMap a
m <- forall a. TwoDState a -> X (TwoDElementMap a)
generateElementmap TwoDState a
s
forall a1 a. TwoD a1 a -> TwoDState a1 -> X a
evalTwoD (forall a. TwoD a ()
updateAllElements forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. GSConfig a -> TwoD a (Maybe a)
gs_navigate GSConfig a
gsconfig)
(TwoDState a
s { td_elementmap :: TwoDElementMap a
td_elementmap = TwoDElementMap a
m })
else
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Display -> Word64 -> IO ()
unmapWindow Display
dpy Word64
win
Display -> Word64 -> IO ()
destroyWindow Display
dpy Word64
win
Display -> Word64 -> IO ()
ungrabPointer Display
dpy Word64
currentTime
Display -> Bool -> IO ()
sync Display
dpy Bool
False
XMonadFont -> X ()
releaseXMF XMonadFont
font
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
selectedElement
gridselectWindow :: GSConfig Window -> X (Maybe Window)
gridselectWindow :: GSConfig Word64 -> X (Maybe Word64)
gridselectWindow GSConfig Word64
gsconf = X [(String, Word64)]
windowMap forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
gridselect GSConfig Word64
gsconf
withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
withSelectedWindow :: (Word64 -> X ()) -> GSConfig Word64 -> X ()
withSelectedWindow Word64 -> X ()
callback GSConfig Word64
conf = do
Maybe Word64
mbWindow <- GSConfig Word64 -> X (Maybe Word64)
gridselectWindow GSConfig Word64
conf
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Word64
mbWindow Word64 -> X ()
callback
windowMap :: X [(String,Window)]
windowMap :: X [(String, Word64)]
windowMap = do
WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Word64 -> X (String, Word64)
keyValuePair (forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
ws)
where keyValuePair :: Word64 -> X (String, Word64)
keyValuePair Word64
w = (, Word64
w) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> X String
decorateName' Word64
w
decorateName' :: Window -> X String
decorateName' :: Word64 -> X String
decorateName' Word64
w = do
forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> X NamedWindow
getName Word64
w
buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
buildDefaultGSConfig :: forall a. (a -> Bool -> X (String, String)) -> GSConfig a
buildDefaultGSConfig a -> Bool -> X (String, String)
col = forall a.
Integer
-> Integer
-> Integer
-> (a -> Bool -> X (String, String))
-> String
-> TwoD a (Maybe a)
-> Rearranger a
-> Double
-> Double
-> String
-> Bool
-> GSConfig a
GSConfig Integer
50 Integer
130 Integer
10 a -> Bool -> X (String, String)
col String
"xft:Sans-8" forall a. TwoD a (Maybe a)
defaultNavigation forall a. Rearranger a
noRearranger (Double
1forall a. Fractional a => a -> a -> a
/Double
2) (Double
1forall a. Fractional a => a -> a -> a
/Double
2) String
"white" Bool
True
bringSelected :: GSConfig Window -> X ()
bringSelected :: GSConfig Word64 -> X ()
bringSelected = (Word64 -> X ()) -> GSConfig Word64 -> X ()
withSelectedWindow forall a b. (a -> b) -> a -> b
$ \Word64
w -> do
(WindowSet -> WindowSet) -> X ()
windows (Word64 -> WindowSet -> WindowSet
bringWindow Word64
w)
Word64 -> X ()
XMonad.focus Word64
w
(WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster
goToSelected :: GSConfig Window -> X ()
goToSelected :: GSConfig Word64 -> X ()
goToSelected = (Word64 -> X ()) -> GSConfig Word64 -> X ()
withSelectedWindow forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow
spawnSelected :: GSConfig String -> [String] -> X ()
spawnSelected :: GSConfig String -> [String] -> X ()
spawnSelected GSConfig String
conf [String]
lst = forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
gridselect GSConfig String
conf (forall a b. [a] -> [b] -> [(a, b)]
zip [String]
lst [String]
lst) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust forall (m :: * -> *). MonadIO m => String -> m ()
spawn
runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X ()
runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X ()
runSelectedAction GSConfig (X ())
conf [(String, X ())]
actions = do
Maybe (X ())
selectedActionM <- forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
gridselect GSConfig (X ())
conf [(String, X ())]
actions
case Maybe (X ())
selectedActionM of
Just X ()
selectedAction -> X ()
selectedAction
Maybe (X ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
gridselectWorkspace :: GSConfig WorkspaceId ->
(WorkspaceId -> WindowSet -> WindowSet) -> X ()
gridselectWorkspace :: GSConfig String -> (String -> WindowSet -> WindowSet) -> X ()
gridselectWorkspace GSConfig String
conf String -> WindowSet -> WindowSet
viewFunc = GSConfig String -> (String -> X ()) -> X ()
gridselectWorkspace' GSConfig String
conf ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> WindowSet -> WindowSet
viewFunc)
gridselectWorkspace' :: GSConfig WorkspaceId -> (WorkspaceId -> X ()) -> X ()
gridselectWorkspace' :: GSConfig String -> (String -> X ()) -> X ()
gridselectWorkspace' GSConfig String
conf String -> X ()
func = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> do
let wss :: [String]
wss = forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
W.tag forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden WindowSet
ws forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws forall a. a -> [a] -> [a]
: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
ws)
forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
gridselect GSConfig String
conf (forall a b. [a] -> [b] -> [(a, b)]
zip [String]
wss [String]
wss) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust String -> X ()
func
type Rearranger a = String -> [(String, a)] -> X [(String, a)]
noRearranger :: Rearranger a
noRearranger :: forall a. Rearranger a
noRearranger String
_ = forall (m :: * -> *) a. Monad m => a -> m a
return
searchStringRearrangerGenerator :: (String -> a) -> Rearranger a
searchStringRearrangerGenerator :: forall a. (String -> a) -> Rearranger a
searchStringRearrangerGenerator String -> a
f =
let r :: String -> [(String, a)] -> m [(String, a)]
r String
"" [(String, a)]
xs = forall (m :: * -> *) a. Monad m => a -> m a
return [(String, a)]
xs
r String
s [(String, a)]
xs | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, a)]
xs = forall (m :: * -> *) a. Monad m => a -> m a
return [(String, a)]
xs
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(String, a)]
xs forall a. [a] -> [a] -> [a]
++ [(String
s, String -> a
f String
s)]
in forall {m :: * -> *}.
Monad m =>
String -> [(String, a)] -> m [(String, a)]
r