## Do not edit this file manually.
## It has been automatically generated from *.org sources.

# TODO: krapka!
.patch_latex <- function(txt){   # print(bibentry,"latex") inserts \bsl macros.
    gsub("\\bsl{}", "", txt, fixed=TRUE)
}

## extract `key' from a bibentry object. I used this to set the 'names' attribute of objects
##     produced by bibtex (< 0.4.0). Don't remember why I didn't use unlist(x$key).
##
## not used anymore
bibentry_key <- function(x){                                                     # 2013-03-29
    .Deprecated("x[[1]]$key or unlist(x$key)")
    attr(unclass(x[[1]][[1]])[[1]], "key")
}

## maybe add to package `gbutils'?
##
## if `wd' is a subdirectory of `string' return the path upto and including `string',
##     otherwise return NULL.
## If not NULL, it is guaranteed that basename(wd) == string
## NOTE: currently doesn't expand `./', etc..
in_subdirectory <- function(string, wd = getwd()){
    if(grepl(string, wd)){
        packpat <- paste0(string, "$")
        while(!grepl(packpat, wd)){
            wd <- dirname(wd)
            if(!grepl(string, wd))
                return(NULL)
        }
        if(basename(wd) == string)
            wd
        else
            ## the found directory has `string' as a suffix, eg. xxxRdpack, not Rdpack
            NULL
    }else
        NULL
}

get_bibentries <- function(..., package = NULL, bibfile = "REFERENCES.bib", 
                           url_only = FALSE, stop_on_error = TRUE){

    if(is.null(package)){
        fn <- file.path(..., bibfile)
        ## check for existence of fn (and length(fn) == 1)? (but see below)
    }else{
        ## first check for development mode in "devtools"

        ## if the current directory is under `package', first look for the file there
        devdir <- in_subdirectory(package)
        if(is.null(devdir))
            fn <- ""
        else{
            ## if in development dir of `package', get it from there
            fn <- file.path(devdir, "inst", ..., bibfile)
            if(length(fn) > 1){
                warning("More than one file found, using the first one only.")
                fn <- fn[1]
            }
            if(!file.exists(fn))
                fn <- ""
        }

        if(fn == "") 
            ## if the above didn't succeed, try system.file(). In principle, this should work
            ##     also in development mode under devtools, at least for REFERENCES.bib,
            ##     but currently devtools' system.file() doesn't handle it.
            fn <- system.file(..., bibfile, package = package)
        
        if(fn == "") 
            ## if the above didn't succeed try system.file() with subdir "inst".
            ##    This is really for the case when system.file() is the one from devtools,
            ##    see the note above. TODO: check if this is the case?
            fn <- system.file("inst", ..., bibfile, package = package)
        
        if(length(fn) == 1  &&  fn == "")
            ## if system.file() didn't find the bib file, check if file package.bib is
            ## provided by package "bibtex" (it is for core R packages, such as "base")
            fn <- system.file("bib", sprintf("%s.bib", package), package = "bibtex")
    }

    if(length(fn) > 1){
        warning("More than one file found, using the first one only.")
        fn <- fn[1]
    }else if(length(fn) == 1  &&  fn == ""){
        msg <- paste0("Couldn't find file ", file.path(..., bibfile),
                      if(!is.null(package)) paste0(" in package `", package, "'"))
        if(stop_on_error)
            stop(msg)
        else{
            warning(msg)
            ## return an empty bibentryRd object
            res <- bibentry()
            class(res) <- c("bibentryRd", class(res))
            return(res)
        }
            
    }

    ## 2018-10-03
    ## use package encoding if specified.
    ## TODO: maybe this function should have argument 'encoding'
    ## TODO: in principle the  Rd file may have its own encoding,
    ##       but my current understanding is that parse_Rd() first converts it to UTF-8.
    ##   BUT what is the encoding of the strings in the object returned by read.bib?
    encoding <- if(!is.null(package) && !is.null(utils::packageDescription(package)$Encoding))
                    utils::packageDescription(package)$Encoding
                else
                    "UTF-8"

    res <- read.bib(file = fn, encoding = encoding)

         # 2018-03-10 commenting out
         #      since bibtex v. >= 0.4.0 has been required for a long time in DESCRIPTION
         #
         #    ## 2016-07-26 Now do this only for versions of  bibtex < '0.4.0'.
         #    ##            From bibtex '0.4.0' read.bib() sets the names.
         #    if(packageVersion("bibtex") < '0.4.0'){
         #        names(res) <- sapply(1:length(res), function(x) bibentry_key(res[[x]][[1]]))
         #    }

    for(nam in names(res)){
        ## unconditionaly recode %'s in filed URL
        if(!is.null(res[nam]$url))
            res[nam]$url <- gsub("([^\\])%", "\\1\\\\%", res[nam]$url)

        if(url_only){  # process also other fields
            ## TODO: currently all unescaped $'s in all fields are recoded;
            ##       Maybe do it more selectively, e.g. only for %'s inside \url{},
            ##       or matching something like http(s):// 
            fields <- names(unclass(res[nam])[[1]])

            unclassed <- unclass(res[nam])
            flag <- FALSE
            for(field in fields){
                wrk <- unclass(res[nam])[[1]][[field]]
                if(is.character(wrk) && any(grepl("([^\\])%", wrk))){
                    flag <- TRUE
                    unclassed[[1]][[field]] <- gsub("([^\\])%", "\\1\\\\%", wrk)
                }
            }
            if(flag){
                class(unclassed) <- class(res[nam])
                res[nam] <- unclassed
            }
        }
    }

    ## 2018-03-03 new:
    class(res) <- c("bibentryRd", class(res))

    res
}

