ui: fix manual viewing (on posix) (fix #623)

This commit is contained in:
Simon Michael 2017-12-30 12:59:25 -08:00
parent a4df7997b4
commit 448934d146

View File

@ -13,23 +13,21 @@ import Brick.Widgets.Border.Style
import Brick.Widgets.Dialog import Brick.Widgets.Dialog
import Brick.Widgets.Edit import Brick.Widgets.Edit
import Brick.Widgets.List import Brick.Widgets.List
import Control.Monad.IO.Class
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import Graphics.Vty (Event(..),Key(..),Modifier(..),Color,Attr,currentAttr) import Graphics.Vty (Event(..),Key(..),Modifier(..),Color,Attr,currentAttr)
import Lens.Micro.Platform import Lens.Micro.Platform
import System.Process import System.Environment
import Hledger hiding (Color) import Hledger hiding (Color)
import Hledger.Cli (CliOpts(rawopts_)) import Hledger.Cli (CliOpts(rawopts_))
import Hledger.Cli.DocFiles
import Hledger.UI.UITypes import Hledger.UI.UITypes
import Hledger.UI.UIState import Hledger.UI.UIState
runInfo = runCommand "hledger-ui --info" >>= waitForProcess
runMan = runCommand "hledger-ui --man" >>= waitForProcess
runHelp = runCommand "hledger-ui --help | less" >>= waitForProcess
-- ui -- ui
-- | Draw the help dialog, called when help mode is active. -- | Draw the help dialog, called when help mode is active.
@ -63,9 +61,9 @@ helpDialog copts =
,renderKey ("q", "quit") ,renderKey ("q", "quit")
,str " " ,str " "
,str "MANUAL" ,str "MANUAL"
,str "from help dialog:" ,str "choose format:"
,renderKey ("t", "text") ,renderKey ("p", "pager")
,renderKey ("m", "man page") ,renderKey ("m", "man")
,renderKey ("i", "info") ,renderKey ("i", "info")
] ]
,padLeftRight 1 $ ,padLeftRight 1 $
@ -124,13 +122,15 @@ helpDialog copts =
statusstyle = min 3 $ fromMaybe 1 $ maybeintopt "status-toggles" $ rawopts_ copts statusstyle = min 3 $ fromMaybe 1 $ maybeintopt "status-toggles" $ rawopts_ copts
-- | Event handler used when help mode is active. -- | Event handler used when help mode is active.
-- May invoke $PAGER, less, man or info, which is likely to fail on MS Windows, TODO.
helpHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState) helpHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
helpHandle ui ev = helpHandle ui ev = do
pagerprog <- liftIO $ fromMaybe "less" <$> lookupEnv "PAGER"
case ev of case ev of
VtyEvent e | e `elem` (moveLeftEvents ++ [EvKey KEsc [], EvKey (KChar '?') []]) -> continue $ setMode Normal ui VtyEvent e | e `elem` (moveLeftEvents ++ [EvKey KEsc [], EvKey (KChar '?') []]) -> continue $ setMode Normal ui
VtyEvent (EvKey (KChar 't') []) -> suspendAndResume $ runHelp >> return ui' VtyEvent (EvKey (KChar 'p') []) -> suspendAndResume $ runPagerForTopic pagerprog "hledger-ui" >> return ui'
VtyEvent (EvKey (KChar 'm') []) -> suspendAndResume $ runMan >> return ui' VtyEvent (EvKey (KChar 'm') []) -> suspendAndResume $ runManForTopic "hledger-ui" >> return ui'
VtyEvent (EvKey (KChar 'i') []) -> suspendAndResume $ runInfo >> return ui' VtyEvent (EvKey (KChar 'i') []) -> suspendAndResume $ runInfoForTopic "hledger-ui" >> return ui'
_ -> continue ui _ -> continue ui
where where
ui' = setMode Normal ui ui' = setMode Normal ui