module Editor(oldEditorF,selectall,loadEditor,setEditorCursorPos) where
import Command
import CompOps((>+<))
import Cont(cmdContK')
import Cursor
import Defaults(menuFont,bgColor,metaKey)--defaultFont
import CmdLineEnv(argReadKey)
import QueryPointer
import TimerF
import Dlayout(groupF)
import Edtypes
import Edit--(EditStopT(..), EditCmd(..), EditEvt(..), IsSelect(..), editF)
import Event
--import Font(FontStruct)
import Fudget
import FRequest
import Geometry() -- instances, for hbc
import LayoutRequest
import Loops(loopCompThroughRightF)
--import Message(Message(..))
import NullF
--import Path(Path(..))
import PopupMenuF
--import SP
import SelectionF
--import Utils(mapList)--loop,
import Xtypes
import Data.Char(isAlpha,toLower,isPrint)
--import Graphic
import InputMsg(InputMsg(..))

default(Int) -- mostly for Hugs

ems :: EditStopFn -> IsSelect -> EditCmd
ems = EditStop -> IsSelect -> EditCmd
EditMove forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditStopFn -> EditStop
EditStopFn
stopafter :: Int -> EDirection -> IsSelect -> EditCmd
stopafter Int
n EDirection
dir = EditStopFn -> IsSelect -> EditCmd
ems (Int -> EditStopFn
sa Int
n) 
	  where sa :: Int -> EditStopFn
sa Int
n String
b String
a = if (Int
n::Int) forall a. Ord a => a -> a -> IsSelect
<= Int
0 then EditStopChoice
EdStop else EDirection -> EditStopFn -> EditStopChoice
EdGo EDirection
dir (Int -> EditStopFn
sa (Int
nforall a. Num a => a -> a -> a
-Int
1))
stop1 :: EDirection -> IsSelect -> EditCmd
stop1 = Int -> EDirection -> IsSelect -> EditCmd
stopafter Int
1

ifhd :: (t -> IsSelect) -> [t] -> IsSelect
ifhd t -> IsSelect
p [t]
l = IsSelect -> IsSelect
not (forall (t :: * -> *) a. Foldable t => t a -> IsSelect
null [t]
l) IsSelect -> IsSelect -> IsSelect
&& t -> IsSelect
p (forall a. [a] -> a
head [t]
l)
aheadl :: EDirection -> p -> p -> p
aheadl EDirection
dir p
b p
a = if EDirection
dir forall a. Eq a => a -> a -> IsSelect
== EDirection
ELeft then p
b else p
a
ifdirhd :: (t -> IsSelect) -> EDirection -> [t] -> [t] -> IsSelect
ifdirhd t -> IsSelect
p EDirection
dir [t]
b [t]
a = forall {t}. (t -> IsSelect) -> [t] -> IsSelect
ifhd t -> IsSelect
p (forall {p}. EDirection -> p -> p -> p
aheadl EDirection
dir [t]
b [t]
a)
stopwhen :: (Char -> IsSelect) -> EDirection -> IsSelect -> EditCmd
stopwhen Char -> IsSelect
p EDirection
dir = EditStopFn -> IsSelect -> EditCmd
ems EditStopFn
sw
   where sw :: EditStopFn
sw String
b String
a = if forall {t}. (t -> IsSelect) -> EDirection -> [t] -> [t] -> IsSelect
ifdirhd Char -> IsSelect
p EDirection
dir String
b String
a then EditStopChoice
EdStop
	          else EDirection -> EditStopFn -> EditStopChoice
EdGo EDirection
dir EditStopFn
sw
stopat :: Char -> EDirection -> IsSelect -> EditCmd
stopat Char
c = (Char -> IsSelect) -> EDirection -> IsSelect -> EditCmd
stopwhen (forall a. Eq a => a -> a -> IsSelect
==Char
c)
stopnl :: EDirection -> IsSelect -> EditCmd
stopnl = Char -> EDirection -> IsSelect -> EditCmd
stopat Char
newline

stopborder :: (Char -> IsSelect) -> EDirection -> IsSelect -> EditCmd
stopborder Char -> IsSelect
p EDirection
dir = EditStopFn -> IsSelect -> EditCmd
ems EditStopFn
sw
  where sw :: EditStopFn
sw String
b String
a = if forall {t}. (t -> IsSelect) -> EDirection -> [t] -> [t] -> IsSelect
ifdirhd (IsSelect -> IsSelect
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> IsSelect
p) EDirection
dir String
b String
a IsSelect -> IsSelect -> IsSelect
&&
		    forall {t}. (t -> IsSelect) -> EDirection -> [t] -> [t] -> IsSelect
ifdirhd Char -> IsSelect
p EDirection
dir String
a String
b then EditStopChoice
EdStop
		 else EDirection -> EditStopFn -> EditStopChoice
EdGo EDirection
dir EditStopFn
sw

stopword :: EDirection -> IsSelect -> EditCmd
stopword = (Char -> IsSelect) -> EDirection -> IsSelect -> EditCmd
stopborder Char -> IsSelect
isAlpha

neverstop :: EDirection -> IsSelect -> EditCmd
neverstop = (Char -> IsSelect) -> EDirection -> IsSelect -> EditCmd
stopwhen (forall a b. a -> b -> a
const IsSelect
False)

-- replaceAll is used for TextRequests
loadEditor :: String -> [EditCmd]
loadEditor String
s = [EditCmd]
selectallforall a. [a] -> [a] -> [a]
++[String -> EditCmd
EditReplace String
s]
selectall :: [EditCmd]
selectall = [EDirection -> IsSelect -> EditCmd
neverstop EDirection
ELeft IsSelect
False,
	     EDirection -> IsSelect -> EditCmd
neverstop EDirection
ERight IsSelect
True]

setEditorCursorPos :: (Int, Int) -> [EditCmd]
setEditorCursorPos (Int
row,Int
col) =
   EditStop -> IsSelect -> EditCmd
EditMove (Point -> EditStop
EditPoint Point
0) IsSelect
False forall a. a -> [a] -> [a]
:
   forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. Int -> a -> [a]
replicate (Int
rowforall a. Num a => a -> a -> a
-Int
1) ([IsSelect -> EditCmd]
down forall {t} {a}. [t -> a] -> t -> [a]
`funmap` IsSelect
False)) forall a. [a] -> [a] -> [a]
++
   [Int -> EDirection -> IsSelect -> EditCmd
stopafter (Int
colforall a. Num a => a -> a -> a
-Int
1) EDirection
ERight IsSelect
False]