print.bibentryRd <- function (x, style = "text", ...){
    class(x) <- class(x)[-1]
    ## TODO: It would be better to modify the entries and then call
    ##       print(), rather than vice versa as now.
    res <- capture.output(print(x, style = style, ...))
    res <- switch(tolower(style),
                  r        = gsub("\\\\\\\\%", "%", res),
                  citation = ,
                  bibtex   = gsub("\\\\%", "%", res),

                  res
                  )
    cat(res, sep = "\n")
}

rebib <- function(infile, outfile, ...){                     # 2013-03-29
    rdo <- permissive_parse_Rd(infile)   ## 2017-11-25 TODO: argument for RdMacros!

    if(missing(outfile))
        outfile <- basename(infile)
    else if(identical(outfile, ""))  # 2013-10-23 else clause is new
        outfile <- infile

    rdo <- inspect_Rdbib(rdo, ...)

    Rdo2Rdf(rdo, file=outfile, srcfile=infile)

    rdo
}

inspect_Rdbib <- function(rdo, force = FALSE, ...){               # 2013-03-29
                   # 2013-12-08 was: pos <- Rdo_locate_predefined_section(rdo, "\\references")
    pos <- Rdo_which_tag_eq(rdo, "\\references")

    if(length(pos) > 1)
        stop(paste("Found", length(pos), "sections `references'.\n",
                   "There should be only one."
                   ))
    else if(length(pos) == 0)  # no section "references".
        return(rdo)

    bibs <- get_bibentries(...)

    fkey <- function(x){
                 m <- gregexpr("[ ]+", x)
                 rm <- regmatches(x, m, invert = TRUE)[[1]]
                 if(length(rm) >= 2 && rm[2] != "bibentry:")
                     rm[2]   # e.g. bibentry:all
                 else if(length(rm) < 3)     # % bibentry: xxx_key_xxx
                     ""   # NA_character_
                 else
                     rm[3]
             }

    fbib <- function(x) grepl("[ ]+bibentry:", x)
    posbibs <-  Rdo_locate(rdo[[pos]], f = fbib, pos_only = fkey)
    poskeys <- sapply(posbibs, function(x) x$value)

    print(posbibs)

    fendkey <- function(x){
                 m <- gregexpr("[ ]+", x)
                 rm <- regmatches(x, m, invert = TRUE)[[1]]
                 if(length(rm) >= 2 && rm[2] != "end:bibentry:")
                     rm[2]   # e.g. end:bibentry:all
                 else if(length(rm) < 3)     # % end:bibentry: xxx_key_xxx
                     ""   # NA_character_
                 else
                     rm[3]
             }

    fendbib <- function(x) grepl("end:bibentry:", x)
    posendbibs <-  Rdo_locate(rdo[[pos]], f = fendbib, pos_only = fendkey)
    posendkeys <- sapply(posendbibs, function(x) x$value)

    toomit <- which(poskeys %in% posendkeys)  # note: en@bibkeys:all is different! todo:
    if(length(toomit) > 0  && !force){
        poskeys <- poskeys[-toomit]
        posbibs <- posbibs[-toomit]
    }

    if(length(poskeys)==0)
        "nothing to do."
    else if(any(poskeys == "bibentry:all")){
        poskey <- posbibs[[ which(poskeys == "bibentry:all") ]]$pos

        bibstxt <- capture.output(print(bibs, "latex"))

        bibstxt <- .patch_latex(bibstxt)  # TODO: krapka!

        bibstxt <- paste(c("", bibstxt), "\n", sep="")
        endbibline <- Rdo_comment("% end:bibentry:all")

        keyflag <- "end:bibentry:all" %in% posendkeys
        if(keyflag && force){              #todo: more careful!
            endposkey <- posendbibs[[ which(posendkeys == "end:bibentry:all") ]]$pos
            rdo[[pos]] <- Rdo_flatremove(rdo[[pos]], poskey+1, endposkey)
        }

        if(!keyflag || force){
            rdo[[pos]] <- Rdo_flatinsert(rdo[[pos]], list(endbibline), poskey,
                                         before = FALSE)
            rdo[[pos]] <- Rdo_flatinsert(rdo[[pos]], bibstxt, poskey,
                                         before = FALSE)
        }
    }else{
        for(i in length(poskeys):1){
            bibkey <- posbibs[[i]]$value
            poskey <- posbibs[[i]]$pos

            bibstxt <- capture.output(print(bibs[poskeys[i]],"latex"))

            bibstxt <- .patch_latex(bibstxt)  # TODO: krapka!

            bibstxt <- list( paste( c("", bibstxt), "\n", sep="") )
            endbibline <- Rdo_comment(paste("% end:bibentry: ", bibkey))

            keyflag <- bibkey %in% posendkeys
            if(keyflag && force){                                       #todo: more careful!
                endposkey <- posendbibs[[ which(posendkeys == bibkey) ]]$pos
                rdo[[pos]] <- Rdo_flatremove(rdo[[pos]], poskey+1, endposkey)
            }

            if(!keyflag || force){ # this is always TRUE here but is left for common look
                                   # with "all". todo: needs consolidation
                rdo[[pos]] <- Rdo_flatinsert(rdo[[pos]], list(endbibline), poskey,
                                             before = FALSE)
                rdo[[pos]] <- Rdo_flatinsert(rdo[[pos]], bibstxt, poskey,
                                             before = FALSE)
            }
        }
    }

    rdo
}

