{-# 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
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
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
Ord)

godir :: a -> a -> EDirection
godir a
wanted a
current = if a
wanted 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 :: forall a.
(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 (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [Gravity -> WindowAttributes
CWBitGravity Gravity
NorthWestGravity,
						  [EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask]]
  in  forall a b. [FRequest] -> K a b -> F a b
windowF [FRequest]
startcmds (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 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 forall a. a -> [a] -> [a]
: [a]
x, Bool
g), [a]
y)

splitwithnl :: String -> ((String, Bool), String)
splitwithnl = 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 forall a. Integral a => a -> a -> a
`div` Int
tabstop forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
* Int
tabstop
		in Int -> String
spaces (Int
t'forall a. Num a => a -> a -> a
-Int
t) forall a. [a] -> [a] -> [a]
++ Int -> String -> String
untab Int
t' String
s
      Char
c:String
s -> Char
cforall a. a -> [a] -> [a]
:Int -> String -> String
untab (if Char
c forall a. Eq a => a -> a -> Bool
== Char
newline then Int
0 else (Int
tforall a. Num a => a -> a -> a
+Int
1)) String
s
      [] -> []

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

editK :: a -> K EditCmd EditEvt
editK a
fontspec = 
  forall {a} {f :: * -> * -> *} {i} {o}.
(FontGen a, FudgetIO f, Show a) =>
a -> (FontData -> f i o) -> f i o
convFontK a
fontspec forall a b. (a -> b) -> a -> b
$ \ FontData
fd ->
  forall {t}. FontData -> (FontStruct -> t) -> t
fontdata2struct FontData
fd forall a b. (a -> b) -> a -> b
$ \ FontStruct
font ->
  forall {a} {i} {o}.
(Show a, ColorGen a) =>
a -> (Pixel -> K i o) -> K i o
changeGetBackPixel String
inputbg forall a b. (a -> b) -> a -> b
$ \Pixel
bg -> 
  forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> String -> Cont (f hi ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap String
inputfg forall a b. (a -> b) -> a -> b
$ \Pixel
fg -> 
  forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> String -> Cont (f hi ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap String
selectbg forall a b. (a -> b) -> a -> b
$ \Pixel
sbg -> 
  forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> String -> Cont (f hi ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap String
selectfg forall a b. (a -> b) -> a -> b
$ \Pixel
sfg -> 
  let fid :: FontId
fid = forall per_char. FontStructF per_char -> FontId
font_id FontStruct
font
      creategcs :: Pixel -> Pixel -> ((GCId, GCId) -> f hi ho) -> f hi ho
creategcs Pixel
fg Pixel
bg (GCId, GCId) -> f hi ho
cont =
	forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
rootGC [forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
GXcopy, forall a b. b -> GCAttributes a b
GCFont FontId
fid,
			 forall a b. a -> GCAttributes a b
GCForeground Pixel
fg, forall a b. a -> GCAttributes a b
GCBackground Pixel
bg] forall a b. (a -> b) -> a -> b
$ \GCId
gc ->
	forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
gc [forall a b. a -> GCAttributes a b
GCForeground Pixel
bg, forall a b. a -> GCAttributes a b
GCBackground Pixel
fg] forall a b. (a -> b) -> a -> b
$ \GCId
igc -> (GCId, GCId) -> f hi ho
cont (GCId
gc,GCId
igc)
  in forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Pixel -> Pixel -> ((GCId, GCId) -> f hi ho) -> f hi ho
creategcs Pixel
fg Pixel
bg forall a b. (a -> b) -> a -> b
$ \(GCId, GCId)
drawGCs ->
     forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Pixel -> Pixel -> ((GCId, GCId) -> f hi ho) -> f hi ho
creategcs Pixel
sfg Pixel
sbg forall a b. (a -> b) -> a -> b
$ \(GCId, GCId)
selectGCs ->
     forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
rootGC (forall {b}. Pixel -> Pixel -> [GCAttributes Pixel b]
invertColorGCattrs Pixel
bg Pixel
fg) forall a b. (a -> b) -> a -> b
$ \GCId
invertGC -> 
  let drawimagestring :: GCId -> Point -> String -> FRequest
drawimagestring =
	if forall a b. (a, b) -> b
snd (forall {per_char}. FontStructF per_char -> (Char, Char)
font_range FontStruct
font) 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 = forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
apSnd (String -> Int
eolxforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditField -> (Int, (String, String))
getLnoEdge
      getLCurp :: EditField -> (Int, Int)
getLCurp = EditField -> (Int, Int)
getCurp 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
splitnl
      maxrmargin :: Int -> String -> Int
maxrmargin Int
x String
s =
	if 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 forall {a1} {a2}. Show a1 => String -> a1 -> a2 -> a2
ctrace String
"editF1" (String
s,String
l,String
r,String -> Int
npos String
l) forall a b. (a -> b) -> a -> b
$ (Int
x forall a. Num a => a -> a -> a
+ String -> Int
npos String
l) forall a. Ord a => a -> a -> a
`max` Int -> String -> Int
maxrmargin Int
0 String
r
      lno :: (a, b) -> a
lno = forall a b. (a, b) -> a
fst
      xp :: (a, b) -> b
xp = forall a b. (a, b) -> b
snd
      p2line :: Point -> (Int, Int)
p2line (Point Int
x Int
y) = (Int
y forall a. Integral a => a -> a -> a
`quot` Int
lheight, Int
x forall a. Num a => a -> a -> a
- Int
xoffset)
      line2p :: (Int, Int) -> Point
line2p (Int
l, Int
x) = Int -> Int -> Point
Point (Int
x forall a. Num a => a -> a -> a
+ Int
xoffset) (Int
l forall a. Num a => a -> a -> a
* Int
lheight)
      lheight :: Int
lheight = 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 <- forall {k} {a}. Ms k (EditState a) EditField
loadField
	   (Int, Int)
lastpos <- forall {k} {a}. Ms k (EditState a) (Int, Int)
loadLastpos
	   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 = forall {a}. Ord a => a -> a -> EDirection
godir (Int, Int)
wantp
		     dist :: (Int, Int) -> Int
dist (Int, Int)
p' = forall a. Num a => a -> a
abs (forall a b. (a, b) -> a
lno (Int, Int)
wantp forall a. Num a => a -> a -> a
- forall a b. (a, b) -> a
lno (Int, Int)
p') forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
abs (forall a b. (a, b) -> b
xp (Int, Int)
wantp forall a. Num a => a -> a -> a
- 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 forall a. Eq a => a -> a -> Bool
== EDirection
ELeft then String
bef else String
aft
		 in case String
ahead of
		      [] -> ((Int, Int)
p, forall a. Maybe a
Nothing)
		      Char
c:String
cs -> let p' :: (Int, Int)
p' = if Char
c forall a. Eq a => a -> a -> Bool
== Char
newline
				       then (forall {a}. Num a => EDirection -> a
dirint EDirection
dir forall a. Num a => a -> a -> a
+ Int
l, if EDirection
dir forall a. Eq a => a -> a -> Bool
== EDirection
ERight
							     then Int
0
							     else String -> Int
eolx String
cs)
				       else (Int
l, Int
x forall a. Num a => a -> a -> a
+ forall {a}. Num a => EDirection -> a
dirint EDirection
dir forall a. Num a => a -> a -> a
* String -> Int
npos [Char
c])
			      in  ((Int, Int)
p', if EDirection
dir forall a. Eq a => a -> a -> Bool
== (Int, Int) -> EDirection
dircomp (Int, Int)
p'
				       then forall a. a -> Maybe a
Just EDirection
dir
				       else if (Int, Int) -> Int
dist (Int, Int)
p' forall a. Ord a => a -> a -> Bool
< (Int, Int) -> Int
dist (Int, Int)
p
					    then forall a. a -> Maybe a
Just EDirection
dir
					    else 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 EditStopFn
stopf -> EditStopFn -> (EditField, String)
mf EditStopFn
stopf
		   EditPoint Point
p -> let lp :: (Int, Int)
lp = Point -> (Int, Int)
p2line Point
p
				      dir :: EDirection
dir = forall {a}. Ord a => a -> a -> EDirection
godir (Int, Int)
lp (Int, Int)
curp
				  in  EditStopFn -> (EditField, String)
mf (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 EDirection
dir -> let wantp :: (Int, Int)
wantp = (forall {a}. Num a => EDirection -> a
dirint EDirection
dir forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> a
lno (Int, Int)
curp, forall a b. (a, b) -> b
xp (Int, Int)
lastpos)
				   in  EditStopFn -> (EditField, String)
mf (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)
	   forall {k} {a}. EditField -> Msc k (EditState a)
storeField EditField
field'
	   let ol :: Int
ol = forall a b. (a, b) -> a
lno (Int, Int)
curp
	       nl :: Int
nl = forall a b. (a, b) -> a
lno forall a b. (a -> b) -> a -> b
$ EditField -> (Int, Int)
getCurp EditField
field'
	   if Bool
issel
	      then forall {a} {hi} {ho}. Int -> Int -> Mk (EditState a -> K hi ho) ()
showlines (forall a. Ord a => a -> a -> a
min Int
ol Int
nl) (forall a. Ord a => a -> a -> a
max Int
ol Int
nl)
	      else if forall {a}. [a] -> Bool
notnull (EditField -> String
getSelection EditField
field)
		   then forall {a} {hi} {ho}. EditField -> Mk (EditState a -> K hi ho) ()
showSelLines EditField
field forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a} {hi} {ho}. Int -> Int -> Mk (EditState a -> K hi ho) ()
showlines Int
nl Int
nl
		   else forall {a} {hi} {ho}. Mk (EditState a -> K hi ho) ()
invIfShowCursor
      showSelLines :: EditField -> Mk (EditState a -> K hi ho) ()
showSelLines EditField
field = 
	     forall {a} {hi} {ho}. Int -> Int -> Mk (EditState a -> K hi ho) ()
showlines (forall a b. (a, b) -> a
lno forall a b. (a -> b) -> a -> b
$ EditField -> (Int, Int)
getLCurp EditField
field) (forall a b. (a, b) -> a
lno 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) <- forall {k} {a}. Ms k (EditState a) (Int, Int)
loadTextWidth
	     let new :: (Int, Int)
new@(Int
_,Int
x') = (Int
l,forall a. Ord a => a -> a -> a
max Int
x Int
minWidth)
	     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Int, Int)
old forall a. Eq a => a -> a -> Bool
/= (Int, Int)
new) forall a b. (a -> b) -> a -> b
$
	       do forall {k} {a}. (Int, Int) -> Msc k (EditState a)
storeTextWidth (Int, Int)
new
		  forall {a1} {k} {r}. Show a1 => a1 -> Msc k r
mtrace (String
"before trylayout "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show(Int
x,Int
x',Int
ox))
		  Point
x <- forall k r s. Cont k r -> Ms k s r
toMs forall a b. (a -> b) -> a -> b
$ forall {b} {c}. LayoutRequest -> Cont (K b c) Point
tryLayoutK 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
		  forall {a1} {k} {r}. Show a1 => a1 -> Msc k r
mtrace String
"after trylayout"
		  forall {k} {a}. Point -> Msc k (EditState a)
storeSize Point
x
	    where mtrace :: a1 -> Msc k r
mtrace a1
x = forall k r. (k -> k) -> Msc k r
toMsc (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 <- forall {k} {a}. Ms k (EditState a) EditField
loadField
	     Point
size <- forall {k} {a}. Ms k (EditState a) Point
loadSize
	     Int
width <- 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 (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ String -> (String, String)
splitnl forall a b. (a -> b) -> a -> b
$ EditField -> String
getBef EditField
field) String
s
		 rl :: Int
rl = forall a b. (a, b) -> a
lno 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 forall a. Num a => a -> a -> a
- (Int
rl 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 forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
hforall a. Ord a => a -> a -> Bool
>Int
0) forall a b. (a -> b) -> a -> b
$
			forall {f :: * -> * -> *} {hi} {ho} {r}.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs (GCId -> Drawable -> Rect -> Point -> FRequest
wCopyArea (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) <- 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 forall a. [a] -> [a] -> [a]
++ 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 forall a. Ord a => a -> a -> Bool
>= Int
tw
		       then Int
newm
		       else if Int
oldm 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' forall a. Num a => a -> a -> a
+ Int
1, Int
tw')
	     forall {a} {b} {c}. (Int, Int) -> Mk (EditState a -> K b c) ()
setSize (Int, Int)
ss
	     forall {sp :: * -> * -> *} {a} {i}.
StreamProcIO sp =>
EditField -> Mk (EditState a -> sp i EditEvt) ()
storeField' EditField
field'
	     UndoStack (EditField, (Int, Int))
us <- forall {k} {a}. Ms k (EditState a) (UndoStack a)
loadUndoStack
	     UndoStack (EditField, (Int, Int))
us' <- forall a c. UndoStack a -> a -> (UndoStack a -> c) -> c
doit UndoStack (EditField, (Int, Int))
us (EditField
field',(Int, Int)
ss) forall (m :: * -> *) a. Monad m => a -> m a
return
	     forall {a} {k}. UndoStack a -> Msc k (EditState a)
storeUndoStack UndoStack (EditField, (Int, Int))
us'
	     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nldown forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$
		let tleft :: Int -> (Int, b)
tleft Int
a = (Int
rl forall a. Num a => a -> a -> a
+ Int
a forall a. Num a => a -> a -> a
+ Int
1, b
0)
		    tnl :: (Int, Int)
tnl = forall {b}. Num b => Int -> (Int, b)
tleft Int
nldown
		in  forall {f :: * -> * -> *} {r} {hi} {ho}.
FudgetIO f =>
(Int, Int) -> (Int, Int) -> Int -> Mk (r -> f hi ho) ()
copy (forall {b}. Num b => Int -> (Int, b)
tleft Int
0) (Int, Int)
tnl (Point -> Int
ycoord Point
size forall a. Num a => a -> a -> a
- Int
lheight forall a. Num a => a -> a -> a
* forall a b. (a, b) -> a
lno (Int, Int)
tnl)
	     forall {a} {hi} {ho}. Int -> Int -> Mk (EditState a -> K hi ho) ()
showlines Int
ll (Int
ll forall a. Num a => a -> a -> a
+ Int
nls)
      dolines :: p
-> p
-> ((p, Int) -> (String, Bool) -> m ())
-> String
-> (p, Int)
-> m (p, Int)
dolines p
first p
last (p, Int) -> (String, Bool) -> m ()
doline = String -> (p, Int) -> m (p, Int)
du
	 where du :: String -> (p, Int) -> m (p, Int)
du String
s p :: (p, Int)
p@(p
l,Int
x) = let ((String
line,Bool
nl), String
rest) = String -> ((String, Bool), String)
splitwithnl String
s
			      in if p
l forall a. Ord a => a -> a -> Bool
> p
last Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then forall (m :: * -> *) a. Monad m => a -> m a
return (p, Int)
p
			      else forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (p
l forall a. Ord a => a -> a -> Bool
>= p
first) ((p, Int) -> (String, Bool) -> m ()
doline (p, Int)
p (String
line,Bool
nl)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
				   String -> (p, Int) -> m (p, Int)
du String
rest (if Bool
nl then (p
lforall a. Num a => a -> a -> a
+p
1,Int
0) else (p
l,Int
xforall 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 (forall {per_char}. FontStructF per_char -> Int
font_ascent FontStruct
font)
	   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a b. (a, b) -> b
xp (Int, Int)
lp forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
	     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)
	   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall {a}. [a] -> Bool
notnull String
line) forall a b. (a -> b) -> a -> b
$
	     forall {f :: * -> * -> *} {hi} {ho} {r}.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs (GCId -> Point -> String -> FRequest
drawimagestring GCId
gc (Point
pforall a. Num a => a -> a -> a
+Point
d) String
line)
	   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
withnl forall a b. (a -> b) -> a -> b
$
	     do Int
width <- 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 forall a. Num a => a -> a -> a
- Point -> Int
xcoord Point
pc) Int
lheight
		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 <- forall {k} {a}. Ms k (EditState a) EditField
loadField
	     Bool
showc <- forall {k} {a}. Ms k (EditState a) Bool
loadShowCursor
	     let clno :: Int
clno = forall a b. (a, b) -> a
lno 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 forall a. Ord a => a -> a -> Bool
<= t
0 then String
l else String
lforall a. [a] -> [a] -> [a]
++Char
newlineforall a. a -> [a] -> [a]
:t -> String -> String
takenl (t
nforall a. Num a => a -> a -> a
-t
1) String
r
		 bef :: String
bef = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall {t}. (Ord t, Num t) => t -> String -> String
takenl (Int
clnoforall a. Num a => a -> a -> a
-Int
first) 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 = forall {p} {m :: * -> *}.
(Ord p, Monad m, Num p) =>
p
-> p
-> ((p, Int) -> (String, Bool) -> m ())
-> String
-> (p, Int)
-> m (p, Int)
dolines Int
first Int
last (forall {f :: * -> * -> *} {a} {hi} {ho}.
FudgetIO f =>
(GCId, GCId)
-> (Int, Int) -> (String, Bool) -> Mk (EditState a -> f hi ho) ()
showLine (GCId, GCId)
gcs)
	     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
clnoforall a. Num a => a -> a -> a
-String -> Int
nlines String
bef,Int
0) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
		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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
		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
aftforall a. [a] -> [a] -> [a]
++[Char
newline]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int, Int)
_ ->
		forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
clno forall a. Ord a => a -> a -> Bool
>= Int
first Bool -> Bool -> Bool
&& Int
clno forall a. Ord a => a -> a -> Bool
<= Int
last) 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 <- forall {k} {a}. Ms k (EditState a) Bool
loadShowCursor
			forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
v forall a. Eq a => a -> a -> Bool
/= Bool
cv ) forall a b. (a -> b) -> a -> b
$
			  do EditField
field <- forall {k} {a}. Ms k (EditState a) EditField
loadField
			     forall {k} {a}. Bool -> Msc k (EditState a)
storeShowCursor Bool
v
			     if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (EditField -> String
getSelection EditField
field) then
			       forall {a} {hi} {ho}. Mk (EditState a -> K hi ho) ()
invCursor
			       else 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 <- forall {k} {a}. Ms k (EditState a) Bool
loadShowCursor
			   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cv forall {a} {hi} {ho}. Mk (EditState a -> K hi ho) ()
invCursor
      invCursor :: Mk (EditState a -> K hi ho) ()
invCursor = do EditField
field <- 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
		     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
sel) forall a b. (a -> b) -> a -> b
$
		       let p :: Point
p = (Int, Int) -> Point
line2p (forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
apSnd ((-Int
1) 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  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 <- forall {k} {a}. Ms k (EditState a) Point
loadSize
		  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 forall {a} {hi} {ho}. Int -> Int -> Mk (EditState a -> K hi ho) ()
showlines (forall a b. (a, b) -> a
lno (Point -> (Int, Int)
p2line Point
l1)) (forall a b. (a, b) -> a
lno (Point -> (Int, Int)
p2line Point
l2) 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 <- 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 -> forall k s. Msc k s
nopMs
	     Just ((EditField
field,(Int, Int)
size),UndoStack a
us') -> do forall {a} {k}. UndoStack a -> Msc k (EditState a)
storeUndoStack UndoStack a
us'
					   forall {sp :: * -> * -> *} {a} {i}.
StreamProcIO sp =>
EditField -> Mk (EditState a -> sp i EditEvt) ()
storeField' EditField
field
					   forall {a} {b} {c}. (Int, Int) -> Mk (EditState a -> K b c) ()
setSize (Int, Int)
size
					   forall {a} {hi} {ho}. Mk (EditState a -> K hi ho) ()
redraw

      storeField' :: EditField -> Mk (EditState a -> sp i EditEvt) ()
storeField' EditField
field' =
	do forall {k} {a}. EditField -> Msc k (EditState a)
storeField EditField
field'
	   forall {sp :: * -> * -> *} {o} {i} {r}.
StreamProcIO sp =>
o -> Msc (sp i o) r
putHighMs (InputMsg String -> EditEvt
EditChange forall a b. (a -> b) -> a -> b
$ forall a. a -> InputMsg a
InputChange 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 <- forall {k} {a}. Ms k (EditState a) EditField
loadField
		      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 = forall {sp :: * -> * -> *} {o} {a} {i}.
StreamProcIO sp =>
(EditField -> o) -> Mk (EditState a -> sp i o) ()
puttext' (String -> EditEvt
EditText forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditField -> String
f)

      putCursor :: Mk (EditState a -> K i EditEvt) ()
putCursor =
        do EditField
field <- forall {k} {a}. Ms k (EditState a) EditField
loadField
	   let lastpos :: (Int, Int)
lastpos = EditField -> (Int, Int)
getCurp EditField
field
	   forall {sp :: * -> * -> *} {o} {i} {r}.
StreamProcIO sp =>
o -> Msc (sp i o) r
putHighMs (Rect -> EditEvt
EditCursor 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) -> forall k r s. Cont k r -> Ms k s r
toMs (forall {a} {b}. Bool -> Rect -> Int -> (Rect -> K a b) -> K a b
maxExposeK Bool
False Rect
r Int
aft) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {hi} {ho}. Rect -> Mk (EditState a -> K hi ho) ()
expose
	  XEvt (GraphicsExpose Rect
r Int
aft Int
_ Int
_) -> forall k r s. Cont k r -> Ms k s r
toMs (forall {a} {b}. Bool -> Rect -> Int -> (Rect -> K a b) -> K a b
maxExposeK Bool
True Rect
r Int
aft) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {hi} {ho}. Rect -> Mk (EditState a -> K hi ho) ()
expose
	  LEvt (LayoutSize Point
s) -> forall {k} {a}. Point -> Msc k (EditState a)
storeSize Point
s
          FResponse
_ -> 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 -> forall {a} {hi} {ho}. Bool -> Mk (EditState a -> K hi ho) ()
showCursor Bool
s
	     EditMove EditStop
estop Bool
issel -> forall {a} {hi} {ho}.
Bool -> EditStop -> Mk (EditState a -> K hi ho) ()
move Bool
issel EditStop
estop
	     EditReplace String
s -> forall {b}.
String -> Mk (EditState (EditField, (Int, Int)) -> K b EditEvt) ()
replace' String
s
	     EditCmd
EditGetText -> forall {sp :: * -> * -> *} {a} {i}.
StreamProcIO sp =>
(EditField -> String) -> Mk (EditState a -> sp i EditEvt) ()
puttext EditField -> String
getField
	     EditCmd
EditGetField -> forall {sp :: * -> * -> *} {o} {a} {i}.
StreamProcIO sp =>
(EditField -> o) -> Mk (EditState a -> sp i o) ()
puttext' ((String, String, String) -> EditEvt
EditField forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditField -> (String, String, String)
getField')
	     EditCmd
EditGetSelection -> forall {sp :: * -> * -> *} {a} {i}.
StreamProcIO sp =>
(EditField -> String) -> Mk (EditState a -> sp i EditEvt) ()
puttext EditField -> String
getSelection
	     EditCmd
EditUndo -> forall {a} {i}.
(UndoStack a -> Maybe ((EditField, (Int, Int)), UndoStack a))
-> Mk (EditState a -> K i EditEvt) ()
undoredo forall a. UndoStack a -> Maybe (a, UndoStack a)
undo
	     EditCmd
EditRedo -> forall {a} {i}.
(UndoStack a -> Maybe ((EditField, (Int, Int)), UndoStack a))
-> Mk (EditState a -> K i EditEvt) ()
undoredo forall a. UndoStack a -> Maybe (a, UndoStack a)
redo
	   forall {a} {i}. Mk (EditState a -> K i EditEvt) ()
putCursor
	   EditField
field <- 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
_ -> forall k s. Msc k s
nopMs
	     EditCmd
_ -> 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 forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message forall {a} {a} {b}. FResponse -> Mk (EditState a -> K a b) ()
handleLow forall {hi}.
EditCmd
-> Mk (EditState (EditField, (Int, Int)) -> K hi EditEvt) ()
handleHigh forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {hi} {ho} {s}. Ms (K hi ho) s (KEvent hi)
getKs
		Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) b
proc


  in  forall {t1} {t2} {r}. t1 -> Mk (t1 -> t2) r -> t2 -> t2
stateK forall {a}. EditState a
initstate (forall {a} {b} {c}. (Int, Int) -> Mk (EditState a -> K b c) ()
setSize (Int
1,Int
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {b}.
Mk (EditState (EditField, (Int, Int)) -> K EditCmd EditEvt) b
proc) 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 = forall a. Maybe a
Nothing
uslimit :: Maybe Int
uslimit = let ul :: Int
ul = forall {p}. (Read p, Show p) => String -> p -> p
argReadKey String
"undodepth" (-Int
1)
	  in if Int
ul forall a. Eq a => a -> a -> Bool
== -Int
1 then forall a. Maybe a
defaultuslimit else forall a. a -> Maybe a
Just Int
ul

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

--initstate = (False,(1,0),undoStack uslimit, createField "", origin, (0, 0))
initstate :: EditState a
initstate = forall a.
Bool
-> (Int, Int)
-> UndoStack a
-> EditField
-> Point
-> (Int, Int)
-> EditState a
S Bool
False (Int
1,Int
0) (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 = forall s f k. (s -> f) -> Ms k s f
fieldMs forall a. EditState a -> Bool
shocur
loadTextWidth :: Ms k (EditState a) (Int, Int)
loadTextWidth = forall s f k. (s -> f) -> Ms k s f
fieldMs  forall a. EditState a -> (Int, Int)
twidth
loadUndoStack :: Ms k (EditState a) (UndoStack a)
loadUndoStack = forall s f k. (s -> f) -> Ms k s f
fieldMs  forall a. EditState a -> UndoStack a
undostack
loadField :: Ms k (EditState a) EditField
loadField = forall s f k. (s -> f) -> Ms k s f
fieldMs forall a. EditState a -> EditField
field
loadSize :: Ms k (EditState a) Point
loadSize = forall s f k. (s -> f) -> Ms k s f
fieldMs forall a. EditState a -> Point
size
loadLastpos :: Ms k (EditState a) (Int, Int)
loadLastpos = forall s f k. (s -> f) -> Ms k s f
fieldMs forall a. EditState a -> (Int, Int)
lastpos
--loadWidth = loadSize >>= \size -> return (xcoord size)
loadWidth :: Mk (EditState a -> k) Int
loadWidth = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point -> Int
xcoord 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)