Merge pull request #87 from surveydown-dev/pingfan-ui-design

Pingfan UI design

DESCRIPTION

@@ -32,6 +32,7 @@ Suggests:
 Imports:
     bslib,
     DBI,
+    digest,
     DT,
     markdown,
     pool,

NAMESPACE

@@ -10,9 +10,11 @@ export(sd_display_value)
 export(sd_get_data)
 export(sd_next)
 export(sd_question)
+export(sd_redirect)
 export(sd_server)
 export(sd_set_password)
 export(sd_setup)
 export(sd_store_value)
 export(sd_update_extension)
 export(sd_update_surveydown)
+importFrom(digest,digest)

NEWS.md

@@ -1,5 +1,8 @@
 # surveydown (development version)
 
+- `sd_redirect()` to create redirection to external links, either by providing a button, a countdown, or both.
+- Now `sd_next()` and `sd_redirect()` both support the "Enter" key for a better user experience.
+
 # surveydown 0.2.1
 
 - In `sd_database()`, now `db_name` is changed to `dbname`, and `table_name` is changed to `table`, for consistency with Supabase, and simplicity of parameter names.

R/ui.R

@@ -327,15 +327,16 @@ sd_display_value <- function(id, display_type = "inline", wrapper = NULL, ...) {
 #' Create a 'Next' Button for Page Navigation
 #'
 #' This function creates a 'Next' button for navigating to the specified next page in a Surveydown survey.
+#' The button can be activated by clicking or by pressing the Enter key.
 #'
 #' @param next_page Character string. The ID of the next page to navigate to. This parameter is required.
 #' @param label Character string. The label of the 'Next' button. Defaults to "Next".
 #'
-#' @details The function generates a Shiny action button that, when clicked, sets the input value
-#'   to the specified next page ID, facilitating page navigation within the Shiny application.
-#'   The button is styled to appear centered on the page.
+#' @details The function generates a Shiny action button that, when clicked or when the Enter key is pressed,
+#'   sets the input value to the specified next page ID, facilitating page navigation within the Shiny application.
+#'   The button is styled to appear centered on the page. The Enter key functionality is only active when the button is visible.
 #'
-#' @return A Shiny action button UI element.
+#' @return A Shiny action button UI element with associated JavaScript for Enter key functionality.
 #'
 #' @examples
 #' sd_next("page2", "Continue to Next Section")
@@ -346,15 +347,199 @@ sd_next <- function(next_page = NULL, label = "Next") {
         stop("You must specify the current_page for the 'Next' button.")
     }
 
-    shiny::actionButton(
-        inputId = make_next_button_id(next_page),
-        label   = label,
-        style   = "display: block; margin: auto;",
-        onclick = sprintf("Shiny.setInputValue('next_page', '%s');", next_page)
+    button_id <- make_next_button_id(next_page)
+
+    shiny::tagList(
+        shiny::actionButton(
+            inputId = button_id,
+            label = label,
+            style = "display: block; margin: auto;",
+            onclick = sprintf("Shiny.setInputValue('next_page', '%s');", next_page)
+        ),
+        shiny::tags$script(shiny::HTML(enter_key_js(button_id)))
     )
 }
 
 # Generate Next Button ID
 make_next_button_id <- function(next_page) {
     return(paste0("next-", next_page))
 }
+
+#' Redirect button
+#'
+#' This function creates a UI element for redirecting to external links. It can provide a clickable button,
+#' automatic redirection after a delay, or both. When a button is created, it can be activated by clicking
+#' or by pressing the Enter key.
+#'
+#' @param url Character string. The target URL for redirection.
+#' @param button Logical. If TRUE, creates a clickable button. If FALSE, creates non-clickable text. Defaults to TRUE.
+#' @param label Character string. The text for the button or display. Defaults to "Click here".
+#' @param delay Numeric. The delay in seconds before automatic redirection. If NULL, no automatic redirection occurs. Defaults to NULL.
+#'
+#' @return A Shiny UI element (button or text) with redirection functionality, horizontally centered and styled.
+#'   If a button is created, it includes JavaScript for Enter key functionality.
+#'
+#' @details
+#' When `button = TRUE`, the function creates a clickable button that can be activated by mouse click or by pressing the Enter key.
+#' The Enter key functionality is only active when the button is visible on the page.
+#' If a delay is specified, the function will initiate an automatic redirection after the specified number of seconds.
+#'
+#' @examples
+#' sd_redirect(
+#'   url = "https://www.google.com",
+#'   button = TRUE,
+#'   label = "Go to Google",
+#'   delay = 5)
+#' sd_redirect(
+#'   url = "https://www.example.com",
+#'   button = FALSE,
+#'   label = "Redirecting to Example",
+#'   delay = 10
+#' )
+#'
+#' @importFrom digest digest
+#' @export
+sd_redirect <- function(url, button = TRUE, label = "Click here", delay = NULL) {
+    # Validate URL
+    if (!grepl("^https?://", url)) {
+        url <- paste0("https://", url)
+    }
+
+    # Create JavaScript for redirection
+    redirect_js <- sprintf("window.location.href = '%s';", url)
+
+    # Create a unique ID for this instance of sd_redirect
+    unique_id <- paste0("redirect_", digest::digest(paste(url, label, delay), algo = "md5"))
+
+    # Styling for the container
+    container_style <- "
+    display: inline-block;
+    text-align: center;
+    border: 1px solid #ddd;
+    border-radius: 5px;
+    padding: 0.5rem 1rem;
+    background-color: #f9f9f9;
+    margin: 0.5rem 0;
+  "
+
+    # Wrapper for centering the container
+    wrapper_style <- "
+    text-align: center;
+    margin: 1rem 0;
+  "
+
+    # Create button or text element
+    if (button) {
+        button_id <- paste0("button_", unique_id)
+        element <- shiny::tagList(
+            shiny::actionButton(
+                inputId = button_id,
+                label = label,
+                onclick = redirect_js
+            ),
+            shiny::tags$script(shiny::HTML(enter_key_js(button_id)))
+        )
+    } else {
+        element <- shiny::span(label)
+    }
+
+    # Add automatic redirection if delay is specified
+    if (!is.null(delay) && is.numeric(delay) && delay > 0) {
+        countdown_id <- paste0("countdown_", unique_id)
+
+        element <- shiny::tagList(
+            shiny::div(
+                style = wrapper_style,
+                shiny::div(
+                    id = unique_id,
+                    style = container_style,
+                    element,
+                    shiny::p(
+                        style = "margin: 0.5rem 0 0 0;",
+                        "Redirecting in ",
+                        shiny::tags$strong(id = countdown_id, delay),
+                        " seconds."
+                    )
+                )
+            ),
+            shiny::tags$script(shiny::HTML(countdown_js(delay, redirect_js, countdown_id, unique_id)))
+        )
+    } else if (!button) {
+        # If there's no delay and it's not a button, we need to inform the user that no action is possible
+        element <- shiny::div(
+            style = wrapper_style,
+            shiny::div(
+                style = container_style,
+                element,
+                shiny::p(style = "margin: 0.5rem 0 0 0;", "Note: This text is for display only and does not trigger redirection.")
+            )
+        )
+    } else {
+        # If it's a button without delay, just wrap it in the styled container
+        element <- shiny::div(
+            style = wrapper_style,
+            shiny::div(
+                style = container_style,
+                element
+            )
+        )
+    }
+
+    return(element)
+}
+
+# Enter Key JS
+enter_key_js <- function(button_id) {
+    sprintf("
+    $(document).ready(function() {
+        var buttonId = '%s';
+        $(document).on('keydown', function(event) {
+            if (event.key === 'Enter' && !event.repeat) {
+                var $button = $('#' + buttonId);
+                if ($button.is(':visible')) {
+                    $button.click();
+                    event.preventDefault();
+                }
+            }
+        });
+    });
+    ", button_id)
+}
+
+# Countdown JS
+countdown_js <- function(delay, redirect_js, countdown_id, unique_id) {
+    sprintf(
+        "
+    $(document).ready(function() {
+      var countdown = %d;
+      var countdownTimer;
+
+      function startCountdown() {
+        countdownTimer = setInterval(function() {
+          countdown--;
+          if (countdown <= 0) {
+            clearInterval(countdownTimer);
+            %s
+          } else {
+            $('#%s').text(countdown);
+          }
+        }, 1000);
+      }
+
+      // Start countdown when this element becomes visible
+      var observer = new IntersectionObserver(function(entries) {
+        if(entries[0].isIntersecting === true) {
+          startCountdown();
+          observer.disconnect();
+        }
+      }, { threshold: [0] });
+
+      observer.observe(document.getElementById('%s'));
+    });
+    ",
+        delay,
+        redirect_js,
+        countdown_id,
+        unique_id
+    )
+}

pkgdown/_pkgdown.yml

@@ -29,6 +29,7 @@ reference:
   - sd_display_question
   - sd_display_value
   - sd_next
+  - sd_redirect
   - sd_store_value
   - sd_copy_value
 - title: "Configuration and Server"