message("*** devOptions() ...")

known <- rownames(R.devices::devOptions())

# Without attaching package
opts0 <- R.devices::devOptions()
print(opts0)

if ("eps" %in% known) {
  opts0eps <- R.devices::devOptions("eps")
  str(opts0eps)
}

if ("png" %in% known) {
  opts <- R.devices::devOptions("png")
  print(opts)
}

# With attaching package
library("R.devices")
opts1 <- R.devices::devOptions()
print(opts1)

if ("eps" %in% known) {
  opts1eps <- R.devices::devOptions("eps")
  str(opts1eps)
  stopifnot(identical(opts1eps, opts0eps))
  stopifnot(identical(opts1, opts0))
}

# Options for the PNG device
if ("png" %in% known) {
  opts <- devOptions("png")
  print(opts)
}

# Options for the postscript device
if ("postscript" %in% known) {
  opts <- devOptions("postscript")
  print(opts)

  # Same using alias
  opts2 <- devOptions("ps")
  print(opts2)
  stopifnot(identical(opts2, opts))
}

# Options for all known devices
opts <- devOptions()
print(opts)

# Setting a custom option
if ("png" %in% known) {
  devOptions("png", foo=list(a=1, b=pi))
  str(devOptions("png")$foo)

  # Setting option to NULL, i.e. drop it
  devOptions("png", foo=NULL)
  str(devOptions("png")$foo)
  str(devOptions("png"))

  # Get individual device options
  print(getDevOption("png", "width"))
}

opts1 <- R.devices::devOptions()
print(opts1)

## Assert devOptions(<function>) equals devOptions(<name>)
## Identify all "primitive" functions
fcns <- lapply(R.devices:::devAll(), FUN=`[`, 1L)
for (name in names(fcns)) {
  fcn <- fcns[[name]]
  cat(sprintf("Asserting devOptions('%s') == devOptions(%s) ...\n", name, fcn))
  fcn <- eval(parse(text=fcn))
  optsName <- devOptions(name)
  optsFcn <- devOptions(fcn)
  res <- all.equal(optsFcn, optsName)
  if (!isTRUE(res)) {
    str(list(name=name, fcn=fcn, byName=optsName, byFcn=optsFcn))
    print(res)
    stop(!all.equal(optsFcn, optsName))
  }
}

message("*** devOptions() for each type ...")
types <- rownames(devOptions())
cat("All known types:\n")
print(types)

for (type in types) {
  message(sprintf("*** devOptions('%s') for each type ...", type))
  opts <- devOptions(type)
  str(opts)
  message(sprintf("*** devOptions('%s') for each type ... DONE", type))
}

message("*** devOptions() for each type ... DONE")


message("*** devOptions(drop=FALSE) ...")

if ("png" %in% known) {
  opts <- devOptions("png", drop=TRUE)
  str(opts)
  stopifnot(is.list(opts))
  stopifnot(is.null(dim(opts)))

  opts <- devOptions("png", drop=FALSE)
  str(opts)
  stopifnot(is.list(opts))
  stopifnot(!is.null(dim(opts)))
}

message("*** devOptions(drop=FALSE) ... DONE")

message("*** devOptions(reset=TRUE) ...")

## Reset all
opts <- devOptions()
print(opts)
opts0 <- devOptions(reset=TRUE)
print(opts0)

## Reset one device
if ("png" %in% known) {
  opts <- devOptions("png")
  width <- getDevOption("png", "width")
  devOptions("png", width=2*width)
  stopifnot(getDevOption("png", "width") == 2*width)
  devOptions("png", reset=TRUE)
  stopifnot(getDevOption("png", "width") == width)

  ## Reset "*"
  opts <- devOptions("*")
  path <- getDevOption("*", "path")
  devOptions("*", path="foo")
  stopifnot(getDevOption("*", "path") == "foo")
  devOptions("*", reset=TRUE)
  stopifnot(getDevOption("*", "path") == path)
}


message("*** devOptions(reset=TRUE) ... DONE")


message("*** devOptions() - errors ...")

res <- try(devOptions(type=character(0L), width=32L))
stopifnot(inherits(res, "try-error"))

message("*** devOptions() - errors ... DONE")


message("*** devOptions() - odds'n'ends ...")

devOptions(type=character(0L), reset=FALSE)
devOptions(type=character(0L), reset=TRUE)

message("*** devOptions() - odds'n'ends ... DONE")

message("*** devOptions() ... DONE")