1{-# LANGUAGE MultiWayIf #-} 2module Matterhorn.Events.Main where 3 4import Prelude () 5import Matterhorn.Prelude 6 7import Brick.Widgets.Edit 8import qualified Graphics.Vty as Vty 9 10import Matterhorn.Command 11import Matterhorn.Events.Keybindings 12import Matterhorn.State.Attachments 13import Matterhorn.State.ChannelSelect 14import Matterhorn.State.ChannelList 15import Matterhorn.State.Channels 16import Matterhorn.State.Editing 17import Matterhorn.State.MessageSelect 18import Matterhorn.State.PostListOverlay ( enterFlaggedPostListMode ) 19import Matterhorn.State.Teams 20import Matterhorn.State.UrlSelect 21import Matterhorn.Types 22 23 24onEventMain :: Vty.Event -> MH () 25onEventMain = 26 void . handleKeyboardEvent mainKeybindings (\ ev -> do 27 resetReturnChannel 28 case ev of 29 (Vty.EvPaste bytes) -> handlePaste bytes 30 _ -> handleEditingInput ev 31 ) 32 33mainKeybindings :: KeyConfig -> KeyHandlerMap 34mainKeybindings = mkKeybindings mainKeyHandlers 35 36mainKeyHandlers :: [KeyEventHandler] 37mainKeyHandlers = 38 [ mkKb EnterSelectModeEvent 39 "Select a message to edit/reply/delete" 40 beginMessageSelect 41 42 , mkKb ReplyRecentEvent 43 "Reply to the most recent message" 44 replyToLatestMessage 45 46 , mkKb ToggleMessagePreviewEvent "Toggle message preview" 47 toggleMessagePreview 48 49 , mkKb ToggleChannelListVisibleEvent "Toggle channel list visibility" 50 toggleChannelListVisibility 51 52 , mkKb ToggleExpandedChannelTopicsEvent "Toggle display of expanded channel topics" 53 toggleExpandedChannelTopics 54 55 , mkKb NextTeamEvent "Switch to the next available team" 56 nextTeam 57 58 , mkKb PrevTeamEvent "Switch to the previous available team" 59 prevTeam 60 61 , mkKb MoveCurrentTeamLeftEvent "Move the current team to the left in the team list" 62 moveCurrentTeamLeft 63 64 , mkKb MoveCurrentTeamRightEvent "Move the current team to the right in the team list" 65 moveCurrentTeamRight 66 67 , mkKb 68 InvokeEditorEvent 69 "Invoke `$EDITOR` to edit the current message" 70 invokeExternalEditor 71 72 , mkKb 73 EnterFastSelectModeEvent 74 "Enter fast channel selection mode" 75 beginChannelSelect 76 77 , mkKb 78 QuitEvent 79 "Quit" 80 requestQuit 81 82 , staticKb "Tab-complete forward" 83 (Vty.EvKey (Vty.KChar '\t') []) $ 84 tabComplete Forwards 85 86 , staticKb "Tab-complete backward" 87 (Vty.EvKey (Vty.KBackTab) []) $ 88 tabComplete Backwards 89 90 , mkKb 91 ScrollUpEvent 92 "Scroll up in the channel input history" $ do 93 -- Up in multiline mode does the usual thing; otherwise we 94 -- navigate the history. 95 isMultiline <- use (csCurrentTeam.tsEditState.cedEphemeral.eesMultiline) 96 case isMultiline of 97 True -> mhHandleEventLensed (csCurrentTeam.tsEditState.cedEditor) handleEditorEvent 98 (Vty.EvKey Vty.KUp []) 99 False -> channelHistoryBackward 100 101 , mkKb 102 ScrollDownEvent 103 "Scroll down in the channel input history" $ do 104 -- Down in multiline mode does the usual thing; otherwise 105 -- we navigate the history. 106 isMultiline <- use (csCurrentTeam.tsEditState.cedEphemeral.eesMultiline) 107 case isMultiline of 108 True -> mhHandleEventLensed (csCurrentTeam.tsEditState.cedEditor) handleEditorEvent 109 (Vty.EvKey Vty.KDown []) 110 False -> channelHistoryForward 111 112 , mkKb PageUpEvent "Page up in the channel message list (enters message select mode)" $ do 113 beginMessageSelect 114 115 , mkKb SelectOldestMessageEvent "Scroll to top of channel message list" $ do 116 beginMessageSelect 117 messageSelectFirst 118 119 , mkKb NextChannelEvent "Change to the next channel in the channel list" 120 nextChannel 121 122 , mkKb PrevChannelEvent "Change to the previous channel in the channel list" 123 prevChannel 124 125 , mkKb NextUnreadChannelEvent "Change to the next channel with unread messages or return to the channel marked '~'" 126 nextUnreadChannel 127 128 , mkKb ShowAttachmentListEvent "Show the attachment list" 129 showAttachmentList 130 131 , mkKb NextUnreadUserOrChannelEvent 132 "Change to the next channel with unread messages preferring direct messages" 133 nextUnreadUserOrChannel 134 135 , mkKb LastChannelEvent "Change to the most recently-focused channel" 136 recentChannel 137 138 , staticKb "Send the current message" 139 (Vty.EvKey Vty.KEnter []) $ do 140 isMultiline <- use (csCurrentTeam.tsEditState.cedEphemeral.eesMultiline) 141 case isMultiline of 142 -- Normally, this event causes the current message to 143 -- be sent. But in multiline mode we want to insert a 144 -- newline instead. 145 True -> handleEditingInput (Vty.EvKey Vty.KEnter []) 146 False -> do 147 tId <- use csCurrentTeamId 148 cId <- use (csCurrentChannelId tId) 149 content <- getEditorContent 150 handleInputSubmission tId cId content 151 152 , mkKb EnterOpenURLModeEvent "Select and open a URL posted to the current channel" 153 startUrlSelect 154 155 , mkKb ClearUnreadEvent "Clear the current channel's unread / edited indicators" $ do 156 tId <- use csCurrentTeamId 157 clearChannelUnreadStatus =<< use (csCurrentChannelId tId) 158 159 , mkKb ToggleMultiLineEvent "Toggle multi-line message compose mode" 160 toggleMultilineEditing 161 162 , mkKb CancelEvent "Cancel autocomplete, message reply, or edit, in that order" 163 cancelAutocompleteOrReplyOrEdit 164 165 , mkKb EnterFlaggedPostsEvent "View currently flagged posts" 166 enterFlaggedPostListMode 167 ] 168