Merge pull request #179 from ramnathv/master

Syntax Highlighting Themes for HTML
yihui · Apr 12, 2012 · 6aa2d1f · 6aa2d1f
2 parents 90e5667 + 56ab698
commit 6aa2d1f
Show file tree

Hide file tree

Showing 9 changed files with 227 additions and 90 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -12,3 +12,4 @@ knitr-minimal.html
 knitr-minimal.md
 knitr-latex.tex
 png$
+^\.Rproj\.user$
diff --git a/.gitignore b/.gitignore
@@ -8,4 +8,6 @@ inst/examples/figure
 inst/examples/ex-out*
 knitr-minimal.html
 knitr-latex.tex
-
+.Rproj.user
+misc
+knitr.Rproj
diff --git a/R/defaults.R b/R/defaults.R
@@ -108,7 +108,7 @@ all_patterns =
                      header.begin = '\n*\\s*<head>',
                      ref.label = '^## @knitr (.*)$'),
 
-       `md` = list(chunk.begin = '^``` \\{r(.*)\\}\\s*$',
+       `md` = list(chunk.begin = '^```\\s*\\{r(.*)\\}\\s*$',
                    chunk.end = '^```\\s*$',
                    chunk.end.is.terminator = TRUE,
                    ref.chunk = '^\\s*<<(.*)>>\\s*$',
@@ -135,7 +135,7 @@ opts_knit =
                     all.patterns = all_patterns, tangle = FALSE,
                     child = FALSE, parent = FALSE,
                     cache.extra = NULL, aliases = NULL,
-
+                    self.contained = TRUE,
                     header = c(highlight = '', tikz = '', framed = ''))
                )
 ## header should not be set by hand unless you know what you are doing

