hexagoxel
/
hxtools
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

hxbrief: Take into account env vars COLUMNS and LINES

master
Lennart Spitzner 2022-07-16 16:49:26 +02:00
parent 103e7e9762
commit 338df579e9
1 changed files with 13 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src-hxbrief/Main.hs
View File

@ -77,6 +77,7 @@ import qualified System.IO
import qualified System.Process as P import qualified System.Process as P
import qualified Text.PrettyPrint.HughesPJ as PP import qualified Text.PrettyPrint.HughesPJ as PP
import Text.Printf ( printf ) import Text.Printf ( printf )
import Text.Read ( readMaybe )
import qualified UI.Butcher.Monadic as B import qualified UI.Butcher.Monadic as B
import Util import Util
@ -111,7 +112,7 @@ data Config = Config
, c_outFile :: Maybe Handle , c_outFile :: Maybe Handle
, c_errFile :: Maybe Handle , c_errFile :: Maybe Handle
, c_sectionChar :: Maybe Char , c_sectionChar :: Maybe Char
, c_termWidth :: Maybe Int , c_termSize :: Maybe (Int, Int)
} }
data State = State data State = State
@ -356,9 +357,9 @@ processLine newPair@(kind, _) = execStateT $ do
let go _ "" = "" let go _ "" = ""
go 0 _ = "…" go 0 _ = "…"
go n (x : xs) = x : go (n - 1) xs go n (x : xs) = x : go (n - 1) xs
in case c_termWidth conf of in case c_termSize conf of
Nothing -> id Nothing -> id
Just w -> go (w - 3) Just (_, w) -> go (w - 3)
let prettyLines = reverse $ take (c_lines conf) curLines <&> \case let prettyLines = reverse $ take (c_lines conf) curLines <&> \case
(StdOut, line) -> fWhiteDis ++ "│ " ++ fReset ++ ellipse line (StdOut, line) -> fWhiteDis ++ "│ " ++ fReset ++ ellipse line
(StdErr, line) -> fRedDis ++ "│ " ++ fReset ++ ellipse line (StdErr, line) -> fRedDis ++ "│ " ++ fReset ++ ellipse line
@ -538,9 +539,14 @@ main = B.mainFromCmdParser $ do
-- restore $ GHC.IO.Encoding.setFileSystemEncoding GHC.IO.Encoding.utf8 -- restore $ GHC.IO.Encoding.setFileSystemEncoding GHC.IO.Encoding.utf8
-- restore $ System.IO.hSetEncoding System.IO.stdout GHC.IO.Encoding.utf8 -- restore $ System.IO.hSetEncoding System.IO.stdout GHC.IO.Encoding.utf8
-- restore $ System.IO.hSetEncoding System.IO.stderr GHC.IO.Encoding.utf8 -- restore $ System.IO.hSetEncoding System.IO.stderr GHC.IO.Encoding.utf8
termWidthMay <- restore $ do termSizeMay <- restore $ do
support <- Ansi.hSupportsANSI System.IO.stdin support <- Ansi.hSupportsANSI System.IO.stdin
if support then fmap snd <$> Ansi.getTerminalSize else pure Nothing if support
then Ansi.getTerminalSize
else do
envLines <- System.Environment.lookupEnv "LINES"
envCols <- System.Environment.lookupEnv "COLUMNS"
pure $ (,) <$> (envLines >>= readMaybe) <*> (envCols >>= readMaybe)
let stdoutCheckCount = let stdoutCheckCount =
length length
$ [ () | keepStdout || keepBoth ] $ [ () | keepStdout || keepBoth ]
@ -586,7 +592,7 @@ main = B.mainFromCmdParser $ do
, c_outFile = Nothing , c_outFile = Nothing
, c_errFile = Nothing , c_errFile = Nothing
, c_sectionChar = Nothing -- if section then Just '#' else Nothing , c_sectionChar = Nothing -- if section then Just '#' else Nothing
, c_termWidth = termWidthMay , c_termSize = termSizeMay
} }
, s_regions = [line0] , s_regions = [line0]
, s_history = [] , s_history = []