#  File src/library/utils/R/news.R
#  Part of the R package, https://www.R-project.org
#
#  Copyright (C) 1995-2018 The R Core Team
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  https://www.R-project.org/Licenses/


news <-
function(query, package = "R", lib.loc = NULL,
         format = NULL, reader = NULL, db = NULL)
{
    if(new.db <- is.null(db)) {
        db <- if(package == "R")
            tools:::.build_news_db_from_R_NEWS_Rd()
        else
            tools:::.build_news_db(package, lib.loc, format, reader)
    }
    if(is.null(db))
        return(NULL)

    if(new.db)
	attr(db, "package") <- package

    ## Is there a way to directly call/use subset.data.frame?
    ## E.g.,
    ##   subset(db, query)
    ## does not work.
    if(missing(query))
        return(db)

    ## For queries we really need to force Version to package_version
    ## and Date to Date ...
    ## This is tricky because we do not necessarily have valid package
    ## versions (e.g., R NEWS has "2.8.1 patched") or could have the
    ## version info missing (and package_version() does not like NAs).

    ## Manipulate fields for querying (but return the original ones).
    db1 <- db
    ## Canonicalize version entries which *start* with a valid numeric
    ## version, i.e., drop things like " patched".
    version <- db$Version
    pos <- regexpr(sprintf("^%s",
                           .standard_regexps()$valid_numeric_version),
                   version)
    if(any(ind <- (pos > -1L)))
        version[ind] <-
            substring(version[ind], 1L, attr(pos, "match.length")[ind])
    db1$Version <- numeric_version(version, strict = FALSE)
    db1$Date <- as.Date(db$Date)

    r <- eval(substitute(query), db1, parent.frame())
    ## Do something if this is not logical ...
    if(!is.null(r)) {
	if(!is.logical(r) || length(r) != length(version))
	    stop("invalid query")
	r <- r & !is.na(r)
	db <- db[r, ]
        ## This should no longer be necessary ...?
	if(!all(r))
	    attr(db, "subset") <- r
    }
    
    db
}

format.news_db <-
function(x, ...)
{
    if(tools:::.news_db_has_no_bad_entries(x)) {

        ## Format news in the preferred input format:
        ##   Changes in $VERSION [($DATE)]:
        ##   [$CATEGORY$]
        ##   indented/formatted bullet list of $TEXT entries.
        ## <FIXME>
        ## Add support for DATE.
        ## </FIXME>

        ## When formatting version and category headers, mimic the HTML
        ## and legacy R layouts: center the former, and left-justify the
        ## latter.  (Alternatively, we could e.g. left-justify the
        ## former and also the latter with an extra indent of 2, but it
        ## seems preferable to be consistent.)

        vchunks <- split(x, x$Version)
        ## Re-order according to decreasing version.
        ## R NEWS has invalid "versions" such as "R-devel" and
        ## "2.4.1 patched".  We can remap the latter (to e.g. 2.4.1.1)
        ## and need to ensure the former come first.
        vstrings <- names(vchunks)
        ind <- vstrings != "R-devel"
        pos <- c(which(!ind),
                 which(ind)[order(as.numeric_version(sub(" *patched", ".1",
                                                         vstrings[ind])),
                                  decreasing = TRUE)])
        vchunks <- vchunks[pos]
	if(length(vchunks)) {
            dates <- sapply(vchunks, function(v) v$Date[1L])
            vstrings <- names(vchunks)
            ind <- vstrings != "R-devel"
            vstrings[ind] <- sprintf("version %s", vstrings[ind])
            vheaders <-
                format(sprintf("Changes in %s%s",
                               vstrings,
                               ifelse(is.na(dates), "",
                                      sprintf(" (%s)", dates))),
                       justify = "centre", width = 72L)
            ## No trailing colon when centering.
        } else vheaders <- character()

        format_items <- function(x)
            paste0("    o   ", gsub("\n", "\n\t", x$Text))
        format_vchunk <- function(vchunk) {
            if(all(!is.na(category <- vchunk$Category)
                   & nzchar(category))) {
                ## need to preserve order of headings.
                cchunks <-
                    split(vchunk,
                          factor(category, levels = unique(category)))
                cheaders <- names(cchunks)
                Map(c, cheaders, lapply(cchunks, format_items),
                    USE.NAMES = FALSE)
            } else {
                format_items(vchunk)
            }
        }

        Map(c, vheaders, lapply(vchunks, format_vchunk),
            USE.NAMES = FALSE)
    } else {
        ## Simple and ugly.
        ## Drop all-NA variables.
        apply(as.matrix(x),
              1L,
              function(e)
              paste(formatDL(e[!is.na(e)], style = "list"),
                    collapse = "\n"))
    }
}

print.news_db <-
function(x, doBrowse = interactive(), browser = getOption("browser"), ...)
{
    port <- if(doBrowse && !identical("false", browser) &&
               is.character(pkg <- attr(x, "package")) &&
               tools:::.news_db_has_no_bad_entries(x))
        tools::startDynamicHelp(NA) else 0L
    if (port > 0L) {
        tools:::.httpd_objects(port, x)
        url <- if (pkg == "R") {
            if(is.null(attr(x, "subset"))) {
                ## Use the pre-built NEWS.html.
                sprintf("http://127.0.0.1:%d/doc/html/NEWS.html",
                        port)
            } else
                sprintf("http://127.0.0.1:%d/doc/html/NEWS.html?objects=1&port=%d",
                        port, port)
        } else
            sprintf("http://127.0.0.1:%d/library/%s/NEWS?objects=1&port=%d",
                    port, pkg, port)
    	## if (!is.null(subset <- attr(x, "subset"))) {
	##     # Subsets are typically ranges of dates or version numbers, so we run-length encode
	##     # the subset vector.  We put TRUE in front so the values alternate TRUE, FALSE, ... .
    	##     rle <- paste(rle(c(TRUE, subset))$lengths, collapse="_")
    	##     url <- paste0(url, "?subset=", rle)
        ## }
    	browseURL(url)
    } else ## simply show in console:
	writeLines(paste(unlist(format(x, ...)), collapse = "\n\n"))
    invisible(x)
}

`[.news_db` <- function(x, i, j, drop) {
    ## Ensure that 'bad' attribute is subscripted as necessary.
    y <- NextMethod()
    if(inherits(y, "news_db")
       && !missing(i)
       && !is.null(bad <- attr(x, "bad"))) {
        attr(y, "bad") <- bad[i]
    }
    y
}

subset.news_db <-
function(x, subset, ...) {
    do.call("news", list(substitute(subset), db = x))
}