[commit: packages/process] master, new-flags, new-flags-no-f3df9d6: Support for CREATE_NEW_CONSOLE (fixes #38) (f3df9d6)

git at git.haskell.org git at git.haskell.org
Mon Nov 2 06:23:45 UTC 2015


Repository : ssh://git@git.haskell.org/process

On branches: master,new-flags,new-flags-no-f3df9d6
Link       : http://ghc.haskell.org/trac/ghc/changeset/f3df9d6507a2f1d4fcee0b9af784cb7e20bd0b50/process

>---------------------------------------------------------------

commit f3df9d6507a2f1d4fcee0b9af784cb7e20bd0b50
Author: Michael Snoyman <michael at snoyman.com>
Date:   Wed Aug 19 10:31:35 2015 +0300

    Support for CREATE_NEW_CONSOLE (fixes #38)


>---------------------------------------------------------------

f3df9d6507a2f1d4fcee0b9af784cb7e20bd0b50
 System/Process.hsc          | 2 ++
 System/Process/Internals.hs | 9 +++++++++
 cbits/runProcess.c          | 3 +++
 changelog.md                | 1 +
 include/processFlags.h      | 1 +
 5 files changed, 16 insertions(+)

diff --git a/System/Process.hsc b/System/Process.hsc
index 1d1bcd9..144daf8 100644
--- a/System/Process.hsc
+++ b/System/Process.hsc
@@ -125,6 +125,7 @@ proc cmd args = CreateProcess { cmdspec = RawCommand cmd args,
                                 create_group = False,
                                 delegate_ctlc = False,
                                 detach_console = False,
+                                create_new_console = False,
                                 new_session = False }
 
 -- | Construct a 'CreateProcess' record for passing to 'createProcess',
@@ -140,6 +141,7 @@ shell str = CreateProcess { cmdspec = ShellCommand str,
                             create_group = False,
                             delegate_ctlc = False,
                             detach_console = False,
+                            create_new_console = False,
                             new_session = False }
 
 {- |
diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
index 65403ea..f8a02b4 100644
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -185,6 +185,11 @@ data CreateProcess = CreateProcess{
   detach_console :: Bool,                  -- ^ Use the windows DETACHED_PROCESS flag when creating the process; does nothing on other platforms.
                                            --
                                            --   /Since: 1.3.0.0/
+  create_new_console :: Bool,              -- ^ Use the windows CREATE_NEW_CONSOLE flag when creating the process; does nothing on other platforms.
+                                           --
+                                           --   Default: @False@
+                                           --
+                                           --   /Since: 1.3.0.0/
   new_session :: Bool                      -- ^ Use posix setsid to start the new process in a new session; does nothing on other platforms.
                                            --
                                            --   /Since: 1.3.0.0/
@@ -267,6 +272,7 @@ createProcess_ fun CreateProcess{ cmdspec = cmdsp,
                                   create_group = mb_create_group,
                                   delegate_ctlc = mb_delegate_ctlc,
                                   detach_console = mb_detach_console,
+                                  create_new_console = mb_create_new_console,
                                   new_session = mb_new_session }
  = do
   let (cmd,args) = commandToProcess cmdsp
@@ -299,6 +305,7 @@ createProcess_ fun CreateProcess{ cmdspec = cmdsp,
                                 ((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)
                                 .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0)
                                 .|.(if mb_detach_console then RUN_PROCESS_DETACHED else 0)
+                                .|.(if mb_create_new_console then RUN_PROCESS_NEW_CONSOLE else 0)
                                 .|.(if mb_new_session then RUN_PROCESS_NEW_SESSION else 0))
                                 pFailedDoing
 
@@ -432,6 +439,7 @@ createProcess_ fun CreateProcess{ cmdspec = cmdsp,
                                   create_group = mb_create_group,
                                   delegate_ctlc = _ignored,
                                   detach_console = mb_detach_console,
+                                  create_new_console = mb_create_new_console,
                                   new_session = mb_new_session }
  = do
   (cmd, cmdline) <- commandToProcess cmdsp
@@ -465,6 +473,7 @@ createProcess_ fun CreateProcess{ cmdspec = cmdsp,
                                 ((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)
                                 .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0)
                                 .|.(if mb_detach_console then RUN_PROCESS_DETACHED else 0))
+                                .|.(if mb_create_new_console then RUN_PROCESS_NEW_CONSOLE else 0))
                                 .|.(if mb_new_session then RUN_PROCESS_NEW_SESSION else 0))
 
      hndStdInput  <- mbPipe mb_stdin  pfdStdInput  WriteMode
diff --git a/cbits/runProcess.c b/cbits/runProcess.c
index 61fdd58..8019605 100644
--- a/cbits/runProcess.c
+++ b/cbits/runProcess.c
@@ -571,6 +571,9 @@ runInteractiveProcess (wchar_t *cmd, wchar_t *workingDirectory,
     if ((flags & RUN_PROCESS_DETACHED) != 0) {
         dwFlags |= DETACHED_PROCESS;
     }
+    if ((flags & RUN_PROCESS_NEW_CONSOLE) != 0) {
+        dwFlags |= CREATE_NEW_CONSOLE;
+    }
 
     if (!CreateProcess(NULL, cmd, NULL, NULL, inherit, dwFlags, environment, workingDirectory, &sInfo, &pInfo))
     {
diff --git a/changelog.md b/changelog.md
index 4b7c32f..d19ee0b 100644
--- a/changelog.md
+++ b/changelog.md
@@ -4,6 +4,7 @@
 
 * Add StdStream(NoStream) to have standard handles closed. [#13](https://github.com/haskell/process/pull/13)
 * Support for Windows `DETACHED_PROCESS` and `setsid` [#32](https://github.com/haskell/process/issues/32)
+* Support for Windows `CREATE_NEW_CONSOLE` [#38](https://github.com/haskell/process/issues/38)
 
 ## 1.2.3.0 *March 2015*
 
diff --git a/include/processFlags.h b/include/processFlags.h
index 9de6a10..b0cd1ec 100644
--- a/include/processFlags.h
+++ b/include/processFlags.h
@@ -8,3 +8,4 @@
 #define RUN_PROCESS_IN_NEW_GROUP 0x2
 #define RUN_PROCESS_DETACHED     0x4
 #define RUN_PROCESS_NEW_SESSION  0x8
+#define RUN_PROCESS_NEW_CONSOLE  0x16



More information about the ghc-commits mailing list