R/Making-Addins.R

Defines functions Save_pdf_png insert_math_variable_sized_square_brackets insert_math_variable_sized_curly_parenthesis insert_math_variable_sized_parenthesis insert_math_subscript insert_math_superscript latex_norm latex_absolute_value latex_glspl latex_gls latex_textgreaterless latex_left_right_corners latex_doubletextquotes latex_singletextquotes latex_mathcal latex_mathds latex_mathbf latex_textsubscript latex_textsuperscript latex_textit latex_textbf insert_double_quotation_mark insert_single_quotation_mark latex_verbatim_inline latex_verbatim latex_texttt insert_nbsp latex_cdot latex_xleftarrow latex_xrightarrow latex_Leftarrow latex_Rightarrow latex_leftarrow latex_rightarrow Mago_insert_before_first_selected_row ensure_blank_line is_blank_line_needed_below is_blank_line_needed_above get_context my_enclose_selection_with_03 my_enclose_selection_with_02 my_enclose_selection_with

Documented in my_enclose_selection_with

#' Mago's Private R Extension for Additional Functions or Add-ins
#'
#' Mago's Private R Extension for Additional Functions or Add-ins (Insert Some R, LaTeX, Markdown Commands).

my_enclose_selection_with <- function(symbol = "",
                                      symbol_before = symbol,
                                      symbol_after  = symbol,
                                      context = rstudioapi::getActiveDocumentContext()) {

  # For the first selection only
  sel <- context$selection[[1]]
  old_text <- sel$text
  Encoding(old_text) <- "UTF-8"

  new_text <- paste0(symbol_before, old_text, symbol_after)

  rstudioapi::insertText(location = sel$range,
                         text = as.character(new_text),
                         id = context$id)

  # If no text is selected, cursor is placed between the symbols.
  if (stringi::stri_isempty(old_text)) {
    rng <- sel$range
    rng[[1]]["column"] <- rng[[1]]["column"] + nchar(symbol_before)

    rstudioapi::setCursorPosition(position = rng[[1]], id = context$id)
  }
}


my_enclose_selection_with_02 <- function(symbol = "",
                                      symbol_before = symbol,
                                      symbol_after  = symbol,
                                      context = rstudioapi::getActiveDocumentContext()) {

  # For the first selection only
  sel <- context$selection[[1]]
  old_text <- sel$text
  Encoding(old_text) <- "UTF-8"

  new_text <- paste0(symbol_before, old_text, symbol_after)

  rstudioapi::insertText(location = sel$range,
                         text = as.character(new_text),
                         id = context$id)

  # If no text is selected, cursor is placed between the symbols.
  if (stringi::stri_isempty(old_text)) {
    rng <- sel$range
    rng[[1]]["column"] <- 0
    rng[[1]]["row"] <- rng[[1]]["row"]+1

    rstudioapi::setCursorPosition(position = rng[[1]], id = context$id)
  }
}

my_enclose_selection_with_03 <- function(symbol = "",
                                         symbol_before = symbol,
                                         symbol_after  = symbol,
                                         context = rstudioapi::getActiveDocumentContext()) {

  # For the first selection only
  sel <- context$selection[[1]]
  old_text <- sel$text
  Encoding(old_text) <- "UTF-8"

  new_text <- paste0(symbol_before, old_text, symbol_after)

  rstudioapi::insertText(location = sel$range,
                         text = as.character(new_text),
                         id = context$id)

  # If no text is selected, cursor is placed between the symbols.
  if (stringi::stri_isempty(old_text)) {
    rng <- sel$range
    rng[[1]]["column"] <- 0
    rng[[1]]["row"] <- rng[[1]]["row"]+2

    rstudioapi::setCursorPosition(position = rng[[1]], id = context$id)
  }
}


# 아래 부분은 spAddins 에서 가져옴. 아래의 명령어는 spAddin::으로 접근할 수 없음


