Fix #173

NAMESPACE

@@ -67,6 +67,8 @@ S3method(select,tbl_graph)
 S3method(semi_join,tbl_graph)
 S3method(slice,morphed_tbl_graph)
 S3method(slice,tbl_graph)
+S3method(tbl_format_footer,named_tbl)
+S3method(tbl_sum,named_tbl)
 S3method(tbl_vars,tbl_graph)
 S3method(ungroup,grouped_tbl_graph)
 S3method(ungroup,morphed_tbl_graph)
@@ -548,6 +550,8 @@ importFrom(igraph,which_multiple)
 importFrom(igraph,which_mutual)
 importFrom(magrittr,"%>%")
 importFrom(pillar,style_subtle)
+importFrom(pillar,tbl_format_footer)
+importFrom(pillar,tbl_sum)
 importFrom(rlang,"!!!")
 importFrom(rlang,"%||%")
 importFrom(rlang,.data)
@@ -573,7 +577,6 @@ importFrom(stats,na.omit)
 importFrom(stats,setNames)
 importFrom(tibble,as_tibble)
 importFrom(tibble,tibble)
-importFrom(tibble,trunc_mat)
 importFrom(tidyr,nest_legacy)
 importFrom(tools,toTitleCase)
 importFrom(utils,head)

R/tbl_graph.R

@@ -74,31 +74,48 @@ as_tbl_graph.default <- function(x, ...) {
 is.tbl_graph <- function(x) {
   inherits(x, 'tbl_graph')
 }
-#' @importFrom tibble trunc_mat
+
+new_name_tibble <- function(x, active = NULL, name = "A tibble", suffix = "") {
+  x <- as_tibble(x, active)
+  attr(x, "name") <- name
+  attr(x, "suffix") <- suffix
+  class(x) <- c("named_tbl", class(x))
+  x
+}
+#' @importFrom pillar tbl_sum
+#' @export
+tbl_sum.named_tbl <- function(x) {
+  summary <- NextMethod()
+  names(summary)[1] <- attr(x, "name")
+  summary[1] <- paste0(summary[1], attr(x, "suffix"))
+  summary
+}
+#' @importFrom pillar tbl_format_footer
+#' @export
+tbl_format_footer.named_tbl <- function(x, setup, ...) {
+  footer <- NextMethod()
+  footer[min(1, length(footer))]
+}
+
 #' @importFrom tools toTitleCase
 #' @importFrom rlang as_quosure sym
-#' @importFrom pillar style_subtle
 #' @export
 print.tbl_graph <- function(x, ...) {
-  arg_list <- list(...)
-  arg_list[['useS4']] <- NULL
   graph_desc <- describe_graph(x)
   not_active <- if (active(x) == 'nodes') 'edges' else 'nodes'
-  top <- do.call(trunc_mat, modifyList(arg_list, list(x = as_tibble(x), n = 6)))
-  top$summary[1] <- paste0(top$summary[1], ' (active)')
-  names(top$summary)[1] <- toTitleCase(paste0(substr(active(x), 1, 4), ' data'))
-  bottom <- do.call(trunc_mat, modifyList(arg_list, list(x = as_tibble(x, active = not_active), n = 3)))
-  names(bottom$summary)[1] <- toTitleCase(paste0(substr(not_active, 1, 4), ' data'))
+  top <- toTitleCase(paste0(substr(active(x), 1, 4), ' data'))
+  bottom <- toTitleCase(paste0(substr(not_active, 1, 4), ' data'))
   cat_subtle('# A tbl_graph: ', gorder(x), ' nodes and ', gsize(x), ' edges\n', sep = '')
   cat_subtle('#\n')
   cat_subtle('# ', graph_desc, '\n', sep = '')
   cat_subtle('#\n')
-  print(top)
+  print(new_name_tibble(x, NULL, top, " (active)"), ...)
   cat_subtle('#\n')
-  print(bottom)
+  print(new_name_tibble(x, not_active, bottom, ""), n = 3)
   invisible(x)
 }
 
+#' @importFrom pillar style_subtle
 cat_subtle <- function(...) cat(pillar::style_subtle(paste0(...)))
 
 #' @export