Add qto_link() function + minor refactor for qto_fig() (#12)

* Add `qto_link()` function
* Fix arg parameter for check_src
* Refactor `qto_fig()` to use `qto_src_span()`
* Fix handling of multiple class values
* Update qto_link to allow bare links
* Fill missing param definitions

NAMESPACE

@@ -13,6 +13,7 @@ export(qto_heading)
 export(qto_hr)
 export(qto_kbd)
 export(qto_li)
+export(qto_link)
 export(qto_ol)
 export(qto_pagebreak)
 export(qto_shortcode)

R/attributes.R

@@ -12,9 +12,11 @@
 #'   pass to [htmltools::css()].
 #' @param .attributes Optional list of attributes. If supplied, any attributes
 #'   passed to `...` are ignored.
-#' @param .output Output type. If "embrace", the returned attributes are
-#'   enclosed in curly brackets.
+#' @param .output Output type. If "embrace", the returned attributes are always
+#'   enclosed in curly brackets, e.g. "{}" if no attributes are supplied. If
+#'   "span", an empty string is returned if no attributes are provided.
 #' @param .drop_empty If `TRUE`, empty attributes are dropped.
+#' @inheritParams rlang::args_error_context
 #' @examples
 #' qto_attributes(id = "id", class = "class")
 #'
@@ -29,13 +31,15 @@ qto_attributes <- function(id = NULL,
                            ...,
                            .attributes = NULL,
                            .output = "embrace",
-                           .drop_empty = TRUE) {
+                           .drop_empty = TRUE,
+                           call = caller_env()) {
     if (is_string(id) && !grepl("^#", id)) {
         id <- paste0("#", id)
     }
 
-    if (is_string(class) && !grepl("^\\.", class)) {
-        class <- paste0(".", class)
+    if (all(is.character(class))) {
+        has_class_prefix <- grepl("^\\.", class)
+        class[!has_class_prefix] <- paste0(".", class[!has_class_prefix])
     }
 
     if (!is.null(css) && is_installed("htmltools")) {
@@ -53,9 +57,15 @@ qto_attributes <- function(id = NULL,
         .attributes <- paste0(c(id, class, css, .attributes), collapse = " ")
     }
 
+    .output <- arg_match0(.output, c("embrace", "span"), error_call = call)
+
+    if ((.output == "span") && !is.null(.attributes)) {
+        .output <- "embrace"
+    }
+
     switch(.output,
         embrace = embrace(.attributes),
-        .attributes
+        span = ""
     )
 }
 

R/figures.R

@@ -22,6 +22,7 @@
 #' qto_fig("graphic.pdf", title = "Title of the graphic")
 #'
 #' @seealso [knitr::include_graphics()]
+#' @family span
 #' @export
 qto_fig <- function(src,
                     caption = NULL,
@@ -72,21 +73,29 @@ qto_fig <- function(src,
 #'
 #' @param src Image source. Either a file path or URL.
 #' @param caption Caption text
-#' @inheritDotParams qto_attributes
+#' @inheritParams qto_src_span
+#' @inheritDotParams qto_src_span
 #' @keywords internal
-qto_fig_span <- function(src, caption = NULL, ...) {
-    fig_attributes <- qto_attributes(
-        ...
+qto_fig_span <- function(src,
+                         caption = NULL,
+                         ...,
+                         allow_missing = TRUE,
+                         allow_empty = FALSE,
+                         call = caller_env()) {
+    check_src(
+        src,
+        allow_missing = allow_missing,
+        allow_empty = allow_empty,
+        call = call
     )
 
-    if (fig_attributes == "{}") {
-        fig_attributes <- ""
-    }
-
-    qto_block(
-        "!",
-        bracket(caption),
-        parentheses(src),
-        fig_attributes
+    qto_src_span(
+        .before = "!",
+        text = caption,
+        src = src,
+        ...,
+        allow_missing = allow_missing,
+        allow_empty = allow_empty,
+        call = call
     )
 }

R/link.R

@@ -0,0 +1,79 @@
+#' Create a Markdown link
+#'
+#' @param src Path or URL for link. Required.
+#' @param text Optional link text. If link text is not provided, a bare link,
+#'   e.g. `<https://quarto.org>` is returned.
+#' @inheritParams check_src
+#' @inheritDotParams qto_attributes -.output -.drop_empty
+#' @examples
+#' qto_link("https://quarto.org")
+#'
+#' qto_link("https://quarto.org", "Quarto")
+#'
+#' qto_link("https://quarto.org", "Quarto", class = "smaller")
+#'
+#' @family span
+#' @export
+qto_link <- function(src,
+                     text = NULL,
+                     ...,
+                     allow_empty = FALSE,
+                     call = caller_env()) {
+    check_src(
+        src,
+        allow_empty = allow_empty,
+        call = call
+    )
+
+    if (is.null(text)) {
+        link <- qto_block(
+            combine(src, before = "<", after = ">"),
+            qto_attributes(
+                ...,
+                .output = "span",
+                call = call
+            ),
+            call = call
+        )
+
+        return(link)
+    }
+
+    qto_src_span(
+        src = src,
+        text = text,
+        ...,
+        allow_empty = allow_empty,
+        call = call
+    )
+}
+
+
+#' Simplified helper for `qto_link()`
+#'
+#' Also used by [qto_fig_span()]
+#'
+#' @param src Image source or URL.
+#' @param text Caption or link text.
+#' @inheritParams check_src
+#' @inheritDotParams qto_attributes
+#' @keywords internal
+qto_src_span <- function(src,
+                         text = NULL,
+                         .before = "",
+                         ...,
+                         allow_missing = FALSE,
+                         allow_empty = FALSE,
+                         call = caller_env()) {
+    qto_block(
+        .before,
+        bracket(text),
+        parentheses(src),
+        qto_attributes(
+            ...,
+            .output = "span",
+            call = call
+        ),
+        call = call
+    )
+}

R/span.R

@@ -6,6 +6,7 @@
 #' @param text Text to wrap in span bracket.
 #' @inheritParams qto_attributes
 #' @inheritDotParams qto_attributes
+#' @family span
 #' @examples
 #'
 #' qto_span("This is *some text*", class = "class", key = "value")

R/utilities-check.R

@@ -1,7 +1,19 @@
+#' Check source string
+#'
+#' Used by [qto_src_span()] to check input strings.
+#'
+#' @param x Input string. Typically a file path or URL.
+#' @param allow_missing If `FALSE` (default), error if string is not a URL and
+#'   not a valid web path. If `TRUE`, allow input to be a path to a non-existent
+#'   file.
+#' @param allow_empty If `FALSE` (default), error if string is empty. If `TRUE`,
+#'   allow input to be an empty string.
+#' @inheritParams rlang::args_error_context
+#' @keywords internal
 check_src <- function(x,
                       allow_missing = FALSE,
                       allow_empty = FALSE,
-                      arg = caller_arg(),
+                      arg = caller_arg(x),
                       call = caller_env()) {
     check_string(x, allow_empty = allow_empty, arg = arg, call = call)
     what <- "an existing file or a valid web path"