Skip to content
GitLab
Menu
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
da333393
Commit
da333393
authored
Feb 03, 2003
by
Diederik van Arkel
Browse files
support type declaration colouring
parent
a1a68e8d
Changes
13
Hide whitespace changes
Inline
Side-by-side
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
)