better untermedStrings

This commit is contained in:
Armin Friedl 2016-08-12 07:58:56 +02:00
parent d3361ad93c
commit 20f968dba5
2 changed files with 32 additions and 13 deletions

View file

@ -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' [] = []

View file

@ -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)
-}