module Matterhorn.Draw.ShowHelp ( drawShowHelp , commandTextTable , commandMarkdownTable , keybindSections ) where import Prelude () import Matterhorn.Prelude import Brick import Brick.Keybindings import Brick.Themes ( themeDescriptions ) import Brick.Widgets.Center ( hCenter ) import Brick.Widgets.Edit ( Editor ) import Brick.Widgets.List ( listSelectedFocusedAttr ) import qualified Data.Map as M import Data.Maybe ( fromJust ) import qualified Data.Text as T import qualified Graphics.Vty as Vty import Lens.Micro.Platform ( Lens' ) import Network.Mattermost.Types ( TeamId ) import Network.Mattermost.Version ( mmApiVersion ) import Matterhorn.Command import Matterhorn.Events.ChannelSelect import Matterhorn.Events.Global import Matterhorn.Events.Main import Matterhorn.Events.MessageSelect import Matterhorn.Events.MessageInterface import Matterhorn.Events.ThemeListWindow import Matterhorn.Events.PostListWindow import Matterhorn.Events.ShowHelp import Matterhorn.Events.UrlSelect import Matterhorn.Events.UserListWindow import Matterhorn.Events.ChannelListWindow import Matterhorn.Events.ReactionEmojiListWindow import Matterhorn.Events.ManageAttachments import Matterhorn.Events.TabbedWindow import Matterhorn.Windows.ViewMessage import Matterhorn.HelpTopics ( helpTopics ) import Matterhorn.Draw.RichText ( renderText ) import Matterhorn.Options ( mhVersion ) import Matterhorn.State.Editing ( editingKeyHandlers ) import Matterhorn.Themes import Matterhorn.Types drawShowHelp :: HelpTopic -> ChatState -> [Widget Name] drawShowHelp :: HelpTopic -> ChatState -> [Widget Name] drawShowHelp HelpTopic topic ChatState st = [HelpScreen -> Widget Name -> Widget Name helpBox (HelpTopic -> HelpScreen helpTopicScreen HelpTopic topic) (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ HelpTopic -> ChatState -> Widget Name helpTopicDraw HelpTopic topic ChatState st] helpTopicDraw :: HelpTopic -> ChatState -> Widget Name helpTopicDraw :: HelpTopic -> ChatState -> Widget Name helpTopicDraw HelpTopic topic ChatState st = AttrName -> AttrName -> Widget Name -> Widget Name forall n. AttrName -> AttrName -> Widget n -> Widget n overrideAttr AttrName codeAttr AttrName helpEmphAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Widget Name -> Widget Name forall n. Widget n -> Widget n hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Int -> Widget Name -> Widget Name forall n. Int -> Widget n -> Widget n hLimit Int helpContentWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ case HelpTopic -> HelpScreen helpTopicScreen HelpTopic topic of HelpScreen MainHelp -> KeyConfig KeyEvent -> Widget Name mainHelp (Config -> KeyConfig KeyEvent configUserKeys (ChatState stChatState -> Getting Config ChatState Config -> Config forall s a. s -> Getting a s a -> a ^.(ChatResources -> Const Config ChatResources) -> ChatState -> Const Config ChatState Lens' ChatState ChatResources csResources((ChatResources -> Const Config ChatResources) -> ChatState -> Const Config ChatState) -> ((Config -> Const Config Config) -> ChatResources -> Const Config ChatResources) -> Getting Config ChatState Config forall b c a. (b -> c) -> (a -> b) -> a -> c .(Config -> Const Config Config) -> ChatResources -> Const Config ChatResources Lens' ChatResources Config crConfiguration)) HelpScreen ScriptHelp -> Widget Name scriptHelp HelpScreen ThemeHelp -> Widget Name themeHelp HelpScreen SyntaxHighlightHelp -> [FilePath] -> Widget Name forall a. SemEq a => [FilePath] -> Widget a syntaxHighlightHelp (Config -> [FilePath] configSyntaxDirs (Config -> [FilePath]) -> Config -> [FilePath] forall a b. (a -> b) -> a -> b $ ChatState stChatState -> Getting Config ChatState Config -> Config forall s a. s -> Getting a s a -> a ^.(ChatResources -> Const Config ChatResources) -> ChatState -> Const Config ChatState Lens' ChatState ChatResources csResources((ChatResources -> Const Config ChatResources) -> ChatState -> Const Config ChatState) -> ((Config -> Const Config Config) -> ChatResources -> Const Config ChatResources) -> Getting Config ChatState Config forall b c a. (b -> c) -> (a -> b) -> a -> c .(Config -> Const Config Config) -> ChatResources -> Const Config ChatResources Lens' ChatResources Config crConfiguration) HelpScreen KeybindingHelp -> KeyConfig KeyEvent -> Widget Name keybindingHelp (Config -> KeyConfig KeyEvent configUserKeys (ChatState stChatState -> Getting Config ChatState Config -> Config forall s a. s -> Getting a s a -> a ^.(ChatResources -> Const Config ChatResources) -> ChatState -> Const Config ChatState Lens' ChatState ChatResources csResources((ChatResources -> Const Config ChatResources) -> ChatState -> Const Config ChatState) -> ((Config -> Const Config Config) -> ChatResources -> Const Config ChatResources) -> Getting Config ChatState Config forall b c a. (b -> c) -> (a -> b) -> a -> c .(Config -> Const Config Config) -> ChatResources -> Const Config ChatResources Lens' ChatResources Config crConfiguration)) mainHelp :: KeyConfig KeyEvent -> Widget Name mainHelp :: KeyConfig KeyEvent -> Widget Name mainHelp KeyConfig KeyEvent kc = Widget Name summary where summary :: Widget Name summary = [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox [Widget Name] entries entries :: [Widget Name] entries = [ Text -> Widget Name forall a. SemEq a => Text -> Widget a heading (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ FilePath -> Text T.pack FilePath mhVersion , Text -> Widget Name forall a. SemEq a => Text -> Widget a headingNoPad (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ FilePath -> Text T.pack FilePath mmApiVersion , Text -> Widget Name forall a. SemEq a => Text -> Widget a heading Text "Help Topics" , Widget Name drawHelpTopics , Text -> Widget Name forall a. SemEq a => Text -> Widget a heading Text "Commands" , Padding -> Widget Name -> Widget Name forall n. Padding -> Widget n -> Widget n padTop (Int -> Padding Pad Int 1) Widget Name mkCommandHelpText , Text -> Widget Name forall a. SemEq a => Text -> Widget a heading Text "Keybindings" ] [Widget Name] -> [Widget Name] -> [Widget Name] forall a. Semigroup a => a -> a -> a <> (KeyConfig KeyEvent -> (Text, [MHKeyEventHandler]) -> Widget Name forall e (m :: * -> *). Ord e => KeyConfig e -> (Text, [KeyEventHandler e m]) -> Widget Name mkKeybindingHelp KeyConfig KeyEvent kc ((Text, [MHKeyEventHandler]) -> Widget Name) -> [(Text, [MHKeyEventHandler])] -> [Widget Name] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [(Text, [MHKeyEventHandler])] keybindSections) mkCommandHelpText :: Widget Name mkCommandHelpText :: Widget Name mkCommandHelpText = let commandNameWidth :: Int commandNameWidth = Int 2 Int -> Int -> Int forall a. Num a => a -> a -> a + ([Int] -> Int forall a. Ord a => [a] -> a forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum ([Int] -> Int) -> [Int] -> Int forall a b. (a -> b) -> a -> b $ Text -> Int T.length (Text -> Int) -> ((Text, Text) -> Text) -> (Text, Text) -> Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Text, Text) -> Text forall a b. (a, b) -> a fst ((Text, Text) -> Int) -> [(Text, Text)] -> [Int] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [(Text, Text)] commandHelpInfo) in [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox [ (Widget Name -> Widget Name forall n. Widget n -> Widget n emph (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Text -> Widget Name forall n. Text -> Widget n txt (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Int -> Text -> Text padTo Int commandNameWidth Text info) Widget Name -> Widget Name -> Widget Name forall n. Widget n -> Widget n -> Widget n <=> (Padding -> Widget Name -> Widget Name forall n. Padding -> Widget n -> Widget n padBottom (Int -> Padding Pad Int 1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Padding -> Widget Name -> Widget Name forall n. Padding -> Widget n -> Widget n padLeft (Int -> Padding Pad Int 2) (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Text -> Widget Name forall a. SemEq a => Text -> Widget a renderText Text desc) | (Text info, Text desc) <- [(Text, Text)] commandHelpInfo ] commandHelpInfo :: [(T.Text, T.Text)] commandHelpInfo :: [(Text, Text)] commandHelpInfo = [(Text, Text)] pairs where pairs :: [(Text, Text)] pairs = [ (Text info, Text desc) | Cmd Text cmd Text desc CmdArgs a args CmdExec a _ <- [Cmd] cs , let argSpec :: Text argSpec = CmdArgs a -> Text forall a. CmdArgs a -> Text printArgSpec CmdArgs a args spc :: Text spc = if Text -> Bool T.null Text argSpec then Text "" else Text " " info :: Text info = Char -> Text -> Text T.cons Char '/' Text cmd Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text spc Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text argSpec ] cs :: [Cmd] cs = (Cmd -> Text) -> [Cmd] -> [Cmd] forall b a. Ord b => (a -> b) -> [a] -> [a] sortWith Cmd -> Text commandName [Cmd] commandList commandTextTable :: T.Text commandTextTable :: Text commandTextTable = let commandNameWidth :: Int commandNameWidth = Int 4 Int -> Int -> Int forall a. Num a => a -> a -> a + ([Int] -> Int forall a. Ord a => [a] -> a forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum ([Int] -> Int) -> [Int] -> Int forall a b. (a -> b) -> a -> b $ Text -> Int T.length (Text -> Int) -> ((Text, Text) -> Text) -> (Text, Text) -> Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Text, Text) -> Text forall a b. (a, b) -> a fst ((Text, Text) -> Int) -> [(Text, Text)] -> [Int] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [(Text, Text)] commandHelpInfo) in Text -> [Text] -> Text T.intercalate Text "\n" ([Text] -> Text) -> [Text] -> Text forall a b. (a -> b) -> a -> b $ [ Int -> Text -> Text padTo Int commandNameWidth Text info Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text desc | (Text info, Text desc) <- [(Text, Text)] commandHelpInfo ] commandMarkdownTable :: T.Text commandMarkdownTable :: Text commandMarkdownTable = Text -> [Text] -> Text T.intercalate Text "\n" ([Text] -> Text) -> [Text] -> Text forall a b. (a -> b) -> a -> b $ [ Text "# Commands" , Text "" , Text "| Command | Description |" , Text "| ------- | ----------- |" ] [Text] -> [Text] -> [Text] forall a. Semigroup a => a -> a -> a <> [ Text "| `" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -> Text escapePipes Text info Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "` | " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -> Text escapePipes Text desc Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " |" | (Text info, Text desc) <- [(Text, Text)] commandHelpInfo ] escapePipes :: Text -> Text escapePipes :: Text -> Text escapePipes = HasCallStack => Text -> Text -> Text -> Text Text -> Text -> Text -> Text T.replace Text "|" Text "\\|" drawHelpTopics :: Widget Name drawHelpTopics :: Widget Name drawHelpTopics = let allHelpTopics :: [Widget n] allHelpTopics = HelpTopic -> Widget n forall {n}. HelpTopic -> Widget n drawTopic (HelpTopic -> Widget n) -> [HelpTopic] -> [Widget n] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [HelpTopic] helpTopics topicNameWidth :: Int topicNameWidth = Int 4 Int -> Int -> Int forall a. Num a => a -> a -> a + ([Int] -> Int forall a. Ord a => [a] -> a forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum ([Int] -> Int) -> [Int] -> Int forall a b. (a -> b) -> a -> b $ Text -> Int T.length (Text -> Int) -> (HelpTopic -> Text) -> HelpTopic -> Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> HelpTopic -> Text helpTopicName (HelpTopic -> Int) -> [HelpTopic] -> [Int] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [HelpTopic] helpTopics) drawTopic :: HelpTopic -> Widget n drawTopic HelpTopic t = (Widget n -> Widget n forall n. Widget n -> Widget n emph (Widget n -> Widget n) -> Widget n -> Widget n forall a b. (a -> b) -> a -> b $ Text -> Widget n forall n. Text -> Widget n txt (Int -> Text -> Text padTo Int topicNameWidth (Text -> Text) -> Text -> Text forall a b. (a -> b) -> a -> b $ HelpTopic -> Text helpTopicName HelpTopic t)) Widget n -> Widget n -> Widget n forall n. Widget n -> Widget n -> Widget n <+> Text -> Widget n forall n. Text -> Widget n txt (HelpTopic -> Text helpTopicDescription HelpTopic t) in [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name forall a b. (a -> b) -> a -> b $ (Padding -> Widget Name -> Widget Name forall n. Padding -> Widget n -> Widget n padBottom (Int -> Padding Pad Int 1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Text -> Widget Name forall a. SemEq a => Text -> Widget a para Text "Learn more about these topics with `/help <topic>`:") Widget Name -> [Widget Name] -> [Widget Name] forall a. a -> [a] -> [a] : [Widget Name] forall {n}. [Widget n] allHelpTopics helpContentWidth :: Int helpContentWidth :: Int helpContentWidth = Int 72 scriptHelp :: Widget Name scriptHelp :: Widget Name scriptHelp = Text -> Widget Name forall a. SemEq a => Text -> Widget a heading Text "Using Scripts" Widget Name -> Widget Name -> Widget Name forall n. Widget n -> Widget n -> Widget n <=> [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox [Widget Name] scriptHelpText where scriptHelpText :: [Widget Name] scriptHelpText = ([Text] -> Widget Name) -> [[Text]] -> [Widget Name] forall a b. (a -> b) -> [a] -> [b] map [Text] -> Widget Name forall a. SemEq a => [Text] -> Widget a paraL [ [ Text "Matterhorn has a special feature that allows you to use " , Text "prewritten shell scripts to preprocess messages. " , Text "For example, this can allow you to run various filters over " , Text "your written text, do certain kinds of automated formatting, " , Text "or just automatically cowsay-ify a message." ] , [ Text "These scripts can be any kind of executable file, " , Text "as long as the file lives in " , Text "*~/.config/matterhorn/scripts* (unless you've explicitly " , Text "moved your XDG configuration directory elsewhere). " , Text "Those executables are given no arguments " , Text "on the command line and are passed your typed message on " , Text "*stdin*; whatever they produce on *stdout* is sent " , Text "as a message. If the script exits successfully, then everything " , Text "that appeared on *stderr* is discarded; if it instead exits with " , Text "a failing exit code, your message is *not* sent, and you are " , Text "presented with whatever was printed on stderr as a " , Text "local error message." ] , [ Text "To run a script, simply type" ] , [ Text "> *> /sh [script-name] [my-message]*" ] , [ Text "And the script named *[script-name]* will be invoked with " , Text "the text of *[my-message]*. If the script does not exist, " , Text "or if it exists but is not marked as executable, you'll be " , Text "presented with an appropriate error message." ] , [ Text "For example, if you want to use a basic script to " , Text "automatically ROT13 your message, you can write a shell " , Text "script using the standard Unix *tr* utility, like this:" ] , [ Text "> *#!/bin/bash -e*" , Text "> *tr '[A-Za-z]' '[N-ZA-Mn-za-m]'*" ] , [ Text "Move this script to *~/.config/matterhorn/scripts/rot13* " , Text "and be sure it's executable with" ] , [ Text "> *$ chmod u+x ~/.config/matterhorn/scripts/rot13*" ] , [ Text "after which you can send ROT13 messages with the " , Text "Matterhorn command " ] , [ Text "> *> /sh rot13 Hello, world!*" ] ] keybindingHelp :: KeyConfig KeyEvent -> Widget Name keybindingHelp :: KeyConfig KeyEvent -> Widget Name keybindingHelp KeyConfig KeyEvent kc = [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name forall a b. (a -> b) -> a -> b $ [ Text -> Widget Name forall a. SemEq a => Text -> Widget a heading Text "Configurable Keybindings" , Padding -> Widget Name -> Widget Name forall n. Padding -> Widget n -> Widget n padBottom (Int -> Padding Pad Int 1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox [Widget Name] keybindingHelpText ] [Widget Name] -> [Widget Name] -> [Widget Name] forall a. [a] -> [a] -> [a] ++ [Widget Name] keybindSectionWidgets [Widget Name] -> [Widget Name] -> [Widget Name] forall a. [a] -> [a] -> [a] ++ [ Text -> Widget Name forall a. SemEq a => Text -> Widget a headingNoPad Text "Keybinding Syntax" , [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox [Widget Name] validKeys ] where addHeading :: Text -> Widget n -> Widget n addHeading Text n Widget n w = [Widget n] -> Widget n forall n. [Widget n] -> Widget n vBox [ Text -> Widget n forall a. SemEq a => Text -> Widget a headingNoPad Text n, Widget n w ] keybindSectionWidgets :: [Widget Name] keybindSectionWidgets = (\(Text name, [MHKeyEventHandler] hs) -> Text -> Widget Name -> Widget Name forall {n}. SemEq n => Text -> Widget n -> Widget n addHeading Text name (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ KeyConfig KeyEvent -> [MHKeyEventHandler] -> Widget Name forall k (m :: * -> *) n. Ord k => KeyConfig k -> [KeyEventHandler k m] -> Widget n keybindingHelpWidget KeyConfig KeyEvent kc [MHKeyEventHandler] hs) ((Text, [MHKeyEventHandler]) -> Widget Name) -> [(Text, [MHKeyEventHandler])] -> [Widget Name] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [(Text, [MHKeyEventHandler])] keybindSections keybindingHelpText :: [Widget Name] keybindingHelpText = ([Text] -> Widget Name) -> [[Text]] -> [Widget Name] forall a b. (a -> b) -> [a] -> [b] map [Text] -> Widget Name forall a. SemEq a => [Text] -> Widget a paraL [ [ Text "Many of the keybindings used in Matterhorn can be " , Text "modified from within Matterhorn's **config.ini** file. " , Text "To do this, include a section called **[KEYBINDINGS]** " , Text "in your config file and use the event names listed below as " , Text "keys and the desired key sequence as values. " , Text "See the end of this page for documentation on the valid " , Text "syntax for key sequences." ] , [ Text "For example, by default, the keybinding to move to the next " , Text "channel in the public channel list is **" , Text nextChanBinding , Text "**, and the corresponding " , Text "previous channel binding is **" , Text prevChanBinding , Text "**. You might want to remap these " , Text "to other keys: say, **C-j** and **C-k**. We can do this with the following " , Text "configuration snippet:" ] , [ Text "```ini\n" , Text "[KEYBINDINGS]\n" , Text "focus-next-channel = C-j\n" , Text "focus-prev-channel = C-k\n" , Text "```" ] , [ Text "You can remap a command to more than one key sequence, in which " , Text "case any one of the key sequences provided can be used to invoke " , Text "the relevant command. To do this, provide the desired bindings as " , Text "a comma-separated list. Additionally, some key combinations are " , Text "used in multiple modes (such as URL select or help viewing) and " , Text "therefore share the same name, such as **cancel** or **scroll-up**." ] , [ Text "Additionally, some keys simply cannot be remapped, mostly in the " , Text "case of editing keybindings. If you feel that a particular key " , Text "event should be rebindable and isn't, then please feel free to " , Text "let us know by posting an issue in the Matterhorn issue tracker." ] , [ Text "It is also possible to entirely unbind a key event by setting its " , Text "key to **unbound**, thus avoiding conflicts between default bindings " , Text "and new ones:" ] , [ Text "```ini\n" , Text "[KEYBINDINGS]\n" , Text "focus-next-channel = unbound\n" , Text "```" ] , [ Text "The rebindable key events, along with their **current** " , Text "values, are as follows:" ] ] nextChanBinding :: Text nextChanBinding = Maybe Binding -> Text ppMaybeBinding (KeyConfig KeyEvent -> KeyEvent -> Maybe Binding forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding firstActiveBinding KeyConfig KeyEvent kc KeyEvent NextChannelEvent) prevChanBinding :: Text prevChanBinding = Maybe Binding -> Text ppMaybeBinding (KeyConfig KeyEvent -> KeyEvent -> Maybe Binding forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding firstActiveBinding KeyConfig KeyEvent kc KeyEvent PrevChannelEvent) validKeys :: [Widget Name] validKeys = ([Text] -> Widget Name) -> [[Text]] -> [Widget Name] forall a b. (a -> b) -> [a] -> [b] map [Text] -> Widget Name forall a. SemEq a => [Text] -> Widget a paraL [ [ Text "The syntax used for key sequences consists of zero or more " , Text "single-character modifier characters followed by a keystroke, " , Text "all separated by dashes. The available modifier keys are " , Text "**S** for Shift, **C** for Ctrl, **A** for Alt, and **M** for " , Text "Meta. So, for example, **" , Binding -> Text ppBinding (Int -> Binding fn Int 2) , Text "** is the F2 key pressed with no " , Text "modifier keys; **" , Binding -> Text ppBinding (Char -> Binding forall a. ToBinding a => a -> Binding ctrl Char 'x') , Text "** is Ctrl and X pressed together, " , Text "and **" , Binding -> Text ppBinding (Binding -> Binding forall a. ToBinding a => a -> Binding shift (Binding -> Binding) -> Binding -> Binding forall a b. (a -> b) -> a -> b $ Char -> Binding forall a. ToBinding a => a -> Binding ctrl Char 'x') , Text "** is Shift, Ctrl, and X all pressed together. " , Text "Although Matterhorn will pretty-print all key combinations " , Text "with specific capitalization, the parser is **not** case-sensitive " , Text "and will ignore any capitalization." ] , [ Text "Your terminal emulator might not recognize some particular " , Text "keypress combinations, or it might reserve certain combinations of " , Text "keys for some terminal-specific operation. Matterhorn does not have a " , Text "reliable way of testing this, so it is up to you to avoid setting " , Text "keybindings that your terminal emulator does not deliver to applications." ] , [ Text "Letter keys, number keys, and function keys are specified with " , Text "their obvious name, such as **x** for the X key, **8** for the 8 " , Text "key, and **f5** for the F5 key. Other valid keys include: " , Text -> [Text] -> Text T.intercalate Text ", " [ Text "**" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text k Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "**" | Text k <- [Text] nonCharKeys ] , Text "." ] ] nonCharKeys :: [Text] nonCharKeys :: [Text] nonCharKeys = (Key -> Text) -> [Key] -> [Text] forall a b. (a -> b) -> [a] -> [b] map Key -> Text ppKey [ Key Vty.KBackTab, Key Vty.KEsc, Key Vty.KBS, Key Vty.KEnter, Key Vty.KUp, Key Vty.KDown , Key Vty.KLeft, Key Vty.KRight, Key Vty.KHome, Key Vty.KEnd, Key Vty.KPageDown , Key Vty.KPageUp, Key Vty.KDel, Key Vty.KUpLeft, Key Vty.KUpRight, Key Vty.KDownLeft , Key Vty.KDownRight, Key Vty.KCenter, Key Vty.KPrtScr, Key Vty.KPause, Key Vty.KIns , Key Vty.KBegin, Key Vty.KMenu ] event :: (Ord e) => KeyConfig e -> e -> Widget a event :: forall e a. Ord e => KeyConfig e -> e -> Widget a event KeyConfig e kc = AttrName -> Widget a -> Widget a forall n. AttrName -> Widget n -> Widget n withDefAttr AttrName helpKeyEventAttr (Widget a -> Widget a) -> (e -> Widget a) -> e -> Widget a forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Widget a forall n. Text -> Widget n txt (Text -> Widget a) -> (e -> Text) -> e -> Widget a forall b c a. (b -> c) -> (a -> b) -> a -> c . Maybe Text -> Text forall a. HasCallStack => Maybe a -> a fromJust (Maybe Text -> Text) -> (e -> Maybe Text) -> e -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . KeyEvents e -> e -> Maybe Text forall k. Ord k => KeyEvents k -> k -> Maybe Text keyEventName (KeyConfig e -> KeyEvents e forall k. KeyConfig k -> KeyEvents k keyConfigEvents KeyConfig e kc) emph :: Widget a -> Widget a emph :: forall n. Widget n -> Widget n emph = AttrName -> Widget a -> Widget a forall n. AttrName -> Widget n -> Widget n withDefAttr AttrName helpEmphAttr para :: SemEq a => Text -> Widget a para :: forall a. SemEq a => Text -> Widget a para Text t = Padding -> Widget a -> Widget a forall n. Padding -> Widget n -> Widget n padTop (Int -> Padding Pad Int 1) (Widget a -> Widget a) -> Widget a -> Widget a forall a b. (a -> b) -> a -> b $ Text -> Widget a forall a. SemEq a => Text -> Widget a renderText Text t paraL :: SemEq a => [Text] -> Widget a paraL :: forall a. SemEq a => [Text] -> Widget a paraL = Text -> Widget a forall a. SemEq a => Text -> Widget a para (Text -> Widget a) -> ([Text] -> Text) -> [Text] -> Widget a forall b c a. (b -> c) -> (a -> b) -> a -> c . [Text] -> Text forall a. Monoid a => [a] -> a mconcat heading :: SemEq a => Text -> Widget a heading :: forall a. SemEq a => Text -> Widget a heading = Padding -> Widget a -> Widget a forall n. Padding -> Widget n -> Widget n padTop (Int -> Padding Pad Int 1) (Widget a -> Widget a) -> (Text -> Widget a) -> Text -> Widget a forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Widget a forall a. SemEq a => Text -> Widget a headingNoPad headingNoPad :: SemEq a => Text -> Widget a headingNoPad :: forall a. SemEq a => Text -> Widget a headingNoPad Text t = Widget a -> Widget a forall n. Widget n -> Widget n hCenter (Widget a -> Widget a) -> Widget a -> Widget a forall a b. (a -> b) -> a -> b $ Widget a -> Widget a forall n. Widget n -> Widget n emph (Widget a -> Widget a) -> Widget a -> Widget a forall a b. (a -> b) -> a -> b $ Text -> Widget a forall a. SemEq a => Text -> Widget a renderText Text t syntaxHighlightHelp :: SemEq a => [FilePath] -> Widget a syntaxHighlightHelp :: forall a. SemEq a => [FilePath] -> Widget a syntaxHighlightHelp [FilePath] dirs = [Widget a] -> Widget a forall n. [Widget n] -> Widget n vBox [ Text -> Widget a forall a. SemEq a => Text -> Widget a heading Text "Syntax Highlighting" , Text -> Widget a forall a. SemEq a => Text -> Widget a para (Text -> Widget a) -> Text -> Widget a forall a b. (a -> b) -> a -> b $ Text "Matterhorn supports syntax highlighting in Markdown code blocks when the " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "name of the code block language follows the block opening sytnax:" , Text -> Widget a forall a. SemEq a => Text -> Widget a para (Text -> Widget a) -> Text -> Widget a forall a b. (a -> b) -> a -> b $ Text "```<language>" , Text -> Widget a forall a. SemEq a => Text -> Widget a para (Text -> Widget a) -> Text -> Widget a forall a b. (a -> b) -> a -> b $ Text "The possible values of `language` are determined by the available syntax " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "definitions. The available definitions are loaded from the following " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "directories according to the configuration setting `syntaxDirectories`. " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "If the setting is omitted, it defaults to the following sequence of directories:" , Text -> Widget a forall a. SemEq a => Text -> Widget a para (Text -> Widget a) -> Text -> Widget a forall a b. (a -> b) -> a -> b $ FilePath -> Text T.pack (FilePath -> Text) -> FilePath -> Text forall a b. (a -> b) -> a -> b $ FilePath -> [FilePath] -> FilePath forall a. [a] -> [[a]] -> [a] intercalate FilePath "\n" ([FilePath] -> FilePath) -> [FilePath] -> FilePath forall a b. (a -> b) -> a -> b $ (\FilePath d -> FilePath "`" FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> FilePath d FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> FilePath "`") (FilePath -> FilePath) -> [FilePath] -> [FilePath] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [FilePath] dirs , Text -> Widget a forall a. SemEq a => Text -> Widget a para (Text -> Widget a) -> Text -> Widget a forall a b. (a -> b) -> a -> b $ Text "Syntax definitions are in the Kate XML format. Files with an " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "`xml` extension are loaded from each directory, with directories earlier " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "in the list taking precedence over later directories when more than one " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "directory provides a definition file for the same syntax." , Text -> Widget a forall a. SemEq a => Text -> Widget a para (Text -> Widget a) -> Text -> Widget a forall a b. (a -> b) -> a -> b $ Text "To place custom definitions in a directory, place a Kate " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "XML syntax definition in the directory and ensure that a copy of " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "`language.dtd` is also present. The file `language.dtd` can be found in " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "the `syntax/` directory of your Matterhorn distribution." ] themeHelp :: Widget Name themeHelp :: Widget Name themeHelp = [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox [ Text -> Widget Name forall a. SemEq a => Text -> Widget a heading Text "Using Themes" , Text -> Widget Name forall a. SemEq a => Text -> Widget a para Text "Matterhorn provides these built-in color themes:" , Padding -> Widget Name -> Widget Name forall n. Padding -> Widget n -> Widget n padTop (Int -> Padding Pad Int 1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name forall a b. (a -> b) -> a -> b $ Widget Name -> Widget Name forall n. Widget n -> Widget n hCenter (Widget Name -> Widget Name) -> (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Widget Name -> Widget Name forall n. Widget n -> Widget n emph (Widget Name -> Widget Name) -> (Text -> Widget Name) -> Text -> Widget Name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> Widget Name forall n. Text -> Widget n txt (Text -> Widget Name) -> (InternalTheme -> Text) -> InternalTheme -> Widget Name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> InternalTheme -> Text internalThemeName (InternalTheme -> Widget Name) -> [InternalTheme] -> [Widget Name] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [InternalTheme] internalThemes , Text -> Widget Name forall a. SemEq a => Text -> Widget a para (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Text "These themes can be selected with the */theme* command. To automatically " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "select a theme at startup, set the *theme* configuration file option to one " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "of the themes listed above." , Text -> Widget Name forall a. SemEq a => Text -> Widget a heading Text "Customizing the Theme" , Text -> Widget Name forall a. SemEq a => Text -> Widget a para (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Text "Theme customization is also supported. To customize the selected theme, " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "create a theme customization file and set the `themeCustomizationFile` " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "configuration option to the path to the customization file. If the path " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "to the file is relative, Matterhorn will look for it in the same directory " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "as the Matterhorn configuration file." , Text -> Widget Name forall a. SemEq a => Text -> Widget a para (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Text "Theme customization files are INI-style files that can customize any " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "foreground color, background color, or style of any aspect of the " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "Matterhorn user interface. Here is an example:" , Text -> Widget Name forall a. SemEq a => Text -> Widget a para (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Text "```\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "[default]\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "default.fg = blue\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "default.bg = black\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "[other]\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> AttrName -> Text attrNameToConfig AttrName codeAttr Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".fg = magenta\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> AttrName -> Text attrNameToConfig AttrName codeAttr Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".style = bold\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> AttrName -> Text attrNameToConfig AttrName clientEmphAttr Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".fg = cyan\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> AttrName -> Text attrNameToConfig AttrName clientEmphAttr Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".style = [bold, underline]\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> AttrName -> Text attrNameToConfig AttrName listSelectedFocusedAttr Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".fg = brightGreen\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "```" , Text -> Widget Name forall a. SemEq a => Text -> Widget a para (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Text "In the example above, the theme's default foreground and background colors " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "are both customized to *blue* and *black*, respectively. The *default* section " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "contains only customizations for the *default* attribute. All other customizations " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "go in the *other* section. We can also set the style for attributes; we can either " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "set just one style (as with the bold setting above) or multiple styles at once " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "(as in the bold/underline example).\n" , Text -> Widget Name forall a. SemEq a => Text -> Widget a para (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Text "Available colors are:\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * black\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * red\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * green\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * yellow\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * blue\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * magenta\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * cyan\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * white\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * brightBlack\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * brightRed\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * brightGreen\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * brightYellow\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * brightBlue\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * brightMagenta\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * brightCyan\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * brightWhite" , Text -> Widget Name forall a. SemEq a => Text -> Widget a para (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Text "Available styles are:\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * standout\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * underline\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * italic\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * strikethrough\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * reverseVideo\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * blink\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * dim\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * bold\n" , Text -> Widget Name forall a. SemEq a => Text -> Widget a para (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Text "It is also possible to specify RGB values using HTML syntax: `#RRGGBB`. " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "Bear in mind that such colors are clamped to the nearest 256-color palette " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "entry, so it is not possible to get the exact color specified.\n\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "In addition, a special value of *default* is possible for either color " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "setting of an attribute. This value indicates that the attribute should " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "use the terminal emulator's default foreground or background color of " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "choice rather than a specific ANSI color." , Text -> Widget Name forall a. SemEq a => Text -> Widget a heading Text "Username Highlighting" , Text -> Widget Name forall a. SemEq a => Text -> Widget a para (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Text "Username colors are chosen by hashing each username and then using the hash " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "to choose a color from a list of predefined username colors. If you would like " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "to change the color in a given entry of this list, we provide the " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "\"username.N\" attributes, where N is the index in the username color list." , Text -> Widget Name forall a. SemEq a => Text -> Widget a heading Text "Theme Attributes" , Text -> Widget Name forall a. SemEq a => Text -> Widget a para (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Text "This section lists all possible theme attributes for use in customization " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "files along with a description of how each one is used in Matterhorn. Each " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "option listed can be set in the *other* section of the customization file. " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "Each provides three customization settings:" , Text -> Widget Name forall a. SemEq a => Text -> Widget a para (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Text " * *<option>.fg = <color>*\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * *<option>.bg = <color>*\n" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " * *<option>.style = <style>* or *<option>.style = [<style>, ...]*\n" , let names :: [(AttrName, Text, Text)] names = [(AttrName, Text, Text)] -> [(AttrName, Text, Text)] forall a. Ord a => [a] -> [a] sort ([(AttrName, Text, Text)] -> [(AttrName, Text, Text)]) -> [(AttrName, Text, Text)] -> [(AttrName, Text, Text)] forall a b. (a -> b) -> a -> b $ (\(AttrName n, Text msg) -> (AttrName n, AttrName -> Text attrNameToConfig AttrName n, Text msg)) ((AttrName, Text) -> (AttrName, Text, Text)) -> [(AttrName, Text)] -> [(AttrName, Text, Text)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Map AttrName Text -> [(AttrName, Text)] forall k a. Map k a -> [(k, a)] M.toList (Map AttrName Text -> [(AttrName, Text)]) -> Map AttrName Text -> [(AttrName, Text)] forall a b. (a -> b) -> a -> b $ ThemeDocumentation -> Map AttrName Text themeDescriptions ThemeDocumentation themeDocs) mkEntry :: (AttrName, Text, Text) -> Widget n mkEntry (AttrName n, Text opt, Text msg) = Padding -> Widget n -> Widget n forall n. Padding -> Widget n -> Widget n padTop (Int -> Padding Pad Int 1) (Widget n -> Widget n) -> Widget n -> Widget n forall a b. (a -> b) -> a -> b $ [Widget n] -> Widget n forall n. [Widget n] -> Widget n vBox [ [Widget n] -> Widget n forall n. [Widget n] -> Widget n hBox [ AttrName -> Widget n -> Widget n forall n. AttrName -> Widget n -> Widget n withDefAttr AttrName clientEmphAttr (Widget n -> Widget n) -> Widget n -> Widget n forall a b. (a -> b) -> a -> b $ Text -> Widget n forall n. Text -> Widget n txt Text opt , Padding -> Widget n -> Widget n forall n. Padding -> Widget n -> Widget n padLeft Padding Max (Widget n -> Widget n) -> Widget n -> Widget n forall a b. (a -> b) -> a -> b $ AttrName -> Widget n -> Widget n forall n. AttrName -> Widget n -> Widget n forceAttr AttrName n (Widget n -> Widget n) -> Widget n -> Widget n forall a b. (a -> b) -> a -> b $ Text -> Widget n forall n. Text -> Widget n txt Text "(demo)" ] , Text -> Widget n forall n. Text -> Widget n txt Text msg ] in [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name forall a b. (a -> b) -> a -> b $ (AttrName, Text, Text) -> Widget Name forall {n}. (AttrName, Text, Text) -> Widget n mkEntry ((AttrName, Text, Text) -> Widget Name) -> [(AttrName, Text, Text)] -> [Widget Name] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [(AttrName, Text, Text)] names ] keybindSections :: [(Text, [MHKeyEventHandler])] keybindSections :: [(Text, [MHKeyEventHandler])] keybindSections = [ (Text "Global Keybindings", [MHKeyEventHandler] globalKeyHandlers) , (Text "Help Page", TeamId -> [MHKeyEventHandler] helpKeyHandlers TeamId teamIdThunk) , (Text "Main Interface", TeamId -> [MHKeyEventHandler] mainKeyHandlers TeamId teamIdThunk [MHKeyEventHandler] -> [MHKeyEventHandler] -> [MHKeyEventHandler] forall a. Semigroup a => a -> a -> a <> Lens' ChatState (MessageInterface Any Any) -> [MHKeyEventHandler] forall n i. Lens' ChatState (MessageInterface n i) -> [MHKeyEventHandler] messageInterfaceKeyHandlers (MessageInterface Any Any -> f (MessageInterface Any Any)) -> ChatState -> f ChatState forall n i (f :: * -> *). Functor f => (MessageInterface n i -> f (MessageInterface n i)) -> ChatState -> f ChatState Lens' ChatState (MessageInterface Any Any) whichThunk) , (Text "Message Editing", Lens' ChatState (MessageInterface Name Any) -> [MHKeyEventHandler] forall i. Lens' ChatState (MessageInterface Name i) -> [MHKeyEventHandler] extraEditorKeyHandlers (MessageInterface Name Any -> f (MessageInterface Name Any)) -> ChatState -> f ChatState forall n i (f :: * -> *). Functor f => (MessageInterface n i -> f (MessageInterface n i)) -> ChatState -> f ChatState Lens' ChatState (MessageInterface Name Any) whichThunk) , (Text "Text Editing", Lens' ChatState (Editor Text Name) -> [MHKeyEventHandler] editingKeyHandlers (Editor Text Name -> f (Editor Text Name)) -> ChatState -> f ChatState Lens' ChatState (Editor Text Name) editorThunk) , (Text "Channel Select Mode", TeamId -> [MHKeyEventHandler] channelSelectKeyHandlers TeamId teamIdThunk) , (Text "Message Select Mode", TeamId -> Lens' ChatState (MessageInterface Any Any) -> [MHKeyEventHandler] forall n i. TeamId -> Lens' ChatState (MessageInterface n i) -> [MHKeyEventHandler] messageSelectKeyHandlers TeamId teamIdThunk (MessageInterface Any Any -> f (MessageInterface Any Any)) -> ChatState -> f ChatState forall n i (f :: * -> *). Functor f => (MessageInterface n i -> f (MessageInterface n i)) -> ChatState -> f ChatState Lens' ChatState (MessageInterface Any Any) whichThunk) , (Text "User Listings", TeamId -> [MHKeyEventHandler] userListWindowKeyHandlers TeamId teamIdThunk) , (Text "URL Select Mode", Lens' ChatState (MessageInterface Name Any) -> [MHKeyEventHandler] forall i. Lens' ChatState (MessageInterface Name i) -> [MHKeyEventHandler] urlSelectKeyHandlers (MessageInterface Name Any -> f (MessageInterface Name Any)) -> ChatState -> f ChatState forall n i (f :: * -> *). Functor f => (MessageInterface n i -> f (MessageInterface n i)) -> ChatState -> f ChatState Lens' ChatState (MessageInterface Name Any) whichThunk) , (Text "Theme List Window", TeamId -> [MHKeyEventHandler] themeListWindowKeyHandlers TeamId teamIdThunk) , (Text "Channel Search Window", TeamId -> [MHKeyEventHandler] channelListWindowKeyHandlers TeamId teamIdThunk) , (Text "Message Viewer: Common", TeamId -> Lens' ChatState (TabbedWindow ChatState MH Name Int) -> [MHKeyEventHandler] forall a. (Show a, Eq a) => TeamId -> Lens' ChatState (TabbedWindow ChatState MH Name a) -> [MHKeyEventHandler] tabbedWindowKeyHandlers TeamId teamIdThunk (TabbedWindow ChatState MH Name Int -> f (TabbedWindow ChatState MH Name Int)) -> ChatState -> f ChatState Lens' ChatState (TabbedWindow ChatState MH Name Int) tabbedWinThunk) , (Text "Message Viewer: Message tab", TeamId -> [MHKeyEventHandler] viewMessageKeyHandlers TeamId teamIdThunk) , (Text "Message Viewer: Reactions tab", TeamId -> [MHKeyEventHandler] viewMessageReactionsKeyHandlers TeamId teamIdThunk) , (Text "Attachment List", Lens' ChatState (MessageInterface Name Any) -> [MHKeyEventHandler] forall i. Lens' ChatState (MessageInterface Name i) -> [MHKeyEventHandler] attachmentListKeyHandlers (MessageInterface Name Any -> f (MessageInterface Name Any)) -> ChatState -> f ChatState forall n i (f :: * -> *). Functor f => (MessageInterface n i -> f (MessageInterface n i)) -> ChatState -> f ChatState Lens' ChatState (MessageInterface Name Any) whichThunk) , (Text "Attachment File Browser", Lens' ChatState (MessageInterface Name Any) -> [MHKeyEventHandler] forall i. Lens' ChatState (MessageInterface Name i) -> [MHKeyEventHandler] attachmentBrowseKeyHandlers (MessageInterface Name Any -> f (MessageInterface Name Any)) -> ChatState -> f ChatState forall n i (f :: * -> *). Functor f => (MessageInterface n i -> f (MessageInterface n i)) -> ChatState -> f ChatState Lens' ChatState (MessageInterface Name Any) whichThunk) , (Text "Flagged Messages", TeamId -> [MHKeyEventHandler] postListWindowKeyHandlers TeamId teamIdThunk) , (Text "Reaction Emoji Search Window", TeamId -> [MHKeyEventHandler] reactionEmojiListWindowKeyHandlers TeamId teamIdThunk) ] teamIdThunk :: TeamId teamIdThunk :: TeamId teamIdThunk = FilePath -> TeamId forall a. HasCallStack => FilePath -> a error FilePath "BUG: should not evaluate teamIdThunk" tabbedWinThunk :: Lens' ChatState (TabbedWindow ChatState MH Name Int) tabbedWinThunk :: Lens' ChatState (TabbedWindow ChatState MH Name Int) tabbedWinThunk = FilePath -> (TabbedWindow ChatState MH Name Int -> f (TabbedWindow ChatState MH Name Int)) -> ChatState -> f ChatState forall a. HasCallStack => FilePath -> a error FilePath "BUG: should not evaluate tabbedWinThunk" editorThunk :: Lens' ChatState (Editor Text Name) editorThunk :: Lens' ChatState (Editor Text Name) editorThunk = FilePath -> (Editor Text Name -> f (Editor Text Name)) -> ChatState -> f ChatState forall a. HasCallStack => FilePath -> a error FilePath "BUG: should not evaluate editorThunk" whichThunk :: Lens' ChatState (MessageInterface n i) whichThunk :: forall n i (f :: * -> *). Functor f => (MessageInterface n i -> f (MessageInterface n i)) -> ChatState -> f ChatState whichThunk = FilePath -> (MessageInterface n i -> f (MessageInterface n i)) -> ChatState -> f ChatState forall a. HasCallStack => FilePath -> a error FilePath "BUG: should not evaluate whichThunk" helpBox :: HelpScreen -> Widget Name -> Widget Name helpBox :: HelpScreen -> Widget Name -> Widget Name helpBox HelpScreen scr Widget Name helpText = AttrName -> Widget Name -> Widget Name forall n. AttrName -> Widget n -> Widget n withDefAttr AttrName helpAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Name -> ViewportType -> Widget Name -> Widget Name forall n. (Ord n, Show n) => n -> ViewportType -> Widget n -> Widget n viewport Name HelpViewport ViewportType Vertical (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Name -> Widget Name -> Widget Name forall n. Ord n => n -> Widget n -> Widget n cached (HelpScreen -> Name HelpContent HelpScreen scr) Widget Name helpText kbColumnWidth :: Int kbColumnWidth :: Int kbColumnWidth = Int 14 kbDescColumnWidth :: Int kbDescColumnWidth :: Int kbDescColumnWidth = Int 60 mkKeybindingHelp :: (Ord e) => KeyConfig e -> (Text, [KeyEventHandler e m]) -> Widget Name mkKeybindingHelp :: forall e (m :: * -> *). Ord e => KeyConfig e -> (Text, [KeyEventHandler e m]) -> Widget Name mkKeybindingHelp KeyConfig e kc (Text sectionName, [KeyEventHandler e m] kbs) = (Text -> Widget Name forall a. SemEq a => Text -> Widget a heading Text sectionName) Widget Name -> Widget Name -> Widget Name forall n. Widget n -> Widget n -> Widget n <=> (Padding -> Widget Name -> Widget Name forall n. Padding -> Widget n -> Widget n padTop (Int -> Padding Pad Int 1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Widget Name -> Widget Name forall n. Widget n -> Widget n hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name forall a b. (a -> b) -> a -> b $ (Text, Widget Name) -> Widget Name forall a b. (a, b) -> b snd ((Text, Widget Name) -> Widget Name) -> [(Text, Widget Name)] -> [Widget Name] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ((Text, Widget Name) -> Text) -> [(Text, Widget Name)] -> [(Text, Widget Name)] forall b a. Ord b => (a -> b) -> [a] -> [a] sortWith (Text, Widget Name) -> Text forall a b. (a, b) -> a fst [(Text, Widget Name)] results) where results :: [(Text, Widget Name)] results = KeyConfig e -> KeyEventHandler e m -> (Text, Widget Name) forall e (m :: * -> *). Ord e => KeyConfig e -> KeyEventHandler e m -> (Text, Widget Name) mkKeybindHelp KeyConfig e kc (KeyEventHandler e m -> (Text, Widget Name)) -> [KeyEventHandler e m] -> [(Text, Widget Name)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [KeyEventHandler e m] kbs mkKeybindHelp :: (Ord e) => KeyConfig e -> KeyEventHandler e m -> (Text, Widget Name) mkKeybindHelp :: forall e (m :: * -> *). Ord e => KeyConfig e -> KeyEventHandler e m -> (Text, Widget Name) mkKeybindHelp KeyConfig e kc KeyEventHandler e m h = let unbound :: [Text] unbound = [Text "(unbound)"] (Text label, Maybe e mEv) = case KeyEventHandler e m -> EventTrigger e forall k (m :: * -> *). KeyEventHandler k m -> EventTrigger k kehEventTrigger KeyEventHandler e m h of ByKey Binding b -> (Binding -> Text ppBinding Binding b, Maybe e forall a. Maybe a Nothing) ByEvent e ev -> let bindings :: [Text] bindings = case KeyConfig e -> e -> Maybe BindingState forall k. Ord k => KeyConfig k -> k -> Maybe BindingState lookupKeyConfigBindings KeyConfig e kc e ev of Maybe BindingState Nothing -> let bs :: [Binding] bs = KeyConfig e -> e -> [Binding] forall k. Ord k => KeyConfig k -> k -> [Binding] allDefaultBindings KeyConfig e kc e ev in if Bool -> Bool not (Bool -> Bool) -> Bool -> Bool forall a b. (a -> b) -> a -> b $ [Binding] -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [Binding] bs then Binding -> Text ppBinding (Binding -> Text) -> [Binding] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Binding] bs else [Text] unbound Just BindingState Unbound -> [Text] unbound Just (BindingList [Binding] bs) | Bool -> Bool not ([Binding] -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [Binding] bs) -> Binding -> Text ppBinding (Binding -> Text) -> [Binding] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Binding] bs | Bool otherwise -> [Text] unbound in (Text -> [Text] -> Text T.intercalate Text ", " [Text] bindings, e -> Maybe e forall a. a -> Maybe a Just e ev) renderEvent :: e -> Widget n renderEvent e ev = Text -> Widget n forall n. Text -> Widget n txt Text "event: " Widget n -> Widget n -> Widget n forall n. Widget n -> Widget n -> Widget n <+> KeyConfig e -> e -> Widget n forall e a. Ord e => KeyConfig e -> e -> Widget a event KeyConfig e kc e ev rendering :: Widget Name rendering = (Widget Name -> Widget Name forall n. Widget n -> Widget n emph (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Text -> Widget Name forall n. Text -> Widget n txt (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Int -> Text -> Text padTo Int kbColumnWidth (Text -> Text) -> Text -> Text forall a b. (a -> b) -> a -> b $ Text label) Widget Name -> Widget Name -> Widget Name forall n. Widget n -> Widget n -> Widget n <+> Text -> Widget Name forall n. Text -> Widget n txt Text " " Widget Name -> Widget Name -> Widget Name forall n. Widget n -> Widget n -> Widget n <+> (Int -> Widget Name -> Widget Name forall n. Int -> Widget n -> Widget n hLimit Int kbDescColumnWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Padding -> Widget Name -> Widget Name forall n. Padding -> Widget n -> Widget n padRight Padding Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ Padding -> Widget Name -> Widget Name forall n. Padding -> Widget n -> Widget n padBottom (Int -> Padding Pad Int 1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name forall a b. (a -> b) -> a -> b $ [Widget Name] -> Widget Name forall n. [Widget n] -> Widget n vBox [ Text -> Widget Name forall a. SemEq a => Text -> Widget a renderText (Text -> Widget Name) -> Text -> Widget Name forall a b. (a -> b) -> a -> b $ Handler m -> Text forall (m :: * -> *). Handler m -> Text handlerDescription (Handler m -> Text) -> Handler m -> Text forall a b. (a -> b) -> a -> b $ KeyEventHandler e m -> Handler m forall k (m :: * -> *). KeyEventHandler k m -> Handler m kehHandler KeyEventHandler e m h , Widget Name -> (e -> Widget Name) -> Maybe e -> Widget Name forall b a. b -> (a -> b) -> Maybe a -> b maybe Widget Name forall n. Widget n emptyWidget e -> Widget Name forall {n}. e -> Widget n renderEvent Maybe e mEv ] ) in (Text label, Widget Name rendering) padTo :: Int -> Text -> Text padTo :: Int -> Text -> Text padTo Int n Text s = Text s Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Int -> Text -> Text T.replicate (Int n Int -> Int -> Int forall a. Num a => a -> a -> a - Text -> Int T.length Text s) Text " "