{-# LANGUAGE CPP #-}
module Edit(EditStop(..),editF, EditEvt(..), EditCmd(..)) where
import BgF
import Color
import Command
import DrawInWindow
import XDraw(clearArea)
import Defaults(inputFg, inputBg)
import CmdLineEnv(argReadKey, argKey)
import Dlayout(windowF)
import Edtypes
import Editfield
import Event
import Font
import Fudget
import FRequest
import Gc
import Geometry
import LayoutRequest(plainLayout,LayoutResponse(..))
import Message(message) --Message(..),
import NullF
import StateMonads
import Control.Monad(when)
import HbcUtils(apSnd)
import Xtypes
import UndoStack
import TryLayout
import Expose
import Maptrace
import GCAttrs(convFontK,fontdata2struct,FontSpec) -- instances
import InputMsg(InputMsg(InputChange))

default (Int) -- mostly for Hugs

data EditStop = 
     EditStopFn EditStopFn 
   | EditPoint Point 
   | EditLine EDirection

data EditCmd = 
     EditShowCursor Bool
   | EditMove EditStop IsSelect
   | EditReplace String
   | EditGetText
   | EditGetField
   | EditGetSelection
   | EditUndo
   | EditRedo 
     
data EditEvt
    = EditText String
    | EditField (String,String,String)
    | EditCursor Rect
    | EditChange (InputMsg String)
    deriving (EditEvt -> EditEvt -> Bool
(EditEvt -> EditEvt -> Bool)
-> (EditEvt -> EditEvt -> Bool) -> Eq EditEvt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditEvt -> EditEvt -> Bool
$c/= :: EditEvt -> EditEvt -> Bool
== :: EditEvt -> EditEvt -> Bool
$c== :: EditEvt -> EditEvt -> Bool
Eq, Eq EditEvt
Eq EditEvt
-> (EditEvt -> EditEvt -> Ordering)
-> (EditEvt -> EditEvt -> Bool)
-> (EditEvt -> EditEvt -> Bool)
-> (EditEvt -> EditEvt -> Bool)
-> (EditEvt -> EditEvt -> Bool)
-> (EditEvt -> EditEvt -> EditEvt)
-> (EditEvt -> EditEvt -> EditEvt)
-> Ord EditEvt
EditEvt -> EditEvt -> Bool
EditEvt -> EditEvt -> Ordering
EditEvt -> EditEvt -> EditEvt
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
min :: EditEvt -> EditEvt -> EditEvt
$cmin :: EditEvt -> EditEvt -> EditEvt
max :: EditEvt -> EditEvt -> EditEvt
$cmax :: EditEvt -> EditEvt -> EditEvt
>= :: EditEvt -> EditEvt -> Bool
$c>= :: EditEvt -> EditEvt -> Bool
> :: EditEvt -> EditEvt -> Bool
$c> :: EditEvt -> EditEvt -> Bool
<= :: EditEvt -> EditEvt -> Bool
$c<= :: EditEvt -> EditEvt -> Bool
< :: EditEvt -> EditEvt -> Bool
$c< :: EditEvt -> EditEvt -> Bool
compare :: EditEvt -> EditEvt -> Ordering
$ccompare :: EditEvt -> EditEvt -> Ordering
$cp1Ord :: Eq EditEvt
Ord)

godir :: a -> a -> EDirection
godir a
wanted a
current = if a
wanted a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
current then EDirection
ELeft else EDirection
ERight

toedstop :: (a ->String->String->(a,Maybe EDirection)) -> a -> EditStopFn
toedstop :: (a -> String -> String -> (a, Maybe EDirection)) -> a -> EditStopFn
toedstop a -> String -> String -> (a, Maybe EDirection)
sf a
st String
b String
a = case a -> String -> String -> (a, Maybe EDirection)
sf a
st String
b String
a of
		      (a
_,Maybe EDirection
Nothing) -> EditStopChoice
EdStop
		      (a
st',Just EDirection
dir) -> EDirection -> EditStopFn -> EditStopChoice
EdGo EDirection
dir ((a -> String -> String -> (a, Maybe EDirection)) -> a -> EditStopFn
forall a.
(a -> String -> String -> (a, Maybe EDirection)) -> a -> EditStopFn
toedstop a -> String -> String -> (a, Maybe EDirection)
sf a
st')

notnull :: [a] -> Bool
notnull = Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

inputbg :: String
inputbg = String -> String -> String
argKey String
"editbg" String
inputBg
inputfg :: String
inputfg = String -> String -> String
argKey String
"editfg" String
inputFg

selectbg :: String
selectbg = String -> String -> String
argKey String
"selectbg" String
inputfg
selectfg :: String
selectfg = String -> String -> String
argKey String
"selectfg" String
inputbg

editF :: FontSpec -> F EditCmd EditEvt
editF :: FontSpec -> F EditCmd EditEvt
editF FontSpec
fontspec =
  let eventmask :: [EventMask]
eventmask = [EventMask
ExposureMask]
      startcmds :: [FRequest]
startcmds = [XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [Gravity -> WindowAttributes
CWBitGravity Gravity
NorthWestGravity,
						  [EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask]]
  in  [FRequest] -> K EditCmd EditEvt -> F EditCmd EditEvt
forall a b. [FRequest] -> K a b -> F a b
windowF [FRequest]
startcmds (FontSpec -> K EditCmd EditEvt
forall a. (FontGen a, Show a) => a -> K EditCmd EditEvt
editK FontSpec
fontspec)

splitwith :: a -> [a] -> (([a], Bool), [a])
splitwith a
c [] = (([], Bool
False), [])
splitwith a
c (a
a : [a]
b) =
    if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c
    then (([], Bool
True), [a]
b)
    else let (([a]
x, Bool
g), [a]
y) = a -> [a] -> (([a], Bool), [a])
splitwith a
c [a]
b
	 in  ((a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
x, Bool
g), [a]
y)

splitwithnl :: String -> ((String, Bool), String)
splitwithnl = Char -> String -> ((String, Bool), String)
forall a. Eq a => a -> [a] -> (([a], Bool), [a])
splitwith Char
newline
tabstop :: Int
tabstop = Int
8
untab :: Int -> String -> String
untab Int
t String
s =
    case String
s of
      Char
'\t':String
s -> let t' :: Int
t' = (Int
t Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
tabstop Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
tabstop
		in Int -> String
spaces (Int
t'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
t) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
untab Int
t' String
s
      Char
c:String
s -> Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Int -> String -> String
untab (if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
newline then Int
0 else (Int
tInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) String
s
      [] -> []

spaces :: Int -> String
spaces Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '

editK :: a -> K EditCmd EditEvt
editK a
fontspec = 
  a -> (FontData -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall a (f :: * -> * -> *) i o.
(FontGen a, FudgetIO f, Show a) =>
a -> (FontData -> f i o) -> f i o
convFontK a
fontspec ((FontData -> K EditCmd EditEvt) -> K EditCmd EditEvt)
-> (FontData -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall a b. (a -> b) -> a -> b
$ \ FontData
fd ->
  FontData -> (FontStruct -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall p. FontData -> (FontStruct -> p) -> p
fontdata2struct FontData
fd ((FontStruct -> K EditCmd EditEvt) -> K EditCmd EditEvt)
-> (FontStruct -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall a b. (a -> b) -> a -> b
$ \ FontStruct
font ->
  String -> (Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall a i o.
(Show a, ColorGen a) =>
a -> (Pixel -> K i o) -> K i o
changeGetBackPixel String
inputbg ((Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt)
-> (Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall a b. (a -> b) -> a -> b
$ \Pixel
bg -> 
  ColormapId
-> String -> (Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> String -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap String
inputfg ((Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt)
-> (Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall a b. (a -> b) -> a -> b
$ \Pixel
fg -> 
  ColormapId
-> String -> (Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> String -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap String
selectbg ((Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt)
-> (Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall a b. (a -> b) -> a -> b
$ \Pixel
sbg -> 
  ColormapId
-> String -> (Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> String -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap String
selectfg ((Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt)
-> (Pixel -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall a b. (a -> b) -> a -> b
$ \Pixel
sfg -> 
  let fid :: FontId
fid = FontStruct -> FontId
forall per_char. FontStructF per_char -> FontId
font_id FontStruct
font
      creategcs :: Pixel -> Pixel -> ((GCId, GCId) -> f b ho) -> f b ho
creategcs Pixel
fg Pixel
bg (GCId, GCId) -> f b ho
cont =
	GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC [GCFunction -> GCAttributes Pixel FontId
forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
GXcopy, FontId -> GCAttributes Pixel FontId
forall a b. b -> GCAttributes a b
GCFont FontId
fid,
			 Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
fg, Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCBackground Pixel
bg] ((GCId -> f b ho) -> f b ho) -> (GCId -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \GCId
gc ->
	GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
gc [Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
bg, Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCBackground Pixel
fg] ((GCId -> f b ho) -> f b ho) -> (GCId -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \GCId
igc -> (GCId, GCId) -> f b ho
cont (GCId
gc,GCId
igc)
  in Pixel
-> Pixel
-> ((GCId, GCId) -> K EditCmd EditEvt)
-> K EditCmd EditEvt
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Pixel -> Pixel -> ((GCId, GCId) -> f b ho) -> f b ho
creategcs Pixel
fg Pixel
bg (((GCId, GCId) -> K EditCmd EditEvt) -> K EditCmd EditEvt)
-> ((GCId, GCId) -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall a b. (a -> b) -> a -> b
$ \(GCId, GCId)
drawGCs ->
     Pixel
-> Pixel
-> ((GCId, GCId) -> K EditCmd EditEvt)
-> K EditCmd EditEvt
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Pixel -> Pixel -> ((GCId, GCId) -> f b ho) -> f b ho
creategcs Pixel
sfg Pixel
sbg (((GCId, GCId) -> K EditCmd EditEvt) -> K EditCmd EditEvt)
-> ((GCId, GCId) -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall a b. (a -> b) -> a -> b
$ \(GCId, GCId)
selectGCs ->
     GCId
-> [GCAttributes Pixel FontId]
-> (GCId -> K EditCmd EditEvt)
-> K EditCmd EditEvt
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC (Pixel -> Pixel -> [GCAttributes Pixel FontId]
forall b. Pixel -> Pixel -> [GCAttributes Pixel b]
invertColorGCattrs Pixel
bg Pixel
fg) ((GCId -> K EditCmd EditEvt) -> K EditCmd EditEvt)
-> (GCId -> K EditCmd EditEvt) -> K EditCmd EditEvt
forall a b. (a -> b) -> a -> b
$ \GCId
invertGC -> 
  let drawimagestring :: GCId -> Point -> String -> FRequest
drawimagestring =
	if (Char, Char) -> Char
forall a b. (a, b) -> b
snd (FontStruct -> (Char, Char)
forall per_char. FontStructF per_char -> (Char, Char)
font_range FontStruct
font) Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\xff'
	then GCId -> Point -> String -> FRequest
wDrawImageString16
	else GCId -> Point -> String -> FRequest
wDrawImageString
      getCurp :: EditField -> (Int, Int)
getCurp = ((String, String) -> Int) -> (Int, (String, String)) -> (Int, Int)
forall t b a. (t -> b) -> (a, t) -> (a, b)
apSnd (String -> Int
eolx(String -> Int)
-> ((String, String) -> String) -> (String, String) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String, String) -> String
forall a b. (a, b) -> a
fst) ((Int, (String, String)) -> (Int, Int))
-> (EditField -> (Int, (String, String)))
-> EditField
-> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditField -> (Int, (String, String))
getLnoEdge
      getLCurp :: EditField -> (Int, Int)
getLCurp = EditField -> (Int, Int)
getCurp (EditField -> (Int, Int))
-> (EditField -> EditField) -> EditField -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EDirection -> EditField -> EditField
setFieldDir EDirection
ELeft
      getRCurp :: EditField -> (Int, Int)
getRCurp = EditField -> (Int, Int)
getCurp (EditField -> (Int, Int))
-> (EditField -> EditField) -> EditField -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EDirection -> EditField -> EditField
setFieldDir EDirection
ERight
      npos :: String -> Int
npos = FontStruct -> String -> Int
next_pos FontStruct
font
      eolx :: String -> Int
eolx = String -> Int
npos (String -> Int) -> (String -> String) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (String -> (String, String)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
splitnl
      maxrmargin :: Int -> String -> Int
maxrmargin Int
x String
s =
	if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s
	then Int
x
	else let (String
l,String
r) = String -> (String, String)
splitnl String
s
	     in String -> (String, String, String, Int) -> Int -> Int
forall a1 a2. Show a1 => String -> a1 -> a2 -> a2
ctrace String
"editF1" (String
s,String
l,String
r,String -> Int
npos String
l) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
npos String
l) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int -> String -> Int
maxrmargin Int
0 String
r
      lno :: (a, b) -> a
lno = (a, b) -> a
forall a b. (a, b) -> a
fst
      xp :: (a, b) -> b
xp = (a, b) -> b
forall a b. (a, b) -> b
snd
      p2line :: Point -> (Int, Int)
p2line (Point Int
x Int
y) = (Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
lheight, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xoffset)
      line2p :: (Int, Int) -> Point
line2p (Int
l, Int
x) = Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xoffset) (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lheight)
      lheight :: Int
lheight = FontStruct -> Int
forall per_char. FontStructF per_char -> Int
linespace FontStruct
font
      move :: Bool -> EditStop -> Mk (EditState a -> K hi ho) ()
move Bool
issel EditStop
estop =
	do EditField
field <- Ms (K hi ho) (EditState a) EditField
forall k a. Ms k (EditState a) EditField
loadField
	   (Int, Int)
lastpos <- Ms (K hi ho) (EditState a) (Int, Int)
forall k a. Ms k (EditState a) (Int, Int)
loadLastpos
	   Mk (EditState a -> K hi ho) ()
forall a hi ho. Mk (EditState a -> K hi ho) ()
invIfShowCursor
	   let curp :: (Int, Int)
curp = EditField -> (Int, Int)
getCurp EditField
field
	       stoppoint :: (Int, Int)
-> (Int, Int) -> String -> String -> ((Int, Int), Maybe EDirection)
stoppoint (Int, Int)
wantp p :: (Int, Int)
p@(Int
l, Int
x) String
bef String
aft = 
		 let dircomp :: (Int, Int) -> EDirection
dircomp = (Int, Int) -> (Int, Int) -> EDirection
forall a. Ord a => a -> a -> EDirection
godir (Int, Int)
wantp
		     dist :: (Int, Int) -> Int
dist (Int, Int)
p' = Int -> Int
forall a. Num a => a -> a
abs ((Int, Int) -> Int
forall a b. (a, b) -> a
lno (Int, Int)
wantp Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Int) -> Int
forall a b. (a, b) -> a
lno (Int, Int)
p') Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Num a => a -> a
abs ((Int, Int) -> Int
forall a b. (a, b) -> b
xp (Int, Int)
wantp Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int, Int) -> Int
forall a b. (a, b) -> b
xp (Int, Int)
p')
		     dir :: EDirection
dir = (Int, Int) -> EDirection
dircomp (Int, Int)
p
		     ahead :: String
ahead = if EDirection
dir EDirection -> EDirection -> Bool
forall a. Eq a => a -> a -> Bool
== EDirection
ELeft then String
bef else String
aft
		 in case String
ahead of
		      [] -> ((Int, Int)
p, Maybe EDirection
forall a. Maybe a
Nothing)
		      Char
c:String
cs -> let p' :: (Int, Int)
p' = if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
newline
				       then (EDirection -> Int
forall p. Num p => EDirection -> p
dirint EDirection
dir Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l, if EDirection
dir EDirection -> EDirection -> Bool
forall a. Eq a => a -> a -> Bool
== EDirection
ERight
							     then Int
0
							     else String -> Int
eolx String
cs)
				       else (Int
l, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ EDirection -> Int
forall p. Num p => EDirection -> p
dirint EDirection
dir Int -> Int -> Int
forall a. Num a => a -> a -> a
* String -> Int
npos [Char
c])
			      in  ((Int, Int)
p', if EDirection
dir EDirection -> EDirection -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> EDirection
dircomp (Int, Int)
p'
				       then EDirection -> Maybe EDirection
forall a. a -> Maybe a
Just EDirection
dir
				       else if (Int, Int) -> Int
dist (Int, Int)
p' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int, Int) -> Int
dist (Int, Int)
p
					    then EDirection -> Maybe EDirection
forall a. a -> Maybe a
Just EDirection
dir
					    else Maybe EDirection
forall a. Maybe a
Nothing)
	       mf :: EditStopFn -> (EditField, String)
mf EditStopFn
sf = Bool -> EditField -> EditStopFn -> (EditField, String)
moveField Bool
issel EditField
field EditStopFn
sf
	       (EditField
field', String
acc) =
		 case EditStop
estop of
		   EditStopFn stopf -> EditStopFn -> (EditField, String)
mf EditStopFn
stopf
		   EditPoint p -> let lp :: (Int, Int)
lp = Point -> (Int, Int)
p2line Point
p
				      dir :: EDirection
dir = (Int, Int) -> (Int, Int) -> EDirection
forall a. Ord a => a -> a -> EDirection
godir (Int, Int)
lp (Int, Int)
curp
				  in  EditStopFn -> (EditField, String)
mf (((Int, Int) -> String -> String -> ((Int, Int), Maybe EDirection))
-> (Int, Int) -> EditStopFn
forall a.
(a -> String -> String -> (a, Maybe EDirection)) -> a -> EditStopFn
toedstop ((Int, Int)
-> (Int, Int) -> String -> String -> ((Int, Int), Maybe EDirection)
stoppoint (Int, Int)
lp) (Int, Int)
curp)
		   EditLine dir -> let wantp :: (Int, Int)
wantp = (EDirection -> Int
forall p. Num p => EDirection -> p
dirint EDirection
dir Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int, Int) -> Int
forall a b. (a, b) -> a
lno (Int, Int)
curp, (Int, Int) -> Int
forall a b. (a, b) -> b
xp (Int, Int)
lastpos)
				   in  EditStopFn -> (EditField, String)
mf (((Int, Int) -> String -> String -> ((Int, Int), Maybe EDirection))
-> (Int, Int) -> EditStopFn
forall a.
(a -> String -> String -> (a, Maybe EDirection)) -> a -> EditStopFn
toedstop ((Int, Int)
-> (Int, Int) -> String -> String -> ((Int, Int), Maybe EDirection)
stoppoint (Int, Int)
wantp) (Int, Int)
curp)
	   EditField -> Mk (EditState a -> K hi ho) ()
forall k a. EditField -> Msc k (EditState a)
storeField EditField
field'
	   let ol :: Int
ol = (Int, Int) -> Int
forall a b. (a, b) -> a
lno (Int, Int)
curp
	       nl :: Int
nl = (Int, Int) -> Int
forall a b. (a, b) -> a
lno ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ EditField -> (Int, Int)
getCurp EditField
field'
	   if Bool
issel
	      then Int -> Int -> Mk (EditState a -> K hi ho) ()
forall a hi ho. Int -> Int -> Mk (EditState a -> K hi ho) ()
showlines (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
ol Int
nl) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
ol Int
nl)
	      else if String -> Bool
forall a. [a] -> Bool
notnull (EditField -> String
getSelection EditField
field)
		   then EditField -> Mk (EditState a -> K hi ho) ()
forall a hi ho. EditField -> Mk (EditState a -> K hi ho) ()
showSelLines EditField
field Mk (EditState a -> K hi ho) ()
-> Mk (EditState a -> K hi ho) () -> Mk (EditState a -> K hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> Mk (EditState a -> K hi ho) ()
forall a hi ho. Int -> Int -> Mk (EditState a -> K hi ho) ()
showlines Int
nl Int
nl
		   else Mk (EditState a -> K hi ho) ()
forall a hi ho. Mk (EditState a -> K hi ho) ()
invIfShowCursor
      showSelLines :: EditField -> Mk (EditState a -> K hi ho) ()
showSelLines EditField
field = 
	     Int -> Int -> Mk (EditState a -> K hi ho) ()
forall a hi ho. Int -> Int -> Mk (EditState a -> K hi ho) ()
showlines ((Int, Int) -> Int
forall a b. (a, b) -> a
lno ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ EditField -> (Int, Int)
getLCurp EditField
field) ((Int, Int) -> Int
forall a b. (a, b) -> a
lno ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ EditField -> (Int, Int)
getRCurp EditField
field) 
      setSize :: (Int, Int) -> Mk (EditState a -> K b c) ()
setSize (Int
l,Int
x) =
	  do old :: (Int, Int)
old@(Int
ol,Int
ox) <- Ms (K b c) (EditState a) (Int, Int)
forall k a. Ms k (EditState a) (Int, Int)
loadTextWidth
	     let new :: (Int, Int)
new@(Int
_,Int
x') = (Int
l,Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
minWidth)
	     Bool
-> Mk (EditState a -> K b c) () -> Mk (EditState a -> K b c) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Int, Int)
old (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int, Int)
new) (Mk (EditState a -> K b c) () -> Mk (EditState a -> K b c) ())
-> Mk (EditState a -> K b c) () -> Mk (EditState a -> K b c) ()
forall a b. (a -> b) -> a -> b
$
	       do (Int, Int) -> Mk (EditState a -> K b c) ()
forall k a. (Int, Int) -> Msc k (EditState a)
storeTextWidth (Int, Int)
new
		  String -> Mk (EditState a -> K b c) ()
forall a1 k r. Show a1 => a1 -> Msc k r
mtrace (String
"before trylayout "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Int, Int, Int) -> String
forall a. Show a => a -> String
show(Int
x,Int
x',Int
ox))
		  Point
x <- Cont (K b c) Point -> Ms (K b c) (EditState a) Point
forall k r s. Cont k r -> Ms k s r
toMs (Cont (K b c) Point -> Ms (K b c) (EditState a) Point)
-> Cont (K b c) Point -> Ms (K b c) (EditState a) Point
forall a b. (a -> b) -> a -> b
$ LayoutRequest -> Cont (K b c) Point
forall b c. LayoutRequest -> Cont (K b c) Point
tryLayoutK (LayoutRequest -> Cont (K b c) Point)
-> LayoutRequest -> Cont (K b c) Point
forall a b. (a -> b) -> a -> b
$
			 Point -> Bool -> Bool -> LayoutRequest
plainLayout ((Int, Int) -> Point
line2p (Int
l,Int
x') Point -> Point -> Point
`padd` Point
llmargin) Bool
True Bool
True
		  String -> Mk (EditState a -> K b c) ()
forall a1 k r. Show a1 => a1 -> Msc k r
mtrace String
"after trylayout"
		  Point -> Mk (EditState a -> K b c) ()
forall k a. Point -> Msc k (EditState a)
storeSize Point
x
	    where mtrace :: a1 -> Msc k r
mtrace a1
x = (k -> k) -> Msc k r
forall k r. (k -> k) -> Msc k r
toMsc (String -> a1 -> k -> k
forall a1 a2. Show a1 => String -> a1 -> a2 -> a2
ctrace String
"editF" a1
x)
      replace' :: String -> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
replace' String
s =
	  do EditField
field <- Ms (K b EditEvt) (EditState (EditField, (Int, Int))) EditField
forall k a. Ms k (EditState a) EditField
loadField
	     Point
size <- Ms (K b EditEvt) (EditState (EditField, (Int, Int))) Point
forall k a. Ms k (EditState a) Point
loadSize
	     Int
width <- Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) Int
forall a k. Mk (EditState a -> k) Int
loadWidth
	     let (Int
ll,Int
lx) = EditField -> (Int, Int)
getLCurp EditField
field
		 uts :: String
uts = Int -> String -> String
untab (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
splitnl (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ EditField -> String
getBef EditField
field) String
s
		 rl :: Int
rl = (Int, Int) -> Int
forall a b. (a, b) -> a
lno ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ EditField -> (Int, Int)
getRCurp EditField
field
		 field' :: EditField
field' = EditField -> String -> EditField
replaceField EditField
field String
uts
		 nls :: Int
nls = String -> Int
nlines String
uts
		 nldown :: Int
nldown = Int
nls Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
rl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ll)
		 copy :: (Int, Int) -> (Int, Int) -> Int -> Mk (r -> f hi ho) ()
copy (Int, Int)
src (Int, Int)
dest Int
h =
		   let srcp :: Point
srcp = (Int, Int) -> Point
line2p (Int, Int)
src
		       r :: Rect
r = Point -> Point -> Rect
Rect Point
srcp (Int -> Int -> Point
pP Int
width Int
h)
		   in Bool -> Mk (r -> f hi ho) () -> Mk (r -> f hi ho) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
hInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) (Mk (r -> f hi ho) () -> Mk (r -> f hi ho) ())
-> Mk (r -> f hi ho) () -> Mk (r -> f hi ho) ()
forall a b. (a -> b) -> a -> b
$
			FRequest -> Mk (r -> f hi ho) ()
forall (f :: * -> * -> *) hi ho r.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs (GCId -> Drawable -> Rect -> Point -> FRequest
wCopyArea ((GCId, GCId) -> GCId
forall a b. (a, b) -> a
fst (GCId, GCId)
drawGCs) Drawable
MyWindow
					    Rect
r ((Int, Int) -> Point
line2p (Int, Int)
dest))
	     (Int
nlines,Int
tw) <- Ms (K b EditEvt) (EditState (EditField, (Int, Int))) (Int, Int)
forall k a. Ms k (EditState a) (Int, Int)
loadTextWidth
	     let changemarg :: String -> EditField -> Int
changemarg String
new EditField
f = Int -> String -> Int
maxrmargin Int
lx (String
new String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a b. (a, b) -> a
fst (String -> (String, String)
splitnl (EditField -> String
getAft EditField
f)))
		 oldm :: Int
oldm = String -> EditField -> Int
changemarg (EditField -> String
getSelection EditField
field) EditField
field
		 newm :: Int
newm = String -> EditField -> Int
changemarg String
uts EditField
field'
		 tw' :: Int
tw' = if Int
newm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
tw
		       then Int
newm
		       else if Int
oldm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
tw
			    then Int
tw
			    else Int -> String -> Int
maxrmargin Int
0 (EditField -> String
getField EditField
field')
		 ss :: (Int, Int)
ss = (EditField -> Int
getLastLineNo EditField
field' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
tw')
	     (Int, Int)
-> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
forall a b c. (Int, Int) -> Mk (EditState a -> K b c) ()
setSize (Int, Int)
ss
	     EditField
-> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
forall (sp :: * -> * -> *) a i.
StreamProcIO sp =>
EditField -> Mk (EditState a -> sp i EditEvt) ()
storeField' EditField
field'
	     UndoStack (EditField, (Int, Int))
us <- Ms
  (K b EditEvt)
  (EditState (EditField, (Int, Int)))
  (UndoStack (EditField, (Int, Int)))
forall k a. Ms k (EditState a) (UndoStack a)
loadUndoStack
	     UndoStack (EditField, (Int, Int))
us' <- UndoStack (EditField, (Int, Int))
-> (EditField, (Int, Int))
-> (UndoStack (EditField, (Int, Int))
    -> Ms
         (K b EditEvt)
         (EditState (EditField, (Int, Int)))
         (UndoStack (EditField, (Int, Int))))
-> Ms
     (K b EditEvt)
     (EditState (EditField, (Int, Int)))
     (UndoStack (EditField, (Int, Int)))
forall a c. UndoStack a -> a -> (UndoStack a -> c) -> c
doit UndoStack (EditField, (Int, Int))
us (EditField
field',(Int, Int)
ss) UndoStack (EditField, (Int, Int))
-> Ms
     (K b EditEvt)
     (EditState (EditField, (Int, Int)))
     (UndoStack (EditField, (Int, Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return
	     UndoStack (EditField, (Int, Int))
-> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
forall a k. UndoStack a -> Msc k (EditState a)
storeUndoStack UndoStack (EditField, (Int, Int))
us'
	     Bool
-> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
-> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nldown Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
 -> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ())
-> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
-> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
forall a b. (a -> b) -> a -> b
$
		let tleft :: Int -> (Int, b)
tleft Int
a = (Int
rl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, b
0)
		    tnl :: (Int, Int)
tnl = Int -> (Int, Int)
forall b. Num b => Int -> (Int, b)
tleft Int
nldown
		in  (Int, Int)
-> (Int, Int)
-> Int
-> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
forall (f :: * -> * -> *) r hi ho.
FudgetIO f =>
(Int, Int) -> (Int, Int) -> Int -> Mk (r -> f hi ho) ()
copy (Int -> (Int, Int)
forall b. Num b => Int -> (Int, b)
tleft Int
0) (Int, Int)
tnl (Point -> Int
ycoord Point
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lheight Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int, Int) -> Int
forall a b. (a, b) -> a
lno (Int, Int)
tnl)
	     Int
-> Int -> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
forall a hi ho. Int -> Int -> Mk (EditState a -> K hi ho) ()
showlines Int
ll (Int
ll Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nls)
      dolines :: a
-> a
-> ((a, Int) -> (String, Bool) -> m ())
-> String
-> (a, Int)
-> m (a, Int)
dolines a
first a
last (a, Int) -> (String, Bool) -> m ()
doline = String -> (a, Int) -> m (a, Int)
du
	 where du :: String -> (a, Int) -> m (a, Int)
du String
s p :: (a, Int)
p@(a
l,Int
x) = let ((String
line,Bool
nl), String
rest) = String -> ((String, Bool), String)
splitwithnl String
s
			      in if a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
last Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then (a, Int) -> m (a, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (a, Int)
p
			      else Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
first) ((a, Int) -> (String, Bool) -> m ()
doline (a, Int)
p (String
line,Bool
nl)) m () -> m (a, Int) -> m (a, Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
				   String -> (a, Int) -> m (a, Int)
du String
rest (if Bool
nl then (a
la -> a -> a
forall a. Num a => a -> a -> a
+a
1,Int
0) else (a
l,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+String -> Int
npos String
line))
      showLine :: (GCId, GCId)
-> (Int, Int) -> (String, Bool) -> Mk (EditState a -> f hi ho) ()
showLine (GCId
gc,GCId
rgc) (Int, Int)
lp (String
line, Bool
withnl) = 
	do let p :: Point
p = (Int, Int) -> Point
line2p (Int, Int)
lp
	       d :: Point
d = Int -> Int -> Point
pP Int
0 (FontStruct -> Int
forall per_char. FontStructF per_char -> Int
font_ascent FontStruct
font)
	   Bool
-> Mk (EditState a -> f hi ho) () -> Mk (EditState a -> f hi ho) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Int, Int) -> Int
forall a b. (a, b) -> b
xp (Int, Int)
lp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Mk (EditState a -> f hi ho) () -> Mk (EditState a -> f hi ho) ())
-> Mk (EditState a -> f hi ho) () -> Mk (EditState a -> f hi ho) ()
forall a b. (a -> b) -> a -> b
$
	     FRequest -> Mk (EditState a -> f hi ho) ()
forall (f :: * -> * -> *) hi ho r.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs (Rect -> Bool -> FRequest
clearArea (Int -> Int -> Int -> Int -> Rect
rR Int
0 (Point -> Int
ycoord Point
p) Int
xoffset Int
lheight) Bool
False)
	   Bool
-> Mk (EditState a -> f hi ho) () -> Mk (EditState a -> f hi ho) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall a. [a] -> Bool
notnull String
line) (Mk (EditState a -> f hi ho) () -> Mk (EditState a -> f hi ho) ())
-> Mk (EditState a -> f hi ho) () -> Mk (EditState a -> f hi ho) ()
forall a b. (a -> b) -> a -> b
$
	     FRequest -> Mk (EditState a -> f hi ho) ()
forall (f :: * -> * -> *) hi ho r.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs (GCId -> Point -> String -> FRequest
drawimagestring GCId
gc (Point
pPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
d) String
line)
	   Bool
-> Mk (EditState a -> f hi ho) () -> Mk (EditState a -> f hi ho) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
withnl (Mk (EditState a -> f hi ho) () -> Mk (EditState a -> f hi ho) ())
-> Mk (EditState a -> f hi ho) () -> Mk (EditState a -> f hi ho) ()
forall a b. (a -> b) -> a -> b
$
	     do Int
width <- Mk (EditState a -> f hi ho) Int
forall a k. Mk (EditState a -> k) Int
loadWidth
		let pc :: Point
pc = Point -> Point -> Point
padd Point
p (Int -> Int -> Point
pP (String -> Int
npos String
line) Int
0)
		    size :: Point
size = Int -> Int -> Point
Point (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Point -> Int
xcoord Point
pc) Int
lheight
		FRequest -> Mk (EditState a -> f hi ho) ()
forall (f :: * -> * -> *) hi ho r.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs (GCId -> Rect -> FRequest
wFillRectangle GCId
rgc (Point -> Point -> Rect
Rect Point
pc Point
size))
      showlines :: Int -> Int -> Mk (EditState a -> K hi ho) ()
showlines Int
first Int
last =
	  do EditField
field <- Ms (K hi ho) (EditState a) EditField
forall k a. Ms k (EditState a) EditField
loadField
	     Bool
showc <- Ms (K hi ho) (EditState a) Bool
forall k a. Ms k (EditState a) Bool
loadShowCursor
	     let clno :: Int
clno = (Int, Int) -> Int
forall a b. (a, b) -> a
lno ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ EditField -> (Int, Int)
getLCurp EditField
field
		 sel :: String
sel = EditField -> String
getSelection EditField
field
		 aft :: String
aft = EditField -> String
getAft EditField
field
		 takenl :: t -> String -> String
takenl t
n String
s = let (String
l,String
r) = String -> (String, String)
splitnl String
s
			      in if t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 then String
l else String
lString -> String -> String
forall a. [a] -> [a] -> [a]
++Char
newlineChar -> String -> String
forall a. a -> [a] -> [a]
:t -> String -> String
takenl (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) String
r
		 bef :: String
bef = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall t. (Ord t, Num t) => t -> String -> String
takenl (Int
clnoInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
first) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ EditField -> String
getBef EditField
field
		 show :: (GCId, GCId)
-> String -> (Int, Int) -> Mk (EditState a -> f hi ho) (Int, Int)
show (GCId, GCId)
gcs = Int
-> Int
-> ((Int, Int) -> (String, Bool) -> Mk (EditState a -> f hi ho) ())
-> String
-> (Int, Int)
-> Mk (EditState a -> f hi ho) (Int, Int)
forall a (m :: * -> *).
(Ord a, Monad m, Num a) =>
a
-> a
-> ((a, Int) -> (String, Bool) -> m ())
-> String
-> (a, Int)
-> m (a, Int)
dolines Int
first Int
last ((GCId, GCId)
-> (Int, Int) -> (String, Bool) -> Mk (EditState a -> f hi ho) ()
forall (f :: * -> * -> *) a hi ho.
FudgetIO f =>
(GCId, GCId)
-> (Int, Int) -> (String, Bool) -> Mk (EditState a -> f hi ho) ()
showLine (GCId, GCId)
gcs)
	     (GCId, GCId)
-> String -> (Int, Int) -> Mk (EditState a -> K hi ho) (Int, Int)
forall (f :: * -> * -> *) a hi ho.
FudgetIO f =>
(GCId, GCId)
-> String -> (Int, Int) -> Mk (EditState a -> f hi ho) (Int, Int)
show (GCId, GCId)
drawGCs String
bef (Int
clnoInt -> Int -> Int
forall a. Num a => a -> a -> a
-String -> Int
nlines String
bef,Int
0) Mk (EditState a -> K hi ho) (Int, Int)
-> ((Int, Int) -> Mk (EditState a -> K hi ho) (Int, Int))
-> Mk (EditState a -> K hi ho) (Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
		(GCId, GCId)
-> String -> (Int, Int) -> Mk (EditState a -> K hi ho) (Int, Int)
forall (f :: * -> * -> *) a hi ho.
FudgetIO f =>
(GCId, GCId)
-> String -> (Int, Int) -> Mk (EditState a -> f hi ho) (Int, Int)
show (if Bool
showc then (GCId, GCId)
selectGCs else (GCId, GCId)
drawGCs) String
sel Mk (EditState a -> K hi ho) (Int, Int)
-> ((Int, Int) -> Mk (EditState a -> K hi ho) (Int, Int))
-> Mk (EditState a -> K hi ho) (Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
		(GCId, GCId)
-> String -> (Int, Int) -> Mk (EditState a -> K hi ho) (Int, Int)
forall (f :: * -> * -> *) a hi ho.
FudgetIO f =>
(GCId, GCId)
-> String -> (Int, Int) -> Mk (EditState a -> f hi ho) (Int, Int)
show (GCId, GCId)
drawGCs (String
aftString -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
newline]) Mk (EditState a -> K hi ho) (Int, Int)
-> ((Int, Int) -> Mk (EditState a -> K hi ho) ())
-> Mk (EditState a -> K hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int, Int)
_ ->
		Bool
-> Mk (EditState a -> K hi ho) () -> Mk (EditState a -> K hi ho) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
clno Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
first Bool -> Bool -> Bool
&& Int
clno Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
last) Mk (EditState a -> K hi ho) ()
forall a hi ho. Mk (EditState a -> K hi ho) ()
invIfShowCursor
      showCursor :: Bool -> Mk (EditState a -> K hi ho) ()
showCursor Bool
v = do Bool
cv <- Ms (K hi ho) (EditState a) Bool
forall k a. Ms k (EditState a) Bool
loadShowCursor
			Bool
-> Mk (EditState a -> K hi ho) () -> Mk (EditState a -> K hi ho) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
v Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
cv ) (Mk (EditState a -> K hi ho) () -> Mk (EditState a -> K hi ho) ())
-> Mk (EditState a -> K hi ho) () -> Mk (EditState a -> K hi ho) ()
forall a b. (a -> b) -> a -> b
$
			  do EditField
field <- Ms (K hi ho) (EditState a) EditField
forall k a. Ms k (EditState a) EditField
loadField
			     Bool -> Mk (EditState a -> K hi ho) ()
forall k a. Bool -> Msc k (EditState a)
storeShowCursor Bool
v
			     if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EditField -> String
getSelection EditField
field) then
			       Mk (EditState a -> K hi ho) ()
forall a hi ho. Mk (EditState a -> K hi ho) ()
invCursor
			       else EditField -> Mk (EditState a -> K hi ho) ()
forall a hi ho. EditField -> Mk (EditState a -> K hi ho) ()
showSelLines EditField
field
      invIfShowCursor :: Mk (EditState a -> K hi ho) ()
invIfShowCursor = do Bool
cv <- Ms (K hi ho) (EditState a) Bool
forall k a. Ms k (EditState a) Bool
loadShowCursor
			   Bool
-> Mk (EditState a -> K hi ho) () -> Mk (EditState a -> K hi ho) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cv Mk (EditState a -> K hi ho) ()
forall a hi ho. Mk (EditState a -> K hi ho) ()
invCursor
      invCursor :: Mk (EditState a -> K hi ho) ()
invCursor = do EditField
field <- Ms (K hi ho) (EditState a) EditField
forall k a. Ms k (EditState a) EditField
loadField
		     let lp :: (Int, Int)
lp = EditField -> (Int, Int)
getCurp EditField
field
			 sel :: String
sel = EditField -> String
getSelection EditField
field
		     Bool
-> Mk (EditState a -> K hi ho) () -> Mk (EditState a -> K hi ho) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
sel) (Mk (EditState a -> K hi ho) () -> Mk (EditState a -> K hi ho) ())
-> Mk (EditState a -> K hi ho) () -> Mk (EditState a -> K hi ho) ()
forall a b. (a -> b) -> a -> b
$
		       let p :: Point
p = (Int, Int) -> Point
line2p ((Int -> Int) -> (Int, Int) -> (Int, Int)
forall t b a. (t -> b) -> (a, t) -> (a, b)
apSnd ((-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int, Int)
lp)
			   s :: Point
s = Int -> Int -> Point
pP Int
1 Int
lheight
			   cur :: Rect
cur = Point -> Point -> Rect
Rect Point
p Point
s
		       in  FRequest -> Mk (EditState a -> K hi ho) ()
forall (f :: * -> * -> *) hi ho r.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs (GCId -> Rect -> FRequest
wFillRectangle GCId
invertGC Rect
cur)
      redraw :: Mk (EditState a -> K hi ho) ()
redraw = do --field <- loadField
		  Point
size <- Ms (K hi ho) (EditState a) Point
forall k a. Ms k (EditState a) Point
loadSize
		  FRequest -> Mk (EditState a -> K hi ho) ()
forall (f :: * -> * -> *) hi ho r.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs (Rect -> Bool -> FRequest
clearArea (Point -> Point -> Rect
Rect Point
origin Point
size) Bool
True)
      expose :: Rect -> Mk (EditState a -> K hi ho) ()
expose Rect
r = let Line Point
l1 Point
l2 = Rect -> Line
rect2line Rect
r
		 in Int -> Int -> Mk (EditState a -> K hi ho) ()
forall a hi ho. Int -> Int -> Mk (EditState a -> K hi ho) ()
showlines ((Int, Int) -> Int
forall a b. (a, b) -> a
lno (Point -> (Int, Int)
p2line Point
l1)) ((Int, Int) -> Int
forall a b. (a, b) -> a
lno (Point -> (Int, Int)
p2line Point
l2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      undoredo :: (UndoStack a -> Maybe ((EditField, (Int, Int)), UndoStack a))
-> Mk (EditState a -> K i EditEvt) ()
undoredo UndoStack a -> Maybe ((EditField, (Int, Int)), UndoStack a)
d =
	do UndoStack a
us <- Ms (K i EditEvt) (EditState a) (UndoStack a)
forall k a. Ms k (EditState a) (UndoStack a)
loadUndoStack
	   case UndoStack a -> Maybe ((EditField, (Int, Int)), UndoStack a)
d UndoStack a
us of
	     Maybe ((EditField, (Int, Int)), UndoStack a)
Nothing -> Mk (EditState a -> K i EditEvt) ()
forall k s. Msc k s
nopMs
	     Just ((EditField
field,(Int, Int)
size),UndoStack a
us') -> do UndoStack a -> Mk (EditState a -> K i EditEvt) ()
forall a k. UndoStack a -> Msc k (EditState a)
storeUndoStack UndoStack a
us'
					   EditField -> Mk (EditState a -> K i EditEvt) ()
forall (sp :: * -> * -> *) a i.
StreamProcIO sp =>
EditField -> Mk (EditState a -> sp i EditEvt) ()
storeField' EditField
field
					   (Int, Int) -> Mk (EditState a -> K i EditEvt) ()
forall a b c. (Int, Int) -> Mk (EditState a -> K b c) ()
setSize (Int, Int)
size
					   Mk (EditState a -> K i EditEvt) ()
forall a hi ho. Mk (EditState a -> K hi ho) ()
redraw

      storeField' :: EditField -> Mk (EditState a -> sp i EditEvt) ()
storeField' EditField
field' =
	do EditField -> Mk (EditState a -> sp i EditEvt) ()
forall k a. EditField -> Msc k (EditState a)
storeField EditField
field'
	   EditEvt -> Mk (EditState a -> sp i EditEvt) ()
forall (sp :: * -> * -> *) o i r.
StreamProcIO sp =>
o -> Msc (sp i o) r
putHighMs (InputMsg String -> EditEvt
EditChange (InputMsg String -> EditEvt) -> InputMsg String -> EditEvt
forall a b. (a -> b) -> a -> b
$ String -> InputMsg String
forall a. a -> InputMsg a
InputChange (String -> InputMsg String) -> String -> InputMsg String
forall a b. (a -> b) -> a -> b
$ EditField -> String
getField EditField
field')

      puttext' :: (EditField -> o) -> Mk (EditState a -> sp i o) ()
puttext' EditField -> o
f = do EditField
field <- Ms (sp i o) (EditState a) EditField
forall k a. Ms k (EditState a) EditField
loadField
		      o -> Mk (EditState a -> sp i o) ()
forall (sp :: * -> * -> *) o i r.
StreamProcIO sp =>
o -> Msc (sp i o) r
putHighMs (EditField -> o
f EditField
field)

      puttext :: (EditField -> String) -> Mk (EditState a -> sp i EditEvt) ()
puttext EditField -> String
f = (EditField -> EditEvt) -> Mk (EditState a -> sp i EditEvt) ()
forall (sp :: * -> * -> *) o a i.
StreamProcIO sp =>
(EditField -> o) -> Mk (EditState a -> sp i o) ()
puttext' (String -> EditEvt
EditText (String -> EditEvt)
-> (EditField -> String) -> EditField -> EditEvt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditField -> String
f)

      putCursor :: Mk (EditState a -> K i EditEvt) ()
putCursor =
        do EditField
field <- Ms (K i EditEvt) (EditState a) EditField
forall k a. Ms k (EditState a) EditField
loadField
	   let lastpos :: (Int, Int)
lastpos = EditField -> (Int, Int)
getCurp EditField
field
	   EditEvt -> Mk (EditState a -> K i EditEvt) ()
forall (sp :: * -> * -> *) o i r.
StreamProcIO sp =>
o -> Msc (sp i o) r
putHighMs (Rect -> EditEvt
EditCursor (Rect -> EditEvt) -> Rect -> EditEvt
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Rect
Rect ((Int, Int) -> Point
line2p (Int, Int)
lastpos Point -> Point -> Point
`psub` Int -> Int -> Point
Point Int
xoffset Int
0) 
					(Int -> Int -> Point
Point Int
xoffset Int
lheight Point -> Point -> Point
`padd` Point
llmargin))

      handleLow :: FResponse -> Mk (EditState a -> K a b) ()
handleLow FResponse
msg =
	case FResponse
msg of
	  XEvt (Expose Rect
r Int
aft) -> Cont (K a b) Rect -> Ms (K a b) (EditState a) Rect
forall k r s. Cont k r -> Ms k s r
toMs (Bool -> Rect -> Int -> Cont (K a b) Rect
forall a b. Bool -> Rect -> Int -> (Rect -> K a b) -> K a b
maxExposeK Bool
False Rect
r Int
aft) Ms (K a b) (EditState a) Rect
-> (Rect -> Mk (EditState a -> K a b) ())
-> Mk (EditState a -> K a b) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Rect -> Mk (EditState a -> K a b) ()
forall a hi ho. Rect -> Mk (EditState a -> K hi ho) ()
expose
	  XEvt (GraphicsExpose Rect
r Int
aft Int
_ Int
_) -> Cont (K a b) Rect -> Ms (K a b) (EditState a) Rect
forall k r s. Cont k r -> Ms k s r
toMs (Bool -> Rect -> Int -> Cont (K a b) Rect
forall a b. Bool -> Rect -> Int -> (Rect -> K a b) -> K a b
maxExposeK Bool
True Rect
r Int
aft) Ms (K a b) (EditState a) Rect
-> (Rect -> Mk (EditState a -> K a b) ())
-> Mk (EditState a -> K a b) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Rect -> Mk (EditState a -> K a b) ()
forall a hi ho. Rect -> Mk (EditState a -> K hi ho) ()
expose
	  LEvt (LayoutSize Point
s) -> Point -> Mk (EditState a -> K a b) ()
forall k a. Point -> Msc k (EditState a)
storeSize Point
s
          FResponse
_ -> Mk (EditState a -> K a b) ()
forall k s. Msc k s
nopMs

      handleHigh :: EditCmd
-> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
handleHigh EditCmd
cmd =
	do case EditCmd
cmd of
	     EditShowCursor Bool
s -> Bool -> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
forall a hi ho. Bool -> Mk (EditState a -> K hi ho) ()
showCursor Bool
s
	     EditMove EditStop
estop Bool
issel -> Bool
-> EditStop
-> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
forall a hi ho. Bool -> EditStop -> Mk (EditState a -> K hi ho) ()
move Bool
issel EditStop
estop
	     EditReplace String
s -> String -> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
forall b.
String -> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
replace' String
s
	     EditCmd
EditGetText -> (EditField -> String)
-> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
forall (sp :: * -> * -> *) a i.
StreamProcIO sp =>
(EditField -> String) -> Mk (EditState a -> sp i EditEvt) ()
puttext EditField -> String
getField
	     EditCmd
EditGetField -> (EditField -> EditEvt)
-> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
forall (sp :: * -> * -> *) o a i.
StreamProcIO sp =>
(EditField -> o) -> Mk (EditState a -> sp i o) ()
puttext' ((String, String, String) -> EditEvt
EditField ((String, String, String) -> EditEvt)
-> (EditField -> (String, String, String)) -> EditField -> EditEvt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditField -> (String, String, String)
getField')
	     EditCmd
EditGetSelection -> (EditField -> String)
-> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
forall (sp :: * -> * -> *) a i.
StreamProcIO sp =>
(EditField -> String) -> Mk (EditState a -> sp i EditEvt) ()
puttext EditField -> String
getSelection
	     EditCmd
EditUndo -> (UndoStack (EditField, (Int, Int))
 -> Maybe
      ((EditField, (Int, Int)), UndoStack (EditField, (Int, Int))))
-> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
forall a i.
(UndoStack a -> Maybe ((EditField, (Int, Int)), UndoStack a))
-> Mk (EditState a -> K i EditEvt) ()
undoredo UndoStack (EditField, (Int, Int))
-> Maybe
     ((EditField, (Int, Int)), UndoStack (EditField, (Int, Int)))
forall a. UndoStack a -> Maybe (a, UndoStack a)
undo
	     EditCmd
EditRedo -> (UndoStack (EditField, (Int, Int))
 -> Maybe
      ((EditField, (Int, Int)), UndoStack (EditField, (Int, Int))))
-> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
forall a i.
(UndoStack a -> Maybe ((EditField, (Int, Int)), UndoStack a))
-> Mk (EditState a -> K i EditEvt) ()
undoredo UndoStack (EditField, (Int, Int))
-> Maybe
     ((EditField, (Int, Int)), UndoStack (EditField, (Int, Int)))
forall a. UndoStack a -> Maybe (a, UndoStack a)
redo
	   Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
forall a i. Mk (EditState a -> K i EditEvt) ()
putCursor
	   EditField
field <- Ms (K hi EditEvt) (EditState (EditField, (Int, Int))) EditField
forall k a. Ms k (EditState a) EditField
loadField
	   let lastpos :: (Int, Int)
lastpos = EditField -> (Int, Int)
getCurp EditField
field
	   case EditCmd
cmd of
	     EditMove (EditLine EDirection
_) Bool
_ -> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
forall k s. Msc k s
nopMs
	     EditCmd
_ -> (Int, Int)
-> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
forall k a. (Int, Int) -> Msc k (EditState a)
storeLastpos (Int, Int)
lastpos

      proc :: Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) b
proc = do (FResponse
 -> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) ())
-> (EditCmd
    -> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) ())
-> Message FResponse EditCmd
-> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) ()
forall t1 p t2. (t1 -> p) -> (t2 -> p) -> Message t1 t2 -> p
message FResponse
-> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) ()
forall a a b. FResponse -> Mk (EditState a -> K a b) ()
handleLow EditCmd
-> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) ()
forall hi.
EditCmd
-> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
handleHigh (Message FResponse EditCmd
 -> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) ())
-> Mk
     (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt)
     (Message FResponse EditCmd)
-> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Mk
  (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt)
  (Message FResponse EditCmd)
forall hi ho s. Ms (K hi ho) s (KEvent hi)
getKs
		Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) b
proc


  in  EditState (EditField, (Int, Int))
-> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) Any
-> K EditCmd EditEvt
-> K EditCmd EditEvt
forall b1 a b2. b1 -> Mk (b1 -> a) b2 -> a -> a
stateK EditState (EditField, (Int, Int))
forall a. EditState a
initstate ((Int, Int)
-> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) ()
forall a b c. (Int, Int) -> Mk (EditState a -> K b c) ()
setSize (Int
1,Int
0) Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) ()
-> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) Any
-> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) Any
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) Any
forall b.
Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) b
proc) K EditCmd EditEvt
forall hi ho. K hi ho
nullK

minWidth :: Int
minWidth = Int
10
xoffset :: Int
xoffset = Int
2
llmargin :: Point
llmargin = Int -> Int -> Point
Point Int
2 Int
2

defaultuslimit :: Maybe a
defaultuslimit = Maybe a
forall a. Maybe a
Nothing
uslimit :: Maybe Int
uslimit = let ul :: Int
ul = String -> Int -> Int
forall p. (Read p, Show p) => String -> p -> p
argReadKey String
"undodepth" (-Int
1)
	  in if Int
ul Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 then Maybe Int
forall a. Maybe a
defaultuslimit else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
ul

data EditState a = S { EditState a -> Bool
shocur :: Bool,
		       EditState a -> (Int, Int)
twidth :: (Int,Int),
		       EditState a -> UndoStack a
undostack :: UndoStack a,
		       EditState a -> EditField
field :: EditField,
		       EditState a -> Point
size :: Point,
		       EditState a -> (Int, Int)
lastpos :: (Int,Int)
		       }

--initstate = (False,(1,0),undoStack uslimit, createField "", origin, (0, 0))
initstate :: EditState a
initstate = Bool
-> (Int, Int)
-> UndoStack a
-> EditField
-> Point
-> (Int, Int)
-> EditState a
forall a.
Bool
-> (Int, Int)
-> UndoStack a
-> EditField
-> Point
-> (Int, Int)
-> EditState a
S Bool
False (Int
1,Int
0) (Maybe Int -> UndoStack a
forall a. Maybe Int -> UndoStack a
undoStack Maybe Int
uslimit) (String -> EditField
createField String
"") Point
origin (Int
0, Int
0)

loadShowCursor :: Ms k (EditState a) Bool
loadShowCursor = (EditState a -> Bool) -> Ms k (EditState a) Bool
forall s f k. (s -> f) -> Ms k s f
fieldMs EditState a -> Bool
forall a. EditState a -> Bool
shocur
loadTextWidth :: Ms k (EditState a) (Int, Int)
loadTextWidth = (EditState a -> (Int, Int)) -> Ms k (EditState a) (Int, Int)
forall s f k. (s -> f) -> Ms k s f
fieldMs  EditState a -> (Int, Int)
forall a. EditState a -> (Int, Int)
twidth
loadUndoStack :: Ms k (EditState a) (UndoStack a)
loadUndoStack = (EditState a -> UndoStack a) -> Ms k (EditState a) (UndoStack a)
forall s f k. (s -> f) -> Ms k s f
fieldMs  EditState a -> UndoStack a
forall a. EditState a -> UndoStack a
undostack
loadField :: Ms k (EditState a) EditField
loadField = (EditState a -> EditField) -> Ms k (EditState a) EditField
forall s f k. (s -> f) -> Ms k s f
fieldMs EditState a -> EditField
forall a. EditState a -> EditField
field
loadSize :: Ms k (EditState a) Point
loadSize = (EditState a -> Point) -> Ms k (EditState a) Point
forall s f k. (s -> f) -> Ms k s f
fieldMs EditState a -> Point
forall a. EditState a -> Point
size
loadLastpos :: Ms k (EditState a) (Int, Int)
loadLastpos = (EditState a -> (Int, Int)) -> Ms k (EditState a) (Int, Int)
forall s f k. (s -> f) -> Ms k s f
fieldMs EditState a -> (Int, Int)
forall a. EditState a -> (Int, Int)
lastpos
--loadWidth = loadSize >>= \size -> return (xcoord size)
loadWidth :: Mk (EditState a -> k) Int
loadWidth = (Point -> Int)
-> Mk (EditState a -> k) Point -> Mk (EditState a -> k) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point -> Int
xcoord Mk (EditState a -> k) Point
forall k a. Ms k (EditState a) Point
loadSize


#define MODMS(lbl) ( \ lbl -> (modMs ( \ s -> s { lbl=lbl } )))

storeShowCursor :: Bool -> Msc k (EditState a)
storeShowCursor = MODMS(shocur)
storeTextWidth :: (Int, Int) -> Msc k (EditState a)
storeTextWidth  = MODMS(twidth)
storeUndoStack :: UndoStack a -> Msc k (EditState a)
storeUndoStack  = MODMS(undostack)
storeField :: EditField -> Msc k (EditState a)
storeField      = MODMS(field)
storeSize :: Point -> Msc k (EditState a)
storeSize       = MODMS(size)
storeLastpos :: (Int, Int) -> Msc k (EditState a)
storeLastpos    = MODMS(lastpos)