# Shortcut for `rstudioapi::getActiveDocumentContext()`
get_context <- function() {
  rstudioapi::getActiveDocumentContext()
}
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Checks if a blank line should be added above the selection
is_blank_line_needed_above <- function(context = get_context()) {
  row <- rs_get_ind_first_selected_row(context)

  # Contents of row above the selection:
  txt <- context$contents[row - 1]
  # Remove spaces and check if string is empty:
  cond <- stringi::stri_isempty(gsub("[[:space:]]", "", txt))
  # If not empty (result: FALSE) and not the first row (result: logical(0)),
  # then an empty row needs to be added:
  isTRUE(!cond)
}
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Checks if a blank line should be added below either the selection or
# the first line of the selection.
# where = c("selection", "first line"):
#       "selection" - below whole selection;
#       "first line" - below the first line of the selection.
is_blank_line_needed_below <- function(where = c("selection",
                                                 "first line"),
                                       context = get_context()) {
  where <- match.arg(where)
  row <- switch(where,
                # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                "first line" = rs_get_ind_first_selected_row(context),
                # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                "selection" = rs_get_ind_last_selected_row(context),
                # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                stop("Incorrect choice of `where`"))

  # Contents of row below the selection:
  txt <- context$contents[row + 1]

  # If the last line is selected, a blank line should be added:
  if (is.na(txt)) {
    return(TRUE)
  }
  # Remove spaces and check if string is empty:
  cond <- stringi::stri_isempty(gsub("[[:space:]]", "", txt))
  # If not empty (result: FALSE), then an empty row needs to be added:
  isTRUE(!cond)
}
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ensure_blank_line <- function(text,
                              context = get_context(),
                              above = FALSE,
                              below_first = FALSE,
                              below_selection = FALSE) {
  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  if (above) {
    if (is_blank_line_needed_above(context)) {
      text <- paste0("\n", text)
    }
  }
  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Checks if blank is needed below the first selected line
  if (below_first) {
    if (is_blank_line_needed_below("first line", context)) {
      text <- paste0(text, "\n")
    }
  }
  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Checks if blank is needed below the all selection
  if (below_selection) {
    if (is_blank_line_needed_below("selection", context)) {
      text <- paste0(text, "\n")
    }
  }
  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  text
  # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
}


Mago_insert_before_first_selected_row <- function(text = "",
                                                ensure_blank_above = FALSE,
                                                context = get_context()) {

  row <- spAddins::rs_get_ind_first_selected_row(context)

  location <- list(start = c(row, 1),
                   end   = c(row, 1))
  class(location) <- "document_range"

  text <- ensure_blank_line(text, context, above = ensure_blank_above)

  rstudioapi::insertText(
    location = location,
    text = text,
    id = context$id
  )
}


# 위 부분은 spAddins 에서 가져옴. 위의 명령어는 spAddin::으로 접근할 수 없음


# latex_rightarrow <- function() {
#   rstudioapi::insertText("\\Ra\\")
# }

latex_rightarrow <- function() {
  rstudioapi::insertText("\\rightarrow")
}

# latex_leftarrow <- function() {
#   rstudioapi::insertText("\\La\\")
# }

latex_leftarrow <- function() {
  rstudioapi::insertText("\\leftarrow")
}

latex_Rightarrow <- function() {
  rstudioapi::insertText("\\Rightarrow")
}

latex_Leftarrow <- function() {
  rstudioapi::insertText("\\Leftarrow")
}

latex_xrightarrow <- function() {
  my_enclose_selection_with(symbol_before = "\\xrightarrow[]{",
                            symbol_after = "}")
}

latex_xleftarrow <- function() {
  my_enclose_selection_with(symbol_before = "\\xleftarrow[]{",
                            symbol_after = "}")
}

latex_cdot <- function() {
  rstudioapi::insertText("\\cd\\")
}

insert_nbsp <- function() {
  rstudioapi::insertText("&nbsp;")
}

latex_texttt <- function() {
  my_enclose_selection_with(symbol_before = "\\texttt{", symbol_after = "}")
}

latex_verbatim <- function() {
  my_enclose_selection_with_02(symbol_before = paste0("\\begin{verbatim}\n"),
                                      symbol_after = paste0("\n\\end{verbatim}"))
}

latex_verbatim_inline <- function() {
  my_enclose_selection_with(symbol_before = "\\verb!",
                                      symbol_after = "!")
}

insert_single_quotation_mark <- function() {
  my_enclose_selection_with(symbol_before = "`",
                                      symbol_after = "'")
}

insert_double_quotation_mark <- function() {
  my_enclose_selection_with(symbol_before = "``",
                                      symbol_after = "''")
}

latex_textbf <- function() {
  my_enclose_selection_with(symbol_before = "\\textbf{",
                                      symbol_after = "}")
}

latex_textit <- function() {
  my_enclose_selection_with(symbol_before = "\\textit{",
                                      symbol_after = "}")
}

latex_textsuperscript <- function() {
  my_enclose_selection_with(symbol_before = "\\textsuperscript{",
                            symbol_after = "}")
}

latex_textsubscript <- function() {
  my_enclose_selection_with(symbol_before = "\\textsubscript{",
                            symbol_after = "}")
}

latex_mathbf <- function() {
  my_enclose_selection_with(symbol_before = "\\mathbf{",
                                      symbol_after = "}")
}

latex_mathds <- function() {
  my_enclose_selection_with(symbol_before = "\\mathds{",
                            symbol_after = "}")
}

latex_mathcal <- function() {
  my_enclose_selection_with(symbol_before = "\\mathcal{",
                            symbol_after = "}")
}

latex_singletextquotes <- function() {
  my_enclose_selection_with(symbol_before = "\\sqm{",
                                      symbol_after = "}")
}

latex_doubletextquotes <- function() {
  my_enclose_selection_with(symbol_before = "\\dqm{",
                                      symbol_after = "}")
}

latex_left_right_corners <- function() {
  my_enclose_selection_with(symbol_before = "\\book{",
                            symbol_after = "}")
}

latex_textgreaterless <- function() {
  my_enclose_selection_with(symbol_before = "\\law{",
                                      symbol_after = "}")
}

latex_gls <- function() {
  my_enclose_selection_with(symbol_before = "\\gls{",
                                      symbol_after = "}")
}

latex_glspl <- function() {
  my_enclose_selection_with(symbol_before = "\\glspl{",
                                      symbol_after = "}")
}

latex_absolute_value <- function() {
  my_enclose_selection_with(symbol_before = "\\left\\lvert ",
                                      symbol_after = " \\right\\rvert")
}

latex_norm <- function() {
  my_enclose_selection_with(symbol_before = "\\left\\lVert ",
                                      symbol_after = " \\right\\rVert")
}

insert_math_superscript <- function() {
  my_enclose_selection_with(symbol_before = "^{",
                            symbol_after = "}")
}

insert_math_subscript <- function() {
  my_enclose_selection_with(symbol_before = "_{",
                            symbol_after = "}")
}

insert_math_variable_sized_parenthesis <- function() {
  my_enclose_selection_with(symbol_before = "\\left( ",
                            symbol_after = " \\right)")
}

insert_math_variable_sized_curly_parenthesis <- function() {
  my_enclose_selection_with(symbol_before = "\\left\\{ ",
                            symbol_after = " \\right\\}")
}

insert_math_variable_sized_square_brackets <- function() {
  my_enclose_selection_with(symbol_before = "\\left[ ",
                            symbol_after = " \\right]")
}


Save_pdf_png <- function(myplot,
                         myfilename,
                         category=NULL,
                         width=7,
                         height=5,
                         dpi=400,
                         family="NanumBarunGothic",
                         ...){
  if(!require(Cairo)){
    library(Cairo)
  }
  if(!require(ggplot2)){
    library(ggplot2)
  }

  path <- list(R="D:/20170814/R/R/figure/",
               Nuclear="D:/20170814/R/Nuclear/figure/",
               Skeleton="D:/20170814/Ph.D/01 The Draft of My Dissertation/skeleton/figure/",
               LaTeX="D:/20170814/R/LaTeX/figure/",
               EnergyEconomics="D:/20170814/R/Energy Economics/figure/",
               MathematicalEconomics="D:/20170814/R/Mathematical Economics/figure/"
  )
  list2env(path, parent.frame())

  myswitch <- category

  if(is.vector(myswitch)){

    print(paste0("The Current Working Directory is: ", getwd()))

    print(paste0("but the figure will be stored at ", category))

    # 위의 명령어들은 pdf 와 png 공통 적용 셋팅.


    # 아래는 cairo_pdf 로 저장.

    cairo_pdf(family = family,
              filename=paste0(category, myfilename, ".pdf", sep=""),
              width = width,
              height = height,
              ...)
    print(pryr::standardise_call(bquote(cairo_pdf(family = .(family),
                                                  filename=.(paste0(category, myfilename, ".pdf", sep="")),
                                                  width = .(width),
                                                  height = .(height)))))

    print(myplot)

    eval(expression(substitute(myplot)))

    dev.off()

    # 아래는 ggsave로 저장

    library(extrafont)
    fonts()
    loadfonts(device="win")

    ggsave(filename=paste0(category, myfilename, ".png", sep=""),
           plot=myplot,
           dpi = dpi,
           device='png',
           width = width,
           height = height,
           units = "in",
           family=family,
           ...)
    pryr::standardise_call(bquote(ggsave(filename=.(paste0(category, myfilename, ".png", sep="")),
                                         plot=.(eval(expression(substitute(myplot)))),
                                         dpi = .(dpi),
                                         device='png',
                                         width = .(width),
                                         height = .(height),
                                         units = "in",
                                         faimly=.(family))))

  } else {

    print(paste0("The Current Working Directory is: ", getwd()))

    print(paste0("and the figure will be stored at ", getwd(), "/figure/"))

    # 위의 명령어들은 pdf 와 png 공통 적용 셋팅.


    # 아래는 cairo_pdf 로 저장.

    cairo_pdf(family = family,
              filename=paste0(getwd(),"/figure/", myfilename, ".pdf", sep=""),
              width = width,
              height = height,
              ...)
    print(pryr::standardise_call(bquote(cairo_pdf(family = .(family),
                                                  filename=.(paste0(getwd(),"/figure/", myfilename, ".pdf", sep="")),
                                                  width = .(width),
                                                  height = .(height)))))
    print(myplot)

    eval(expression(substitute(myplot)))

    dev.off()

    # 아래는 ggsave로 저장

    library(extrafont)
    fonts()
    loadfonts(device="win")

    ggsave(filename=paste0(getwd(),"/figure/", myfilename, ".png", sep=""),
           plot=myplot,
           dpi = dpi,
           device='png',
           width = width,
           height = height,
           units = "in",
           family=family,
           ...)
    pryr::standardise_call(bquote(ggsave(filename=.(paste0(getwd(),"/figure/", myfilename, ".png", sep="")),
                                         plot=.(eval(expression(substitute(myplot)))),
                                         dpi = .(dpi),
                                         device='png',
                                         width = .(width),
                                         height = .(height),
                                         units = "in",
                                         family=.(family))))
  }
}

Save_pdf <- function(myplot,
                     myfilename,
                     category=NULL,
                     width=7,
                     height=5,
                     dpi=400,
                     family="NanumBarunGothic",
                     ...){
  if(!require(Cairo)){
    library(Cairo)
  }
  if(!require(ggplot2)){
    library(ggplot2)
  }

  path <- list(R="D:/20170814/R/R/figure/",
               Nuclear="D:/20170814/R/Nuclear/figure/",
               Skeleton="D:/20170814/Ph.D/01 The Draft of My Dissertation/skeleton/figure/",
               LaTeX="D:/20170814/R/LaTeX/figure/",
               EnergyEconomics="D:/20170814/R/Energy Economics/figure/",
               MathematicalEconomics="D:/20170814/R/Mathematical Economics/figure/"
  )
  list2env(path, parent.frame())

  myswitch <- category

  if(is.vector(myswitch)){

    print(paste0("The Current Working Directory is: ", getwd()))

    print(paste0("but the figure will be stored at ", category))

    # 위의 명령어들은 pdf 와 png 공통 적용 셋팅.


    # 아래는 cairo_pdf 로 저장.

    cairo_pdf(family = family,
              filename=paste0(category, myfilename, ".pdf", sep=""),
              width = width,
              height = height,
              ...)
    print(pryr::standardise_call(bquote(cairo_pdf(family = .(family),
                                                  filename=.(paste0(category, myfilename, ".pdf", sep="")),
                                                  width = .(width),
                                                  height = .(height)))))

    print(myplot)

    eval(expression(substitute(myplot)))

    dev.off()

  } else {

    print(paste0("The Current Working Directory is: ", getwd()))

    print(paste0("and the figure will be stored at ", getwd(), "/figure/"))

    # 위의 명령어들은 pdf 와 png 공통 적용 셋팅.


    # 아래는 cairo_pdf 로 저장.

    cairo_pdf(family = family,
              filename=paste0(getwd(),"/figure/", myfilename, ".pdf", sep=""),
              width = width,
              height = height,
              ...)
    print(pryr::standardise_call(bquote(cairo_pdf(family = .(family),
                                                  filename=.(paste0(getwd(),"/figure/", myfilename, ".pdf", sep="")),
                                                  width = .(width),
                                                  height = .(height)))))
    print(myplot)

    eval(expression(substitute(myplot)))

    dev.off()
    }
}


Save_png <- function(myplot,
                     myfilename,
                     category=NULL,
                     width=7,
                     height=5,
                     dpi=400,
                     family="NanumBarunGothic",
                     ...){
  if(!require(Cairo)){
    library(Cairo)
  }
  if(!require(ggplot2)){
    library(ggplot2)
  }

  path <- list(R="D:/20170814/R/R/figure/",
               Nuclear="D:/20170814/R/Nuclear/figure/",
               Skeleton="D:/20170814/Ph.D/01 The Draft of My Dissertation/skeleton/figure/",
               LaTeX="D:/20170814/R/LaTeX/figure/",
               EnergyEconomics="D:/20170814/R/Energy Economics/figure/",
               MathematicalEconomics="D:/20170814/R/Mathematical Economics/figure/"
  )
  list2env(path, parent.frame())

  myswitch <- category

  if(is.vector(myswitch)){

    print(paste0("The Current Working Directory is: ", getwd()))

    print(paste0("but the figure will be stored at ", category))

    # 위의 명령어들은 pdf 와 png 공통 적용 셋팅.

    # 아래는 ggsave로 저장


    library(extrafont)
    fonts()
    loadfonts(device="win")

    ggsave(filename=paste0(category, myfilename, ".png", sep=""),
           plot=myplot,
           dpi = dpi,
           device='png',
           width = width,
           height = height,
           units = "in",
           family=family,
           ...)
    pryr::standardise_call(bquote(ggsave(filename=.(paste0(category, myfilename, ".png", sep="")),
                                         plot=.(eval(expression(substitute(myplot)))),
                                         dpi = .(dpi),
                                         device='png',
                                         width = .(width),
                                         height = .(height),
                                         units = "in",
                                         family=.(family))))

  } else {

    print(paste0("The Current Working Directory is: ", getwd()))

    print(paste0("and the figure will be stored at ", getwd(), "/figure/"))

    # 위의 명령어들은 pdf 와 png 공통 적용 셋팅.

    # 아래는 ggsave로 저장


    library(extrafont)
    fonts()
    loadfonts(device="win")

    ggsave(filename=paste0(getwd(),"/figure/", myfilename, ".png", sep=""),
           plot=myplot,
           dpi = dpi,
           device='png',
           width = width,
           height = height,
           units = "in",
           ...)
    pryr::standardise_call(bquote(ggsave(filename=.(paste0(getwd(),"/figure/", myfilename, ".png", sep="")),
                                         plot=.(eval(expression(substitute(myplot)))),
                                         dpi = .(dpi),
                                         device='png',
                                         width = .(width),
                                         height = .(height),
                                         units = "in")))
  }
}


Save_tmap_pdf_png <- function(myplot,
                         myfilename,
                         category=NULL,
                         width=7,
                         height=5,
                         dpi=400,
                         family="NanumBarunGothic",
                         ...){
  if(!require(Cairo)){
    library(Cairo)
  }
  if(!require(ggplot2)){
    library(ggplot2)
  }

  path <- list(R="D:/20170814/R/R/figure/",
               Nuclear="D:/20170814/R/Nuclear/figure/",
               Skeleton="D:/20170814/Ph.D/01 The Draft of My Dissertation/skeleton/figure/",
               LaTeX="D:/20170814/R/LaTeX/figure/",
               EnergyEconomics="D:/20170814/R/Energy Economics/figure/",
               MathematicalEconomics="D:/20170814/R/Mathematical Economics/figure/"
  )
  list2env(path, parent.frame())

  myswitch <- category

  if(is.vector(myswitch)){

    print(paste0("The Current Working Directory is: ", getwd()))

    print(paste0("but the figure will be stored at ", category))

    # 위의 명령어들은 pdf 와 png 공통 적용 셋팅.


    # 아래는 cairo_pdf 로 저장.

    cairo_pdf(family = family,
              filename=paste0(category, myfilename, ".pdf", sep=""),
              width = width,
              height = height,
              ...)
    print(pryr::standardise_call(bquote(cairo_pdf(family = .(family),
                                                  filename=.(paste0(category, myfilename, ".pdf", sep="")),
                                                  width = .(width),
                                                  height = .(height)))))

    print(myplot)

    eval(expression(substitute(myplot)))

    dev.off()

    # 아래는 tmap_save로 저장

    library(extrafont)
    fonts()
    loadfonts(device="win")

    tmap_save(tm=myplot,
              filename=paste0(category, myfilename, ".png", sep=""),
               dpi = dpi,
               # device='png',
               width = width,
               height = height,
               units = "in")
    pryr::standardise_call(bquote(tmap_save(tm=.(eval(expression(substitute(myplot)))),
                                         filename=.(paste0(category, myfilename, ".png", sep="")),
                                         dpi = .(dpi),
                                         device='png',
                                         width = .(width),
                                         height = .(height),
                                         units = "in")))

  } else {

    print(paste0("The Current Working Directory is: ", getwd()))

    print(paste0("and the figure will be stored at ", getwd(), "/figure/"))

    # 위의 명령어들은 pdf 와 png 공통 적용 셋팅.


    # 아래는 cairo_pdf 로 저장.

    cairo_pdf(family = family,
              filename=paste0(getwd(),"/figure/", myfilename, ".pdf", sep=""),
              width = width,
              height = height,
              ...)
    print(pryr::standardise_call(bquote(cairo_pdf(family = .(family),
                                                  filename=.(paste0(getwd(),"/figure/", myfilename, ".pdf", sep="")),
                                                  width = .(width),
                                                  height = .(height)))))
    print(myplot)

    eval(expression(substitute(myplot)))

    dev.off()

    # 아래는 tmap_save로 저장

    library(extrafont)
    fonts()
    loadfonts(device="win")

    tmap_save(tm=myplot,
              filename=paste0(category, myfilename, ".png", sep=""),
              dpi = dpi,
              # device='png',
              width = width,
              height = height,
              units = "in",
              ...)
    pryr::standardise_call(bquote(tmap_save(tm=.(eval(expression(substitute(myplot)))),
                                         filename=.(paste0(category, myfilename, ".png", sep="")),
                                         dpi = .(dpi),
                                         device='png',
                                         width = .(width),
                                         height = .(height),
                                         units = "in")))
  }
}


Save_tmap_png <- function(myplot,
                              myfilename,
                              category=NULL,
                              width=7,
                              height=5,
                              dpi=400,
                          ...){
  if(!require(Cairo)){
    library(Cairo)
  }
  if(!require(ggplot2)){
    library(ggplot2)
  }

  path <- list(R="D:/20170814/R/R/figure/",
               Nuclear="D:/20170814/R/Nuclear/figure/",
               Skeleton="D:/20170814/Ph.D/01 The Draft of My Dissertation/skeleton/figure/",
               LaTeX="D:/20170814/R/LaTeX/figure/",
               EnergyEconomics="D:/20170814/R/Energy Economics/figure/",
               MathematicalEconomics="D:/20170814/R/Mathematical Economics/figure/"
  )
  list2env(path, parent.frame())

  myswitch <- category

  if(is.vector(myswitch)){

    print(paste0("The Current Working Directory is: ", getwd()))

    print(paste0("but the figure will be stored at ", category))

    # 위의 명령어들은 pdf 와 png 공통 적용 셋팅.

    # 아래는 tmap_save로 저장

    library(extrafont)
    fonts()
    loadfonts(device="win")

    tmap_save(tm=myplot,
              filename=paste0(category, myfilename, ".png", sep=""),
              dpi = dpi,
              # device='png',
              width = width,
              height = height,
              units = "in",
              ...)
    pryr::standardise_call(bquote(tmap_save(tm=.(eval(expression(substitute(myplot)))),
                                         filename=.(paste0(category, myfilename, ".png", sep="")),
                                         dpi = .(dpi),
                                         device='png',
                                         width = .(width),
                                         height = .(height),
                                         units = "in")))

  } else {

    print(paste0("The Current Working Directory is: ", getwd()))

    print(paste0("and the figure will be stored at ", getwd(), "/figure/"))

    # 위의 명령어들은 pdf 와 png 공통 적용 셋팅.

    # 아래는 tmap_save로 저장

    library(extrafont)
    fonts()
    loadfonts(device="win")

    tmap_save(tm=myplot,
              filename=paste0(category, myfilename, ".png", sep=""),
              dpi = dpi,
              # device='png',
              width = width,
              height = height,
              units = "in",
              ...)
    pryr::standardise_call(bquote(tmap_save(tm=.(eval(expression(substitute(myplot)))),
                                         filename=.(paste0(category, myfilename, ".png", sep="")),
                                         dpi = .(dpi),
                                         device='png',
                                         width = .(width),
                                         height = .(height),
                                         units = "in")))
  }
}



insert_math_inline <- function() {
  my_enclose_selection_with(symbol_before = "$",
                            symbol_after = "$")
}

latex_equation_environment <- function() {
  my_enclose_selection_with_02(symbol_before = paste0("\\begin{align}\n"),
                                      symbol_after = paste0("\n\\end{align}"))
}

latex_equation_environment_starred <- function() {
  my_enclose_selection_with_02(symbol_before = paste0("\\begin{align*}\n"),
                               symbol_after = paste0("\n\\end{align*}"))
}



latex_insert_todonote_01 <- function() {
  my_enclose_selection_with(symbol_before = paste0("\\todonew[inline, nolist]{Definition}{\\textbf{The Definition of } \\\\ \\textcolor{black!40}{\\rule[4pt]{\\textwidth}{0.1mm}} \\\\ "),
                                      symbol_after = paste0("\\hyperlink{todo\\thetodoListItems}{$\\Uparrow$}}"))
}

latex_insert_todonote_02 <- function() {
  my_enclose_selection_with(symbol_before = paste0("\\todonew[noline, inline, nolist, color=Coral2]{Coral2}{\\textbf{Coral2 todonotes }  \\\\ \\textcolor{black}{\\rule[4pt]{\\textwidth}{0.1mm}} \\\\ "),
                                      symbol_after = paste0("\\hyperlink{todo\\thetodoListItems}{$\\Uparrow$}}"))
}

latex_insert_todonote_03 <- function() {
  my_enclose_selection_with(symbol_before = paste0("\\todonew[noline, inline, nolist, color=SteelBlue2]{SteelBlue2}{\\textbf{SteelBlue2 todonotes }  \\\\ \\textcolor{black}{\\rule[4pt]{\\textwidth}{0.1mm}} \\\\ "),
                                      symbol_after = paste0("\\hyperlink{todo\\thetodoListItems}{$\\Uparrow$}}"))
}

latex_insert_todonote_04 <- function() {
  my_enclose_selection_with(symbol_before = paste0("\\todonew[noline, inline, nolist, color=OliveDrab2]{OliveDrab2}{\\textbf{OliveDrab2 todonotes }  \\\\ \\textcolor{black}{\\rule[4pt]{\\textwidth}{0.1mm}} \\\\ "),
                                      symbol_after = paste0("\\hyperlink{todo\\thetodoListItems}{$\\Uparrow$}}"))
}

latex_insert_todonote_05 <- function() {
  my_enclose_selection_with(symbol_before = paste0("\\marginnote{\\caution[t][BrickRed][\\ifmykoreanswitch 주의! \\else Attention! \\fi]{"),
                                      symbol_after = paste0("}}"))
}

latex_insert_todonote_06 <- function() {
  my_enclose_selection_with(symbol_before = paste0("\\marginnote{\\caution[t][cyan!80!black][\\ifmykoreanswitch 검토! \\else Consider! \\fi]{"),
                                      symbol_after = paste0("}}"))
}

latex_insert_todonote_07 <- function() {
  my_enclose_selection_with(symbol_before = paste0("\\marginnote{\\caution[t][ForestGreen][\\ifmykoreanswitch 참고! \\else Refer! \\fi]{"),
                                      symbol_after = paste0("}}"))
}

latex_insert_math_formula_todonote_08 <- function() {
  my_enclose_selection_with_02(symbol_before = paste0("\\todonew[noline, inline]{Math Formula}{\n"),
                            symbol_after = paste0(" \\\\
\\hyperlink{todo\\thetodoListItems}{$\\Uparrow$}}"))
  }

latex_case_items <- function() {
  rstudioapi::insertText("\\begin{flushleft}
\\setlength{\\mathindent}{0cm}
\\begin{equation*}
\\begin{minipage}[t][][t]{\\widthof{A: }} A: \\end{minipage}
\\begin{cases}
& \\begin{minipage}[t][][t]{0.8\\textwidth} \\textbullet\\ a,\\end{minipage} \\\\
& \\begin{minipage}[t][][t]{0.8\\textwidth} \\textbullet\\ b,\\end{minipage} \\\\
& \\begin{minipage}[t][][t]{0.8\\textwidth} \\textbullet\\ c,\\end{minipage}
\\end{cases}
\\end{equation*}
\\end{flushleft}")
}

latex_math_where <- function() {
  rstudioapi::insertText("\\begin{flushleft}
\\setlength{\\mathindent}{0.5cm}
where,
\\begin{equation*}
\\left\\lbrace
\\begin{array}{lll}
설명대상1   &:& \\begin{minipage}[t][][t]{0.7\\textwidth} 내용1,\\end{minipage} \\\\
설명대상2   &:& \\begin{minipage}[t][][t]{0.7\\textwidth} 내용2,\\end{minipage} \\\\
설명대상3   &:& \\begin{minipage}[t][][t]{0.7\\textwidth} 내용3,\\end{minipage}
\\end{array}\\right.
\\end{equation*}
\\end{flushleft}")
}


latex_url <- function() {
  my_enclose_selection_with(symbol_before = "\\url{", symbol_after = "}")
}



latex_alpha <- function() {
  rstudioapi::insertText("\\alpha")
}

latex_beta <- function() {
  rstudioapi::insertText("\\beta")
}

latex_gamma <- function() {
  rstudioapi::insertText("\\gamma")
}

latex_delta <- function() {
  rstudioapi::insertText("\\delta")
}

latex_epsilon <- function() {
  rstudioapi::insertText("\\varepsilon")
}

latex_zeta <- function() {
  rstudioapi::insertText("\\zeta")
}

latex_eta <- function() {
  rstudioapi::insertText("\\eta")
}

latex_theta <- function() {
  rstudioapi::insertText("\\theta")
}

latex_iota <- function() {
  rstudioapi::insertText("\\iota")
}

latex_kappa <- function() {
  rstudioapi::insertText("\\kappa")
}

latex_lambda <- function() {
  rstudioapi::insertText("\\lambda")
}

latex_mu <- function() {
  rstudioapi::insertText("\\mu")
}

latex_nu <- function() {
  rstudioapi::insertText("\\nu")
}

latex_xi <- function() {
  rstudioapi::insertText("\\xi")
}

latex_omikron <- function() {
  rstudioapi::insertText("\\omikron")
}

latex_pi <- function() {
  rstudioapi::insertText("\\pi")
}

latex_rho <- function() {
  rstudioapi::insertText("\\rho")
}

latex_sigma <- function() {
  rstudioapi::insertText("\\sigma")
}

latex_tau <- function() {
  rstudioapi::insertText("\\tau")
}

latex_upsilon <- function() {
  rstudioapi::insertText("\\upsilon")
}

latex_phi <- function() {
  rstudioapi::insertText("\\phi")
}

latex_chi <- function() {
  rstudioapi::insertText("\\chi")
}

latex_psi <- function() {
  rstudioapi::insertText("\\psi")
}

latex_omega <- function() {
  rstudioapi::insertText("\\omega")
}



latex_Alpha <- function() {
  rstudioapi::insertText("\\Alpha")
}

latex_Beta <- function() {
  rstudioapi::insertText("\\Beta")
}

latex_Gamma <- function() {
  rstudioapi::insertText("\\Gamma")
}

latex_Delta <- function() {
  rstudioapi::insertText("\\Delta")
}

latex_Epsilon <- function() {
  rstudioapi::insertText("\\Epsilon")
}

latex_Zeta <- function() {
  rstudioapi::insertText("\\Zeta")
}

latex_Eta <- function() {
  rstudioapi::insertText("\\Eta")
}

latex_Theta <- function() {
  rstudioapi::insertText("\\Theta")
}

latex_Iota <- function() {
  rstudioapi::insertText("\\Iota")
}

latex_Kappa <- function() {
  rstudioapi::insertText("\\Kappa")
}

latex_Lambda <- function() {
  rstudioapi::insertText("\\Lambda")
}

latex_Mu <- function() {
  rstudioapi::insertText("\\Mu")
}

latex_Nu <- function() {
  rstudioapi::insertText("\\Nu")
}

latex_Xi <- function() {
  rstudioapi::insertText("\\Xi")
}

latex_Omikron <- function() {
  rstudioapi::insertText("\\Omikron")
}

latex_Pi <- function() {
  rstudioapi::insertText("\\Pi")
}

latex_Rho <- function() {
  rstudioapi::insertText("\\Rho")
}

latex_Sigma <- function() {
  rstudioapi::insertText("\\Sigma")
}

latex_Tau <- function() {
  rstudioapi::insertText("\\Tau")
}

latex_Upsilon <- function() {
  rstudioapi::insertText("\\Upsilon")
}

latex_Phi <- function() {
  rstudioapi::insertText("\\Phi")
}

latex_Chi <- function() {
  rstudioapi::insertText("\\Chi")
}

latex_Psi <- function() {
  rstudioapi::insertText("\\Psi")
}

latex_Omega <- function() {
  rstudioapi::insertText("\\Omega")
}

# Ctrl+Alt+Shift+g
Greek <- function(){
  number <- seq(1:24)
  lowercase <- c('\u03b1', "\u03b2", "\u03b3", "\u03b4", "\u03b5", "\u03b6",
                 "\u03b7", "\u03b8", "\u03b9", "\u03ba", "\u03bb", "\u03bc",
                 "\u03bd", "\u03be", "\u03bf", "\u03c0", "\u03c1", "\u03c3",
                 "\u03c4", "\u03c5", "\u03c6", "\u03c7", "\u03c8", "\u03c9")
  lowercase_LaTeX <- c("\\alpha", "\\beta", "\\gamma", "\\delta", "\\epsilon", "\\zeta",
                  "\\eta", "\\theta", "\\iota", "\\kappa", "\\lambda", "\\mu",
                  "\\nu", "\\xi", "\\omikron", "\\pi", "\\rho", "\\sigma",
                  "\\tau", "\\upsilon", "\\phi", "\\chi", "\\psi", "\\omega")
  lowercase_unicode <- c('\\u03b1', "\\u03b2", "\\u03b3", "\\u03b4", "\\u03b5", "\\u03b6",
                         "\\u03b7", "\\u03b8", "\\u03b9", "\\u03ba", "\\u03bb", "\\u03bc",
                         "\\u03bd", "\\u03be", "\\u03bf", "\\u03c0", "\\u03c1", "\\u03c3",
                         "\\u03c4", "\\u03c5", "\\u03c6", "\\u03c7", "\\u03c8", "\\u03c9")
  uppercase <- c("\u0391", "\u0392", "\u0393", "\u0394", "\u0395", "\u0396",
                 "\u0397", "\u0398", "\u0399", "\u039a", "\u039b", "\u039c",
                 "\u039d", "\u039e", "\u039f", "\u03a0", "\u03a1", "\u03a3",
                 "\u03a4", "\u03a5", "\u03a6", "\u03a7", "\u03a8", "\u03a9")

  uppercase_LaTeX <- c("\\Alpha", "\\Beta", "\\Gamma", "\\Delta", "\\Epsilon", "\\Zeta",
                       "\\Eta", "\\Theta", "\\Iota", "\\Kappa", "\\Lambda", "\\Mu",
                       "\\Nu", "\\Xi", "\\Omikron", "\\Pi", "\\Rho", "\\Sigma",
                       "\\Tau", "\\Upsilon", "\\Phi", "\\Chi", "\\Psi", "\\Omega")
  uppercase_unicode <- c("\\u0391", "\\u0392", "\\u0393", "\\u0394", "\\u0395", "\\u0396",
                         "\\u0397", "\\u0398", "\\u0399", "\\u039a", "\\u039b", "\\u039c",
                         "\\u039d", "\\u039e", "\\u039f", "\\u03a0", "\\u03a1", "\\u03a3",
                         "\\u03a4", "\\u03a5", "\\u03a6", "\\u03a7", "\\u03a8", "\\u03a9")
  Greek_table <- data.frame(number,
                            lowercase,
                            lowercase_LaTeX,
                            lowercase_unicode,
                            uppercase,
                            uppercase_LaTeX,
                            uppercase_unicode)

  assign("Greek_table", Greek_table, envir = parent.frame())

  Greek_list <- list(number=number,
                     lowercase=lowercase,
                     lowercase_LaTeX=lowercase_LaTeX,
                     lowercase_unicode=lowercase_unicode,
                     uppercase=uppercase,
                     uppercase_LaTeX=uppercase_LaTeX,
                     uppercase_unicode=uppercase_unicode)

  a_list <- list(Greek_list=Greek_list)

  list2env(a_list, parent.frame())

  View(Greek_table)
}

latex_Roman_uppercase_number <- function() {
  my_enclose_selection_with(symbol_before = "\\Rnum{", symbol_after = "}")
}

latex_Roman_lowercase_number <- function() {
  my_enclose_selection_with(symbol_before = "\\rnum{", symbol_after = "}")
}

insert_LaTeX_math_lvec <- function() {
  my_enclose_selection_with(symbol_before = "\\lvec[n]{x", symbol_after = "}")
}

insert_LaTeX_math_lidx <- function() {
  my_enclose_selection_with(symbol_before = "\\lidx[n]{i", symbol_after = "}")
}

latex_blank_lines <- function(context=rstudioapi::getActiveDocumentContext()) {
  # For the first selection only
  sel <- context$selection[[1]]
  old_text <- sel$text
  Encoding(old_text) <- "UTF-8"

  rstudioapi::insertText("\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n")

  # If no text is selected, cursor is placed between the symbols.
  if (stringi::stri_isempty(old_text)) {
    rng <- sel$range
    rng[[1]]["column"] <- rng[[1]]["column"]

    rstudioapi::setCursorPosition(position = rng[[1]], id = context$id)
  }
}

insert_LaTeX_math_times <- function() {
  rstudioapi::insertText("\\times ")
}

insert_LaTeX_math_division <- function() {
  my_enclose_selection_with(symbol_before = "\\frac{",
                            symbol_after = "}{}")
}

insert_LaTeX_math_summation <- function() {
  rstudioapi::insertText("\\sum_{i = 1}^{n} ")
}

insert_LaTeX_math_product <- function() {
  rstudioapi::insertText("\\prod_{i = 1}^{n} ")
}

insert_LaTeX_math_hat <- function() {
  my_enclose_selection_with(symbol_before = "\\hat{",
                            symbol_after = "}")
}

insert_LaTeX_math_tilde <- function() {
  my_enclose_selection_with(symbol_before = "\\tilde{",
                            symbol_after = "}")
}

insert_LaTeX_math_bar <- function() {
  my_enclose_selection_with(symbol_before = "\\bar{",
                            symbol_after = "}")
}

insert_LaTeX_math_text <- function() {
  my_enclose_selection_with(symbol_before = "\\text{",
                            symbol_after = "}")
}

insert_tabular_environment <- function() {
  my_enclose_selection_with(symbol_before = "\\begin{tabular}[c]{@{}l@{}}",
                            symbol_after = "\\end{tabular}")
}


path <- function(x=NULL){
  R <- "D:/20170814/R/R/figure/";
  Nuclear <- "D:/20170814/R/Nuclear/figure/";
  Skeleton <- "D:/20170814/Ph.D/01 The Draft of My Dissertation/skeleton/figure/";
  LaTeX <- "D:/20170814/R/LaTeX/figure/";
  EnergyEconomics <- "D:/20170814/R/Energy Economics/figure/";
  MathematicalEconomics <- "D:/20170814/R/Mathematical Economics/figure/"

  assign("R", R, envir = parent.frame())
  assign("Nuclear", Nuclear, envir = parent.frame())
  assign("Skeleton", Skeleton, envir = parent.frame())
  assign("LaTeX", LaTeX, envir = parent.frame())
  assign("EnergyEconomics", EnergyEconomics, envir = parent.frame())
  assign("MathematicalEconomics", MathematicalEconomics, envir = parent.frame())

  if (!is.null(x)){
    print(x)
  }
}


# Multiple plot function
#
# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
# - cols:   Number of columns in layout
# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
#
# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
# then plot 1 will go in the upper left, 2 will go in the upper right, and
# 3 will go all the way across the bottom.
#
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  library(grid)

  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)

  numPlots = length(plots)

  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                     ncol = cols, nrow = ceiling(numPlots/cols))
  }

  if (numPlots==1) {
    print(plots[[1]])

  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))

    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))

      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}
