module SelectionF where
import FudUTF8(decodeUTF8,encodeUTF8)
import Command
import CompOps((>=^<), (>^=<))
import Cont(conts,cmdContK')
import Shells(unmappedShellF)
import Event
import Fudget
import FRequest
import Xcommand
import GetWindowProperty
import InternAtom
import NullF
import LayoutF(nullLF)
import Spops(putSP,getSP)
import Loops(loopThroughRightF)
import EitherUtils(stripEither)
import SerCompF(absF)
import Xtypes
data SelCmd a = Sel a | ClearSel | PasteSel deriving (SelCmd a -> SelCmd a -> Bool
forall a. Eq a => SelCmd a -> SelCmd a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelCmd a -> SelCmd a -> Bool
$c/= :: forall a. Eq a => SelCmd a -> SelCmd a -> Bool
== :: SelCmd a -> SelCmd a -> Bool
$c== :: forall a. Eq a => SelCmd a -> SelCmd a -> Bool
Eq, SelCmd a -> SelCmd a -> Bool
SelCmd a -> SelCmd a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (SelCmd a)
forall a. Ord a => SelCmd a -> SelCmd a -> Bool
forall a. Ord a => SelCmd a -> SelCmd a -> Ordering
forall a. Ord a => SelCmd a -> SelCmd a -> SelCmd a
min :: SelCmd a -> SelCmd a -> SelCmd a
$cmin :: forall a. Ord a => SelCmd a -> SelCmd a -> SelCmd a
max :: SelCmd a -> SelCmd a -> SelCmd a
$cmax :: forall a. Ord a => SelCmd a -> SelCmd a -> SelCmd a
>= :: SelCmd a -> SelCmd a -> Bool
$c>= :: forall a. Ord a => SelCmd a -> SelCmd a -> Bool
> :: SelCmd a -> SelCmd a -> Bool
$c> :: forall a. Ord a => SelCmd a -> SelCmd a -> Bool
<= :: SelCmd a -> SelCmd a -> Bool
$c<= :: forall a. Ord a => SelCmd a -> SelCmd a -> Bool
< :: SelCmd a -> SelCmd a -> Bool
$c< :: forall a. Ord a => SelCmd a -> SelCmd a -> Bool
compare :: SelCmd a -> SelCmd a -> Ordering
$ccompare :: forall a. Ord a => SelCmd a -> SelCmd a -> Ordering
Ord)
data SelEvt a = LostSel | SelNotify a deriving (SelEvt a -> SelEvt a -> Bool
forall a. Eq a => SelEvt a -> SelEvt a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelEvt a -> SelEvt a -> Bool
$c/= :: forall a. Eq a => SelEvt a -> SelEvt a -> Bool
== :: SelEvt a -> SelEvt a -> Bool
$c== :: forall a. Eq a => SelEvt a -> SelEvt a -> Bool
Eq, SelEvt a -> SelEvt a -> Bool
SelEvt a -> SelEvt a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (SelEvt a)
forall a. Ord a => SelEvt a -> SelEvt a -> Bool
forall a. Ord a => SelEvt a -> SelEvt a -> Ordering
forall a. Ord a => SelEvt a -> SelEvt a -> SelEvt a
min :: SelEvt a -> SelEvt a -> SelEvt a
$cmin :: forall a. Ord a => SelEvt a -> SelEvt a -> SelEvt a
max :: SelEvt a -> SelEvt a -> SelEvt a
$cmax :: forall a. Ord a => SelEvt a -> SelEvt a -> SelEvt a
>= :: SelEvt a -> SelEvt a -> Bool
$c>= :: forall a. Ord a => SelEvt a -> SelEvt a -> Bool
> :: SelEvt a -> SelEvt a -> Bool
$c> :: forall a. Ord a => SelEvt a -> SelEvt a -> Bool
<= :: SelEvt a -> SelEvt a -> Bool
$c<= :: forall a. Ord a => SelEvt a -> SelEvt a -> Bool
< :: SelEvt a -> SelEvt a -> Bool
$c< :: forall a. Ord a => SelEvt a -> SelEvt a -> Bool
compare :: SelEvt a -> SelEvt a -> Ordering
$ccompare :: forall a. Ord a => SelEvt a -> SelEvt a -> Ordering
Ord)
data ESelCmd a = OwnSel | SelCmd (SelCmd a) deriving (ESelCmd a -> ESelCmd a -> Bool
forall a. Eq a => ESelCmd a -> ESelCmd a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ESelCmd a -> ESelCmd a -> Bool
$c/= :: forall a. Eq a => ESelCmd a -> ESelCmd a -> Bool
== :: ESelCmd a -> ESelCmd a -> Bool
$c== :: forall a. Eq a => ESelCmd a -> ESelCmd a -> Bool
Eq, ESelCmd a -> ESelCmd a -> Bool
ESelCmd a -> ESelCmd a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ESelCmd a)
forall a. Ord a => ESelCmd a -> ESelCmd a -> Bool
forall a. Ord a => ESelCmd a -> ESelCmd a -> Ordering
forall a. Ord a => ESelCmd a -> ESelCmd a -> ESelCmd a
min :: ESelCmd a -> ESelCmd a -> ESelCmd a
$cmin :: forall a. Ord a => ESelCmd a -> ESelCmd a -> ESelCmd a
max :: ESelCmd a -> ESelCmd a -> ESelCmd a
$cmax :: forall a. Ord a => ESelCmd a -> ESelCmd a -> ESelCmd a
>= :: ESelCmd a -> ESelCmd a -> Bool
$c>= :: forall a. Ord a => ESelCmd a -> ESelCmd a -> Bool
> :: ESelCmd a -> ESelCmd a -> Bool
$c> :: forall a. Ord a => ESelCmd a -> ESelCmd a -> Bool
<= :: ESelCmd a -> ESelCmd a -> Bool
$c<= :: forall a. Ord a => ESelCmd a -> ESelCmd a -> Bool
< :: ESelCmd a -> ESelCmd a -> Bool
$c< :: forall a. Ord a => ESelCmd a -> ESelCmd a -> Bool
compare :: ESelCmd a -> ESelCmd a -> Ordering
$ccompare :: forall a. Ord a => ESelCmd a -> ESelCmd a -> Ordering
Ord)
data ESelEvt a = WantSel | SelEvt (SelEvt a) deriving (ESelEvt a -> ESelEvt a -> Bool
forall a. Eq a => ESelEvt a -> ESelEvt a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ESelEvt a -> ESelEvt a -> Bool
$c/= :: forall a. Eq a => ESelEvt a -> ESelEvt a -> Bool
== :: ESelEvt a -> ESelEvt a -> Bool
$c== :: forall a. Eq a => ESelEvt a -> ESelEvt a -> Bool
Eq, ESelEvt a -> ESelEvt a -> Bool
ESelEvt a -> ESelEvt a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ESelEvt a)
forall a. Ord a => ESelEvt a -> ESelEvt a -> Bool
forall a. Ord a => ESelEvt a -> ESelEvt a -> Ordering
forall a. Ord a => ESelEvt a -> ESelEvt a -> ESelEvt a
min :: ESelEvt a -> ESelEvt a -> ESelEvt a
$cmin :: forall a. Ord a => ESelEvt a -> ESelEvt a -> ESelEvt a
max :: ESelEvt a -> ESelEvt a -> ESelEvt a
$cmax :: forall a. Ord a => ESelEvt a -> ESelEvt a -> ESelEvt a
>= :: ESelEvt a -> ESelEvt a -> Bool
$c>= :: forall a. Ord a => ESelEvt a -> ESelEvt a -> Bool
> :: ESelEvt a -> ESelEvt a -> Bool
$c> :: forall a. Ord a => ESelEvt a -> ESelEvt a -> Bool
<= :: ESelEvt a -> ESelEvt a -> Bool
$c<= :: forall a. Ord a => ESelEvt a -> ESelEvt a -> Bool
< :: ESelEvt a -> ESelEvt a -> Bool
$c< :: forall a. Ord a => ESelEvt a -> ESelEvt a -> Bool
compare :: ESelEvt a -> ESelEvt a -> Ordering
$ccompare :: forall a. Ord a => ESelEvt a -> ESelEvt a -> Ordering
Ord)
eselectionF :: F (ESelCmd String) (ESelEvt String)
eselectionF :: F (ESelCmd String) (ESelEvt String)
eselectionF =
(forall {a}. Either a a -> a
stripEither forall a b e. (a -> b) -> F e a -> F e b
>^=< forall {t :: * -> *} {a} {b} {c} {d}.
Foldable t =>
t FRequest -> K a b -> F c d -> F (Either a c) (Either b d)
unmappedShellF [] K (ESelCmd String) (ESelEvt String)
selK forall {hi} {ho}. F hi ho
nullLF) forall c d e. F c d -> (e -> c) -> F e d
>=^<
forall a b. a -> Either a b
Left where
selK :: K (ESelCmd String) (ESelEvt String)
selK =
forall a c b. (a -> Cont c b) -> [a] -> Cont c [b]
conts (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {b} {c}. String -> Bool -> Cont (K b c) Atom
internAtomK Bool
True)
[String
"PRIMARY", String
"STRING", String
"NONE", String
"ATOM"] forall a b. (a -> b) -> a -> b
$
\ [Atom
primaryA, Atom
stringA, Atom
noneA, Atom
atomA] ->
forall a c b. (a -> Cont c b) -> [a] -> Cont c [b]
conts (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {b} {c}. String -> Bool -> Cont (K b c) Atom
internAtomK Bool
False) [String
"FUDGETS_UTF8",String
"UTF8_STRING"] forall a b. (a -> b) -> a -> b
$
\ [Atom
fudgetsA, Atom
utf8A] -> let
sevt :: SelEvt a -> Message a (ESelEvt a)
sevt = forall a b. b -> Message a b
Highforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SelEvt a -> ESelEvt a
SelEvt
l :: K (ESelCmd String) (ESelEvt String)
l =
forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ \KEvent (ESelCmd String)
ev ->
case KEvent (ESelCmd String)
ev of
High ESelCmd String
esc -> case ESelCmd String
esc of
SelCmd SelCmd String
sc -> case SelCmd String
sc of
Sel String
t -> K (ESelCmd String) (ESelEvt String)
l
SelCmd String
ClearSel -> K (ESelCmd String) (ESelEvt String)
deselect
SelCmd String
PasteSel -> K (ESelCmd String) (ESelEvt String)
paste_utf8string
ESelCmd String
OwnSel -> K (ESelCmd String) (ESelEvt String)
select
Low (XEvt XEvent
ev) -> case XEvent
ev of
SelectionClear Atom
s | Atom
s forall a. Eq a => a -> a -> Bool
== Atom
primaryA -> forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a}. SelEvt a -> Message a (ESelEvt a)
sevt forall a. SelEvt a
LostSel) K (ESelCmd String) (ESelEvt String)
l
SelectionRequest Time
t Window
w Selection
s -> Time -> Window -> Selection -> K (ESelCmd String) (ESelEvt String)
selectionrequest Time
t Window
w Selection
s
SelectionNotify Time
t Selection
s -> Selection -> K (ESelCmd String) (ESelEvt String)
selectionnotify Selection
s
XEvent
_ -> K (ESelCmd String) (ESelEvt String)
l
Low FResponse
_ -> K (ESelCmd String) (ESelEvt String)
l
selectionrequest :: Time -> Window -> Selection -> K (ESelCmd String) (ESelEvt String)
selectionrequest Time
time Window
w sel :: Selection
sel@(Selection Atom
s Atom
t Atom
p) =
if Atom
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Atom
stringA,Atom
utf8A]
then forall {i} {o}. Time -> Window -> Selection -> K i o -> K i o
notify Time
time Window
w (Atom -> Atom -> Atom -> Selection
Selection Atom
s Atom
noneA Atom
p) K (ESelCmd String) (ESelEvt String)
l
else
let p' :: Atom
p' = if Atom
p forall a. Eq a => a -> a -> Bool
== Atom
noneA then Atom
t else Atom
p
wait :: Message a (ESelCmd a) -> Maybe a
wait (High (SelCmd (Sel a
t))) = forall a. a -> Maybe a
Just a
t
wait Message a (ESelCmd a)
_ = forall a. Maybe a
Nothing
in forall {ho} {hi} {a}.
KCommand ho -> (KEvent hi -> Maybe a) -> Cont (K hi ho) a
cmdContK' (forall a b. b -> Message a b
High forall a. ESelEvt a
WantSel) forall {a} {a}. Message a (ESelCmd a) -> Maybe a
wait forall a b. (a -> b) -> a -> b
$ \String
rawtext ->
let text :: String
text = if Atom
tforall a. Eq a => a -> a -> Bool
==Atom
utf8A
then String -> String
encodeUTF8 String
rawtext
else String
rawtext in
forall {i} {o}. XCommand -> K i o -> K i o
xcommandK (Window
-> Atom -> Atom -> Time -> PropertyMode -> String -> XCommand
ChangeProperty Window
w Atom
p' Atom
t Time
8 PropertyMode
propModeReplace String
text) forall a b. (a -> b) -> a -> b
$
forall {i} {o}. Time -> Window -> Selection -> K i o -> K i o
notify Time
time Window
w (Atom -> Atom -> Atom -> Selection
Selection Atom
s Atom
t Atom
p') K (ESelCmd String) (ESelEvt String)
l
notify :: Time -> Window -> Selection -> K i o -> K i o
notify Time
t Window
w Selection
sel = forall {i} {o}. XCommand -> K i o -> K i o
xcommandK (Window -> Bool -> [EventMask] -> XEvent -> XCommand
SendEvent Window
w Bool
False [] (Time -> Selection -> XEvent
SelectionNotify Time
t Selection
sel))
paste_string :: K (ESelCmd String) (ESelEvt String)
paste_string = Atom -> K (ESelCmd String) (ESelEvt String)
paste' Atom
stringA
paste_utf8string :: K (ESelCmd String) (ESelEvt String)
paste_utf8string = Atom -> K (ESelCmd String) (ESelEvt String)
paste' Atom
utf8A
paste' :: Atom -> K (ESelCmd String) (ESelEvt String)
paste' Atom
typ =
forall {i} {o}. XCommand -> K i o -> K i o
xcommandK (Selection -> XCommand
ConvertSelection (Atom -> Atom -> Atom -> Selection
Selection Atom
primaryA Atom
typ Atom
fudgetsA)) K (ESelCmd String) (ESelEvt String)
l
paste_failed :: K (ESelCmd String) (ESelEvt String)
paste_failed = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a}. SelEvt a -> Message a (ESelEvt a)
sevt (forall a. a -> SelEvt a
SelNotify String
"")) K (ESelCmd String) (ESelEvt String)
l
selectionnotify :: Selection -> K (ESelCmd String) (ESelEvt String)
selectionnotify sel :: Selection
sel@(Selection Atom
s Atom
t Atom
p) =
if Atom
pforall a. Eq a => a -> a -> Bool
==Atom
noneA
then if Atom
tforall a. Eq a => a -> a -> Bool
==Atom
utf8A
then K (ESelCmd String) (ESelEvt String)
paste_string
else K (ESelCmd String) (ESelEvt String)
paste_failed
else if Atom
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Atom
stringA,Atom
utf8A]
then K (ESelCmd String) (ESelEvt String)
paste_failed
else forall {b} {c}.
Time
-> Atom
-> Bool
-> Atom
-> Cont (K b c) (Atom, Time, Time, Time, String)
getWindowPropertyK Time
0 Atom
p Bool
True Atom
t forall a b. (a -> b) -> a -> b
$
\(Atom
typ, Time
format, Time
nitems, Time
after,String
seltext) ->
let s' :: String
s' = if Atom
tforall a. Eq a => a -> a -> Bool
==Atom
utf8A then String -> String
decodeUTF8 String
seltext else String
seltext in
forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a}. SelEvt a -> Message a (ESelEvt a)
sevt (forall a. a -> SelEvt a
SelNotify String
s')) K (ESelCmd String) (ESelEvt String)
l
select :: K (ESelCmd String) (ESelEvt String)
select = Bool -> K (ESelCmd String) (ESelEvt String)
select' Bool
True
deselect :: K (ESelCmd String) (ESelEvt String)
deselect = Bool -> K (ESelCmd String) (ESelEvt String)
select' Bool
False
select' :: Bool -> K (ESelCmd String) (ESelEvt String)
select' Bool
b = forall {i} {o}. XCommand -> K i o -> K i o
xcommandK (Bool -> Atom -> XCommand
SetSelectionOwner Bool
b Atom
primaryA) K (ESelCmd String) (ESelEvt String)
l
in K (ESelCmd String) (ESelEvt String)
l
selectionF :: F (SelCmd String) (SelEvt String)
selectionF :: F (SelCmd String) (SelEvt String)
selectionF = forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF (forall a b. SP a b -> F a b
absF (forall {a} {a}.
a
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
selSP String
"")) (F (ESelCmd String) (ESelEvt String)
eselectionF) where
selSP :: a
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
selSP a
text =
let same :: SP (Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
same = a
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
selSP a
text
toesel :: a -> Either a b
toesel = forall a b. a -> Either a b
Left
toout :: b -> Either a b
toout = forall a b. b -> Either a b
Right in
forall a b. Cont (SP a b) a
getSP forall a b. (a -> b) -> a -> b
$ \Either (ESelEvt a) (SelCmd a)
msg -> case Either (ESelEvt a) (SelCmd a)
msg of
Right SelCmd a
ocmd -> case SelCmd a
ocmd of
Sel a
t -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Either a b
toesel forall a. ESelCmd a
OwnSel) forall a b. (a -> b) -> a -> b
$ a
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
selSP a
t
SelCmd a
_ -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Either a b
toesel (forall a. SelCmd a -> ESelCmd a
SelCmd SelCmd a
ocmd)) SP (Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
same
Left ESelEvt a
esevt -> case ESelEvt a
esevt of
ESelEvt a
WantSel -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Either a b
toesel (forall a. SelCmd a -> ESelCmd a
SelCmd (forall a. a -> SelCmd a
Sel a
text))) SP (Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
same
SelEvt SelEvt a
se -> forall b a. b -> SP a b -> SP a b
putSP (forall {b} {a}. b -> Either a b
toout SelEvt a
se) SP (Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
same