feat: add multi-language support

R/get_calendar.R

@@ -8,6 +8,11 @@
 #'   
 #' @param weekend a `logical`. If `TRUE` keeps Saturdays and Sundays. Default is
 #'   `FALSE`.
+#' 
+#' @param lang a `character` of length 1. Used to change the default locale
+#'   (i.e. the language). Default is `NULL` (i.e. use the current locale).
+#'   See examples below. Depending on the OS and the locale, the output can be
+#'   weird.
 #'   
 #' @return A `data.frame` with the following columns:
 #' - `date`: the date of the day (`YYYY-MM-DD`),
@@ -34,9 +39,13 @@
 #' 
 #' ## Calendar for January 1970 ----
 #' head(get_calendar(year = 1970, month = 1))
+#' 
+#' ## Change the locale ----
+#' head(get_calendar(year = 1970, month = 1, lang = "spanish"))
 
 get_calendar <- function(year = format(Sys.Date(), "%Y"), 
-                         month = format(Sys.Date(), "%m"), weekend = FALSE) {
+                         month = format(Sys.Date(), "%m"), weekend = FALSE,
+                         lang = NULL) {
 
   ## Check args ----
 
@@ -72,9 +81,9 @@ get_calendar <- function(year = format(Sys.Date(), "%Y"),
 
   ## Switch to US locale ----
 
-  locale <- Sys.getlocale("LC_TIME")
+  lc_time    <- Sys.getlocale("LC_TIME")
+  on.exit(Sys.setlocale("LC_TIME", lc_time), add = TRUE)
   Sys.setlocale("LC_TIME", "en_US.UTF-8")
-  on.exit(Sys.setlocale("LC_TIME", locale))
 
 
   ## Create sequence of days ----
@@ -88,24 +97,44 @@ get_calendar <- function(year = format(Sys.Date(), "%Y"),
 
   ## Extract date info ----
 
-  calendar <- data.frame("date"       = dates,
-                         "year"       = as.integer(format(dates, "%Y")),
-                         "month"      = as.integer(format(dates, "%m")),
-                         "day"        = as.integer(format(dates, "%d")),
-                         "month_name" = tools::toTitleCase(format(dates, "%B")),
-                         "weekday"    = tools::toTitleCase(format(dates, "%A")),
-                         "week"       = as.integer(format(dates, "%W")))
+  calendar <- data.frame(
+    "date"          = dates,
+    "year"          = as.integer(format(dates, "%Y")),
+    "month"         = as.integer(format(dates, "%m")),
+    "day"           = as.integer(format(dates, "%d")),
+    "en_month_name" = tools::toTitleCase(format(dates, "%B")),
+    "en_weekday"    = tools::toTitleCase(format(dates, "%A")),
+    "week"          = as.integer(format(dates, "%W")))
+
+
+  ## Translate names ----
+
+  if (is.null(lang)) {
+    lang <- lc_time
+  }
+
+  Sys.setlocale("LC_TIME", lc_time)
+
+  calendar$"user_month_name" <- unlist(lapply(calendar$"month", 
+                                              get_month_name,
+                                              lang = lang))
+
+  calendar$"user_weekday"    <- unlist(lapply(calendar$"date", 
+                                              get_weekday_name,
+                                              lang = lang))
 
 
   ## Add position on x-axis (day of the week) ----
 
-  calendar <- merge(calendar, weekdays(), by = "weekday", all = TRUE)
+  calendar <- merge(calendar, weekdays(), by.x = "en_weekday", by.y = "weekday",
+                    all = TRUE)
 
 
   ## Remove weekend (if required) ----
 
   if (!weekend) {
-    calendar <- calendar[!(calendar$"weekday" %in% c("Saturday", "Sunday")), ]  
+    calendar <- calendar[!(calendar$"en_weekday" %in% 
+                             c("Saturday", "Sunday")), ]  
   }
 
 
@@ -131,8 +160,9 @@ get_calendar <- function(year = format(Sys.Date(), "%Y"),
 
   ## Order columns ----
 
-  calendar <- calendar[ , c("date", "year", "month", "day", "week", "weekday",
-                            "month_name", "x", "y")]
+  calendar <- calendar[ , c("date", "year", "month", "day", "week",
+                            "en_weekday", "en_month_name", "user_weekday", 
+                            "user_month_name","x", "y")]
 
   calendar
 }

R/plot_calendar.R

@@ -30,7 +30,12 @@
 #'   names match event categories. For example, let's that the `events` object
 #'   contains two categories (`cat_a` and `cat_b`), the `palette` argument must
 #'   be equal to `palette = c("cat_a" = "black", "cat_b" = "red")`.
-#'
+#' 
+#' @param lang a `character` of length 1. Used to change the default locale
+#'   (i.e. the language). Default is `NULL` (i.e. use the current locale).
+#'   See examples below. Depending on the OS and the locale, the output can be
+#'   weird.
+#'   
 #' @return No return value. The calendar will exported as a `pdf` file in 
 #' `path`.
 #' 
@@ -44,7 +49,8 @@
 plot_calendar <- function(year = format(Sys.Date(), "%Y"), 
                           month = format(Sys.Date(), "%m"), 
                           path = getwd(), filename = NULL, title = NULL, 
-                          events = NULL, weekend = FALSE, palette = "#990000") {
+                          events = NULL, weekend = FALSE, palette = "#990000",
+                          lang = NULL) {
 
   ## Check year ----
 
@@ -206,20 +212,20 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"),
 
   ## Get calendar data ----
 
-  calendar <- get_calendar(year, month, weekend)
+  calendar <- get_calendar(year, month, weekend, lang = lang)
   offs     <- days_off(year)
 
 
   ## Create title ----
 
   if (is.null(title)) {
-    title <- paste(unique(calendar[ , "month_name"]), year)
+    title <- paste(unique(calendar[ , "user_month_name"]), year)
   }
 
 
   ## Define x-axis range ----
 
-  x_lim <- c(0, length(unique(calendar$"weekday")))  
+  x_lim <- c(0, length(unique(calendar$"en_weekday")))  
 
 
   ## Define y-axis range ----
@@ -233,6 +239,28 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"),
   y_lim[1] <- ifelse(n_weeks == 4, 2, y_lim[1])
 
 
+  ## Switch locale ----
+
+  if (!is.null(lang)) {
+
+    o_warn <- options()$"warn"
+
+    lc_time    <- Sys.getlocale("LC_TIME")
+    lc_ctype   <- Sys.getlocale("LC_CTYPE")
+    lc_collate <- Sys.getlocale("LC_COLLATE")
+
+    on.exit(options("warn" = o_warn), add = TRUE)
+    on.exit(Sys.setlocale("LC_TIME",    lc_time), add = TRUE)
+    on.exit(Sys.setlocale("LC_CTYPE",   lc_ctype), add = TRUE)
+    on.exit(Sys.setlocale("LC_COLLATE", lc_collate), add = TRUE)
+
+    options("warn" = -1)
+    Sys.setlocale("LC_TIME",    lang)
+    Sys.setlocale("LC_CTYPE",   lang)
+    Sys.setlocale("LC_COLLATE", lang)
+  }
+
+
   ## Graphical parameters ----
 
   cairo_pdf(filename   = file.path(path, filename),
@@ -282,7 +310,7 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"),
 
     ## Add weekend ----
 
-    if (calendar[i, "weekday"] %in% c("Saturday", "Sunday")) {
+    if (calendar[i, "en_weekday"] %in% c("Saturday", "Sunday")) {
 
       rect(xleft   = calendar[i, "x"] - 1,
            xright  = calendar[i, "x"],
@@ -331,9 +359,12 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"),
 
   for (i in 1:nrow(weekdays())) {
 
+    label <- which(calendar$"en_weekday" == weekdays()[i, "weekday"])
+    label <- calendar[label[1], "user_weekday"]
+
     text(x      = weekdays()[i, "x"] - 0.5,
          y      = 5.95,
-         labels = weekdays()[i, "weekday"],
+         labels = label,
          cex    = 0.65,
          pos    = 3,
          font   = 2,