Replace HTML button elements with Bootstrap panels and fix CSS class assignment bugs

..Rcheck/00check.log

@@ -0,0 +1,31 @@
+* using log directory ‘/home/runner/work/TileMaker/TileMaker/..Rcheck’
+* using R version 4.3.3 (2024-02-29)
+* using platform: x86_64-pc-linux-gnu (64-bit)
+* R was compiled by
+    gcc (Ubuntu 13.2.0-23ubuntu3) 13.2.0
+    GNU Fortran (Ubuntu 13.2.0-23ubuntu3) 13.2.0
+* running under: Ubuntu 24.04.2 LTS
+* using session charset: UTF-8
+* using options ‘--no-examples --no-tests --no-vignettes’
+* checking for file ‘./DESCRIPTION’ ... OK
+* checking extension type ... Package
+* this is package ‘TileMaker’ version ‘0.2.9’
+* package encoding: UTF-8
+* checking package namespace information ... OK
+* checking package dependencies ... ERROR
+Packages required but not available:
+  'htmltools', 'purrr', 'dplyr', 'rlang', 'tibble'
+
+Packages suggested but not available:
+  'testthat', 'knitr', 'rmarkdown', 'ggplot2'
+
+VignetteBuilder package required for checking but not installed: ‘knitr’
+
+The suggested packages are required for a complete check.
+Checking can be attempted without them by setting the environment
+variable _R_CHECK_FORCE_SUGGESTS_ to a false value.
+
+See section ‘The DESCRIPTION file’ in the ‘Writing R Extensions’
+manual.
+* DONE
+Status: 1 ERROR

R/tile_maker.R

