Build R package from GNU Emacs on Windows 10

I use Windows 10 machine, at work, with GNU Emacs installed from choco repository. Script from my article Run shiny R application from Emacs was not working like in my old Windows 7. First thing is that it was not founding my R binary and I’ve got error:

apply: Spawning child process: Invalid argument

First thing was adding path to R binary second issue was path to Root of the package

Here is first function based on the one from previous article:

(defun call-r-command (command-list)
  "run R command in shell buffer window

  if there is displayed buffer that have shell it will use that window"
  (let* ((name "*R*")
         (new-buffer (get-buffer-create name))
         (old-buff (get-buffer name))
         ;; run R command
         (script-proc-buffer
          (apply 'make-comint-in-buffer
                 "script"
                 new-buffer
                 "c:/Program Files/R/R-3.5.2/bin/R.exe"
                 nil
                 command-list))
         ;; if there is *R* buffer try to find its window
         (old-window (if old-buff (get-buffer-window old-buff)))
         ;; use old window or find any that have shell mode
         (window (or old-window
                     (get-window-with-mode '(comint-mode eshell-mode))))
       (script-proc (get-buffer-process script-proc-buffer)))
    ;; reuse window or create new one
    (if window
        (set-window-buffer window new-buffer)
      (switch-to-buffer-other-window new-buffer))))

This function execute R command, so my new shiny function is shorter

(defun shiny ()
  "run shiny R application in shell buffer"
  (interactive)
  (let ((R (concat "shiny::runApp('" default-directory "')")))
    (call-r-command `("-e" ,R "--no-save"))))

Next is function that return root of git repo (since my R package is also git repo):

(defun shell-line (command)
  "Function execute shell command and return the result as single line"
  (replace-regexp-in-string "\n" "" (shell-command-to-string command)))

The problem with git on Windows 10 in GNU Emacs (or because of shell-command-to-string function) is that path is in Unix format not in Windows format, so I need to fix the path to use it in my R calling script.

(defun git-root-repo ()
  "Function return root of the git repo"
  (interactive)
  (replace-regexp-in-string "/mnt/c/" "c:/" (shell-line "git rev-parse --show-toplevel")))

Now my final function that build the R package:

(defun build-r-package ()
  "Build R package using git root directory as path to R package"
  (interactive)
  (call-r-command `("CMD" "INSTALL" ,(git-root-repo))))

Missing function for finding buffer with same major mode can be found in my previous article Run shiny R application from Emacs.

Run shiny R application from Emacs

Right now I use Windows box for development at work and I use Emacs, but I needed to run RStudio to run the shiny application that I was working on. I though it would be nice to run shiny app from Emacs. On windows I was not able to run ansi-term but eshell was working.

Here is a function that run shiny app if the buffer you’re in is directory that contain server.R:

(defun shiny ()
  "run shiny R application in new shell buffer

  if there is displayed buffer that have shell it will use that window"
  (interactive)
  (let* ((R (concat "shiny::runApp('" default-directory "')"))
         (name "*shiny*")
         (new-buffer (get-buffer-create name))
         (script-proc-buffer
          (apply 'make-comint-in-buffer "script" new-buffer "R" nil `("-e" ,R)))
         (window (get-window-with-mode '(comint-mode eshell-mode)))
       (script-proc (get-buffer-process script-proc-buffer)))
    (if window
        (set-window-buffer window new-buffer)
      (switch-to-buffer-other-window new-buffer))))


(defun search-window-buffer (fn)
  "return first window for witch given function return non nil value"
  (let ((buffers (buffer-list))
        (value))
    (dolist (buffer buffers value)
      (let ((window (get-buffer-window buffer)))
        (if (and window (not value) (funcall fn buffer window))
            (setq value window)))))))

(defun get-window-with-mode (modes)
  "return window with given major modes"
  (search-window-buffer (lambda (buff window)
                        ((let ((mode (with-current-buffer buffer major-mode)))
                          (member mode modes)))))

I’ve needed to use sentinels because If I run simple eshell command it was freezing Emacs and I need to press C-g to cancel the command, it din’t kill R but it was not very good solution.

I’ve also need to update my switch to other major mode buffer, because I was using Eshell that had eshell-mode and my new shiny buffer had comint-mode, I wanted those buffers it to be treated as the same. Above I’ve defined two functions for searching windows because I was using eshell and I wanted to have R from shiny run in the same window. If you’re using ansi-term (on windows it don’t work) you can check it’s major mode and add it to the list of modes in call to get-window-with-mode.

Below is the code for switching to other buffer with same mode (it’s should be common maybe), using C-M-tab and C-tab.

(setq same-mode-alist '((eshell-mode comint-mode) (comint-mode eshell-mode)))

;; SAME BUFFER SWITCH
(defun buffer-same-mode (change-buffer-fun)
  "execute function for next buffer with the same major mode
  or mode on the list in same-mode-alist variable"
  (let ((current-mode major-mode)
        (next-mode nil))
    (while (not (or (eq next-mode current-mode)
                    (member next-mode (cdr (assoc current-mode same-mode-alist)))))
      (funcall change-buffer-fun)
      (setq next-mode major-mode))))

(defun previous-buffer-same-mode ()
  "switch to previous buffer with same mode"
  (interactive)
  (buffer-same-mode #'previous-buffer))

(defun next-buffer-same-mode ()
  "switch to next buffer with same mode"
  (interactive)
  (buffer-same-mode #'next-buffer))

(global-set-key [C-M-tab] 'previous-buffer-same-mode)
(global-set-key [C-tab] 'next-buffer-same-mode)

How to simulate error for http requests in R application

I was working on shiny R application and the app was using xmlParse(path) to parse url from web API I was using. I needed to add error handling to respond to 404 and 500 errors, so I’ve changed my code to use httr library. That way I could use two steps process of getting xml from API.

My code look like this:

      res <- GET(url)
      if (res$status_code == 500) {
        message <- "Error From API" 
        simpleFatalError(message)
        stop(message)
      } else if (res$status_code == 404) {
        message <- paste("Study", .session$sid, "not found")
        simpleFatalError(message)
        stop(message)
      } else if (res$status_code != 200) {
        message <- paste(
          "Unknown response code",
          res$status_code,
          "for Study",
          .session$sid
        )
        simpleFatalError(message)
        stop(message)
      }
      studyXML <- tryCatch(
        xmlRoot(xmlTreeParse(
          content(res, "text", encoding = "UTF-8"),
          useInternalNodes=TRUE
        )),
        error = function(e) {
           simpleFatalError("parse error")
        }
      )

and now I had the problem how to simulate 500 error because that error in the API that was needed to be handled was fixed by the API team. So what I’ve did was installing Fiddler I work on windows if you work on Linux better would be to use Burp Suite.

And I used Fiddler script which seems simpler solution because it was just one line of code:

    static function OnBeforeResponse(oSession: Session) {
        if (m_Hide304s && oSession.responseCode == 304) {
            oSession["ui-hide"] = "true";
        }
        if (oSession.url.Contains("study.xml")) { // this was part of the url that returned xml from API
            oSession.oRequest.FailSession(500, "Blocked", "Fiddler blocked this file");
        }
    }

But I had the problem that Fiddler was not handling my backed requests. And it turn out that I needed to enable proxy for httr which is as simple as:

res <- GET(path, use_proxy("127.0.0.1", 8888))

Then I was able to test my connecting to the API, and get proper error in shiny app.

Dropdown menu in R Shiny

Shiny framework use bootstrap 3 that support drop down menus, all you have to do, to have drop down menu in Shiny, is to prepare html and the bootstrap will handle style and logic for opening and closing the menu. Here is the handy function that will create drop down menu for you:

dropdownMenu <- function(label=NULL, icon=NULL, menu=NULL) {
  ul <- lapply(names(menu), function(id) {
    if (is.character(menu[[id]])) {
      tags$li(actionLink(id, menu[[id]]))
    } else {
      args <- menu[[id]]
      args$inputId <- id
      tags$li(do.call(actionLink, args))
    }
  })
  ul$class <- "dropdown-menu"
  tags$div(
    class = "dropdown",
    tags$button(
      class = "btn btn-default dropdown-toggle",
      type = "button",
      `data-toggle` = "dropdown",
      label,
      `if`(!is.null(icon), icon, tags$span(class="caret"))
    ),
    do.call(tags$ul, ul)
  )
}

The function will create drop down menu with caret like on the demo on getbootstrap.com or if you provide icon you will get only that icon the label is optional so you can have dropdown menu with just an icon. It use actionLink to create links so you don't need to to create custom input widget

You can use this function like this, to create hamburger menu:

dropdownMenu(
  icon = icon("bars"),
  menu = list(edit = "edit item", rename = list(label = "address", icon = icon("id-card"))
)

and it will create two inputs input$edit and input$rename so you can add observeEvent to listen to on click.

Execute javascript code when R shiny output have been rendered

If you have reactive observer like this:

output$resultsTable <- renderTable({
   tableData
});

and you want to modify the table from javascript you can’t put shinyjs::runjs after table is rendered because the table data need to be the last expression of the reactive renderTable observer. The solution is to use new feature of JavaScript, implemented in browsers, which is mutation observer. The browser support is very good, you can check it on caniuse. The solution that will work, look like this (using jQuery plugin):
$.fn.onRender = function(callback, options) {
  if (arguments[0] == 'cancel') {
    return this.each(function() {
      var self = $(this);
      var render = self.data('render');
      if (render) {
        render.observer.disconnect();
        self.removeData('render');
      }
    });
  } else {
    var settings = $.extend({
      // if set to true will remove mutation observer after first mutation
      oneTime: true,
      // if set to true will always execute and clear mutation observer on first mutation
      // default will not fire callback when mution is recalcuation of any element
      strict: false,
      observer: {childList: true, subtree: true, attributes: true},
      check: function(node) { return node.closest('body').length; }
    }, options || {});
    return this.each(function() {
      var node = $(this);
      var render = node.data('render');
      if (!render) {
        render = {
          callbacks: $.Callbacks(),
          observer: new MutationObserver(function(mutations) {
            // if recalculating wait for next mutation
            if (!(node.hasClass('recalculating') || node.find('.recalculating').length) ||
                settings.strict) {
              if (settings.check(node)) {
                render.callbacks.fireWith(node[0]);
              }
              if (settings.oneTime) {
                node.onRender('cancel');
              }
            }
          })
        };
        render.observer.observe(node[0], settings.observer);
        node.data('render', render);
      }
      render.callbacks.add(callback);
    });
  }
};

You can use it like this:
function changeTable(selector) {
   $(selector).onRender(function() {
      $(this).find('thead th').css('color', 'red');
   });
}

output$resultsTable <- renderTable({
   shinyjs::runjs("changeTable('#resultsTable')")
   tableData
});

if you want to execute code once and use it outside of shiny observer you can use option oneTime: false like this:
function updateTableWhenRender(selector) {
   $(selector).onRender(function() {
      $(this).find('thead th').css('color', 'red');
   }, {oneTime: false});
}

then the function can be put outside of observer like this:
output$resultsTable <- renderTable({
   tableData
});
shinyjs::runjs("updateTableWhenRender('#resultsTable')")

To cancel the mutation observer, that was created with the plugin, you can execute this line of code:
$(selector).onRender('cancel');

If you have multiple renders and have onRender on each render call you should call cancel before you call onRender again.
This code can be used for instance to update reactive table (e.g. apply jQuery plugin). You can check how this would work with this shiny emulation on CodePen.
Latest version of the plugin can be found in this gist.