Merge pull request #129 from jhudsl/cansavvy/quarto

quarto `get_chapters()` compatibility

.Rbuildignore

@@ -33,3 +33,4 @@ vignettes/.httr-oauth$
 ^package_bundles/leanbuild_0.1.2.tgz*
 inst/extdata/tmp/default*
 
+^CRAN-SUBMISSION$

CRAN-SUBMISSION

@@ -0,0 +1,3 @@
+Version: 1.2.1
+Date: 2024-01-09 15:20:24 UTC
+SHA: 60a69efa2a507c472471cf7ffb7c8d7d370d66ab

R/auth.R

@@ -78,7 +78,6 @@ authorize <- function(token = NULL, cache = FALSE, ...) {
 #' }
 #'
 auth_from_secret <- function(access_token = NULL, refresh_token = NULL) {
-
   # If no tokens are specified, we'll grab the default ones.
   if (is.null(access_token) | is.null(refresh_token)) {
     decrypted <- openssl::aes_cbc_decrypt(

R/bookdown_to_leanpub.R

@@ -434,13 +434,36 @@ make_embed_markdown <- function(url,
 get_chapters <- function(bookdown_index = file.path("docs", "index.html"),
                          base_url = NULL) {
   # Read in html
-  index_html <- suppressWarnings(try(xml2::read_html(paste(bookdown_index, collapse = "\n"))))
+  index_html <- suppressWarnings(try(xml2::read_html(bookdown_index)))
 
-  # Extract chapter nodes
+  # Extract chapter nodes the Rmd way
   nodes <- rvest::html_nodes(index_html, xpath = paste0("//", 'li[@class="chapter"]'))
 
-  if (length(nodes) > 0) {
-    # Format into a data.frame
+  # If the Rmd way didn't work, lets try the quarto way
+  if (length(nodes) < 1) {
+    # Get the sidebar stuff
+    nodes <- rvest::html_nodes(index_html, xpath = paste0("//", 'div[@class="sidebar-item-container"]'))
+
+    # We only want chapters
+    nodes <- nodes[grep("chapter",as.character(nodes))]
+
+    # Extract chapter nodes from the sidebar
+    chapt_titles <- nodes %>%
+      rvest::html_nodes('span.chapter-title') %>%
+      rvest::html_text()
+
+    data_level <- nodes %>%
+      rvest::html_nodes('span.chapter-number') %>%
+      rvest::html_text()
+
+    data_path <- nodes %>%
+      rvest::html_nodes('a.sidebar-item-text.sidebar-link') %>%
+      rvest::html_attr('href') %>%
+      stringr::str_remove("^\\.\\/")
+
+    chapt_data <- data.frame(chapt_titles, data_level, data_path)
+
+  } else {
     chapt_data <- rvest::html_attrs(nodes) %>%
       dplyr::bind_rows() %>%
       dplyr::rename_with(~ gsub("-", "_", .x, fixed = TRUE)) %>%
@@ -451,7 +474,9 @@ get_chapters <- function(bookdown_index = file.path("docs", "index.html"),
       dplyr::select(url, chapt_title) %>%
       as.data.frame() %>%
       dplyr::distinct(url, .keep_all = TRUE)
-  } else {
+  }
+
+  if (nrow(chapt_data) < 1) {
     stop(paste("Chapter retrieval from:", bookdown_index, "Failed."))
   }
 

R/data.R

@@ -1,4 +1,3 @@
-
 #' Get file path to an key encryption RDS
 key_encrypt_creds_path <- function() {
   list.files(

R/notes_to_fig_alt.R

@@ -21,7 +21,7 @@ get_gs_pptx <- function(id) {
     fr_header <- result$headers$`x-frame-options`
     if (!is.null(fr_header)) {
       if (all(fr_header == "DENY")) {
-       warn_them <- TRUE
+        warn_them <- TRUE
       }
     }
     if (httr::status_code(result) >= 300) {
@@ -30,15 +30,15 @@ get_gs_pptx <- function(id) {
     # don't write something if not really a pptx
     ctype <- result$headers$`content-type`
     if (httr::status_code(result) >= 400 &&
-        !is.null(ctype) && grepl("html", ctype)) {
+      !is.null(ctype) && grepl("html", ctype)) {
       file.remove(pptx_file)
     }
     if (grepl("ServiceLogin", result$url)) {
       warn_them <- TRUE
     }
     if (warn_them) {
       warning(
-       paste0(
+        paste0(
           "This presentation may not be available, ",
           "did you turn link sharing on?"
         )
@@ -50,11 +50,12 @@ get_gs_pptx <- function(id) {
 
 
 export_url <- function(id, page_id = NULL, type = "pptx") {
-  url = paste0(
+  url <- paste0(
     "https://docs.google.com/presentation/d/",
-    id, "/export/", type, "?id=", id)
+    id, "/export/", type, "?id=", id
+  )
   if (!is.null(page_id)) {
-    url = paste0(url, "&pageid=", page_id)
+    url <- paste0(url, "&pageid=", page_id)
   }
   url
 }
@@ -300,22 +301,25 @@ xml_notes <- function(file, collapse_text = TRUE, xpath = "//a:r//a:t") {
 #' extract_object_id(slide_url = "https://docs.google.com/presentation/d/1H5aF_ROKVxE-H
 #'                                FHhoOy9vU2Y-y2M_PiV0q-JBL17Gss/edit?usp=sharing")
 #' }
-extract_object_id = function(slide_url, token = NULL, access_token = NULL, refresh_token = NULL) {
+extract_object_id <- function(slide_url, token = NULL, access_token = NULL, refresh_token = NULL) {
   # Get Slide ID from URL
   id <- get_slide_id(slide_url)
   # Using Slide ID, create url that we'll send to GET
   get_url <- gsub("{presentationId}", id,
-              "https://slides.googleapis.com/v1/presentations/{presentationId}", fixed=TRUE)
+    "https://slides.googleapis.com/v1/presentations/{presentationId}",
+    fixed = TRUE
+  )
 
   # if token not provided, fetch token
   if (is.null(token)) {
-
     token_try <- try(get_token(), silent = TRUE)
 
     # We will supply credentials if none can be grabbed by get_token()
     if (is.null(token_try)) {
-      auth_from_secret(access_token = access_token,
-                       refresh_token = refresh_token)
+      auth_from_secret(
+        access_token = access_token,
+        refresh_token = refresh_token
+      )
     }
     token <- get_token()
   } # else user provides token
@@ -341,7 +345,7 @@ extract_object_id = function(slide_url, token = NULL, access_token = NULL, refre
 #'
 #' @examples
 #' \dontrun{
-#'  get_object_id_notes("https://docs.google.com/presentation/d/
+#' get_object_id_notes("https://docs.google.com/presentation/d/
 #'                       1H5aF_ROKVxE-HFHhoOy9vU2Y-y2M_PiV0q-JBL17Gss/edit?usp=sharing")
 #' }
 get_object_id_notes <- function(slide_url) {
@@ -356,4 +360,3 @@ get_object_id_notes <- function(slide_url) {
 
   data.frame(id = object_ids, notes = speaker_notes)
 }
-

R/set_up.R

@@ -23,7 +23,6 @@ get_bookdown_spec <- function(path = ".") {
 #'
 #' @return Returns the directory where the _bookdown.yml is contained.
 #' @export
-
 bookdown_path <- function(path = ".") {
   # See what unzip is being used
   operating_system <- Sys.info()[1]