Commit 202b7ac8 authored by Diederik van Arkel's avatar Diederik van Arkel

refix unique types

parent 755dccc9
...@@ -34,4 +34,4 @@ from EdActionType import Action ...@@ -34,4 +34,4 @@ from EdActionType import Action
performAction :: Action -> EditMonad (PSt PLocState) nothing performAction :: Action -> EditMonad (PSt PLocState) nothing
undoAction :: EditMonad (PSt *l) nothing undoAction :: EditMonad (PSt .l) nothing
...@@ -204,7 +204,7 @@ removeSelectionIfNecessary ...@@ -204,7 +204,7 @@ removeSelectionIfNecessary
ELSE ELSE
( result False ) ( result False )
undoStuff :: !Action -> EditMonad (PSt *l) nothing undoStuff :: !Action -> EditMonad (PSt .l) nothing
undoStuff (Insert _) = undoStuff (Insert _) =
getUndoInfo >>>= \undoinfo -> getUndoInfo >>>= \undoinfo ->
case undoinfo.uninfo of case undoinfo.uninfo of
...@@ -226,7 +226,7 @@ undoStuff _ = ...@@ -226,7 +226,7 @@ undoStuff _ =
(RemoveInfo True state) -> setUndoInfo {undoinfo & uninfo=(RemoveInfo False state)} (RemoveInfo True state) -> setUndoInfo {undoinfo & uninfo=(RemoveInfo False state)}
_ -> skip _ -> skip
undoAction :: EditMonad (PSt *l) nothing undoAction :: EditMonad (PSt .l) nothing
undoAction = undoAction =
getUndoInfo >>>= \undoinfo -> getUndoInfo >>>= \undoinfo ->
getState >>>= \fin -> getState >>>= \fin ->
......
...@@ -20,7 +20,7 @@ from EdMonad import EditMonad, EditState, StateM ...@@ -20,7 +20,7 @@ from EdMonad import EditMonad, EditState, StateM
// configureKeyMapping :: (PSt EditorState .p) -> (PSt EditorState .p) // configureKeyMapping :: (PSt EditorState .p) -> (PSt EditorState .p)
// But then you have to import EdState which imports this module... // But then you have to import EdState which imports this module...
configureKeyMapping :: KeyMapping (KeyMapping (PSt *l) -> (PSt *l)) (PSt *l) -> (PSt *l) configureKeyMapping :: KeyMapping (KeyMapping (PSt .l) -> (PSt .l)) (PSt .l) -> (PSt .l)
macKeyMapping :: KeyMapping macKeyMapping :: KeyMapping
//pcKeyMapping :: KeyMapping //pcKeyMapping :: KeyMapping
......
...@@ -285,7 +285,7 @@ convertModifiers { shiftDown, altDown, controlDown, optionDown, commandDown } ...@@ -285,7 +285,7 @@ convertModifiers { shiftDown, altDown, controlDown, optionDown, commandDown }
, dialogFont :: Font , dialogFont :: Font
} }
configureKeyMapping :: KeyMapping (KeyMapping (PSt *l) -> (PSt *l)) (PSt *l) -> (PSt *l) configureKeyMapping :: KeyMapping (KeyMapping (PSt .l) -> (PSt .l)) (PSt .l) -> (PSt .l)
configureKeyMapping keyMapping setKeyMapping pstateIds configureKeyMapping keyMapping setKeyMapping pstateIds
// Compute the line height of the dialog font // Compute the line height of the dialog font
...@@ -317,9 +317,6 @@ configureKeyMapping keyMapping setKeyMapping pstateIds ...@@ -317,9 +317,6 @@ configureKeyMapping keyMapping setKeyMapping pstateIds
] ]
# (actionSize, pstate) = controlSize (actionControl listBox []) False Nothing Nothing Nothing pstate # (actionSize, pstate) = controlSize (actionControl listBox []) False Nothing Nothing Nothing pstate
maxWidth = max actionSize.w keySize.w maxWidth = max actionSize.w keySize.w
# listBox = ListBoxControl [] [] listBoxId
[ ControlViewSize {w=maxModWidth+maxKeyWidth,h=3*lineHeight}
]
# (_, pstate) = openModalDialog # (_, pstate) = openModalDialog
{ keyMapping = keyMapping, dialogFont = font } // local state of dialog { keyMapping = keyMapping, dialogFont = font } // local state of dialog
(dialog maxWidth keySize actionSize maxActionWidth lineHeight listBox) // dialog definition (dialog maxWidth keySize actionSize maxActionWidth lineHeight listBox) // dialog definition
...@@ -466,7 +463,7 @@ where ...@@ -466,7 +463,7 @@ where
// removeBinding removes the selected key bindings // removeBinding removes the selected key bindings
removeBinding :: (u:KeyMappingDialogState, PSt *l) -> (u:KeyMappingDialogState, PSt *l) removeBinding :: (u:KeyMappingDialogState, PSt .l) -> (u:KeyMappingDialogState, PSt .l)
removeBinding (dialogState=:{ keyMapping}, pstate) removeBinding (dialogState=:{ keyMapping}, pstate)
# (wstate, pstate) = accPIO (getWindow dialogId) pstate # (wstate, pstate) = accPIO (getWindow dialogId) pstate
| isNothing wstate = (dialogState,pstate) | isNothing wstate = (dialogState,pstate)
...@@ -496,7 +493,7 @@ where ...@@ -496,7 +493,7 @@ where
// bindKey adds a binding to the key mapping table. It binds the // bindKey adds a binding to the key mapping table. It binds the
// currently selected action to the selected key (including modifiers). // currently selected action to the selected key (including modifiers).
bindKey :: (u:KeyMappingDialogState, PSt *l) -> (u:KeyMappingDialogState, PSt *l) bindKey :: (u:KeyMappingDialogState, PSt .l) -> (u:KeyMappingDialogState, PSt .l)
bindKey (dialogState=:{ keyMapping}, pstate) bindKey (dialogState=:{ keyMapping}, pstate)
# (wstate, pstate) = accPIO (getWindow dialogId) pstate # (wstate, pstate) = accPIO (getWindow dialogId) pstate
| isNothing wstate = (dialogState,pstate) | isNothing wstate = (dialogState,pstate)
......
...@@ -15,9 +15,7 @@ from StdString import String ...@@ -15,9 +15,7 @@ from StdString import String
from StdPSt import PSt, IOSt from StdPSt import PSt, IOSt
import EdMonad import EdMonad
//editWindowLook :: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture))
editWindowLook :: EditState SelectState !UpdateState -> (!*Picture -> *Picture) editWindowLook :: EditState SelectState !UpdateState -> (!*Picture -> *Picture)
// editWindowLook: defines the look of the editor window. This function // editWindowLook: defines the look of the editor window. This function
// is used to handle update events. // is used to handle update events.
...@@ -9,25 +9,15 @@ import StdIOCommon ...@@ -9,25 +9,15 @@ import StdIOCommon
import StdPicture import StdPicture
import EdVisualText, EdVisualCursor, EdVisualLineNr import EdVisualText, EdVisualCursor, EdVisualLineNr
//import dodebug
trace_n _ f :== f
// editWindowLook: updating the affected areas is done by updating // editWindowLook: updating the affected areas is done by updating
// each of the rectangles. // each of the rectangles.
//editWindowLook :: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture)) editWindowLook :: EditState SelectState !UpdateState -> (!*Picture -> *Picture)
editWindowLook :: EditState SelectState !UpdateState -> (!*Picture -> *Picture)
editWindowLook editState selectState updateState=:{ updArea, newFrame, oldFrame } editWindowLook editState selectState updateState=:{ updArea, newFrame, oldFrame }
= editWindowLook` = editWindowLook`
//editWindowLook editState
// = (editState`,editWindowLook`)
where where
// editWindowLook` :: !*Picture -> *Picture
editWindowLook` picture editWindowLook` picture
// editWindowLook` selectState updateState=:{ updArea, newFrame, oldFrame } picture
// # picture = traceUpdate updArea picture
# updArea = cleanUpdate updArea // hack around object i/o bug... # updArea = cleanUpdate updArea // hack around object i/o bug...
// # picture = traceUpdate updArea picture
# picture = vDrawLineNrs fontInfo text newFrame updArea picture # picture = vDrawLineNrs fontInfo text newFrame updArea picture
# picture = vUpdateText fontInfo text newFrame updArea picture # picture = vUpdateText fontInfo text newFrame updArea picture
# picture = case visible of # picture = case visible of
...@@ -38,7 +28,7 @@ where ...@@ -38,7 +28,7 @@ where
(text,ds2) = getText ds1 (text,ds2) = getText ds1
(visible,ds3) = getCursorVisibility ds2 (visible,ds3) = getCursorVisibility ds2
(height,ds4) = getCursorHeight ds3 (height,ds4) = getCursorHeight ds3
(selection=:{end},(editState`,_)) = getSelection ds4 (selection=:{end},_) = getSelection ds4
/* /*
import StdDebug,dodebug import StdDebug,dodebug
......
...@@ -14,7 +14,7 @@ from EdMonad import EditState, EditMonad, StateM ...@@ -14,7 +14,7 @@ from EdMonad import EditState, EditMonad, StateM
:: EditAction l a :== EditMonad (PSt l) a :: EditAction l a :== EditMonad (PSt l) a
openEditId :: *env -> (EditId, *env) | Ids env openEditId :: *env -> (EditId, *env) | Ids env
openEditReceiver :: !EditId -> Receiver2 Message Message EditState (PSt *l) openEditReceiver :: !EditId -> Receiver2 Message Message EditState (PSt .l)
hasEditState :: !EditId !*(PSt *l) -> *(Bool, *PSt *l) hasEditState :: !EditId !*(PSt .l) -> *(Bool, *PSt .l)
appEditState :: !EditId !.(EditAction *l .r) !*(PSt *l) -> *(.r,*PSt *l) appEditState :: !EditId !.(EditAction .l .r) !*(PSt .l) -> *(.r,*PSt .l)
...@@ -22,14 +22,14 @@ openEditId :: *env -> (EditId, *env) | Ids env ...@@ -22,14 +22,14 @@ openEditId :: *env -> (EditId, *env) | Ids env
openEditId pstate openEditId pstate
= openR2Id pstate = openR2Id pstate
openEditReceiver :: !EditId -> Receiver2 Message Message EditState (PSt *l) openEditReceiver :: !EditId -> Receiver2 Message Message EditState (PSt .l)
openEditReceiver editId openEditReceiver editId
= Receiver2 editId receive [] = Receiver2 editId receive []
// receive a message from the outside world // receive a message from the outside world
receive :: Message (EditState, PSt *l) -> receive :: Message (EditState, PSt .l) ->
(Message, (EditState, PSt *l)) (Message, (EditState, PSt .l))
receive message (editState, pstate) receive message (editState, pstate)
= case message of = case message of
MsgGet -> (MsgState editState, (editState, pstate)) MsgGet -> (MsgState editState, (editState, pstate))
...@@ -38,14 +38,14 @@ receive message (editState, pstate) ...@@ -38,14 +38,14 @@ receive message (editState, pstate)
// hasEditState // hasEditState
hasEditState :: !EditId !*(PSt *l) -> *(Bool, *PSt *l) hasEditState :: !EditId !*(PSt .l) -> *(Bool, *PSt .l)
hasEditState editId pstate hasEditState editId pstate
# ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate # ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate
= (isJust maybeResp, pstate) = (isJust maybeResp, pstate)
// appEditState // appEditState
appEditState :: !EditId !.(EditAction *l .r) !*(PSt *l) -> *(.r,*PSt *l) appEditState :: !EditId !.(EditAction .l .r) !*(PSt .l) -> *(.r,*PSt .l)
appEditState editId monad pState appEditState editId monad pState
# (editState, pState) = getEditState editId pState # (editState, pState) = getEditState editId pState
# (x, (editState, pState)) = monad (editState, pState) # (x, (editState, pState)) = monad (editState, pState)
...@@ -54,7 +54,7 @@ appEditState editId monad pState ...@@ -54,7 +54,7 @@ appEditState editId monad pState
// getEditState // getEditState
getEditState :: !EditId !*(PSt *l) -> *(EditState, *PSt *l) getEditState :: !EditId !*(PSt .l) -> *(EditState, *PSt .l)
getEditState editId pstate getEditState editId pstate
# ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate # ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate
| isNothing maybeResp | isNothing maybeResp
...@@ -64,7 +64,7 @@ getEditState editId pstate ...@@ -64,7 +64,7 @@ getEditState editId pstate
_ -> abort "getEditState (EdMessage.icl): unknown response" _ -> abort "getEditState (EdMessage.icl): unknown response"
setEditState :: !EditId !EditState !*(PSt *l) -> *PSt *l setEditState :: !EditId !EditState !*(PSt .l) -> *PSt .l
setEditState editId editState pstate setEditState editId editState pstate
# ((_, maybeResp), pstate) = syncSend2 editId (MsgState editState) pstate # ((_, maybeResp), pstate) = syncSend2 editId (MsgState editState) pstate
| isNothing maybeResp | isNothing maybeResp
......
...@@ -92,7 +92,7 @@ instance toString UndoState ...@@ -92,7 +92,7 @@ instance toString UndoState
:: EditMonad env a :== StateM *(!EditState, env) a :: EditMonad env a :== StateM *(!EditState, env) a
initEditState :: !Id !Id !String !Font !(Int,Bool,Bool,Bool,Bool) !SyntaxColours !*(PSt *l) -> (EditState , *PSt *l) initEditState :: !Id !Id !String !Font !(Int,Bool,Bool,Bool,Bool) !SyntaxColours !*(PSt .l) -> (EditState , *PSt .l)
appEnv :: (.env -> .env) -> EditMonad .env nothing appEnv :: (.env -> .env) -> EditMonad .env nothing
accEnv :: (.env -> (.a, .env)) -> EditMonad .env .a accEnv :: (.env -> (.a, .env)) -> EditMonad .env .a
noResult :: !(EditMonad .env a) *(EditState, .env) -> (EditState, .env) noResult :: !(EditMonad .env a) *(EditState, .env) -> (EditState, .env)
...@@ -101,35 +101,35 @@ onlyEnv :: !(EditMonad .env a) *(EditState, .env) -> .env ...@@ -101,35 +101,35 @@ onlyEnv :: !(EditMonad .env a) *(EditState, .env) -> .env
// ACCESSORS & MODIFIERS // ACCESSORS & MODIFIERS
getMenuSelection :: EditMonad .env (Maybe String) getMenuSelection :: EditMonad .env (Maybe String)
setMenuSelection :: (Maybe String) -> EditMonad (PSt *l) nothing setMenuSelection :: (Maybe String) -> EditMonad (PSt .l) nothing
getUndoInfo :: EditMonad .env UndoInfo getUndoInfo :: EditMonad .env UndoInfo
setUndoInfo :: UndoInfo -> EditMonad (PSt *l) nothing setUndoInfo :: UndoInfo -> EditMonad (PSt .l) nothing
getLineNumbers :: EditMonad .env Bool getLineNumbers :: EditMonad .env Bool
setLineNumbers :: !Bool -> EditMonad (PSt *l) nothing setLineNumbers :: !Bool -> EditMonad (PSt .l) nothing
getNewlineConvention :: EditMonad .env NewlineConvention getNewlineConvention :: EditMonad .env NewlineConvention
setNewlineConvention :: NewlineConvention -> EditMonad (PSt *l) nothing setNewlineConvention :: NewlineConvention -> EditMonad (PSt .l) nothing
getReadOnly :: EditMonad .env Bool getReadOnly :: EditMonad .env Bool
setReadOnly :: Bool -> EditMonad (PSt *l) nothing setReadOnly :: Bool -> EditMonad (PSt .l) nothing
getText :: EditMonad .env Text getText :: EditMonad .env Text
setText :: !Text -> EditMonad (PSt *l) nothing setText :: !Text -> EditMonad (PSt .l) nothing
getVirtualX :: EditMonad .env Int getVirtualX :: EditMonad .env Int
setVirtualX :: Int -> EditMonad (PSt *l) nothing setVirtualX :: Int -> EditMonad (PSt .l) nothing
getFontInfo :: EditMonad .env FontInfo getFontInfo :: EditMonad .env FontInfo
setFontInfo :: FontInfo -> EditMonad (PSt *l) nothing setFontInfo :: FontInfo -> EditMonad (PSt .l) nothing
appFontInfo :: (FontInfo -> FontInfo) -> EditMonad (PSt *l) nothing appFontInfo :: (FontInfo -> FontInfo) -> EditMonad (PSt .l) nothing
getWindowId :: EditMonad .env Id getWindowId :: EditMonad .env Id
getCursorVisibility :: EditMonad .env Bool getCursorVisibility :: EditMonad .env Bool
setCursorVisibility :: Bool -> EditMonad (PSt *l) nothing setCursorVisibility :: Bool -> EditMonad (PSt .l) nothing
getSelection :: EditMonad .env Selection getSelection :: EditMonad .env Selection
setSelection :: Selection -> EditMonad (PSt *l) nothing setSelection :: Selection -> EditMonad (PSt .l) nothing
getSelectMode :: EditMonad .env SelectMode getSelectMode :: EditMonad .env SelectMode
setSelectMode :: SelectMode -> EditMonad (PSt *l) nothing setSelectMode :: SelectMode -> EditMonad (PSt .l) nothing
getPathName :: EditMonad .env String getPathName :: EditMonad .env String
setPathName :: String -> EditMonad (PSt *l) nothing setPathName :: String -> EditMonad (PSt .l) nothing
getNeedSave :: EditMonad .env Bool getNeedSave :: EditMonad .env Bool
setNeedSave :: Bool -> EditMonad (PSt *l) nothing setNeedSave :: Bool -> EditMonad (PSt .l) nothing
getCursorHeight :: EditMonad .env Int getCursorHeight :: EditMonad .env Int
setFont :: Font -> EditMonad (PSt *l) nothing setFont :: Font -> EditMonad (PSt .l) nothing
pathNameToWindowTitle :: !String -> String pathNameToWindowTitle :: !String -> String
pathNameToWindowTitle` :: !String -> String pathNameToWindowTitle` :: !String -> String
...@@ -139,9 +139,9 @@ from StdIOBasic import Point2 ...@@ -139,9 +139,9 @@ from StdIOBasic import Point2
getTimerId :: EditMonad .env Id getTimerId :: EditMonad .env Id
getToolPt :: EditMonad .env Point2 getToolPt :: EditMonad .env Point2
setToolPt :: Point2 -> EditMonad (PSt *l) nothing setToolPt :: Point2 -> EditMonad (PSt .l) nothing
//-- //--
getState :: EditMonad (PSt *l) IRState getState :: EditMonad (PSt .l) IRState
setState :: IRState -> EditMonad (PSt *l) nothing setState :: IRState -> EditMonad (PSt .l) nothing
...@@ -137,7 +137,7 @@ getLineNumbers = ...@@ -137,7 +137,7 @@ getLineNumbers =
getEditState >>>= \{lineNumbers} -> getEditState >>>= \{lineNumbers} ->
result lineNumbers result lineNumbers
setLineNumbers :: !Bool -> EditMonad (PSt *l) nothing setLineNumbers :: !Bool -> EditMonad (PSt .l) nothing
setLineNumbers linenumbers = setLineNumbers linenumbers =
updateEditState update >>> updateEditState update >>>
getEditState >>>= \{windowId} -> getEditState >>>= \{windowId} ->
...@@ -154,7 +154,7 @@ where ...@@ -154,7 +154,7 @@ where
/* EXPORTED FUNCTIONS */ /* EXPORTED FUNCTIONS */
initEditState :: !Id !Id !String !Font !(Int,Bool,Bool,Bool,Bool) !SyntaxColours !*(PSt *l) -> (EditState, *PSt *l) initEditState :: !Id !Id !String !Font !(Int,Bool,Bool,Bool,Bool) !SyntaxColours !*(PSt .l) -> (EditState, *PSt .l)
initEditState windowId eUndoId pathName font tabs=:(_,_,_,linenos,showSynCol) syncols pstate initEditState windowId eUndoId pathName font tabs=:(_,_,_,linenos,showSynCol) syncols pstate
# (tId,pstate) = openId pstate // P4 # (tId,pstate) = openId pstate // P4
# (fontInfo, pstate) = computeFontInfo font tabs syncols pstate # (fontInfo, pstate) = computeFontInfo font tabs syncols pstate
...@@ -223,7 +223,7 @@ getMenuSelection = ...@@ -223,7 +223,7 @@ getMenuSelection =
getEditState >>>= \{menusel} -> getEditState >>>= \{menusel} ->
result menusel result menusel
setMenuSelection :: (Maybe String) -> EditMonad (PSt *l) nothing setMenuSelection :: (Maybe String) -> EditMonad (PSt .l) nothing
setMenuSelection menusel = setMenuSelection menusel =
updateEditState update updateEditState update
where where
...@@ -234,7 +234,7 @@ getNewlineConvention = ...@@ -234,7 +234,7 @@ getNewlineConvention =
getEditState >>>= \{newlineConv} -> getEditState >>>= \{newlineConv} ->
result newlineConv result newlineConv
setNewlineConvention :: NewlineConvention -> EditMonad (PSt *l) nothing setNewlineConvention :: NewlineConvention -> EditMonad (PSt .l) nothing
setNewlineConvention newlineConv = setNewlineConvention newlineConv =
updateEditState update updateEditState update
where where
...@@ -245,7 +245,7 @@ getReadOnly = ...@@ -245,7 +245,7 @@ getReadOnly =
getEditState >>>= \{readOnly} -> getEditState >>>= \{readOnly} ->
result readOnly result readOnly
setReadOnly :: Bool -> EditMonad (PSt *l) nothing setReadOnly :: Bool -> EditMonad (PSt .l) nothing
setReadOnly readOnly = setReadOnly readOnly =
updateEditState update updateEditState update
where where
...@@ -256,7 +256,7 @@ getText ...@@ -256,7 +256,7 @@ getText
= getEditState >>>= \{text} -> = getEditState >>>= \{text} ->
result text result text
setText :: !Text -> EditMonad (PSt *l) nothing setText :: !Text -> EditMonad (PSt .l) nothing
setText text = setText text =
updateEditState update >>> updateEditState update >>>
updateLook updateLook
...@@ -269,14 +269,14 @@ getFontInfo ...@@ -269,14 +269,14 @@ getFontInfo
= getEditState >>>= \{fontInfo} -> = getEditState >>>= \{fontInfo} ->
result fontInfo result fontInfo
setFontInfo :: FontInfo -> EditMonad (PSt *l) nothing setFontInfo :: FontInfo -> EditMonad (PSt .l) nothing
setFontInfo fontInfo = setFontInfo fontInfo =
updateEditState update updateEditState update
where where
update editState update editState
= {editState & fontInfo=fontInfo} = {editState & fontInfo=fontInfo}
appFontInfo :: (FontInfo -> FontInfo) -> EditMonad (PSt *l) nothing appFontInfo :: (FontInfo -> FontInfo) -> EditMonad (PSt .l) nothing
appFontInfo fontFun = appFontInfo fontFun =
updateEditState update >>> updateEditState update >>>
updateLook updateLook
...@@ -288,7 +288,7 @@ getCursorVisibility ...@@ -288,7 +288,7 @@ getCursorVisibility
= getEditState >>>= \{cursorInfo} -> = getEditState >>>= \{cursorInfo} ->
result cursorInfo.visible result cursorInfo.visible
setCursorVisibility :: Bool -> EditMonad (PSt *l) nothing setCursorVisibility :: Bool -> EditMonad (PSt .l) nothing
setCursorVisibility visible = setCursorVisibility visible =
updateEditState update >>> updateEditState update >>>
updateLook updateLook
...@@ -301,7 +301,7 @@ getSelection ...@@ -301,7 +301,7 @@ getSelection
= getEditState >>>= \{selectInfo={selection}} -> = getEditState >>>= \{selectInfo={selection}} ->
result selection result selection
setSelection :: Selection -> EditMonad (PSt *l) nothing setSelection :: Selection -> EditMonad (PSt .l) nothing
setSelection selection = setSelection selection =
updateEditState update >>> updateEditState update >>>
updateLook updateLook
...@@ -314,7 +314,7 @@ getVirtualX ...@@ -314,7 +314,7 @@ getVirtualX
= getEditState >>>= \{cursorInfo={virtualX}} -> = getEditState >>>= \{cursorInfo={virtualX}} ->
result virtualX result virtualX
setVirtualX :: Int -> EditMonad (PSt *l) nothing setVirtualX :: Int -> EditMonad (PSt .l) nothing
setVirtualX virtualX setVirtualX virtualX
= updateEditState update = updateEditState update
where where
...@@ -326,7 +326,7 @@ getSelectMode ...@@ -326,7 +326,7 @@ getSelectMode
= getEditState >>>= \{selectInfo={selectMode}} -> = getEditState >>>= \{selectInfo={selectMode}} ->
result selectMode result selectMode
setSelectMode :: SelectMode -> EditMonad (PSt *l) nothing setSelectMode :: SelectMode -> EditMonad (PSt .l) nothing
setSelectMode selectMode setSelectMode selectMode
= updateEditState update = updateEditState update
where where
...@@ -343,7 +343,7 @@ getWindowId ...@@ -343,7 +343,7 @@ getWindowId
= getEditState >>>= \{windowId} -> = getEditState >>>= \{windowId} ->
result windowId result windowId
setFont :: Font -> EditMonad (PSt *l) nothing setFont :: Font -> EditMonad (PSt .l) nothing
setFont font = monad setFont font = monad
where where
monad (editState,pState) monad (editState,pState)
...@@ -366,7 +366,7 @@ where ...@@ -366,7 +366,7 @@ where
update fontInfo editState update fontInfo editState
= { editState & fontInfo = fontInfo } = { editState & fontInfo = fontInfo }
updateEditState :: (EditState -> EditState) -> EditMonad (PSt *l) nothing updateEditState :: (EditState -> EditState) -> EditMonad (PSt .l) nothing
updateEditState editStateFun updateEditState editStateFun
= updateEditState` = updateEditState`
where where
...@@ -378,19 +378,15 @@ where ...@@ -378,19 +378,15 @@ where
// look function is not applied, so no visible update is // look function is not applied, so no visible update is
// caused by updateLook. // caused by updateLook.
updateLook :: EditMonad (PSt *l) nothing updateLook :: EditMonad (PSt .l) nothing
updateLook updateLook
= getWindowId >>>= \windowId -> = getWindowId >>>= \windowId ->
getEditState >>>= \editState -> getEditState >>>= \editState ->
// let
// (editState,editLook) = editWindowLook editState
// in
// appEnv (appPIO (setWindowLook windowId False (True,editLook)))
appEnv (appPIO (setWindowLook windowId False (True,editWindowLook editState))) appEnv (appPIO (setWindowLook windowId False (True,editWindowLook editState)))
// compute some properties of a font // compute some properties of a font
computeFontInfo :: !Font !(Int,Bool,Bool,Bool,Bool) !SyntaxColours !(PSt *l) -> (FontInfo, PSt *l) computeFontInfo :: !Font !(Int,Bool,Bool,Bool,Bool) !SyntaxColours !(PSt .l) -> (FontInfo, PSt .l)
computeFontInfo font (tabSize,autoTab,showTabs,_,showSynCol) syncols pstate computeFontInfo font (tabSize,autoTab,showTabs,_,showSynCol) syncols pstate
# (metrics, pstate) = accPIO (accScreenPicture (getFontMetrics font)) pstate # (metrics, pstate) = accPIO (accScreenPicture (getFontMetrics font)) pstate
lineHeight = metrics.fAscent + metrics.fDescent + metrics.fLeading lineHeight = metrics.fAscent + metrics.fDescent + metrics.fLeading
...@@ -426,7 +422,7 @@ getPathName = ...@@ -426,7 +422,7 @@ getPathName =
getEditState >>>= \{pathName} -> getEditState >>>= \{pathName} ->
result pathName result pathName
setPathName :: String -> EditMonad (PSt *l) nothing setPathName :: String -> EditMonad (PSt .l) nothing
setPathName path = setPathName path =
updateEditState update updateEditState update
where where
...@@ -474,7 +470,7 @@ where ...@@ -474,7 +470,7 @@ where
= FindLastChar c s (dec i);