From c897575af5a771f520786dfb40adaa99d8fbf346 Mon Sep 17 00:00:00 2001 From: Austin Seipp Date: Fri, 19 Aug 2016 18:44:39 +0000 Subject: [PATCH 1/2] Only set console terminal title when stdout supports ANSI sequences In some environments, setting the terminal title does not work, like Emacs. This results in very ugly output when using Cryptol as a REPL inside emacs with cryptol-mode, because Emacs merely repeats the escape sequences back to you, completely ruining the main REPL. This patch only sets the terminal if the `stdout` handle is detected to support ANSI escape sequences. This is an adequate check for setting the title. Note the exact semantics are to check that the output is a terminal, and that `TERM` is not set to `dumb`, which is what Emacs sets it to. In the future, `shouldSetREPLTitle` may be expanded to include other cases if that isn't enough. Note a subtle point about this: the function to check this case is very specifically named, because while we may not be able to support certain terminal codes, we *can* support ANSI escape sequences in places like Emacs, reliably. Thus, this patch does not have any changes to the color output: that should be handled by a follow up patch (that allows either autodetect, or explicit enable/disable, on the command line). Then, Emacs will be able to explicitly request color support for the REPL when invoked, while the REPL code itself will reliably abstain from setting the title in such environments automatically. There shouldn't ever be a need to export some '--set-ansi-terminal-title' flag with this logic. Signed-off-by: Austin Seipp --- cryptol/Main.hs | 2 +- cryptol/REPL/Haskeline.hs | 11 ++++++++++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/cryptol/Main.hs b/cryptol/Main.hs index c833147c..44ea61a2 100644 --- a/cryptol/Main.hs +++ b/cryptol/Main.hs @@ -210,7 +210,7 @@ setupREPL opts = do 4 (vcat (map pp smoke))) exitFailure displayLogo True - setUpdateREPLTitle setREPLTitle + setUpdateREPLTitle (shouldSetREPLTitle >>= \b -> when b setREPLTitle) updateREPLTitle mCryptolPath <- io $ lookupEnv "CRYPTOLPATH" case mCryptolPath of diff --git a/cryptol/REPL/Haskeline.hs b/cryptol/REPL/Haskeline.hs index 1be70e24..1e92ff93 100644 --- a/cryptol/REPL/Haskeline.hs +++ b/cryptol/REPL/Haskeline.hs @@ -24,7 +24,8 @@ import Control.Monad.Trans.Control import Data.Char (isAlphaNum, isSpace) import Data.Function (on) import Data.List (isPrefixOf,nub,sortBy,sort) -import System.Console.ANSI (setTitle) +import System.IO (stdout) +import System.Console.ANSI (setTitle, hSupportsANSI) import System.Console.Haskeline import System.Directory ( doesFileExist , getHomeDirectory @@ -151,6 +152,14 @@ setREPLTitle = do lm <- getLoadedMod io (setTitle (mkTitle lm)) +-- | In certain environments like Emacs, we shouldn't set the terminal +-- title. Note: this does not imply we can't use color output. We can +-- use ANSI color sequences in places like Emacs, but not terminal +-- codes. Rather, the lack of color output would imply this option, not the +-- other way around. +shouldSetREPLTitle :: REPL Bool +shouldSetREPLTitle = io (hSupportsANSI stdout) + -- Completion ------------------------------------------------------------------ -- | Completion for cryptol commands. From 1f4b9518a39916f47710c98ac56cb649d7774f94 Mon Sep 17 00:00:00 2001 From: Austin Seipp Date: Fri, 19 Aug 2016 19:17:56 +0000 Subject: [PATCH 2/2] Add a --color command line option This command has three options: 'auto', 'none', and 'always'. They're fairly self explanatory. 'auto' is the default, and detects that the terminal output is not equal to `dumb`, and that `stdout` is a terminal handle. The choice of option has no impact on whether the title sequence is sent to the ANSI terminal. That is always detected automatically and independently of this option. Signed-off-by: Austin Seipp --- cryptol/Main.hs | 25 ++++++++++++++++++++++++- cryptol/REPL/Haskeline.hs | 14 +++++++++++--- cryptol/REPL/Logo.hs | 2 +- 3 files changed, 36 insertions(+), 5 deletions(-) diff --git a/cryptol/Main.hs b/cryptol/Main.hs index 44ea61a2..3029be6d 100644 --- a/cryptol/Main.hs +++ b/cryptol/Main.hs @@ -41,12 +41,16 @@ import System.IO (hClose, hPutStr, openTempFile) import Prelude () import Prelude.Compat +data ColorMode = AutoColor | NoColor | AlwaysColor + deriving (Show, Eq) + data Options = Options { optLoad :: [FilePath] , optVersion :: Bool , optHelp :: Bool , optBatch :: Maybe FilePath , optCommands :: [String] + , optColorMode :: ColorMode , optCryptolrc :: Cryptolrc , optCryptolPathOnly :: Bool } deriving (Show) @@ -58,6 +62,7 @@ defaultOptions = Options , optHelp = False , optBatch = Nothing , optCommands = [] + , optColorMode = AutoColor , optCryptolrc = CryrcDefault , optCryptolPathOnly = False } @@ -73,6 +78,11 @@ options = , "on the command line (overrides --batch)" ]) + , Option "" ["color"] (ReqArg setColorMode "MODE") + (concat [ "control the color output for the terminal, which may be " + , "'auto', 'none' or 'always' (default: 'auto')" + ]) + , Option "v" ["version"] (NoArg setVersion) "display version number" @@ -103,6 +113,13 @@ addCommand cmd = setBatchScript :: String -> OptParser Options setBatchScript path = modify $ \ opts -> opts { optBatch = Just path } +-- | Set the color mode of the terminal output. +setColorMode :: String -> OptParser Options +setColorMode "auto" = modify $ \ opts -> opts { optColorMode = AutoColor } +setColorMode "none" = modify $ \ opts -> opts { optColorMode = NoColor } +setColorMode "always" = modify $ \ opts -> opts { optColorMode = AlwaysColor } +setColorMode x = OptFailure ["invalid color mode: " ++ x ++ "\n"] + -- | Signal that version should be displayed. setVersion :: OptParser Options setVersion = modify $ \ opts -> opts { optVersion = True } @@ -209,7 +226,13 @@ setupREPL opts = do print (hang "Errors encountered on startup; exiting:" 4 (vcat (map pp smoke))) exitFailure - displayLogo True + + color <- case optColorMode opts of + AlwaysColor -> return True + NoColor -> return False + AutoColor -> canDisplayColor + displayLogo color + setUpdateREPLTitle (shouldSetREPLTitle >>= \b -> when b setREPLTitle) updateREPLTitle mCryptolPath <- io $ lookupEnv "CRYPTOLPATH" diff --git a/cryptol/REPL/Haskeline.hs b/cryptol/REPL/Haskeline.hs index 1e92ff93..330b3893 100644 --- a/cryptol/REPL/Haskeline.hs +++ b/cryptol/REPL/Haskeline.hs @@ -153,13 +153,21 @@ setREPLTitle = do io (setTitle (mkTitle lm)) -- | In certain environments like Emacs, we shouldn't set the terminal --- title. Note: this does not imply we can't use color output. We can +-- title. Note: this does not imply we can't use color output. We can -- use ANSI color sequences in places like Emacs, but not terminal --- codes. Rather, the lack of color output would imply this option, not the --- other way around. +-- codes. +-- +-- This checks that @'stdout'@ is a proper terminal handle, and that the +-- terminal mode is not @dumb@, which is set by Emacs and others. shouldSetREPLTitle :: REPL Bool shouldSetREPLTitle = io (hSupportsANSI stdout) +-- | Whether we can display color titles. This checks that @'stdout'@ +-- is a proper terminal handle, and that the terminal mode is not +-- @dumb@, which is set by Emacs and others. +canDisplayColor :: REPL Bool +canDisplayColor = io (hSupportsANSI stdout) + -- Completion ------------------------------------------------------------------ -- | Completion for cryptol commands. diff --git a/cryptol/REPL/Logo.hs b/cryptol/REPL/Logo.hs index 5199bc45..6d2f7aee 100644 --- a/cryptol/REPL/Logo.hs +++ b/cryptol/REPL/Logo.hs @@ -49,4 +49,4 @@ logo useColor = lineLen = length (head ls) displayLogo :: Bool -> REPL () -displayLogo useColor =unlessBatch (io (mapM_ putStrLn (logo useColor))) +displayLogo useColor = unlessBatch (io (mapM_ putStrLn (logo useColor)))