diff --git a/R/header.R b/R/header.R
@@ -1,27 +1,66 @@
-## x is the output of processed document
-insert_header = function(x) {
-  if (is.null(b <- knit_patterns$get('header.begin'))) return(x)
-  h = opts_knit$get('header')
-  i = which(str_detect(x, b))
-  if (length(i) == 1L) {
-    fmt = opts_knit$get('out.format')
-    if (fmt %in% c('markdown', 'gfm', 'jekyll')) return(x)
-    if (identical('latex', fmt))
-      h = c('\\usepackage{graphicx, color}', h)
-    if (identical('html', fmt))
-      h = h['highlight']
-    h = h[nzchar(h)]; if (length(h) == 0) h = ''
-    loc = str_locate(x[i], b)
-    str_sub(x[i], loc[, 1], loc[, 2]) =
-      str_c(str_sub(x[i], loc[, 1], loc[, 2]), '\n', str_c(h, collapse = '\n'))
-  } else if (length(i) == 0L) {
-    if (parent_mode()) {
-      h = c('\\usepackage{graphicx, color}', h)
-      x = c(getOption('tikzDocumentDeclaration'), str_c(h, collapse = '\n'),
-            .knitEnv$tikzPackages, '\\begin{document}', x, '\\end{document}')
-    }
-  }
-  x
+## doc is the output of processed document
+insert_header <- function(doc){
+	fmt = opts_knit$get('out.format')
+	switch(fmt, 
+		html  = insert_header_html(doc), 
+		latex = insert_header_latex(doc),
+		doc
+	)
+}
+
+## Makes latex header with macros required for highlighting, tikz and framed
+make_header_latex <- function(){
+	h <- "\\usepackage{graphicx, color}"
+	h <- paste(c(h, opts_knit$get('header')), collapse = "\n")
+	if (opts_knit$get('self.contained')){
+		return(h)
+	} else {
+		writeLines(h, 'knitr.sty')
+		return('\\usepackage{knitr}')
+	}
+}
+
+insert_header_latex <- function(doc){
+	# TODO: is this really required since b will never be NULL for latex.
+	if (is.null(b <- knit_patterns$get('header.begin'))){
+		return(doc)
+	}
+	h   <- make_header_latex()
+	i   <- which(str_detect(doc, b))
+	l   <- str_locate(doc[i], b)
+	if (length(i) == 1L){
+		tmp <- str_sub(doc[i], l[, 1], l[, 2])
+		str_sub(doc[i], l[,1], l[,2]) <- str_c(tmp, "\n", h)
+	} else if (length(i) == 0L) {
+		doc <- str_c(getOption('tikzDocumentDeclaration'), h, .knitEnv$packages,
+			"\\begin{document}", doc, "\\end{document}")
+	}
+	return(doc)
+}
+
+make_header_html <- function(){
+	h <- opts_knit$get('header')[['highlight']]
+	if (opts_knit$get('self.contained')){
+		h <- str_c('<style type="text/css">', h, '</style>', collapse = "\n")
+		return(h)
+	} else {
+		writeLines(h, 'knitr.css')
+		return('<link rel="stylesheet" href="knitr.css" type="text/css" />')
+	}
+}
+
+insert_header_html <- function(doc){
+	if (is.null(b <- knit_patterns$get('header.begin'))){
+		return(doc)
+	}
+	h <- make_header_html()
+	i <- which(str_detect(doc, b))
+	l <- str_locate(doc[i], b)
+	if (length(i) == 1L){
+		tmp <- str_sub(doc[i], l[, 1], l[, 2])
+		str_sub(doc[i], l[,1], l[,2]) <- str_c(tmp, "\n", h)
+	}
+	return(doc)
 }
 
 #' Set the header information
@@ -61,56 +100,3 @@ set_header = function(...) {
   opts_knit$set(header = h)
 }
 
-## many thanks to Donald Arseneau
-.header.framed = '\\usepackage{framed}
-\\makeatletter
-\\newenvironment{kframe}{%
- \\def\\FrameCommand##1{\\hskip\\@totalleftmargin \\hskip-\\fboxsep
- \\colorbox{shadecolor}{##1}\\hskip-\\fboxsep
-     % There is no \\@totalrightmargin, so:
-     \\hskip-\\linewidth \\hskip-\\@totalleftmargin \\hskip\\columnwidth}%
- \\MakeFramed {\\advance\\hsize-\\width
-   \\@totalleftmargin\\z@ \\linewidth\\hsize
-   \\@setminipage}}%
- {\\par\\unskip\\endMakeFramed}
-\\makeatother
-
-\\definecolor{shadecolor}{rgb}{.97, .97, .97}
-\\newenvironment{knitrout}{}{} % an empty environment to be redefined in TeX
-
-\\newcommand{\\SweaveOpts}[1]{}  % do not interfere with LaTeX
-\\newcommand{\\SweaveInput}[1]{} % because they are not real TeX commands
-\\newcommand{\\Sexpr}[1]{}       % will only be parsed by R
-'
-
-## LaTeX styles for highlight
-.header.hi.tex =
-    str_c(c("\\newcommand{\\hlnumber}[1]{\\textcolor[rgb]{0,0,0}{#1}}%",
-            "\\newcommand{\\hlfunctioncall}[1]{\\textcolor[rgb]{.5,0,.33}{\\textbf{#1}}}%",
-            "\\newcommand{\\hlstring}[1]{\\textcolor[rgb]{.6,.6,1}{#1}}%",
-            "\\newcommand{\\hlkeyword}[1]{\\textbf{#1}}%",
-            "\\newcommand{\\hlargument}[1]{\\textcolor[rgb]{.69,.25,.02}{#1}}%",
-            "\\newcommand{\\hlcomment}[1]{\\textcolor[rgb]{.18,.6,.34}{#1}}%",
-            "\\newcommand{\\hlroxygencomment}[1]{\\textcolor[rgb]{.44,.48,.7}{#1}}%",
-            "\\newcommand{\\hlformalargs}[1]{\\hlargument{#1}}%",
-            "\\newcommand{\\hleqformalargs}[1]{\\hlargument{#1}}%",
-            "\\newcommand{\\hlassignement}[1]{\\textbf{#1}}%",
-            "\\newcommand{\\hlpackage}[1]{\\textcolor[rgb]{.59,.71,.145}{#1}}%",
-            "\\newcommand{\\hlslot}[1]{\\textit{#1}}%",
-            "\\newcommand{\\hlsymbol}[1]{#1}%",
-            "\\newcommand{\\hlprompt}[1]{\\textcolor[rgb]{.5,.5,.5}{#1}}%",
-            boxes_latex(), "\\definecolor{fgcolor}{rgb}{0,0,0}"), collapse = '\n')
-
-.header.hi.html =
-    str_c(c('<style type="text/css">', '.knitr {
-	background-color: #F7F7F7;
-}', '.error {
-	font-weight: bold;
-	color: #FF0000;
-}', '.warning {
-	font-weight: bold;
-}', '.message {
-	font-style: italic;
-}', '.source, .output, .warning, .error, .message {
-	padding: 0.5em 1em;
-}', styler('default'), '</style>'), collapse = '\n')
diff --git a/R/hooks.R b/R/hooks.R
@@ -282,8 +282,17 @@ render_latex = function() {
   if (child_mode()) return()
   test_latex_pkg('framed', system.file('misc', 'framed.sty', package = 'knitr'))
   h = opts_knit$get('header')
-  if (!nzchar(h['framed'])) set_header(framed = .header.framed)
-  if (!nzchar(h['highlight'])) set_header(highlight = .header.hi.tex)
+  if (!nzchar(h['framed'])) {
+		.knit.sty      <- system.file('misc', 'knitr.sty', package = 'knitr')  
+		.header.framed <- paste(readLines(.knit.sty), collapse = "\n")
+		set_header(framed = .header.framed)
+	}
+  if (!nzchar(h['highlight'])) {
+		# header for Latex Syntax Highlighting
+		.header.hi.tex = paste(theme_to_header_latex('edit-eclipse')$highlight, 
+		   collapse = '\n')
+		set_header(highlight = .header.hi.tex)
+	}
   knit_hooks$restore()
   knit_hooks$set(source = function(x, options) {
     if (options$highlight) {
@@ -339,7 +348,13 @@ render_html = function() {
     force(name)
     function (x, options) sprintf('<div class="%s">%s</div>', name, x)
   }
-  set_header(highlight = .header.hi.html)
+  h = opts_knit$get('header')
+  if (!nzchar(h['highlight'])) {
+		# CSS for html syntax highlighting
+		.header.hi.html = paste(theme_to_header_html('default')$highlight, 
+		   collapse = '\n')
+		 set_header(highlight = .header.hi.html)
+	}
   z = list()
   for (i in c('source', 'output', 'warning', 'message', 'error'))
     z[[i]] = html.hook(i)

diff --git a/R/themes.R b/R/themes.R
@@ -2,16 +2,20 @@
 #' @noRd
 #' @author Ramnath Vaidyanathan
 set_theme = function(theme) {
+	fmt = opts_knit$get('out.format')
   header = if (is.list(theme)) theme else theme_to_header(theme)
-  highlight = paste(c(header$highlight, boxes_latex()), collapse = "\n")
-  opts_chunk$set(background = header$background)
+  highlight = paste(header$highlight, collapse = "\n")
+  if(fmt == 'latex') {
+  	opts_chunk$set(background = header$background)
+  }
   set_header(highlight = highlight)
   ## par(col = theme$foreground)
 }
 get_theme = function(theme = NULL) {
   if (is.null(theme)) {
-    f = list.files(system.file("themes", package = "knitr"), pattern = "\\.css$")
-    gsub("\\.css$", "", basename(f))
+    theme_dir = system.file("themes", package = "knitr")
+    theme_files = list.files(theme_dir,  pattern = "\\.css$")
+    gsub("\\.css$", "", basename(theme_files))
   } else {
     theme_to_header(theme)
   }
@@ -41,11 +45,23 @@ get_theme = function(theme = NULL) {
 #' knit_theme$set(thm)
 knit_theme = list(set = set_theme, get = get_theme)
 
+
+#' Generates header based on a theme and output format of document
+#' @author Ramnath Vaidyanathan
+#' @noRd
+theme_to_header = function(theme){
+	fmt <- opts_knit$get('out.format')
+	if (fmt == 'latex'){
+		theme_to_header_latex(theme)
+	} else
+		theme_to_header_html(theme)
+}	
+
 #' Generates latex header based on a theme
 #' @importFrom highlight css.parser styler_assistant_latex
 #' @author Ramnath Vaidyanathan
 #' @noRd
-theme_to_header = function(theme) {
+theme_to_header_latex = function(theme) {
   css_file = if (file.exists(theme)) theme else {
     system.file("themes", sprintf("%s.css", theme), package = "knitr")
   }
@@ -57,7 +73,27 @@ theme_to_header = function(theme) {
 
   ## write latex highlight header
   fgheader = color_def(foreground, "fgcolor")
-  highlight = c(fgheader, styler_assistant_latex(css_out[-1]))
-
+  highlight = c(fgheader, styler_assistant_latex(css_out[-1]), boxes_latex())
   list(highlight = highlight, background = background, foreground = foreground)
 }
+
+#' Generates css header based on a theme
+#' @author Ramnath Vaidyanathan
+#' @noRd
+#  HACK: replace ugly sub hack to match knitr background with theme
+#  TODO: warning, error, source etc. are still black, an issue for dark themes
+#  TODO: might be a good idea to regenerate the css files appending the 
+#        .knitr.css template to the existing templates
+theme_to_header_html <- function(theme){
+	css_file = if (file.exists(theme)) theme else {
+		system.file("themes", sprintf("%s.css", theme), package = "knitr")
+	}
+	bgcolor <- css.parser(css_file)$background$color
+	css_knitr = system.file('themes', '.knitr.css', package = 'knitr')
+	css_knitr_lines <- readLines(css_knitr)
+	css_knitr_lines  <-  sub('^([[:space:]]+background-color:\\s+)(.*)$', 
+	  sprintf('\\1%s;', bgcolor), css_knitr_lines)
+	css <- c(css_knitr_lines, readLines(css_file))
+	return(list(highlight = css))
+}
+
diff --git a/inst/misc/knitr.sty b/inst/misc/knitr.sty
@@ -0,0 +1,19 @@
+\usepackage{framed}
+\makeatletter
+\newenvironment{kframe}{%
+ \def\FrameCommand##1{\hskip\@totalleftmargin \hskip-\fboxsep
+ \colorbox{shadecolor}{##1}\hskip-\fboxsep
+     % There is no \\@totalrightmargin, so:
+     \hskip-\linewidth \hskip-\@totalleftmargin \hskip\columnwidth}%
+ \MakeFramed {\advance\hsize-\width
+   \@totalleftmargin\z@ \linewidth\hsize
+   \@setminipage}}%
+ {\par\unskip\endMakeFramed}
+\makeatother
+
+\definecolor{shadecolor}{rgb}{.97, .97, .97}
+\newenvironment{knitrout}{}{} % an empty environment to be redefined in TeX
+
+\newcommand{\SweaveOpts}[1]{}  % do not interfere with LaTeX
+\newcommand{\SweaveInput}[1]{} % because they are not real TeX commands
+\newcommand{\Sexpr}[1]{}       % will only be parsed by R
diff --git a/inst/themes/.knitr.css b/inst/themes/.knitr.css
@@ -0,0 +1,17 @@
+.knitr {
+  background-color: #F7F7F7;
+  border:solid 1px #B0B0B0;
+}
+.error {
+	font-weight: bold;
+	color: #FF0000;
+}, 
+.warning {
+	font-weight: bold;
+} 
+.message {
+	font-style: italic;
+} 
+.source, .output, .warning, .error, .message {
+	padding: 0.5em 1em;
+}
diff --git a/inst/themes/default.css b/inst/themes/default.css
@@ -0,0 +1,61 @@
+.background{
+  color: #eeeeee ;
+}
+.number{
+	color: rgb(21,20,181) ;
+}
+
+.functioncall{
+	color: red ;
+}
+
+.string{
+	color: rgb(153,153,255) ;
+}
+
+.keyword{
+	font-weight: bolder ;
+	color: black;
+}
+
+.argument{
+	color: rgb( 177,63,5) ;
+}
+
+.comment{
+	color: rgb( 204,204,204) ;
+}
+
+.roxygencomment{
+	color: rgb(0,151,255);
+}
+
+.formalargs{
+	color: rgb(18,182,18);
+}
+
+.eqformalargs{
+	color: rgb(18,182,18);
+}
+
+.assignement{
+	font-weight: bolder;
+	color: rgb(55,55,98);
+}
+
+.package{
+	color: rgb(150,182,37);
+}
+
+.slot{
+	font-style:italic;
+}
+
+.symbol{
+	color: black ;
+}
+
+.prompt{
+	color: black ;
+}
+