Rdo_flatremove <- function(rdo, from, to){  # 2013-03-30 todo: more careful!
    res <- rdo[-(from:to)]
    attributes(res) <- attributes(rdo)             # todo: more guarded copying of attributes?
    res
}

                                        # todo: move to another file later
Rdo_flatinsert <- function(rdo, val, pos, before = TRUE){                        # 2013-03-29
    depth <- length(pos)
    if(depth > 1){
        rdo[[pos]] <- Recall(rdo[[ pos[-depth] ]], val, pos[-depth])
        # todo: dali zapazva attributite na rdo?
        return(rdo)
    }

    n <- length(rdo)
    if(!before)
        pos <- pos + 1

    res <- if(pos==1)        c(val, rdo)
           else if(pos==n+1) c(rdo, val)
           else              c( rdo[1:(pos-1)], val, rdo[pos:n])
    attributes(res) <- attributes(rdo)             # todo: more guarded copying of attributes?
    res
}

## TODO: auto-deduce 'package'?
insert_ref <- function(key, package = NULL, ...) { # bibfile = "REFERENCES.bib"
    if(is.null(package)) 
        stop("argument 'package' must be provided")

    bibs <- get_bibentries(package = package, ..., stop_on_error = FALSE)

    if(length(bibs) == 0){
        note <- paste0("\"Failed to insert reference with key = ", key, 
                       " from package = '", package, "'.",
                       " Possible cause --- missing REFERENCES.bib in package '",
                       package, "' or '", package, "' not installed.\""
                       )
        note <- paste0("\\Sexpr[results=rd,stage=install]{{warning(", note, ");", note, "}} ")
        item <- bibentry(
            bibtype = "Misc",
            title = "Not avalable",
            author = person("A", "Adummy"),
            year = format(Sys.time(), "%Y"),
            note = note,
            key = key
        )
        .toRd_styled(item, package)
    }else if(length(key) == 1){
        item <- tryCatch(bibs[[key]],
                         warning = function(c) {
                             if(grepl("subscript out of bounds", c$message)){
                                 ## tell the user the offending key.
                                 s <- paste0("possibly non-existing key '", key, "'")
                                 c$message <- paste0(c$message, " (", s, ")")
                             }
                             warning(c)
                                 # res <- paste0("\nWARNING: failed to insert reference '", key,
                                 #               "' from package '", package, "' - ",
                                 #               s, ".\n")
                                 # return(res)
                             ## setup a dummy entry
                             bibentry(
                                 bibtype = "Misc",
                                 title = "Not avalable",
                                 author = person("A", "Adummy"),
                                 year = format(Sys.time(), "%Y"),
                                 note = paste0("Failed to insert reference with key = ", key, 
                                               " from package = '", package, "'.",
                                               " Possible cause --- missing or misspelled key."
                                               ),
                                 key = key
                             )
                         })

            #     # 2018-03-01 Bug: Unexpected END_OF_INPUT error (URL parsing?) #3
            #     #     I don't know why toRd() doesn't do this...
            #     #
            #     # escape percents that are not preceded by backslash
            #     #  (the `if' is because in case of error above, item will be simply a string)
            #
            # Commenting out since get_bibentries() does it.
            #     if(inherits(item, "bibentry")  &&  !is.null(item$url))
            #         item$url <- gsub("([^\\])%", "\\1\\\\%", item$url)

# if(interactive()) browser()

            # wrk <- .toRd_styled(item, package) # TODO: add styles? (doesn't seem feasible here)
            # fn <- tempfile()
            # cat(wrk, file = fn)
            # res <- permissive_parse_Rd(fn) ## tools::parse_Rd(fn)
            # tools::toRd(res)
            # 
            # wrk <- .toRd_styled(item, package) 
            # Encoding(wrk) <- "bytes"
            # wrk
            # 
        .toRd_styled(item, package) 
    }else{
        ## key is documented to be of length one, nevertheless handle it too
        kiki <- FALSE
        items <- withCallingHandlers(bibs[[key]], warning = function(w) {kiki <<- TRUE})
        ## TODO: deal with URL's as above
        txt <- .toRd_styled(items, package)

        if(kiki){ # warning(s) in bibs[[key]]
            s <- paste0("WARNING: failed to insert ",
                        "one or more of the following keys in REFERENCES.bib:\n",
                        paste(key, collapse = ", \n"), ".")
            warning(s)
            txt <- c(txt, s)
        }
        paste0(paste(txt, collapse = "\n\n"), "\n")
    }
}