horiz :: EDirection -> IsSelect -> [IsSelect -> EditCmd]
horiz EDirection
dir IsSelect
meta = EDirection -> IsSelect -> EditCmd
stop1 EDirection
dir forall a. a -> [a] -> [a]
: if IsSelect
meta then [EDirection -> IsSelect -> EditCmd
stopword EDirection
dir] else []
left :: IsSelect -> [IsSelect -> EditCmd]
left = EDirection -> IsSelect -> [IsSelect -> EditCmd]
horiz EDirection
ELeft
right :: IsSelect -> [IsSelect -> EditCmd]
right = EDirection -> IsSelect -> [IsSelect -> EditCmd]
horiz EDirection
ERight
up :: [IsSelect -> EditCmd]
up = [EditStop -> IsSelect -> EditCmd
EditMove (EDirection -> EditStop
EditLine EDirection
ELeft)]
down :: [IsSelect -> EditCmd]
down = [EditStop -> IsSelect -> EditCmd
EditMove (EDirection -> EditStop
EditLine EDirection
ERight)]

undo :: [b -> EditCmd]
undo = [forall a b. a -> b -> a
const EditCmd
EditUndo]
redo :: [b -> EditCmd]
redo = [forall a b. a -> b -> a
const EditCmd
EditRedo]

