Add ps_switch_to()

NAMESPACE

@@ -53,6 +53,7 @@ export(ps_shared_lib_users)
 export(ps_shared_libs)
 export(ps_status)
 export(ps_suspend)
+export(ps_switch_to)
 export(ps_system_cpu_times)
 export(ps_system_memory)
 export(ps_system_swap)

R/windows.R

@@ -0,0 +1,60 @@
+
+#' Send an alert to the window of a process
+#'
+#' This function currently only works on Windows and errors on
+#' other platforms.
+#'
+#' R processes might not have an associated window, e.g. if they are
+#' running in a terminal, or in RStudio. In RGui they do.
+#'
+#' @param p Process handle.
+#' @param ancestors Logical flag. Whether to try to alert the
+#' closest ancestor in the process tree, if the specified process
+#' does not have an associated window. It uses [ps_descent()] to
+#' look up the ancestors.
+#' @return A named list:
+#' * `proc`: a process handle. This is the handle that ps tried to
+#'   alert. It might that same as `p` or an ancestor, if
+#'   `ancestors = TRUE` was specified. This is `NULL` if ps did
+#'   not find any process with an associated Window to alert.
+#' * `success`: whether the Windows API call returned success.
+#'   If this is `TRUE` that typically means that the alerted
+#'   window is the active one. If it is `FALSE`, then the alert was
+#'   probably still sent, and the user will see it on the status bar
+#'   (in Windows 10).
+#'
+#' @export
+#' @examples
+#' \dontrun{
+#' # This usually does nothing interactively, since the current
+#' # (RStudio, RGui, Windows Terminal, etc.) window is on top.
+#' ps_switch_to()
+#'
+#' # Try switching to another window, while the sleep is running,
+#' # and then you'll see an alert for the current
+#' # (RStudio, RGui, etc.) window
+#' Sys.sleep(4); ps_switch_to()
+#' }
+
+ps_switch_to <- function(p = ps_handle(), ancestors = TRUE) {
+  os <- ps_os_type()
+  if (!os[["WINDOWS"]]) {
+    stop("`ps_windows()` currently only works on Windows")
+  }
+  assert_ps_handle(p)
+
+  if (ancestors) {
+    plist <- ps_descent(p)
+  } else {
+    plist <- list(p)
+  }
+  pids <- map_int(plist, ps_pid)
+
+  ret <- .Call(psll_switch_to, pids)
+  if (ret == 0) {
+    list(proc = NULL, success = FALSE)
+  } else {
+    # -pid on failure
+    list(proc = plist[[match(abs(ret), pids)]], success = ret > 0)
+  }
+}

_pkgdown.yml

@@ -59,6 +59,7 @@ reference:
   - ps_set_cpu_affinity
   - ps_get_nice
   - ps_set_nice
+  - ps_switch_to
   - ps_wait
   - ps_windows_nice_values
 

src/api-windows.c

@@ -1740,7 +1740,69 @@ SEXP psll_set_nice(SEXP p, SEXP value) {
   if (hProcess) CloseHandle(hProcess);
   ps__throw_error();
   return R_NilValue;
+}
+
+struct psll_windows_data {
+  int *pids;
+  int num_pids;
+  HWND handle;
+  SEXP result;
+};
+
+BOOL CALLBACK psll_switch_to_proc1(
+    _In_ HWND   hwnd,
+    _In_ LPARAM lParam) {
+  struct psll_windows_data *data = (struct psll_windows_data*) lParam;
+
+  DWORD processId;
+  DWORD ret = GetWindowThreadProcessId(hwnd, &processId);
+  if (!ret) return TRUE;
+
+  int i;
+  for (i = 0; i < data->num_pids; i++) {
+    if (data->pids[i] == processId) {
+      data->handle = hwnd;
+      data->num_pids = i;
+      INTEGER(data->result)[0] = processId;
+      if (i == 0) return FALSE; else return TRUE;
+    }
+  }
+
+  return TRUE;
+}
+
+BOOL CALLBACK psll_switch_to_proc2(
+    _In_ HWND   hwnd,
+    _In_ LPARAM lParam) {
+  struct psll_windows_data *data = (struct psll_windows_data*) lParam;
 
+  if (hwnd == data->handle) {
+    BOOL ret = SetForegroundWindow(hwnd);
+    if (!ret) {
+      INTEGER(data->result)[0] = -INTEGER(data->result)[0];
+    }
+    return FALSE;
+  }
+
+  return TRUE;
+}
+
+SEXP psll_switch_to(SEXP pids) {
+  struct psll_windows_data data;
+  data.pids = INTEGER(pids);
+  data.num_pids = LENGTH(pids);
+  data.handle = NULL;
+  data.result = PROTECT(allocVector(INTSXP, 1));
+  INTEGER(data.result)[0] = 0;
+
+  EnumWindows(psll_switch_to_proc1, (LPARAM) &data);
+
+  if (data.handle != NULL) {
+    EnumWindows(psll_switch_to_proc2, (LPARAM) &data);
+  }
+
+  UNPROTECT(1);
+  return data.result;
 }
 
 

src/dummy.c

@@ -50,6 +50,7 @@
 #ifndef PS__WINDOWS
 SEXP psw__realpath(SEXP x) { return ps__dummy("psw__realpath"); }
 SEXP psll_dlls(SEXP x) { return ps__dummy("psll_dlls"); }
+SEXP psll_switch_to(SEXP x) { return ps__dummy("psll_switch_to"); }
 #endif
 #endif
 

src/init.c

@@ -69,6 +69,7 @@ static const R_CallMethodDef callMethods[]  = {
   { "psll_get_nice",     (DL_FUNC) psll_get_nice,     1 },
   { "psll_set_nice",     (DL_FUNC) psll_set_nice,     2 },
   { "psll_dlls",         (DL_FUNC) psll_dlls,         1 },
+  { "psll_switch_to",    (DL_FUNC) psll_switch_to,    1 },
   { "psll_get_cpu_aff",  (DL_FUNC) psll_get_cpu_aff,  1 },
   { "psll_set_cpu_aff",  (DL_FUNC) psll_set_cpu_aff,  2 },
   { "psll_wait",         (DL_FUNC) psll_wait,         2 },

src/ps.h

@@ -44,6 +44,7 @@ SEXP psll_connections(SEXP p);
 SEXP psll_get_nice(SEXP p);
 SEXP psll_set_nice(SEXP p, SEXP value);
 SEXP psll_dlls(SEXP p);
+SEXP psll_switch_to(SEXP plist);
 SEXP psll_get_cpu_aff(SEXP p);
 SEXP psll_set_cpu_aff(SEXP p, SEXP affinity);
 SEXP psll_wait(SEXP p, SEXP timeout);