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