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 Message(Message(..))
import NullF
import LayoutF(nullLF)
import Spops(putSP,getSP)
import Loops(loopThroughRightF)
import EitherUtils(stripEither)
import SerCompF(absF)
import Xtypes

{- 
Supports cut/paste of UTF-8 encoded Unicode Strings.
Cut/paste of Unicode strings between two fudgets program works.
Cut/paste between a fudget program and xterm -u8 from XFree86 4.0 works.
/TH 2000-04-02
-}

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 -- select t
		 SelCmd String
ClearSel -> K (ESelCmd String) (ESelEvt String)
deselect
		 SelCmd String
PasteSel -> K (ESelCmd String) (ESelEvt String)
paste_utf8string -- try UTF-8 first...
	      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  -- UTF8_STRING wasn't supported, try STRING
	       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
      -- should check that setselectionowner succeeded.
      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