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
(SelCmd a -> SelCmd a -> Bool)
-> (SelCmd a -> SelCmd a -> Bool) -> Eq (SelCmd a)
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, Eq (SelCmd a)
Eq (SelCmd a)
-> (SelCmd a -> SelCmd a -> Ordering)
-> (SelCmd a -> SelCmd a -> Bool)
-> (SelCmd a -> SelCmd a -> Bool)
-> (SelCmd a -> SelCmd a -> Bool)
-> (SelCmd a -> SelCmd a -> Bool)
-> (SelCmd a -> SelCmd a -> SelCmd a)
-> (SelCmd a -> SelCmd a -> SelCmd a)
-> Ord (SelCmd a)
SelCmd a -> SelCmd a -> Bool
SelCmd a -> SelCmd a -> Ordering
SelCmd a -> SelCmd a -> SelCmd a
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
$cp1Ord :: forall a. Ord a => Eq (SelCmd a)
Ord)
data SelEvt a = LostSel | SelNotify a deriving (SelEvt a -> SelEvt a -> Bool
(SelEvt a -> SelEvt a -> Bool)
-> (SelEvt a -> SelEvt a -> Bool) -> Eq (SelEvt a)
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, Eq (SelEvt a)
Eq (SelEvt a)
-> (SelEvt a -> SelEvt a -> Ordering)
-> (SelEvt a -> SelEvt a -> Bool)
-> (SelEvt a -> SelEvt a -> Bool)
-> (SelEvt a -> SelEvt a -> Bool)
-> (SelEvt a -> SelEvt a -> Bool)
-> (SelEvt a -> SelEvt a -> SelEvt a)
-> (SelEvt a -> SelEvt a -> SelEvt a)
-> Ord (SelEvt a)
SelEvt a -> SelEvt a -> Bool
SelEvt a -> SelEvt a -> Ordering
SelEvt a -> SelEvt a -> SelEvt a
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
$cp1Ord :: forall a. Ord a => Eq (SelEvt a)
Ord)
data ESelCmd a = OwnSel | SelCmd (SelCmd a) deriving (ESelCmd a -> ESelCmd a -> Bool
(ESelCmd a -> ESelCmd a -> Bool)
-> (ESelCmd a -> ESelCmd a -> Bool) -> Eq (ESelCmd a)
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, Eq (ESelCmd a)
Eq (ESelCmd a)
-> (ESelCmd a -> ESelCmd a -> Ordering)
-> (ESelCmd a -> ESelCmd a -> Bool)
-> (ESelCmd a -> ESelCmd a -> Bool)
-> (ESelCmd a -> ESelCmd a -> Bool)
-> (ESelCmd a -> ESelCmd a -> Bool)
-> (ESelCmd a -> ESelCmd a -> ESelCmd a)
-> (ESelCmd a -> ESelCmd a -> ESelCmd a)
-> Ord (ESelCmd a)
ESelCmd a -> ESelCmd a -> Bool
ESelCmd a -> ESelCmd a -> Ordering
ESelCmd a -> ESelCmd a -> ESelCmd a
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
$cp1Ord :: forall a. Ord a => Eq (ESelCmd a)
Ord)
data ESelEvt a = WantSel | SelEvt (SelEvt a) deriving (ESelEvt a -> ESelEvt a -> Bool
(ESelEvt a -> ESelEvt a -> Bool)
-> (ESelEvt a -> ESelEvt a -> Bool) -> Eq (ESelEvt a)
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, Eq (ESelEvt a)
Eq (ESelEvt a)
-> (ESelEvt a -> ESelEvt a -> Ordering)
-> (ESelEvt a -> ESelEvt a -> Bool)
-> (ESelEvt a -> ESelEvt a -> Bool)
-> (ESelEvt a -> ESelEvt a -> Bool)
-> (ESelEvt a -> ESelEvt a -> Bool)
-> (ESelEvt a -> ESelEvt a -> ESelEvt a)
-> (ESelEvt a -> ESelEvt a -> ESelEvt a)
-> Ord (ESelEvt a)
ESelEvt a -> ESelEvt a -> Bool
ESelEvt a -> ESelEvt a -> Ordering
ESelEvt a -> ESelEvt a -> ESelEvt a
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
$cp1Ord :: forall a. Ord a => Eq (ESelEvt a)
Ord)
eselectionF :: F (ESelCmd String) (ESelEvt String)
eselectionF :: F (ESelCmd String) (ESelEvt String)
eselectionF =
(Either (ESelEvt String) (ESelEvt String) -> ESelEvt String
forall p. Either p p -> p
stripEither (Either (ESelEvt String) (ESelEvt String) -> ESelEvt String)
-> F (Either (ESelCmd String) Any)
(Either (ESelEvt String) (ESelEvt String))
-> F (Either (ESelCmd String) Any) (ESelEvt String)
forall a b e. (a -> b) -> F e a -> F e b
>^=< [FRequest]
-> K (ESelCmd String) (ESelEvt String)
-> F Any (ESelEvt String)
-> F (Either (ESelCmd String) Any)
(Either (ESelEvt String) (ESelEvt String))
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 F Any (ESelEvt String)
forall hi ho. F hi ho
nullLF) F (Either (ESelCmd String) Any) (ESelEvt String)
-> (ESelCmd String -> Either (ESelCmd String) Any)
-> F (ESelCmd String) (ESelEvt String)
forall c d e. F c d -> (e -> c) -> F e d
>=^<
ESelCmd String -> Either (ESelCmd String) Any
forall a b. a -> Either a b
Left where
selK :: K (ESelCmd String) (ESelEvt String)
selK =
(String -> Cont (K (ESelCmd String) (ESelEvt String)) Atom)
-> [String] -> Cont (K (ESelCmd String) (ESelEvt String)) [Atom]
forall a c b. (a -> Cont c b) -> [a] -> Cont c [b]
conts ((String -> Bool -> Cont (K (ESelCmd String) (ESelEvt String)) Atom)
-> Bool
-> String
-> Cont (K (ESelCmd String) (ESelEvt String)) Atom
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Bool -> Cont (K (ESelCmd String) (ESelEvt String)) Atom
forall b c. String -> Bool -> Cont (K b c) Atom
internAtomK Bool
True)
[String
"PRIMARY", String
"STRING", String
"NONE", String
"ATOM"] Cont (K (ESelCmd String) (ESelEvt String)) [Atom]
-> Cont (K (ESelCmd String) (ESelEvt String)) [Atom]
forall a b. (a -> b) -> a -> b
$
\ [Atom
primaryA, Atom
stringA, Atom
noneA, Atom
atomA] ->
(String -> Cont (K (ESelCmd String) (ESelEvt String)) Atom)
-> [String] -> Cont (K (ESelCmd String) (ESelEvt String)) [Atom]
forall a c b. (a -> Cont c b) -> [a] -> Cont c [b]
conts ((String -> Bool -> Cont (K (ESelCmd String) (ESelEvt String)) Atom)
-> Bool
-> String
-> Cont (K (ESelCmd String) (ESelEvt String)) Atom
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Bool -> Cont (K (ESelCmd String) (ESelEvt String)) Atom
forall b c. String -> Bool -> Cont (K b c) Atom
internAtomK Bool
False) [String
"FUDGETS_UTF8",String
"UTF8_STRING"] Cont (K (ESelCmd String) (ESelEvt String)) [Atom]
-> Cont (K (ESelCmd String) (ESelEvt String)) [Atom]
forall a b. (a -> b) -> a -> b
$
\ [Atom
fudgetsA, Atom
utf8A] -> let
sevt :: SelEvt a -> Message a (ESelEvt a)
sevt = ESelEvt a -> Message a (ESelEvt a)
forall a b. b -> Message a b
High(ESelEvt a -> Message a (ESelEvt a))
-> (SelEvt a -> ESelEvt a) -> SelEvt a -> Message a (ESelEvt a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelEvt a -> ESelEvt a
forall a. SelEvt a -> ESelEvt a
SelEvt
l :: K (ESelCmd String) (ESelEvt String)
l =
Cont
(K (ESelCmd String) (ESelEvt String)) (KEvent (ESelCmd String))
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont
(K (ESelCmd String) (ESelEvt String)) (KEvent (ESelCmd String))
-> Cont
(K (ESelCmd String) (ESelEvt String)) (KEvent (ESelCmd String))
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 Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
primaryA -> KCommand (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (SelEvt String -> KCommand (ESelEvt String)
forall a a. SelEvt a -> Message a (ESelEvt a)
sevt SelEvt String
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 Atom -> [Atom] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Atom
stringA,Atom
utf8A]
then Time
-> Window
-> Selection
-> K (ESelCmd String) (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
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 Atom -> Atom -> Bool
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))) = a -> Maybe a
forall a. a -> Maybe a
Just a
t
wait Message a (ESelCmd a)
_ = Maybe a
forall a. Maybe a
Nothing
in KCommand (ESelEvt String)
-> (KEvent (ESelCmd String) -> Maybe String)
-> Cont (K (ESelCmd String) (ESelEvt String)) String
forall ho hi a.
KCommand ho -> (KEvent hi -> Maybe a) -> Cont (K hi ho) a
cmdContK' (ESelEvt String -> KCommand (ESelEvt String)
forall a b. b -> Message a b
High ESelEvt String
forall a. ESelEvt a
WantSel) KEvent (ESelCmd String) -> Maybe String
forall a a. Message a (ESelCmd a) -> Maybe a
wait Cont (K (ESelCmd String) (ESelEvt String)) String
-> Cont (K (ESelCmd String) (ESelEvt String)) String
forall a b. (a -> b) -> a -> b
$ \String
rawtext ->
let text :: String
text = if Atom
tAtom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
==Atom
utf8A
then String -> String
encodeUTF8 String
rawtext
else String
rawtext in
XCommand
-> K (ESelCmd String) (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
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) (K (ESelCmd String) (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String))
-> K (ESelCmd String) (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
forall a b. (a -> b) -> a -> b
$
Time
-> Window
-> Selection
-> K (ESelCmd String) (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
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 = XCommand -> K i o -> K i o
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 =
XCommand
-> K (ESelCmd String) (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
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 = KCommand (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (SelEvt String -> KCommand (ESelEvt String)
forall a a. SelEvt a -> Message a (ESelEvt a)
sevt (String -> SelEvt String
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
pAtom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
==Atom
noneA
then if Atom
tAtom -> Atom -> Bool
forall 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 Atom -> [Atom] -> Bool
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 Time
-> Atom
-> Bool
-> Atom
-> Cont
(K (ESelCmd String) (ESelEvt String))
(Atom, Time, Time, Time, String)
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 Cont
(K (ESelCmd String) (ESelEvt String))
(Atom, Time, Time, Time, String)
-> Cont
(K (ESelCmd String) (ESelEvt String))
(Atom, Time, Time, Time, String)
forall a b. (a -> b) -> a -> b
$
\(Atom
typ, Time
format, Time
nitems, Time
after,String
seltext) ->
let s' :: String
s' = if Atom
tAtom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
==Atom
utf8A then String -> String
decodeUTF8 String
seltext else String
seltext in
KCommand (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (SelEvt String -> KCommand (ESelEvt String)
forall a a. SelEvt a -> Message a (ESelEvt a)
sevt (String -> SelEvt String
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 = XCommand
-> K (ESelCmd String) (ESelEvt String)
-> K (ESelCmd String) (ESelEvt String)
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 = F (Either (ESelEvt String) (SelCmd String))
(Either (ESelCmd String) (SelEvt String))
-> F (ESelCmd String) (ESelEvt String)
-> F (SelCmd String) (SelEvt String)
forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF (SP
(Either (ESelEvt String) (SelCmd String))
(Either (ESelCmd String) (SelEvt String))
-> F (Either (ESelEvt String) (SelCmd String))
(Either (ESelCmd String) (SelEvt String))
forall a b. SP a b -> F a b
absF (String
-> SP
(Either (ESelEvt String) (SelCmd String))
(Either (ESelCmd String) (SelEvt String))
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 = a -> Either a b
forall a b. a -> Either a b
Left
toout :: b -> Either a b
toout = b -> Either a b
forall a b. b -> Either a b
Right in
Cont
(SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a)))
(Either (ESelEvt a) (SelCmd a))
forall a b. Cont (SP a b) a
getSP Cont
(SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a)))
(Either (ESelEvt a) (SelCmd a))
-> Cont
(SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a)))
(Either (ESelEvt a) (SelCmd a))
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 -> Either (ESelCmd a) (SelEvt a)
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
forall b a. b -> SP a b -> SP a b
putSP (ESelCmd a -> Either (ESelCmd a) (SelEvt a)
forall a b. a -> Either a b
toesel ESelCmd a
forall a. ESelCmd a
OwnSel) (SP (Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a)))
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
forall a b. (a -> b) -> a -> b
$ a
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
selSP a
t
SelCmd a
_ -> Either (ESelCmd a) (SelEvt a)
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
forall b a. b -> SP a b -> SP a b
putSP (ESelCmd a -> Either (ESelCmd a) (SelEvt a)
forall a b. a -> Either a b
toesel (SelCmd a -> ESelCmd a
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 -> Either (ESelCmd a) (SelEvt a)
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
forall b a. b -> SP a b -> SP a b
putSP (ESelCmd a -> Either (ESelCmd a) (SelEvt a)
forall a b. a -> Either a b
toesel (SelCmd a -> ESelCmd a
forall a. SelCmd a -> ESelCmd a
SelCmd (a -> SelCmd a
forall a. a -> SelCmd a
Sel a
text))) SP (Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
same
SelEvt SelEvt a
se -> Either (ESelCmd a) (SelEvt a)
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
-> SP
(Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
forall b a. b -> SP a b -> SP a b
putSP (SelEvt a -> Either (ESelCmd a) (SelEvt a)
forall b a. b -> Either a b
toout SelEvt a
se) SP (Either (ESelEvt a) (SelCmd a)) (Either (ESelCmd a) (SelEvt a))
same