############################################################################

# edit_snippets 함수 버전: 1
# Ctrl+Alt+Shift+s
# edit_snippets <- function(){
#   rstudioapi::callFun("sendToConsole", "file.edit(paste0(path.expand('~'),'/.R/snippets/markdown.snippets'))")
# }


# edit_snippets 함수 버전: 2
# Ctrl+Alt+Shift+s
# edit_snippets <- function(){
#   library(svDialogs)
#   # subject <- dlgInput("Which snippets?: ", default="markdown")$res
#   subject <- dlgInput.gui("Which snippets?: ", default="markdown", gui= .GUI)$res
#   myfile <- paste0(path.expand('~'),'/.R/snippets/',subject,'.snippets')
#   rstudioapi::callFun("sendToConsole", paste0(file.edit(myfile)))
# }


# edit_snippets 함수 버전: 3
# Ctrl+Alt+Shift+s
edit_snippets <- function(){
  choices <- c("r", "markdown", "tex")
  subject <- select.list(choices,
                         preselect = "markdown",
                         multiple = FALSE,
                         title = "Which snippets?",
                         graphics = TRUE)
  if (!nchar(subject)) {
  } else {
    myfile <- paste0(path.expand('~'),'/.R/snippets/',subject,'.snippets')
    rstudioapi::callFun("sendToConsole", paste0(file.edit(myfile)))
  }
}

