blob: cc6d005c3f706f8343ce3691070adb80aa9ea275 [file] [log] [blame]
Hao Zhu86a4dd02020-08-23 22:58:45 -04001#' Convert selected RStudio markdown table to kable code
2#'
3#' @description RStudio 1.4 comes with a very nice live markdown table editor
4#' (see https://bookdown.org/yihui/rmarkdown-cookbook/rstudio-visual.html for
5#' details). For those who need to further customize those markdown tables, you
6#' can use this function/addin to convert the markdown table to necessary R
7#' code to render that table using `kableExtra`.
8#'
9#' @export
10md_table_to_kable <- function() {
11 current_selection <- rstudioapi::getSourceEditorContext()
12 x <- current_selection$selection[[1]]$text
13 if (x == "") {
14 stop("You have not yet selected any markdown table text!")
15 }
16 x <- trimws(x)
17 x_lines <- stringr::str_split(x, '\n')[[1]]
18 if (!stringr::str_detect(x_lines[2], '^\\|[\\-\\:]')) {
19 stop("Unexpected form of markdown table. This function only works for ",
20 "regular markdown tables. Compact mode is not supported.")
21 }
22
23 # Get caption if available
24 if (stringr::str_detect(x_lines[length(x_lines)], '^: ')) {
25 caption <- sub('^: ', '', x_lines[length(x_lines)])
26 x_lines <- x_lines[-c(length(x_lines) - 1, length(x_lines))]
27 } else {
28 caption <- NULL
29 }
30 n_row <- length(x_lines) - 2
31
32 # get content matrix
33 col_length <- stringr::str_split(x_lines[2], "\\|")[[1]]
34 col_length <- col_length[-c(1, length(col_length))]
35 n_col <- length(col_length)
36 col_length <- nchar(col_length)
37 col_offset <- cumsum(col_length + 1) + 1
38 col_offset <- c(1, col_offset[-n_col])
39 start_pos <- col_offset + 2
40 end_pos <- col_length + col_offset - 1
41 content_matrix <- matrix(
42 unlist(lapply(x_lines, substring, start_pos, end_pos)),
43 ncol = n_col, byrow = TRUE
44 )
45
46 # Get alignment
47 alignment <- vapply(content_matrix[2, ], function(x) {
48 if (stringr::str_sub(x, -1, -1) == ":") {
49 if (stringr::str_sub(x, 1, 1) == ":") {
50 return('c')
51 } else {
52 return('r')
53 }
54 } else {
55 return('l')
56 }
57 }, 'character', USE.NAMES = FALSE)
58
59 content_matrix <- trimws(content_matrix)
60 col_names <- content_matrix[1, ]
61
62 content_matrix <- content_matrix[-c(1, 2), ]
63 content_matrix <- sim_double_escape(content_matrix)
64
65 str_parts <- c(
66 '```{r}\n',
67 'data.frame(\n'
68 )
69
70 if (n_col > 1) {
71 for (i in seq(n_col - 1)) {
72 str_parts[i + 2] <- paste0(
73 ' `Col', i, '` = ', vector_str(content_matrix[, i]), ', \n'
74 )
75 }
76 }
77 str_parts[n_col + 2] <- paste0(
78 ' `Col', n_col, '` = ', vector_str(content_matrix[, n_col]), '\n'
79 )
80 str_parts[n_col + 3] <- paste0(
81 ') %>%\n kableExtra::kbl(\n escape = F, \n col.names = ',
82 if (all(col_names == "")) 'NULL' else vector_str(col_names),
83 ', \n align = ', vector_str(alignment), ', \n caption = ',
84 if (is.null(caption)) 'NULL' else paste0('"', caption, '"'),
85 ',\n booktable = T\n ) %>%\n kableExtra::kable_styling()\n```'
86 )
87 out <- paste(str_parts, collapse = "")
88
89 rstudioapi::insertText(location = current_selection$selection[[1]]$range,
90 text = out,
91 id = current_selection$id)
92
93 return(out)
94}
95
96vector_str <- function(v) {
97 return(paste0('c(', paste0('"', v, '"', collapse = ", "), ')'))
98}