Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-ide
Commits
202b7ac8
Commit
202b7ac8
authored
Oct 24, 2001
by
Diederik van Arkel
Browse files
refix unique types
parent
755dccc9
Changes
18
Hide whitespace changes
Inline
Side-by-side
Ed/EdAction.dcl
View file @
202b7ac8
...
...
@@ -34,4 +34,4 @@ from EdActionType import Action
performAction
::
Action
->
EditMonad
(
PSt
PLocState
)
nothing
undoAction
::
EditMonad
(
PSt
*
l
)
nothing
undoAction
::
EditMonad
(
PSt
.
l
)
nothing
Ed/EdAction.icl
View file @
202b7ac8
...
...
@@ -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
->
...
...
Ed/EdKeyMapping.dcl
View file @
202b7ac8
...
...
@@ -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
...
...
Ed/EdKeyMapping.icl
View file @
202b7ac8
...
...
@@ -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
)
...
...
Ed/EdLook.dcl
View file @
202b7ac8
...
...
@@ -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.
Ed/EdLook.icl
View file @
202b7ac8
...
...
@@ -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
...
...
Ed/EdMessage.dcl
View file @
202b7ac8
...
...
@@ -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
)
Ed/EdMessage.icl
View file @
202b7ac8
...
...
@@ -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
...
...
Ed/EdMonad.dcl
View file @
202b7ac8
...
...
@@ -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
Ed/EdMonad.icl
View file @
202b7ac8
...
...
@@ -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
>>>
...
...
Ed/EdMovement.dcl
View file @
202b7ac8
...
...
@@ -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
]
Ed/EdMovement.icl
View file @
202b7ac8
...
...
@@ -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
->
...
...
Ed/EdVisualCursor.dcl
View file @
202b7ac8
...
...
@@ -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
Ed/EdVisualCursor.icl
View file @
202b7ac8
...
...
@@ -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 =