From b7bc253ca3160578f88d05fd7f2d9dacae7b00dd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 28 Apr 2017 18:23:34 -0400 Subject: automatically open control window --- ControlWindow.hs | 15 +++++++++++++-- VirtualTerminal.hs | 41 +++++++++++++++++++++++++++++++++++++++++ debug-me.cabal | 1 + 3 files changed, 55 insertions(+), 2 deletions(-) create mode 100644 VirtualTerminal.hs 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 -- cgit v1.2.3