diff --git a/racket/src/racket/src/error.c b/racket/src/racket/src/error.c
index 82f33797ef..eddfb10e40 100644
--- a/racket/src/racket/src/error.c
+++ b/racket/src/racket/src/error.c
@@ -296,7 +296,7 @@ Scheme_Config *scheme_init_error_escape_proc(Scheme_Config *config)
*/
static intptr_t sch_vsprintf(char *s, intptr_t maxlen, const char *msg, va_list args, char **_s,
- Scheme_Object **_errno_val)
+ Scheme_Object **_errno_val, int *_unsupported)
/* NULL for s means allocate the buffer here (and return in (_s), but this function
doesn't allocate before extracting arguments from the stack. */
{
@@ -532,6 +532,10 @@ static intptr_t sch_vsprintf(char *s, intptr_t maxlen, const char *msg, va_list
*_errno_val = err_kind;
}
}
+ if (_unsupported
+ && (errid == RKTIO_ERROR_UNSUPPORTED)
+ && (errkind == RKTIO_ERROR_KIND_RACKET))
+ *_unsupported = 1;
}
break;
case 'e':
@@ -758,7 +762,7 @@ static intptr_t scheme_sprintf(char *s, intptr_t maxlen, const char *msg, ...)
GC_CAN_IGNORE va_list args;
HIDE_FROM_XFORM(va_start(args, msg));
- len = sch_vsprintf(s, maxlen, msg, args, NULL, NULL);
+ len = sch_vsprintf(s, maxlen, msg, args, NULL, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
return len;
@@ -1074,7 +1078,7 @@ scheme_signal_error (const char *msg, ...)
intptr_t len;
HIDE_FROM_XFORM(va_start(args, msg));
- len = sch_vsprintf(NULL, 0, msg, args, &buffer, NULL);
+ len = sch_vsprintf(NULL, 0, msg, args, &buffer, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
if (scheme_current_thread->current_local_env) {
@@ -1106,7 +1110,7 @@ void scheme_warning(char *msg, ...)
intptr_t len;
HIDE_FROM_XFORM(va_start(args, msg));
- len = sch_vsprintf(NULL, 0, msg, args, &buffer, NULL);
+ len = sch_vsprintf(NULL, 0, msg, args, &buffer, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
buffer[len++] = '\n';
@@ -1130,7 +1134,7 @@ void scheme_log(Scheme_Logger *logger, int level, int flags,
}
HIDE_FROM_XFORM(va_start(args, msg));
- len = sch_vsprintf(NULL, 0, msg, args, &buffer, NULL);
+ len = sch_vsprintf(NULL, 0, msg, args, &buffer, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
buffer[len] = 0;
@@ -1153,7 +1157,7 @@ void scheme_log_w_data(Scheme_Logger *logger, int level, int flags,
}
HIDE_FROM_XFORM(va_start(args, msg));
- len = sch_vsprintf(NULL, 0, msg, args, &buffer, NULL);
+ len = sch_vsprintf(NULL, 0, msg, args, &buffer, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
buffer[len] = 0;
@@ -2227,7 +2231,7 @@ void scheme_read_err(Scheme_Object *port,
Scheme_Object *loc;
HIDE_FROM_XFORM(va_start(args, detail));
- slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL);
+ slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
ls = "";
@@ -2323,7 +2327,7 @@ Scheme_Object *scheme_numr_err(Scheme_Object *complain,
intptr_t slen;
HIDE_FROM_XFORM(va_start(args, detail));
- slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL);
+ slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
if (SCHEME_FALSEP(complain))
@@ -2519,7 +2523,7 @@ void scheme_wrong_syntax(const char *where,
GC_CAN_IGNORE va_list args;
HIDE_FROM_XFORM(va_start(args, detail));
- slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL);
+ slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
}
@@ -2536,7 +2540,7 @@ void scheme_unbound_syntax(const char *where,
GC_CAN_IGNORE va_list args;
HIDE_FROM_XFORM(va_start(args, detail));
- slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL);
+ slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
do_wrong_syntax(where, detail_form, form, s, slen, scheme_null, MZEXN_FAIL_SYNTAX_UNBOUND);
@@ -2558,7 +2562,7 @@ void scheme_wrong_syntax_with_more_sources(const char *where,
GC_CAN_IGNORE va_list args;
HIDE_FROM_XFORM(va_start(args, detail));
- slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL);
+ slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
}
@@ -2603,7 +2607,7 @@ void scheme_wrong_return_arity(const char *where,
GC_CAN_IGNORE va_list args;
HIDE_FROM_XFORM(va_start(args, detail));
- slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL);
+ slen = sch_vsprintf(NULL, 0, detail, args, &s, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
}
@@ -2662,7 +2666,7 @@ void scheme_raise_out_of_memory(const char *where, const char *msg, ...)
GC_CAN_IGNORE va_list args;
HIDE_FROM_XFORM(va_start(args, msg));
- slen = sch_vsprintf(NULL, 0, msg, args, &s, NULL);
+ slen = sch_vsprintf(NULL, 0, msg, args, &s, NULL, NULL);
HIDE_FROM_XFORM(va_end(args));
}
@@ -4528,7 +4532,7 @@ scheme_raise_exn(int id, ...)
GC_CAN_IGNORE va_list args;
intptr_t alen;
char *msg;
- int i, c;
+ int i, c, unsupported = 0;
Scheme_Object *eargs[MZEXN_MAXARGS], *errno_val = NULL;
char *buffer;
@@ -4548,7 +4552,7 @@ scheme_raise_exn(int id, ...)
msg = mzVA_ARG(args, char*);
- alen = sch_vsprintf(NULL, 0, msg, args, &buffer, &errno_val);
+ alen = sch_vsprintf(NULL, 0, msg, args, &buffer, &errno_val, &unsupported);
HIDE_FROM_XFORM(va_end(args));
#ifndef NO_SCHEME_EXNS
@@ -4564,6 +4568,9 @@ scheme_raise_exn(int id, ...)
eargs[2] = errno_val;
c++;
}
+ } else if (unsupported) {
+ if (id == MZEXN_FAIL)
+ id = MZEXN_FAIL_UNSUPPORTED;
}
do_raise(scheme_make_struct_instance(exn_table[id].type,
diff --git a/racket/src/racket/src/port.c b/racket/src/racket/src/port.c
index 65515c7a27..152c312561 100644
--- a/racket/src/racket/src/port.c
+++ b/racket/src/racket/src/port.c
@@ -6188,13 +6188,10 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
static Scheme_Object *sch_shell_execute(int c, Scheme_Object *argv[])
{
-#ifdef WINDOWS_PROCESSES
char *dir;
int show = 0;
-# define mzseSHOW(s, x) s = x
-#else
-# define mzseSHOW(s, x) /* empty */
-#endif
+ int nplen;
+ Scheme_Object *sv, *sf, *sp;
if (!SCHEME_FALSEP(argv[0]) && !SCHEME_CHAR_STRINGP(argv[0]))
scheme_wrong_contract("shell-execute", "(or/c string? #f)", 0, c, argv);
@@ -6209,7 +6206,7 @@ static Scheme_Object *sch_shell_execute(int c, Scheme_Object *argv[])
# define mzseCMP(id, str) \
if (SAME_OBJ(scheme_intern_symbol(str), argv[4]) \
|| SAME_OBJ(scheme_intern_symbol(# id), argv[4])) { \
- mzseSHOW(show, id); show_set = 1; }
+ show = RKTIO_ ## id; show_set = 1; }
mzseCMP(SW_HIDE, "sw_hide");
mzseCMP(SW_MAXIMIZE, "sw_maximize");
mzseCMP(SW_MINIMIZE, "sw_minimize");
@@ -6227,61 +6224,35 @@ static Scheme_Object *sch_shell_execute(int c, Scheme_Object *argv[])
scheme_wrong_type("shell-execute", "show-mode symbol", 4, c, argv);
}
-#ifdef WINDOWS_PROCESSES
- dir =
-#endif
- scheme_expand_string_filename(argv[3],
- "shell-execute", NULL,
- SCHEME_GUARD_FILE_EXISTS);
-#ifdef WINDOWS_PROCESSES
- {
- SHELLEXECUTEINFOW se;
- int nplen;
- Scheme_Object *sv, *sf, *sp;
+ dir = scheme_expand_string_filename(argv[3],
+ "shell-execute", NULL,
+ SCHEME_GUARD_FILE_EXISTS);
- nplen = strlen(dir);
- dir = scheme_normal_path_seps(dir, &nplen, 0);
+ nplen = strlen(dir);
+ dir = scheme_normal_path_seps(dir, &nplen, 0);
+
+ if (SCHEME_FALSEP(argv[0]))
+ sv = NULL;
+ else
+ sv = scheme_char_string_to_byte_string(argv[0]);
+ sf = scheme_char_string_to_byte_string(argv[1]);
+ sp = scheme_char_string_to_byte_string(argv[2]);
- if (SCHEME_FALSEP(argv[0]))
- sv = scheme_false;
- else
- sv = scheme_char_string_to_byte_string(argv[0]);
- sf = scheme_char_string_to_byte_string(argv[1]);
- sp = scheme_char_string_to_byte_string(argv[2]);
-
- memset(&se, 0, sizeof(se));
- se.fMask = SEE_MASK_NOCLOSEPROCESS | SEE_MASK_FLAG_DDEWAIT;
- se.cbSize = sizeof(se);
- if (SCHEME_FALSEP(sv))
- se.lpVerb = NULL;
- else {
- se.lpVerb = WIDE_PATH_COPY(SCHEME_BYTE_STR_VAL(sv));
- }
- se.lpFile = WIDE_PATH_COPY(SCHEME_BYTE_STR_VAL(sf));
- se.lpParameters = WIDE_PATH_COPY(SCHEME_BYTE_STR_VAL(sp));
- se.lpDirectory = WIDE_PATH_COPY(dir);
- se.nShow = show;
- se.hwnd = NULL;
-
- /* Used to use ShellExecuteEx(&se) here. Not sure why it doesn't work,
- and the problem was intermittent (e.g., worked for opening a URL
- with IE as the default browser, but failed with Netscape). */
- if (ShellExecuteW(se.hwnd, se.lpVerb, se.lpFile, se.lpParameters, se.lpDirectory, se.nShow)) {
- return scheme_false;
- } else {
- scheme_signal_error("shell-execute: execute failed\n"
- " command: %V\n"
- " system error: %E",
- argv[1],
- GetLastError());
- return NULL;
- }
+ if (rktio_shell_execute(scheme_rktio,
+ sv ? SCHEME_BYTE_STR_VAL(sv) : NULL,
+ SCHEME_BYTE_STR_VAL(sf),
+ SCHEME_BYTE_STR_VAL(sp),
+ dir,
+ show))
+ return scheme_false;
+ else {
+ scheme_raise_exn(MZEXN_FAIL,
+ "shell-execute: execute failed\n"
+ " command: %V\n"
+ " system error: %R",
+ argv[1]);
+ return NULL;
}
-#else
- scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
- "shell-execute: " NOT_SUPPORTED_STR);
- return NULL;
-#endif
}
/*========================================================================*/
diff --git a/racket/src/rktio/Makefile.in b/racket/src/rktio/Makefile.in
index 096115d8f7..2125044233 100644
--- a/racket/src/rktio/Makefile.in
+++ b/racket/src/rktio/Makefile.in
@@ -25,6 +25,7 @@ OBJS = rktio_fs.@LTO@ \
rktio_envvars.@LTO@ \
rktio_fs_change.@LTO@ \
rktio_flock.@LTO@ \
+ rktio_shellex.@LTO@ \
rktio_time.@LTO@ \
rktio_error.@LTO@ \
rktio_hash.@LTO@ \
@@ -74,6 +75,9 @@ rktio_fs_change.@LTO@: $(srcdir)/rktio_fs_change.c $(RKTIO_HEADERS)
rktio_flock.@LTO@: $(srcdir)/rktio_flock.c $(RKTIO_HEADERS)
$(CC) $(CFLAGS) -I$(srcdir) -I. -o rktio_flock.@LTO@ -c $(srcdir)/rktio_flock.c
+rktio_shellex.@LTO@: $(srcdir)/rktio_shellex.c $(RKTIO_HEADERS)
+ $(CC) $(CFLAGS) -I$(srcdir) -I. -o rktio_shellex.@LTO@ -c $(srcdir)/rktio_shellex.c
+
rktio_time.@LTO@: $(srcdir)/rktio_time.c $(RKTIO_HEADERS)
$(CC) $(CFLAGS) -I$(srcdir) -I. -o rktio_time.@LTO@ -c $(srcdir)/rktio_time.c
diff --git a/racket/src/rktio/rktio.h b/racket/src/rktio/rktio.h
index dab22fea94..f9626a0065 100644
--- a/racket/src/rktio/rktio.h
+++ b/racket/src/rktio/rktio.h
@@ -848,6 +848,33 @@ RKTIO_EXTERN intptr_t rktio_get_process_children_milliseconds(rktio_t *rktio);
RKTIO_EXTERN rktio_timestamp_t rktio_get_seconds(rktio_t *rktio);
RKTIO_EXTERN rktio_date_t *rktio_seconds_to_date(rktio_t *rktio, rktio_timestamp_t seconds, int nanoseconds, int get_gmt);
+/*************************************************/
+/* Windows ShellExecute */
+
+enum {
+ RKTIO_SW_HIDE,
+ RKTIO_SW_MAXIMIZE,
+ RKTIO_SW_MINIMIZE,
+ RKTIO_SW_RESTORE,
+ RKTIO_SW_SHOW,
+ RKTIO_SW_SHOWDEFAULT,
+ RKTIO_SW_SHOWMAXIMIZED,
+ RKTIO_SW_SHOWMINIMIZED,
+ RKTIO_SW_SHOWMINNOACTIVE,
+ RKTIO_SW_SHOWNA,
+ RKTIO_SW_SHOWNOACTIVATE,
+ RKTIO_SW_SHOWNORMAL
+};
+
+rktio_ok_t rktio_shell_execute(rktio_t *rktio,
+ const char *verb,
+ const char *target,
+ const char *arg,
+ const char *dir,
+ int show_mode);
+/* Support only on Windows to run `ShellExecute`. The `dir` argument
+ needs to have normalized path separators. */
+
/*************************************************/
/* Errors */
@@ -891,6 +918,7 @@ enum {
RKTIO_ERROR_TRY_AGAIN_WITH_IPV4, /* for TCP listen */
RKTIO_ERROR_TIME_OUT_OF_RANGE,
RKTIO_ERROR_NO_SUCH_ENVVAR,
+ RKTIO_ERROR_SHELL_EXECUTE_FAILED,
};
RKTIO_EXTERN void rktio_set_last_error(rktio_t *rktio, int kind, int errid);
diff --git a/racket/src/rktio/rktio_error.c b/racket/src/rktio/rktio_error.c
index 8c6f15e7ef..7dd1128890 100644
--- a/racket/src/rktio/rktio_error.c
+++ b/racket/src/rktio/rktio_error.c
@@ -37,6 +37,7 @@ err_str_t err_strs[] = {
{ RKTIO_ERROR_TRY_AGAIN_WITH_IPV4, "listen failed, but try again with just IPv4 addresses" },
{ RKTIO_ERROR_TIME_OUT_OF_RANGE, "time value out-of-range for date conversion" },
{ RKTIO_ERROR_NO_SUCH_ENVVAR, "no value as an environment variable" },
+ { RKTIO_ERROR_SHELL_EXECUTE_FAILED, "ShellExecute failed" },
{ 0, NULL }
};
diff --git a/racket/src/rktio/rktio_shellex.c b/racket/src/rktio/rktio_shellex.c
new file mode 100644
index 0000000000..e4e81344e5
--- /dev/null
+++ b/racket/src/rktio/rktio_shellex.c
@@ -0,0 +1,76 @@
+#include "rktio.h"
+#include "rktio_private.h"
+
+#define rktio_SHOW_CONVERT(v) case RKTIO_ ## v: show_mode = v; break
+
+rktio_ok_t rktio_shell_execute(rktio_t *rktio,
+ const char *verb,
+ const char *target,
+ const char *arg,
+ const char *dir,
+ int show_mode)
+/* dir needs to have normalized path separators */
+{
+#ifdef RKTIO_SYSTEM_WINDOWS
+ SHELLEXECUTEINFOW se;
+ int ok, r;
+
+ switch(show_mode) {
+ rktio_SHOW_CONVERT(SW_HIDE);
+ rktio_SHOW_CONVERT(SW_MAXIMIZE);
+ rktio_SHOW_CONVERT(SW_MINIMIZE);
+ rktio_SHOW_CONVERT(SW_RESTORE);
+ rktio_SHOW_CONVERT(SW_SHOW);
+ rktio_SHOW_CONVERT(SW_SHOWDEFAULT);
+ rktio_SHOW_CONVERT(SW_SHOWMAXIMIZED);
+ rktio_SHOW_CONVERT(SW_SHOWMINIMIZED);
+ rktio_SHOW_CONVERT(SW_SHOWMINNOACTIVE);
+ rktio_SHOW_CONVERT(SW_SHOWNA);
+ rktio_SHOW_CONVERT(SW_SHOWNOACTIVATE);
+ rktio_SHOW_CONVERT(SW_SHOWNORMAL);
+ }
+
+ memset(&se, 0, sizeof(se));
+ se.fMask = SEE_MASK_NOCLOSEPROCESS | SEE_MASK_FLAG_DDEWAIT;
+ se.cbSize = sizeof(se);
+ if (!verb)
+ se.lpVerb = NULL;
+ else
+ se.lpVerb = WIDE_PATH_copy(verb);
+ se.lpFile = WIDE_PATH_copy(target);
+ se.lpParameters = WIDE_PATH_copy(arg);
+ se.lpDirectory = WIDE_PATH_copy(dir);
+ se.nShow = show_mode;
+ se.hwnd = NULL;
+
+ r = (int)(intptr_t)ShellExecuteW(se.hwnd, se.lpVerb, se.lpFile, se.lpParameters,
+ se.lpDirectory, se.nShow);
+
+ ok = (r > 32);
+
+ if (!ok) {
+ switch(r) {
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_PATH_NOT_FOUND:
+ case ERROR_BAD_FORMAT:
+ set_windows_error(r);
+ break;
+ default:
+ /* Other results are not Windows error codes,
+ so just collapse them to a Racket error */
+ set_racket_error(RKTIO_ERROR_SHELL_EXECUTE_FAILED);
+ break;
+ }
+ }
+
+ if (se.lpVerb) free((char *)se.lpVerb);
+ free((char *)se.lpFile);
+ free((char *)se.lpParameters);
+ free((char *)se.lpDirectory);
+
+ return ok;
+#else
+ set_racket_error(RKTIO_ERROR_UNSUPPORTED);
+ return 0;
+#endif
+}
diff --git a/racket/src/worksp/librktio/librktio.vcproj b/racket/src/worksp/librktio/librktio.vcproj
index 8d9346994e..0c7ae2555a 100644
--- a/racket/src/worksp/librktio/librktio.vcproj
+++ b/racket/src/worksp/librktio/librktio.vcproj
@@ -154,6 +154,10 @@
RelativePath="..\..\rktio\rktio_flock.c"
>
+
+
diff --git a/racket/src/worksp/librktio/librktio.vcxproj b/racket/src/worksp/librktio/librktio.vcxproj
index 8fb39e3f19..a5b9a58a86 100644
--- a/racket/src/worksp/librktio/librktio.vcxproj
+++ b/racket/src/worksp/librktio/librktio.vcxproj
@@ -127,6 +127,7 @@
+