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