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
2d67a49a
Commit
2d67a49a
authored
Oct 08, 2001
by
Diederik van Arkel
Browse files
More Editor state threading
parent
18653865
Changes
14
Hide whitespace changes
Inline
Side-by-side
Ed/EdLook.dcl
View file @
2d67a49a
...
...
@@ -15,7 +15,7 @@ from StdString import String
from
StdPSt
import
PSt
,
IOSt
import
EdMonad
editWindowLook
::
EditState
SelectState
!
UpdateState
->
(!*
Picture
->
*
Picture
)
editWindowLook
::
EditState
->
(
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 @
2d67a49a
...
...
@@ -15,12 +15,12 @@ trace_n _ f :== f
// editWindowLook: updating the affected areas is done by updating
// each of the rectangles.
editWindowLook
::
EditState
SelectState
!
UpdateState
->
(!*
Picture
->
*
Picture
)
editWindowLook
editState
selectState
updateState
=:{
updArea
,
newFrame
,
oldFrame
}
=
trace_n
(
"Look"
,
update
State
)
editWindowLook`
editWindowLook
::
EditState
->
(
EditState
,
SelectState
!
UpdateState
->
(!*
Picture
->
*
Picture
)
)
editWindowLook
editState
=
(
edit
State
`
,
editWindowLook`
)
where
editWindowLook`
::
!*
Picture
->
*
Picture
editWindowLook`
picture
//
editWindowLook` :: !*Picture -> *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
...
...
@@ -34,7 +34,7 @@ where
(
text
,
ds2
)
=
getText
ds1
(
visible
,
ds3
)
=
getCursorVisibility
ds2
(
height
,
ds4
)
=
getCursorHeight
ds3
(
selection
=:{
end
},
_
)
=
getSelection
ds4
(
selection
=:{
end
},
(
editState`
,_)
)
=
getSelection
ds4
/*
import StdDebug,dodebug
...
...
Ed/EdMessage.dcl
View file @
2d67a49a
...
...
@@ -7,15 +7,14 @@ definition module EdMessage
from
StdId
import
Id
,
RId
,
Ids
from
StdPSt
import
PSt
,
IOSt
from
StdReceiver
import
Receiver2
,
R2Id
,
Receiver2Function
,
ReceiverAttribute
from
EdMonad
import
EditState
from
EdMonad
import
EditState
,
EditMonad
::
EditId
::
Message
::
EditAction
l
a
:==
EditMonad
(
PSt
l
)
a
openEditId
::
*
env
->
(
EditId
,
*
env
)
|
Ids
env
openEditReceiver
::
!
EditId
->
Receiver2
Message
Message
EditState
(
PSt
*
l
)
hasEditState
::
!
EditId
!*(
PSt
*
l
)
->
*(
Bool
,
*
PSt
*
l
)
getEditState
::
!
EditId
!*(
PSt
*
l
)
->
*(
EditState
,
*
PSt
*
l
)
setEditState
::
!
EditId
!
EditState
!*(
PSt
*
l
)
->
*
PSt
*
l
hasEditState
::
!
EditId
!*(
PSt
*
l
)
->
*(
Bool
,
*
PSt
*
l
)
appEditState
::
!
EditId
!.(
EditAction
*
l
.
r
)
!*(
PSt
*
l
)
->
*(.
r
,*
PSt
*
l
)
Ed/EdMessage.icl
View file @
2d67a49a
...
...
@@ -16,6 +16,8 @@ import EdMonad
|
MsgGet
// ask for the state
|
MsgOk
// signifies that a send operation was successful
::
EditAction
l
a
:==
EditMonad
(
PSt
l
)
a
openEditId
::
*
env
->
(
EditId
,
*
env
)
|
Ids
env
openEditId
pstate
=
openR2Id
pstate
...
...
@@ -41,6 +43,15 @@ 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
monad
pState
#
(
editState
,
pState
)
=
getEditState
editId
pState
#
(
x
,
(
editState
,
pState
))
=
monad
(
editState
,
pState
)
#
pState
=
setEditState
editId
editState
pState
=
(
x
,
pState
)
// getEditState
getEditState
::
!
EditId
!*(
PSt
*
l
)
->
*(
EditState
,
*
PSt
*
l
)
...
...
Ed/EdMonad.icl
View file @
2d67a49a
...
...
@@ -382,7 +382,10 @@ updateLook :: EditMonad (PSt *l) nothing
updateLook
=
getWindowId
>>>=
\
windowId
->
getEditState
>>>=
\
editState
->
appEnv
(
appPIO
(
setWindowLook
windowId
False
(
True
,
editWindowLook
editState
)))
let
(
editState
,
editLook
)
=
editWindowLook
editState
in
appEnv
(
appPIO
(
setWindowLook
windowId
False
(
True
,
editLook
)))
// compute some properties of a font
...
...
Ed/EdState.dcl
View file @
2d67a49a
...
...
@@ -22,7 +22,7 @@ instance Editor (PSt *p) | Editor p
initEditorState
::
!
KeyMapping
->
EditorState
findReceiver
::
!
Id
!
EditorState
->
Maybe
EditId
findReceiver
::
!
Id
!
EditorState
->
(!
Maybe
EditId
,
!
EditorState
)
addReceiver
::
Id
EditId
!
EditorState
->
EditorState
removeReceiver
::
Id
!
EditorState
->
EditorState
...
...
Ed/EdState.icl
View file @
2d67a49a
...
...
@@ -46,10 +46,10 @@ removeReceiver windowId editorState=:{ windows }
// lookup the window identification number in the global administration
findReceiver
::
!
Id
!
EditorState
->
Maybe
EditId
findReceiver
windowId
{
windows
}
|
isEmpty
matches
=
Nothing
|
otherwise
=
Just
(
hd
matches
)
findReceiver
::
!
Id
!
EditorState
->
(!
Maybe
EditId
,
!
EditorState
)
findReceiver
windowId
(
es
=:
{
windows
}
)
|
isEmpty
matches
=
(
Nothing
,
es
)
|
otherwise
=
(
Just
(
hd
matches
)
,
es
)
where
matches
=
tableLookup
windowId
windows
Ed/EdWindow.icl
View file @
2d67a49a
...
...
@@ -24,13 +24,14 @@ openEditWindow uId title pathName text font tabs syncols windowId atts ps
// compute the view domain of the visual text
(
viewDomain
,
(
editState
,
ps
))
=
computeViewDomain
(
editState
,
ps
)
// setup the window attributes
(
editState
,
editLook
)
=
editWindowLook
editState
windowAttrs
=
atts
++
// in this order so that new attributes override default atts
[
WindowViewSize
{
w
=
800
,
h
=
fontInfo
.
FontInfo
.
lineHeight
*
40
}
,
WindowHMargin
0
0
,
WindowVMargin
0
0
,
WindowId
windowId
,
WindowViewDomain
viewDomain
,
WindowLook
True
(
edit
WindowLook
editState
)
,
WindowLook
True
edit
Look
,
WindowHScroll
(
hScrollFun
fontInfo
)
,
WindowVScroll
(
vScrollFun
fontInfo
)
,
WindowPos
(
Fix
,
OffsetVector
{
vx
=
10
,
vy
=
10
})
...
...
@@ -48,11 +49,12 @@ openEditWindow uId title pathName text font tabs syncols windowId atts ps
closeEditWindow
::
!
Id
!*(
PSt
*
b
)
->
*
PSt
*
b
|
Editor
b
;
closeEditWindow
windowId
pState
#
(
editorState
,
pState
)
=
getEditorState
pState
#
notEdit
=
isNothing
(
findReceiver
windowId
editorState
)
|
notEdit
=
setEditorState
editorState
pState
#
editorState
=
removeReceiver
windowId
editorState
pState
=
closeWindow
windowId
pState
#
(
editorState
,
pState
)
=
getEditorState
pState
#
(
maybeEditId
,
editorState
)
=
findReceiver
windowId
editorState
|
isNothing
maybeEditId
=
setEditorState
editorState
pState
#
editorState
=
removeReceiver
windowId
editorState
pState
=
closeWindow
windowId
pState
=
setEditorState
editorState
pState
/**********************
...
...
Editor/EdClient.dcl
View file @
2d67a49a
definition
module
EdClient
import
EdMonad
,
EdState
,
EdCommon
from
EdMessage
import
EditAction
sendToActiveWindow
::
.(*(
EditState
,*
PSt
*
b
)
->
*(.
c
,*(.
EditState
,*
PSt
*
b
)))
!*(
PSt
*
b
)
->
*(
Maybe
.
c
,*
PSt
*
b
)
|
Editor
b
message
::
!.
Id
!.(*(
EditState
,*
PSt
*
b
)
->
*(.
c
,*(.
EditState
,*
PSt
*
b
)))
!*(
PSt
*
b
)
->
*(
Maybe
.
c
,*
PSt
*
b
)
|
Editor
b
;
::
EditAction
l
a
:==
EditMonad
(
PSt
l
)
a
// Messages
msgSave
::
EditAction
*
l
nothing
...
...
Editor/EdClient.icl
View file @
2d67a49a
...
...
@@ -12,13 +12,13 @@ import ExtNotice, StrictList
//sendToActiveWindow :: (EditAction .l .p a) (EditorState,(PSt .l)) -> (Maybe a, (EditorState,(PSt .l)))
sendToActiveWindow
::
.(*(
EditState
,*
PSt
*
b
)
->
*(.
c
,*(.
EditState
,*
PSt
*
b
)))
!*(
PSt
*
b
)
->
*(
Maybe
.
c
,*
PSt
*
b
)
|
Editor
b
sendToActiveWindow
editAction
pState
#
(
maybeId
,
pState
)
=
accPIO
getActiveWindow
pState
#
(
maybeId
,
pState
)
=
accPIO
getActiveWindow
pState
|
isNothing
maybeId
=
(
Nothing
,
pState
)
// fail silently
#
windowId
=
fromJust
maybeId
(
editorState
,
pState
)
=
getEditorState
pState
notEdit
=
isNothing
(
findReceiver
windowId
editorState
)
|
not
Edit
#
windowId
=
fromJust
maybeId
(
editorState
,
pState
)
=
getEditorState
pState
#
(
maybeEditId
,
editorState
)
=
findReceiver
windowId
editorState
|
isNothing
maybe
Edit
Id
=
(
Nothing
,
pState
)
=
message
windowId
editAction
pState
...
...
@@ -26,19 +26,15 @@ sendToActiveWindow editAction pState
message
::
!.
Id
!.(*(
EditState
,*
PSt
*
b
)
->
*(.
c
,*(.
EditState
,*
PSt
*
b
)))
!*(
PSt
*
b
)
->
*(
Maybe
.
c
,*
PSt
*
b
)
|
Editor
b
;
message
windowId
monad
pState
#
(
editorState
,
pState
)
=
getEditorState
pState
#
maybeEditId
=
findReceiver
windowId
editorState
#
(
maybeEditId
,
editorState
)
=
findReceiver
windowId
editorState
|
isNothing
maybeEditId
=
(
Nothing
,
setEditorState
editorState
pState
)
#
editId
=
fromJust
maybeEditId
#
(
editState
,
pState
)
=
getEditState
editId
pState
#
(
x
,
(
editState
,
pState
))
=
monad
(
editState
,
pState
)
#
pState
=
setEditState
editId
editState
pState
#
(
x
,
pState
)
=
appEditState
editId
monad
pState
#
pState
=
setEditorState
editorState
pState
=
(
Just
x
,
pState
)
::
EditAction
l
a
:==
EditMonad
(
PSt
l
)
a
// Messages
msgSave
::
EditAction
*
l
nothing
...
...
Ide/EdClient.dcl
View file @
2d67a49a
...
...
@@ -23,15 +23,13 @@ definition module EdClient
import
StdMaybe
,
StdId
,
StdPSt
,
StdPicture
,
StdPrint
from
EdState
import
Editor
,
EditorState
from
EdMessage
import
EditId
from
EdMessage
import
EditId
,
EditAction
from
EdLineText
import
Text
import
EdPosition
from
EdSelection
import
Selection
,
emptySelection
,
lineSelection
from
EdMonad
import
UndoState
,
EditMonad
,
EditState
,
StateM
,
getPathName
import
IdeState
::
EditAction
l
a
:==
EditMonad
(
PSt
l
)
a
isEditWin
::
Id
*(
PSt
*
a
)
->
*(
Bool
,*
PSt
*
a
)
|
Editor
a
// "Remote method invocations". The destination is denoted by a window identifier.
...
...
Ide/EdClient.icl
View file @
2d67a49a
...
...
@@ -33,12 +33,10 @@ import EdText
import
IdeState
,
UtilNewlinesFile
::
EditAction
l
a
:==
EditMonad
(
PSt
l
)
a
isEditWin
::
Id
*(
PSt
*
a
)
->
*(
Bool
,*
PSt
*
a
)
|
Editor
a
isEditWin
windowId
pState
#
(
editorState
,
pState
)
=
getEditorState
pState
#
maybeEditId
=
findReceiver
windowId
editorState
#
(
maybeEditId
,
editorState
)
=
findReceiver
windowId
editorState
#
iseditwin
=
not
(
isNothing
maybeEditId
)
#
pState
=
setEditorState
editorState
pState
=
(
iseditwin
,
pState
)
...
...
@@ -46,25 +44,23 @@ isEditWin windowId pState
message
::
!
Id
!.(
EditAction
*
b
.
c
)
!*(
PSt
*
b
)
->
*(
Maybe
.
c
,*
PSt
*
b
)
|
Editor
b
message
windowId
monad
pState
#
(
editorState
,
pState
)
=
getEditorState
pState
#
maybeEditId
=
findReceiver
windowId
editorState
#
(
maybeEditId
,
editorState
)
=
findReceiver
windowId
editorState
|
isNothing
maybeEditId
=
(
Nothing
,
setEditorState
editorState
pState
)
#
editId
=
fromJust
maybeEditId
#
(
editState
,
pState
)
=
getEditState
editId
pState
#
(
x
,
(
editState
,
pState
))
=
monad
(
editState
,
pState
)
#
pState
=
setEditState
editId
editState
pState
#
(
x
,
pState
)
=
appEditState
editId
monad
pState
#
pState
=
setEditorState
editorState
pState
=
(
Just
x
,
pState
)
sendToActiveWindow
::
.(
EditAction
*
b
.
c
)
!*(
PSt
*
b
)
->
*(
Maybe
.
c
,*
PSt
*
b
)
|
Editor
b
sendToActiveWindow
editAction
pState
#
(
maybeId
,
pState
)
=
accPIO
getActiveWindow
pState
#
(
maybeId
,
pState
)
=
accPIO
getActiveWindow
pState
|
isNothing
maybeId
=
(
Nothing
,
pState
)
// fail silently
#
windowId
=
fromJust
maybeId
(
editorState
,
pState
)
=
getEditorState
pState
notEdit
=
isNothing
(
findReceiver
windowId
editorState
)
|
not
Edit
#
windowId
=
fromJust
maybeId
(
editorState
,
pState
)
=
getEditorState
pState
#
(
maybeEditId
,
editorState
)
=
findReceiver
windowId
editorState
|
isNothing
maybe
Edit
Id
=
(
Nothing
,
pState
)
=
message
windowId
editAction
pState
...
...
Ide/conswin.icl
View file @
2d67a49a
...
...
@@ -118,9 +118,7 @@ maybe_cons_win_message2 message ps
=
(
Nothing
,
ps
)
cons_message
editId
monad
pState
#
(
editState
,
pState
)
=
getEditState
editId
pState
#
(
x
,
(
editState
,
pState
))
=
monad
(
editState
,
pState
)
#!
pState
=
setEditState
editId
editState
pState
#
(
x
,
pState
)
=
appEditState
editId
monad
pState
=
(
Just
x
,
pState
)
//---
...
...
@@ -135,13 +133,14 @@ openConsoleWindow cwi text atts ps
#
(_,
(
editState
,
ps
))
=
setText
text
(
editState
,
ps
)
#
(
fontInfo
,
(
editState
,
ps
))
=
getFontInfo
(
editState
,
ps
)
#
(
viewDomain
,
(
editState
,
ps
))
=
computeViewDomain
(
editState
,
ps
)
#
(
editState
,
editLook
)
=
editWindowLook
editState
#
windowAttrs
=
[
WindowOuterSize
cwi
.
tsiz
,
WindowHMargin
0
0
,
WindowVMargin
0
0
,
WindowId
windowId
,
WindowViewDomain
viewDomain
,
WindowLook
True
(
edit
WindowLook
editState
)
,
WindowLook
True
edit
Look
,
WindowHScroll
(
hScrollFun
fontInfo
)
,
WindowVScroll
(
vScrollFun
fontInfo
)
,
WindowPos
(
Fix
,
OffsetVector
cwi
.
tpos
)
...
...
Ide/typewin.icl
View file @
2d67a49a
...
...
@@ -130,9 +130,7 @@ type_win_message message ps
type_message
::
!
EditId
!.(
EditMonad
*(
PSt
*
b
)
.
c
)
!*(
PSt
*
b
)
->
*(
Maybe
.
c
,*(
PSt
*
b
))
type_message
editId
monad
pState
#
(
editState
,
pState
)
=
getEditState
editId
pState
#
(
x
,
(
editState
,
pState
))
=
monad
(
editState
,
pState
)
#!
pState
=
setEditState
editId
editState
pState
#
(
x
,
pState
)
=
appEditState
editId
monad
pState
=
(
Just
x
,
pState
)
//---
...
...
@@ -147,13 +145,14 @@ openTypeWindow twi text atts ps
#
(_,
(
editState
,
ps
))
=
setText
text
(
editState
,
ps
)
#
(
fontInfo
,
(
editState
,
ps
))
=
getFontInfo
(
editState
,
ps
)
#
(
viewDomain
,
(
editState
,
ps
))
=
computeViewDomain
(
editState
,
ps
)
#
(
editState
,
editLook
)
=
editWindowLook
editState
#
windowAttrs
=
[
WindowOuterSize
twi
.
tsiz
,
WindowHMargin
0
0
,
WindowVMargin
0
0
,
WindowId
windowId
,
WindowViewDomain
viewDomain
,
WindowLook
True
(
edit
WindowLook
editState
)
,
WindowLook
True
edit
Look
,
WindowHScroll
(
hScrollFun
fontInfo
)
,
WindowVScroll
(
vScrollFun
fontInfo
)
,
WindowPos
(
Fix
,
OffsetVector
twi
.
tpos
)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment