R/addins.R

In msberends/certedata: Tools for Data Analysis at Certe

# ==================================================================== #
# TITLE                                                                #
# Tools for Data Analysis at Certe                                     #
#                                                                      #
# AUTHORS                                                              #
# Berends MS (m.berends@certe.nl)                                      #
# Meijer BC (b.meijer@certe.nl)                                        #
# Hassing EEA (e.hassing@certe.nl)                                     #
#                                                                      #
# COPYRIGHT                                                            #
# (c) 2019 Certe Medische diagnostiek & advies - https://www.certe.nl  #
#                                                                      #
# LICENCE                                                              #
# This R package is free software; you can redistribute it and/or      #
# modify it under the terms of the GNU General Public License          #
# version 2.0, as published by the Free Software Foundation.           #
# This R package is distributed in the hope that it will be useful,    #
# but WITHOUT ANY WARRANTY; without even the implied warranty of       #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the         #
# GNU General Public License for more details.                         #
# ==================================================================== #

#' @noRd
#' @export
addin_library <- function() {
  library(certedata)
}

#' @noRd
#' @export
addin_open_trelloboard <- function() {
  trello_openboard()
}

#' @noRd
#' @export
addin_project_add <- function() {
  project_add()
}

#' @noRd
#' @export
addin_open_trellocard <- function() {
  trello_opencard()
}

#' @noRd
#' @export
addin_trello_edit <- function() {
  project_edit()
}

#' @noRd
#' @export
addin_insert_equalsexact <- function() {
  rstudioapi::insertText(" %===% ")
}

#' @noRd
#' @export
addin_timestamp <- function() {
  msg <- rstudioapi::showPrompt("Insert timestamp",
                                "Info about section:",
                                "")
  if (!is.null(msg)) {
    msg <- trimws(msg)
    initials <- Sys.getenv("R_USERNAME") %>%
      strsplit(" ") %>%
      unlist() %>%
      substr(1, 1) %>%
      concat()
    rstudioapi::insertText(
      paste(
        "\n#",
        initials,
        "|",
        Sys.time() %>% format2("ddd d mmmm yyyy HH:MM:SS"),
        "|",
        msg,
        "----\n"
      ) %>% gsub('  ', ' ', ., fixed = TRUE))
  }
}

#' @noRd
#' @export
auto_format_syntax <- function() {
  context <- rstudioapi::getSourceEditorContext()
  text <- context$selection[[1]]$text
  if (all(nchar(text) == 0)) {
    stop("No code selected")
  }
  text <- gsub("( |\n)*%>%( |\n)*", " %>%\n", text)
  text <- gsub("([,(]) *\n", "\\1", text)
  text <- gsub(" *, *([a-zA-Z]{3,255})", ",\n\\1", text)
  out <- styler::style_text(text)
  
  toinsert <- paste0(out[out != ""], collapse = "\n")
  toinsert <- gsub(" *\n *[)]", ")", toinsert)
  
  rstudioapi::modifyRange(location = context$selection[[1]]$range, 
                          text = toinsert,
                          id = context$id)
  
  context_new <- rstudioapi::getSourceEditorContext()
  new_range <- rstudioapi::document_range(start = context$selection[[1]]$range[[1]],
                                          end = context_new$selection[[1]]$range[[2]])
  rstudioapi::setSelectionRanges(ranges = new_range,
                                 id = context_new$id)
}