Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
clean-ide
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
6
Issues
6
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
clean-and-itasks
clean-ide
Commits
da333393
Commit
da333393
authored
Feb 03, 2003
by
Diederik van Arkel
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
support type declaration colouring
parent
a1a68e8d
Changes
13
Hide whitespace changes
Inline
Side-by-side
Showing
13 changed files
with
408 additions
and
132 deletions
+408
-132
Ed/EdLineText.dcl
Ed/EdLineText.dcl
+1
-1
Ed/EdLineText.icl
Ed/EdLineText.icl
+8
-8
Ed/EdMonad.dcl
Ed/EdMonad.dcl
+1
-0
Ed/EdMonad.icl
Ed/EdMonad.icl
+2
-0
Ed/EdTab.icl
Ed/EdTab.icl
+57
-39
Ed/EdText.dcl
Ed/EdText.dcl
+2
-2
Ed/EdText.icl
Ed/EdText.icl
+9
-9
Ed/EdVisualText.icl
Ed/EdVisualText.icl
+8
-2
Ed/syncol.dcl
Ed/syncol.dcl
+11
-3
Ed/syncol.icl
Ed/syncol.icl
+281
-66
Ide/edoptions.icl
Ide/edoptions.icl
+18
-1
Ide/prefix.icl
Ide/prefix.icl
+1
-1
Pm/PmPrefs.icl
Pm/PmPrefs.icl
+9
-0
No files found.
Ed/EdLineText.dcl
View file @
da333393
...
...
@@ -30,7 +30,7 @@ getLineC :: !LineNr !u:Text -> ((!Info,!String), !u:Text)
getLines
::
LineNr
LineNr
Text
->
(
StrictList
String
,
Text
)
//getLinesC :: LineNr LineNr Text -> (StrictList (Int,String), Text)
updateLine
::
!
LineNr
!
String
!.
Text
->
(!
Int
,!.
Text
)
updateLine
::
!
LineNr
!
String
!.
Text
->
(!
Int
,!
Int
,!
.
Text
)
removeLine
::
!
LineNr
!
Text
->
Text
removeLines
::
!
LineNr
!
LineNr
!
Text
->
Text
...
...
Ed/EdLineText.icl
View file @
da333393
...
...
@@ -22,7 +22,7 @@ export TextAnnot Void, SyncInf, ConsInf
*/
::
LineAnnot
:==
Info
dummyLineAnnot
:==
(
0
,
False
)
dummyLineAnnot
:==
(
0
,
False
,
False
)
annotLine
:==
slMap
(\
s
->(
dummyLineAnnot
,
s
))
annotWhole
:==
firstParse
annotPart
:==
quickParse
...
...
@@ -237,7 +237,7 @@ removeLines first last text=:{ nrLines, blocks }
#
(
before
,
after
)
=
slSplitAt
first
lines
#
after
=
slDrop
nrRemoveLines
after
#!
lines
=
slAppend
before
after
#
(_,
lines
)
=
annotPart
(
dec
first
)
(
dec
first
)
lines
#
(_,
_,
lines
)
=
annotPart
(
dec
first
)
(
dec
first
)
lines
=
{
blocks
=
group
BlockSize
lines
,
nrLines
=
nrLines
-
nrRemoveLines
}
insertLines
::
!
LineNr
!(
StrictList
String
)
!
Text
->
Text
...
...
@@ -248,7 +248,7 @@ insertLines lineNr strings text=:{ nrLines, blocks }
#
strings
=
annotLine
strings
#!
after
=
slAppend
strings
after
#!
lines
=
slAppend
before
after
#
(_,
lines
)
=
annotPart
(
dec
lineNr
)
(
lineNr
+
nrInsertLines
)
lines
#
(_,
_,
lines
)
=
annotPart
(
dec
lineNr
)
(
lineNr
+
nrInsertLines
)
lines
=
{
blocks
=
group
BlockSize
lines
,
nrLines
=
nrLines
+
nrInsertLines
}
appendLines
::
!(
StrictList
String
)
!
Text
->
Text
...
...
@@ -257,7 +257,7 @@ appendLines strings text=:{ nrLines, blocks }
#
before
=
textToStringsC
text
#
after
=
annotLine
strings
#!
lines
=
slAppend
before
after
#
(_,
lines
)
=
annotPart
(
dec
nrLines
)
(
nrLines
+
nrAppendLines
)
lines
#
(_,
_,
lines
)
=
annotPart
(
dec
nrLines
)
(
nrLines
+
nrAppendLines
)
lines
=
{
blocks
=
group
BlockSize
lines
,
nrLines
=
nrLines
+
nrAppendLines
}
appendLines`
::
!(
StrictList
String
)
!
Text
->
Text
...
...
@@ -272,16 +272,16 @@ appendLines` strings text=:{ nrLines, blocks }
#
update
=
case
slHead
update
of
(
pl
,
st
)
->
(
pl
,
st
+++.
string
)
#!
lines
=
slAppend
before
(
SCons
update
after
)
#
(_,
lines
)
=
annotPart
(
dec
nrLines
)
(
nrLines
+
nrAppendLines
)
lines
#
(_,
_,
lines
)
=
annotPart
(
dec
nrLines
)
(
nrLines
+
nrAppendLines
)
lines
=
{
blocks
=
group
BlockSize
lines
,
nrLines
=
nrLines
+
nrAppendLines
}
updateLine
::
!
LineNr
!
String
!.
Text
->
(!
Int
,!.
Text
)
updateLine
::
!
LineNr
!
String
!.
Text
->
(!
Int
,!
Int
,!
.
Text
)
updateLine
lineNr
string
text
=:{
nrLines
,
blocks
}
#
lines
=
textToStringsC
text
#
(
before
,
after
)
=
slSplitAt
lineNr
lines
#
(
pl
,_)
=
slHead
after
#
after
=
SCons
(
pl
,
string
)
(
slTail
after
)
#!
lines
=
slAppend
before
after
#
(
fin
,
lines
)
=
annotPart
lineNr
lineNr
lines
=
(
fin
,{
blocks
=
group
BlockSize
lines
,
nrLines
=
nrLines
})
#
(
st
,
fin
,
lines
)
=
annotPart
lineNr
lineNr
lines
=
(
st
,
fin
,{
blocks
=
group
BlockSize
lines
,
nrLines
=
nrLines
})
Ed/EdMonad.dcl
View file @
da333393
...
...
@@ -54,6 +54,7 @@ from EdSelection import :: Selection, :: Position, :: ColumnNr, :: LineNr
,
charColour
::
!
Colour
,
keywordColour
::
!
Colour
,
typedefColour
::
!
Colour
,
typedeclColour
::
!
Colour
}
DefaultSyntaxColours
::
SyntaxColours
...
...
Ed/EdMonad.icl
View file @
da333393
...
...
@@ -88,6 +88,7 @@ import EdAction
,
charColour
::
!
Colour
,
keywordColour
::
!
Colour
,
typedefColour
::
!
Colour
,
typedeclColour
::
!
Colour
}
instance
toString
ActionInfo
...
...
@@ -412,6 +413,7 @@ DefaultSyntaxColours =
,
charColour
=
Magenta
,
keywordColour
=
Grey
,
typedefColour
=
Black
,
typedeclColour
=
Black
}
//--
...
...
Ed/EdTab.icl
View file @
da333393
...
...
@@ -87,52 +87,55 @@ where
|
S
// in string constant...
|
C
// in char constant...
|
T
Int
// in typedef
|
D
Int
// in typedecl
import
ospicture
// for optimized drawfuns...
optDrawS
:==
pictdrawstring
// use non-optimised versions
optDrawC
:==
pictdrawchar
// "
tabDrawStringC
::
!
Point2
!(!
Info
,!
String
)
!
FontInfo
!*
Picture
->
*
Picture
tabDrawStringC
point
((
clevel
,
typedef
),
string
)
{
tabSize
,
charWidth
,
thefont
,
showTabs
,
syntaxColours
={
textColour
,
backgroundColour
,
tabColour
,
commentColour
,
stringColour
,
charColour
,
keywordColour
,
typedefColour
}}
tabDrawStringC
point
((
clevel
,
typedef
,
typedecl
),
string
)
{
tabSize
,
charWidth
,
thefont
,
showTabs
,
syntaxColours
={
textColour
,
backgroundColour
,
tabColour
,
commentColour
,
stringColour
,
charColour
,
keywordColour
,
typedefColour
,
typedeclColour
}}
picture
#!
strings
=
splitAtTabs
string
|
typedef
=
tabDrawString`
True
(
T
clevel
)
point
strings
picture
=
tabDrawString`
True
(
N
clevel
)
point
strings
picture
=
tabDrawString`
/*True*/
(
T
clevel
)
point
strings
picture
|
typedecl
=
tabDrawString`
(
D
clevel
)
point
strings
picture
=
tabDrawString`
/*True*/
(
N
clevel
)
point
strings
picture
where
tabDrawString`
::
!
Bool
!
CommentLevel
!
Point2
!.[
String
]
!*
Picture
->
*
Picture
tabDrawString`
::
/*!Bool*/
!
CommentLevel
!
Point2
!.[
String
]
!*
Picture
->
*
Picture
// hmm, need to get if column 0 into local funs...
tabDrawString`
_
_
_
[]
picture
tabDrawString`
/*_*/
_
_
[]
picture
// #! (_,picture) = optGetPenPos picture
=
picture
tabDrawString`
ini
clevel
point
[
string
:
[]]
picture
tabDrawString`
/*ini*/
clevel
point
[
string
:
[]]
picture
// #! (_,picture) = optGetPenPos picture
#!
picture
=
setPenPos
point
picture
#!
(_,
picture
)
=
drawC
ini
clevel
string
picture
#!
(_,
picture
)
=
drawC
/*ini*/
clevel
string
picture
// #! (_,picture) = optGetPenPos picture
=
picture
tabDrawString`
ini
clevel
point
[
string
:
strings
]
picture
tabDrawString`
/*ini*/
clevel
point
[
string
:
strings
]
picture
// #! (_,picture) = optGetPenPos picture
#!
picture
=
setPenPos
point
picture
#!
(
clevel
,
picture
)
=
drawC
ini
clevel
string
picture
#!
(
clevel
,
picture
)
=
drawC
/*ini*/
clevel
string
picture
// #! (newPoint,picture) = optGetPenPos picture
#!
(
newPoint
,
picture
)
=
getPenPos
picture
#!
newX
=
alignAtTab`
newPoint
.
x
tabSize
charWidth
|
not
showTabs
=
tabDrawString`
False
clevel
{
point
&
x
=
newX
}
strings
picture
=
tabDrawString`
/*False*/
clevel
{
point
&
x
=
newX
}
strings
picture
#!
picture
=
setPenColour
tabColour
picture
#!
picture
=
optDrawC
'~'
picture
#!
picture
=
setPenColour
textColour
picture
=
tabDrawString`
False
clevel
{
point
&
x
=
newX
}
strings
picture
=
tabDrawString`
/*False*/
clevel
{
point
&
x
=
newX
}
strings
picture
drawC
::
!
Bool
!
CommentLevel
!.
String
!*
Picture
->
(!
CommentLevel
,!*
Picture
)
drawC
ini
c
s
pic
drawC
::
/*!Bool*/
!
CommentLevel
!.
String
!*
Picture
->
(!
CommentLevel
,!*
Picture
)
drawC
/*ini*/
c
s
pic
=
drawC
c
pic
where
drawC
::
!
CommentLevel
!*
Picture
->
(!
CommentLevel
,!*
Picture
)
...
...
@@ -148,10 +151,13 @@ where
=
(
L
,
pic
)
drawC
(
N
cl
)
pic
// normal
#
pic
=
(
if
(
cl
==
0
)
(
setPenColour
textColour
)
(
setPenColour
commentColour
))
pic
=
dL
ini
(
N
cl
)
0
pic
=
dL
/*ini*/
(
N
cl
)
0
pic
drawC
(
T
cl
)
pic
#
pic
=
(
if
(
cl
==
0
)
(
setPenColour
typedefColour
)
(
setPenColour
commentColour
))
pic
=
dL
ini
(
T
cl
)
0
pic
=
dL
/*ini*/
(
T
cl
)
0
pic
drawC
(
D
cl
)
pic
#
pic
=
(
if
(
cl
==
0
)
(
setPenColour
typedeclColour
)
(
setPenColour
commentColour
))
pic
=
dL
(
D
cl
)
0
pic
l
=
size
s
funnyChar
i
=
isStringMember
s
.[
i
]
(
dec
funnySize
)
funnyChars
...
...
@@ -165,10 +171,11 @@ where
funnyChars
=:
"~@#$%^?!+-*<>
\\
/|&=:."
funnySize
=
20
dL
::
!
Bool
!
CommentLevel
!.
Int
!*
Picture
->
(!
CommentLevel
,!*
Picture
)
dL
ini
cl
i
pic
dL
::
/*!Bool*/
!
CommentLevel
!.
Int
!*
Picture
->
(!
CommentLevel
,!*
Picture
)
dL
/*ini*/
cl
i
pic
|
i
>=
l
=
(
cl
,
pic
)
/*
| ini && s.[i] == ':' && not (in_comment cl)
# i` = inc i
| i` >= l
...
...
@@ -201,11 +208,11 @@ where
# (cl,pic) = normalise ini i cl pic
# pic = optDrawC ':' pic
= dL False (N 0) i` pic
*/
|
s
.[
i
]
==
'*'
#
i`
=
inc
i
|
i`
>=
l
#
(
cl
,
pic
)
=
normalise
ini
i
cl
pic
//
# (cl,pic) = normalise ini i cl pic
#
pic
=
optDrawC
'*'
pic
=
(
cl
,
pic
)
|
s
.[
i`
]
==
'/'
...
...
@@ -216,31 +223,31 @@ where
#
cl
=
dec_comment
cl
|
not
(
in_comment
cl
)
//cl == 0
#
pic
=
setPenColour
(
non_comment_colour
cl
)
/*textColour*/
pic
=
dL
False
cl
i``
pic
=
dL
False
cl
i``
pic
=
dL
/*False*/
cl
i``
pic
=
dL
/*False*/
cl
i``
pic
|
i``
<
l
&&
funnyChar
i``
// eat till end of funnyid substring...
#
j
=
scanfunny
i``
#
r
=
s
%(
i``
,
dec
j
)
#
(
cl
,
pic
)
=
normalise
ini
i
cl
pic
//
# (cl,pic) = normalise ini i cl pic
#
pic
=
optDrawS
"*/"
pic
#
pic
=
optDrawS
r
pic
=
dL
False
cl
j
pic
=
dL
/*False*/
cl
j
pic
#
pic
=
setPenColour
commentColour
pic
// idiot proof for trickery at start of text...
#
pic
=
optDrawS
"*/"
pic
#
cl
=
dec_comment
cl
|
not
(
in_comment
cl
)
//cl == 0
#
pic
=
setPenColour
(
non_comment_colour
cl
)
/*textColour*/
pic
=
dL
False
cl
i``
pic
=
dL
False
cl
i``
pic
#
(
cl
,
pic
)
=
normalise
ini
i
cl
pic
=
dL
/*False*/
cl
i``
pic
=
dL
/*False*/
cl
i``
pic
//
# (cl,pic) = normalise ini i cl pic
#
pic
=
optDrawC
'*'
pic
=
dL
False
cl
i`
pic
=
dL
/*False*/
cl
i`
pic
|
s
.[
i
]
==
'/'
#
i`
=
inc
i
|
i`
>=
l
#
(
cl
,
pic
)
=
normalise
ini
i
cl
pic
//
# (cl,pic) = normalise ini i cl pic
#
pic
=
optDrawC
'/'
pic
=
(
cl
,
pic
)
|
s
.[
i`
]
==
'/'
...
...
@@ -253,10 +260,10 @@ where
#
pic
=
setPenColour
commentColour
pic
#
pic
=
optDrawS
"/*"
pic
#
cl
=
inc_comment
cl
=
dL
False
cl
(
inc
i`
)
pic
#
(
cl
,
pic
)
=
normalise
ini
i
cl
pic
=
dL
/*False*/
cl
(
inc
i`
)
pic
//
# (cl,pic) = normalise ini i cl pic
#
pic
=
optDrawC
'/'
pic
=
dL
False
cl
i`
pic
=
dL
/*False*/
cl
i`
pic
|
(
s
.[
i
]
==
'"'
)
&&
(
not
(
in_comment
cl
))
//(cl == 0)
#
pic
=
setPenColour
stringColour
pic
#
pic
=
optDrawC
'"'
pic
...
...
@@ -265,18 +272,23 @@ where
#
pic
=
setPenColour
charColour
pic
#
pic
=
optDrawC
'\''
pic
=
dC
(
inc
i
)
pic
|
/*(cl == 0)*/
(
not
(
in_comment
cl
))
&&
(
funnyChar
i
)
#
j
=
scanfunny
i
#
r
=
s
%(
i
,
dec
j
)
/*
# (cl,pic) = case r of
"|" -> (cl,pic)
"=" -> (cl,pic)
_ -> normalise ini i cl pic
*/
#
pic
=
optDrawS
r
pic
=
dL
False
cl
j
pic
=
dL
/*False*/
cl
j
pic
/*
# (cl,pic) = case WhiteSpace s.[i] of
True -> (cl,pic)
_ -> normalise ini i cl pic
*/
#
(
key
,
j
)
=
scankeyword
s
i
|
key
&&
(
not
(
in_comment
cl
))
//cl == 0
#
r
=
s
%(
i
,
dec
j
)
...
...
@@ -284,11 +296,12 @@ where
#
pic
=
setPenColour
keywordColour
pic
#
pic
=
optDrawS
r
pic
#
pic
=
setPenColour
c
pic
=
dL
False
cl
j
pic
=
dL
/*False*/
cl
j
pic
#
r
=
s
%(
i
,
dec
j
)
#
pic
=
optDrawS
r
pic
=
dL
False
cl
j
pic
=
dL
/*False*/
cl
j
pic
where
/*
normalise True 0 (T 0) pic
# pic = setPenColour textColour pic
= (N 0,pic)
...
...
@@ -297,23 +310,28 @@ where
in_typedef cl = case cl of
T l -> l == 0
_ -> False
*/
in_comment
cl
=
case
cl
of
N
l
->
l
<>
0
T
l
->
l
<>
0
D
l
->
l
<>
0
_
->
False
dec_comment
cl
=
case
cl
of
N
l
->
N
(
dec
l
)
T
l
->
T
(
dec
l
)
D
l
->
D
(
dec
l
)
inc_comment
cl
=
case
cl
of
N
l
->
N
(
inc
l
)
T
l
->
T
(
inc
l
)
D
l
->
D
(
inc
l
)
non_comment_colour
cl
=
case
cl
of
N
_
->
textColour
T
_
->
typedefColour
D
_
->
typedeclColour
scankeyword
::
!.
String
!
Int
->
(!
Bool
,!
Int
)
scankeyword
s
i
#
c
=
s
.[
i
]
|
not
(
isAlpha
c
)
|
not
(
isAlpha
c
||
(
c
==
'_'
)
)
#
j
=
inc
i
=
(
False
,
j
)
#
j
=
scanalpha
(
inc
i
)
...
...
@@ -396,7 +414,7 @@ where
|
s
.[
i
]
==
'"'
#
pic
=
optDrawC
'"'
pic
#
pic
=
setPenColour
textColour
pic
=
dL
False
(
N
0
)
(
inc
i
)
pic
=
dL
/*False*/
(
N
0
)
(
inc
i
)
pic
|
s
.[
i
]
==
'\\'
#
pic
=
optDrawC
'\\'
pic
#
i
=
inc
i
...
...
@@ -413,7 +431,7 @@ where
|
s
.[
i
]
==
'\''
#
pic
=
optDrawC
'\''
pic
#
pic
=
setPenColour
textColour
pic
=
dL
False
(
N
0
)
(
inc
i
)
pic
=
dL
/*False*/
(
N
0
)
(
inc
i
)
pic
|
s
.[
i
]
==
'\\'
#
pic
=
optDrawC
'\\'
pic
#
i
=
inc
i
...
...
Ed/EdText.dcl
View file @
da333393
...
...
@@ -7,8 +7,8 @@ from EdSelection import :: Selection, :: Position, :: ColumnNr, :: LineNr
import
EdLineText
getTextFragment
::
!
Selection
!
Text
->
(!
TextFragment
,
!
Text
)
removeText
::
!
Selection
!
Text
->
(
Maybe
Int
,
Text
)
insertText
::
!
Position
!
TextFragment
!
Text
->
(
Maybe
Int
,
Text
)
removeText
::
!
Selection
!
Text
->
(
Maybe
(
Int
,
Int
),
Text
)
insertText
::
!
Position
!
TextFragment
!
Text
->
(
Maybe
(
Int
,
Int
),
Text
)
replaceText
::
!
Selection
!
TextFragment
!
Text
->
Text
appendText
::
!
TextFragment
!
Text
->
Text
...
...
Ed/EdText.icl
View file @
da333393
...
...
@@ -29,25 +29,25 @@ where
chopLastLine
(
SCons
aLine
lines
)
=
SCons
aLine
(
chopLastLine
lines
)
removeText
::
!
Selection
!
Text
->
(
Maybe
Int
,
Text
)
removeText
::
!
Selection
!
Text
->
(
Maybe
(
Int
,
Int
)
,
Text
)
removeText
{
start
={
col
=
col1
,
row
=
row1
},
end
={
col
=
col2
,
row
=
row2
}}
text
#
(
firstLine
,
text
)
=
getLine
row1
text
// selection within one line?
|
row1
==
row2
#
(
fin
,
text
)
=
updateLine
row1
#
(
st
,
fin
,
text
)
=
updateLine
row1
(
firstLine
%
(
0
,
col1
-
1
)
+++
firstLine
%
(
col2
,
size
firstLine
-
1
)
)
text
=
(
Just
fin
,
text
)
=
(
Just
(
st
,
fin
)
,
text
)
// selection contains more than one line
#
(
lastLine
,
text
)
=
getLine
row2
text
#
newLine
=
firstLine
%
(
0
,
col1
-
1
)
+++
lastLine
%
(
col2
,
size
lastLine
-
1
)
#
(_,
text
)
=
updateLine
row1
newLine
text
#
(_,
_,
text
)
=
updateLine
row1
newLine
text
#
text
=
removeLines
(
row1
+
1
)
row2
text
=
(
Nothing
,
text
)
insertText
::
!
Position
!
TextFragment
!
Text
->
(
Maybe
Int
,
Text
)
insertText
::
!
Position
!
TextFragment
!
Text
->
(
Maybe
(
Int
,
Int
)
,
Text
)
insertText
{
col
,
row
}
strings
text
#
(
line
,
text
)
=
getLine
row
text
left
=
line
%
(
0
,
col
-
1
)
...
...
@@ -58,8 +58,8 @@ insertText { col, row } strings text
// insertion in a single line
|
nrOfStrings
==
1
#
newLine
=
left
+++
slHead
strings
+++
right
#
(
fin
,
text
)
=
updateLine
row
newLine
text
=
(
Just
fin
,
text
)
#
(
st
,
fin
,
text
)
=
updateLine
row
newLine
text
=
(
Just
(
st
,
fin
)
,
text
)
// insertion of more than one line
#
fragment
=
SCons
...
...
@@ -86,12 +86,12 @@ replaceText sel=:{start={col=col1,row=row1},end={col=col2,row=row2}} strings tex
// no strings at all
|
nrOfStrings
==
0
#
newLine
=
left
+++
right
#
(_,
text
)
=
updateLine
row1
newLine
text
#
(_,
_,
text
)
=
updateLine
row1
newLine
text
=
text
// insertion in a single line
|
nrOfStrings
==
1
#
newLine
=
left
+++
slHead
strings
+++
right
#
(_,
text
)
=
updateLine
row1
newLine
text
#
(_,
_,
text
)
=
updateLine
row1
newLine
text
=
text
// insertion of more than one line
#
fragment
=
SCons
...
...
Ed/EdVisualText.icl
View file @
da333393
...
...
@@ -77,7 +77,11 @@ vInsertText position textFragment =
THEN
vResetViewDomain
ELSE
(
vTextUpdate
position
(
fromJust
fin
-
position
.
row
+
1
))
// (vTextUpdate position (fromJust fin - position.row + 1))
let
(
beg
,
end
)
=
fromJust
fin
in
(
vTextUpdate
{
col
=
0
,
row
=
beg
}
(
end
-
beg
+
1
))
vAppendLines
::
TextFragment
->
EditMonad
(
PSt
.
l
)
nothing
vAppendLines
textFragment
=
...
...
@@ -138,7 +142,9 @@ vRemoveText selection=:{ start=start=:{ col=col1,row=row1 }
THEN
vResetViewDomain
ELSE
(
vTextUpdate
start
(
fromJust
fin
-
row1
+
1
))
// (vTextUpdate start (fromJust fin - row1 + 1))
let
(
beg
,
end
)
=
fromJust
fin
in
(
vTextUpdate
{
col
=
0
,
row
=
beg
}
(
end
-
beg
+
1
))
//--
...
...
Ed/syncol.dcl
View file @
da333393
...
...
@@ -5,7 +5,15 @@ definition module syncol
import
StdString
import
StrictList
::
Info
:==
(!
Int
,!
Bool
)
::
Info
:==
(!
Int
// comment nesting level at start of line
// ,!Bool // in typedef at start of line
,!
Bool
// is typedef line
// ,!Bool // in typedecl at start of line
// ,!Int // typedecl offside level
,!
Bool
// is typedecl line
)
// pack bools into bitfield?
firstParse
::
!(
StrictList
String
)
->
StrictList
(
Info
,
String
)
quickParse
::
!
Int
!
Int
!(
StrictList
(
Info
,
String
))
->
(
Int
,
StrictList
(
Info
,
String
))
firstParse
::
!(
StrictList
String
)
->
StrictList
(
!
Info
,!
String
)
quickParse
::
!
Int
!
Int
!(
StrictList
(
!
Info
,!
String
))
->
(
Int
,
Int
,
StrictList
(!
Info
,!
String
))
Ed/syncol.icl
View file @
da333393
...
...
@@ -4,17 +4,87 @@ implementation module syncol
import
StdArray
,
StdClass
,
StdBool
,
StdList
,
StdFunc
,
StdString
import
StrictList
/*
:: Private =
{ num :: !Int
, icl_only :: !Bool
}
Start
// = scanFirst 0 0 0 line1 // (index,indent,level)
# s0 = (0,False,False,0)
# s1 = parseLine s0 line1
# s2 = parseLine s1 line2
# s3 = parseLine s2 line3
# s4 = parseLine s3 line4
# s5 = parseLine s4 line5
= (s0,s1,s2,s3,s4,s5)
where
line1 = ":: State = "
line2 = " {num::Int}"
line3 = "fun :: frups"
line4 = " -> fraps"
line5 = "global :== something"
*/
/*
parseLine: initial comment nesting level & textline -> new comment nesting level
*/
parseLine
::
!.
Info
!.
String
->
Info
parseLine
comment_level
line
=
pL
comment_level
0
::
State
:==
(
!
Int
// comment nesting level at start of line
,
!
Bool
// in typedef at start of line
,
!
Bool
// in typedecl at start of line
,
!
Int
// typedecl offside level
)
::
Info`
:==
(!
Int
// comment nesting level at start of line
,!
Bool
// is typedef line
// ,!Int // typedecl offside level
,!
Bool
// is typedecl line
)
scanFirst
::
!
Int
!
Int
!
Int
!.
String
->
(!
Int
,!
Int
,!
Int
)
scanFirst
level
index
indent
line
|
index
>=
line_size
=
(
index
,
indent
,
level
)
#
char
=
line
.[
index
]
|
char
==
' '
=
scanFirst
level
(
inc
index
)
(
inc
indent
)
line
|
char
==
'\t'
=
scanFirst
level
(
inc
index
)
((
inc
(
indent
>>
2
))
<<
2
)
line
|
char
==
'\n'
=
scanFirst
level
(
inc
index
)
indent
line
|
char
==
'\r'
=
scanFirst
level
(
inc
index
)
indent
line
|
char
==
'\f'
=
scanFirst
level
(
inc
index
)
indent
line
|
char
==
'*'
#
index`
=
inc
index
indent`
=
inc
indent
|
index`
>=
line_size
=
(
index
,
indent
,
level
)
|
line
.[
index`
]
==
'/'
#
index``
=
inc
index`
indent``
=
inc
indent`
|
level
<>
0
=
scanFirst
(
dec
level
)
index``
indent``
line
// try to fix problem below
|
index``
>=
line_size
=
(
index``
,
-1
,
dec
level
)
|
funnyChar
line
.[
index``
]
=
(
index
,
indent
,
level
)
// hmmm excludes */*/ and *//*...*/
=
scanFirst
(
dec
level
)
index``
indent``
line
|
level
==
0
=
(
index
,
indent
,
level
)
=
scanFirst
level
index`
indent`
line
|
char
==
'/'
#
index`
=
inc
index
indent`
=
inc
indent
|
index`
>=
line_size
=
(
index
,
indent
,
level
)
#
char`
=
line
.[
index`
]
|
char`
==
'/'
=
(
index
,
-1
,
level
)
// shouldn't we exclude funnyId's ??
|
char`
==
'*'
=
scanFirst
(
inc
level
)
(
inc
index`
)
(
inc
indent`
)
line
|
level
==
0
=
(
index
,
indent
,
level
)
=
scanFirst
level
index`
indent`
line
|
level
<>
0
=
scanFirst
level
(
inc
index
)
(
inc
indent
)
line
=
(
index
,
indent
,
level
)
where
funnyChar
c
=
isStringMember
c
(
dec
funnySize
)
funnyChars
line_size
=
size
line
funnyChar
c
=
isStringMember
c
(
dec
funnySize
)
funnyChars
where
isStringMember
::
!
Char
!
Int
!
String
->
Bool
isStringMember
x
i
s
|
i
<
0
=
False
...
...
@@ -25,64 +95,88 @@ where
funnyChars
=:
"~@#$%^?!+-*<>
\\
/|&=:."
funnySize
=
20
// =: size funnyChars?
scanfunny
::
!
Int
!
Int
!
String
->
Int
scanfunny
i
line_size
line
|
i
>=
line_size
=
line_size
|
funnyChar
line
.[
i
]
=
scanfunny
(
inc
i
)
line_size
line
=
i
//:: String State -> ((Info,String),State)
parseLine
::
!.
State
!.
String
->
(!
Bool
,!
State
)
parseLine
state
=:(
level
,
typedef
,
typedecl
,
offside
)
line
#
(
index
,
indent
,
level
)
=
scanFirst
level
0
0
line
#
(
typedecl
,
offside
)
=
if
typedecl
(
if
(
index
<
line_size
&&
indent
<=
offside
)
(
False
,
indent
)
(
True
,
offside
)
)
(
False
,
indent
)
#
state
=
(
level
,
typedef
,
typedecl
,
offside
)
#
has_content
=
index
<
line_size
#
not_double_colon
=
line
%(
index
,
dec
(
scanfunny
index
line_size
line
))
<>
"::"
=
(
has_content
&&
if
(
index
>
0
)
not_double_colon
True
,
pL
state
index
)
where
line_size
=
size
line
pL
::
!
Info
!
Int
->
Info
pL
(
level
,
typedef
)
i
// parse normal text
|
i
>=
line_size
=
(
level
,
typedef
)
pL
::
!
State
!
Int
->
State
pL
(
level
,
typedef
,
typedecl
,
offside
)
i
// parse normal text
|
i
>=
line_size
=
(
level
,
typedef
,
typedecl
,
offside
)
#!
char
=
line
.[
i
]
|
char
==
'*'
#
i
=
inc
i
|
i
>=
line_size
=
(
level
,
typedef
)
|
i
>=
line_size
=
(
level
,
typedef
,
typedecl
,
offside
)
|
line
.[
i
]
==
'/'
#!
i
=
inc
i
|
level
<>
0
=
pL
(
dec
level
,
typedef
)
i
// try to fix problem below
|
level
<>
0
=
pL
(
dec
level
,
typedef
,
typedecl
,
offside
)
i
// try to fix problem below
|
i
<
line_size
&&
funnyChar
line
.[
i
]
=
scanFunny
(
level
,
typedef
)
i
// hmmm excludes */*/ and *//*...*/
=
pL
(
dec
level
,
typedef
)
i
=
pL
(
level
,
typedef
)
i
=
scanFunny
(
level
,
typedef
,
typedecl
,
offside
)
i
i
// hmmm excludes */*/ and *//*...*/
=
pL