Identifying potential issue with inline printing in tables

notebook_paged_table_bug.Rmd

---
title: "R Notebook"
output: html_notebook
editor_options: 
  chunk_output_type: inline
---


```{r setup}
library(tibble)
# sample class that should always render as uppercase
#' @export
as_print_upper <- function(x){
  structure( x, class = c("PRINT_UPPER"))
}

#' @export
is_notebook <- function(){
  is_notebook_val <- isTRUE(getOption("rstudio.notebook.executing"))
  if (interactive() & !is_notebook_val) {
    "1"
  } else if (is_notebook_val) {
    "2"
  } else{
    "3"
  }
}

#' @export
print.PRINT_UPPER <- function(x,..., notebook = is_notebook()){
  cat(format(x,..., notebook = notebook))
  invisible(x)
}

#' @export
format.PRINT_UPPER <- function(x, ..., notebook = is_notebook()) {
  func <- switch(notebook,
         "1" = toupper,
         "2" = tolower,
         "3" = function(z){paste(z, "NEW VALUES")}
  )

  func(x)
}

#convert to data.frame
#' @export
as.data.frame.PRINT_UPPER <- function (x, row.names = NULL, optional = FALSE, ...){

  nm = paste(deparse(substitute(x), width.cutoff = 500L), collapse = " ")
  force(nm)
  nrows <- length(x)
  x <- list(x)

  if (is.null(row.names)) {
    if (nrows == 0L)
      row.names <- character()
    else if (length(row.names <- names(x)) != nrows || anyDuplicated(row.names))
      row.names <- .set_row_names(nrows)
  }

  if (!is.null(names(x)))
    names(x) <- NULL

  if (!optional)
    names(x) <- nm

  structure(x, row.names = row.names, class = "data.frame")
}

```


```{r printing}

my_obj <- as_print_upper(c("val1","VAL2","val3"))

# with inline turned on, should print all lower case
# with inline turned off, should print all upper case
my_obj


z <- tibble(
  col = my_obj,
  val = 1:3
)

sapply(z, class)

# cases are not respected when printing in line, and class of field
# 'col' is marked as character, not class "PRINT_UPPER" in paged_table
# and not respecting format...
z



```