cursorbindings :: IsSelect -> [(String, [IsSelect -> EditCmd])]
cursorbindings IsSelect
meta = 
    [(String
"left", IsSelect -> [IsSelect -> EditCmd]
left IsSelect
meta), 
     (String
"right",IsSelect -> [IsSelect -> EditCmd]
right IsSelect
meta),
     (String
"up",[IsSelect -> EditCmd]
up),
     (String
"down",[IsSelect -> EditCmd]
down),
     (String
"b",IsSelect -> [IsSelect -> EditCmd]
left IsSelect
meta),
     (String
"f",IsSelect -> [IsSelect -> EditCmd]
right IsSelect
meta)] 

ctrls :: [(String, [IsSelect -> EditCmd])]
ctrls  = [(String
"e",[EDirection -> IsSelect -> EditCmd
stopnl EDirection
ERight]),
         (String
"a",[EDirection -> IsSelect -> EditCmd
stopnl EDirection
ELeft]),
	 (String
"p",[IsSelect -> EditCmd]
up),
	 (String
"n",[IsSelect -> EditCmd]
down),
	 (String
"b",IsSelect -> [IsSelect -> EditCmd]
left IsSelect
False),
	 (String
"f",IsSelect -> [IsSelect -> EditCmd]
right IsSelect
False),
	 (String
"slash",forall {b}. [b -> EditCmd]
undo),
	 (String
"question",forall {b}. [b -> EditCmd]
redo)]

selectleft :: IsSelect -> [EditCmd]
selectleft IsSelect
meta = forall {t} {a}. [t -> a] -> t -> [a]
funmap (IsSelect -> [IsSelect -> EditCmd]
left IsSelect
meta) IsSelect
True
[t -> a]
fl funmap :: [t -> a] -> t -> [a]
`funmap` t
x = [t -> a
f t
x | t -> a
f <- [t -> a]
fl]
hasMeta :: t Modifiers -> IsSelect
hasMeta t Modifiers
mods = Modifiers
metaKey forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> IsSelect
`elem` t Modifiers
mods
hasControl :: t Modifiers -> IsSelect
hasControl t Modifiers
mods = Modifiers
Control forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> IsSelect
`elem` t Modifiers
mods
cursorkey :: t Modifiers -> String -> Maybe [EditCmd]
cursorkey t Modifiers
mods String
key = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (if forall {t :: * -> *}. Foldable t => t Modifiers -> IsSelect
hasControl t Modifiers
mods then [(String, [IsSelect -> EditCmd])]
ctrls 
			     else IsSelect -> [(String, [IsSelect -> EditCmd])]
cursorbindings (forall {t :: * -> *}. Foldable t => t Modifiers -> IsSelect
hasMeta t Modifiers
mods))
			    (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
key) 
		     forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[IsSelect -> EditCmd]
l-> forall a. a -> Maybe a
Just (forall {t} {a}. [t -> a] -> t -> [a]
funmap [IsSelect -> EditCmd]
l (Modifiers
Shift forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> IsSelect
`elem` t Modifiers
mods))

isEnterKey :: String -> IsSelect
isEnterKey String
key = String
key forall a. Eq a => a -> a -> IsSelect
== String
"Return" IsSelect -> IsSelect -> IsSelect
|| String
key forall a. Eq a => a -> a -> IsSelect
== String
"KP_Enter"
printorenter :: t Modifiers -> String -> String -> Maybe String
printorenter t Modifiers
mods String
key String
ascii =
    if forall {t :: * -> *}. Foldable t => t Modifiers -> IsSelect
hasMeta t Modifiers
mods then forall a. Maybe a
Nothing
    else if String -> IsSelect
isEnterKey String
key then
        forall a. a -> Maybe a
Just [Char
newline]
    else if String
key forall a. Eq a => a -> a -> IsSelect
== String
"Tab" then forall a. a -> Maybe a
Just [Char
'\t']
    else if IsSelect -> IsSelect
not (forall {t :: * -> *}. Foldable t => t Modifiers -> IsSelect
hasControl t Modifiers
mods) then
        case String
ascii of
          Char
