1#  File src/library/utils/R/unix/create.post.R
2#  Part of the R package, https://www.R-project.org
3#
4#  Copyright (C) 1995-2017 The R Core Team
5#
6#  This program is free software; you can redistribute it and/or modify
7#  it under the terms of the GNU General Public License as published by
8#  the Free Software Foundation; either version 2 of the License, or
9#  (at your option) any later version.
10#
11#  This program is distributed in the hope that it will be useful,
12#  but WITHOUT ANY WARRANTY; without even the implied warranty of
13#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14#  GNU General Public License for more details.
15#
16#  A copy of the GNU General Public License is available at
17#  https://www.R-project.org/Licenses/
18
19create.post <- function(instructions = character(),
20                        description = "post",
21                        subject = "",
22                        method = getOption("mailer"),
23                        address = "the relevant mailing list",
24                        ccaddress = getOption("ccaddress", ""),
25                        filename = "R.post",
26                        info = character())
27{
28    method <-
29	if(is.null(method)) "none"
30	else match.arg(method, c("mailto", "mailx", "gnudoit", "none", "ess"))
31    open_prog <- if(grepl("-apple-darwin", R.version$platform)) "open" else "xdg-open"
32    if (method == "mailto")
33        if(!nzchar(Sys.which(open_prog))) {
34            browser <- Sys.getenv("R_BROWSER", "")
35            if(!nzchar(browser)) {
36                warning("cannot find program to open 'mailto:' URIs: reverting to 'method=\"none\"'")
37                flush.console()
38                Sys.sleep(5)
39            } else {
40                message("Using the browser to open a mailto: URI")
41                open_prog <- browser
42            }
43        }
44
45    body <- c(instructions,
46              "--please do not edit the information below--", "",
47              info)
48
49    none_method <- function() {
50        disclaimer <-
51            paste0("# Your mailer is set to \"none\",\n",
52                   "# hence we cannot send the, ", description, " directly from R.\n",
53                   "# Please copy the ", description, " (after finishing it) to\n",
54                   "# your favorite email program and send it to\n#\n",
55                   "#       ", address, "\n#\n",
56                   "######################################################\n",
57                   "\n\n")
58
59        cat(c(disclaimer, body), file = filename, sep = "\n")
60        cat("The", description, "is being opened for you to edit.\n")
61        flush.console()
62        file.edit(filename)
63        cat("The unsent ", description, " can be found in file ",
64            sQuote(filename), "\n", sep ="")
65    }
66
67    if(method == "none") {
68        none_method()
69    } else if(method == "mailx") {
70        if(missing(address)) stop("must specify 'address'")
71        if(!nzchar(subject)) stop("'subject' is missing")
72        if(length(ccaddress) != 1L) stop("'ccaddress' must be of length 1")
73
74	cat(body, file=filename, sep = "\n")
75        cat("The", description, "is being opened for you to edit.\n")
76        file.edit(filename)
77
78        if(is.character(ccaddress) && nzchar(ccaddress)) {
79            cmdargs <- paste("-s", shQuote(subject),
80                             "-c", shQuote(ccaddress),
81                             shQuote(address),
82                             "<", filename, "2>/dev/null")
83        }
84        else
85            cmdargs <- paste("-s", shQuote(subject),
86                             shQuote(address), "<",
87                             filename, "2>/dev/null")
88        status <- 1L
89        answer <- askYesNo(paste0("Email the ", description, " now?"))
90        if(isTRUE(answer)) {
91            cat("Sending email ...\n")
92            status <- system(paste("mailx", cmdargs), , TRUE, TRUE)
93            if(status)
94                status <- system(paste("Mail", cmdargs), , TRUE, TRUE)
95            if(status)
96                status <- system(paste("/usr/ucb/mail", cmdargs), , TRUE, TRUE)
97
98            if(status == 0L) unlink(filename)
99            else {
100                cat("Sending email failed!\n")
101                cat("The unsent", description, "can be found in file",
102                    sQuote(filename), "\n")
103            }
104        } else
105            cat("The unsent", description, "can be found in file", filename, "\n")
106    } else if(method == "ess") {
107	cat(body, sep = "\n")
108    } else  if(method == "gnudoit") {
109        ## FIXME: insert subject and ccaddress
110	cmd <- paste0("gnudoit -q '",
111		     "(mail nil \"", address, "\")",
112		     "(insert \"", paste(body, collapse="\\n"), "\")",
113		     "(search-backward \"Subject:\")",
114		     "(end-of-line)'")
115	system(cmd)
116    } else if(method == "mailto") {
117        if (missing(address)) stop("must specify 'address'")
118        if (!nzchar(subject)) subject <- "<<Enter Meaningful Subject>>"
119        if(length(ccaddress) != 1L) stop("'ccaddress' must be of length 1")
120        cat("The", description, "is being opened in your default mail program\nfor you to complete and send.\n")
121        ## The mailto: standard (RFC2368) says \r\n for the body
122        arg <- paste0("mailto:", address,
123                     "?subject=", subject,
124                     if(is.character(ccaddress) && nzchar(ccaddress))
125                         paste0("&cc=", ccaddress),
126                     "&body=", paste(body, collapse = "\r\n"))
127        if(system2(open_prog, shQuote(URLencode(arg)), FALSE, FALSE)) {
128            cat("opening the mailer failed, so reverting to 'mailer=\"none\"'\n")
129            flush.console()
130            none_method()
131        }
132    }
133    invisible()
134}
135