# Ctrl+Alt+Shift+f
edit_files <- function(){
  path_file_list <- list("default_desktop" = "C:/Users/smlee/Documents/R/win-library/3.6/rmarkdown/rmd/latex/default-1.17.0.2.tex",
                         "default_cloud" = "~/R/x86_64-pc-linux-gnu-library/3.6/rmarkdown/rmd/latex/default-1.17.0.2.tex",
                         "addin_shortcuts" = "~/.R/rstudio/keybindings/addins.json")
  choices <- c("default_desktop", "default_cloud", "addin_shortcuts")
  subject <- select.list(choices,
                         preselect = "default_desktop",
                         multiple = FALSE,
                         title = "Which file??",
                         graphics = TRUE)
  if (!nchar(subject)) {
  } else {
    myfile <- path_file_list[[subject]] # 리스트에서 이름에 대응하는 값만을 추출하기 위해 [[]] 사용.
    cat(paste(rep("=", 60), collapse =""), "\n")
    cat(crayon::bgBlue(paste0("file.edit(", myfile, ")")), "\n")
    rstudioapi::callFun("sendToConsole", paste0(file.edit(myfile)))
  }
}

# Ctrl++
header_level_increase <- function(){
  thisSourceEditor <- rstudioapi::getSourceEditorContext()

  # thisSourceEditor$selection[[1]]$range$start["row"] # 선택된 줄의 index

  # thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]] # 선택된 줄의 내용

  # substr(thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]], 1, 1) # 선택된 줄의 첫 문자

  if (identical(substr(thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]], 1, 1), "#")) {
    spAddins::rs_insert_at_row_start(row=thisSourceEditor$selection[[1]]$range$start["row"],
                                     text="#")
  }
  else {
    spAddins::rs_insert_at_row_start(row=thisSourceEditor$selection[[1]]$range$start["row"],
                                     text="# ")
  }
}

