From 0c7b29a96a8107ff0c7db0a718db1df3e49d7e60 Mon Sep 17 00:00:00 2001 From: Eli Pousson Date: Sun, 21 Jan 2024 23:59:40 -0500 Subject: [PATCH] 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 | 1 + R/attributes.R | 22 +++++++--- R/figures.R | 35 ++++++++++------ R/link.R | 79 +++++++++++++++++++++++++++++++++++ R/span.R | 1 + R/utilities-check.R | 14 ++++++- man/check_src.Rd | 37 ++++++++++++++++ man/qto_attributes.Rd | 13 ++++-- man/qto_fig.Rd | 5 +++ man/qto_fig_span.Rd | 35 ++++++++++------ man/qto_link.Rd | 52 +++++++++++++++++++++++ man/qto_span.Rd | 15 ++++++- man/qto_src_span.Rd | 54 ++++++++++++++++++++++++ tests/testthat/_snaps/link.md | 14 +++++++ tests/testthat/test-link.R | 9 ++++ 15 files changed, 348 insertions(+), 38 deletions(-) create mode 100644 R/link.R create mode 100644 man/check_src.Rd create mode 100644 man/qto_link.Rd create mode 100644 man/qto_src_span.Rd create mode 100644 tests/testthat/_snaps/link.md create mode 100644 tests/testthat/test-link.R diff --git a/NAMESPACE b/NAMESPACE index 09ac028..f9a60b0 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/attributes.R b/R/attributes.R index 6f99dab..c5c7824 100644 --- a/R/attributes.R +++ b/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 = "" ) } diff --git a/R/figures.R b/R/figures.R index 5ba7310..db4034a 100644 --- a/R/figures.R +++ b/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 ) } diff --git a/R/link.R b/R/link.R new file mode 100644 index 0000000..014fb2d --- /dev/null +++ b/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. `` 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 + ) +} diff --git a/R/span.R b/R/span.R index 6aaad1c..2b63b82 100644 --- a/R/span.R +++ b/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") diff --git a/R/utilities-check.R b/R/utilities-check.R index 4c2396b..22a67a5 100644 --- a/R/utilities-check.R +++ b/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" diff --git a/man/check_src.Rd b/man/check_src.Rd new file mode 100644 index 0000000..e87886b --- /dev/null +++ b/man/check_src.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-check.R +\name{check_src} +\alias{check_src} +\title{Check source string} +\usage{ +check_src( + x, + allow_missing = FALSE, + allow_empty = FALSE, + arg = caller_arg(x), + call = caller_env() +) +} +\arguments{ +\item{x}{Input string. Typically a file path or URL.} + +\item{allow_missing}{If \code{FALSE} (default), error if string is not a URL and +not a valid web path. If \code{TRUE}, allow input to be a path to a non-existent +file.} + +\item{allow_empty}{If \code{FALSE} (default), error if string is empty. If \code{TRUE}, +allow input to be an empty string.} + +\item{arg}{An argument name as a string. This argument +will be mentioned in error messages as the input that is at the +origin of a problem.} + +\item{call}{The execution environment of a currently +running function, e.g. \code{caller_env()}. The function will be +mentioned in error messages as the source of the error. See the +\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} +} +\description{ +Used by \code{\link[=qto_src_span]{qto_src_span()}} to check input strings. +} +\keyword{internal} diff --git a/man/qto_attributes.Rd b/man/qto_attributes.Rd index 4a1a970..6cc0b48 100644 --- a/man/qto_attributes.Rd +++ b/man/qto_attributes.Rd @@ -11,7 +11,8 @@ qto_attributes( ..., .attributes = NULL, .output = "embrace", - .drop_empty = TRUE + .drop_empty = TRUE, + call = caller_env() ) } \arguments{ @@ -29,10 +30,16 @@ pass to \code{\link[htmltools:css]{htmltools::css()}}.} \item{.attributes}{Optional list of attributes. If supplied, any attributes passed to \code{...} are ignored.} -\item{.output}{Output type. If "embrace", the returned attributes are -enclosed in curly brackets.} +\item{.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.} \item{.drop_empty}{If \code{TRUE}, empty attributes are dropped.} + +\item{call}{The execution environment of a currently +running function, e.g. \code{caller_env()}. The function will be +mentioned in error messages as the source of the error. See the +\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} } \description{ \code{\link[=qto_attributes]{qto_attributes()}} creates an attribute string used by \code{\link[=qto_div]{qto_div()}}, diff --git a/man/qto_fig.Rd b/man/qto_fig.Rd index 9cb3687..63f4f96 100644 --- a/man/qto_fig.Rd +++ b/man/qto_fig.Rd @@ -52,4 +52,9 @@ qto_fig("graphic.pdf", title = "Title of the graphic") } \seealso{ \code{\link[knitr:include_graphics]{knitr::include_graphics()}} + +Other span: +\code{\link{qto_link}()}, +\code{\link{qto_span}()} } +\concept{span} diff --git a/man/qto_fig_span.Rd b/man/qto_fig_span.Rd index 3fe4471..739d593 100644 --- a/man/qto_fig_span.Rd +++ b/man/qto_fig_span.Rd @@ -4,7 +4,14 @@ \alias{qto_fig_span} \title{Simplified helper for qto_fig()} \usage{ -qto_fig_span(src, caption = NULL, ...) +qto_fig_span( + src, + caption = NULL, + ..., + allow_missing = TRUE, + allow_empty = FALSE, + call = caller_env() +) } \arguments{ \item{src}{Image source. Either a file path or URL.} @@ -12,20 +19,22 @@ qto_fig_span(src, caption = NULL, ...) \item{caption}{Caption text} \item{...}{ - Arguments passed on to \code{\link[=qto_attributes]{qto_attributes}} + Arguments passed on to \code{\link[=qto_src_span]{qto_src_span}} \describe{ - \item{\code{id}}{Div or span identifier. If \code{id} does not start with \code{"#"}, the -hash character is applied as a prefix.} - \item{\code{class}}{Div or span class. If \code{class} does not start with \code{"."}, the -period character is applied as a prefix.} - \item{\code{css}}{If \code{{htmltools}} is installed, a list of css style attributes to -pass to \code{\link[htmltools:css]{htmltools::css()}}.} - \item{\code{.attributes}}{Optional list of attributes. If supplied, any attributes -passed to \code{...} are ignored.} - \item{\code{.output}}{Output type. If "embrace", the returned attributes are -enclosed in curly brackets.} - \item{\code{.drop_empty}}{If \code{TRUE}, empty attributes are dropped.} + \item{\code{text}}{Caption or link text.} }} + +\item{allow_missing}{If \code{FALSE} (default), error if string is not a URL and +not a valid web path. If \code{TRUE}, allow input to be a path to a non-existent +file.} + +\item{allow_empty}{If \code{FALSE} (default), error if string is empty. If \code{TRUE}, +allow input to be an empty string.} + +\item{call}{The execution environment of a currently +running function, e.g. \code{caller_env()}. The function will be +mentioned in error messages as the source of the error. See the +\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} } \description{ Simplified helper for qto_fig() diff --git a/man/qto_link.Rd b/man/qto_link.Rd new file mode 100644 index 0000000..9051094 --- /dev/null +++ b/man/qto_link.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/link.R +\name{qto_link} +\alias{qto_link} +\title{Create a Markdown link} +\usage{ +qto_link(src, text = NULL, ..., allow_empty = FALSE, call = caller_env()) +} +\arguments{ +\item{src}{Path or URL for link. Required.} + +\item{text}{Optional link text. If link text is not provided, a bare link, +e.g. \verb{} is returned.} + +\item{...}{ + Arguments passed on to \code{\link[=qto_attributes]{qto_attributes}} + \describe{ + \item{\code{id}}{Div or span identifier. If \code{id} does not start with \code{"#"}, the +hash character is applied as a prefix.} + \item{\code{class}}{Div or span class. If \code{class} does not start with \code{"."}, the +period character is applied as a prefix.} + \item{\code{css}}{If \code{{htmltools}} is installed, a list of css style attributes to +pass to \code{\link[htmltools:css]{htmltools::css()}}.} + \item{\code{.attributes}}{Optional list of attributes. If supplied, any attributes +passed to \code{...} are ignored.} + }} + +\item{allow_empty}{If \code{FALSE} (default), error if string is empty. If \code{TRUE}, +allow input to be an empty string.} + +\item{call}{The execution environment of a currently +running function, e.g. \code{caller_env()}. The function will be +mentioned in error messages as the source of the error. See the +\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} +} +\description{ +Create a Markdown link +} +\examples{ +qto_link("https://quarto.org") + +qto_link("https://quarto.org", "Quarto") + +qto_link("https://quarto.org", "Quarto", class = "smaller") + +} +\seealso{ +Other span: +\code{\link{qto_fig}()}, +\code{\link{qto_span}()} +} +\concept{span} diff --git a/man/qto_span.Rd b/man/qto_span.Rd index 15aa9f9..69122ba 100644 --- a/man/qto_span.Rd +++ b/man/qto_span.Rd @@ -18,9 +18,14 @@ hash character is applied as a prefix.} period character is applied as a prefix.} \item{\code{css}}{If \code{{htmltools}} is installed, a list of css style attributes to pass to \code{\link[htmltools:css]{htmltools::css()}}.} - \item{\code{.output}}{Output type. If "embrace", the returned attributes are -enclosed in curly brackets.} + \item{\code{.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.} \item{\code{.drop_empty}}{If \code{TRUE}, empty attributes are dropped.} + \item{\code{call}}{The execution environment of a currently +running function, e.g. \code{caller_env()}. The function will be +mentioned in error messages as the source of the error. See the +\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} }} \item{.attributes}{Optional list of attributes. If supplied, any attributes @@ -37,3 +42,9 @@ qto_span("This is *some text*", class = "class", key = "value") qto_span("This is good", id = "id", class = "class", key1 = "val1", key2 = "val2") } +\seealso{ +Other span: +\code{\link{qto_fig}()}, +\code{\link{qto_link}()} +} +\concept{span} diff --git a/man/qto_src_span.Rd b/man/qto_src_span.Rd new file mode 100644 index 0000000..de8f9f7 --- /dev/null +++ b/man/qto_src_span.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/link.R +\name{qto_src_span} +\alias{qto_src_span} +\title{Simplified helper for \code{qto_link()}} +\usage{ +qto_src_span( + src, + text = NULL, + .before = "", + ..., + allow_missing = FALSE, + allow_empty = FALSE, + call = caller_env() +) +} +\arguments{ +\item{src}{Image source or URL.} + +\item{text}{Caption or link text.} + +\item{...}{ + Arguments passed on to \code{\link[=qto_attributes]{qto_attributes}} + \describe{ + \item{\code{id}}{Div or span identifier. If \code{id} does not start with \code{"#"}, the +hash character is applied as a prefix.} + \item{\code{class}}{Div or span class. If \code{class} does not start with \code{"."}, the +period character is applied as a prefix.} + \item{\code{css}}{If \code{{htmltools}} is installed, a list of css style attributes to +pass to \code{\link[htmltools:css]{htmltools::css()}}.} + \item{\code{.attributes}}{Optional list of attributes. If supplied, any attributes +passed to \code{...} are ignored.} + \item{\code{.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.} + \item{\code{.drop_empty}}{If \code{TRUE}, empty attributes are dropped.} + }} + +\item{allow_missing}{If \code{FALSE} (default), error if string is not a URL and +not a valid web path. If \code{TRUE}, allow input to be a path to a non-existent +file.} + +\item{allow_empty}{If \code{FALSE} (default), error if string is empty. If \code{TRUE}, +allow input to be an empty string.} + +\item{call}{The execution environment of a currently +running function, e.g. \code{caller_env()}. The function will be +mentioned in error messages as the source of the error. See the +\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} +} +\description{ +Also used by \code{\link[=qto_fig_span]{qto_fig_span()}} +} +\keyword{internal} diff --git a/tests/testthat/_snaps/link.md b/tests/testthat/_snaps/link.md new file mode 100644 index 0000000..398208b --- /dev/null +++ b/tests/testthat/_snaps/link.md @@ -0,0 +1,14 @@ +# qto_link works + + Code + qto_link("https://quarto.org") + Output + + +--- + + Code + qto_link("https://quarto.org", "Quarto website") + Output + [Quarto website](https://quarto.org) + diff --git a/tests/testthat/test-link.R b/tests/testthat/test-link.R new file mode 100644 index 0000000..1a495e1 --- /dev/null +++ b/tests/testthat/test-link.R @@ -0,0 +1,9 @@ +test_that("qto_link works", { + expect_snapshot( + qto_link("https://quarto.org") + ) + + expect_snapshot( + qto_link("https://quarto.org", "Quarto website") + ) +})