-
Notifications
You must be signed in to change notification settings - Fork 2
/
add_actions.R
193 lines (173 loc) · 7.74 KB
/
add_actions.R
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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
#' Add GUI elements like actions (menu items), icons, or methods in a predefined
#' list
#'
#' @description Manage lists of GUI actions, icons and methods.
#'
#' @param obj The name of the object in `SciViews:TempEnv` to manipulate.
#' @param text The text of actions to add (label on first line, tip on other
#' lines).
#' @param code The R code of actions to add.
#' @param state The default (initial) state of an action, as a succession of
#' letters: `c` = checked, `u` = unchecked (default); `d` = disabled,
#' `e` = enabled (default); `h` = hidden, `v` = visible (default). Default
#' values are optional. Ex: `udv` means: unchecked - disabled - visible and
#' it equals to simply `d`, given the defaults for the other properties.
#' @param options A character vector with other options to pass to the graphical
#' toolkit for this action.
#' @param replace Do we replace existing items in 'x'?
#' @param icons The description of the icons to add.
#' @param methods The list of methods to add (character string).
#' @return The modified object is returned invisibly.
#' @export
#' @seealso [add_items()], [obj_menu()], [temp_env()]
#' @keywords utilities
#' @concept list of GUI elements
#' @examples
#' # This is useful to add actions, icons, descriptions, shortcuts or methods
#' # TODO: examples and use for functions add_actions(), add_icons() and
#' # add_methods()
add_actions <- function(obj = get_actions(), text = NULL, code = NULL,
state = NULL, options = NULL, replace = TRUE) {
dat <- get_temp(obj, default = list())
if (!inherits(dat, "list"))
stop("'obj' should inherit from 'list'")
# Make sure we return an svActions object
class(dat) <- unique(c("svActions", class(dat)))
# Add new actions characteristics to dat; make sure newdata are correct
add_data <- function(x, new_data, replace) {
new_names <- names(new_data)
if (is.null(new_names))
stop("Data you add in actions must be a named character vector")
new_data <- as.character(new_data)
names(new_data) <- new_names
add_items(x, new_data, replace = replace)
}
if (!is.null(text)) dat$text <- add_data(dat$text, text, replace)
if (!is.null(code)) dat$code <- add_data(dat$code, code, replace)
if (!is.null(state)) dat$state <- add_data(dat$state, state, replace)
if (!is.null(options)) dat$options <- add_data(dat$options, options, replace)
## Reassign the modified values
assign_temp(obj, dat)
invisible(dat)
}
#' @export
#' @rdname add_actions
get_actions <- function(){
if (!exists_temp(".svActions")) {
# Create .svActions if it does not exists yet
.svActions <- list()
class(.svActions) <- unique(c("svActions", class(.svActions)))
assign_temp(".svActions", .svActions, replace.existing = FALSE)
# Define actions we need for the object browser menus
add_temp(".svActions", "text", c(
load = gettext("Load...\nLoad R objects"),
source = gettext("Source...\nSource R code"),
save = gettext("Save as...\nSave to a file"),
import = gettext("Import...\nImport data in R"),
export = gettext("Export...\nExport data to a file"),
report = gettext("Report...\nPrepare a report for this object"),
setwd = gettext("Set Working dir...\nChange current R working directory"),
print = gettext("Print or show\nPrint or show the content of the object"),
generic = gettext("<<<fun>>>()\nApply method <<<fun>>>() to the object"),
names = gettext("Names\nNames of variables contained in the object"),
str = gettext("Str\nCompact str() representation of an object"),
help = gettext("Help\nHelp on an object"),
example = gettext("Example\nRun examples for this object"),
edit = gettext("Edit\nEdit an object"),
fix = gettext("Fix\nFix an R object"),
pkg = gettext("Load package(s)\nLoad one or several R packages"),
remove = gettext("Remove\nRemove (permanently!) one or several objects from memory"),
require = gettext("Require <<<pkg>>>\nRequire the package <<<pkg>>>"),
attach = gettext("Attach\nAttach an object to the search path"),
detach = gettext("Detach\nDetach an object or package from the search path"),
detachUnload = gettext("Detach and unload\nDetach a package from the search path and unload it"),
reattach = gettext("Reattach\nReattach an object to the search path"),
pkgInfo = gettext("Package info\nShow detailed information for this package"),
viewDef = gettext("View (default)\nDefault view for this object"),
view = gettext("View <<<type>>>\nDisplay a '<<<type>>>' view for this object"),
copyDef = gettext("Copy (default)\nCopy this object to the clipboard (default format)"),
copy = gettext("Copy <<<type>>>\nCopy this object to the clipboard in '<<<type>>>' format"),
Functions = gettext("Functions\nGeneric functions and methods"),
View = gettext("View\nView the object"),
Copy = gettext("Copy\nCopy the object to the clipboard")
), replace = replace)
add_temp(".svActions", "code", c(
load = "guiLoad([[[pos = \"<<<envir>>>\"]]])",
source = "guiSource([[[pos = \"<<<envir>>>\"]]])",
save = "guiSave(<<<obj>>>[[[, pos = \"<<<envir>>>\"]]])",
import = "guiImport()",
export = "guiExport(<<<obj>>>)",
report = "guiReport(<<<obj>>>)",
setwd = "guiSetwd([[[<<<dir>>>]]])",
print = "<<<obj>>>",
generic = "[[[<<<var>>>> <- ]]]<<<fun>>>(<<<obj>>>)",
names = "names(<<<obj>>>)",
str = "str(<<<obj>>>)",
help = "help(<<<obj>>>)",
example = "example(<<<obj>>>)",
edit = "<<<obj>>> <- edit(<<<obj>>>)",
fix = "fix(<<<obj>>>)", # There is no guarantee we fix the right one!
pkg = "[[[<<<res>>> <- ]]]pkg(\"<<<pkgs>>>\")",
remove = "rm(<<<obj>>>[[[, pos = \"<<<envir>>>\"]]])",
require = "[[[<<<res>>> <- ]]]require(<<<pkg>>>)",
attach = "attach(<<<obj>>>)",
detach = "detach(<<<envir>>>)",
detachunload = "detach(<<<envir>>>, unload = TRUE)",
reattach = "detach(<<<obj>>>); attach(<<<obj>>>)",
pkgInfo = "<<<H>>>library(help = <<<package>>>)",
viewDef = "view(<<<obj>>>)",
view = "view(<<<obj>>>, type = \"<<<type>>>\")",
copyDef = "copy(<<<obj>>>)",
copy = "copy(<<<obj>>>, type = \"<<<type>>>\")"
), replace = replace)
add_temp(".svActions", "state", c(
viewDef = "d",
copyDef = "d"
), replace = replace)
add_temp(".svActions", "options", c(
generic = ""
), replace = replace)
}
get_temp(".svActions")
}
#' @export
#' @rdname add_actions
add_icons <- function(obj = ".svIcons", icons, replace = TRUE) {
# Get the list of icons
icn <- get_temp(obj, default = character())
if (!inherits(icn, "character"))
stop("'obj' should inherit from 'character'")
# Check that new icons are correctly formatted
nicons <- names(icons)
if (is.null(nicons))
stop("Icons map you add must be a named character vector")
icons <- as.character(icons)
names(icons) <- nicons
# Add new icons to it
icn <- add_items(icn, icons, replace = replace)
# Make sure we return an svIcons object
class(icn) <- unique(c("svIcons", class(icn)))
# Reassign the modified values
assign_temp(obj, icn)
invisible(icn)
}
#' @export
#' @rdname add_actions
add_methods <- function(methods) {
# Get the list of methods
met <- getOption("svGUI.methods")
if (!is.null(met))
methods <- add_items(met, methods, use.names = FALSE)
options(svGUI.methods = sort(methods))
invisible(methods)
}
# Backward compatibility
#' @export
#' @rdname add_actions
addActions <- add_actions
#' @export
#' @rdname add_actions
addIcons <- add_icons
#' @export
#' @rdname add_actions
addMethods <- add_methods