# Ctrl+Alt++
header_level_decrease <- function(){
  thisSourceEditor <- rstudioapi::getSourceEditorContext()

  # thisSourceEditor$selection[[1]]$range$start["row"]

  # thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]

  # substr(thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]], 1, 1)

  if (identical(substr(thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]], 1, 1), "#")) {
    sel <- thisSourceEditor$selection[[1]]
    old_text  <- thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]
    Encoding(old_text) <- "UTF-8"
    new_text <- trimws(sub("^.", "", old_text), "l")
    sel$range$start["column"] <- 1
    sel$range$end["column"] <- Inf
    rstudioapi::modifyRange(location = sel$range,
                            text = as.character(new_text),
                            id = thisSourceEditor$id)
  }
  else { if (identical(substr(thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]], 1, 1), " ")) {
    sel <- thisSourceEditor$selection[[1]]
    old_text  <- thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]
    Encoding(old_text) <- "UTF-8"
    new_text <- trimws(old_text, "l")
    sel$range$start["column"] <- 1
    sel$range$end["column"] <- Inf
    rstudioapi::modifyRange(location = sel$range,
                            text = as.character(new_text),
                            id = thisSourceEditor$id)
  }
  }
}

# 아래 명령어는 R Session이 시작된 후에 처음 한 번만 잘 작동함. 원인은 모르겠음.
insert_docsum <- function(){
  my_enclose_selection_with(symbol_before = "docsum")
KeyboardSimulator::keybd.press("Shift", hold=TRUE)
KeyboardSimulator::keybd.press("Tab")
KeyboardSimulator::keybd.release("Shift")
KeyboardSimulator::keybd.release("Tab")
}

