1hilight_source = function(x, format, options) {
2  if ((format %in% c('latex', 'html')) && options$highlight) {
3    res = if (options$engine == 'R') {
4      opts = opts_knit$get('highr.opts')
5      highr::hilight(x, format, prompt = options$prompt, markup = opts$markup)
6    } else {
7      res = try(highr::hi_andre(x, options$engine, format))
8      if (inherits(res, 'try-error')) {
9        if (format == 'html') highr:::escape_html(x) else highr:::escape_latex(x)
10      } else {
11        highlight_header()
12        n = length(res)
13        # do not touch font size
14        if (res[n] == '\\normalsize') res = res[-n]
15        res
16      }
17    }
18    if (format == 'latex' && is.character(tld <- opts_knit$get('latex.tilde'))) {
19      res = gsub('\\hlopt{~}', tld, res, fixed = TRUE)
20    }
21    res
22  } else if (options$prompt) {
23    # if you did not reformat or evaluate the code, I have to figure out which
24    # lines belong to one complete expression first (#779)
25    if (options$engine == 'R' && isFALSE(options$tidy) && isFALSE(options$eval))
26      x = vapply(xfun::split_source(x), one_string, character(1))
27    line_prompt(x)
28  } else x
29}
30
31highlight_header = function() {
32  set_header(highlight.extra = paste(c(
33    sprintf('\\let\\hl%s\\hlstd', c('esc', 'pps', 'lin')),
34    sprintf('\\let\\hl%s\\hlcom', c('slc', 'ppc'))
35  ), collapse = ' '))
36}
37
38# stolen from Romain's highlight package (v0.3.2)
39
40# http://www.w3schools.com/css/css_colornames.asp
41w3c.colors = c(
42  aqua = '#00FFFF', black = '#000000', blue = '#0000FF', fuchsia = '#FF00FF',
43  gray = '#808080', green = '#008000', lime = '#00FF00', maroon = '#800000',
44  navy = '#000080', olive = '#808000', purple = '#800080', red = '#FF0000',
45  silver = '#C0C0C0', teal = '#008080', white = '#FFFFFF', yellow = '#FFFF00'
46)
47
48css.parse.color = function(txt, default = '#000000') {
49  txt = gsub('\\s+', '', tolower(txt))
50  if (is.hex(txt)) return(txt)
51
52  # css specs are from 0 to 255
53  rgb = function(...) grDevices::rgb(..., maxColorValue = 255)
54
55  # first we try to match against w3c standard colors
56  if (!grepl('[^a-z]', txt) && txt %in% names(w3c.colors))
57    return(w3c.colors[txt])
58
59  # now we try R colors
60  if (!grepl('[^a-z0-9]', txt)) {
61    R.colors = colors()
62    res = R.colors %in% txt
63    if (any(res)) {
64      return(rgb(t(col2rgb(R.colors[res]))))
65    }
66  }
67
68  # next we try an rgb() specification
69  if (grepl('rgb', txt)) {
70    p = try_silent(parse(text = txt))
71    if (!inherits(p, 'try-error')) {
72      res = try_silent(eval(p))
73      if (!inherits(res, 'try-error')) return(res)
74    }
75  }
76
77  # fall back on the default color
78  default
79}
80
81is.hex = function(x) grepl('^#[0-9a-f]{6}$', x)
82
83# minimal css parser
84css.parser = function(file, lines = read_utf8(file)) {
85
86  rx = '^\\.(.*?) *\\{.*$'
87  dec.lines = grep(rx, lines)
88  dec.names = sub(rx, '\\1', lines[dec.lines])
89  if (any(grepl('[0-9]', dec.names))) warning('use of numbers in style names')
90
91  end.lines = grep('^\\s*\\}', lines)
92
93  # find the closing brace of each declaration
94  dec.close = end.lines[vapply(dec.lines, function(x) which.min(end.lines < x), integer(1))]
95
96  pos = matrix(c(dec.lines, dec.close), ncol = 2)
97  styles = apply(pos, 1, function(x) {
98    data = lines[(x[1] + 1):(x[2] - 1)]
99    settings.rx = '^\\s*(.*?)\\s*:\\s*(.*?)\\s*;\\s*$'
100    settings = sub(settings.rx, '\\1', data, perl = TRUE)
101    contents = sub(settings.rx, '\\2', data, perl = TRUE)
102    out = list()
103    for (i in seq_along(settings)) {
104      setting = settings[i]
105      content = contents[i]
106      out[[setting]] = switch(
107        setting,
108        color = css.parse.color(content, '#000000'),
109        background = css.parse.color(content, '#FFFFFF'),
110        content
111      )
112    }
113    out
114  })
115  names(styles) = dec.names
116  styles
117}
118
119# styler assistant for latex
120styler_assistant_latex = function(x) {
121
122  styles = sapply(x, function(item) {
123    settings = names(item)
124    has = function(s, value) {
125      s %in% settings && grepl(value, item[[s]])
126    }
127    start = end = ''
128    if ('color' %in% settings) {
129      start = paste0(start, '\\textcolor[rgb]{', col2latexrgb(item[['color']]), '}{')
130      end = paste0(end, '}')
131    }
132    if (has('font-weight', 'bold')) {
133      start = paste0(start, '\\textbf{')
134      end = paste0('}', end)
135    }
136    if (has('font-style', 'italic')) {
137      start = paste0(start, '\\textit{')
138      end = paste0('}', end)
139    }
140    sprintf('%s#1%s', start, end)
141  })
142  res = sprintf('\\newcommand{\\hl%s}[1]{%s}%%', names(x), styles)
143  c(res, '\\let\\hlipl\\hlkwb')
144}
145
146col2latexrgb = function(hex) {
147  # as.character(0.123) -> 0,123 when "OutDec = ,", so make sure . is used
148  outdec = options(OutDec = '.'); on.exit(options(outdec))
149  col = col2rgb(hex)[, 1] / 255
150  paste(round(col, 3), collapse = ',')
151}
152