1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
new_evaluation <- function(x) {
# Needs explicit list for backwards compatibility
structure(x, class = c("evaluate_evaluation", "list"))
}
is_evaluation <- function(x) {
inherits(x, "evaluate_evaluation")
}
#' @export
`[.evaluate_evaluation` <- function(x, i, ...) {
new_evaluation(NextMethod())
}
#' @export
print.evaluate_evaluation <- function(x, ...) {
cat_line("<evaluation>")
for (component in x) {
type <- output_type(component)
if (type == "source") {
cat_line("Source code: ")
cat_line(indent(component$src))
} else if (type == "text") {
cat_line("Text output: ")
cat_line(indent(component))
} else if (type %in% c("message", "warning", "error")) {
cat_line("Condition: ")
cat_line(indent(format_condition(component)))
} else if (type == "plot") {
dl <- component[[1]]
cat_line("Plot [", length(dl), "]:")
for (call in dl) {
fun_call <- call[[2]][[1]]
if (hasName(fun_call, "name")) {
cat_line(" <base> ", fun_call$name, "()")
} else {
cat_line(" <grid> ", deparse(fun_call))
}
}
} else {
cat_line("Other: ")
cat(" ")
str(component, indent.str = " ")
}
}
invisible(x)
}
output_type <- function(x) {
if (is.character(x)) {
"text"
} else if (is.error(x)) {
"error"
} else if (is.warning(x)) {
"warning"
} else if (is.message(x)) {
"message"
} else if (is.recordedplot(x)) {
"plot"
} else if (is.source(x)) {
"source"
} else if (inherits(x, "gg") || inherits(x, "ggplot2::ggplot")) {
"gg"
} else {
class(x)[[1]]
}
}
#' Object class tests
#'
#' @keywords internal
#' @rdname is.message
#' @export
is.message <- function(x) inherits(x, "message")
#' @rdname is.message
#' @export
is.warning <- function(x) inherits(x, "warning")
#' @rdname is.message
#' @export
is.error <- function(x) inherits(x, "error")
#' @rdname is.message
#' @export
is.source <- function(x) inherits(x, "source")
#' @rdname is.message
#' @export
is.recordedplot <- function(x) inherits(x, "recordedplot")
|
