Commit da333393 authored by Diederik van Arkel's avatar Diederik van Arkel

support type declaration colouring

parent a1a68e8d
......@@ -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
......
......@@ -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})
......@@ -54,6 +54,7 @@ from EdSelection import :: Selection, :: Position, :: ColumnNr, :: LineNr
, charColour :: !Colour
, keywordColour :: !Colour
, typedefColour :: !Colour
, typedeclColour :: !Colour
}
DefaultSyntaxColours :: SyntaxColours
......
......@@ -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
}
//--
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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))
//--
......
......@@ -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))
......@@ -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</