## 2017-11-25 new
## see utils:::print.help_files_with_topic()
viewRd <- function(infile, type = "text", stages = NULL){
    infile <- normalizePath(infile)

    if(is.null(stages))
        # stages <- c("install", "render")
        stages <- c("build", "install", "render")
        # stages <- c("build", "render")
    else if(!is.character(stages) || !all(stages %in% c("build", "install", "render")))
        stop('stages must be a character vector containing one or more of the strings "build", "install", and "render"')

    ## here we need to expand the Rd macros, so don't use permissive_parse_Rd()
    ## TODO: (BUG) e is NULL under RStudio
    e <- tools::loadPkgRdMacros(system.file(package = "Rdpack"))
    ## Rdo <- parse_Rd(infile, macros = e)

    pkgname <- basename(dirname(dirname(infile)))
    outfile <- tempfile(fileext = paste0(".", type))

    ## can't do this, the file may be deleted before the browser opens it:
    ##        on.exit(unlink(outfile))
    switch(type,
           text = {
               temp <- tools::Rd2txt(infile, # was: Rdo,
                                     out = outfile, package = pkgname, stages = stages
                                     , macros = e)
               file.show(temp, delete.file = TRUE) # text file is deleted
           },
           html = {
               temp <- tools::Rd2HTML(infile, # was: Rdo,
                                      out = outfile, package = pkgname,
                                      stages = stages
                                      , macros = e)
               browseURL(temp)
               ## html file is not deleted
#browser()
           },
           stop("'type' should be one of 'text' or 'html'")
           )
}

## temporary; not exported
vigbib <- function(package, verbose = TRUE, ..., vig = NULL){
    if(!is.null(vig))
        return(makeVignetteReference(package, vig, ...))

    vigs <- vignette(package = package)
    if(nrow(vigs$results) == 0){
        if(verbose)
            cat("No vignettes found in package ", package, "\n")
        return(bibentry())
    }
    wrk <- lapply(seq_len(nrow(vigs$results)),
                  function(x) makeVignetteReference(package = package, vig = x,
                                                    verbose = FALSE, ...)
                  )
    res <- do.call("c", wrk)
    if(verbose)
        print(res, style = "Bibtex")
    invisible(res)
}

makeVignetteReference <- function(package, vig = 1, verbose = TRUE,
                                  title, author, type = "pdf",
                                  bibtype = "Article", key = NULL
                                  ){
    publisher <- NULL # todo: turn this into an argument some day ...

    if(missing(package))
        stop("argument 'package' is missing with no default")

    cranname <- "CRAN"
    cran <- "https://CRAN.R-Project.org"
    cranpack <- paste0(cran, "/package=", package)

    ## todo: for now only cran
    if(is.null(publisher)){
        publisher <- cran
        publishername <- cranname
        publisherpack <- cranpack
    }

    desc <- packageDescription(package)
    vigs <- vignette(package = package)

    if(is.character(vig)){
        vig <- pmatch(vig, vigs$results[ , "Item"])
        if(length(vig) == 1  &&  !is.na(vig)){
            wrk <- vigs$results[vig, "Title"]
        }else
            stop(paste0("'vig' must (partially) match one of:\n",
                        paste0("\t", 1:nrow(vigs$results), " ", vigs$results[ , "Item"], "\n",
                               collapse = "\n"),
                        "Alternatively, 'vig' can be the index printed in front of the name above."))
    }else if(1 <= vig  && vig <= nrow(vigs$results)){
        wrk <- vigs$results[vig, "Title"]
    }else{
        stop("not ready yet, should return all vigs in the package.")
    }


    if(missing(author))
        author <- desc$Author

    title <- gsub(" \\([^)]*\\)$", "", wrk)  # drop ' (source, pdf)'
    item <- vigs$results[vig, "Item"]
    vigfile <- paste0(item, ".", type)

    journal <- paste0("URL ", publisherpack, ".",
                      " Vignette included in R package ", package,
                      ", version ", desc$Version
                      )

    if(is.null(desc$Date)){ # built-in packages do not have field "year"
        if(grepl("^Part of R", desc$License[1])){
            ## title <- paste0(title, "(", desc$License, ")")
            publisherpack <- cran ## do not add package=... to https in this case
            journal <- paste0("URL ", publisherpack, ".",
                              " Vignette included in R package ", package,
                              " (", desc$License, ")"
                              )
        }
        year <- R.version$year
    }else
        year <- substring(desc$Date, 1, 4)

                 # stop(paste0("argument 'vig' must be a charater string or an integer\n",
                 #            "between 1 and the number of vignettes in the package"))

    if(is.null(key))
        key <- paste0("vig", package, ":", vigs$results[vig, "Item"])

    res <- bibentry(
        key = key,
        bibtype = bibtype,
        title = title,
        author = author,
        journal = journal,
        year = year,
        ## note = "R package version 1.3-4",
        publisher = publishername,
        url = publisherpack
    )

    if(verbose){
        print(res, style = "Bibtex")
        cat("\n")
    }
    res
}