# Ctrl+Alt+-
make_header_unnumbered <- function(){
  thisSourceEditor <- rstudioapi::getSourceEditorContext()

  # thisSourceEditor$selection[[1]]$range$start["row"]

  # thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]

  sel <- thisSourceEditor$selection[[1]]
  old_text  <- thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]
  Encoding(old_text) <- "UTF-8"
  old_text <- trimws(old_text, "r")

  last_three_characters <- substr(old_text,
         stringi::stri_length(old_text)-2,
         stringi::stri_length(old_text))

  if (identical(last_three_characters, "{-}")) {

  }
  else {
    new_text <- paste0(old_text, " {-}")
    sel$range$start["column"] <- 1
    sel$range$end["column"] <- Inf
    rstudioapi::modifyRange(location = sel$range,
                            text = as.character(new_text),
                            id = thisSourceEditor$id)
  }
}

# Ctrl+Alt+Shift+-
make_header_back_to_numbered <- function(){
  thisSourceEditor <- rstudioapi::getSourceEditorContext()

  # thisSourceEditor$selection[[1]]$range$start["row"]

  # thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]

  sel <- thisSourceEditor$selection[[1]]
  old_text  <- thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]
  Encoding(old_text) <- "UTF-8"
  old_text <- trimws(old_text, "r")

  last_three_characters <- substr(old_text,
                                  stringi::stri_length(old_text)-2,
                                  stringi::stri_length(old_text))

  if (identical(last_three_characters, "{-}")) {
    new_text <- trimws(substr(old_text,
                       1,
                       stringi::stri_length(old_text)-3), "r")
    sel$range$start["column"] <- 1
    sel$range$end["column"] <- Inf
    rstudioapi::modifyRange(location = sel$range,
                            text = as.character(new_text),
                            id = thisSourceEditor$id)
  }
}

