git.iko.soy/Idris-dev
on master help sign in
Merge pull request #496 from david-christiansen/color-repl
ce9b19bEdwin Brady
src/Idris/Colours.hs+8−6
compare with master
unifiedsplit
@@ -13,11 +13,12 @@ data IdrisColour = IdrisColour { colour :: Color
13 , vivid :: Bool
13 , vivid :: Bool
14 , underline :: Bool
14 , underline :: Bool
15 , bold :: Bool
15 , bold :: Bool
16+ , italic :: Bool
16 }
17 }
17 deriving (Eq, Show)
18 deriving (Eq, Show)
18
19
19mkColour :: Color -> IdrisColour
20mkColour :: Color -> IdrisColour
20−mkColour c = IdrisColour c True False False
21+mkColour c = IdrisColour c True False False False
21
22
22data ColourTheme = ColourTheme { keywordColour :: IdrisColour
23data ColourTheme = ColourTheme { keywordColour :: IdrisColour
23 , boundVarColour :: IdrisColour
24 , boundVarColour :: IdrisColour
@@ -30,21 +31,22 @@ data ColourTheme = ColourTheme { keywordColour :: IdrisColour
30 deriving (Eq, Show)
31 deriving (Eq, Show)
31
32
32defaultTheme :: ColourTheme
33defaultTheme :: ColourTheme
33−defaultTheme = ColourTheme { keywordColour = IdrisColour Black True True True
34+defaultTheme = ColourTheme { keywordColour = IdrisColour Black True True True False
34 , boundVarColour = mkColour Magenta
35 , boundVarColour = mkColour Magenta
35− , implicitColour = IdrisColour Magenta True True False
36+ , implicitColour = IdrisColour Magenta True True False False
36 , functionColour = mkColour Green
37 , functionColour = mkColour Green
37 , typeColour = mkColour Blue
38 , typeColour = mkColour Blue
38 , dataColour = mkColour Red
39 , dataColour = mkColour Red
39− , promptColour = IdrisColour Black True False True
40+ , promptColour = IdrisColour Black True False True False
40 }
41 }
41
42
42-- Set the colour of a string using POSIX escape codes
43-- Set the colour of a string using POSIX escape codes
43colourise :: IdrisColour -> String -> String
44colourise :: IdrisColour -> String -> String
44−colourise (IdrisColour c v u b) str = setSGRCode sgr ++ str ++ setSGRCode [Reset]
45+colourise (IdrisColour c v u b i) str = setSGRCode sgr ++ str ++ setSGRCode [Reset]
45 where sgr = [SetColor Foreground (if v then Vivid else Dull) c] ++
46 where sgr = [SetColor Foreground (if v then Vivid else Dull) c] ++
46 (if u then [SetUnderlining SingleUnderline] else []) ++
47 (if u then [SetUnderlining SingleUnderline] else []) ++
47− (if b then [SetConsoleIntensity BoldIntensity] else [])
48+ (if b then [SetConsoleIntensity BoldIntensity] else []) ++
49+ (if i then [SetItalicized True] else [])
48
50
49colouriseKwd :: ColourTheme -> String -> String
51colouriseKwd :: ColourTheme -> String -> String
50colouriseKwd t = colourise (keywordColour t)
52colouriseKwd t = colourise (keywordColour t)
src/Idris/Completion.hs+1−1
@@ -134,7 +134,7 @@ completeColour (prev, next) = case words (reverse prev) of
134 isCmd ":color" = True
134 isCmd ":color" = True
135 isCmd _ = False
135 isCmd _ = False
136 colours = map (map toLower . show) $ enumFromTo (minBound::Color) maxBound
136 colours = map (map toLower . show) $ enumFromTo (minBound::Color) maxBound
137− formats = ["vivid", "dull", "underline", "nounderline", "bold", "nobold"]
137+ formats = ["vivid", "dull", "underline", "nounderline", "bold", "nobold", "italic", "noitalic"]
138 completeColourFormat = let getCmpl = completeWith (colours ++ formats) in
138 completeColourFormat = let getCmpl = completeWith (colours ++ formats) in
139 completeWord Nothing " \t" (return . getCmpl)
139 completeWord Nothing " \t" (return . getCmpl)
140
140
src/Idris/REPL.hs+3−1
@@ -277,7 +277,9 @@ edit f orig
277 let cmd = editor ++ line ++ f
277 let cmd = editor ++ line ++ f
278 liftIO $ system cmd
278 liftIO $ system cmd
279 clearErr
279 clearErr
280− putIState (orig { idris_options = idris_options i })
280+ putIState $ orig { idris_options = idris_options i
281+ , idris_colourTheme = idris_colourTheme i
282+ }
281 loadInputs [f]
283 loadInputs [f]
282 iucheck
284 iucheck
283 return ()
285 return ()
src/Idris/REPLParser.hs+5−1
@@ -104,6 +104,8 @@ pColourMod = try (P.symbol "vivid" >> return doVivid)
104 <|> try (P.symbol "nounderline" >> return doNoUnderline)
104 <|> try (P.symbol "nounderline" >> return doNoUnderline)
105 <|> try (P.symbol "bold" >> return doBold)
105 <|> try (P.symbol "bold" >> return doBold)
106 <|> try (P.symbol "nobold" >> return doNoBold)
106 <|> try (P.symbol "nobold" >> return doNoBold)
107+ <|> try (P.symbol "italic" >> return doItalic)
108+ <|> try (P.symbol "noitalic" >> return doNoItalic)
107 <|> try (pColour >>= return . doSetColour)
109 <|> try (pColour >>= return . doSetColour)
108 where doVivid i = i { vivid = True }
110 where doVivid i = i { vivid = True }
109 doDull i = i { vivid = False }
111 doDull i = i { vivid = False }
@@ -111,6 +113,8 @@ pColourMod = try (P.symbol "vivid" >> return doVivid)
111 doNoUnderline i = i { underline = False }
113 doNoUnderline i = i { underline = False }
112 doBold i = i { bold = True }
114 doBold i = i { bold = True }
113 doNoBold i = i { bold = False }
115 doNoBold i = i { bold = False }
116+ doItalic i = i { italic = True }
117+ doNoItalic i = i { italic = False }
114 doSetColour c i = i { colour = c }
118 doSetColour c i = i { colour = c }
115
119
116
120
@@ -126,7 +130,7 @@ pColourType = doColourType colourTypes
126
130
127pSetColourCmd :: P.IdrisParser Command
131pSetColourCmd :: P.IdrisParser Command
128pSetColourCmd = (do c <- pColourType
132pSetColourCmd = (do c <- pColourType
129− let defaultColour = IdrisColour Black True False False
133+ let defaultColour = IdrisColour Black True False False False
130 opts <- sepBy pColourMod (P.whiteSpace)
134 opts <- sepBy pColourMod (P.whiteSpace)
131 let colour = foldr ($) defaultColour $ reverse opts
135 let colour = foldr ($) defaultColour $ reverse opts
132 return $ SetColour c colour)
136 return $ SetColour c colour)