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
performAction :: Action -> EditMonad (PSt PLocState) nothing
undoAction :: EditMonad (PSt *l) nothing
undoAction :: EditMonad (PSt .l) nothing
......@@ -204,7 +204,7 @@ removeSelectionIfNecessary
ELSE
( result False )
undoStuff :: !Action -> EditMonad (PSt *l) nothing
undoStuff :: !Action -> EditMonad (PSt .l) nothing
undoStuff (Insert _) =
getUndoInfo >>>= \undoinfo ->
case undoinfo.uninfo of
......@@ -226,7 +226,7 @@ undoStuff _ =
(RemoveInfo True state) -> setUndoInfo {undoinfo & uninfo=(RemoveInfo False state)}
_ -> skip
undoAction :: EditMonad (PSt *l) nothing
undoAction :: EditMonad (PSt .l) nothing
undoAction =
getUndoInfo >>>= \undoinfo ->
getState >>>= \fin ->
......
......@@ -20,7 +20,7 @@ from EdMonad import EditMonad, EditState, StateM
// configureKeyMapping :: (PSt EditorState .p) -> (PSt EditorState .p)
// 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
//pcKeyMapping :: KeyMapping
......
......@@ -285,7 +285,7 @@ convertModifiers { shiftDown, altDown, controlDown, optionDown, commandDown }
, 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
// Compute the line height of the dialog font
......@@ -317,9 +317,6 @@ configureKeyMapping keyMapping setKeyMapping pstateIds
]
# (actionSize, pstate) = controlSize (actionControl listBox []) False Nothing Nothing Nothing pstate
maxWidth = max actionSize.w keySize.w
# listBox = ListBoxControl [] [] listBoxId
[ ControlViewSize {w=maxModWidth+maxKeyWidth,h=3*lineHeight}
]
# (_, pstate) = openModalDialog
{ keyMapping = keyMapping, dialogFont = font } // local state of dialog
(dialog maxWidth keySize actionSize maxActionWidth lineHeight listBox) // dialog definition
......@@ -466,7 +463,7 @@ where
// 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)
# (wstate, pstate) = accPIO (getWindow dialogId) pstate
| isNothing wstate = (dialogState,pstate)
......@@ -496,7 +493,7 @@ where
// bindKey adds a binding to the key mapping table. It binds the
// 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)
# (wstate, pstate) = accPIO (getWindow dialogId) pstate
| isNothing wstate = (dialogState,pstate)
......
......@@ -15,9 +15,7 @@ from StdString import String
from StdPSt import PSt, IOSt
import EdMonad
//editWindowLook :: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture))
editWindowLook :: EditState SelectState !UpdateState -> (!*Picture -> *Picture)
// editWindowLook: defines the look of the editor window. This function
// is used to handle update events.
......@@ -9,25 +9,15 @@ import StdIOCommon
import StdPicture
import EdVisualText, EdVisualCursor, EdVisualLineNr
//import dodebug
trace_n _ f :== f
// editWindowLook: updating the affected areas is done by updating
// 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`
//editWindowLook editState
// = (editState`,editWindowLook`)
where
// editWindowLook` :: !*Picture -> *Picture
editWindowLook` picture
// editWindowLook` selectState updateState=:{ updArea, newFrame, oldFrame } picture
// # picture = traceUpdate updArea picture
# updArea = cleanUpdate updArea // hack around object i/o bug...
// # picture = traceUpdate updArea picture
# picture = vDrawLineNrs fontInfo text newFrame updArea picture
# picture = vUpdateText fontInfo text newFrame updArea picture
# picture = case visible of
......@@ -38,7 +28,7 @@ where
(text,ds2) = getText ds1
(visible,ds3) = getCursorVisibility ds2
(height,ds4) = getCursorHeight ds3
(selection=:{end},(editState`,_)) = getSelection ds4
(selection=:{end},_) = getSelection ds4
/*
import StdDebug,dodebug
......
......@@ -14,7 +14,7 @@ from EdMonad import EditState, EditMonad, StateM
:: EditAction l a :== EditMonad (PSt l) a
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)
appEditState :: !EditId !.(EditAction *l .r) !*(PSt *l) -> *(.r,*PSt *l)
hasEditState :: !EditId !*(PSt .l) -> *(Bool, *PSt .l)
appEditState :: !EditId !.(EditAction .l .r) !*(PSt .l) -> *(.r,*PSt .l)
......@@ -22,14 +22,14 @@ openEditId :: *env -> (EditId, *env) | Ids env
openEditId pstate
= openR2Id pstate
openEditReceiver :: !EditId -> Receiver2 Message Message EditState (PSt *l)
openEditReceiver :: !EditId -> Receiver2 Message Message EditState (PSt .l)
openEditReceiver editId
= Receiver2 editId receive []
// receive a message from the outside world
receive :: Message (EditState, PSt *l) ->
(Message, (EditState, PSt *l))
receive :: Message (EditState, PSt .l) ->
(Message, (EditState, PSt .l))
receive message (editState, pstate)
= case message of
MsgGet -> (MsgState editState, (editState, pstate))
......@@ -38,14 +38,14 @@ receive message (editState, pstate)
// hasEditState
hasEditState :: !EditId !*(PSt *l) -> *(Bool, *PSt *l)
hasEditState :: !EditId !*(PSt .l) -> *(Bool, *PSt .l)
hasEditState editId pstate
# ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate
= (isJust maybeResp, pstate)
// 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
# (editState, pState) = getEditState editId pState
# (x, (editState, pState)) = monad (editState, pState)
......@@ -54,7 +54,7 @@ appEditState editId monad pState
// getEditState
getEditState :: !EditId !*(PSt *l) -> *(EditState, *PSt *l)
getEditState :: !EditId !*(PSt .l) -> *(EditState, *PSt .l)
getEditState editId pstate
# ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate
| isNothing maybeResp
......@@ -64,7 +64,7 @@ getEditState editId pstate
_ -> abort "getEditState (EdMessage.icl): unknown response"
setEditState :: !EditId !EditState !*(PSt *l) -> *PSt *l
setEditState :: !EditId !EditState !*(PSt .l) -> *PSt .l
setEditState editId editState pstate
# ((_, maybeResp), pstate) = syncSend2 editId (MsgState editState) pstate
| isNothing maybeResp
......
......@@ -92,7 +92,7 @@ instance toString UndoState
:: 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
accEnv :: (.env -> (.a, .env)) -> EditMonad .env .a
noResult :: !(EditMonad .env a) *(EditState, .env) -> (EditState, .env)
......@@ -101,35 +101,35 @@ onlyEnv :: !(EditMonad .env a) *(EditState, .env) -> .env
// ACCESSORS & MODIFIERS
getMenuSelection :: EditMonad .env (Maybe String)
setMenuSelection :: (Maybe String) -> EditMonad (PSt *l) nothing
setMenuSelection :: (Maybe String) -> EditMonad (PSt .l) nothing
getUndoInfo :: EditMonad .env UndoInfo
setUndoInfo :: UndoInfo -> EditMonad (PSt *l) nothing
setUndoInfo :: UndoInfo -> EditMonad (PSt .l) nothing
getLineNumbers :: EditMonad .env Bool
setLineNumbers :: !Bool -> EditMonad (PSt *l) nothing
setLineNumbers :: !Bool -> EditMonad (PSt .l) nothing
getNewlineConvention :: EditMonad .env NewlineConvention
setNewlineConvention :: NewlineConvention -> EditMonad (PSt *l) nothing
setNewlineConvention :: NewlineConvention -> EditMonad (PSt .l) nothing
getReadOnly :: EditMonad .env Bool
setReadOnly :: Bool -> EditMonad (PSt *l) nothing
setReadOnly :: Bool -> EditMonad (PSt .l) nothing
getText :: EditMonad .env Text
setText :: !Text -> EditMonad (PSt *l) nothing
setText :: !Text -> EditMonad (PSt .l) nothing
getVirtualX :: EditMonad .env Int
setVirtualX :: Int -> EditMonad (PSt *l) nothing
setVirtualX :: Int -> EditMonad (PSt .l) nothing
getFontInfo :: EditMonad .env FontInfo
setFontInfo :: FontInfo -> EditMonad (PSt *l) nothing
appFontInfo :: (FontInfo -> FontInfo) -> EditMonad (PSt *l) nothing
setFontInfo :: FontInfo -> EditMonad (PSt .l) nothing
appFontInfo :: (FontInfo -> FontInfo) -> EditMonad (PSt .l) nothing
getWindowId :: EditMonad .env Id
getCursorVisibility :: EditMonad .env Bool
setCursorVisibility :: Bool -> EditMonad (PSt *l) nothing
setCursorVisibility :: Bool -> EditMonad (PSt .l) nothing
getSelection :: EditMonad .env Selection
setSelection :: Selection -> EditMonad (PSt *l) nothing
setSelection :: Selection -> EditMonad (PSt .l) nothing
getSelectMode :: EditMonad .env SelectMode
setSelectMode :: SelectMode -> EditMonad (PSt *l) nothing
setSelectMode :: SelectMode -> EditMonad (PSt .l) nothing
getPathName :: EditMonad .env String
setPathName :: String -> EditMonad (PSt *l) nothing
setPathName :: String -> EditMonad (PSt .l) nothing
getNeedSave :: EditMonad .env Bool
setNeedSave :: Bool -> EditMonad (PSt *l) nothing
setNeedSave :: Bool -> EditMonad (PSt .l) nothing
getCursorHeight :: EditMonad .env Int
setFont :: Font -> EditMonad (PSt *l) nothing
setFont :: Font -> EditMonad (PSt .l) nothing
pathNameToWindowTitle :: !String -> String
pathNameToWindowTitle` :: !String -> String
......@@ -139,9 +139,9 @@ from StdIOBasic import Point2
getTimerId :: EditMonad .env Id
getToolPt :: EditMonad .env Point2
setToolPt :: Point2 -> EditMonad (PSt *l) nothing
setToolPt :: Point2 -> EditMonad (PSt .l) nothing
//--
getState :: EditMonad (PSt *l) IRState
setState :: IRState -> EditMonad (PSt *l) nothing
getState :: EditMonad (PSt .l) IRState
setState :: IRState -> EditMonad (PSt .l) nothing
......@@ -137,7 +137,7 @@ getLineNumbers =
getEditState >>>= \{lineNumbers} ->
result lineNumbers
setLineNumbers :: !Bool -> EditMonad (PSt *l) nothing
setLineNumbers :: !Bool -> EditMonad (PSt .l) nothing
setLineNumbers linenumbers =
updateEditState update >>>
getEditState >>>= \{windowId} ->
......@@ -154,7 +154,7 @@ where
/* 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
# (tId,pstate) = openId pstate // P4
# (fontInfo, pstate) = computeFontInfo font tabs syncols pstate
......@@ -223,7 +223,7 @@ getMenuSelection =
getEditState >>>= \{menusel} ->
result menusel
setMenuSelection :: (Maybe String) -> EditMonad (PSt *l) nothing
setMenuSelection :: (Maybe String) -> EditMonad (PSt .l) nothing
setMenuSelection menusel =
updateEditState update
where
......@@ -234,7 +234,7 @@ getNewlineConvention =
getEditState >>>= \{newlineConv} ->
result newlineConv
setNewlineConvention :: NewlineConvention -> EditMonad (PSt *l) nothing
setNewlineConvention :: NewlineConvention -> EditMonad (PSt .l) nothing
setNewlineConvention newlineConv =
updateEditState update
where
......@@ -245,7 +245,7 @@ getReadOnly =
getEditState >>>= \{readOnly} ->
result readOnly
setReadOnly :: Bool -> EditMonad (PSt *l) nothing
setReadOnly :: Bool -> EditMonad (PSt .l) nothing
setReadOnly readOnly =
updateEditState update
where
......@@ -256,7 +256,7 @@ getText
= getEditState >>>= \{text} ->
result text
setText :: !Text -> EditMonad (PSt *l) nothing
setText :: !Text -> EditMonad (PSt .l) nothing
setText text =
updateEditState update >>>
updateLook
......@@ -269,14 +269,14 @@ getFontInfo
= getEditState >>>= \{fontInfo} ->
result fontInfo
setFontInfo :: FontInfo -> EditMonad (PSt *l) nothing
setFontInfo :: FontInfo -> EditMonad (PSt .l) nothing
setFontInfo fontInfo =
updateEditState update
where
update editState
= {editState & fontInfo=fontInfo}
appFontInfo :: (FontInfo -> FontInfo) -> EditMonad (PSt *l) nothing
appFontInfo :: (FontInfo -> FontInfo) -> EditMonad (PSt .l) nothing
appFontInfo fontFun =
updateEditState update >>>
updateLook
......@@ -288,7 +288,7 @@ getCursorVisibility
= getEditState >>>= \{cursorInfo} ->
result cursorInfo.visible
setCursorVisibility :: Bool -> EditMonad (PSt *l) nothing
setCursorVisibility :: Bool -> EditMonad (PSt .l) nothing
setCursorVisibility visible =
updateEditState update >>>
updateLook
......@@ -301,7 +301,7 @@ getSelection
= getEditState >>>= \{selectInfo={selection}} ->
result selection
setSelection :: Selection -> EditMonad (PSt *l) nothing
setSelection :: Selection -> EditMonad (PSt .l) nothing
setSelection selection =
updateEditState update >>>
updateLook
......@@ -314,7 +314,7 @@ getVirtualX
= getEditState >>>= \{cursorInfo={virtualX}} ->
result virtualX
setVirtualX :: Int -> EditMonad (PSt *l) nothing
setVirtualX :: Int -> EditMonad (PSt .l) nothing
setVirtualX virtualX
= updateEditState update
where
......@@ -326,7 +326,7 @@ getSelectMode
= getEditState >>>= \{selectInfo={selectMode}} ->
result selectMode
setSelectMode :: SelectMode -> EditMonad (PSt *l) nothing
setSelectMode :: SelectMode -> EditMonad (PSt .l) nothing
setSelectMode selectMode
= updateEditState update
where
......@@ -343,7 +343,7 @@ getWindowId
= getEditState >>>= \{windowId} ->
result windowId
setFont :: Font -> EditMonad (PSt *l) nothing
setFont :: Font -> EditMonad (PSt .l) nothing
setFont font = monad
where
monad (editState,pState)
......@@ -366,7 +366,7 @@ where
update fontInfo editState
= { editState & fontInfo = fontInfo }
updateEditState :: (EditState -> EditState) -> EditMonad (PSt *l) nothing
updateEditState :: (EditState -> EditState) -> EditMonad (PSt .l) nothing
updateEditState editStateFun
= updateEditState`
where
......@@ -378,19 +378,15 @@ where
// look function is not applied, so no visible update is
// caused by updateLook.
updateLook :: EditMonad (PSt *l) nothing
updateLook :: EditMonad (PSt .l) nothing
updateLook
= getWindowId >>>= \windowId ->
getEditState >>>= \editState ->
// let
// (editState,editLook) = editWindowLook editState
// in
// appEnv (appPIO (setWindowLook windowId False (True,editLook)))
appEnv (appPIO (setWindowLook windowId False (True,editWindowLook editState)))
// 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
# (metrics, pstate) = accPIO (accScreenPicture (getFontMetrics font)) pstate
lineHeight = metrics.fAscent + metrics.fDescent + metrics.fLeading
......@@ -426,7 +422,7 @@ getPathName =
getEditState >>>= \{pathName} ->
result pathName
setPathName :: String -> EditMonad (PSt *l) nothing
setPathName :: String -> EditMonad (PSt .l) nothing
setPathName path =
updateEditState update
where
......@@ -474,7 +470,7 @@ where
= FindLastChar c s (dec i);
setNeedSave :: Bool -> EditMonad (PSt *l) nothing
setNeedSave :: Bool -> EditMonad (PSt .l) nothing
setNeedSave need =
getReadOnly >>>= \readOnly ->
getEditState >>>= \{windowId,pathName} ->
......@@ -524,7 +520,7 @@ getUndoInfo
= getEditState >>>= \{undoInfo} ->
result undoInfo
setUndoInfo :: UndoInfo -> EditMonad (PSt *l) nothing
setUndoInfo :: UndoInfo -> EditMonad (PSt .l) nothing
setUndoInfo undoInfo
= getEditState >>>= \{/*undomId,*/undoeId} ->
appEnv (appPIO (mfun undoeId)) >>>
......@@ -549,7 +545,7 @@ getToolPt
= getEditState >>>= \{toolPt} ->
result toolPt
setToolPt :: Point2 -> EditMonad (PSt *l) nothing
setToolPt :: Point2 -> EditMonad (PSt .l) nothing
setToolPt toolPt =
updateEditState update
where
......@@ -557,12 +553,12 @@ where
//--
getState :: EditMonad (PSt *l) IRState
getState :: EditMonad (PSt .l) IRState
getState =
getEditState >>>= \{text,selectInfo={selection,selectMode},cursorInfo={virtualX,visible},needSave} ->
result {txt=text,sel=selection,mod=selectMode,vix=virtualX,vis=visible,ns=needSave}
setState :: IRState -> EditMonad (PSt *l) nothing
setState :: IRState -> EditMonad (PSt .l) nothing
setState state =
updateEditState update >>>
updateLook >>>
......
......@@ -26,7 +26,7 @@ instance == Movement
instance toString Movement
instance fromString Movement
positionAfterMove :: !Movement !Position -> EditMonad (PSt *l) Position
positionAfterMove :: !Movement !Position -> EditMonad (PSt .l) Position
isVerticalMove :: !Movement -> Bool
selectWordAt :: !Position -> EditMonad .env Selection
allMovements :: [Movement]
......@@ -71,7 +71,7 @@ where
"end of text" -> EndOfText
_ -> StartOfText // silly default
positionAfterMove :: !Movement !Position -> EditMonad (PSt *l) Position
positionAfterMove :: !Movement !Position -> EditMonad (PSt .l) Position
positionAfterMove movement position
= fun position
where
......@@ -94,16 +94,16 @@ isVerticalMove :: !Movement -> Bool
isVerticalMove movement
= isMember movement [ LineUp, LineDown, PageUp, PageDown ]
lineUp :: Position -> EditMonad (PSt *l) Position
lineUp :: Position -> EditMonad (PSt .l) Position
lineUp position
= verticalMove 0 (~1) position
lineDown :: Position -> EditMonad (PSt *l) Position
lineDown :: Position -> EditMonad (PSt .l) Position
lineDown position
= getText >>>= \text ->
verticalMove (textLength text - 1) 1 position
charLeft :: Position -> EditMonad (PSt *l) Position
charLeft :: Position -> EditMonad (PSt .l) Position
charLeft {col, row}
= getText >>>= \text ->
let previousLine = fst (getLine (row - 1) text) in
......@@ -120,7 +120,7 @@ charLeft {col, row}
result { col=col-1, row=row} // one position to the left
)
charRight :: Position -> EditMonad (PSt *l) Position
charRight :: Position -> EditMonad (PSt .l) Position
charRight {col, row}
= getText >>>= \text ->
let currentLine = fst (getLine row text) in
......@@ -239,7 +239,7 @@ isFunnyChar c = isMember c ['~@#$%^?!+-*<>\\/|&=:.']
isWhiteSpace c = isMember c [' \t\r\n\f\b']
otherChar c = (==) c
pageUp :: Position -> EditMonad (PSt *l) Position
pageUp :: Position -> EditMonad (PSt .l) Position
pageUp position=:{col,row} =
getViewFrame >>>= \frame ->
getFontInfo >>>= \{lineHeight} ->
......@@ -254,7 +254,7 @@ pageUp position=:{col,row} =
in
verticalMove 0 rowChange position
pageDown :: Position -> EditMonad (PSt *l) Position
pageDown :: Position -> EditMonad (PSt .l) Position
pageDown position=:{col,row} =
getViewFrame >>>= \frame ->
getFontInfo >>>= \fontInfo=:{lineHeight} ->
......@@ -296,7 +296,7 @@ where
# {col=newCol} = pointToPosition virtualPoint text fontInfo
= (newVirtualX,newCol)
verticalMove :: Int Int Position -> EditMonad (PSt *l) Position
verticalMove :: Int Int Position -> EditMonad (PSt .l) Position
verticalMove endReached rowChange position=:{col, row} =
getFontInfo >>>= \fontInfo=:{lineHeight} ->
getVirtualX >>>= \virtualX ->
......
......@@ -28,24 +28,24 @@ vUpdateCursor :: !Bool !Position !Int !FontInfo !Text !ViewFrame ![Rectangle]
-> (*Picture -> *Picture)
// vUpdateCursor: updates the cursor
vShowCursor :: EditMonad (PSt *l) nothing
vHideCursor :: EditMonad (PSt *l) nothing
vShowCursor :: EditMonad (PSt .l) nothing
vHideCursor :: EditMonad (PSt .l) nothing
// exported only for use by mouse functions to hide cursor during mouse edits
vCenterCursor :: EditMonad (PSt *l) nothing
vCenterCursor :: EditMonad (PSt .l) nothing
// vCenterCursor: checks to see whether the cursor is within the view frame.
// If it is not, the cursor is centered in the directions in which
// it is necessary to make the cursor visible.
vScrollToCursor :: EditMonad (PSt *l) nothing
vScrollToCursor :: EditMonad (PSt .l) nothing
// vScrollToCursor: scrolls the view frame up to the point that the cursor
// becomes visible.
vMoveCursor :: !Movement -> EditMonad (PSt *l) nothing
vMoveCursor :: !Movement -> EditMonad (PSt .l) nothing
vDoCursorSafe :: (EditMonad (PSt *l) a) -> EditMonad (PSt *l) a
vDoCursorSafe :: (EditMonad (PSt .l) a) -> EditMonad (PSt .l) a
vChangeSelectionTo :: Selection -> EditMonad (PSt *l) nothing
vChangeSelectionTo :: Selection -> EditMonad (PSt .l) nothing
// vChangeSelectionTo: changes the selection from the current selection
// to the given selection and redraws, so that the display
// reflects this change
......@@ -56,4 +56,4 @@ vUpdateSelection :: !Selection FontInfo Text ViewFrame [Rectangle]
// vUpdateSelection: updates the selection in the frame
// within the given update area
vRemoveSelection :: EditMonad (PSt *l) nothing
vRemoveSelection :: EditMonad (PSt .l) nothing
......@@ -28,13 +28,13 @@ import ioutil, StrictList
//--
vCenterCursor :: EditMonad (PSt *l) nothing
vCenterCursor :: EditMonad (PSt .l) nothing
vCenterCursor = vMakeCursorVisible True
vScrollToCursor :: EditMonad (PSt *l) nothing
vScrollToCursor :: EditMonad (PSt .l) nothing
vScrollToCursor = vMakeCursorVisible False
vMakeCursorVisible :: !Bool -> EditMonad (PSt *l) nothing
vMakeCursorVisible :: !Bool -> EditMonad (PSt .l) nothing
vMakeCursorVisible center =
getWindowId >>>= \windowId ->
accEnv (accPIO (getWindowViewFrame windowId)) >>>= \viewFrame ->
......@@ -79,7 +79,7 @@ vMakeCursorVisible center =
appEnv (appPIO (moveWindowViewFrame windowId vector))
)
vMoveCursor :: !Movement -> EditMonad (PSt *l) nothing
vMoveCursor :: !Movement -> EditMonad (PSt .l) nothing
vMoveCursor move =
getWindowId >>>= \windowId ->
accEnv (accPIO (getWindowViewFrame windowId)) >>>= \viewFrame ->
......@@ -113,13 +113,13 @@ vMoveCursor move =
//---
vDoCursorSafe :: (EditMonad (PSt *l) a) -> EditMonad (PSt *l) a
vDoCursorSafe :: (EditMonad (PSt .l) a) -> EditMonad (PSt .l) a
vDoCursorSafe operation =
vHideCursor >>>
operation >>>
vShowCursor
vShowCursor :: EditMonad (PSt *l) nothing
vShowCursor :: EditMonad (PSt .l) nothing
vShowCursor =
getSelection >>>= \selection=:{end} ->
IF (isEmptySelection selection)
......@@ -139,7 +139,7 @@ vShowCursor =
)
ELSE (skip)
vHideCursor :: EditMonad (PSt *l) nothing
vHideCursor :: EditMonad (PSt .l) nothing
vHideCursor =
getCursorVisibility >>>= \visible ->
IF visible
......@@ -196,7 +196,7 @@ vUpdateSelection selection fontInfo text frame rects =
vHiliteSelection frame rects text fontInfo clippedSelection
)
vChangeSelectionTo :: Selection -> EditMonad (PSt *l) nothing
vChangeSelectionTo :: Selection -> EditMonad (PSt .l) nothing
vChangeSelectionTo newSelection =
// retrieve the current selection from the state and then
// update the state with the new selection
......@@ -225,7 +225,7 @@ vHiliteSelection frame upds text fontInfo selection pic
# rects = selToRects selection frame text fontInfo
= appClipPicture (toRegion upds)(seq(map hilite rects) ) pic
vRemoveSelection :: EditMonad (PSt *l) nothing
vRemoveSelection :: EditMonad (PSt .l) nothing
vRemoveSelection =
getSelection >>>= \selection ->
let orderedSelection = orderSelection selection
......
......@@ -16,22 +16,22 @@ vUpdateText :: !FontInfo !Text !ViewFrame ![Rectangle] -> (*Picture -> *Picture
// vUpdateText: updates the text in the rectangles within
// the given view frame
vInsertText :: Position TextFragment -> EditMonad (PSt *l) nothing
vInsertText :: Position TextFragment -> EditMonad (PSt .l) nothing
// vInsertText: inserts a piece of text into the visual text
// (assumes that the position where the insert takes place is visible)
vAppendLines :: TextFragment -> EditMonad (PSt *l) nothing
vAppendText :: TextFragment -> EditMonad (PSt *l) nothing
vAppendLines :: TextFragment -> EditMonad (PSt .l) nothing
vAppendText :: TextFragment -> EditMonad (PSt .l) nothing
vRemoveText :: !Selection -> EditMonad (PSt *l) nothing
vRemoveText :: !Selection -> EditMonad (PSt .l) nothing
// vRemoveText: removes a piece of text from the visual text.
// (assumes that the first position in the selection is visible)
computeViewDomain :: EditMonad .env ViewDomain
getViewFrame :: EditMonad (PSt *l) ViewFrame
vResetViewDomain :: EditMonad !(PSt *l) nothing
vTextUpdate :: !Position Int -> EditMonad (PSt *l) nothing
vDraw :: (*Picture -> *Picture) -> EditMonad (PSt *l) a
getViewFrame :: EditMonad (PSt .l) ViewFrame
vResetViewDomain :: EditMonad !(PSt .l) nothing
vTextUpdate :: !Position Int -> EditMonad (PSt .l) nothing
vDraw :: (*Picture -> *Picture) -> EditMonad (PSt .l) a
pointToPosition :: !Point2 !Text !FontInfo -> Position
positionToPoint :: !Position !Text !FontInfo -> Point2
......
......@@ -58,7 +58,7 @@ where
MAX_LINE_WIDTH = 2000
//\\//\\//\\//\\//
getViewFrame :: EditMonad (PSt *l) ViewFrame
getViewFrame :: EditMonad (PSt .l) ViewFrame
getViewFrame
= getWindowId >>>= \windowId ->
accEnv (accPIO (getWindowViewFrame windowId))
......@@ -69,7 +69,7 @@ vUpdateText :: !FontInfo !Text !ViewFrame ![Rectangle] -> (*Picture -> *Picture)
vUpdateText fontInfo text frame rectangles
= seqmap (vUpdateRectangle text fontInfo) rectangles
vInsertText :: Position TextFragment -> EditMonad (PSt *l) nothing
vInsertText :: Position TextFragment -> EditMonad (PSt .l) nothing
vInsertText position textFragment =
getText >>>= \text ->
let (fin,newText) = insertText position textFragment text
......@@ -81,7 +81,7 @@ vInsertText position textFragment =
ELSE
(vTextUpdate position (fromJust fin - position.row + 1))
vAppendLines :: TextFragment -> EditMonad (PSt *l) nothing
vAppendLines :: TextFragment -> EditMonad (PSt .l) nothing
vAppendLines textFragment =
getText >>>= \text ->
let
......@@ -104,7 +104,7 @@ where
#! pState = appPIO (setWindowViewDomain windowId viewDomain) pState
= (undef,(editState,pState))
vAppendText :: TextFragment -> EditMonad (PSt *l) nothing
vAppendText :: TextFragment -> EditMonad (PSt .l) nothing
vAppendText textFragment =
getText >>>= \text ->
let
......@@ -128,7 +128,7 @@ where
= (undef,(editState,pState))
vRemoveText :: !Selection -> EditMonad (PSt *l) nothing
vRemoveText :: !Selection -> EditMonad (PSt .l) nothing
vRemoveText selection=:{ start=start=:{ col=col1,row=row1 }
, end={ col=col2,row=row2 }
}
......@@ -203,7 +203,7 @@ where
# picture = drawTextLines (y + lineHeight) strings picture
= picture
vTextUpdate :: !Position Int -> EditMonad (PSt *l) nothing
vTextUpdate :: !Position Int -> EditMonad (PSt .l) nothing
vTextUpdate position=:{row} numLines =
getText >>>= \text ->
getViewFrame >>>= \frame ->
......@@ -235,7 +235,7 @@ vTextUpdate position=:{row} numLines =
// vResetViewDomain changes the view domain, so that the current visual
// text fits in the window.
vResetViewDomain :: EditMonad !(PSt *l) nothing
vResetViewDomain :: EditMonad !(PSt .l) nothing
vResetViewDomain = monad
where
monad (editState,pState)
......@@ -256,7 +256,7 @@ where
#! pState = appPIO (updateWindow windowId Nothing) pState // quick fix for changed setViewDomain interpretation...
= (undef,(editState,pState))
vDraw :: (*Picture -> *Picture) -> EditMonad (PSt *l) a
vDraw :: (*Picture -> *Picture) -> EditMonad (PSt .l) a
vDraw drawFun =
getWindowId >>>= \windowId ->
appEnv (appPIO (appWindowPicture windowId drawFun))
......
......@@ -11,18 +11,18 @@ instance Controls ListBoxControl
openListBoxId :: !*env -> (!ListBoxId,!*env) | Ids env
getListBoxSelection :: !ListBoxId !(PSt *l) -> (!(!Bool,![(String,!Index)]),!PSt *l)
setListBoxSelection :: !ListBoxId ![Index] !(PSt *l) -> PSt *l
getListBoxItems :: !ListBoxId !(PSt *l) -> (!(!Bool,![String]),!PSt *l)
openListBoxItems :: !ListBoxId !Index ![String] !(PSt *l) -> PSt *l
appendListBoxItems :: !ListBoxId ![String] !(PSt *l) -> PSt *l
closeListBoxItems :: !ListBoxId ![Index] !(PSt *l) -> PSt *l
closeAllListBoxItems :: !ListBoxId !(PSt *l) -> PSt *l
upListBoxSelItem :: !ListBoxId !*([a],!*PSt *l) -> *(Bool,*([a],*PSt *l))
dnListBoxSelItem :: !ListBoxId !*([a],!*PSt *l) -> *(Bool,*([a],*PSt *l))
showListBoxControl :: !ListBoxId !*(IOSt *l) -> *IOSt *l
hideListBoxControl :: !ListBoxId !*(IOSt *l) -> *IOSt *l
enableListBoxControl :: !ListBoxId !*(IOSt *l) -> *IOSt *l
disableListBoxControl :: !ListBoxId !*(IOSt *l) -> *IOSt *l
getListBoxSelection :: !ListBoxId !(PSt .l) -> (!(!Bool,![(String,!Index)]),!PSt .l)
setListBoxSelection :: !ListBoxId ![Index] !(PSt .l) -> PSt .l
getListBoxItems :: !ListBoxId !(PSt .l) -> (!(!Bool,![String]),!PSt .l)
openListBoxItems :: !ListBoxId !Index ![String] !(PSt .l) -> PSt .l
appendListBoxItems :: !ListBoxId ![String] !(PSt .l) -> PSt .l
closeListBoxItems :: !ListBoxId ![Index] !(PSt .l) -> PSt .l
closeAllListBoxItems :: !ListBoxId !(PSt .l) -> PSt .l
upListBoxSelItem :: !ListBoxId !*([a],!*PSt .l) -> *(Bool,*([a],*PSt .l))
dnListBoxSelItem :: !ListBoxId !*([a],!*PSt .l) -> *(Bool,*([a],*PSt .l))
showListBoxControl :: !ListBoxId !*(IOSt .l) -> *IOSt .l
hideListBoxControl :: !ListBoxId !*(IOSt .l) -> *IOSt .l
enableListBoxControl :: !ListBoxId !*(IOSt .l) -> *IOSt .l
disableListBoxControl :: !ListBoxId !*(IOSt .l) -> *IOSt .l
......@@ -125,7 +125,7 @@ mouseFilter (MouseDown _ _ ddown) = ddown==1
mouseFilter _ = False
// The mouse either sets, adds, or removes items to the selection:
//mouse :: MouseState (ListBoxState,PSt *l) -> (ListBoxState,PSt *l)
//mouse :: MouseState (ListBoxState,PSt .l) -> (ListBoxState,PSt .l)
mouse metrics (MouseDown pos {shiftDown} _) ((listboxState,ls),ps)
# listboxState = {ListBoxState | listboxState & selection=okSelection}
# (listboxState,newLook)
......@@ -277,7 +277,7 @@ openListBoxId env
// The functions below take care of the proper communication with the receiver that
// belongs to the listbox control.
getListBoxSelection :: !ListBoxId !(PSt *l) -> (!(!Bool,![(String,!Index)]),!PSt *l)
getListBoxSelection :: !ListBoxId !(PSt .l) -> (!(!Bool,![(String,!Index)]),!PSt .l)
getListBoxSelection {r2Id} ps
# ((_,maybe_out),ps) = syncSend2 r2Id InGetSelection ps
| isNothing maybe_out
......@@ -288,11 +288,11 @@ getListBoxSelection {r2Id} ps
| otherwise
= (result,ps)
setListBoxSelection :: !ListBoxId ![Index] !(PSt *l) -> PSt *l
setListBoxSelection :: !ListBoxId ![Index] !(PSt .l) -> PSt .l
setListBoxSelection {r2Id} selection ps
= snd (syncSend2 r2Id (InSetSelection selection) ps)
getListBoxItems :: !ListBoxId !(PSt *l) -> (!(!Bool,![String]),!PSt *l)
getListBoxItems :: !ListBoxId !(PSt .l) -> (!(!Bool,![String]),!PSt .l)
getListBoxItems {r2Id} ps
# ((_,maybe_out),ps) = syncSend2 r2Id InGetItems ps
| isNothing maybe_out
......@@ -303,23 +303,23 @@ getListBoxItems {r2Id} ps
| otherwise
= (result,ps)
openListBoxItems :: !ListBoxId !Index ![String] !(PSt *l) -> PSt *l
openListBoxItems :: !ListBoxId !Index ![String] !(PSt .l) -> PSt .l
openListBoxItems {r2Id} index items ps
= snd (syncSend2 r2Id (InOpenItems index items) ps)