# Ctrl+Alt+h
add_header_symbols_multiple_lines <- function(){
  CurrentSourceEditor <- rstudioapi::getSourceEditorContext() # 현재 script의 정보를 저장.
  row_number <- c(CurrentSourceEditor$selection[[1]]$range$start[[1]]:CurrentSourceEditor$selection[[1]]$range$end[[1]])
  input_header_level <- svDialogs::dlgInput("Header Level (the number of #)?", default="#")$res # Prefix는 사용자 입력으로.
  for (i in 1:length(row_number)){
    spAddins::rs_insert_at_row_start(row_number[i], paste0(input_header_level, " "))
  }
}

# Ctrl+1 (keypad)
modified_rmd_heading_1 <- function(){
  thisSourceEditor <- rstudioapi::getSourceEditorContext()
  row_number <- c(thisSourceEditor$selection[[1]]$range$start[[1]]:thisSourceEditor$selection[[1]]$range$end[[1]])
  sel <- thisSourceEditor$selection[[1]]
  old_text  <- thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]
  Encoding(old_text) <- "UTF-8"
  old_text <- trimws(old_text, "l")

  if (stringr::str_detect(old_text, "^#{1,}?")) {
    if (stringr::str_detect(old_text, "^# ")) {
      new_text <- trimws(stringr::str_remove(old_text, "^#+"), "l")
      sel$range$start["column"] <- 1
      sel$range$end["column"] <- Inf
      rstudioapi::modifyRange(location = sel$range,
                              text = as.character(new_text),
                              id = thisSourceEditor$id)
    }
    else {
      new_text <- paste0("\n# ", trimws(stringr::str_remove(old_text, "^#+"), "l"))
      sel$range$start["column"] <- 1
      sel$range$end["column"] <- Inf
      rstudioapi::modifyRange(location = sel$range,
                              text = as.character(new_text),
                              id = thisSourceEditor$id)
    }
  }
  else {
    new_text <- paste0("\n# ", old_text)
    sel$range$start["column"] <- 1
    sel$range$end["column"] <- Inf
    rstudioapi::modifyRange(location = sel$range,
                            text = as.character(new_text),
                            id = thisSourceEditor$id)
  }
}

