ansi-terminal 1.0.2 → 1.1.5
raw patch · 9 files changed
Files
- CHANGELOG.md +51/−2
- LICENSE +20/−17
- README.md +4/−2
- ansi-terminal.cabal +14/−8
- app/Example.hs +88/−24
- src/System/Console/ANSI.hs +83/−23
- src/System/Console/ANSI/Codes.hs +0/−310
- unix/System/Console/ANSI/Internal.hs +34/−4
- win/System/Console/ANSI/Internal.hs +9/−1
CHANGELOG.md view
@@ -1,6 +1,56 @@ Changes ======= +Version 1.1.5 +------------- + +* On Windows, smothers a C compiler's warnings about `macro-undefined`, + `missing-definitions` and `pragma-pack`, which can be triggered by Windows + C headers. + +Version 1.1.4 +------------- + +* Fixes `hGetCursorPosition` and `hGetLayerColor` on Windows, allowing time for + reported information to reach the standard input channel. +* Improvements to Haddock documentation. +* The executable `ansi-terminal-example` allows individual examples to be + selected. + +Version 1.1.3 +------------- + +* Module `System.Console.ANSI.Codes` spun out to dependency package + `ansi-terminal-types-1.1.3`. + +Version 1.1.2 +------------- + +* Add `enableLineWrap` and `disableLineWrap`, and support for enabling and + disabling automatic line wrapping. + +Version 1.1.1 +------------- + +* Use of C function `setenv()` in one thread can cause other threads calling C + functions that query environment variables to crash. On Unix-like operating + systems, where such functions are used, the implementations of + `hSupportsANSI` and `hSupportsANSIColor` now avoid unnecessary calls of + `System.Environment.lookupEnv`. + +* Improvements to Haddock documentation. + +Version 1.1 +----------- + +* Add support for console layer `Underlining` and underlining styles + `CurlyUnderline`, `DottedUnderline` and `DashedUnderline`. +* Add type synonyms `Parameter`, `SubParam`, and `ParamWithSubs` to represent + SGR parameter values with and without following parameter substrings comprised + of one or more parameter elements (including empty elements). +* Add `csi'` and `sgrToCode'`, corresponding to `csi` and `sgrToCode` but + capable of handling a parameter value followed by a parameter substring. + Version 1.0.2 ------------- @@ -18,11 +68,10 @@ action can try to enable the processing of \'ANSI\' control characters in output. * In Windows Terminal and ConHost terminals, `hSupportsANSI` will yield `False` - if the the processing of \'ANSI\' control characters in output is not enabled. + if the processing of \'ANSI\' control characters in output is not enabled. * Deprecated `hSupportsANSIWithoutEmulation` is now consistent with `hNowSupportsANSI`. * Improvements to Haddock documentation. - Version 1.0 -----------
LICENSE view
@@ -1,22 +1,25 @@ Copyright (c) 2008, Maximilian Bolingbroke All rights reserved. -Redistribution and use in source and binary forms, with or without modification, are permitted -provided that the following conditions are met: +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: - * Redistributions of source code must retain the above copyright notice, this list of - conditions and the following disclaimer. - * Redistributions in binary form must reproduce the above copyright notice, this list of - conditions and the following disclaimer in the documentation and/or other materials - provided with the distribution. - * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to - endorse or promote products derived from this software without specific prior written permission. +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. +* Redistributions in binary form must reproduce the above copyright notice, this + list of conditions and the following disclaimer in the documentation and/or + other materials provided with the distribution. +* Neither the name of Maximilian Bolingbroke nor the names of other contributors + may be used to endorse or promote products derived from this software without + specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR -CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER -IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT -OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md view
@@ -9,12 +9,13 @@ ['ANSI' terminal escape code](http://en.wikipedia.org/wiki/ANSI_escape_sequences) support for Haskell, which allows:-- Colored text output, with control over both foreground and background- colors+- Colored text output, with control over foreground, background and (where+ supported) underlining colors - Clearing parts of a line or the screen - Hiding or showing the cursor - Moving the cursor around - Reporting the position of the cursor+- Enabling and disabling automatic line wrapping - Scrolling the screen up or down - Switching between the Alternate and Normal Screen Buffers - Clickable hyperlinks to URIs@@ -40,6 +41,7 @@ - Directly changing cursor position: `setCursorColumn` and `setCursorPosition` - Saving, restoring and reporting cursor position: `saveCursor`, `restoreCursor` and `reportCursorPosition`+- Automatic line wrapping: `enableLineWrap` and `disableLineWrap` - Scrolling the screen: `scrollPageUp` and `scrollPageDown` - Changing the title: `setTitle`
ansi-terminal.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 1.22 Name: ansi-terminal -Version: 1.0.2 +Version: 1.1.5 Category: User Interfaces Synopsis: Simple ANSI terminal support Description: ANSI terminal support for Haskell: allows cursor movement, @@ -23,23 +23,23 @@ type: git location: git://github.com/UnkindPartition/ansi-terminal.git -Flag Example +Flag example Description: Build the example application Default: False Library Hs-Source-Dirs: src Exposed-Modules: System.Console.ANSI - System.Console.ANSI.Codes -- We re-export all of ansi-terminal-types to aid compatibility for -- downstream users. - Reexported-Modules: System.Console.ANSI.Types + Reexported-Modules: System.Console.ANSI.Codes + , System.Console.ANSI.Types Other-Modules: System.Console.ANSI.Internal Build-Depends: base >= 4.8.0.0 && < 5 - , ansi-terminal-types == 0.11.5 + , ansi-terminal-types == 1.1.3 , colour >= 2.1.0 if os(windows) Hs-Source-Dirs: win @@ -47,12 +47,18 @@ System.Console.ANSI.Windows.Win32.Types System.Console.ANSI.Windows.Win32.MinTTY Include-Dirs: win/include - Includes: errors.h - HsWin32.h - winternl_compat.h Install-Includes: HsWin32.h C-Sources: win/c-source/errors.c win/c-source/HsWin32.c + -- The MSYS2 UCRT64 environment is stricter than the MINGW64 + -- environment about these C compiler diagnostics: + -- (1) macro-redefined, (2) missing-declarations, and + -- (3) pragma-pack. Windows C headers are not warning-clean under + -- -Wmacro-redefined, -Wmissing-declarations and -Wpragma-pack. We + -- smother those warnings: + Cc-Options: -Wno-macro-redefined + -Wno-missing-declarations + -Wno-pragma-pack else Hs-Source-Dirs: unix
app/Example.hs view
@@ -11,34 +11,57 @@ import Data.Colour.SRGB (sRGB24) import System.Console.ANSI +import System.Environment ( getArgs ) -examples :: [IO ()] -examples = [ cursorMovementExample - , lineChangeExample - , setCursorPositionExample - , saveRestoreCursorExample - , clearExample - , scrollExample - , screenBuffersExample - , sgrColorExample - , sgrOtherExample - , cursorVisibilityExample - , hyperlinkExample - , titleExample - , getCursorPositionExample - , getTerminalSizeExample - , getLayerColorExample - ] +examples :: [(String, IO ())] +examples = + [ ( "Cursor movement", cursorMovementExample ) + , ( "Line change", lineChangeExample ) + , ( "Set cursor position", setCursorPositionExample ) + , ( "Save restore cursor", saveRestoreCursorExample ) + , ( "Clear", clearExample ) + , ( "Line wrap", lineWrapExample ) + , ( "Scroll", scrollExample ) + , ( "Screen buffers", screenBuffersExample ) + , ( "SGR color", sgrColorExample ) + , ( "SGR other", sgrOtherExample ) + , ( "Cursor visibility", cursorVisibilityExample ) + , ( "Hyperlink", hyperlinkExample ) + , ( "Title", titleExample ) + , ( "Get cursor position", getCursorPositionExample ) + , ( "Get terminal size", getTerminalSizeExample ) + , ( "Get layer color", getLayerColorExample ) + ] main :: IO () main = do - stdoutSupportsANSI <- hNowSupportsANSI stdout - if stdoutSupportsANSI + args <- getArgs + let numExamples = zip [1 ..] examples + if wantHelp args then - mapM_ (resetScreen >>) examples - else - putStrLn "Standard output does not support 'ANSI' escape codes." + listExamples numExamples + else do + let wantedNumExamples = filter (isExample args) numExamples + wantedExamples = map getExample wantedNumExamples + stdoutSupportsANSI <- hNowSupportsANSI stdout + if stdoutSupportsANSI + then + mapM_ (resetScreen >>) wantedExamples + else + putStrLn "Standard output does not support 'ANSI' escape codes." + where + wantHelp :: [String] -> Bool + wantHelp args = "-h" `elem` args || "--help" `elem` args + listExamples :: [(Int, (String, IO ()))] -> IO () + listExamples = mapM_ (\(n, (d, _)) -> putStrLn $ show n ++ ": " ++ d) + + isExample :: [String] -> (Int, (String, IO ())) -> Bool + isExample args (n, _) = show n `elem` args + + getExample :: (Int, (String, IO ())) -> IO () + getExample (_, (_, example)) = example + -- Annex D to Standard ECMA-48 (5th Ed, 1991) identifies that the representation -- of an erased state is implementation-dependent. There may or may not be a -- distinction between a character position in the erased state and one imaging @@ -206,6 +229,24 @@ pause -- +lineWrapExample :: IO () +lineWrapExample = do + putStrLn $ take 240 $ cycle "Default-line-wrap|" + pause + -- Default-line-wrap|Default-line-wrap|Default-line-wrap|Default-line-wrap|Def + -- ault-line-wrap|Default-line-wrap|Default-line-wrap|Default-line-wrap|Defaul + -- t-line-wrap|Default-line-wrap|Default-line-wrap|Default-line-wrap|Default-l + disableLineWrap + putStrLn $ take 240 $ cycle "Disable-line-wrap|" + pause + -- Disable-line-wrap|Disable-line-wrap|Disable-line-wrap|Disable-line-wrap|Dis + enableLineWrap + putStrLn $ take 240 $ cycle "Enable-line-wrap|" + pause + -- Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable- + -- line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wr + -- ap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enab + scrollExample :: IO () scrollExample = do putStrLn "Line One" @@ -243,15 +284,16 @@ sgrColorExample :: IO () sgrColorExample = do let colors = enumFromTo minBound maxBound :: [Color] - forM_ [Foreground, Background] $ \layer -> do + forM_ [Foreground, Background, Underlining] $ \layer -> do forM_ [Dull, Vivid] $ \intensity -> do resetScreen forM_ colors $ \color -> do setSGR [Reset] setSGR [SetColor layer intensity color] + setSGR [SetUnderlining SingleUnderline] print color pause - -- The ANSI eight standard colors, 4 times in sequence (two layers and two + -- The ANSI eight standard colors, 6 times in sequence (three layers and two -- intensities) resetScreen @@ -333,6 +375,25 @@ putStr " " replicateM_ 5 pause + resetScreen + setSGR [Reset] + setSGR [SetUnderlining SingleUnderline] + forM_ + (zip "Underlining: True color (24 bit color depth)" (cycle [0, 10 .. 255])) $ + \(c, i) -> do + setSGR [SetRGBColor Underlining $ sRGB24 i 0 0] + putChar c + putChar '\n' + putChar '\n' + setSGR [Reset] + setSGR [SetUnderlining SingleUnderline] + forM_ (zip "Underlining: A 256-color palette" (cycle [0 .. 5])) $ + \(c, i) -> do + setSGR [SetPaletteColor Underlining $ xterm6LevelRGB i 0 0] + putChar c + putChar '\n' + replicateM_ 5 pause + sgrOtherExample :: IO () sgrOtherExample = do let named_styles = [ (SetConsoleIntensity BoldIntensity, "Bold") @@ -342,6 +403,9 @@ , (SetItalicized False, "No Italics") , (SetUnderlining SingleUnderline, "Single Underline") , (SetUnderlining DoubleUnderline, "Double Underline") + , (SetUnderlining CurlyUnderline, "Curly Underline") + , (SetUnderlining DottedUnderline, "Dotted Underline") + , (SetUnderlining DashedUnderline, "Dashed Underline") , (SetUnderlining NoUnderline, "No Underline") , (SetBlinkSpeed SlowBlink, "Slow Blink") , (SetBlinkSpeed RapidBlink, "Rapid Blink")
src/System/Console/ANSI.hs view
@@ -10,7 +10,8 @@ codes) provide a rich range of functionality for terminal control, which includes: - * Colored text output, with control over both foreground and background colors + * Colored text output, with control over foreground, background and (where + supported) underlining colors * Clearing parts of a line or the screen @@ -20,6 +21,8 @@ * Reporting the position of the cursor + * Enabling or disabling automatic line wrapping + * Scrolling the screen up or down * Switching between the Alternate and Normal Screen Buffers @@ -83,9 +86,9 @@ GHC's management of input and output (IO) on Windows has also developed over time. If they are supported by the terminal software, some control character sequences cause data to be emitted into the console input stream. For GHC's -historical and default IO manager, the function 'hGetBufNonBlocking' in module -"System.IO" does not work on Windows. This has been attributed to the lack of -non-blocking primatives in the operating system (see +historical and default IO manager, the function 'System.IO.hGetBufNonBlocking' +in module "System.IO" does not work on Windows. This has been attributed to the +lack of non-blocking primatives in the operating system (see [GHC bug report #806](https://ghc.haskell.org/trac/ghc/ticket/806). GHC's native IO manager on Windows (\'WinIO\'), introduced as a preview in [GHC 9.0.1](https://downloads.haskell.org/ghc/9.0.1/docs/html/users_guide/9.0.1-notes.html#highlights), @@ -196,6 +199,7 @@ , cursorBackwardCode -- * Cursor movement by line + -- -- | The difference between movements \"by character\" and \"by line\" is -- that @*Line@ functions additionally move the cursor to the start of the -- line, while functions like @cursorUp@ and @cursorDown@ keep the column @@ -220,6 +224,7 @@ , setCursorPositionCode -- * Saving, restoring and reporting cursor position + -- -- | These code sequences are not part of ECMA-48 standard; they are popular, -- but non-portable extensions. E. g., Terminal.app on MacOS -- <https://stackoverflow.com/questions/25879183 does not support them>. @@ -242,6 +247,7 @@ , reportCursorPositionCode -- * Clearing parts of the screen + -- -- | Note that these functions only clear parts of the screen. They do not -- move the cursor. Some functions are based on the whole screen and others -- are based on the line in which the cursor is located. @@ -266,6 +272,19 @@ , clearFromCursorToLineBeginningCode , clearLineCode + -- * Enabling and disabling automatic line wrapping + -- + -- | These functions control whether or not characters automatically wrap to + -- the next line when the cursor reaches the right border. + , enableLineWrap + , disableLineWrap + -- ** \'h...\' variants + , hEnableLineWrap + , hDisableLineWrap + -- ** \'...Code\' variants + , enableLineWrapCode + , disableLineWrapCode + -- * Scrolling the screen , scrollPageUp , scrollPageDown @@ -277,6 +296,7 @@ , scrollPageDownCode -- * Using screen buffers + -- -- | These code sequences are not part of ECMA-48 standard; they are popular, -- but non-portable extensions, corresponding to @smcup@ and @rmcup@ capabilities -- in @terminfo@ database. @@ -302,6 +322,7 @@ , setSGRCode -- * Cursor visibilty changes + -- -- | Strictly speaking, these code sequences are not part of ECMA-48 standard; -- they are popular, but non-portable extensions. However, in practice they seem -- to work pretty much everywhere. @@ -315,6 +336,7 @@ , showCursorCode -- * Hyperlinks + -- -- | These code sequences are not part of ECMA-48 standard and not even an -- @xterm@ extension. Nevertheless -- <https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda many terminals> @@ -362,12 +384,12 @@ , hSupportsANSIWithoutEmulation ) where +import Control.Concurrent (threadDelay) import Control.Exception.Base ( bracket ) import Control.Monad ( when, void ) import Data.Char ( digitToInt, isDigit, isHexDigit ) import Data.Colour.SRGB ( RGB (..) ) import Data.Word ( Word16 ) -import System.Environment ( getEnvironment ) import System.IO ( BufferMode (..), Handle, hFlush, hGetBuffering, hGetEcho, hPutStr , hReady, hSetBuffering, hSetEcho, stdin, stdout @@ -600,7 +622,7 @@ -- will work with a given handle. -- -- If the handle is not writable (that is, it cannot manage output - see --- 'hIsWritable'), then @pure False@ is returned. +-- 'System.IO.hIsWritable'), then @pure False@ is returned. -- -- For Unix-like operating systems, the current implementation checks -- that: (1) the handle is a terminal; and (2) a @TERM@ environment variable is @@ -611,12 +633,12 @@ -- a terminal, (2) a @TERM@ environment variable is not set to @dumb@, and (3) -- the processing of \'ANSI\' control characters in output is enabled; and -- second, as an alternative, whether the handle is connected to a \'mintty\' --- terminal. (That is because the function 'hIsTerminalDevice' is used to check --- if the handle is a terminal. However, where a non-native Windows terminal --- (such as \'mintty\') is implemented using redirection, that function will not --- identify a handle to the terminal as a terminal.) If it is not already --- enabled, this function does *not* enable the processing of \'ANSI\' control --- characters in output (see 'hNowSupportsANSI'). +-- terminal. (That is because the function 'System.IO.hIsTerminalDevice' is used +-- to check if the handle is a terminal. However, where a non-native Windows +-- terminal (such as \'mintty\') is implemented using redirection, that function +-- will not identify a handle to the terminal as a terminal.) If it is not +-- already enabled, this function does *not* enable the processing of \'ANSI\' +-- control characters in output (see 'hNowSupportsANSI'). -- -- @since 0.6.2 hSupportsANSI :: Handle -> IO Bool @@ -627,7 +649,7 @@ -- the processing of \'ANSI\' control characters in output is not enabled, this -- function first tries to enable such processing. -- --- @Since 1.0.1 +-- @since 1.0.1 hNowSupportsANSI :: Handle -> IO Bool hNowSupportsANSI = Internal.hNowSupportsANSI @@ -637,11 +659,7 @@ -- -- @since 0.9 hSupportsANSIColor :: Handle -> IO Bool -hSupportsANSIColor h = (||) <$> hSupportsANSI h <*> isEmacsTerm - where - isEmacsTerm = (\env -> insideEmacs env && isDumb env) <$> getEnvironment - insideEmacs = any (\(k, _) -> k == "INSIDE_EMACS") - isDumb env = Just "dumb" == lookup "TERM" env +hSupportsANSIColor = Internal.hSupportsANSIColor -- | Use heuristics to determine whether a given handle will support \'ANSI\' -- control characters in output. The function is consistent with @@ -724,6 +742,8 @@ -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) -- +-- This operation may fail with an error if 'stdin' has been redirected. +-- -- @since 0.10.3 getCursorPosition :: IO (Maybe (Int, Int)) getCursorPosition = hGetCursorPosition stdout @@ -742,6 +762,8 @@ -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) -- +-- This operation may fail with an error if 'stdin' has been redirected. +-- -- @since 0.10.1 hGetCursorPosition :: Handle -> IO (Maybe (Int, Int)) hGetCursorPosition h = fmap to0base <$> getCursorPosition' @@ -758,8 +780,13 @@ hSetEcho stdin False clearStdin hReportCursorPosition h - hFlush h -- ensure the report cursor position code is sent to the - -- operating system + -- Ensure the report cursor position code is sent to the operating + -- system: + hFlush h + -- On Windows and in Windows Terminal v1.22.12111.0 (at least), it seems + -- that a moment's delay is required in order to allow sufficient time + -- for the reported information to reach the standard input channel: + threadDelay 1 getReportedCursorPosition case readP_to_S cursorPosition input of [] -> pure Nothing @@ -787,6 +814,8 @@ -- emulated, but the emulation does not work on Windows Terminal and (2) of -- difficulties in obtaining the data emitted into the console input stream. -- +-- Underlining is not supported. +-- -- @since 0.11.4 reportLayerColor :: ConsoleLayer -> IO () reportLayerColor = hReportLayerColor stdout @@ -818,6 +847,8 @@ -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) -- +-- Underlining is not supported. +-- -- @since 0.11.4 getReportedLayerColor :: ConsoleLayer -> IO String getReportedLayerColor = Internal.getReportedLayerColor @@ -835,6 +866,10 @@ -- and PowerShell are based on the Console API.) This function also relies on -- emulation that does not work on Windows Terminal. -- +-- Underlining is not supported. +-- +-- This operation may fail with an error if 'stdin' has been redirected. +-- -- @since 0.11.4 getLayerColor :: ConsoleLayer -> IO (Maybe(RGB Word16)) getLayerColor = hGetLayerColor stdout @@ -851,6 +886,10 @@ -- and PowerShell are based on the Console API.) This function also relies on -- emulation that does not work on Windows Terminal. -- +-- Underlining is not supported. +-- +-- This operation may fail with an error if 'stdin' has been redirected. +-- -- @since 0.11.4 hGetLayerColor :: Handle -> ConsoleLayer -> IO (Maybe (RGB Word16)) hGetLayerColor h layer = do @@ -864,8 +903,12 @@ hSetEcho stdin False clearStdin hReportLayerColor h layer - hFlush h -- ensure the report cursor position code is sent to the - -- operating system + -- Ensure the report cursor position code is sent to the operating system: + hFlush h + -- On Windows and in Windows Terminal v1.22.12111.0 (at least), it seems + -- that a moment's delay is required in order to allow sufficient time for + -- the reported information to reach the standard input channel: + threadDelay 1 getReportedLayerColor layer case readP_to_S (layerColor layer) input of [] -> pure Nothing @@ -890,6 +933,8 @@ -- > [(col, _)] -> putStrLn $ "The color was " ++ show col ++ "." -- > (_:_) -> putStrLn $ "Error: parse not unique" -- +-- Underlining is not supported. +-- -- @since 0.11.4 layerColor :: ConsoleLayer -> ReadP (RGB Word16) layerColor layer = do @@ -897,6 +942,7 @@ void $ string $ case layer of Foreground -> "10" Background -> "11" + Underlining -> fail "reportLayerColor does not support underlining" void $ string ";rgb:" redHex <- hexadecimal -- A non-negative whole hexadecimal number void $ char '/' @@ -938,6 +984,8 @@ -- as mintty, that are not based on Windows' Console API. (Command Prompt and -- PowerShell are based on the Console API.) -- +-- This operation may fail with an error if 'stdin' has been redirected. +-- -- For a different approach, one that does not use control character sequences -- and works when 'stdin' is redirected, see the -- <https://hackage.haskell.org/package/terminal-size terminal-size> package. @@ -948,7 +996,7 @@ -- | Attempts to get the current terminal size (height in rows, width in -- columns), by writing control character sequences to the specified handle --- (which will typically be 'stdout' or 'stderr'). +-- (which will typically be 'stdout' or 'System.IO.stderr'). -- -- There is no \'ANSI\' control character sequence that reports the terminal -- size. So, it attempts to set the cursor position beyond the bottom right @@ -961,6 +1009,8 @@ -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) -- +-- This operation may fail with an error if 'stdin' has been redirected. +-- -- For a different approach, one that does not use control character sequences -- and works when 'stdin' is redirected, see the -- <https://hackage.haskell.org/package/terminal-size terminal-size> package. @@ -1020,6 +1070,16 @@ clearFromCursorToLineEnd = hClearFromCursorToLineEnd stdout clearFromCursorToLineBeginning = hClearFromCursorToLineBeginning stdout clearLine = hClearLine stdout + +hEnableLineWrap, hDisableLineWrap :: + Handle + -> IO () +hEnableLineWrap h = hPutStr h enableLineWrapCode +hDisableLineWrap h = hPutStr h disableLineWrapCode + +enableLineWrap, disableLineWrap :: IO () +enableLineWrap = hEnableLineWrap stdout +disableLineWrap = hDisableLineWrap stdout hScrollPageUp, hScrollPageDown :: Handle
− src/System/Console/ANSI/Codes.hs
@@ -1,310 +0,0 @@-{-# LANGUAGE Safe #-} - -{-| This module exports functions that return 'String' values containing codes -in accordance with the \'ANSI\' standards for control character sequences -described in the documentation of module "System.Console.ANSI". --} -module System.Console.ANSI.Codes - ( - -- * Basic data types - module System.Console.ANSI.Types - - -- * Cursor movement by character - -- - -- | These functions yield @\"\"@ when the number is @0@ as, on some - -- terminals, a @0@ parameter for the underlying \'ANSI\' code specifies a - -- default parameter of @1@. - , cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode - - -- * Cursor movement by line - -- - -- | These functions yield the equivalent of @setCursorColumnCode 0@ when - -- the number is @0@ as, on some terminals, a @0@ parameter for the - -- underlying \'ANSI\' code specifies a default parameter of @1@. - , cursorUpLineCode, cursorDownLineCode - - -- * Directly changing cursor position - , setCursorColumnCode, setCursorPositionCode - - -- * Saving, restoring and reporting cursor position - , saveCursorCode, restoreCursorCode, reportCursorPositionCode - - -- * Clearing parts of the screen - , clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode - , clearScreenCode, clearFromCursorToLineEndCode - , clearFromCursorToLineBeginningCode, clearLineCode - - -- * Scrolling the screen - -- - -- | These functions yield @\"\"@ when the number is @0@ as, on some - -- terminals, a @0@ parameter for the underlying \'ANSI\' code specifies a - -- default parameter of @1@. - , scrollPageUpCode, scrollPageDownCode - - -- * Using screen buffers - , useAlternateScreenBufferCode, useNormalScreenBufferCode - - -- * Reporting background or foreground colors - , reportLayerColorCode - - -- * Select Graphic Rendition mode: colors and other whizzy stuff - , setSGRCode - - -- * Cursor visibilty changes - , hideCursorCode, showCursorCode - - -- * Hyperlinks - -- | Some, but not all, terminals support hyperlinks - that is, clickable - -- text that points to a URI. - , hyperlinkCode, hyperlinkWithIdCode, hyperlinkWithParamsCode - - -- * Changing the title - , setTitleCode - - -- * Utilities - , colorToCode, csi, osc, sgrToCode - ) where - -import Data.Char (isPrint) -import Data.List (intercalate) - -import Data.Colour.SRGB (toSRGB24, RGB (..)) - -import System.Console.ANSI.Types - --- | 'csi' @parameters controlFunction@, where @parameters@ is a list of 'Int', --- returns the control sequence comprising the control function CONTROL --- SEQUENCE INTRODUCER (CSI) followed by the parameter(s) (separated by \';\') --- and ending with the @controlFunction@ character(s) that identifies the --- control function. -csi :: - [Int] -- ^ List of parameters for the control sequence - -> String -- ^ Character(s) that identify the control function - -> String -csi args code = "\ESC[" ++ intercalate ";" (map show args) ++ code - --- | 'osc' @parameterS parametersT@, where @parameterS@ specifies the type of --- operation to perform and @parametersT@ is the other parameter(s) (if any), --- returns the control sequence comprising the control function OPERATING SYSTEM --- COMMAND (OSC) followed by the parameters (separated by \';\') and ending with --- the STRING TERMINATOR (ST) @\"\\ESC\\\\\"@. --- --- @since 0.11.4 -osc :: - String -- ^ Ps parameter - -> String -- ^ Pt parameter(s) - -> String -osc pS pT = "\ESC]" ++ pS ++ ";" ++ pT ++ "\ESC\\" - --- | 'colorToCode' @color@ returns the 0-based index of the color (one of the --- eight colors in the ANSI standard). -colorToCode :: Color -> Int -colorToCode color = case color of - Black -> 0 - Red -> 1 - Green -> 2 - Yellow -> 3 - Blue -> 4 - Magenta -> 5 - Cyan -> 6 - White -> 7 - --- | 'sgrToCode' @sgr@ returns the parameter of the SELECT GRAPHIC RENDITION --- (SGR) aspect identified by @sgr@. -sgrToCode :: - SGR -- ^ The SGR aspect - -> [Int] -sgrToCode sgr = case sgr of - Reset -> [0] - SetConsoleIntensity intensity -> case intensity of - BoldIntensity -> [1] - FaintIntensity -> [2] - NormalIntensity -> [22] - SetItalicized True -> [3] - SetItalicized False -> [23] - SetUnderlining underlining -> case underlining of - SingleUnderline -> [4] - DoubleUnderline -> [21] - NoUnderline -> [24] - SetBlinkSpeed blink_speed -> case blink_speed of - SlowBlink -> [5] - RapidBlink -> [6] - NoBlink -> [25] - SetVisible False -> [8] - SetVisible True -> [28] - SetSwapForegroundBackground True -> [7] - SetSwapForegroundBackground False -> [27] - SetColor Foreground Dull color -> [30 + colorToCode color] - SetColor Foreground Vivid color -> [90 + colorToCode color] - SetColor Background Dull color -> [40 + colorToCode color] - SetColor Background Vivid color -> [100 + colorToCode color] - SetPaletteColor Foreground index -> [38, 5, fromIntegral index] - SetPaletteColor Background index -> [48, 5, fromIntegral index] - SetRGBColor Foreground color -> [38, 2] ++ toRGB color - SetRGBColor Background color -> [48, 2] ++ toRGB color - SetDefaultColor Foreground -> [39] - SetDefaultColor Background -> [49] - where - toRGB color = let RGB r g b = toSRGB24 color - in map fromIntegral [r, g, b] - -cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode :: - Int -- ^ Number of lines or characters to move - -> String -cursorUpCode n = if n == 0 then "" else csi [n] "A" -cursorDownCode n = if n == 0 then "" else csi [n] "B" -cursorForwardCode n = if n == 0 then "" else csi [n] "C" -cursorBackwardCode n = if n == 0 then "" else csi [n] "D" - -cursorDownLineCode, cursorUpLineCode :: - Int -- ^ Number of lines to move - -> String -cursorDownLineCode n = if n == 0 then csi [1] "G" else csi [n] "E" -cursorUpLineCode n = if n == 0 then csi [1] "G" else csi [n] "F" - --- | Code to move the cursor to the specified column. The column numbering is --- 0-based (that is, the left-most column is numbered 0). -setCursorColumnCode :: - Int -- ^ 0-based column to move to - -> String -setCursorColumnCode n = csi [n + 1] "G" - --- | Code to move the cursor to the specified position (row and column). The --- position is 0-based (that is, the top-left corner is at row 0 column 0). -setCursorPositionCode :: - Int -- ^ 0-based row to move to - -> Int -- ^ 0-based column to move to - -> String -setCursorPositionCode n m = csi [n + 1, m + 1] "H" - --- | @since 0.7.1 -saveCursorCode, restoreCursorCode :: String -saveCursorCode = "\ESC7" -restoreCursorCode = "\ESC8" - --- | Code to emit the cursor position into the console input stream, immediately --- after being recognised on the output stream, as: --- @ESC [ \<cursor row> ; \<cursor column> R@ --- --- Note that the information that is emitted is 1-based (the top-left corner is --- at row 1 column 1) but 'setCursorPositionCode' is 0-based. --- --- In isolation of 'System.Console.ANSI.getReportedCursorPosition' or --- 'System.Console.ANSI.getCursorPosition', this function may be of limited use --- on Windows operating systems because of difficulties in obtaining the data --- emitted into the console input stream. --- --- @since 0.7.1 -reportCursorPositionCode :: String -reportCursorPositionCode = csi [] "6n" - --- | Code to emit the layer color into the console input stream, immediately --- after being recognised on the output stream, as: --- @ESC ] \<Ps> ; rgb: \<red> ; \<green> ; \<blue> \<ST>@ --- where @\<Ps>@ is @10@ for 'Foreground' and @11@ for 'Background'; @\<red>@, --- @\<green>@ and @\<blue>@ are the color channel values in hexadecimal (4, 8, --- 12 and 16 bit values are possible, although 16 bit values are most common); --- and @\<ST>@ is the STRING TERMINATOR (ST). ST depends on the terminal --- software and may be the @BEL@ character or @ESC \\@ characters. --- --- This function may be of limited, or no, use on Windows operating systems --- because (1) the control character sequence is not supported on native --- terminals (2) of difficulties in obtaining the data emitted into the --- console input stream. See 'System.Console.ANSI.getReportedLayerColor'. --- --- @since 0.11.4 -reportLayerColorCode :: ConsoleLayer -> String -reportLayerColorCode Foreground = osc "10" "?" -reportLayerColorCode Background = osc "11" "?" - -clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode, - clearScreenCode :: String -clearFromCursorToLineEndCode, clearFromCursorToLineBeginningCode, - clearLineCode :: String - -clearFromCursorToScreenEndCode = csi [0] "J" -clearFromCursorToScreenBeginningCode = csi [1] "J" -clearScreenCode = csi [2] "J" -clearFromCursorToLineEndCode = csi [0] "K" -clearFromCursorToLineBeginningCode = csi [1] "K" -clearLineCode = csi [2] "K" - -scrollPageUpCode, scrollPageDownCode :: - Int -- ^ Number of lines to scroll by - -> String -scrollPageUpCode n = if n == 0 then "" else csi [n] "S" -scrollPageDownCode n = if n == 0 then "" else csi [n] "T" - -useAlternateScreenBufferCode, useNormalScreenBufferCode :: String -useAlternateScreenBufferCode = csi [] "?1049h" -useNormalScreenBufferCode = csi [] "?1049l" - -setSGRCode :: - [SGR] - -- ^ Commands: these will typically be applied on top of the current - -- console SGR mode. An empty list of commands is equivalent to the list - -- @[Reset]@. Commands are applied left to right. - -> String -setSGRCode sgrs = csi (concatMap sgrToCode sgrs) "m" - -hideCursorCode, showCursorCode :: String -hideCursorCode = csi [] "?25l" -showCursorCode = csi [] "?25h" - --- | Code to introduce a hyperlink with (key, value) parameters. Some terminals --- support an @id@ parameter key, so that hyperlinks with the same @id@ value --- are treated as connected. --- --- @since 0.11.3 -hyperlinkWithParamsCode :: - [(String, String)] - -- ^ Parameters - -> String - -- ^ URI - -> String - -- ^ Link text - -> String -hyperlinkWithParamsCode params uri link = - osc "8" pT ++ link ++ osc "8" ";" - where - pT = params' ++ ";" ++ uri - params' = intercalate ":" $ map (\(k, v) -> k ++ "=" ++ v) params - --- | Code to introduce a hyperlink. --- --- @since 0.11.3 -hyperlinkCode :: - String - -- ^ URI - -> String - -- ^ Link text - -> String -hyperlinkCode = hyperlinkWithParamsCode [] - --- | Code to introduce a hyperlink with an identifier for the link. Some --- terminals support an identifier, so that hyperlinks with the same identifier --- are treated as connected. --- --- @since 0.11.3 -hyperlinkWithIdCode :: - String - -- ^ Identifier for the link - -> String - -- ^ URI - -> String - -- ^ Link text - -> String -hyperlinkWithIdCode linkId = hyperlinkWithParamsCode [("id", linkId)] - --- | Code to set the terminal window title and the icon name (that is, the text --- for the window in the Start bar, or similar). - --- Thanks to Brandon S. Allbery and Curt Sampson for pointing me in the right --- direction on xterm title setting on haskell-cafe. The "0" signifies that both --- the title and "icon" text should be set. This is chosen for consistent --- behaviour between Unixes and Windows. -setTitleCode :: - String - -- ^ New window title and icon name - -> String -setTitleCode title = osc "0" (filter isPrint title)
unix/System/Console/ANSI/Internal.hs view
@@ -1,16 +1,18 @@-{-# LANGUAGE Safe #-} +{-# LANGUAGE Trustworthy #-} module System.Console.ANSI.Internal ( getReportedCursorPosition , getReportedLayerColor , hSupportsANSI , hNowSupportsANSI + , hSupportsANSIColor ) where import Data.List ( uncons ) -import Data.Maybe ( fromMaybe, mapMaybe ) +import Data.Maybe ( fromMaybe, isJust, mapMaybe ) import System.Environment ( lookupEnv ) import System.IO ( Handle, hIsTerminalDevice, hIsWritable ) +import System.IO.Unsafe ( unsafePerformIO ) import System.Timeout ( timeout ) import System.Console.ANSI.Types ( ConsoleLayer (..) ) @@ -19,6 +21,8 @@ getReportedCursorPosition = getReport "\ESC[" ["R"] getReportedLayerColor :: ConsoleLayer -> IO String +getReportedLayerColor Underlining = + error "getReportedLayerColor does not support underlining." getReportedLayerColor layer = getReport ("\ESC]" ++ pS ++ ";rgb:") ["\BEL", "\ESC\\"] where @@ -72,8 +76,34 @@ -- (https://github.com/hspec/hspec/commit/d932f03317e0e2bd08c85b23903fb8616ae642bd) hSupportsANSI h = (&&) <$> hIsWritable h <*> hSupportsANSI' where - hSupportsANSI' = (&&) <$> hIsTerminalDevice h <*> isNotDumb - isNotDumb = (/= Just "dumb") <$> lookupEnv "TERM" + hSupportsANSI' = (&& isNotDumb) <$> hIsTerminalDevice h hNowSupportsANSI :: Handle -> IO Bool hNowSupportsANSI = hSupportsANSI + +hSupportsANSIColor :: Handle -> IO Bool +hSupportsANSIColor h = (|| isEmacsTerm) <$> hSupportsANSI h + where + isEmacsTerm = insideEmacs && isDumb + isDumb = not isNotDumb + +-- | This function assumes that once it is first established whether or not the +-- TERM environment variable exists with contents dumb, that will not change. +-- This approach is taken because the use of C function setenv() in one thread +-- can cause other threads calling C function getenv() to crash. On Unix-like +-- operating systems, System.Environment.lookupEnv is implemented using C +-- function getenv(). +isNotDumb :: Bool +isNotDumb = unsafePerformIO (lookupEnv "TERM") /= Just "dumb" + +{-# NOINLINE isNotDumb #-} + +-- | This function assumes that once it is first established whether or not the +-- INSIDE_EMACS environment variable exists, that will not change. This approach +-- is taken because the use of C function setenv() in one thread can cause other +-- threads calling C function getenv() to crash. On Unix-like operating systems, +-- System.Environment.lookupEnv is implemented using C function getenv(). +insideEmacs :: Bool +insideEmacs = isJust $ unsafePerformIO (lookupEnv "INSIDE_EMACS") + +{-# NOINLINE insideEmacs #-}
win/System/Console/ANSI/Internal.hs view
@@ -5,12 +5,13 @@ , getReportedLayerColor , hNowSupportsANSI , hSupportsANSI + , hSupportsANSIColor ) where import Control.Exception ( IOException, SomeException, catch, try ) import Data.Bits ( (.&.), (.|.) ) import Data.Maybe ( mapMaybe ) -import System.Environment ( lookupEnv ) +import System.Environment ( getEnvironment, lookupEnv ) import System.IO ( Handle, hIsTerminalDevice, hIsWritable, stdin ) import System.Console.ANSI.Types ( ConsoleLayer ) @@ -103,3 +104,10 @@ if h == iNVALID_HANDLE_VALUE || h == nullHANDLE then invalid -- Invalid handle or no handle else action h + +hSupportsANSIColor :: Handle -> IO Bool +hSupportsANSIColor h = (||) <$> hSupportsANSI h <*> isEmacsTerm + where + isEmacsTerm = (\env -> insideEmacs env && isDumb env) <$> getEnvironment + insideEmacs = any (\(k, _) -> k == "INSIDE_EMACS") + isDumb env = Just "dumb" == lookup "TERM" env