├── LICENSE ├── inst ├── rcloud.rmd.png ├── rstudio │ └── addins.dcf ├── addin │ ├── addin_files │ │ ├── submit.js │ │ ├── html5shiv.min.js │ │ ├── respond.min.js │ │ ├── logo.svg │ │ ├── selectize.bootstrap3.css │ │ ├── bootstrap.min.js │ │ ├── selectize.min.js │ │ └── babel-polyfill.min.js │ └── addin.html └── javascript │ └── rcloud.rmd.js ├── NAMESPACE ├── R ├── utils.R ├── onload.R ├── parser.R ├── rstudio.R ├── export.R └── import.R ├── NEWS.md ├── DESCRIPTION └── README.md /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2016 2 | COPYRIGHT HOLDER: AT&T Intellectual Property 3 | -------------------------------------------------------------------------------- /inst/rcloud.rmd.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/att/rcloud.rmd/master/inst/rcloud.rmd.png -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | 2 | export(exportRmd) 3 | importFrom(knitr, all_patterns) 4 | importFrom(knitr, opts_knit) 5 | importFrom(tools, file_path_sans_ext) 6 | importFrom(yaml, yaml.load) 7 | -------------------------------------------------------------------------------- /inst/rstudio/addins.dcf: -------------------------------------------------------------------------------- 1 | Name: Export to RCloud notebook 2 | Description: Create an RCloud notebook from the current Rmd file. 3 | Binding: rstudio_to_rcloud_rmd 4 | Interactive: false 5 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | 2 | `%||%` <- function(l, r) if (is.null(l)) r else l 3 | 4 | `%:::%` <- function(p, f) do.call(base::`:::`, list(p, f)) 5 | 6 | drop_nulls <- function(x) { 7 | x [ ! vapply(x, is.null, TRUE) ] 8 | } 9 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | ## 1.0.2 2 | Fix accidental global that could clobber other RCloud extensions 3 | 4 | ## 1.0.1 5 | * Default empty notebook cells to empty comments for imported rmd, to avoid producing invalid gist 6 | * Export Rmarkdown dialog was conflicting with Export Notebook to File dialog 7 | * Improvements to Rmarkdown Import form 8 | 9 | ## 1.0 10 | Initial release 11 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: rcloud.rmd 2 | Type: Package 3 | Title: Import and Export RStudio Notebooks into/from RCloud 4 | Version: 1.0.2 5 | Authors@R: person("Gábor", "Csárdi", email = "gcsardi@mango-solutions.com", 6 | role = c("aut", "cre")) 7 | Description: Import and export Rmarkdown RStudio notebooks, or other 8 | Rmarkdown documents, into/from RCLoud notebooks. 9 | License: MIT + file LICENSE 10 | RCloud-Extension: gui 11 | Encoding: UTF-8 12 | Imports: 13 | knitr, 14 | tools, 15 | yaml 16 | Suggests: 17 | jsonlite, 18 | rcloud.support (>= 1.7-0), 19 | rstudioapi, 20 | whisker 21 | -------------------------------------------------------------------------------- /R/onload.R: -------------------------------------------------------------------------------- 1 | 2 | caps <- NULL 3 | 4 | .onLoad <- function(libname, pkgname) { 5 | 6 | ## Not in RCloud? Return silently 7 | if (! requireNamespace("rcloud.support", quietly = TRUE)) return() 8 | 9 | path <- system.file( 10 | package = "rcloud.rmd", 11 | "javascript", 12 | "rcloud.rmd.js" 13 | ) 14 | 15 | caps <<- rcloud.support::rcloud.install.js.module( 16 | "rcloud.rmd", 17 | paste(readLines(path), collapse = '\n') 18 | ) 19 | 20 | ocaps <- list( 21 | importRmd = make_oc(importRmd), 22 | exportRmd = make_oc(exportRmd) 23 | ) 24 | 25 | if (!is.null(caps)) caps$init(ocaps) 26 | } 27 | 28 | make_oc <- function(x) { 29 | do.call(base::`:::`, list("rcloud.support", "make.oc"))(x) 30 | } 31 | -------------------------------------------------------------------------------- /inst/addin/addin_files/submit.js: -------------------------------------------------------------------------------- 1 | // non-empty line to mitigate a whisker bug 2 | var notebook = {{{ notebook }}}; 3 | 4 | function cancelrmd() { 5 | window.close(); 6 | } 7 | 8 | function updateFormAction(url) { 9 | $('#import-form').attr('action', url + "/api.R/create"); 10 | } 11 | 12 | $( 13 | function() { 14 | $( "#rcloud_url_custom" ).on('input', function(event) { 15 | var val = $('#rcloud_url_custom')[0].value; 16 | if(val != "") { 17 | updateFormAction(val) 18 | } else { 19 | updateFormAction($('#rcloud_url_predefined').val()) 20 | } 21 | }); 22 | $('#rcloud_url_predefined').on('change', function () { 23 | if($('#rcloud_url_custom')[0].value === "") { 24 | updateFormAction($('#rcloud_url_predefined').val()) 25 | } 26 | }); 27 | } 28 | ) 29 | $( 30 | function() { 31 | $( "#json" )[0].value = JSON.stringify(notebook); 32 | updateFormAction($('#rcloud_url_predefined').val()) 33 | } 34 | ) -------------------------------------------------------------------------------- /R/parser.R: -------------------------------------------------------------------------------- 1 | 2 | ## We use knitr's (internal) parser. IMO the implementation of the 3 | ## parser is a mess, it keeps modifying some global state, so it is very 4 | ## hard to follow. Which means that it is also hard to reproduce what it 5 | ## does. So we just use it. :( 6 | 7 | parse_rmd <- function(lines) { 8 | 9 | ## Get the YAML header, split it off 10 | yaml <- character() 11 | if (length(lines) >= 2 && grepl("^---\\s*$", lines[1])) { 12 | ynos <- grep("^---\\s*$", lines) 13 | if (length(ynos) >= 2) { 14 | yaml <- lines[1:ynos[2]] 15 | lines <- lines[-(1:ynos[2])] 16 | } 17 | } 18 | 19 | opts_knit$set(out.format = 'markdown') 20 | ("knitr" %:::% "knit_code")$restore() 21 | parsed <- ("knitr" %:::% "split_file")(lines, patterns = all_patterns$md) 22 | 23 | res <- c( 24 | list(structure(class = "yaml", yaml)), 25 | lapply(parsed, make_chunk_parser()) 26 | ) 27 | 28 | drop_nulls(res) 29 | } 30 | 31 | make_chunk_parser <- function() { 32 | current_block <- 0 33 | 34 | function(chunk) { 35 | 36 | if (inherits(chunk, "inline")) { 37 | if (chunk$input == "") { 38 | NULL 39 | } else { 40 | structure( 41 | class = "inline", 42 | list( 43 | text = chunk$input, 44 | code = chunk$code, 45 | code_loc = chunk$location 46 | ) 47 | ) 48 | } 49 | 50 | } else if (inherits(chunk, "block")) { 51 | current_block <<- current_block + 1 52 | code <- ("knitr" %:::% "knit_code")$get(current_block) 53 | if (identical(code, "") || is.null(code) || length(code) == 0) { 54 | NULL 55 | } else { 56 | structure( 57 | class = "block", 58 | list( 59 | code = code, 60 | param = chunk$params 61 | ) 62 | ) 63 | } 64 | } 65 | 66 | } 67 | } 68 | -------------------------------------------------------------------------------- /inst/addin/addin.html: -------------------------------------------------------------------------------- 1 | 2 |
4 | 5 | 6 | 7 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 20 | 21 | 22 | 23 | 24 | 56 | 57 | -------------------------------------------------------------------------------- /R/rstudio.R: -------------------------------------------------------------------------------- 1 | 2 | rstudio_to_rcloud_rmd <- function() { 3 | 4 | if (! check_opened_file()) return(invisible()) 5 | if (! check_required_packages()) return(invisible()) 6 | 7 | edit_ctx <- rstudioapi::getSourceEditorContext() 8 | text <- paste(edit_ctx$contents, collapse = "\n") 9 | filename <- file_path_sans_ext(basename( 10 | edit_ctx$path %||% NA_character_ 11 | )) 12 | 13 | ## Copy over files to temp dir 14 | tmp <- tempfile() 15 | dir.create(tmp) 16 | file.copy( 17 | system.file("addin", package = "rcloud.rmd"), 18 | tmp, 19 | recursive = TRUE 20 | ) 21 | 22 | ## Fill the templates 23 | data <- list( 24 | notebook = as.character(toJSON(rmdToJson(text, filename))), 25 | urls = rcloud_urls() 26 | ) 27 | template(file.path(tmp, "addin", "addin_files", "submit.js"), data) 28 | template(file.path(tmp, "addin", "addin.html"), data) 29 | 30 | html <- paste0("file://", tmp, "/addin/addin.html") 31 | browseURL(html) 32 | } 33 | 34 | toJSON <- function(x) { 35 | x <- I(x) 36 | 37 | jsonlite::toJSON( 38 | x, dataframe = "columns", null = "null", na = "null", 39 | auto_unbox = TRUE, digits = 16, use_signif = TRUE, 40 | force = TRUE, POSIXt = "ISO8601", UTC = TRUE, rownames = FALSE, 41 | keep_vec_names = TRUE, json_verbatim = TRUE 42 | ) 43 | } 44 | 45 | rcloud_urls <- function() { 46 | urls <- c("https://rcloud.social", "http://127.0.0.1:8080") 47 | paste0("", collapse = "\n") 48 | } 49 | 50 | template <- function(file, data) { 51 | lines <- readLines(file) 52 | filled <- whisker::whisker.render(lines, data = data) 53 | writeLines(filled, file) 54 | } 55 | 56 | check_opened_file <- function() { 57 | tryCatch( 58 | { rstudioapi::getSourceEditorContext(); TRUE }, 59 | error = function(e) { 60 | message("No Rmd file is open for RCloud export.") 61 | FALSE 62 | } 63 | ) 64 | } 65 | 66 | check_required_packages <- function() { 67 | check_installed_package("jsonlite") && 68 | check_installed_package("rstudioapi") && 69 | check_installed_package("whisker") 70 | } 71 | 72 | check_installed_package <- function(pkg) { 73 | if (! requireNamespace(pkg, quietly = TRUE)) { 74 | message("Package needed for Rmd export, but not installed: ", pkg) 75 | FALSE 76 | } else { 77 | TRUE 78 | } 79 | } 80 | -------------------------------------------------------------------------------- /R/export.R: -------------------------------------------------------------------------------- 1 | 2 | ## Create an Rmd and return it as a string, or 3 | ## write it to a file (if file is not NULL) 4 | 5 | exportRmd <- function(id, version, file = NULL) { 6 | 7 | res <- rcloud.support::rcloud.get.notebook(id, version) 8 | 9 | if (! res$ok) return(NULL) 10 | 11 | cells <- res$content$files 12 | cells <- cells[grep("^part", names(cells))] 13 | if (!length(names(cells))) return(NULL) 14 | 15 | cnums <- suppressWarnings(as.integer( 16 | gsub("^\\D+(\\d+)\\..*", "\\1", names(cells)) 17 | )) 18 | cells <- cells[match(sort.int(cnums), cnums)] 19 | 20 | tmp <- file 21 | if (is.null(tmp)) { 22 | tmp <- tempfile(fileext = ".Rmd") 23 | on.exit(unlink(tmp), add = TRUE) 24 | } 25 | 26 | cat("", file = tmp) 27 | 28 | for (cell in cells) { 29 | if (grepl("^part.*\\.R$", cell$filename)) { 30 | cat(format_r_cell(cell), file = tmp, append = TRUE) 31 | 32 | } else if (grepl("^part.*\\.md$", cell$filename)) { 33 | cat(format_md_cell(cell), file = tmp, append = TRUE) 34 | 35 | } else if (grepl("^part.*\\.Rmd$", cell$filename)) { 36 | cat(format_rmd_cell(cell), file = tmp, append = TRUE) 37 | 38 | } else { 39 | ext <- tools::file_ext(cell$filename) 40 | cat(format_default_cell(cell, ext), file = tmp, append = TRUE) 41 | } 42 | } 43 | 44 | if (is.null(file)) { 45 | list( 46 | description = res$content$description, 47 | rmd = readChar(tmp, file.info(tmp)$size) 48 | ) 49 | } else { 50 | invisible() 51 | } 52 | } 53 | 54 | format_r_cell <- function(cell) { 55 | format_default_cell(cell, ext = "R") 56 | } 57 | 58 | format_md_cell <- function(cell) { 59 | paste0(cell$content, "\n") 60 | } 61 | 62 | format_rmd_cell <- function(cell) { 63 | paste0(cell$content, "\n") 64 | } 65 | 66 | format_default_cell <- function(cell, ext) { 67 | 68 | conv <- c(R = "r", py = "python") 69 | 70 | if (ext %in% names (conv)) { 71 | label <- conv[ext] 72 | } else { 73 | warning("Unknown cell type ", ext, " written as text") 74 | return(paste0(cell$content, "\n")) 75 | } 76 | 77 | ## Handle ##> headers, these are chunk options 78 | options <- if (grepl("^##>", cell$content)) { 79 | split <- strsplit(cell$content, "\n")[[1]] 80 | line <- split[1] 81 | cell$content <- paste(split[-1], collapse = "\n") 82 | paste0(" ", sub("^##>\\s*", "", line)) 83 | } 84 | 85 | paste0("```{", label, options, "}\n", cell$content, "\n```\n") 86 | } 87 | -------------------------------------------------------------------------------- /R/import.R: -------------------------------------------------------------------------------- 1 | 2 | rmdToJson <- function(text, filename) { 3 | lines <- strsplit(text, "\n", fixed = TRUE)[[1]] 4 | parsed <- parse_rmd(lines) 5 | 6 | yaml <- NULL 7 | notebook <- list( 8 | files = mapply(seq_along(parsed), parsed, FUN = function(num, chunk) { 9 | 10 | if (inherits(chunk, "yaml")) { 11 | yaml <<- chunk 12 | code <- ifelse(trimws(chunk)=="", "", chunk) 13 | structure( 14 | list(list(content = paste(code, collapse = "\n"))), 15 | names = paste0("part", num, ".md") 16 | ) 17 | 18 | } else if (inherits(chunk, "inline")) { 19 | code <- ifelse(trimws(chunk$text)=="", "", chunk$text) 20 | structure( 21 | list(list(content = code)), 22 | names = paste0("part", num, ".md") 23 | ) 24 | 25 | } else if (inherits(chunk, "block")) { 26 | 27 | if ("label" %in% names(chunk$param) && 28 | grepl("^unnamed-chunk-", chunk$param$label)) { 29 | chunk$param <- chunk$param[names(chunk$param) != "label"] 30 | } 31 | 32 | content <- if (length(chunk$param)) { 33 | paste0( 34 | "##> ", 35 | paste( 36 | names(chunk$param), 37 | chunk$param, 38 | sep = "=", 39 | collapse = ", " 40 | ), 41 | "\n" 42 | ) 43 | } 44 | code <- ifelse(trimws(chunk$code)=="", "# ",chunk$code) 45 | content <- paste0(content, paste(code, collapse = "\n")) 46 | structure( 47 | list(list(content = content)), 48 | names = paste0("part", num, ".R") 49 | ) 50 | } 51 | }) 52 | ) 53 | 54 | notebook$description <- make_description(yaml, filename) 55 | 56 | notebook 57 | } 58 | 59 | importRmd <- function(text, filename) { 60 | 61 | notebook <- rmdToJson(text, filename) 62 | 63 | res <- rcloud.support::rcloud.create.notebook(notebook, FALSE) 64 | 65 | if (!isTRUE(res$ok)) stop("failed to create new notebook") 66 | 67 | res$content 68 | } 69 | 70 | make_description <- function(yaml, filename) { 71 | 72 | yaml <- paste( 73 | grep("^---\\s*$", yaml, invert = TRUE, value = TRUE), 74 | collapse = "\n" 75 | ) 76 | yaml <- tryCatch(yaml.load(yaml), error = function(e) NULL) 77 | 78 | from_filename <- file_path_sans_ext(basename(filename)) 79 | from_yaml <- tryCatch( 80 | yaml$Title %||% yaml$title, 81 | error = function(e) NULL 82 | ) 83 | from_yaml %||% from_filename 84 | } 85 | -------------------------------------------------------------------------------- /inst/addin/addin_files/html5shiv.min.js: -------------------------------------------------------------------------------- 1 | /** 2 | * @preserve HTML5 Shiv 3.7.2 | @afarkas @jdalton @jon_neal @rem | MIT/GPL2 Licensed 3 | */ 4 | // Only run this code in IE 8 5 | if (!!window.navigator.userAgent.match("MSIE 8")) { 6 | !function(a,b){function c(a,b){var c=a.createElement("p"),d=a.getElementsByTagName("head")[0]||a.documentElement;return c.innerHTML="x",d.insertBefore(c.lastChild,d.firstChild)}function d(){var a=t.elements;return"string"==typeof a?a.split(" "):a}function e(a,b){var c=t.elements;"string"!=typeof c&&(c=c.join(" ")),"string"!=typeof a&&(a=a.join(" ")),t.elements=c+" "+a,j(b)}function f(a){var b=s[a[q]];return b||(b={},r++,a[q]=r,s[r]=b),b}function g(a,c,d){if(c||(c=b),l)return c.createElement(a);d||(d=f(c));var e;return e=d.cache[a]?d.cache[a].cloneNode():p.test(a)?(d.cache[a]=d.createElem(a)).cloneNode():d.createElem(a),!e.canHaveChildren||o.test(a)||e.tagUrn?e:d.frag.appendChild(e)}function h(a,c){if(a||(a=b),l)return a.createDocumentFragment();c=c||f(a);for(var e=c.frag.cloneNode(),g=0,h=d(),i=h.length;i>g;g++)e.createElement(h[g]);return e}function i(a,b){b.cache||(b.cache={},b.createElem=a.createElement,b.createFrag=a.createDocumentFragment,b.frag=b.createFrag()),a.createElement=function(c){return t.shivMethods?g(c,a,b):b.createElem(c)},a.createDocumentFragment=Function("h,f","return function(){var n=f.cloneNode(),c=n.createElement;h.shivMethods&&("+d().join().replace(/[\w\-:]+/g,function(a){return b.createElem(a),b.frag.createElement(a),'c("'+a+'")'})+");return n}")(t,b.frag)}function j(a){a||(a=b);var d=f(a);return!t.shivCSS||k||d.hasCSS||(d.hasCSS=!!c(a,"article,aside,dialog,figcaption,figure,footer,header,hgroup,main,nav,section{display:block}mark{background:#FF0;color:#000}template{display:none}")),l||i(a,d),a}var k,l,m="3.7.2",n=a.html5||{},o=/^<|^(?:button|map|select|textarea|object|iframe|option|optgroup)$/i,p=/^(?:a|b|code|div|fieldset|h1|h2|h3|h4|h5|h6|i|label|li|ol|p|q|span|strong|style|table|tbody|td|th|tr|ul)$/i,q="_html5shiv",r=0,s={};!function(){try{var a=b.createElement("a");a.innerHTML="' + fr.result.split("\n")
43 | .slice(0,15)
44 | .join("\n") + '\n...\n'
45 | );
46 | ui_utils.enable_bs_button(import_button);
47 | rmd_raw = fr.result;
48 | rmd_filename = file.name;
49 | };
50 | fr.readAsText(file);
51 | }
52 |
53 | function do_import() {
54 | // Need to call back to R to import the notebook
55 | oc.importRmd(rmd_raw, rmd_filename).then(
56 | function(notebook) {
57 | console.log(notebook);
58 | if (notebook) {
59 | editor.star_notebook(true, {notebook: notebook}).then(function() {
60 | editor.set_notebook_visibility(notebook.id, true);
61 |
62 | // highlight the node:
63 | editor.highlight_imported_notebooks(notebook);
64 | });
65 | }
66 |
67 | dialog.modal('hide');
68 | }
69 | );
70 | }
71 |
72 | var body = $('');
73 | var file_select = $('');
74 |
75 | file_select
76 | .click(function() {
77 | ui_utils.disable_bs_button(import_button);
78 | rmd_status.hide();
79 | file_select.val(null);
80 | })
81 | .change(function() {
82 | do_upload(file_select[0].files[0]);
83 | });
84 |
85 | rmd_status = $('');
86 | rmd_status.append(rmd_status);
87 |
88 | body.append($('').append(file_select))
89 | .append($('').append(rmd_status.hide()));
90 | var cancel = $('Cancel')
91 | .on('click', function() { $(dialog).modal('hide'); });
92 | import_button = $('Import')
93 | .on('click', do_import);
94 |
95 | ui_utils.disable_bs_button(import_button);
96 |
97 | var footer = $('')
98 | .append(cancel).append(import_button);
99 | var header = $(['