# Ctrl+2 (keypad)
modified_rmd_heading_2 <- function(){
  thisSourceEditor <- rstudioapi::getSourceEditorContext()

  sel <- thisSourceEditor$selection[[1]]
  old_text  <- thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]
  Encoding(old_text) <- "UTF-8"
  old_text <- trimws(old_text, "l")

  if (stringr::str_detect(old_text, "^#{1,}?")) {
    if (stringr::str_detect(old_text, "^## ")) {
      new_text <- trimws(stringr::str_remove(old_text, "^#+"), "l")
      sel$range$start["column"] <- 1
      sel$range$end["column"] <- Inf
      rstudioapi::modifyRange(location = sel$range,
                              text = as.character(new_text),
                              id = thisSourceEditor$id)
    }
    else {
      new_text <- paste0("\n## ", trimws(stringr::str_remove(old_text, "^#+"), "l"))
      sel$range$start["column"] <- 1
      sel$range$end["column"] <- Inf
      rstudioapi::modifyRange(location = sel$range,
                              text = as.character(new_text),
                              id = thisSourceEditor$id)
    }
  }
  else {
    new_text <- paste0("\n## ", old_text)
    sel$range$start["column"] <- 1
    sel$range$end["column"] <- Inf
    rstudioapi::modifyRange(location = sel$range,
                            text = as.character(new_text),
                            id = thisSourceEditor$id)
  }
}

# Ctrl+3 (keypad)
modified_rmd_heading_3 <- function(){
  thisSourceEditor <- rstudioapi::getSourceEditorContext()

  sel <- thisSourceEditor$selection[[1]]
  old_text  <- thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]
  Encoding(old_text) <- "UTF-8"
  old_text <- trimws(old_text, "l")

  if (stringr::str_detect(old_text, "^#{1,}?")) {
    if (stringr::str_detect(old_text, "^### ")) {
      new_text <- trimws(stringr::str_remove(old_text, "^#+"), "l")
      sel$range$start["column"] <- 1
      sel$range$end["column"] <- Inf
      rstudioapi::modifyRange(location = sel$range,
                              text = as.character(new_text),
                              id = thisSourceEditor$id)
    }
    else {
      new_text <- paste0("\n### ", trimws(stringr::str_remove(old_text, "^#+"), "l"))
      sel$range$start["column"] <- 1
      sel$range$end["column"] <- Inf
      rstudioapi::modifyRange(location = sel$range,
                              text = as.character(new_text),
                              id = thisSourceEditor$id)
    }
  }
  else {
    new_text <- paste0("\n### ", old_text)
    sel$range$start["column"] <- 1
    sel$range$end["column"] <- Inf
    rstudioapi::modifyRange(location = sel$range,
                            text = as.character(new_text),
                            id = thisSourceEditor$id)
  }
}

# Ctrl+4 (keypad)
modified_rmd_heading_4 <- function(){
  thisSourceEditor <- rstudioapi::getSourceEditorContext()

  sel <- thisSourceEditor$selection[[1]]
  old_text  <- thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]
  Encoding(old_text) <- "UTF-8"
  old_text <- trimws(old_text, "l")

  if (stringr::str_detect(old_text, "^#{1,}?")) {
    if (stringr::str_detect(old_text, "^#### ")) {
      new_text <- trimws(stringr::str_remove(old_text, "^#+"), "l")
      sel$range$start["column"] <- 1
      sel$range$end["column"] <- Inf
      rstudioapi::modifyRange(location = sel$range,
                              text = as.character(new_text),
                              id = thisSourceEditor$id)
    }
    else {
      new_text <- paste0("\n#### ", trimws(stringr::str_remove(old_text, "^#+"), "l"))
      sel$range$start["column"] <- 1
      sel$range$end["column"] <- Inf
      rstudioapi::modifyRange(location = sel$range,
                              text = as.character(new_text),
                              id = thisSourceEditor$id)
    }
  }
  else {
    new_text <- paste0("\n#### ", old_text)
    sel$range$start["column"] <- 1
    sel$range$end["column"] <- Inf
    rstudioapi::modifyRange(location = sel$range,
                            text = as.character(new_text),
                            id = thisSourceEditor$id)
  }
}

# Ctrl+5 (keypad)
modified_rmd_heading_5 <- function(){
  thisSourceEditor <- rstudioapi::getSourceEditorContext()

  sel <- thisSourceEditor$selection[[1]]
  old_text  <- thisSourceEditor$contents[thisSourceEditor$selection[[1]]$range$start["row"]]
  Encoding(old_text) <- "UTF-8"
  old_text <- trimws(old_text, "l")

  if (stringr::str_detect(old_text, "^#{1,}?")) {
    if (stringr::str_detect(old_text, "^##### ")) {
      new_text <- trimws(stringr::str_remove(old_text, "^#+"), "l")
      sel$range$start["column"] <- 1
      sel$range$end["column"] <- Inf
      rstudioapi::modifyRange(location = sel$range,
                              text = as.character(new_text),
                              id = thisSourceEditor$id)
    }
    else {
      new_text <- paste0("\n##### ", trimws(stringr::str_remove(old_text, "^#+"), "l"))
      sel$range$start["column"] <- 1
      sel$range$end["column"] <- Inf
      rstudioapi::modifyRange(location = sel$range,
                              text = as.character(new_text),
                              id = thisSourceEditor$id)
    }
  }
  else {
    new_text <- paste0("\n##### ", old_text)
    sel$range$start["column"] <- 1
    sel$range$end["column"] <- Inf
    rstudioapi::modifyRange(location = sel$range,
                            text = as.character(new_text),
                            id = thisSourceEditor$id)
  }
}

# Ctrl+Shift+↓(Down Arrow, 아래 화살표)
copy_column_above_line <- function(){
  CurrentSourceEditor <- rstudioapi::getSourceEditorContext() # 현재 script의 정보를 저장.
  text_above_line <- CurrentSourceEditor$contents[CurrentSourceEditor$selection[[1]]$range$start["row"]-1]
  if (CurrentSourceEditor$selection[[1]]$range$start["column"] == CurrentSourceEditor$selection[[1]]$range$end["column"]){
  new_text <- stringr::str_sub(text_above_line,
                               CurrentSourceEditor$selection[[1]]$range$start["column"],
                               CurrentSourceEditor$selection[[1]]$range$end["column"])
  } else {
  new_text <- stringr::str_sub(text_above_line,
                               CurrentSourceEditor$selection[[1]]$range$start["column"],
                               CurrentSourceEditor$selection[[1]]$range$end["column"]-1)
  }
  rstudioapi::modifyRange(text = as.character(new_text))
}

# Ctrl+Alt+v
view_R_object <- function(){
  CurrentSourceEditor <- rstudioapi::getSourceEditorContext()
  selected_R_object <- CurrentSourceEditor$selection[[1]]$text
  View(eval(parse(text=selected_R_object)))
}

# Ctrl+Alt+n
add_line_number <- function(){
  CurrentSourceEditor <- rstudioapi::getSourceEditorContext() # 현재 script의 정보를 저장.
  row_number <- c(CurrentSourceEditor$selection[[1]]$range$start[[1]]:CurrentSourceEditor$selection[[1]]$range$end[[1]])
  input_prefix <- svDialogs::dlgInput("Prefix?", default="")$res # Prefix는 사용자 입력으로.
  input_suffix <- svDialogs::dlgInput("Suffix?", default="")$res # Suffix 사용자 입력으로.
  for (i in 1:length(row_number)){
    spAddins::rs_insert_at_row_start(row_number[i], paste0(input_prefix, i, input_suffix))
  }
}
SeungmanLEEmago/Making-Addins documentation built on Dec. 18, 2021, 1:04 p.m.