Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
clean-and-itasks
clean-ide
Commits
202b7ac8
Commit
202b7ac8
authored
Oct 24, 2001
by
Diederik van Arkel
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
refix unique types
parent
755dccc9
Changes
18
Hide whitespace changes
Inline
Side-by-side
Showing
18 changed files
with
131 additions
and
150 deletions
+131
-150
Ed/EdAction.dcl
Ed/EdAction.dcl
+1
-1
Ed/EdAction.icl
Ed/EdAction.icl
+2
-2
Ed/EdKeyMapping.dcl
Ed/EdKeyMapping.dcl
+1
-1
Ed/EdKeyMapping.icl
Ed/EdKeyMapping.icl
+3
-6
Ed/EdLook.dcl
Ed/EdLook.dcl
+0
-2
Ed/EdLook.icl
Ed/EdLook.icl
+2
-12
Ed/EdMessage.dcl
Ed/EdMessage.dcl
+3
-3
Ed/EdMessage.icl
Ed/EdMessage.icl
+7
-7
Ed/EdMonad.dcl
Ed/EdMonad.dcl
+19
-19
Ed/EdMonad.icl
Ed/EdMonad.icl
+22
-26
Ed/EdMovement.dcl
Ed/EdMovement.dcl
+1
-1
Ed/EdMovement.icl
Ed/EdMovement.icl
+8
-8
Ed/EdVisualCursor.dcl
Ed/EdVisualCursor.dcl
+8
-8
Ed/EdVisualCursor.icl
Ed/EdVisualCursor.icl
+9
-9
Ed/EdVisualText.dcl
Ed/EdVisualText.dcl
+8
-8
Ed/EdVisualText.icl
Ed/EdVisualText.icl
+8
-8
Util/StdListBox.dcl
Util/StdListBox.dcl
+15
-15
Util/StdListBox.icl
Util/StdListBox.icl
+14
-14
No files found.
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 =
appEnv
(
appPIO
(
moveWindowViewFrame
windowId
vector
))
)