From bd78cf85f05f1fdadd7818206f0105c0ea792160 Mon Sep 17 00:00:00 2001
From: Chris Grandin <chris.grandin@gmail.com>
Date: Wed, 13 Nov 2024 10:01:40 -0800
Subject: [PATCH] Change calls to `knitr:::%n%` to `%||%` (#1480)

Co-authored-by: Yihui Xie <xie@yihui.name>
---
 R/bs4_book.R | 2 +-
 R/html.R     | 2 +-
 R/skeleton.R | 2 +-
 R/utils.R    | 4 ++--
 4 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/R/bs4_book.R b/R/bs4_book.R
index 8b1170bfe..1c6f59331 100644
--- a/R/bs4_book.R
+++ b/R/bs4_book.R
@@ -427,7 +427,7 @@ tweak_navbar <- function(html, toc, active = "", rmd_index = NULL, repo = NULL)
   }
 
   if (!is.null(repo$base)) {
-    icon <- repo$icon %n%
+    icon <- repo$icon %||%
       ifelse(grepl("github\\.com", repo$base), "fab fa-github", "fab fa-gitlab")
     template_link_icon(html, ".//a[@id='book-repo']", icon)
     template_link_icon(html, ".//a[@id='book-source']", icon)
diff --git a/R/html.R b/R/html.R
index c0a854ebd..dad883f82 100644
--- a/R/html.R
+++ b/R/html.R
@@ -881,7 +881,7 @@ add_chapter_prefix = function(content) {
 add_chapter_prefix_one = function(content, type = c('chapter', 'appendix')) {
   config = load_config()
   field = paste0(type, '_name')
-  chapter_name = config[[field]] %n% ui_language(field)
+  chapter_name = config[[field]] %||% ui_language(field)
   if (is.null(chapter_name) || identical(chapter_name, '')) return(content)
   chapter_fun = if (is.character(chapter_name)) {
     function(i) switch(
diff --git a/R/skeleton.R b/R/skeleton.R
index 0237c04ea..2c4227fc9 100644
--- a/R/skeleton.R
+++ b/R/skeleton.R
@@ -113,7 +113,7 @@ skeleton_get_dir = function(...) {
 
 skeleton_get_files = function(subdir = NULL, relative = TRUE) {
   resources = skeleton_get_dir()
-  subdir = file.path(resources, subdir %n% "")
+  subdir = file.path(resources, subdir %||% "")
   if (!dir.exists(subdir)) return(NULL)
   files = list.files(subdir, recursive = TRUE, include.dirs = FALSE, full.names = TRUE)
   if (relative) xfun::relative_path(files, resources) else files
diff --git a/R/utils.R b/R/utils.R
index a54a89bfd..501f48480 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -70,7 +70,7 @@ get_base_format = function(format, options = list()) {
 }
 
 load_config = function(config_file = '_bookdown.yml') {
-  config_file = opts$get('config_file') %n% config_file
+  config_file = opts$get('config_file') %||% config_file
   if (length(opts$get('config')) == 0 && file.exists(config_file)) {
     # store the book config
     opts$set(config = rmarkdown:::yaml_load_file(config_file))
@@ -489,7 +489,7 @@ verify_rstudio_version = function() {
 
 str_trim = function(x) gsub('^\\s+|\\s+$', '', x)
 
-`%n%` = knitr:::`%n%`
+if (getRversion() < '4.4.0') `%||%` = function(x, y) if (is.null(x)) y else x
 
 output_md = function() getOption('bookdown.output.markdown', FALSE)