R/writePotfile.R

In sigbertklinke/gettext: Implements Localization of Texts Similar to 'GNU gettext'

#' writePotfile
#'
#' Creates a POT file from text extracted with \code{\link{xgettext}}.
#'
#' @param txt xgettext object
#' @param file character: a file name to save the POT file
#' @param all logical: export all strings (default: \code{TRUE})
#' @param R logical: export all strings into a R or POT format (default: \code{FALSE})
#' 
#' @return nothing
#' @export 
#'
#' @examples
#' txt  <- xgettext(system.file("shiny", "app1", "app.R", package="gettext"))
#' file <- sprintf("%s/myproject.pot", tempdir(TRUE))
#' writePotfile(txt, file)
writePotfile <- function(txt, file, all=TRUE, R=FALSE) {
  if (!('xxgettext' %in% class(txt))) stop("'txt' needs to be generated by 'xgettext")
  #
  lines <- c()
  if (R) {
    lines <- 'addPlural(nplurals=1, plural=function(n) { 0 }, lang=getOption("gettext.lang"), domain=getOption("gettext.domain"))'
  } else if (all(txt[,1]!='', na.rm=TRUE)) {
    lines <- c('msgid ""', 'msgstr ""', '"Project-Id-Version: \\n"', 
               sprintf('"POT-Creation-Date: %s\\n"', strftime(Sys.time())),
               '"PO-Revision-Date: \\n"', '"Last-Translator: \\n"', '"Language-Team: \\n"',
               '"MIME-Version: 1.0\\n"', '"Content-Type: text/plain; charset=UTF-8\\n"',
               '"Content-Transfer-Encoding: 8bit\\n"',
               '"X-Generator: R gettext 0.1\\n"', '')
  }
  
  for (i in 1:nrow(txt)) {
    if (all && (txt[i,1]=='')) {
      if (R) {
        lines <- c(lines, 
                   sprintf('addMsg("%s", "", context=%s, lang=getOption("gettext.lang"), domain=getOption("gettext.domain"))',
                           txt[i,2],
                           if(is.na(txt[i,4])) 'NA' else  shQuote(txt[i,4], 'cmd'))
        )
      } else {
        lines <- c(lines, 
                   sprintf("%-15s \"%s\"", 'msgid', txt[i,2]), 
                   sprintf("%-15s \"%s\"", 'msgstr', ''), 
                   '')
      }
    }
    if (txt[i,1] %in% c('gettext', 'G')) {
      if (is.na(txt[i,2])) {
        warning(sprintf('Entry %.0f ignored: %s', i, toString(txt[i,])))
      } else {
        if (R) {
          lines <- c(lines, 
                     sprintf('addMsg("%s", "", context=%s, lang=getOption("gettext.lang"), domain=getOption("gettext.domain"))',
                             txt[i,2],
                             if(is.na(txt[i,4])) 'NA' else  shQuote(txt[i,4], 'cmd'))
          )
        } else {
          if (!is.na(txt[i,4])) lines <- c(lines, sprintf("%-15s \"%s\"", 'msgctxt', txt[i,4]))
          lines <- c(lines, 
                     sprintf("%-15s \"%s\"", 'msgid', txt[i,2]), 
                     sprintf("%-15s \"%s\"", 'msgstr', ''),
                     '')
        }
      }
    }
    if (txt[i,1] %in% c('ngettext', 'N')) {
      if (is.na(txt[i,2]) || is.na(txt[i,3])) {
        warning(sprintf('Entry %.0f ignored: %s', i, toString(txt[i,])))
      } else {
        if (R) {
          lines <- c(lines, 
                     sprintf('addMsg("%s", c("", ""), plural="%s", context=%s, lang=getOption("gettext.lang"), domain=getOption("gettext.domain"))',
                             txt[i,2],
                             txt[i,3],
                             if(is.na(txt[i,4])) 'NA' else shQuote(txt[i,4], 'cmd'))
          )
                     
        } else {
          if (!is.na(txt[i,4])) lines <- c(lines, sprintf("%-15s \"%s\"", 'msgctxt', txt[i,4]))
          lines <- c(lines, 
                     sprintf("%-15s \"%s\"", 'msgid', txt[i,2]), 
                     sprintf("%-15s \"%s\"", 'msgid_plural', txt[i,3]), 
                     sprintf("%-15s \"%s\"", 'msgstr[0]', ''),
                     sprintf("%-15s \"%s\"", 'msgstr[1]', ''),
                     '')
        }
      }
    }
  }
  if (R) lines <- c(lines, 'printWarnings()')
  writeLines(lines, file, useBytes=TRUE)
}