-
Notifications
You must be signed in to change notification settings - Fork 2
/
inputs.R
238 lines (228 loc) · 6.71 KB
/
inputs.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
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
# All input components
#' A clearable text inputInput control
#' @description An UI component with a "X" button in the end to clear the entire
#' entered text. It works the same as `Textinput`.
#'
#' @param inputId ID
#' @param label text label above
#' @param value default value
#' @param placeholder place holder text when value is empty
#' @param style additional CSS styles you want to apply
#' @return a shiny component
#' @export
#'
#' @examples
#' if(interactive()){
#'
#' ui <- fluidPage(
#' clearableTextInput("input1", "This is a input box", style = "width: 50%;"),
#' verbatimTextOutput("out1")
#' )
#'
#' server <- function(input, output, session) {
#' output$out1 <- renderPrint(input$input1)
#' }
#'
#' shinyApp(ui, server)
#' }
clearableTextInput <- function(
inputId,
label = "",
value = "",
placeholder = "",
style = "width: 100%;") {
force(inputId)
tagList(tags$div(
style = style,
tags$label(label, `for` = inputId),
tags$span(
class = "form-control text-input-clearable",
style = "background-color: #fff;",
tags$input(
id = inputId,
type = "text",
value = value,
placeholder = placeholder
),
HTML('<span class="glyphicon glyphicon-remove"></span>')
)
),
tags$script(glue("clearText('{inputId}')")),
spsDepend("basic")
)
}
#' Bootstrap 3 text input group
#' @description Text input group and custom widgets append to left ar/and right
#' @param textId text box id
#' @param label text label for this input group
#' @param value default value for the text input
#' @param placeholder default placeholder text for the text input if no value
#' @param left_text text or icon add to the left side
#' @param right_text text or icon add to the right side
#' @param style additional style add to the group
#'
#' @return text input group component
#' @details If no text is specified for both left and right, the return is almost
#' identical to [clearableTextInput]
#' @export
#'
#' @examples
#' if(interactive()){
#'
#' ui <- fluidPage(
#' textInputGroup("id1", "left", left_text = "a"),
#' textInputGroup("id2", "right", right_text = "b"),
#' textInputGroup("id3", "both", left_text = "$", right_text = ".00"),
#' textInputGroup("id4", "none"),
#' textInputGroup("id5", "icon", left_text = icon("house")),
#' )
#'
#' server <- function(input, output, session) {
#'
#' }
#'
#' shinyApp(ui, server)
#' }
textInputGroup <-function(
textId,
label = "",
value = "",
placeholder = "enter text",
left_text = NULL,
right_text = NULL,
style = "width: 100%;"){
if (all(!emptyIsFalse(left_text), !emptyIsFalse(right_text))) {
form_style = "display: block;"
} else {
form_style = ""
}
div(
style = style,
tags$label(label, `for` = textId),
div(
class="input-group",
style = form_style,
if (emptyIsFalse(left_text)) tags$span(class="input-group-addon", left_text) else "",
tags$span(
class = "form-control text-input-clearable",
style = "width: 100%;",
tags$input(
id = textId,
type = "text",
value = value,
placeholder = placeholder
),
HTML('<span class="glyphicon glyphicon-remove"></span>')
),
tags$script(glue("clearText('{textId}')")),
if (emptyIsFalse(right_text)) tags$span(class="input-group-addon", right_text) else "",
),
spsDepend("basic")
)
}
#' Text input with an action button
#' @description One kind of bootstrap3 input group: a textinput and a button attached
#' to the end
#' @param textId the text input ID
#' @param btnId the button ID, if not specified, it is "textId" + "_btn" like, `textId_btn`
#' @param label label of the whole group, on the top
#' @param text_value initial value of the text input
#' @param placeholder placeholder text of the text input
#' @param btn_icon a [shiny::icon] of the button
#' @param btn_label text on the button
#' @param style additional CSS style of the group
#' @param tooltip a tooltip of the group
#' @param placement where should the tooltip go?
#' @param ... additional args pass to the button, see [shiny::actionButton]
#' @export
#' @return a shiny input group
#'
#' @examples
#' if(interactive()){
#' library(shiny)
#'
#' ui <- fluidPage(
#' column(
#' 6,
#' textButton(textId = "tbtn_default", label = "default"),
#' textButton(
#' textId = "tbtn-icon",
#' label = "change icon and color",
#' btn_icon = icon("house"),
#' class = "btn-warning" # pass to the button
#' ),
#' textButton(
#' textId = "tbtn_style",
#' label = "change styles",
#' style = "color: red; border: 2px dashed green;"
#' ),
#' textButton(
#' textId = "tbtn_submit",
#' label = "interact with shiny server",
#' btn_label = "Submit",
#' placeholder = "type and submit",
#' class = "btn-primary"),
#' verbatimTextOutput("tbtn_submit_out")
#' )
#' )
#'
#' server <- function(input, output, session) {
#' # watch for the button ID "tbtn_submit" + "_btn"
#' observeEvent(input$tbtn_submit_btn, {
#' output$tbtn_submit_out <- renderPrint(isolate(input$tbtn_submit))
#' })
#'
#' }
#'
#' shinyApp(ui, server)
#' }
textButton <- function(
textId,
btnId = paste0(textId, "_btn"),
label = "",
text_value ="",
placeholder = "",
tooltip = "",
placement = "bottom",
btn_icon = NULL,
btn_label = "btn",
style = "",
...
){
stopifnot(is.character(textId) && length(textId) == 1)
stopifnot(is.character(btnId) && length(btnId) == 1)
stopifnot(is.character(label) && length(label) == 1)
stopifnot(is.character(text_value) && length(text_value) == 1)
stopifnot(is.character(placeholder) && length(placeholder) == 1)
stopifnot(is.character(tooltip) && length(tooltip) == 1)
stopifnot(is.character(placement) && length(placement) == 1)
stopifnot(is.character(btn_label) && length(btn_label) == 1)
div(
style = style,
tags$label(label, `for` = textId),
div(
class = "input-group",
`data-toggle`="tooltip",
title = tooltip,
`data-placement` = placement,
tags$span(
class = "form-control text-input-clearable",
style = "width: 100%;",
tags$input(
id = textId,
type = "text",
value = text_value,
placeholder = placeholder
),
HTML('<span class="glyphicon glyphicon-remove"></span>')
),
tags$span(
class="input-group-btn",
actionButton(btnId, btn_label, icon = btn_icon, ...)
),
tags$script(glue("clearText('{textId}')")),
spsDepend("basic"),
spsDepend('pop-tip')
)
)
}