slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

dev: lib: refactor pager

Browse Source
This commit is contained in:
Simon Michael 2023-04-06 10:03:37 -10:00
parent eb5a8ecc4e
commit c661fa7763
1 changed files with 13 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
hledger-lib/Hledger/Utils/IO.hs
View File

@ -158,14 +158,16 @@ pprint' = pPrintOpt CheckColorTty prettyopts'
-- "Avoid using pshow, pprint, dbg* in the code below to prevent infinite loops." (?) -- "Avoid using pshow, pprint, dbg* in the code below to prevent infinite loops." (?)
-- | Display the given text on the terminal, using the user's $PAGER if the text is taller -- | Display the given text on the terminal, using the user's $PAGER if the text is taller
-- than the current terminal and stdout is interactive and TERM is not "dumb". -- than the current terminal and stdout is interactive and TERM is not "dumb"
-- (except on Windows, where a pager will not be used).
pager :: String -> IO () pager :: String -> IO ()
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
pager = putStrLn pager = putStrLn
#else #else
pager s = do printOrPage' s = do -- an extra check for Emacs users:
dumbterm <- (== Just "dumb") <$> lookupEnv "TERM" dumbterm <- (== Just "dumb") <$> lookupEnv "TERM"
(if dumbterm then putStrLn else printOrPage . T.pack) s if dumbterm then putStrLn s else printOrPage (T.pack s)
pager = printOrPage'
#endif #endif
-- | An alternative to ansi-terminal's getTerminalSize, based on -- | An alternative to ansi-terminal's getTerminalSize, based on
@ -181,6 +183,14 @@ getTerminalHeight = fmap fst <$> getTerminalHeightWidth
getTerminalWidth :: IO (Maybe Int) getTerminalWidth :: IO (Maybe Int)
getTerminalWidth = fmap snd <$> getTerminalHeightWidth getTerminalWidth = fmap snd <$> getTerminalHeightWidth
-- | Make sure our $LESS environment variable contains R, to help pager
-- call less (if it does) in a way that it will show any ANSI output properly.
setLessR :: IO ()
setLessR = do
less <- getEnvDefault "LESS" ""
let less' = if 'R' `elem` less then less else 'R':less
setEnv "LESS" less'
-- Command line arguments -- Command line arguments
-- | The command line arguments that were used at program startup. -- | The command line arguments that were used at program startup.