mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-26 20:02:27 +03:00
ui: fix manual viewing (on posix) (fix #623)
This commit is contained in:
parent
a4df7997b4
commit
448934d146
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user