c : String
_ | Char -> IsSelect
isPrint Char
c -> forall a. a -> Maybe a
Just [Char
c]
          String
_ -> forall a. Maybe a
Nothing
   else forall a. Maybe a
Nothing
toEdF :: a -> Message a (Either (Either a (Either a a)) b)
toEdF = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right

toSelF :: a -> Message a (Either (Either a (Either (Either a b) b)) b)
toSelF = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
toTimerF :: a -> Message a (Either (Either a (Either (Either a a) b)) b)
toTimerF = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right

toOut :: a -> Message a (Either a a)
toOut = forall a b. b -> Message a b
High forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right

getEdSel :: Cont
  (K (Either (Either a (Either a EditEvt)) b)
     (Either (Either a (Either a EditCmd)) b))
  String
getEdSel = forall {a} {a} {a} {b} {a} {a} {b}.
a
-> Cont
     (K (Either (Either a (Either a EditEvt)) b)
        (Either (Either a (Either a a)) b))
     String
getEd EditCmd
EditGetSelection
getEdText :: Cont
  (K (Either (Either a (Either a EditEvt)) b)
     (Either (Either a (Either a EditCmd)) b))
  String
getEdText = forall {a} {a} {a} {b} {a} {a} {b}.
a
-> Cont
     (K (Either (Either a (Either a EditEvt)) b)
        (Either (Either a (Either a a)) b))
     String
getEd EditCmd
EditGetText

getEd :: a
-> Cont
     (K (Either (Either a (Either a EditEvt)) b)
        (Either (Either a (Either a a)) b))
     String
getEd a
ecmd =
    forall {ho} {hi} {a}.
KCommand ho -> (KEvent hi -> Maybe a) -> Cont (K hi ho) a
cmdContK' (forall {a} {a} {a} {a} {b}.
a -> Message a (Either (Either a (Either a a)) b)
toEdF a
ecmd)
              (\KEvent (Either (Either a (Either a EditEvt)) b)
e ->
               case KEvent (Either (Either a (Either a EditEvt)) b)
e of
                 High (Left (Right (Right (EditText String
t)))) -> forall a. a -> Maybe a
Just String
t
                 KEvent (Either (Either a (Either a EditEvt)) b)
_ -> forall a. Maybe a
Nothing)

getSel :: Cont
  (K (Either (Either a (Either (Either (SelEvt a) b) b)) b)
     (Either (Either a (Either (Either (SelCmd a) b) b)) b))
  a
getSel =
    forall {ho} {hi} {a}.
KCommand ho -> (KEvent hi -> Maybe a) -> Cont (K hi ho) a
cmdContK' (forall {a} {a} {a} {b} {b} {b}.
a -> Message a (Either (Either a (Either (Either a b) b)) b)
toSelF forall a. SelCmd a
PasteSel)
              (\KEvent (Either (Either a (Either (Either (SelEvt a) b) b)) b)
e ->
               case KEvent (Either (Either a (Either (Either (SelEvt a) b) b)) b)
e of
                 High (Left (Right (Left (Left (SelNotify a
t))))) -> forall a. a -> Maybe a
Just a
t
                 KEvent (Either (Either a (Either (Either (SelEvt a) b) b)) b)
_ -> forall a. Maybe a
Nothing)

replace' :: String
-> K hi (Either (Either a (Either a EditCmd)) b)
-> K hi (Either (Either a (Either a EditCmd)) b)
replace' String
s = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {a} {a} {b}.
a -> Message a (Either (Either a (Either a a)) b)
toEdF forall a b. (a -> b) -> a -> b
$ String -> EditCmd
EditReplace String
s)
clearSel :: K hi (Either (Either a (Either a EditCmd)) b)
-> K hi (Either (Either a (Either a EditCmd)) b)
clearSel = forall {hi} {a} {a} {b}.
String
-> K hi (Either (Either a (Either a EditCmd)) b)
-> K hi (Either (Either a (Either a EditCmd)) b)
replace' String
""
copySel :: K (Either (Either a (Either a EditEvt)) b)
  (Either (Either a (Either (Either (SelCmd String) b) EditCmd)) b)
