automatically open control window

3 files changed, 55 insertions, 2 deletions

diff --git a/ControlWindow.hs b/ControlWindow.hs
index c22092f..cc63cef 100644
--- a/ControlWindow.hs
+++ b/ControlWindow.hs
@@ -7,8 +7,11 @@ module ControlWindow where
 import Types
 import CmdLine
 import ControlSocket
+import VirtualTerminal
 
 import System.IO
+import System.Environment
+import System.Process
 import System.Posix
 import Control.Concurrent.Async
 import Control.Concurrent.STM
@@ -16,12 +19,16 @@ import Control.Concurrent.STM.TMChan
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import Data.ByteString.UTF8 (fromString)
+import Control.Monad
 import Data.Monoid
 import Prelude
 
+winDesc :: String
+winDesc = "debug-me session control and chat window"
+
 controlWindow :: ControlOpts -> IO ()
 controlWindow _ = do
-	putStrLn "** debug-me session control and chat window"
+	putStrLn $ "** " ++ winDesc
 	socketfile <- defaultSocketFile
 	ichan <- newTMChanIO
 	ochan <- newTMChanIO
@@ -46,8 +53,12 @@ openControlWindow = do
 	ichan <- newTMChanIO
 	ochan <- newTMChanIO
 	_ <- async $ serveControlSocket soc ichan ochan
+	myexe <- getExecutablePath
+	mproc <- runInVirtualTerminal winDesc myexe ["--control"]
+	case mproc of
+		Nothing -> putStrLn "You need to open another shell prompt, and run: debug-me --control"
+		Just p -> void $ createProcess p
 	-- Wait for message from control process.
-	putStrLn "You need to open another shell prompt, and run: debug-me --control"
 	v <- atomically $ readTMChan ochan
 	case v of
 		Just ControlWindowOpened -> return ()
diff --git a/VirtualTerminal.hs b/VirtualTerminal.hs
new file mode 100644
index 0000000..6c7ef75
--- /dev/null
+++ b/VirtualTerminal.hs
@@ -0,0 +1,41 @@
+module VirtualTerminal where
+
+import System.FilePath
+import System.Directory
+import System.Process
+import System.Environment
+
+-- | Finds a virtual termianl program that looks like it will work
+-- to run a command with some parameters.
+--
+-- Note that the parameters are exposed to the shell by some virtual 
+-- termianls, but not by others.
+runInVirtualTerminal :: String -> String -> [String] -> IO (Maybe CreateProcess)
+runInVirtualTerminal title cmd params = do
+	path <- getSearchPath
+	mdisplay <- lookupEnv "DISPLAY"
+	possibles <- case mdisplay of
+		Just _ -> return $ do
+			p <- path
+			c <- xtermcmds
+			return (p, c)
+		Nothing -> return []
+	find possibles
+  where
+	find [] = return Nothing
+	find ((d, (c, ps)):rest) = do
+		exists <- doesFileExist (d </> c)
+		if exists
+			then return $ Just $ proc (d </> c) ps
+			else find rest
+	
+	-- Ordered list; generally xfce user may have gnome stuff
+	-- installed, and only fall back to the older terminals when
+	-- nothing else is available.
+	xtermcmds =
+		[ ("xfce4-terminal", std)
+		, ("gnome-terminal", ["-e", unwords (cmd:params)])
+		, ("xterm", std)
+		, ("rxvt", ["-T", title, "-e", cmd])
+		]
+	std = ["-T", title, "-e", unwords (cmd:params)]
diff --git a/debug-me.cabal b/debug-me.cabal
index 4ca97d5..7faf2ae 100644
--- a/debug-me.cabal
+++ b/debug-me.cabal
@@ -98,6 +98,7 @@ Executable debug-me
     SessionID
     Types
     Val
+    VirtualTerminal
     WebSockets
 
 source-repository head