/
so_functions.r
169 lines (127 loc) · 6.54 KB
/
so_functions.r
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
# ---------------------------------------------------------------------------------------- #
# #
# Four functions here: #
# ------------------- #
# #
# stackQuestion -- Opens a webbrowser, pointed to questionURL. #
# Default is new question #
# #
# getWebbrowserApp -- support function to stackQuestion(), returns the full path #
# to the web browser application given a descriptive name #
# #
# .sorepro -- copies to clipboard a simple (yet often repeated) reminder #
# for new users on SO, on how to make a reproducible example #
# #
# .so -- based on function written by @flodel, this will combine #
# code + output into a cleanly formatted text. #
# #
# the major modification from @flodels code is that this #
# current iteration can take raw text, or even clipboard text #
# #
# #
# ---------------------------------------------------------------------------------------- #
## Set default web browser.
options(webbrowser.default="chrome")
getWebbrowserApp <- function(app.name, applications.folder="/Applications/") {
if (!is.character(app.name))
stop ("'app.name' must be a character")
browsers <- setNames(nm=c("chrome", "safari", "firefox", "internet explorer"), obj=paste0(applications.folder, c("Google Chrome.app", "Safari.app", "Firefox.app", "Internet Explorer.app")))
b.matched <- pmatch(gsub("google\\s*", "", tolower(app.name)), names(browsers))
if (is.na(b.matched)) {
warning("'", app.name, "' did not match any known browsers. Valid options are: \n\t", paste0("'", names(browsers), "'", collapse=", "))
return(NA)
}
if(names(browsers)[b.matched] == "internet explorer")
warning("Unrecoverable erorr: Your browser is internet explorer.")
return(browsers[b.matched])
}
stackQuestion <- function(questionURL="http://stackoverflow.com/questions/ask", browser=c("chrome", "safari", "firefox", "internet explorer")) {
if (missing(browser))
browser <- getOption("webbrowser.default", browser[[1]])
browser.app <- getWebbrowserApp(browser)
command.mac <- sprintf("/usr/bin/open -a '%s' '%s'", browser.app, questionURL)
## TODO:
## The goal is to open the page, with text pasted into the text box located here
## <textarea id="wmd-input" class="wmd-input processed" name="post-text" cols="92" rows="15" tabindex="101" data-min-length=""></textarea>
system(command.mac)
}
.so <- function(script.file=NULL, text=clipPaste(), copy.to.clipboard=TRUE) {
## original function by @flodel
# run the code and store the output in a character vector
tmp <- tempfile()
if (is.null(script.file)) {
script.file <- tempfile(pat="source_", fileext=".r")
con.sf <- file(script.file, open="w")
# writeLines(text, con=script.file, sep="\n")
writeLines(text, con=con.sf, sep="\n")
close(con.sf)
}
capture.output(
source(script.file
, echo = TRUE
, prompt.echo = "> " # getOption("prompt")
, continue.echo = "+ " # getOption("continue")
, max.deparse.length = 10000
)
, file = tmp)
out <- readLines(tmp)
# identify lines that are comments, code, results
idx.comments <- grep("^> [#]{2}", out)
idx.code <- grep("^[>+] ", out)
idx.blank <- grep("^[[:space:]]*$", out)
idx.results <- setdiff(seq_along(out),
c(idx.comments, idx.code, idx.blank))
# reformat
out[idx.comments] <- sub("^> [#]{2} ", "", out[idx.comments])
out[idx.code] <- sub("^[>+] ", " ", out[idx.code])
out[idx.results] <- sub("^", " # ", out[idx.results])
if (copy.to.clipboard)
clipCopy(out)
## Check for stackoverflow URL at first non-blank line.
first_nonblank <- 1 + if (length(idx.blank)) min(idx.blank) else 0
web.address <- gsub("^(\\s*(#)*)\\s*|\\s*$", "", out[first_nonblank])
## If the line matches a stackoverflow address, remove it from answer.
## Otherwise, set web.address to NULL (which will be tested against next)
if (grepl("^(http://)?(www.)?stackoverflow", web.address))
out <- out[-first_nonblank]
else
web.address <- NULL
if (!is.null(web.address))
stackQuestion(web.address)
# output
cat(out, sep = "\n", file = stdout())
}
.sorepro <- function() {
## copies the bitly link to reproduce.r
link <- "http://bit.ly/SORepro"
out <- paste0("Hello and welcome to SO. To help make a reproducible example, you can use `reproduce(<your data>)` . Instructions are here: ", link, " - [How to make a great R reproducible example](", link, ")")
cat("\n", out, "\n\n")
clipCopy(out)
return(link)
}
## Additional clipboard functions. These are macosx specific and need to be modified for other platforms
if (!exists("clipPaste"))
clipPaste <- function(flat=TRUE) {
con <- pipe("pbpaste", open="rb")
ret <- readLines(con, warn=FALSE)
if (flat)
ret <- paste0(ret, collapse="\n")
close(con)
return(ret)
}
if (!exists("clipCopy"))
clipCopy <- function(txt, sep="", undo.save=TRUE) {
# equivalent of highlighting txt and hitting CMD+C
if (!is.character(txt))
txt <- capture.output(txt)
txt <- paste(txt, collapse="\n")
if (undo.save && exists(".undo.bank"))
.undo.bank()
# Currently, this works only Mac OSX
if(Sys.info()[['sysname']] != "Darwin")
return(txt)
con <- pipe("pbcopy", "w")
writeLines(txt, con, sep=sep)
close(con)
return(invisible(txt))
}