## 2018-03-13 new
insert_citeOnly <- function(keys, package = NULL, before = NULL, after = NULL,
                            bibpunct = NULL, ..., 
       cached_env = NULL, cite_only = FALSE, dont_cite = FALSE) { # bibfile = "REFERENCES.bib"

    if(!is.null(cached_env)){
        if(is.null(cached_env$refsmat))
            cached_env$refsmat <- matrix(character(0), nrow = 0, ncol = 2)
        if(is.null(cached_env$allbibs))
            cached_env$allbibs <- list()
    }

    if(is.null(package))
        stop("argument 'package' must be provided")

    if(length(keys) > 1)
        stop("`keys' must be a character string")

    if(!cite_only)
        cached_env$refsmat <- rbind(cached_env$refsmat, c(keys, package))

    if(dont_cite)
        return(character(0))


    textual <- grepl(";textual$", keys)
    if(textual)
        keys <- gsub(";textual$", "", keys)

    if(grepl("[^a-zA-Z.0-9]", package)){
        delims <- gsub("[a-zA-Z.0-9]", "", package)
        ch <- substr(delims, 1, 1)
        wrk <- strsplit(package, ch, fixed = TRUE)[[1]] # note: [[1]]
        package <- wrk[1]
        if(length(wrk) > 1){
            if(nchar(wrk[2]) > 1 || nchar(wrk[2]) == 1  && wrk[2] != " ")
                before <- wrk[2]
            if(length(wrk) > 2 && (nchar(wrk[3]) > 1 || nchar(wrk[3]) == 1  && wrk[3] != " "))
                after <- wrk[3]
        }
    }


    if(is.null(cached_env)){
        bibs <- get_bibentries(package = package, ..., stop_on_error = FALSE)
    }else{
        bibs <- cached_env$allbibs[[package]]
        if(is.null(bibs)){
            bibs <- get_bibentries(package = package, ..., stop_on_error = FALSE)
            cached_env$allbibs[[package]] <- bibs
        }
    }



       ## This wouldn't work since roxygen2 will change it to citation
       ##    TODO: check
       ## if(substr(keys, 1, 1) == "["){ # rmarkdown syntax (actually roxygen2?)
       ##     keys <- substr(keys, 2, nchar(keys) - 1) # drop "[" and the closing "]"
       ##     splitkeys <- strsplit(keys, ";", fixed = TRUE)[[1]] # note: [[1]]
       ##
       ##
       ##
       ## }

    refch <-  "@"
    refchpat <- paste0("^[", refch, "]")
    if(grepl(refchpat, keys)){
        ch <- substr(keys, 1, 1) # 'ch' is not used currently
        keys <- substr(keys, 2, nchar(keys)) # drop refch
        ## TODO: check if there are still @'s at this point

        refpat <- paste0("(", refch, "[^;,()[:space:]]+)")  #  "(@[^;,[:space:]]+)"
        if(textual){
            wrkkeys <- strsplit(keys, "@")[[1]] # note [[1]] !!!

            ## the last key is special, since there is none after it
            nk <- length(wrkkeys)
            wrkkeys[nk] <- if(grepl("[;,]$", wrkkeys[nk]))
                               sub("([;,])$", ")\\1", wrkkeys[nk])
                           else
                               paste0(wrkkeys[nk], ")")

            ## the 2nd element contains the first key even if the string starts with '@'
            ##    (if that is the case the first string is "")
            if(nk > 2){
                for(i in 2:(nk - 1)){
                    wrkkeys[i] <- if(grepl("([;,][^;,]*)$", wrkkeys[i]))
                                      sub("([;,][^;,]*)$", ")\\1" , wrkkeys[i])
                                  else
                                      sub("^([^;,()[:space:]]+)", "\\1)" , wrkkeys[i])
                }
            }
            keys <- paste0(wrkkeys, collapse = refch)
        }

        m <- gregexpr(refpat, keys)
        allkeys <- regmatches(keys, m)[[1]] # note: [[1]]
        allkeys <- gsub(refch, "", allkeys)

        if(textual){
            bibpunct0 = c("(", ")", ";", "a", "", ",")
            if(!is.null(bibpunct)){
                if(length(bibpunct) < length(bibpunct0))
                    bibpunct <- c(bibpunct, bibpunct0[-seq_len(length(bibpunct))])
                ind <- which(is.na(bibpunct))
                if(length(ind) > 0)
                    bibpunct[ind] <- bibpunct0[ind]
            }else
                bibpunct <- bibpunct0
        }else{
            ## for now ignore bibpunct in this case
            bibpunct <- c("", "", ";", "a", "", ",")
        }

        refs <- sapply(allkeys,
                       function(key)
                           safe_cite(key, bibs, textual = textual, bibpunct = bibpunct,
                                     from.package = package)
                       )
        if(textual){
            ## drop ")" - strong assumption that that is the last char
            refs <- sapply(refs, function(s) substr(s, 1, nchar(s) - 1))
        }

        ## replace keys with citations
        text <- keys
        regmatches(text, m) <- list(refs)

        if(!textual) # 2018-03-28 don't put patentheses in textual mode
            text <- paste0("(", text, ")")
    }else{
        if(is.null(bibpunct))
            text <- safe_cite(keys, bibs, textual = textual, before = before, after = after
                            , from.package = package)
        else{
            bibpunct0 = c("(", ")", ";", "a", "", ",")
            if(length(bibpunct) < length(bibpunct0))
                bibpunct <- c(bibpunct, bibpunct0[-seq_len(length(bibpunct))])
            ind <- which(is.na(bibpunct))
            if(length(ind) > 0)
                bibpunct[ind] <- bibpunct0[ind]

            text <- safe_cite(keys, bibs, textual = textual, before = before, after = after,
                              bibpunct = bibpunct, from.package = package)
        }
    }
    
    toRd(text)
}