-> K (Either (Either a (Either a EditEvt)) b)
     (Either (Either a (Either (Either (SelCmd String) b) EditCmd)) b)
copySel K (Either (Either a (Either a EditEvt)) b)
  (Either (Either a (Either (Either (SelCmd String) b) EditCmd)) b)
k = forall {a} {a} {b} {a} {a} {b}.
Cont
  (K (Either (Either a (Either a EditEvt)) b)
     (Either (Either a (Either a EditCmd)) b))
  String
getEdSel forall a b. (a -> b) -> a -> b
$ (\String
s -> forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {a} {b} {b} {b}.
a -> Message a (Either (Either a (Either (Either a b) b)) b)
toSelF (forall a. a -> SelCmd a
Sel String
s)) K (Either (Either a (Either a EditEvt)) b)
  (Either (Either a (Either (Either (SelCmd String) b) EditCmd)) b)
k)
click :: IsSelect
-> Point
-> K hi (Either (Either a (Either a EditCmd)) b)
-> K hi (Either (Either a (Either a EditCmd)) b)
click IsSelect
issel Point
p = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {a} {a} {b}.
a -> Message a (Either (Either a (Either a a)) b)
toEdF forall a b. (a -> b) -> a -> b
$ EditStop -> IsSelect -> EditCmd
EditMove (Point -> EditStop
EditPoint Point
p) IsSelect
issel)
starttimer :: K hi (Either (Either a (Either (Either a (Maybe (Int, Int))) b)) b)
-> K hi
     (Either (Either a (Either (Either a (Maybe (Int, Int))) b)) b)
starttimer = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either (Either a a) b)) b)
toTimerF forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int
scrolldel,Int
scrolldel))
stoptimer :: K hi (Either (Either a (Either (Either a (Maybe a)) b)) b)
-> K hi (Either (Either a (Either (Either a (Maybe a)) b)) b)
stoptimer = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {a} {a} {b} {b}.
a -> Message a (Either (Either a (Either (Either a a) b)) b)
toTimerF forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing)
scrolldel :: Int
scrolldel = forall {p}. (Read p, Show p) => String -> p -> p
argReadKey String
"scrolldel" Int
200

