Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-ansi-terminal for openSUSE:Factory checked in at 2023-01-18 13:09:37 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-ansi-terminal (Old) and /work/SRC/openSUSE:Factory/.ghc-ansi-terminal.new.32243 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-ansi-terminal" Wed Jan 18 13:09:37 2023 rev:22 rq:1059050 version:0.11.4 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-ansi-terminal/ghc-ansi-terminal.changes 2022-08-01 21:29:34.529514717 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-ansi-terminal.new.32243/ghc-ansi-terminal.changes 2023-01-18 13:09:45.432448443 +0100 @@ -1,0 +2,9 @@ +Mon Nov 21 23:22:40 UTC 2022 - Peter Simons <psim...@suse.com> + +- Update ansi-terminal to version 0.11.4. + Upstream has edited the change log file since the last release in + a non-trivial way, i.e. they did more than just add a new entry + at the top. You can review the file at: + http://hackage.haskell.org/package/ansi-terminal-0.11.4/src/CHANGELOG.md + +------------------------------------------------------------------- Old: ---- ansi-terminal-0.11.3.tar.gz New: ---- ansi-terminal-0.11.4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-ansi-terminal.spec ++++++ --- /var/tmp/diff_new_pack.0XN5Pz/_old 2023-01-18 13:09:45.984451613 +0100 +++ /var/tmp/diff_new_pack.0XN5Pz/_new 2023-01-18 13:09:45.988451636 +0100 @@ -18,7 +18,7 @@ %global pkg_name ansi-terminal Name: ghc-%{pkg_name} -Version: 0.11.3 +Version: 0.11.4 Release: 0 Summary: Simple ANSI terminal support, with Windows compatibility License: BSD-3-Clause ++++++ ansi-terminal-0.11.3.tar.gz -> ansi-terminal-0.11.4.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/CHANGELOG.md new/ansi-terminal-0.11.4/CHANGELOG.md --- old/ansi-terminal-0.11.3/CHANGELOG.md 2022-04-29 01:06:08.000000000 +0200 +++ new/ansi-terminal-0.11.4/CHANGELOG.md 2022-11-22 00:13:30.000000000 +0100 @@ -1,11 +1,30 @@ Changes ======= +Version 0.11.4 +-------------- + +* Add `reportLayerColor`, `getReportedLayerColor` and `getLayerColor` for + querying the layer color on terminals that support the functionality. +* Add `useAlternateScreenBuffer` and `useNormalScreenBuffer`, and support for + switching between the Alternate and Normal Screen Buffers. +* When the argument is `0`, `cursorUpCode`, `cursorDownCode`, + `cursorForwardCode`, `cursorBackwardCode`,`scrollPageUpCode` and + `scrollPageDownCode` now yield `""`, and `cursorUpLineCode` and + `cursorDownLineCode` now yield the equivalent of `setCursorColumnCode 0`. This + is because, on some terminals, a `0` parameter for the underlying 'ANSI' code + specifies a default parameter of `1`. +* Add `osc` as a utility function, for OSC sequences. +* `setTitle` now uses the recommended STRING TERMINATOR (ST) of `\ESC\\`, rather + than the legacy `\BEL` (`\007`), and filters the title of all non-printable + characters, not just `\BEL`. +* Improvements to Haddock documentation. + Version 0.11.3 -------------- * Add `hyperlink`, `hyperlinkWithId` and `hyperlinkWithParams`, and support for - clicable hyperlinks. + clickable hyperlinks. Version 0.11.2 -------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/README.md new/ansi-terminal-0.11.4/README.md --- old/ansi-terminal-0.11.3/README.md 2022-04-29 01:00:01.000000000 +0200 +++ new/ansi-terminal-0.11.4/README.md 2022-11-22 00:13:03.000000000 +0100 @@ -16,6 +16,7 @@ - Moving the cursor around - Reporting the position of the cursor - Scrolling the screen up or down +- Switching between the Alternate and Normal Screen Buffers - Clickable hyperlinks to URIs - Changing the title of the terminal diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/ansi-terminal.cabal new/ansi-terminal-0.11.4/ansi-terminal.cabal --- old/ansi-terminal-0.11.3/ansi-terminal.cabal 2022-04-29 01:04:07.000000000 +0200 +++ new/ansi-terminal-0.11.4/ansi-terminal.cabal 2022-11-22 00:11:15.000000000 +0100 @@ -1,5 +1,5 @@ Name: ansi-terminal -Version: 0.11.3 +Version: 0.11.4 Cabal-Version: >= 1.10 Category: User Interfaces Synopsis: Simple ANSI terminal support, with Windows compatibility @@ -29,6 +29,11 @@ Description: Build the example application Default: False +Flag Win32-2-13-1 + Description: Use Win32-2-13.1.0 or later. If used, there is + no dependency on the mintty package. + Default: True + Library Hs-Source-Dirs: src Exposed-Modules: System.Console.ANSI @@ -41,8 +46,10 @@ , colour >=2.1.0 if os(windows) Build-Depends: containers >= 0.5.0.0 - , mintty - , Win32 >= 2.0 + if flag(Win32-2-13-1) + Build-Depends: Win32 >= 2.13.1 + else + Build-Depends: Win32 < 2.13.1, mintty Cpp-Options: -DWINDOWS Other-Modules: System.Console.ANSI.Windows System.Console.ANSI.Windows.Detect diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/app/Example.hs new/ansi-terminal-0.11.4/app/Example.hs --- old/ansi-terminal-0.11.3/app/Example.hs 2022-04-29 01:00:01.000000000 +0200 +++ new/ansi-terminal-0.11.4/app/Example.hs 2022-11-21 23:44:30.000000000 +0100 @@ -19,6 +19,7 @@ , saveRestoreCursorExample , clearExample , scrollExample + , screenBuffersExample , sgrColorExample , sgrOtherExample , cursorVisibilityExample @@ -26,6 +27,7 @@ , titleExample , getCursorPositionExample , getTerminalSizeExample + , getLayerColorExample ] main :: IO () @@ -221,6 +223,17 @@ -- Line Two -- Line Three +screenBuffersExample :: IO () +screenBuffersExample = do + replicateM_ 5 $ putStrLn "This message is on the Normal Screen Bufffer" + replicateM_ 5 pause + useAlternateScreenBuffer + replicateM_ 5 $ putStrLn "This message is on the Alternate Screen Bufffer" + replicateM_ 5 pause + useNormalScreenBuffer + replicateM_ 5 $ putStrLn "This message is continuing where we left off" + replicateM_ 5 pause + sgrColorExample :: IO () sgrColorExample = do let colors = enumFromTo minBound maxBound :: [Color] @@ -427,3 +440,16 @@ Nothing -> putStrLn "Error: unable to get the terminal size\n" pause -- The size of the terminal is 25 rows by 80 columns. + +getLayerColorExample :: IO () +getLayerColorExample = do + fgResult <- getLayerColor Foreground + case fgResult of + Just fgCol -> putStrLn $ "The reported foreground color is:\n" ++ + show fgCol ++ "\n" + Nothing -> putStrLn "Error: unable to get the foreground color\n" + bgResult <- getLayerColor Background + case bgResult of + Just bgCol -> putStrLn $ "The reported background color is:\n" ++ + show bgCol ++ "\n" + Nothing -> putStrLn "Error: unable to get the background color\n" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/System/Console/ANSI/Codes.hs new/ansi-terminal-0.11.4/src/System/Console/ANSI/Codes.hs --- old/ansi-terminal-0.11.3/src/System/Console/ANSI/Codes.hs 2022-04-29 01:00:01.000000000 +0200 +++ new/ansi-terminal-0.11.4/src/System/Console/ANSI/Codes.hs 2022-11-22 00:10:04.000000000 +0100 @@ -22,9 +22,17 @@ 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 @@ -39,8 +47,18 @@ , 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 @@ -56,9 +74,10 @@ , setTitleCode -- * Utilities - , colorToCode, csi, sgrToCode + , colorToCode, csi, osc, sgrToCode ) where +import Data.Char (isPrint) import Data.List (intercalate) import Data.Colour.SRGB (toSRGB24, RGB (..)) @@ -75,6 +94,18 @@ -> 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 @@ -129,15 +160,15 @@ cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode :: Int -- ^ Number of lines or characters to move -> String -cursorUpCode n = csi [n] "A" -cursorDownCode n = csi [n] "B" -cursorForwardCode n = csi [n] "C" -cursorBackwardCode n = csi [n] "D" +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 = csi [n] "E" -cursorUpLineCode n = csi [n] "F" +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). @@ -164,19 +195,34 @@ -- 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 'getReportedCursorPosition' or '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. --- 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 the GHC bug report #806 at --- <https://ghc.haskell.org/trac/ghc/ticket/806>). +-- 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, @@ -191,8 +237,12 @@ scrollPageUpCode, scrollPageDownCode :: Int -- ^ Number of lines to scroll by -> String -scrollPageUpCode n = csi [n] "S" -scrollPageDownCode n = csi [n] "T" +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 @@ -218,10 +268,11 @@ -> String -- ^ Link text -> String -hyperlinkWithParamsCode ps uri link = - "\ESC]8;" ++ ps' ++ ";" ++ uri ++ "\ESC\\" ++ link ++ "\ESC]8;;\ESC\\" +hyperlinkWithParamsCode params uri link = + osc "8" pT ++ link ++ osc "8" ";" where - ps' = intercalate ":" $ map (\(k, v) -> k ++ "=" ++ v) ps + pT = params' ++ ";" ++ uri + params' = intercalate ":" $ map (\(k, v) -> k ++ "=" ++ v) params -- | Code to introduce a hyperlink. -- @@ -258,4 +309,4 @@ -- behaviour between Unixes and Windows. setTitleCode :: String -- ^ New window title and icon name -> String -setTitleCode title = "\ESC]0;" ++ filter (/= '\007') title ++ "\007" +setTitleCode title = osc "0" (filter isPrint title) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/System/Console/ANSI/Unix.hs new/ansi-terminal-0.11.4/src/System/Console/ANSI/Unix.hs --- old/ansi-terminal-0.11.3/src/System/Console/ANSI/Unix.hs 2022-04-29 01:00:01.000000000 +0200 +++ new/ansi-terminal-0.11.4/src/System/Console/ANSI/Unix.hs 2022-11-21 23:44:30.000000000 +0100 @@ -9,9 +9,12 @@ #include "Exports-Include.hs" ) where -import Data.Maybe (fromMaybe) import Control.Exception.Base (bracket) import Control.Monad (when) +#if MIN_VERSION_base(4,8,0) +import Data.List (uncons) +#endif +import Data.Maybe (fromMaybe, mapMaybe) import System.IO (BufferMode (..), Handle, hGetBuffering, hGetEcho, hIsTerminalDevice, hIsWritable, hPutStr, hReady, hSetBuffering, hSetEcho, stdin) @@ -19,7 +22,6 @@ import Text.ParserCombinators.ReadP (readP_to_S) import System.Console.ANSI.Codes -import System.Console.ANSI.Types -- This file contains code that is common to modules System.Console.ANSI.Unix, -- System.Console.ANSI.Windows and System.Console.ANSI.Windows.Emulator, such as @@ -59,6 +61,11 @@ hScrollPageUp h n = hPutStr h $ scrollPageUpCode n hScrollPageDown h n = hPutStr h $ scrollPageDownCode n +hUseAlternateScreenBuffer h = hPutStr h useAlternateScreenBufferCode +hUseNormalScreenBuffer h = hPutStr h useNormalScreenBufferCode + +hReportLayerColor h layer = hPutStr h $ reportLayerColorCode layer + hSetSGR h sgrs = hPutStr h $ setSGRCode sgrs hHideCursor h = hPutStr h hideCursorCode @@ -86,26 +93,63 @@ -- getReportedCursorPosition :: IO String -- (See Common-Include.hs for Haddock documentation) -getReportedCursorPosition = do +getReportedCursorPosition = getReport "\ESC[" ["R"] + +-- getReportedLayerColor :: ConsoleLayer -> IO String +-- (See Common-Include.hs for Haddock documentation) +getReportedLayerColor layer = + getReport ("\ESC]" ++ pS ++ ";rgb:") ["\BEL", "\ESC\\"] + where + pS = case layer of + Foreground -> "10" + Background -> "11" + +getReport :: String -> [String] -> IO String +getReport _ [] = error "getReport requires a list of terminating sequences." +getReport startChars endChars = do -- If, unexpectedly, no data is available on the console input stream then -- the timeout will prevent the getChar blocking. For consistency with the -- Windows equivalent, returns "" if the expected information is unavailable. - fromMaybe "" <$> timeout 500000 get -- 500 milliseconds + fromMaybe "" <$> timeout 500000 (getStart startChars "") -- 500 milliseconds where - get = do + endChars' = mapMaybe uncons endChars +#if !MIN_VERSION_base(4,8,0) + where + uncons :: [a] -> Maybe (a, [a]) + uncons [] = Nothing + uncons (x:xs) = Just (x, xs) +#endif + + -- The list is built in reverse order, in order to avoid O(n^2) complexity. + -- So, getReport yields the reversed built list. + + getStart :: String -> String -> IO String + getStart "" r = getRest r + getStart (h:hs) r = do + c <- getChar + if c == h + then getStart hs (c:r) -- Try to get the rest of the start characters + else return $ reverse (c:r) -- If the first character(s) are not the + -- expected start then give up. This provides + -- a modicom of protection against unexpected + -- data in the input stream. + getRest :: String -> IO String + getRest r = do c <- getChar - if c == '\ESC' - then get' [c] - else return [c] -- If the first character is not the expected \ESC then - -- give up. This provides a modicom of protection against - -- unexpected data in the input stream. - get' s = do + case lookup c endChars' of + Nothing -> getRest (c:r) -- Continue building the list, until the first of + -- the end characters is obtained. + Just es -> getEnd es (c:r) -- Try to get the rest of the end characters. + + getEnd :: String -> String -> IO String + getEnd "" r = return $ reverse r + getEnd (e:es) r = do c <- getChar - if c /= 'R' - then get' (c:s) -- Continue building the list, until the expected 'R' - -- character is obtained. Build the list in reverse order, - -- in order to avoid O(n^2) complexity. - else return $ reverse (c:s) -- Reverse the order of the built list. + if c /= e + then getRest (c:r) -- Continue building the list, with the original end + -- characters. + else getEnd es (c:r) -- Continue building the list, checking against the + -- remaining end characters. -- hGetCursorPosition :: Handle -> IO (Maybe (Int, Int)) -- (See Common-Include.hs for Haddock documentation) @@ -133,5 +177,32 @@ clearStdin = do isReady <- hReady stdin when isReady $ do + _ <-getChar + clearStdin + +-- hGetLayerColor :: Handle -> IO (Maybe (Colour Word16)) +-- (See Common-Include.hs for Haddock documentation) +hGetLayerColor h layer = do + input <- bracket (hGetBuffering stdin) (hSetBuffering stdin) $ \_ -> do + -- set no buffering (if 'no buffering' is not already set, the contents of + -- the buffer will be discarded, so this needs to be done before the + -- cursor positon is emitted) + hSetBuffering stdin NoBuffering + -- ensure that echoing is off + bracket (hGetEcho stdin) (hSetEcho stdin) $ \_ -> do + hSetEcho stdin False + clearStdin + hReportLayerColor h layer + hFlush h -- ensure the report cursor position code is sent to the + -- operating system + getReportedLayerColor layer + case readP_to_S (layerColor layer) input of + [] -> return Nothing + [(col, _)] -> return $ Just col + (_:_) -> return Nothing + where + clearStdin = do + isReady <- hReady stdin + when isReady $ do _ <-getChar clearStdin diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/System/Console/ANSI/Windows/Detect.hs new/ansi-terminal-0.11.4/src/System/Console/ANSI/Windows/Detect.hs --- old/ansi-terminal-0.11.3/src/System/Console/ANSI/Windows/Detect.hs 2021-03-12 22:07:41.000000000 +0100 +++ new/ansi-terminal-0.11.4/src/System/Console/ANSI/Windows/Detect.hs 2022-11-18 00:50:34.000000000 +0100 @@ -15,7 +15,11 @@ import Control.Exception (SomeException(..), throwIO, try) import Data.Bits ((.&.), (.|.)) +#ifdef MIN_VERSION_mintty import System.Console.MinTTY (isMinTTYHandle) +#else +import System.Win32.MinTTY (isMinTTYHandle) +#endif import System.IO (Handle, hIsWritable, stdout) import System.IO.Unsafe (unsafePerformIO) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/System/Console/ANSI/Windows/Emulator/Codes.hs new/ansi-terminal-0.11.4/src/System/Console/ANSI/Windows/Emulator/Codes.hs --- old/ansi-terminal-0.11.3/src/System/Console/ANSI/Windows/Emulator/Codes.hs 2022-04-29 01:00:01.000000000 +0200 +++ new/ansi-terminal-0.11.4/src/System/Console/ANSI/Windows/Emulator/Codes.hs 2022-11-21 23:44:30.000000000 +0100 @@ -23,6 +23,12 @@ -- * Scrolling the screen , scrollPageUpCode, scrollPageDownCode + -- * Using screen buffers + , useAlternateScreenBufferCode, useNormalScreenBufferCode + + -- * Reporting background and foreground colors + , reportLayerColorCode + -- * Select Graphic Rendition mode: colors and other whizzy stuff , setSGRCode @@ -82,6 +88,13 @@ scrollPageUpCode _ = "" scrollPageDownCode _ = "" +useAlternateScreenBufferCode, useNormalScreenBufferCode :: String +useAlternateScreenBufferCode = "" +useNormalScreenBufferCode = "" + +reportLayerColorCode :: ConsoleLayer -> String +reportLayerColorCode _ = "" + 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/System/Console/ANSI/Windows/Emulator.hs new/ansi-terminal-0.11.4/src/System/Console/ANSI/Windows/Emulator.hs --- old/ansi-terminal-0.11.3/src/System/Console/ANSI/Windows/Emulator.hs 2022-04-29 01:00:01.000000000 +0200 +++ new/ansi-terminal-0.11.4/src/System/Console/ANSI/Windows/Emulator.hs 2022-11-21 23:44:30.000000000 +0100 @@ -10,6 +10,7 @@ import qualified Control.Exception as CE (catch) import Control.Monad (unless) import Data.Bits ((.&.), (.|.), complement, shiftL, shiftR) +import Data.Char (isPrint) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.List (foldl', minimumBy) import Data.Maybe (mapMaybe) @@ -17,14 +18,18 @@ import System.IO (Handle, hIsTerminalDevice, hPutStr, stdin) import System.IO.Unsafe (unsafePerformIO) import Text.ParserCombinators.ReadP (readP_to_S) +import Text.Printf(printf) import Data.Colour (Colour) import Data.Colour.Names (black, blue, cyan, green, grey, lime, magenta, maroon, navy, olive, purple, red, silver, teal, white, yellow) import Data.Colour.SRGB (RGB (..), toSRGB) +#ifdef MIN_VERSION_mintty import System.Console.MinTTY (isMinTTYHandle) +#else +import System.Win32.MinTTY (isMinTTYHandle) +#endif -import System.Console.ANSI.Types import qualified System.Console.ANSI.Unix as Unix import System.Console.ANSI.Windows.Detect import System.Console.ANSI.Windows.Emulator.Codes @@ -231,6 +236,9 @@ = emulatorFallback (Unix.hScrollPageDown h n) $ withHandle h $ \handle -> hScrollPage cds handle n +hUseAlternateScreenBuffer _ = return () +hUseNormalScreenBuffer _ = return () + {-# INLINE applyANSIColorToAttribute #-} applyANSIColorToAttribute :: WORD -> WORD -> WORD -> Color -> WORD -> WORD applyANSIColorToAttribute rED gREEN bLUE color attribute = case color of @@ -357,7 +365,7 @@ -- really what I'm designing for. hSetTitle h title = emulatorFallback (Unix.hSetTitle h title) $ - withTString title $ setConsoleTitle + withTString (filter isPrint title) setConsoleTitle cursorPositionRef :: IORef (Map.Map HANDLE COORD) {-# NOINLINE cursorPositionRef #-} @@ -389,6 +397,27 @@ "\ESC[" ++ show y ++ ";" ++ show x ++ "R" return () +hReportLayerColor h layer + = emulatorFallback (Unix.hReportLayerColor h layer) $ withHandle h $ + \handle -> do + result <- getConsoleScreenBufferInfoEx handle + let attributes = csbix_attributes result + colorTable = csbix_color_table result + fgRef = attributes .&. fOREGROUND_INTENSE_WHITE + bgRef = shiftR (attributes .&. bACKGROUND_INTENSE_WHITE) 4 + fgColor = colorTable !! fromIntegral fgRef + bgColor = colorTable !! fromIntegral bgRef + (oscCode, color) = case layer of + Foreground -> ("10", fgColor) + Background -> ("11", bgColor) + r = shiftL (color .&. 0xFF) 8 + g = color .&. 0xFF00 + b = shiftR (color .&. 0xFF0000) 8 + report = printf "\ESC]%s;rgb:%04x/%04x/%04x\ESC\\" oscCode r g b + hIn <- getStdHandle sTD_INPUT_HANDLE + _ <- writeConsoleInput hIn $ keyPresses report + return () + keyPress :: Char -> [INPUT_RECORD] keyPress c = [keyDown, keyUp] where @@ -462,10 +491,12 @@ -- getReportedCursorPosition :: IO String -- (See Common-Include.hs for Haddock documentation) -getReportedCursorPosition - = CE.catch getReportedCursorPosition' getCPExceptionHandler +getReportedCursorPosition = getReported + +getReported :: IO String +getReported = CE.catch getReported' getReportedExceptionHandler where - getReportedCursorPosition' = withHandleToHANDLE stdin action + getReported' = withHandleToHANDLE stdin action where action hdl = do n <- getNumberOfConsoleInputEvents hdl @@ -493,25 +524,40 @@ hGetCursorPosition h = fmap to0base <$> getCursorPosition' where to0base (row, col) = (row - 1, col - 1) - getCursorPosition' = CE.catch getCursorPosition'' getCPExceptionHandler + getCursorPosition' = + hGetReport h hReportCursorPosition getReportedCursorPosition cursorPosition + +hGetReport :: Handle + -> (Handle -> IO ()) + -> IO String -> ReadP a -> IO (Maybe a) +hGetReport h report get parse = + CE.catch getReport getReportedExceptionHandler where - getCursorPosition'' = do + getReport = do withHandleToHANDLE stdin flush -- Flush the console input buffer - hReportCursorPosition h + report h hFlush h -- ensure the report cursor position code is sent to the -- operating system - input <- getReportedCursorPosition - case readP_to_S cursorPosition input of + input <- get + case readP_to_S parse input of [] -> return Nothing - [((row, col),_)] -> return $ Just (row, col) + [(value,_)] -> return $ Just value (_:_) -> return Nothing where flush hdl = do n <- getNumberOfConsoleInputEvents hdl unless (n == 0) (void $ readConsoleInput hdl n) -getCPExceptionHandler :: IOException -> IO a -getCPExceptionHandler e = error msg + +-- getReportedLayerColor :: ConsoleLayer -> IO String +--(See Common-Include.hs for Haddock documentation) +getReportedLayerColor _ = getReported + +hGetLayerColor h layer = hGetReport h + (`hReportLayerColor` layer) (getReportedLayerColor layer) (layerColor layer) + +getReportedExceptionHandler :: IOException -> IO a +getReportedExceptionHandler e = error msg where msg = "Error: " ++ show e ++ "\nThis error may be avoided by using a " ++ "console based on the Windows' Console API, such as Command Prompt " ++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/System/Console/ANSI/Windows/Foreign.hs new/ansi-terminal-0.11.4/src/System/Console/ANSI/Windows/Foreign.hs --- old/ansi-terminal-0.11.3/src/System/Console/ANSI/Windows/Foreign.hs 2021-03-12 22:07:41.000000000 +0100 +++ new/ansi-terminal-0.11.4/src/System/Console/ANSI/Windows/Foreign.hs 2022-11-21 23:44:30.000000000 +0100 @@ -18,9 +18,10 @@ charToWCHAR, cWcharsToChars, - COORD(..), SMALL_RECT(..), rect_top, rect_bottom, rect_left, rect_right, - rect_width, rect_height, CONSOLE_CURSOR_INFO(..), - CONSOLE_SCREEN_BUFFER_INFO(..), CHAR_INFO(..), + COLORREF, COORD(..), SMALL_RECT(..), rect_top, rect_bottom, rect_left, + rect_right, rect_width, rect_height, CONSOLE_CURSOR_INFO(..), + CONSOLE_SCREEN_BUFFER_INFO(..), CONSOLE_SCREEN_BUFFER_INFOEX(..), + CHAR_INFO(..), sTD_INPUT_HANDLE, sTD_OUTPUT_HANDLE, sTD_ERROR_HANDLE, @@ -34,6 +35,7 @@ getStdHandle, getConsoleScreenBufferInfo, + getConsoleScreenBufferInfoEx, getConsoleCursorInfo, getConsoleMode, @@ -59,15 +61,16 @@ import Data.Bits ((.|.), shiftL) import Data.Char (chr, ord) import Data.Typeable (Typeable) +import Data.Word (Word32) import Foreign.C.Types (CInt (..), CWchar (..)) import Foreign.Marshal.Alloc (alloca) -import Foreign.Marshal.Array (allocaArray, peekArray, withArrayLen) +import Foreign.Marshal.Array (allocaArray, peekArray, pokeArray, withArrayLen) import Foreign.Marshal.Utils (maybeWith, with) import Foreign.Ptr (Ptr, castPtr, plusPtr) import Foreign.Storable (Storable (..)) -- `SHORT` and `withHandleToHANDLE` are not both available before Win32-2.5.1.0 import System.Win32.Compat (BOOL, DWORD, ErrCode, HANDLE, LPCTSTR, LPDWORD, - SHORT, TCHAR, UINT, WORD, failIfFalse_, getLastError, iNVALID_HANDLE_VALUE, + SHORT, TCHAR, UINT, ULONG, WORD, failIfFalse_, getLastError, iNVALID_HANDLE_VALUE, nullHANDLE, withHandleToHANDLE, withTString) #if defined(i386_HOST_ARCH) @@ -206,6 +209,68 @@ ptr4 <- pokeAndOffset ptr3 window poke ptr4 maximum_window_size +data CONSOLE_SCREEN_BUFFER_INFOEX = CONSOLE_SCREEN_BUFFER_INFOEX + { csbix_size :: COORD + , csbix_cursor_position :: COORD + , csbix_attributes :: WORD + , csbix_window :: SMALL_RECT + , csbix_maximum_window_size :: COORD + , csbix_popup_attributes :: WORD + , csbix_fullscreen_supported :: BOOL + , csbix_color_table :: [COLORREF] + } deriving (Show) + +-- When specifying an explicit RGB color, the COLORREF value has the following +-- hexadecimal form: +-- 0x00bbggrr +-- The low-order byte contains a value for the relative intensity of red; the +-- second byte contains a value for green; and the third byte contains a value +-- for blue. The high-order byte must be zero. The maximum value for a single +-- byte is 0xFF. +type COLORREF = Word32 + +instance Storable CONSOLE_SCREEN_BUFFER_INFOEX where + sizeOf ~(CONSOLE_SCREEN_BUFFER_INFOEX + size cursor_position attributes window maximum_window_size popup_attributes + fullscreen_supported _) + = sizeOf sizeCsbix + sizeOf size + sizeOf cursor_position + sizeOf attributes + sizeOf window + + sizeOf maximum_window_size + sizeOf popup_attributes + + sizeOf fullscreen_supported + 16 * sizeOf (undefined :: COLORREF) + alignment ~(CONSOLE_SCREEN_BUFFER_INFOEX _ _ _ _ _ _ _ _) = alignment sizeCsbix + peek ptr = do + let ptr0 = castPtr ptr `plusPtr` sizeOf sizeCsbix + (size, ptr1) <- peekAndOffset ptr0 + (cursor_position, ptr2) <- peekAndOffset ptr1 + (attributes, ptr3) <- peekAndOffset ptr2 + (window, ptr4) <- peekAndOffset ptr3 + (maximum_window_size, ptr5) <- peekAndOffset ptr4 + (popup_attributes, ptr6) <- peekAndOffset ptr5 + (fullscreen_supported, ptr7) <- peekAndOffset ptr6 + color_table <- peekArray 16 ptr7 + return (CONSOLE_SCREEN_BUFFER_INFOEX + size cursor_position attributes window maximum_window_size + popup_attributes fullscreen_supported color_table) + poke ptr (CONSOLE_SCREEN_BUFFER_INFOEX + size cursor_position attributes window maximum_window_size popup_attributes + fullscreen_supported color_table) + = do + ptr0 <- pokeAndOffset (castPtr ptr) sizeCsbix + ptr1 <- pokeAndOffset ptr0 size + ptr2 <- pokeAndOffset ptr1 cursor_position + ptr3 <- pokeAndOffset ptr2 attributes + ptr4 <- pokeAndOffset ptr3 window + ptr5 <- pokeAndOffset ptr4 maximum_window_size + ptr6 <- pokeAndOffset ptr5 popup_attributes + ptr7 <- pokeAndOffset ptr6 fullscreen_supported + pokeArray ptr7 color_table' + where + color_table' = take 16 $ color_table ++ repeat 0 + +sizeCsbix :: ULONG +sizeCsbix = fromIntegral $ + sizeOf (undefined :: CONSOLE_SCREEN_BUFFER_INFOEX) + + data CHAR_INFO = CHAR_INFO { ci_char :: WCHAR , ci_attributes :: WORD @@ -265,6 +330,10 @@ cGetConsoleScreenBufferInfo :: HANDLE -> Ptr CONSOLE_SCREEN_BUFFER_INFO -> IO BOOL +foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleScreenBufferInfoEx" + cGetConsoleScreenBufferInfoEx :: HANDLE + -> Ptr CONSOLE_SCREEN_BUFFER_INFOEX + -> IO BOOL foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleCursorInfo" cGetConsoleCursorInfo :: HANDLE -> Ptr CONSOLE_CURSOR_INFO -> IO BOOL foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleMode" @@ -347,6 +416,17 @@ cGetConsoleScreenBufferInfo handle ptr_console_screen_buffer_info peek ptr_console_screen_buffer_info +getConsoleScreenBufferInfoEx :: HANDLE -> IO CONSOLE_SCREEN_BUFFER_INFOEX +getConsoleScreenBufferInfoEx handle + = alloca $ \ptr_console_screen_buffer_infoex -> do + -- In the Windows Console API, the `CONSOLE_SCREEN_BUFFER_INFOEX` + -- structure passed to the `GetConsoleScreenBufferInfoEx` function must + -- include the size of the structure. + poke (castPtr ptr_console_screen_buffer_infoex) sizeCsbix + throwIfFalse $ + cGetConsoleScreenBufferInfoEx handle ptr_console_screen_buffer_infoex + peek ptr_console_screen_buffer_infoex + getConsoleCursorInfo :: HANDLE -> IO CONSOLE_CURSOR_INFO getConsoleCursorInfo handle = alloca $ \ptr_console_cursor_info -> do throwIfFalse $ cGetConsoleCursorInfo handle ptr_console_cursor_info diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/System/Console/ANSI/Windows.hs new/ansi-terminal-0.11.4/src/System/Console/ANSI/Windows.hs --- old/ansi-terminal-0.11.3/src/System/Console/ANSI/Windows.hs 2022-04-29 01:00:01.000000000 +0200 +++ new/ansi-terminal-0.11.4/src/System/Console/ANSI/Windows.hs 2022-11-21 23:44:30.000000000 +0100 @@ -11,7 +11,6 @@ import System.IO (Handle) -import System.Console.ANSI.Types import qualified System.Console.ANSI.Unix as U import System.Console.ANSI.Windows.Detect (ANSISupport (..), ConsoleDefaultState (..), aNSISupport) @@ -145,6 +144,27 @@ scrollPageDownCode :: Int -> String scrollPageDownCode = nativeOrEmulated U.scrollPageDownCode E.scrollPageDownCode +-- * Using screen buffers +hUseAlternateScreenBuffer = nativeOrEmulated + U.hUseAlternateScreenBuffer E.hUseAlternateScreenBuffer +hUseNormalScreenBuffer = nativeOrEmulated + U.hUseNormalScreenBuffer E.hUseNormalScreenBuffer + +useAlternateScreenBufferCode :: String +useAlternateScreenBufferCode = nativeOrEmulated + U.useAlternateScreenBufferCode E.useAlternateScreenBufferCode + +useNormalScreenBufferCode :: String +useNormalScreenBufferCode = nativeOrEmulated + U.useNormalScreenBufferCode E.useNormalScreenBufferCode + +-- * Reporting the background or foreground colors +hReportLayerColor = E.hReportLayerColor + +reportLayerColorCode :: ConsoleLayer -> String +reportLayerColorCode = nativeOrEmulated + U.reportLayerColorCode E.reportLayerColorCode + -- * Select Graphic Rendition mode: colors and other whizzy stuff -- -- The following SGR codes are NOT implemented by Windows 10 Threshold 2: @@ -220,3 +240,11 @@ -- hGetCursorPosition :: Handle -> IO (Maybe (Int, Int)) -- (See Common-Include.hs for Haddock documentation) hGetCursorPosition = E.hGetCursorPosition + +-- getReportedLayerColor :: ConsoleLayer -> IO String +-- (See Common-Include.hs for Haddock documentation) +getReportedLayerColor = E.getReportedLayerColor + +-- hGetLayerColor :: ConsoleLayer -> IO (Maybe (RGB Word16)) +-- (See Common-Include.hs for Haddock documentation) +hGetLayerColor = E.hGetLayerColor diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/System/Console/ANSI.hs new/ansi-terminal-0.11.4/src/System/Console/ANSI.hs --- old/ansi-terminal-0.11.3/src/System/Console/ANSI.hs 2022-04-29 01:00:01.000000000 +0200 +++ new/ansi-terminal-0.11.4/src/System/Console/ANSI.hs 2022-11-22 00:12:07.000000000 +0100 @@ -1,9 +1,10 @@ #include "Common-Safe-Haskell.hs" -{-| Through this module, this library provides platform-independent support for +{-| == Introduction +Through this module, this library provides platform-independent support for control character sequences following the \'ANSI\' standards (see further below) for terminal software that supports those sequences, running on a Unix-like -operating system or Windows. +operating system or on Windows (see further below). The sequences of control characters (also referred to as \'escape\' sequences or codes) provide a rich range of functionality for terminal control, which @@ -21,6 +22,8 @@ * Scrolling the screen up or down + * Switching between the Alternate and Normal Screen Buffers + * Clickable hyperlinks to URIs * Changing the title of the terminal @@ -29,23 +32,7 @@ are flushed from the output buffer (with a newline character @\"\\n\"@ or, for the standard output channel, @hFlush stdout@). -The functions moving the cursor to an absolute position are 0-based (the -top-left corner is considered to be at row 0 column 0) (see 'setCursorPosition') -and so is 'getCursorPosition'. The \'ANSI\' standards themselves are 1-based -(that is, the top-left corner is considered to be at row 1 column 1) and some -functions reporting the position of the cursor are too (see -'reportCursorPosition'). - -The native terminal software on Windows is \'Command Prompt\' or \`PowerShell\`. -Before Windows 10 version 1511 (known as the \'November [2015] Update\' or -\'Threshold 2\') that software did not support such control sequences. For that -software, this library also provides support for such sequences by using -emulation. - -Terminal software other than the native software exists for Windows. One example -is the \'mintty\' terminal emulator for \'Cygwin\', \'MSYS\' or \'MSYS2\', and -dervied projects, and for \'WSL\' (Windows Subsystem for Linux). - +== \'ANSI\' standards The \'ANSI\' standards refer to (1) standard ECMA-48 \`Control Functions for Coded Character Sets\' (5th edition, 1991); (2) extensions in ITU-T Recommendation (previously CCITT Recommendation) T.416 (03/93) \'Information @@ -59,35 +46,78 @@ The whole of the \'ANSI\' standards are not supported by this library but most (if not all) of the parts that are popular and well-supported by terminal -software are supported. Every function exported by this module comes in three -variants, namely: +software are supported (see further below). + +== Cursor positions +The functions moving the cursor to an absolute position are 0-based (the +top-left corner is considered to be at row 0 column 0) (see 'setCursorPosition') +and so is 'getCursorPosition'. The \'ANSI\' standards themselves are 1-based +(that is, the top-left corner is considered to be at row 1 column 1) and some +functions reporting the position of the cursor are too (see +'reportCursorPosition'). + +== Windows and control character sequences +The native terminal software on Windows has developed over time. Before +Windows 10 version 1511 (known as the \'November [2015] Update\' or +\'Threshold 2\') that software did not support control character sequences. For +that software, this library also provides support for such sequences by using +emulation based on the Windows Console API. From 2018, Microsoft introduced the +Windows Pseudo Console (\'ConPTY\') API and then Windows Terminal, with the +objective of replacing most of the Windows Console API with the use of control +character sequences and retiring the historical user-interface role of Windows +Console Host (\'ConHost\'). + +Terminal software other than the native software exists for Windows. One example +is the \'mintty\' terminal emulator for \'Cygwin\', \'MSYS\' or \'MSYS2\', and +dervied projects, and for \'WSL\' (Windows Subsystem for Linux). + +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 the GHC bug report #806 at +<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), +has not yet provided a solution. On Windows, this library uses emulation based +on the Windows Console API to try to read data emitted into the console input +stream. Functions that use that emulation are not supported on consoles, such +as mintty, that are not based on that API. + +== Function variants provided +Every function exported by this module comes in three variants, namely: * A variant that has an @IO ()@ type and doesn't take a @Handle@ (for example, @clearScreen :: IO ()@). This variant just outputs the \`ANSI\` command directly to the standard output channel ('stdout') and any terminal corresponding to it. Commands issued like this should work as you expect on - both Unix-like operating systems and Windows. + both Unix-like operating systems and Windows (unless exceptions on Windows + are stated). * An \'@h@...\' variant that has an @IO ()@ type but takes a @Handle@ (for example, @hClearScreen :: Handle -> IO ()@). This variant outputs the \`ANSI\` command to the supplied handle and any terminal corresponding to it. Commands issued like this should also work as you expect on both Unix-like - operating systems and Windows. + operating systems and Windows (unless exceptions on Windows are stated). * A \'...@Code@\' variant that has a @String@ type (for example, @clearScreenCode :: String@). This variant outputs the sequence of control characters as a 'String', which can be added to any other bit of text before - being output. The use of these codes is generally discouraged because they - will not work on legacy versions of Windows where the terminal in use is not - ANSI-enabled (see further above). On Windows, where emulation has been - necessary, these variants will always output the empty string. That is done - so that it is possible to use them portably; for example, coloring console - output on the understanding that you will see colors only if you are running - on a Unix-like operating system or a version of Windows where emulation has - not been necessary. If the control characters are always required, see module + being output. If a high degree of backwards compatability is rewuired, the + use of these codes is discouraged because they will not work on legacy + versions of Windows where the terminal in use is not ANSI-enabled (see + further above). On Windows, where emulation has been necessary, these + variants will always output the empty string. That is done so that it is + possible to use them portably; for example, coloring console output on the + understanding that you will see colors only if you are running on a Unix-like + operating system or a version of Windows where emulation has not been + necessary. If the control characters are always required, see module "System.Console.ANSI.Codes". -Example: +== Examples of use + +A simple example is below: > module Main where > @@ -102,7 +132,7 @@ > setSGR [Reset] -- Reset to default colour scheme > putStrLn "Default colors." -Another example: +Another example is below: > module Main where > diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/System/Win32/Compat.hs new/ansi-terminal-0.11.4/src/System/Win32/Compat.hs --- old/ansi-terminal-0.11.3/src/System/Win32/Compat.hs 2022-04-29 01:00:01.000000000 +0200 +++ new/ansi-terminal-0.11.4/src/System/Win32/Compat.hs 2022-11-21 23:44:30.000000000 +0100 @@ -27,6 +27,7 @@ , SHORT -- from Win32-2.5.0.0 , TCHAR , UINT + , ULONG -- from Win32-2.5.0.0 , WORD , failIfFalse_ , getLastError @@ -53,7 +54,7 @@ #if !defined(PATCHING_WIN32_PACKAGE) -import System.Win32.Types (SHORT, withHandleToHANDLE) +import System.Win32.Types (SHORT, ULONG, withHandleToHANDLE) #else @@ -73,8 +74,9 @@ #if !MIN_VERSION_Win32(2,5,0) import Foreign.C.Types (CShort (..)) +import Data.Word (Word32) #else -import System.Win32.Types (SHORT) +import System.Win32.Types (SHORT, ULONG) #endif #if !MIN_VERSION_Win32(2,5,1) @@ -88,6 +90,7 @@ #if !MIN_VERSION_Win32(2,5,0) type SHORT = CShort +type ULONG = Word32 #endif withStablePtr :: a -> (StablePtr a -> IO b) -> IO b diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/includes/Common-Include-Enabled.hs new/ansi-terminal-0.11.4/src/includes/Common-Include-Enabled.hs --- old/ansi-terminal-0.11.3/src/includes/Common-Include-Enabled.hs 2021-03-12 22:07:41.000000000 +0100 +++ new/ansi-terminal-0.11.4/src/includes/Common-Include-Enabled.hs 2022-10-25 00:19:00.000000000 +0200 @@ -2,10 +2,10 @@ -- in the case of the module System.Console.ANSI.Windows.Emulator (see the file -- Common-Include-Emulator.hs in respect of the latter). --- | Set the Select Graphic Rendition mode +-- Set the Select Graphic Rendition mode hSetSGR :: Handle - -> [SGR] -- ^ Commands: these will typically be applied on top of the + -> [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. @@ -40,11 +40,11 @@ clearFromCursorToLineBeginning = hClearFromCursorToLineBeginning stdout clearLine = hClearLine stdout --- | Scroll the displayed information up or down the terminal: not widely +-- Scroll the displayed information up or down the terminal: not widely -- supported hScrollPageUp, hScrollPageDown :: Handle - -> Int -- ^ Number of lines to scroll by + -> Int -- Number of lines to scroll by -> IO () -- | Scroll the displayed information up or down the terminal: not widely diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/includes/Common-Include.hs new/ansi-terminal-0.11.4/src/includes/Common-Include.hs --- old/ansi-terminal-0.11.3/src/includes/Common-Include.hs 2022-04-29 01:00:01.000000000 +0200 +++ new/ansi-terminal-0.11.4/src/includes/Common-Include.hs 2022-11-21 23:44:30.000000000 +0100 @@ -10,14 +10,19 @@ #endif import Control.Monad (void) -import Data.Char (isDigit) +import Data.Char (digitToInt, isDigit, isHexDigit) +import Data.Word (Word16) import System.Environment (getEnvironment) import System.IO (hFlush, stdout) -import Text.ParserCombinators.ReadP (char, many1, ReadP, satisfy) +import Text.ParserCombinators.ReadP (ReadP, (<++), char, many1, satisfy, string) + +import Data.Colour.SRGB (RGB (..)) + +import System.Console.ANSI.Types hCursorUp, hCursorDown, hCursorForward, hCursorBackward :: Handle - -> Int -- ^ Number of lines or characters to move + -> Int -- Number of lines or characters to move -> IO () cursorUp, cursorDown, cursorForward, cursorBackward :: Int -- ^ Number of lines or characters to move @@ -28,7 +33,7 @@ cursorBackward = hCursorBackward stdout hCursorDownLine, hCursorUpLine :: Handle - -> Int -- ^ Number of lines to move + -> Int -- Number of lines to move -> IO () cursorDownLine, cursorUpLine :: Int -- ^ Number of lines to move -> IO () @@ -36,7 +41,7 @@ cursorUpLine = hCursorUpLine stdout hSetCursorColumn :: Handle - -> Int -- ^ 0-based column to move to + -> Int -- 0-based column to move to -> IO () -- | Move the cursor to the specified column. The column numbering is 0-based @@ -46,8 +51,8 @@ setCursorColumn = hSetCursorColumn stdout hSetCursorPosition :: Handle - -> Int -- ^ 0-based row to move to - -> Int -- ^ 0-based column to move to + -> Int -- 0-based row to move to + -> Int -- 0-based column to move to -> IO () -- | Move the cursor to the specified position (row and column). The position is @@ -85,10 +90,6 @@ -- In isolation of 'getReportedCursorPosition' or '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. --- 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 the GHC bug report #806 at --- <https://ghc.haskell.org/trac/ghc/ticket/806>). -- -- @since 0.7.1 reportCursorPosition :: IO () @@ -103,16 +104,49 @@ hideCursor = hHideCursor stdout showCursor = hShowCursor stdout --- | Introduce a hyperlink with (key, value) parameters. Some terminals support +hUseAlternateScreenBuffer + :: Handle + -> IO () + +hUseNormalScreenBuffer + :: Handle + -> IO () + +-- | Use the Alternate Screen Buffer. If currently using the Normal Screen +-- Buffer, it will save the cursor position and switch to the Alternate Screen +-- Buffer. It will always clear the Alternate Screen Buffer. The Alternate +-- Screen Buffer has no scroll back facility. +-- +-- It is an application's responsibility to ensure that it switches back to the +-- Normal Screen Buffer if an exception is raised while the Alternate Screen +-- Buffer is being used. For example, by using 'Control.Exception.bracket_': +-- +-- > bracket_ useAlternateScreenBuffer useNormalScreenBuffer action +-- +-- @since 0.11.4 +useAlternateScreenBuffer + :: IO () +useAlternateScreenBuffer = hUseAlternateScreenBuffer stdout + +-- | Use the Normal Screen Buffer. If currently using the Alternate Screen +-- Buffer, it will clear the Alternate Screen Buffer, and switch to the Normal +-- Screen Buffer. It will always restore the saved cursor position. +-- +-- @since 0.11.4 +useNormalScreenBuffer + :: IO () +useNormalScreenBuffer = hUseNormalScreenBuffer stdout + +-- 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 hHyperlinkWithParams :: Handle - -> [(String, String)] -- ^ Parameters - -> String -- ^ URI - -> String -- ^ Link text + -> [(String, String)] -- Parameters + -> String -- URI + -> String -- Link text -> IO () -- | Introduce a hyperlink with (key, value) parameters. Some terminals support @@ -127,13 +161,13 @@ -> IO () hyperlinkWithParams = hHyperlinkWithParams stdout --- | Introduce a hyperlink. +-- Introduce a hyperlink. -- -- @since 0.11.3 hHyperlink :: Handle - -> String -- ^ URI - -> String -- ^ Link text + -> String -- URI + -> String -- Link text -> IO () hHyperlink h = hHyperlinkWithParams h [] @@ -146,16 +180,16 @@ -> IO () hyperlink = hHyperlink stdout --- | Introduce a hyperlink with an identifier for the link. Some terminals +-- 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 hHyperlinkWithId :: Handle - -> String -- ^ Identifier for the link - -> String -- ^ URI - -> String -- ^ Link text + -> String -- Identifier for the link + -> String -- URI + -> String -- Link text -> IO () hHyperlinkWithId h linkId = hHyperlinkWithParams h [("id", linkId)] @@ -171,10 +205,10 @@ -> IO () hyperlinkWithId = hHyperlinkWithId stdout --- | Set the terminal window title and icon name (that is, the text for the +-- Set the terminal window title and icon name (that is, the text for the -- window in the Start bar, or similar). hSetTitle :: Handle - -> String -- ^ New window title and icon name + -> String -- New window title and icon name -> IO () -- | Set the terminal window title and icon name (that is, the text for the -- window in the Start bar, or similar). @@ -332,22 +366,149 @@ -- @since 0.10.1 hGetCursorPosition :: Handle -> IO (Maybe (Int, Int)) +-- | Looking for a way to get layer colors? See 'getLayerColor'. +-- +-- Emit the layerColor 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 function is not supported on native terminals and is +-- emulated, but the emulation does not work on Windows Terminal and (2) of +-- difficulties in obtaining the data emitted into the console input stream. +-- +-- @since 0.11.4 +reportLayerColor :: ConsoleLayer -> IO () +reportLayerColor = hReportLayerColor stdout + +-- @since 0.11.4 +hReportLayerColor :: Handle -> ConsoleLayer -> IO () + +-- | Attempts to get the reported layer color data from the console input +-- stream. The function is intended to be called immediately after +-- 'reportLayerColor' (or related functions) have caused characters to be +-- emitted into the stream. +-- +-- For example, on a Unix-like operating system: +-- +-- > -- set no buffering (if 'no buffering' is not already set, the contents of +-- > -- the buffer will be discarded, so this needs to be done before the cursor +-- > -- positon is emitted) +-- > hSetBuffering stdin NoBuffering +-- > -- ensure that echoing is off +-- > input <- bracket (hGetEcho stdin) (hSetEcho stdin) $ \_ -> do +-- > hSetEcho stdin False +-- > reportLayerColor Foreground +-- > hFlush stdout -- ensure the report cursor position code is sent to the +-- > -- operating system +-- > getReportedLayerColor Foreground +-- +-- On Windows operating systems, the function is not supported on consoles, such +-- as mintty, that are not based on the Windows' Console API. (Command Prompt +-- and PowerShell are based on the Console API.) +-- +-- @since 0.11.4 +getReportedLayerColor :: ConsoleLayer -> IO String + +-- | Attempts to get the reported layer color, combining the functions +-- 'reportLayerColor', 'getReportedLayerColor' and 'layerColor'. Any RGB color +-- is scaled to be 16 bits per channel, the most common format reported by +-- terminal software. Returns 'Nothing' if any data emitted by +-- 'reportLayerColor', obtained by 'getReportedLayerColor', cannot be parsed by +-- 'layerColor'. Uses 'stdout'. If 'stdout' will be redirected, see +-- 'hGetLayerColor' for a more general function. +-- +-- On Windows operating systems, the function is not supported on consoles, such +-- as mintty, that are not based on the Windows' Console API. (Command Prompt +-- and PowerShell are based on the Console API.) This function also relies on +-- emulation that does not work on Windows Terminal. +-- +-- @since 0.11.4 +getLayerColor :: ConsoleLayer -> IO (Maybe(RGB Word16)) +getLayerColor = hGetLayerColor stdout + +-- | Attempts to get the reported layer color, combining the functions +-- 'hReportLayerColor', 'getReportedLayerColor' and 'layerColor'. Any RGB color +-- is scaled to be 16 bits per channel, the most common format reported by +-- terminal software. Returns 'Nothing' if any data emitted by +-- 'hReportLayerColor', obtained by 'getReportedLayerColor', cannot be parsed by +-- 'layerColor'. +-- +-- On Windows operating systems, the function is not supported on consoles, such +-- as mintty, that are not based on the Windows' Console API. (Command Prompt +-- and PowerShell are based on the Console API.) This function also relies on +-- emulation that does not work on Windows Terminal. +-- +-- @since 0.11.4 +hGetLayerColor :: Handle -> ConsoleLayer -> IO (Maybe (RGB Word16)) + +-- | Parses the characters emitted by 'reportLayerColor' into the console input +-- stream. +-- +-- For example, if the characters emitted by 'reportLayerColor' are in 'String' +-- @input@ then the parser could be applied like this: +-- +-- > let result = readP_to_S (layerColor layer) input +-- > case result of +-- > [] -> putStrLn $ "Error: could not parse " ++ show input +-- > [(col, _)] -> putStrLn $ "The color was " ++ show col ++ "." +-- > (_:_) -> putStrLn $ "Error: parse not unique" +-- +-- @since 0.11.4 +layerColor :: ConsoleLayer -> ReadP (RGB Word16) +layerColor layer = do + void $ string "\ESC]" + void $ string $ case layer of + Foreground -> "10" + Background -> "11" + void $ string ";rgb:" + redHex <- hexadecimal -- A non-negative whole hexadecimal number + void $ char '/' + greenHex <- hexadecimal -- A non-negative whole hexadecimal number + void $ char '/' + blueHex <- hexadecimal -- A non-negative whole hexadecimal number + void $ string "\BEL" <++ string "\ESC\\" + let lenRed = length redHex + lenGreen = length greenHex + lenBlue = length blueHex + if lenRed == lenGreen && lenGreen == lenBlue + then + if lenRed == 0 || lenRed > 4 + then fail "Color format not recognised" + else + let m = 16 ^ (4 - lenRed) + r = fromIntegral $ m * hexToInt redHex + g = fromIntegral $ m * hexToInt greenHex + b = fromIntegral $ m * hexToInt blueHex + in return $ RGB r g b + else fail "Color format not recognised" + where + hexDigit = satisfy isHexDigit + hexadecimal = many1 hexDigit + hexToInt hex = foldl (\d a -> d * 16 + a) 0 (map digitToInt hex) + -- | Attempts to get the current terminal size (height in rows, width in -- columns). -- -- There is no \'ANSI\' control character sequence that reports the terminal -- size. So, it attempts to set the cursor position beyond the bottom right -- corner of the terminal and then use 'getCursorPosition' to query the console --- input stream. It works only on terminals that support each step. Uses --- 'stdout'. If 'stdout' will be redirected, see 'hGetTerminalSize' for a more --- general function. +-- input stream. It works only on terminals that support each step and if data +-- can be emitted to 'stdin'. (Use 'System.IO.hIsTerminalDevice' to test if +-- 'stdin' is connected to a terminal.) Uses 'stdout'. If 'stdout' will be +-- redirected, see 'System.IO.hGetTerminalSize' for a more general function. -- -- On Windows operating systems, the function is not supported on consoles, such -- as mintty, that are not based on Windows' Console API. (Command Prompt and -- PowerShell are based on the Console API.) -- --- For a different approach, one that does not use control character sequences, --- see the +-- 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. -- -- @since 0.9 @@ -361,14 +522,16 @@ -- There is no \'ANSI\' control character sequence that reports the terminal -- size. So, it attempts to set the cursor position beyond the bottom right -- corner of the terminal and then use 'hGetCursorPosition' to query the console --- input stream. It works only on terminals that support each step. +-- input stream. It works only on terminals that support each step and if data +-- can be emitted to 'stdin'. (Use 'System.IO.hIsTerminalDevice' to test if +-- 'stdin' is connected to a terminal.) -- -- On Windows operating systems, the function is not supported on consoles, such -- as mintty, that are not based on the Windows' Console API. (Command Prompt -- and PowerShell are based on the Console API.) -- --- For a different approach, one that does not use control character sequences, --- see the +-- 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. -- -- @since 0.10.1 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ansi-terminal-0.11.3/src/includes/Exports-Include.hs new/ansi-terminal-0.11.4/src/includes/Exports-Include.hs --- old/ansi-terminal-0.11.3/src/includes/Exports-Include.hs 2022-04-29 01:00:01.000000000 +0200 +++ new/ansi-terminal-0.11.4/src/includes/Exports-Include.hs 2022-11-21 23:44:30.000000000 +0100 @@ -10,10 +10,12 @@ , cursorDown , cursorForward , cursorBackward + -- ** \'h...\' variants , hCursorUp , hCursorDown , hCursorForward , hCursorBackward + -- ** \'...Code\' variants , cursorUpCode , cursorDownCode , cursorForwardCode @@ -24,57 +26,59 @@ -- that @*Line@ functions additionally move the cursor to the start of the -- line, while functions like @cursorUp@ and @cursorDown@ keep the column -- the same. - -- - -- Also keep in mind that @*Line@ functions are not as portable. See - -- <https://github.com/UnkindPartition/ansi-terminal/issues/10> for the details. , cursorUpLine , cursorDownLine + -- ** \'h...\' variants , hCursorUpLine , hCursorDownLine + -- ** \'...Code\' variants , cursorUpLineCode , cursorDownLineCode -- * Directly changing cursor position , setCursorColumn - , hSetCursorColumn - , setCursorColumnCode - , setCursorPosition + -- ** \'h...\' variants + , hSetCursorColumn , hSetCursorPosition + -- ** \'...Code\' variants + , setCursorColumnCode , setCursorPositionCode -- * Saving, restoring and reporting cursor position , saveCursor - , hSaveCursor - , saveCursorCode - , restoreCursor - , hRestoreCursor - , restoreCursorCode - , reportCursorPosition + -- ** \'h...\' variants + , hSaveCursor + , hRestoreCursor , hReportCursorPosition + -- ** \'...Code\' variants + , saveCursorCode + , restoreCursorCode , reportCursorPositionCode -- * Clearing parts of the screen - -- | Note that these functions only clear parts of the screen. They do not move the - -- cursor. + -- | 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. , clearFromCursorToScreenEnd , clearFromCursorToScreenBeginning , clearScreen - , hClearFromCursorToScreenEnd - , hClearFromCursorToScreenBeginning - , hClearScreen - , clearFromCursorToScreenEndCode - , clearFromCursorToScreenBeginningCode - , clearScreenCode - , clearFromCursorToLineEnd , clearFromCursorToLineBeginning , clearLine + -- ** \'h...\' variants + , hClearFromCursorToScreenEnd + , hClearFromCursorToScreenBeginning + , hClearScreen , hClearFromCursorToLineEnd , hClearFromCursorToLineBeginning , hClearLine + -- ** \'...Code\' variants + , clearFromCursorToScreenEndCode + , clearFromCursorToScreenBeginningCode + , clearScreenCode , clearFromCursorToLineEndCode , clearFromCursorToLineBeginningCode , clearLineCode @@ -82,11 +86,30 @@ -- * Scrolling the screen , scrollPageUp , scrollPageDown + -- ** \'h...\' variants , hScrollPageUp , hScrollPageDown + -- ** \'...Code\' variants , scrollPageUpCode , scrollPageDownCode + -- * Using screen buffers + -- | On Windows, if emulation is required, switching between alternate and + -- normal screen buffers is not emulated. + , useAlternateScreenBuffer + , useNormalScreenBuffer + -- ** \'h...\' variants + , hUseAlternateScreenBuffer + , hUseNormalScreenBuffer + -- ** \'...Code\' variants + , useAlternateScreenBufferCode + , useNormalScreenBufferCode + + -- * Reporting the background or foreground colors + , reportLayerColor + , hReportLayerColor + , reportLayerColorCode + -- * Select Graphic Rendition mode: colors and other whizzy stuff , setSGR , hSetSGR @@ -95,8 +118,10 @@ -- * Cursor visibilty changes , hideCursor , showCursor + -- ** \'h...\' variants , hHideCursor , hShowCursor + -- ** \'...Code\' variants , hideCursorCode , showCursorCode @@ -105,13 +130,15 @@ -- text that points to a URI. On Windows, if emulation is required, -- hyperlinks are not emulated. , hyperlink - , hHyperlink - , hyperlinkCode , hyperlinkWithId - , hHyperlinkWithId - , hyperlinkWithIdCode , hyperlinkWithParams + -- ** \'h...\' variants + , hHyperlink + , hHyperlinkWithId , hHyperlinkWithParams + -- ** \'...Code\' variants + , hyperlinkCode + , hyperlinkWithIdCode , hyperlinkWithParamsCode -- * Changing the title @@ -133,3 +160,9 @@ -- * Getting the terminal size , getTerminalSize , hGetTerminalSize + + -- * Getting the background or foreground colors + , getLayerColor + , hGetLayerColor + , getReportedLayerColor + , layerColor