safe_cite <- function(keys, bib, ..., from.package = NULL){
    wrk.keys <- unlist(strsplit(keys, ","))
    if(!all(wrk.keys %in% names(bib))){
        ok <- wrk.keys %in% names(bib)
        miss.keys <- wrk.keys[!ok]
        warning("possibly non-existing key(s)", 
                if(!is.null(from.package))
                    paste0(" in bib file from package '", from.package, "'"),
                ":\n    ", paste(miss.keys, sep = ", "), "\n")

        keys <- wrk.keys[ok]
    }

        # 2018-06-02 was: cite(keys = keys, bib = bib, ...)
    cite(keys = keys, bib = bib, longnamesfirst = FALSE, ...)
}

insert_all_ref <- function(refs, style = ""){
    if(is.environment(refs)){
        refsmat <- refs$refsmat
        allbibs <- refs$allbibs
        if(is.null(allbibs))
            allbibs <- list()
    }else{
        refsmat <- refs
        allbibs <- list()
    }

    if(is.null(refs) || is.null(refsmat) || nrow(refsmat) == 0)
        ## Returning the empty string is probably preferable but 'R CMD check' does not see
        ## that the references are empty in this case (although the help system see this and
        ## drops the section "references". To avoid confusing the user, print some
        ## informative text.
        return("There are no references for Rd macro \\verb{\\insertAllCites} on this help page.")

    all.keys <- list()
    for(i in 1:nrow(refsmat)){
        keys <- refsmat[i, 1]

        textual <- grepl(";textual$", keys)
        if(any(textual))
            keys <- gsub(";textual", "", keys)

        refch <-  "@"
        refchpat <- paste0("^[", refch, "]")
        if(grepl(refchpat, keys)){
            ch <- substr(keys, 1, 1)
            keys <- substr(keys, 2, nchar(keys)) # drop refch

            refpat <- paste0("(", refch, "[^;,[:space:]]+)")  #  "(@[^;,[:space:]]+)"
            m <- gregexpr(refpat, keys)
            keys <- regmatches(keys, m)[[1]] # note: [[1]]
            keys <- gsub("@", "", keys)
        }else{
             keys <- unlist(strsplit(keys, ","))
        }

        package <- refsmat[i, 2]

        if(is.null(all.keys[[package]]))
            all.keys[[package]] <- keys
        else
            all.keys[[package]] <- c(all.keys[[package]], keys)
    }
    bibs <- NULL
    for(package in names(all.keys)){
        cur <- unique(all.keys[[package]])

        be <- allbibs[[package]]
        if(is.null(be))
            be <- get_bibentries(package = package, stop_on_error = FALSE)
        
        if(length(be) == 0){
            be <- bibentry(
                bibtype = "Misc",
                title = "Not avalable",
                author = person("A", "Adummy"),
                year = format(Sys.time(), "%Y"),
                note = paste0("Failed to insert reference with keys = \n    ",
                              paste0(cur, collapse = " "), "\n",
                              "from package = '", package, "'.",
                              " Possible cause --- missing REFERENCES.bib in package '",
                              package, "' or '", package, "' not installed."
                              ),
                key = paste0(cur, collapse = ":")
            )
        }else if(all(cur != "*")){
            be <- tryCatch(be[cur],
                           warning = function(c) {
                               if(grepl("subscript out of bounds", c$message)){
                                   ## tell the user the offending keys.
                                   c$message <- paste0(c$message, " (",
                                                       paste(cur, collapse = " "),
                                                       "' from package '", package, "'", ")"
                                                       )
                               }
                               warning(c)
                               ## setup a dummy entry
                               dummy <- bibentry(
                                   bibtype = "Misc",
                                   title = paste0("Some keys from package ", package,
                                                  " are not avalable"), 
                                   author = person("A", "Adummy"),
                                   year = format(Sys.time(), "%Y"),
                                   note = paste0("Failed to insert reference with keys:\n    ",
                                                 paste0(cur, collapse = ", "), "\n",
                                                 "from package = '", package, "'.",
                                                 " Possible cause --- missing REFERENCES.bib in package '",
                                                 package, "' or '", package, "' not installed."
                                                 ),
                                   key = paste0(cur, collapse = ":")
                               )

                               c(be[cur], dummy)
                           })
        }

        if(is.null(bibs))
            bibs <- be
        else
            bibs <- c(bibs, be) # TODO: duplicate keys in different packages?
    }

    bibs <- sort(bibs)

    pkgs <- names(all.keys)
          # \Sexpr[stage=build,results=hide]{requireNamespace("cvar")}
 
    ## 2016-06-02 was:    
    ##     if(length(pkgs) > 0){
    ##         pkg <- pkgs[1] ## TODO: for now should do
    ##         if(!isNamespaceLoaded(pkg) && !requireNamespace(pkg) )
    ##             sty <- NULL
    ##         else{
    ##             sty <- Rdpack_bibstyles(pkg)
    ##         }
    ##     }else
    ##         sty <- NULL
    ##     
    ##     if(!is.null(sty))
    ##         res <- sapply(bibs, function(x) tools::toRd(x, style = "JSSLongNames"))
    ##     else {
    ##         if(style == "")
    ##             res <- sapply(bibs, function(x) tools::toRd(x))
    ##         else{
    ##             res <- sapply(bibs, function(x) tools::toRd(x, style = "JSSLongNames"))
    ##         }
    ##     }
    
    pkg <- if(length(pkgs) > 0)  ## TODO: for now should do
               pkgs[1]
           else character(0)

    res <- .toRd_styled(bibs, pkg)
        # 2018-10-01 use \par since pkgdown ignores the empty lines
        #     TODO: needs further thought
        # was: 
        #  (for now restoring the old one, to check if pkgdown would consider this as a bug)
#browser()
    # paste0(res, collapse = "\n\n")
    paste0(res, collapse = "\\cr\\cr ")
}