oldEditorF :: FontSpec -> F EditCmd EditEvt
oldEditorF FontSpec
font = forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF forall {b4} {a}.
F (Either
     (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        [(MenEvt, b4)]
        (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd)))
  (Either
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt)))
g where
   g :: F (Either
     (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        [(MenEvt, b4)]
        (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd)))
  (Either
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt)))
g = forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF (forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd [[WindowAttributes] -> XCommand
ChangeWindowAttributes 
	       [[EventMask] -> WindowAttributes
CWEventMask [EventMask
KeyPressMask,EventMask
EnterWindowMask,EventMask
LeaveWindowMask]],
	       [WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
1],
	       IsSelect -> Button -> ModState -> [EventMask] -> XCommand
GrabButton IsSelect
True (Int -> Button
Button Int
1) [Modifiers
Any] 
	          [EventMask
ButtonPressMask,EventMask
PointerMotionMask,EventMask
ButtonReleaseMask]])
	      (forall a b. Int -> K a b -> K a b
setFontCursor Int
152 forall a b. (a -> b) -> a -> b
$ forall {a}.
IsSelect
-> IsSelect
-> K (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
editorK IsSelect
False IsSelect
False)
	      (forall {c} {d} {b4}.
F c d -> F (Either [(MenEvt, b4)] c) (Either MenEvt d)
menu ((F (SelCmd String) (SelEvt String)
selectionF forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+< F (Maybe (Int, Int)) Tick
timerF) forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+< FontSpec -> F EditCmd EditEvt
editF FontSpec
font))
   editorK :: IsSelect
-> IsSelect
-> K (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
editorK IsSelect
bpressed IsSelect
focus = K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same where
     same :: K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same = 
      forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ \KEvent
  (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
msg ->
        case KEvent
  (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
msg of
         Low (XEvt XEvent
event) ->
	   case XEvent
event of
	     KeyEvent Int
_ Point
_ Point
_ ModState
mods Pressed
Pressed KeyCode
_ String
key String
ascii -> 
		if forall {t :: * -> *}. Foldable t => t Modifiers -> IsSelect
hasMeta ModState
mods IsSelect -> IsSelect -> IsSelect
&& String -> IsSelect
isEnterKey String
key
		then String
-> K (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
putInputDoneMsg String
key
		else
		case forall {t :: * -> *}.
Foldable t =>
t Modifiers -> String -> String -> Maybe String
printorenter ModState
mods String
key String
ascii of
		   Just String
s -> forall {hi} {a} {a} {b}.
String
-> K hi (Either (Either a (Either a EditCmd)) b)
-> K hi (Either (Either a (Either a EditCmd)) b)
replace' String
s K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
		   Maybe String
Nothing -> case forall {t :: * -> *}.
Foldable t =>
t Modifiers -> String -> Maybe [EditCmd]
cursorkey ModState
mods String
key of
		      Just [EditCmd]
eds -> forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a} {a} {b}.
a -> Message a (Either (Either a (Either a a)) b)
toEdF [EditCmd]
eds) K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
		      Maybe [EditCmd]
Nothing -> 
			 if String
key forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> IsSelect
`elem` [String
"Delete",String
"BackSpace"] 
			 then forall {a} {a} {b} {a} {a} {b}.
Cont
  (K (Either (Either a (Either a EditEvt)) b)
     (Either (Either a (Either a EditCmd)) b))
  String
getEdSel forall a b. (a -> b) -> a -> b
$ \String
s -> 
			      (if forall (t :: * -> *) a. Foldable t => t a -> IsSelect
null String
s 
			       then forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a} {a} {b}.
a -> Message a (Either (Either a (Either a a)) b)
toEdF 
					      (IsSelect -> [EditCmd]
selectleft (forall {t :: * -> *}. Foldable t => t Modifiers -> IsSelect
hasMeta ModState
mods)))
			       else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall {hi} {a} {a} {b}.
K hi (Either (Either a (Either a EditCmd)) b)
-> K hi (Either (Either a (Either a EditCmd)) b)
clearSel K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
			 else K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
	     MotionNotify {pos :: XEvent -> Point
pos=Point
p,state :: XEvent -> ModState
state=ModState
mods} -> forall {hi} {a} {a} {b}.
IsSelect
-> Point
-> K hi (Either (Either a (Either a EditCmd)) b)
-> K hi (Either (Either a (Either a EditCmd)) b)
click IsSelect
True Point
p K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
	     ButtonEvent {pos :: XEvent -> Point
pos=Point
p,state :: XEvent -> ModState
state=ModState
mods,type' :: XEvent -> Pressed
type'=Pressed
Pressed,button :: XEvent -> Button
button=Button Int
1} ->
		forall {hi} {a} {a} {b} {b}.
K hi (Either (Either a (Either (Either a (Maybe (Int, Int))) b)) b)
-> K hi
     (Either (Either a (Either (Either a (Maybe (Int, Int))) b)) b)
starttimer forall a b. (a -> b) -> a -> b
$
		forall {hi} {a} {a} {b}.
IsSelect
-> Point
-> K hi (Either (Either a (Either a EditCmd)) b)
-> K hi (Either (Either a (Either a EditCmd)) b)
click (Modifiers
Shift forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> IsSelect
`elem` ModState
mods) Point
p forall a b. (a -> b) -> a -> b
$ IsSelect
-> IsSelect
-> K (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
showCursor IsSelect
True IsSelect
focus
	     ButtonEvent {type' :: XEvent -> Pressed
type'=Pressed
Released,button :: XEvent -> Button
button=Button Int
1} -> 
		forall {hi} {a} {a} {a} {b} {b}.
K hi (Either (Either a (Either (Either a (Maybe a)) b)) b)
-> K hi (Either (Either a (Either (Either a (Maybe a)) b)) b)
stoptimer forall a b. (a -> b) -> a -> b
$ IsSelect
-> IsSelect
-> K (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
showCursor IsSelect
False IsSelect
focus
	     FocusIn {mode :: XEvent -> Mode
mode=Mode
NotifyNormal} -> IsSelect
-> IsSelect
-> K (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
showCursor IsSelect
bpressed IsSelect
True
	     FocusOut {mode :: XEvent -> Mode
mode=Mode
NotifyNormal} -> IsSelect
-> IsSelect
-> K (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
showCursor IsSelect
bpressed IsSelect
False
	     XEvent
_ -> K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
	 High (Left (Right (Left (Right Tick
Tick)))) ->
	   forall {b} {c}. Cont (K b c) (IsSelect, Point, Point, ModState)
queryPointerK forall a b. (a -> b) -> a -> b
$ \(IsSelect
_,Point
_,Point
p,ModState
_) -> forall {hi} {a} {a} {b}.
IsSelect
-> Point
-> K hi (Either (Either a (Either a EditCmd)) b)
-> K hi (Either (Either a (Either a EditCmd)) b)
click IsSelect
True Point
p K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
	 High (Left (Left MenEvt
mencmd)) -> case MenEvt
mencmd of
				      MenEvt
MenCut -> forall {a} {a} {b} {a} {b} {b}.
K (Either (Either a (Either a EditEvt)) b)
  (Either (Either a (Either (Either (SelCmd String) b) EditCmd)) b)
-> K (Either (Either a (Either a EditEvt)) b)
     (Either (Either a (Either (Either (SelCmd String) b) EditCmd)) b)
copySel forall a b. (a -> b) -> a -> b
$ forall {hi} {a} {a} {b}.
K hi (Either (Either a (Either a EditCmd)) b)
-> K hi (Either (Either a (Either a EditCmd)) b)
clearSel K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
				      MenEvt
MenCopy -> forall {a} {a} {b} {a} {b} {b}.
K (Either (Either a (Either a EditEvt)) b)
  (Either (Either a (Either (Either (SelCmd String) b) EditCmd)) b)
-> K (Either (Either a (Either a EditEvt)) b)
     (Either (Either a (Either (Either (SelCmd String) b) EditCmd)) b)
copySel K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
				      MenEvt
MenPaste -> forall {a} {a} {b} {b} {b} {a} {a} {b} {b} {b}.
Cont
  (K (Either (Either a (Either (Either (SelEvt a) b) b)) b)
     (Either (Either a (Either (Either (SelCmd a) b) b)) b))
  a
getSel forall a b. (a -> b) -> a -> b
$ \String
s ->
						  forall {hi} {a} {a} {b}.
String
-> K hi (Either (Either a (Either a EditCmd)) b)
-> K hi (Either (Either a (Either a EditCmd)) b)
replace' String
s K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
	 High (Left (Right (Right EditEvt
ecmd))) -> 
	    (case EditEvt
ecmd of
		  EditCursor Rect
r -> forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall a b. a -> Message a b
Low forall a b. (a -> b) -> a -> b
$ LayoutMessage -> FRequest
LCmd forall a b. (a -> b) -> a -> b
$
					Rect -> LayoutMessage
layoutMakeVisible Rect
r)
		  EditEvt
_ -> forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
	    forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {a}. a -> Message a (Either a a)
toOut EditEvt
ecmd) K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
	 High (Right EditCmd
ocmd) -> forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {a} {a} {b}.
a -> Message a (Either (Either a (Either a a)) b)
toEdF EditCmd
ocmd) K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
	 KEvent
  (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
_ -> K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same
     showCursor :: IsSelect
-> IsSelect
-> K (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
showCursor IsSelect
b IsSelect
f = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {a} {a} {b}.
a -> Message a (Either (Either a (Either a a)) b)
toEdF (IsSelect -> EditCmd
EditShowCursor (IsSelect
b IsSelect -> IsSelect -> IsSelect
|| IsSelect
f))) forall a b. (a -> b) -> a -> b
$ 
		    IsSelect
-> IsSelect
-> K (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
editorK IsSelect
b IsSelect
f
     putInputDoneMsg :: String
-> K (Either
        (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
        EditCmd)
     (Either
        (Either
           a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
        EditEvt)
putInputDoneMsg String
key =
       forall {a} {a} {b} {a} {a} {b}.
Cont
  (K (Either (Either a (Either a EditEvt)) b)
     (Either (Either a (Either a EditCmd)) b))
  String
getEdText forall a b. (a -> b) -> a -> b
$ \ String
s ->
       forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {a} {a}. a -> Message a (Either a a)
toOut forall a b. (a -> b) -> a -> b
$ InputMsg String -> EditEvt
EditChange (forall a. String -> a -> InputMsg a
InputDone String
key String
s)) forall a b. (a -> b) -> a -> b
$
       forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a} {a} {b}.
a -> Message a (Either (Either a (Either a a)) b)
toEdF [EditCmd]
selectall) forall a b. (a -> b) -> a -> b
$
       K (Either
     (Either MenEvt (Either (Either (SelEvt String) Tick) EditEvt))
     EditCmd)
  (Either
     (Either
        a (Either (Either (SelCmd String) (Maybe (Int, Int))) EditCmd))
     EditEvt)
same

data MenEvt = MenCut | MenCopy | MenPaste  deriving (MenEvt -> MenEvt -> IsSelect
forall a. (a -> a -> IsSelect) -> (a -> a -> IsSelect) -> Eq a
/= :: MenEvt -> MenEvt -> IsSelect
$c/= :: MenEvt -> MenEvt -> IsSelect
== :: MenEvt -> MenEvt -> IsSelect
$c== :: MenEvt -> MenEvt -> IsSelect
Eq, Eq MenEvt
MenEvt -> MenEvt -> IsSelect
MenEvt -> MenEvt -> Ordering
MenEvt -> MenEvt -> MenEvt
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> IsSelect)
-> (a -> a -> IsSelect)
-> (a -> a -> IsSelect)
-> (a -> a -> IsSelect)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MenEvt -> MenEvt -> MenEvt
$cmin :: MenEvt -> MenEvt -> MenEvt
max :: MenEvt -> MenEvt -> MenEvt
$cmax :: MenEvt -> MenEvt -> MenEvt
>= :: MenEvt -> MenEvt -> IsSelect
$c>= :: MenEvt -> MenEvt -> IsSelect
> :: MenEvt -> MenEvt -> IsSelect
$c> :: MenEvt -> MenEvt -> IsSelect
<= :: MenEvt -> MenEvt -> IsSelect
$c<= :: MenEvt -> MenEvt -> IsSelect
< :: MenEvt -> MenEvt -> IsSelect
$c< :: MenEvt -> MenEvt -> IsSelect
compare :: MenEvt -> MenEvt -> Ordering
$ccompare :: MenEvt -> MenEvt -> Ordering
Ord)

menu :: F c d -> F (Either [(MenEvt, b4)] c) (Either MenEvt d)
menu = forall {b1} {b2} {t :: * -> *} {b3} {c} {d} {b4}.
(Eq b1, Graphic b2, Foldable t) =>
String
-> IsSelect
-> String
-> Button
-> ModState
-> t (ModState, String)
-> [(b1, b3)]
-> (b1 -> b2)
-> F c d
-> F (Either [(b1, b4)] c) (Either b1 d)
oldPopupMenuF String
bgColor IsSelect
True String
menuFont (Int -> Button
Button Int
3) [] [] 
     [(MenEvt
MenCut, []), (MenEvt
MenCopy, []), (MenEvt
MenPaste, [])]
               (\MenEvt
x -> case MenEvt
x of
                  MenEvt
MenCut -> String
"Cut"
                  MenEvt
MenCopy -> String
"Copy"
                  MenEvt
MenPaste -> String
"Paste")