@@ -81,15 +81,12 @@ solo_box <- function(value = NULL, txt = NULL, former = NULL, size = "md",
                      icon = NULL, color = "info", link = NULL, units = NULL,
                      hover = NULL, textModifier = "h1", pretty = NULL, ...) {
 
-  tags$a(
-    href = link,
-    tags$button(
-      title = hover,
-      # color= "button",
-      color = color,
-      role = "button",
-      # classes: size, color
-      class = "btn", class = paste0("btn-", size), class = paste0("btn-", color),
+  panel_content <- tags$div(
+    title = hover,
+    class = "panel", class = paste0("panel-", color),
+    style = if (!is.null(link) && link != "") "cursor: pointer;" else NULL,
+    tags$div(
+      class = "panel-body text-center",
       if (!(is.null(value) & is.null(units) & is.null(icon))) {
         tag(textModifier, tags$span(
           ico(icon),
@@ -122,10 +119,17 @@ solo_box <- function(value = NULL, txt = NULL, former = NULL, size = "md",
           }
         )$children)
       },
-      HTML(txt),
+      if (!is.null(txt)) tags$div(HTML(txt), style = "margin-top: 10px;"),
       ...
     )
   )
+
+  # Only wrap in anchor tag if link is provided and not empty
+  if (!is.null(link) && link != "") {
+    tags$a(href = link, panel_content, style = "text-decoration: none; color: inherit;")
+  } else {
+    panel_content
+  }
 }
 
 
@@ -232,17 +236,12 @@ solo_gradient_box <- function(value = NULL, txt = NULL, former = NULL,
     finalcolor <- "warning"
   }
 
-  tags$a(
-    href = link,
-    tags$button(
-      href = link,
-      title = hover,
-      # color= "button",
-      color = finalcolor,
-      role = "button",
-      # classes: size, color
-      class = "btn", class = paste0("btn-", size),
-      class = paste0("btn-", finalcolor),
+  panel_content <- tags$div(
+    title = hover,
+    class = "panel", class = paste0("panel-", finalcolor),
+    style = if (!is.null(link) && link != "") "cursor: pointer;" else NULL,
+    tags$div(
+      class = "panel-body text-center",
       if (hide_value == FALSE) {
         tag(textModifier, tags$span(
           ico(icon),
@@ -280,10 +279,17 @@ solo_gradient_box <- function(value = NULL, txt = NULL, former = NULL,
           }
         )$children)
       },
-      HTML(txt),
+      if (!is.null(txt)) tags$div(HTML(txt), style = "margin-top: 10px;"),
       ...
     )
   )
+
+  # Only wrap in anchor tag if link is provided and not empty
+  if (!is.null(link) && link != "") {
+    tags$a(href = link, panel_content, style = "text-decoration: none; color: inherit;")
+  } else {
+    panel_content
+  }
 }
 
 
@@ -339,15 +345,12 @@ solo_box_ct <- function(value = NULL, txt = NULL, size = "md",
                      icon = NULL, color = "info", link = NULL, units = NULL,
                      hover = NULL, textModifier = "h1", ...) {
 
-  tags$a(
-    href = link,
-    tags$button(
-      title = hover,
-      # color= "button",
-      color = color,
-      role = "button",
-      # classes: size, color
-      class = "btn", class = paste0("btn-", size), class = paste0("btn-", color),
+  panel_content <- tags$div(
+    title = hover,
+    class = "panel", class = paste0("panel-", color),
+    style = if (!is.null(link) && link != "") "cursor: pointer;" else NULL,
+    tags$div(
+      class = "panel-body text-center",
       if (!(is.null(value) & is.null(units) & is.null(icon))) {
         tag(textModifier, tags$span(
           ico(icon),
@@ -363,10 +366,17 @@ solo_box_ct <- function(value = NULL, txt = NULL, size = "md",
           )
         )$children)
       },
-      HTML(txt),
+      if (!is.null(txt)) tags$div(HTML(txt), style = "margin-top: 10px;"),
       ...
     )
   )
+
+  # Only wrap in anchor tag if link is provided and not empty
+  if (!is.null(link) && link != "") {
+    tags$a(href = link, panel_content, style = "text-decoration: none; color: inherit;")
+  } else {
+    panel_content
+  }
 }
 
 
@@ -425,21 +435,25 @@ multi_box <- function(icons = NULL, txt = NULL, values = NULL,
   if (is.null(txt)) txt <- rep(" ", length(values))
   if (is.null(icons)) icons <- rep(" ", length(values))
 
-  ## Now build button
-  tags$a(
-    href = link,
-    tags$button(
-      href = link,
-      title = hover,
-      # color= "button",
-      color = color,
-      role = "button",
-      # classes: size, color
-      class = "btn", class = paste0("btn-", size), class = paste0("btn-", color),
-      tags$h1(HTML(title)),
-      pmap(list(values, txt, icons), gutsMaker)
+  ## Now build panel
+  panel_content <- tags$div(
+    title = hover,
+    class = "panel", class = paste0("panel-", color),
+    style = if (!is.null(link) && link != "") "cursor: pointer;" else NULL,
+    tags$div(
+      class = "panel-body text-center",
+      if (!is.null(title)) tags$h1(HTML(title)),
+      pmap(list(values, txt, icons), gutsMaker),
+      ...
     )
   )
+
+  # Only wrap in anchor tag if link is provided and not empty
+  if (!is.null(link) && link != "") {
+    tags$a(href = link, panel_content, style = "text-decoration: none; color: inherit;")
+  } else {
+    panel_content
+  }
 }
 
 

tests/testthat/test-clickable-links.R

@@ -0,0 +1,110 @@
+context("test-clickable-links")
+
+test_that("panels without links don't have anchor tags", {
+  # Test solo_box without link
+  box_no_link <- solo_box(value = 42, txt = "Test", color = "info")
+  html_string <- as.character(box_no_link)
+
+  # Should not contain <a> tag
+  expect_false(grepl("<a", html_string))
+  # Should contain panel div
+  expect_true(grepl("panel", html_string))
+  # Should not contain button tag
+  expect_false(grepl("<button", html_string))
+
+  # Test solo_gradient_box without link
+  grad_box_no_link <- solo_gradient_box(value = 80, txt = "Test")
+  html_string_grad <- as.character(grad_box_no_link)
+
+  # Should not contain <a> tag
+  expect_false(grepl("<a", html_string_grad))
+  # Should contain panel div
+  expect_true(grepl("panel", html_string_grad))
+  # Should not contain button tag
+  expect_false(grepl("<button", html_string_grad))
+
+  # Test solo_box_ct without link
+  box_ct_no_link <- solo_box_ct(value = 42, txt = "Test", color = "info")
+  html_string_ct <- as.character(box_ct_no_link)
+
+  # Should not contain <a> tag
+  expect_false(grepl("<a", html_string_ct))
+  # Should contain panel div
+  expect_true(grepl("panel", html_string_ct))
+  # Should not contain button tag
+  expect_false(grepl("<button", html_string_ct))
+
+  # Test multi_box without link
+  multi_no_link <- multi_box(values = c(1, 2), txt = c("A", "B"), color = "info")
+  html_string_multi <- as.character(multi_no_link)
+
+  # Should not contain <a> tag
+  expect_false(grepl("<a", html_string_multi))
+  # Should contain panel div
+  expect_true(grepl("panel", html_string_multi))
+  # Should not contain button tag
+  expect_false(grepl("<button", html_string_multi))
+})
+
+test_that("panels with links do have anchor tags", {
+  # Test solo_box with link
+  box_with_link <- solo_box(value = 42, txt = "Test", color = "info", link = "https://example.com")
+  html_string <- as.character(box_with_link)
+
+  # Should contain <a> tag with href
+  expect_true(grepl("<a", html_string))
+  expect_true(grepl("href.*=.*https://example.com", html_string))
+  # Should contain panel div
+  expect_true(grepl("panel", html_string))
+  # Should not contain button tag
+  expect_false(grepl("<button", html_string))
+
+  # Test solo_gradient_box with link
+  grad_box_with_link <- solo_gradient_box(value = 80, txt = "Test", link = "https://example.com")
+  html_string_grad <- as.character(grad_box_with_link)
+
+  # Should contain <a> tag with href
+  expect_true(grepl("<a", html_string_grad))
+  expect_true(grepl("href.*=.*https://example.com", html_string_grad))
+  # Should contain panel div
+  expect_true(grepl("panel", html_string_grad))
+  # Should not contain button tag
+  expect_false(grepl("<button", html_string_grad))
+
+  # Test solo_box_ct with link
+  box_ct_with_link <- solo_box_ct(value = 42, txt = "Test", color = "info", link = "https://example.com")
+  html_string_ct <- as.character(box_ct_with_link)
+
+  # Should contain <a> tag with href
+  expect_true(grepl("<a", html_string_ct))
+  expect_true(grepl("href.*=.*https://example.com", html_string_ct))
+  # Should contain panel div
+  expect_true(grepl("panel", html_string_ct))
+  # Should not contain button tag
+  expect_false(grepl("<button", html_string_ct))
+
+  # Test multi_box with link
+  multi_with_link <- multi_box(values = c(1, 2), txt = c("A", "B"), color = "info", link = "https://example.com")
+  html_string_multi <- as.character(multi_with_link)
+
+  # Should contain <a> tag with href
+  expect_true(grepl("<a", html_string_multi))
+  expect_true(grepl("href.*=.*https://example.com", html_string_multi))
+  # Should contain panel div
+  expect_true(grepl("panel", html_string_multi))
+  # Should not contain button tag
+  expect_false(grepl("<button", html_string_multi))
+})
+
+test_that("empty string link is treated as no link", {
+  # Test solo_box with empty string link
+  box_empty_link <- solo_box(value = 42, txt = "Test", color = "info", link = "")
+  html_string <- as.character(box_empty_link)
+
+  # Should not contain <a> tag when link is empty string
+  expect_false(grepl("<a", html_string))
+  # Should contain panel div
+  expect_true(grepl("panel", html_string))
+  # Should not contain button tag
+  expect_false(grepl("<button", html_string))
+})