# Clean up LaTeX accents and braces
#     this is a copy of unexported  tools:::cleanupLatex by Duncan Murdoch.
cleanupLatex <- function(x) {
    if (!length(x)) return(x)
    latex <- tryCatch(parseLatex(x), error = function(e)e)
    if (inherits(latex, "error")) {
    	x
    } else {
    	deparseLatex(latexToUtf8(latex), dropBraces=TRUE)
    }
}

#+BEGIN_SRC R
deparseLatexToRd = function(x, dropBraces = FALSE)
{
    result <- character()
    lastTag <- "TEXT"
    for (i in seq_along(x)) {
        a <- x[[i]]
        tag <- attr(a, "latex_tag")
        if (is.null(tag)) tag <- "NULL"
        switch(tag,
        VERB = ,
        TEXT = ,
        MACRO = ,
        COMMENT = result <- c(result, a),
        BLOCK = result <- c(result, if (dropBraces && lastTag == "TEXT") Recall(a) else c("{", Recall(a), "}")),
        ENVIRONMENT = result <- c(result,
        	"\\begin{", a[[1L]], "}",
        	Recall(a[[2L]]),
        	"\\end{", a[[1L]], "}"),
        ## MATH = result <- c(result, "$", Recall(a), "$"),
        MATH = result <- c(result, "\\eqn{", Recall(a), "}"),
        NULL = stop("Internal error, no tag", domain = NA)
        )
        lastTag <- tag
    }
    paste(result, collapse="")
}

Rdpack_bibstyles <- local({
    styles <- list()
    function(package, authors){
        if((n <- nargs()) > 1){
            styles[[package]] <<- authors
            
        }else if(n == 1)
            styles[[package]]
        else
            styles
    }
})

.toRd_styled <- function(bibs, package, style = ""){
    if(length(package) == 0)
        sty <- NULL
    else if(!isNamespaceLoaded(package) && !requireNamespace(package) )
        sty <- NULL
    else
        sty <- Rdpack_bibstyles(package)
    
    ## TODO: check if these 'sapply()'s preserve encodings, if set.
    if(!is.null(sty))
        res <- sapply(bibs, function(x) tools::toRd(x, style = "JSSLongNames"))
    else { # check style
        if(style == ""){
            if(!("JSSRd" %in% tools::getBibstyle(all = TRUE)))
                ## bibstyle_JSSRd()
                set_Rdpack_bibstyle("JSSRd")
            res <- sapply(bibs, function(x) tools::toRd(x, style = "JSSRd"))
        }else{
            res <- sapply(bibs, function(x) tools::toRd(x, style = "JSSLongNames"))
        }
    }
    ## 2018-10-08
    ## TODO: this is risky but read.bib, bibentry, toRd and similar seem to work internally with UTF-8
    ##     if(!all(Encoding(res) == "UTF-8")){
    ##         ## warning(paste("encoding is: ", paste0(Encoding(res), collapse = ", "), "\n"))
    ##         Encoding(res) <- "UTF-8"
    ##     }
    
    res
}

