better untermedStrings
This commit is contained in:
parent
d3361ad93c
commit
20f968dba5
2 changed files with 32 additions and 13 deletions
|
@ -49,10 +49,12 @@ fontMap = [ (attrName "assignment" , fg Vty.blue)
|
||||||
-- return a [Fontification] list
|
-- return a [Fontification] list
|
||||||
fontify :: String -> [Fontification]
|
fontify :: String -> [Fontification]
|
||||||
fontify = concatApply [ assignments, returns
|
fontify = concatApply [ assignments, returns
|
||||||
, untermStrings, strings
|
, strings
|
||||||
, guards, comments
|
, guards, comments
|
||||||
, mismatchedBrackets]
|
, mismatchedBrackets
|
||||||
|
, untermStrings]
|
||||||
|
|
||||||
|
-- TODO: CLEAN UP ALL THAT LENGHTY COMMENTS
|
||||||
|
|
||||||
-- applies the functions in order
|
-- applies the functions in order
|
||||||
-- the fontification of the last function overrules
|
-- the fontification of the last function overrules
|
||||||
|
@ -96,9 +98,6 @@ returns = matchAttrAll "return" "\\^.+;"
|
||||||
strings :: String -> [Fontification]
|
strings :: String -> [Fontification]
|
||||||
strings = matchAttrAll "string" "\".*\""
|
strings = matchAttrAll "string" "\".*\""
|
||||||
|
|
||||||
untermStrings :: String -> [Fontification]
|
|
||||||
untermStrings = matchAttrAll "err_string" "\".*\"[^\\;]" -- string is unterm if it isn't inside a guard (starts with '[') and isn't terminated by ';'
|
|
||||||
|
|
||||||
comments :: String -> [Fontification]
|
comments :: String -> [Fontification]
|
||||||
comments = matchAttrAll "comment" "%.*"
|
comments = matchAttrAll "comment" "%.*"
|
||||||
|
|
||||||
|
@ -110,13 +109,13 @@ matchAttrAll attribute regexString bs =
|
||||||
-- Converts contents of a MatchArray (result of a regex matching)
|
-- Converts contents of a MatchArray (result of a regex matching)
|
||||||
-- to a fontification with the given attribute
|
-- to a fontification with the given attribute
|
||||||
matchToFT :: AttrName -> [Tdfa.MatchArray] -> [Fontification]
|
matchToFT :: AttrName -> [Tdfa.MatchArray] -> [Fontification]
|
||||||
matchToFT attrName matchArray = matchToFT' matchArray
|
matchToFT attrName matchArray = map sliceToFT (matchesToSlices matchArray)
|
||||||
where matchToFT' [] = []
|
where sliceToFT (start,end) = FT start end attrName
|
||||||
matchToFT' (m:ms) =
|
|
||||||
let match = m ! 0 -- get 1st elem of match array (this is the whole match, which we want)
|
matchesToSlices :: [Tdfa.MatchArray] -> [(Int,Int)]
|
||||||
start = fst match
|
matchesToSlices [] = []
|
||||||
end = (fst match) + (snd match)
|
matchesToSlices (m:ms) = let match = m ! 0 -- get 1st elem of match array (this is the whole match, which we want)
|
||||||
in (FT start end attrName) : matchToFT' ms
|
in (fst match, (fst match) + (snd match)): matchesToSlices ms
|
||||||
|
|
||||||
-- TODO per se regexes are too weak to find matching
|
-- TODO per se regexes are too weak to find matching
|
||||||
-- things. We could use a regex lib that supports
|
-- things. We could use a regex lib that supports
|
||||||
|
@ -159,6 +158,22 @@ mismatched attrName s (open, close) = slicesToFT attrName $ (fst orphans)++(snd
|
||||||
| otherwise = mismatched' restStr (ix+1) ophs
|
| otherwise = mismatched' restStr (ix+1) ophs
|
||||||
|
|
||||||
|
|
||||||
|
untermStrings :: String -> [Fontification]
|
||||||
|
untermStrings s = slicesToFT (attrName "err_string") $ lastChar untermSlices
|
||||||
|
where commentsFts = comments s
|
||||||
|
regex = Tdfa.makeRegex ("\".*\"[^\\;]"::String) :: Tdfa.Regex
|
||||||
|
untermSlices = prune $ matchesToSlices $ Tdfa.matchAll regex s
|
||||||
|
prune [] = []
|
||||||
|
prune (unterm: unterms)
|
||||||
|
| isFontified unterm commentsFts = prune unterms
|
||||||
|
| otherwise = unterm: prune unterms
|
||||||
|
-- gets the slice containing the char after an untermed string (can be
|
||||||
|
-- special like newline too)
|
||||||
|
lastChar [] = []
|
||||||
|
lastChar (unterm:unterms) = let end = snd unterm
|
||||||
|
in (end-1, end): lastChar unterms
|
||||||
|
|
||||||
|
|
||||||
slicesToFT :: AttrName -> [(Int,Int)] -> [Fontification]
|
slicesToFT :: AttrName -> [(Int,Int)] -> [Fontification]
|
||||||
slicesToFT attrName slices = slicesToFT' slices
|
slicesToFT attrName slices = slicesToFT' slices
|
||||||
where slicesToFT' [] = []
|
where slicesToFT' [] = []
|
||||||
|
|
|
@ -169,9 +169,13 @@ fontifyToMarkup' markup (f:ff) = fontifyToMarkup' (markupSet slice attribute mar
|
||||||
-- TODO had to name this function drawHeditText to test
|
-- TODO had to name this function drawHeditText to test
|
||||||
-- out the fontifier w/o deleting the old thing,
|
-- out the fontifier w/o deleting the old thing,
|
||||||
-- think it won't be needed -> delete?
|
-- think it won't be needed -> delete?
|
||||||
|
{-
|
||||||
drawContent :: [String] -> Widget n
|
drawContent :: [String] -> Widget n
|
||||||
drawContent = markup . (createMarkup []) . unlines
|
drawContent = markup . (createMarkup []) . unlines
|
||||||
|
-}
|
||||||
|
|
||||||
-- TODO is this needed/used somewhere? i don't see it -> delete?
|
-- TODO is this needed/used somewhere? i don't see it -> delete?
|
||||||
|
{-
|
||||||
appCursor :: HeditState -> [CursorLocation Names] -> Maybe (CursorLocation Names)
|
appCursor :: HeditState -> [CursorLocation Names] -> Maybe (CursorLocation Names)
|
||||||
appCursor st c = Just (head c)
|
appCursor st c = Just (head c)
|
||||||
|
-}
|
||||||
|
|
Loading…
Reference in a new issue