← Back to branch summary

~ubuntu-branches/ubuntu/utopic/carettah/utopic

« back to all changes in this revision

Viewing changes to FormatPangoMarkup.hs

  • Committer: Package Import Robot
  • Author(s): Kiwamu Okabe
  • Date: 2012-05-13 21:52:34 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20120513215234-16l2iawob5vxrmd3
Tags: 0.1.2-1
New upstream version

Show diffs side-by-side

added added

removed removed

Lines of Context:
FormatPangoMarkup.hs
1
 
module FormatPangoMarkup (formatPangoMarkup) where
 
1
module FormatPangoMarkup (formatPangoMarkup, formatPangoMarkupWhite) where
2
2
import Text.Highlighting.Kate
3
3
import Graphics.Rendering.Pango
4
4
 
5
5
-- TODO: should use blaze-builder
6
6
 
7
 
tagTok :: Token -> String
8
 
tagTok (KeywordTok, s)        = "<span foreground=\"#007020\" font_weight=\"bold\">" ++ escapeMarkup s ++ "</span>"
9
 
tagTok (DataTypeTok, s)       = "<span foreground=\"#902000\">" ++ escapeMarkup s ++ "</span>"
10
 
tagTok (DecValTok, s)         = "<span foreground=\"#40a070\">" ++ escapeMarkup s ++ "</span>"
11
 
tagTok (BaseNTok, s)          = "<span foreground=\"#40a070\">" ++ escapeMarkup s ++ "</span>"
12
 
tagTok (FloatTok, s)          = "<span foreground=\"#40a070\">" ++ escapeMarkup s ++ "</span>"
13
 
tagTok (CharTok, s)           = "<span foreground=\"#4070a0\">" ++ escapeMarkup s ++ "</span>"
14
 
tagTok (StringTok, s)         = "<span foreground=\"#4070a0\">" ++ escapeMarkup s ++ "</span>"
15
 
tagTok (CommentTok, s)        = "<span foreground=\"#60a0b0\" background=\"lightgray\" font_style=\"italic\">" ++ escapeMarkup s ++ "</span>"
16
 
tagTok (OtherTok, s)          = "<span foreground=\"#007020\">" ++ escapeMarkup s ++ "</span>"
17
 
tagTok (AlertTok, s)          = "<span foreground=\"red\" font_weight=\"bold\">" ++ escapeMarkup s ++ "</span>"
18
 
tagTok (FunctionTok, s)       = "<span foreground=\"#06287e\">" ++ escapeMarkup s ++ "</span>"
19
 
tagTok (RegionMarkerTok, s)   = escapeMarkup s
20
 
tagTok (ErrorTok, s)          = "<span foreground=\"red\" font_weight=\"bold\">" ++ escapeMarkup s ++ "</span>"
21
 
tagTok (NormalTok, s)         = escapeMarkup s
22
 
 
23
 
tagLine :: SourceLine -> [String]
24
 
tagLine = fmap tagTok
 
7
 
 
8
tokColor :: TokenType -> String
 
9
tokColor KeywordTok        = "<span foreground=\"#007020\">"
 
10
tokColor DataTypeTok       = "<span foreground=\"#902000\">"
 
11
tokColor DecValTok         = "<span foreground=\"#40a070\">"
 
12
tokColor BaseNTok          = "<span foreground=\"#40a070\">"
 
13
tokColor FloatTok          = "<span foreground=\"#40a070\">"
 
14
tokColor CharTok           = "<span foreground=\"#4070a0\">"
 
15
tokColor StringTok         = "<span foreground=\"#4070a0\">"
 
16
tokColor CommentTok        = "<span foreground=\"#60a0b0\">"
 
17
tokColor OtherTok          = "<span foreground=\"#007020\">"
 
18
tokColor AlertTok          = "<span foreground=\"red\">"
 
19
tokColor FunctionTok       = "<span foreground=\"#06287e\">"
 
20
tokColor RegionMarkerTok   = "<span>"
 
21
tokColor ErrorTok          = "<span foreground=\"red\">"
 
22
tokColor NormalTok         = "<span>"
 
23
 
 
24
tokShape :: TokenType -> String
 
25
tokShape KeywordTok        = "<span font_weight=\"bold\">"
 
26
tokShape DataTypeTok       = "<span>"
 
27
tokShape DecValTok         = "<span>"
 
28
tokShape BaseNTok          = "<span>"
 
29
tokShape FloatTok          = "<span>"
 
30
tokShape CharTok           = "<span>"
 
31
tokShape StringTok         = "<span>"
 
32
tokShape CommentTok        = "<span font_style=\"italic\">"
 
33
tokShape OtherTok          = "<span>"
 
34
tokShape AlertTok          = "<span font_weight=\"bold\">"
 
35
tokShape FunctionTok       = "<span>"
 
36
tokShape RegionMarkerTok   = "<span>"
 
37
tokShape ErrorTok          = "<span font_weight=\"bold\">"
 
38
tokShape NormalTok         = "<span>"
 
39
 
 
40
tagTok, tagTokShape :: Token -> String
 
41
tagTok (t, s) = tokColor t ++ tokShape t ++ escapeMarkup s ++ "</span></span>"
 
42
tagTokShape (t, s) = tokShape t ++ escapeMarkup s ++ "</span>"
25
43
 
26
44
formatPangoMarkup :: String -> String -> String
27
 
formatPangoMarkup lang = unlines . fmap (concat . tagLine) . highlightAs lang
 
45
formatPangoMarkup lang = unlines . fmap (concat . fmap tagTok) . highlightAs lang
 
46
 
 
47
formatPangoMarkupWhite :: String -> String -> String
 
48
formatPangoMarkupWhite lang text =
 
49
  "<span foreground=\"white\">" ++ 
 
50
  (unlines . fmap (concat . fmap tagTokShape) . highlightAs lang) text ++ 
 
51
  "</span>"