## bibstyle_JSSRd <- function(){
##     tools::bibstyle("JSSRd", .init = TRUE, .default = FALSE,
##                     cleanupLatex = function(x) {
##                         if (!length(x)) return(x)
##                         latex <- tryCatch(tools::parseLatex(x), error = function(e)e)
##                         if (inherits(latex, "error")) {
##                             x
##                         } else {
##                             deparseLatexToRd(latexToUtf8(latex), dropBraces=TRUE)
##                         }
##                     }
##                     
##                     )
## }

set_Rdpack_bibstyle <- function(bibstyle = "JSSRd"){
    ## from /tools/R/bibstyle.R makeJSS()
    collapse <- function(strings)
        paste(strings, collapse="\n")
    emph <- function(s)
        if (length(s)) paste0("\\emph{", collapse(s), "}")


    switch(bibstyle,
    "JSSRd" = tools::bibstyle("JSSRd", .init = TRUE, .default = FALSE,
                    cleanupLatex = function(x) {
                        if (!length(x)) return(x)
                        latex <- tryCatch(tools::parseLatex(x), error = function(e)e)
                        if (inherits(latex, "error")) {
                            x
                        } else {
                            deparseLatexToRd(latexToUtf8(latex), dropBraces=TRUE)
                        }
                    },

                    ## modified from tools::makeJSS()
                    ## TODO: report on R-devel?.
                    bookVolume = function(book) {
                        result <- ""
                        if (length(book$volume)){
                            result <- paste("volume", collapse(book$volume))
                            if (length(book$number))
                                result <- paste0(result, "(", collapse(book$number), ")")
                            if (length(book$series))
                                result <- paste(result, "of", emph(collapse(book$series)))
                        }else if (length(book$number)){
                            ## todo: in JSS style and others the title end with '.' and 
                            ##       'number' is 'Number', but don't want to fiddle with this now. 
                            result <- paste(result, "number", collapse(book$number))
                            if (length(book$series))
                                result <- paste(result, "in", collapse(book$series))
                        }else if (length(book$series))
                            result <- paste(result, collapse(book$series))
                        if (nzchar(result)) result
                    }


                    ),

    "JSSLongNames" = tools::bibstyle("JSSLongNames", .init = TRUE, .default = FALSE,
                    cleanupLatex = function(x) {
                        if (!length(x)) return(x)
                        latex <- tryCatch(tools::parseLatex(x), error = function(e)e)
                        if (inherits(latex, "error")) {
                            x
                        } else {
                            deparseLatexToRd(latexToUtf8(latex), dropBraces=TRUE)
                        }
                    },
                    
                    bookVolume = function(book) {
                        result <- ""
                        if (length(book$volume)){
                            result <- paste("volume", collapse(book$volume))
                            if (length(book$number))
                                result <- paste0(result, "(", collapse(book$number), ")")
                            if (length(book$series))
                                result <- paste(result, "of", emph(collapse(book$series)))
                        }else if (length(book$number)){
                            ## todo: in JSS style and others the title end with '.' and 
                            ##       'number' is 'Number', but don't want to fiddle with this now. 
                            result <- paste(result, "number", collapse(book$number))
                            if (length(book$series))
                                result <- paste(result, "in", collapse(book$series))
                        }else if (length(book$series))
                            result <- paste(result, collapse(book$series))
                        if (nzchar(result)) result
                    },

                    shortName = function(person) {
                        paste(paste(cleanupLatex(person$given), collapse=" "),
                              cleanupLatex(person$family), sep = " ")
                    }
                    ),
    ## default
    stop("Unknown bibstyle ", bibstyle)
    )
}

## ls(environment(bibstyle)$styles$JSS)
.onLoad <- function(lib, pkg){
    ## tools::bibstyle("JSSLongNames", .init = TRUE, .default = FALSE,
    ##     shortName = function(person) {
    ##         paste(paste(cleanupLatex(person$given), collapse=" "),
    ##               cleanupLatex(person$family), sep = " ")
    ##     },
    ## 
    ##     cleanupLatex = function(x) {
    ##         if (!length(x)) return(x)
    ##         latex <- tryCatch(tools::parseLatex(x), error = function(e)e)
    ##         if (inherits(latex, "error")) {
    ##             x
    ##         } else {
    ##             Rdpack:::deparseLatexToRd(latexToUtf8(latex), dropBraces=TRUE)
    ##         }
    ##     }
    ##     
    ##     )

    set_Rdpack_bibstyle("JSSLongNames")
    
    Rdpack_bibstyles(package = pkg, authors = "LongNames")
    invisible(NULL)
}
