rktio: add ShellExecute

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,

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
+  int nplen;
-#else
+  Scheme_Object *sv, *sf, *sp;
-# define mzseSHOW(s, x) /* empty */
-#endif
 
   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 = scheme_expand_string_filename(argv[3],
-  dir = 
+				      "shell-execute", NULL,
-#endif
+				      SCHEME_GUARD_FILE_EXISTS);
-    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;
 
-    nplen = strlen(dir);
+  nplen = strlen(dir);
-    dir = scheme_normal_path_seps(dir, &nplen, 0);
+  dir = scheme_normal_path_seps(dir, &nplen, 0);
     
-    if (SCHEME_FALSEP(argv[0]))
+  if (SCHEME_FALSEP(argv[0]))
-      sv = scheme_false;
+    sv = NULL;
-    else
+  else
-      sv = scheme_char_string_to_byte_string(argv[0]);
+    sv = scheme_char_string_to_byte_string(argv[0]);
-    sf = scheme_char_string_to_byte_string(argv[1]);
+  sf = scheme_char_string_to_byte_string(argv[1]);
-    sp = scheme_char_string_to_byte_string(argv[2]);
+  sp = scheme_char_string_to_byte_string(argv[2]);
 
-    memset(&se, 0, sizeof(se));
+  if (rktio_shell_execute(scheme_rktio,
-    se.fMask = SEE_MASK_NOCLOSEPROCESS | SEE_MASK_FLAG_DDEWAIT;
+			  sv ? SCHEME_BYTE_STR_VAL(sv) : NULL,
-    se.cbSize = sizeof(se);
+			  SCHEME_BYTE_STR_VAL(sf),
-    if (SCHEME_FALSEP(sv))
+			  SCHEME_BYTE_STR_VAL(sp),
-      se.lpVerb = NULL;
+			  dir,
-    else {
+			  show))
-      se.lpVerb = WIDE_PATH_COPY(SCHEME_BYTE_STR_VAL(sv));
+    return scheme_false;
-    }
+  else {
-    se.lpFile = WIDE_PATH_COPY(SCHEME_BYTE_STR_VAL(sf));
+    scheme_raise_exn(MZEXN_FAIL,
-    se.lpParameters = WIDE_PATH_COPY(SCHEME_BYTE_STR_VAL(sp));
+		     "shell-execute: execute failed\n"
-    se.lpDirectory = WIDE_PATH_COPY(dir);
+		     "  command: %V\n"
-    se.nShow = show;
+		     "  system error: %R",
-    se.hwnd = NULL;
+		     argv[1]);
-
+    return 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;
-    }
   }
-#else
-  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
-		   "shell-execute: " NOT_SUPPORTED_STR);
-  return NULL;
-#endif
 }
 
 /*========================================================================*/

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
 

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);

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 }
 };
 

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
+}

racket/src/worksp/librktio/librktio.vcproj

@@ -154,6 +154,10 @@
 				RelativePath="..\..\rktio\rktio_flock.c"
 				>
 			</File>
+			<File
+				RelativePath="..\..\rktio\rktio_shellex.c"
+				>
+			</File>
 			<File
 				RelativePath="..\..\rktio\rktio_time.c"
 				>

racket/src/worksp/librktio/librktio.vcxproj

@@ -127,6 +127,7 @@
     <ClCompile Include="..\..\rktio\rktio_envvars.c" />
     <ClCompile Include="..\..\rktio\rktio_fs_change.c" />
     <ClCompile Include="..\..\rktio\rktio_flock.c" />
+    <ClCompile Include="..\..\rktio\rktio_shellex.c" />
     <ClCompile Include="..\..\rktio\rktio_time.c" />
     <ClCompile Include="..\..\rktio\rktio_error.c" />
     <ClCompile Include="..\..\rktio\rktio_hash.c" />