Merge branch 'develop'

Author: jtdaugherty

CHANGELOG.md

@@ -1,4 +1,31 @@
 
+90000.0.0
+=========
+
+NOTE: this version of Matterhorn requires server version 9.0 or greater.
+
+Package changes:
+* Updated to use Vty 6 for crossplatform terminal support, meaning
+  Matterhorn can now be built and run on Windows terminals. Please let
+  us know if you try this and encounter any issues!
+
+Enhancements:
+* Added support for a new "auto" mode to determine channel list width.
+  There is now a new `auto` value for the `channelListWidth`
+  configuration file setting. Its default is unchanged and it can still
+  take an integer value specifying the channel list width in columns.
+  If set to `auto`, its value is determined by Matterhorn, bounded by
+  minimum and maximum values, as a function of window width. This is
+  intended to give nicer results as font size decreases, up to a point.
+* Add a `/write-theme` command to write the current theme to an INI
+  file.
+
+Bug fixes:
+* Updated channel viewing book-keeping to work with changes in
+  Mattermost 9.0.
+* Fixed an issue where terminal input provided right before the UI is
+  initialized could cause the application to crash.
+
 50200.19.0
 ==========
 

matterhorn.cabal

@@ -1,5 +1,5 @@
 name:                matterhorn
-version:             50200.19.0
+version:             90000.0.0
 synopsis:            Terminal client for the Mattermost chat system
 description:         This is a terminal client for the Mattermost chat
                      system. Please see the README for a list of
@@ -170,31 +170,32 @@ library
     ghc-options: -fhide-source-paths
 
   build-depends:       base                 >=4.8      && <5
-                     , mattermost-api       == 50200.15.0
+                     , mattermost-api       == 90000.0.0
                      , base-compat          >= 0.9     && < 0.13
                      , unordered-containers >= 0.2     && < 0.3
                      , containers           >= 0.5.7   && < 0.7
                      , split                >= 0.2     && < 0.3
                      , data-clist           >= 0.1.2   && < 0.2
                      , semigroups           >= 0.18    && < 0.20
-                     , connection           >= 0.2     && < 0.4
-                     , text                 >= 1.2.5.0 && < 2.0
+                     , crypton-connection   >= 0.3.1   && < 0.4
+                     , text                 >= 1.2.5.0 && < 2.1
                      , bytestring           >= 0.10    && < 0.12
                      , stm                  >= 2.4     && < 2.6
                      , config-ini           >= 0.2.2.0 && < 0.3
                      , process              >= 1.4     && < 1.7
                      , microlens-platform   >= 0.3     && < 0.5
-                     , brick                >= 1.8     && < 1.9
+                     , brick                >= 2.0     && < 2.1
                      , brick-skylighting    >= 1.0     && < 1.1
-                     , vty                  >= 5.38    && < 5.39
+                     , vty                  >= 6.0     && < 6.1
+                     , vty-crossplatform    >= 0.2.0.0 && < 0.3.0.0
                      , word-wrap            >= 0.4.0   && < 0.5
-                     , transformers         >= 0.4     && < 0.6
+                     , transformers         >= 0.4     && < 0.7
                      , text-zipper          >= 0.13    && < 0.14
                      , time                 >= 1.6     && < 2.0
                      , xdg-basedir          >= 0.2     && < 0.3
                      , filepath             >= 1.4     && < 1.5
                      , directory            >= 1.3     && < 1.4
-                     , vector               < 0.13
+                     , vector               < 0.14
                      , strict               >= 0.3     && < 0.6
                      , hashable             >= 1.2     && < 1.5
                      , commonmark           >= 0.2.1   && < 0.3
@@ -207,7 +208,7 @@ library
                      , mtl                  >= 2.2     && < 2.4
                      , aspell-pipe          >= 0.6     && < 0.7
                      , stm-delay            >= 0.1     && < 0.2
-                     , unix                 >= 2.7.1.0 && < 2.9
+                     , unix-compat          >= 0.6     && < 0.8
                      , skylighting-core     >= 0.12    && < 0.13
                      , timezone-olson       >= 0.2     && < 0.3
                      , timezone-series      >= 0.1.6.1 && < 0.2

src/Matterhorn/App.hs

@@ -10,9 +10,9 @@ import           Matterhorn.Prelude
 import           Brick
 import           Control.Monad.Trans.Except ( runExceptT )
 import qualified Graphics.Vty as Vty
+import qualified Graphics.Vty.CrossPlatform as Vty
 import           Text.Aspell ( stopAspell )
 import           GHC.Conc (getNumProcessors, setNumCapabilities)
-import           System.Posix.IO ( stdInput )
 
 import           Network.Mattermost
 
@@ -32,11 +32,14 @@ app :: App ChatState MHEvent Name
 app =
     App { appDraw         = draw
         , appHandleEvent  = Events.onEvent
-        , appStartEvent   = return ()
         , appAttrMap      = (^.csResources.crTheme)
         , appChooseCursor = \s cs -> do
             tId <- s^.csCurrentTeamId
             cursorByMode cs s tId (teamMode $ s^.csTeam(tId))
+        , appStartEvent = do
+            vty <- getVtyHandle
+            (w, h) <- liftIO $ Vty.displayBounds $ Vty.outputIface vty
+            runMHEvent $ Events.setWindowSize w h
         }
 
 cursorByMode :: [CursorLocation Name] -> ChatState -> TeamId -> Mode -> Maybe (CursorLocation Name)
@@ -84,12 +87,7 @@ runMatterhorn opts config = do
     setupCpuUsage config
 
     let mkVty = do
-          mEraseChar <- Vty.getTtyEraseChar stdInput
-          let addEraseChar cfg = case mEraseChar of
-                  Nothing -> cfg
-                  Just ch -> cfg { Vty.inputMap = (Nothing, [ch], Vty.EvKey Vty.KBS []) : Vty.inputMap cfg }
-
-          vty <- Vty.mkVty $ addEraseChar Vty.defaultConfig
+          vty <- Vty.mkVty Vty.defaultConfig
           let output = Vty.outputIface vty
           Vty.setMode output Vty.BracketedPaste True
           Vty.setMode output Vty.Hyperlink $ configHyperlinkingMode config

src/Matterhorn/Config.hs

@@ -80,7 +80,7 @@ fromIni = do
     configTeam           <- fieldMbOf "team" stringField
     configPort           <- fieldDefOf "port" number (configPort defaultConfig)
     configUrlPath        <- fieldMbOf "urlPath" stringField
-    configChannelListWidth <- fieldDefOf "channelListWidth" number
+    configChannelListWidth <- fieldDefOf "channelListWidth" channelListWidthField
                               (configChannelListWidth defaultConfig)
     configCpuUsagePolicy <- fieldDefOf "cpuUsagePolicy" cpuUsagePolicy
                             (configCpuUsagePolicy defaultConfig)
@@ -260,6 +260,14 @@ defaultBindings =
     , (MoveCurrentTeamRightEvent        , [ ])
     ]
 
+channelListWidthField :: Text -> Either String ChannelListWidth
+channelListWidthField t =
+    case T.toLower t of
+        "auto" -> return ChannelListWidthAuto
+        _ -> case readMaybe (T.unpack t) of
+            Nothing -> Left "Invalid value for channelListWidth"
+            Just w  -> Right $ ChannelListWidthFixed w
+
 channelListOrientationField :: Text -> Either String ChannelListOrientation
 channelListOrientationField t =
     case T.toLower t of
@@ -416,7 +424,7 @@ defaultConfig = addDefaultKeys $
            , configAspellDictionary            = Nothing
            , configUnsafeUseHTTP               = False
            , configValidateServerCertificate   = True
-           , configChannelListWidth            = 22
+           , configChannelListWidth            = ChannelListWidthFixed 22
            , configLogMaxBufferSize            = 200
            , configShowOlderEdits              = True
            , configUserKeys                    = newKeyConfig allEvents [] []

src/Matterhorn/Constants.hs

@@ -8,6 +8,8 @@ module Matterhorn.Constants
   , userSigil
   , userSigilChar
   , editMarking
+  , channelListMinAutoWidth
+  , channelListMaxAutoWidth
   )
 where
 
@@ -17,6 +19,14 @@ import Matterhorn.Prelude
 import qualified Data.Text as T
 
 
+-- | The minimum channel list width when the width is set to 'auto'.
+channelListMinAutoWidth :: Int
+channelListMinAutoWidth = 24
+
+-- | The maximum channel list width when the width is set to 'auto'.
+channelListMaxAutoWidth :: Int
+channelListMaxAutoWidth = 44
+
 -- | The number of rows to consider a "page" when scrolling
 pageAmount :: Int
 pageAmount = 15

src/Matterhorn/Draw/Autocomplete.hs

@@ -18,6 +18,7 @@ import           Lens.Micro.Platform ( SimpleGetter, Lens' )
 import           Network.Mattermost.Types ( User(..), Channel(..), TeamId )
 
 import           Matterhorn.Constants ( normalChannelSigil )
+import           Matterhorn.Draw.ChannelList ( channelListWidth )
 import           Matterhorn.Draw.Util ( mkChannelName )
 import           Matterhorn.Themes
 import           Matterhorn.Types
@@ -93,10 +94,9 @@ renderAutocompleteBox st tId mCurChan which ac =
         curUser = myUsername st
         cfg = st^.csResources.crConfiguration
         showingChanList = configShowChannelList cfg
-        chanListWidth = configChannelListWidth cfg
         maybeLimit = fromMaybe id $ do
             let sub = if showingChanList
-                      then chanListWidth + 1
+                      then channelListWidth st + 1
                       else 0
                 threadNarrow = threadShowing && (cfg^.configThreadOrientationL `elem` [ThreadLeft, ThreadRight])
                 threadShowing = isJust $ st^.csTeam(tId).tsThreadInterface

src/Matterhorn/Draw/ChannelList.hs

@@ -16,7 +16,12 @@
 --     channels matching the entered text (and highlighting the
 --     matching portion).
 
-module Matterhorn.Draw.ChannelList (renderChannelList, renderChannelListHeader) where
+module Matterhorn.Draw.ChannelList
+  ( renderChannelList
+  , renderChannelListHeader
+  , channelListWidth
+  )
+where
 
 import           Prelude ()
 import           Matterhorn.Prelude
@@ -34,6 +39,7 @@ import qualified Network.Mattermost.Types as MM
 
 import           Matterhorn.Draw.Util
 import           Matterhorn.State.Channels
+import           Matterhorn.Constants ( channelListMinAutoWidth, channelListMaxAutoWidth )
 import           Matterhorn.Themes
 import           Matterhorn.Types
 import           Matterhorn.Types.Common ( sanitizeUserText )
@@ -54,10 +60,17 @@ data ChannelListEntryData =
                          , entryUserStatus  :: Maybe UserStatus
                          }
 
-sbRenderer :: ScrollbarRenderer n
+sbRenderer :: VScrollbarRenderer n
 sbRenderer =
-    verticalScrollbarRenderer { renderScrollbarHandleBefore = str "▲"
-                              , renderScrollbarHandleAfter = str "▼"
+    verticalScrollbarRenderer { renderVScrollbarHandleBefore = str "▲"
+                              , renderVScrollbarHandleAfter = str "▼"
+                              , scrollbarWidthAllocation = 2
+                              , renderVScrollbar =
+                                  hLimit 1 $
+                                  renderVScrollbar verticalScrollbarRenderer
+                              , renderVScrollbarTrough =
+                                  hLimit 1 $
+                                  renderVScrollbarTrough verticalScrollbarRenderer
                               }
 
 renderChannelListHeader :: ChatState -> MM.TeamId -> Widget Name
@@ -84,9 +97,9 @@ renderChannelList :: ChatState -> MM.TeamId -> Widget Name
 renderChannelList st tId =
     header <=> vpBody
     where
-        (sbOrientation, sbPad) = case st^.csResources.crConfiguration.configChannelListOrientationL of
-            ChannelListLeft -> (OnLeft, padLeft (Pad 1))
-            ChannelListRight -> (OnRight, padRight (Pad 1))
+        sbOrientation = case st^.csResources.crConfiguration.configChannelListOrientationL of
+            ChannelListLeft -> OnLeft
+            ChannelListRight -> OnRight
         myUsername_ = myUsername st
         channelName e = ClickableChannelListEntry $ channelListEntryChannelId e
         renderEntry s e = clickable (channelName e) $
@@ -96,7 +109,7 @@ renderChannelList st tId =
                  withVScrollBars sbOrientation $
                  withVScrollBarHandles $
                  withClickableVScrollBars VScrollBar $
-                 viewport (ChannelListViewport tId) Vertical $ sbPad body
+                 viewport (ChannelListViewport tId) Vertical body
         body = case teamMode $ st^.csTeam(tId) of
             ChannelSelect ->
                 let zipper = st^.csTeam(tId).tsChannelSelectState.channelSelectMatches
@@ -269,3 +282,16 @@ recentChannelSigil = "<"
 
 returnChannelSigil :: String
 returnChannelSigil = "~"
+
+channelListWidthAutoPercent :: Double
+channelListWidthAutoPercent = 0.2
+
+channelListWidth :: ChatState -> Int
+channelListWidth st =
+    case configChannelListWidth $ st^.csResources.crConfiguration of
+        ChannelListWidthFixed w -> w
+        ChannelListWidthAuto ->
+            let calcWidth = round $ channelListWidthAutoPercent * (fromIntegral width :: Double)
+                width = fst $ st^.csResources.crWindowSize
+            in min channelListMaxAutoWidth $
+               max channelListMinAutoWidth calcWidth

src/Matterhorn/Draw/Main.hs

@@ -20,7 +20,7 @@ import           Network.Mattermost.Types ( Type(Direct, Private, Group)
                                           )
 
 
-import           Matterhorn.Draw.ChannelList ( renderChannelList )
+import           Matterhorn.Draw.ChannelList ( renderChannelList, channelListWidth )
 import           Matterhorn.Draw.Messages
 import           Matterhorn.Draw.MessageInterface
 import           Matterhorn.Draw.Autocomplete
@@ -76,10 +76,9 @@ mainInterface st mode mtId =
     mainDisplay = maybeSubdue messageInterface
 
     channelList = channelListMaybeVlimit mode $
-                  hLimit channelListWidth $ case mtId of
+                  hLimit (channelListWidth st) $ case mtId of
                       Nothing -> fill ' '
                       Just tId -> renderChannelList st tId
-    channelListWidth = configChannelListWidth $ st^.csResources.crConfiguration
     channelListMaybeVlimit ChannelSelect w =
         Widget (hSize w) (vSize w) $ do
             ctx <- getContext

src/Matterhorn/Events.hs

@@ -1,5 +1,6 @@
 module Matterhorn.Events
   ( onEvent
+  , setWindowSize
   )
 where
 
@@ -194,21 +195,26 @@ onVtyEvent =
                     ]
 
 handleResizeEvent :: Vty.Event -> MH Bool
-handleResizeEvent (Vty.EvResize _ _) = do
+handleResizeEvent (Vty.EvResize w h) = do
+    setWindowSize w h
+    return True
+handleResizeEvent _ =
+    return False
+
+setWindowSize :: Int -> Int -> MH ()
+setWindowSize w h = do
     -- On resize, invalidate the entire rendering cache since many
     -- things depend on the window size.
     --
     -- Note: we fall through after this because it is sometimes
     -- important for modes to have their own additional logic to run
     -- when a resize occurs, so we don't want to stop processing here.
+    csResources.crWindowSize .= (w, h)
+
     mh invalidateCache
     withCurrentTeam $ \tId ->
         mh $ makeVisible $ SelectedChannelListEntry tId
 
-    return True
-handleResizeEvent _ =
-    return False
-
 handleTeamModeEvent :: Vty.Event -> MH Bool
 handleTeamModeEvent e = do
     withCurrentTeam $ \tId -> do

src/Matterhorn/Events/Websocket.hs

@@ -166,9 +166,15 @@ handleWebsocketEvent we = do
             | otherwise -> return ()
 
         WMChannelViewed
-            | Just cId <- wepChannelId $ weData we -> refreshChannelById cId
+            | Just cId <- wepChannelId $ weData we -> mhLog LogGeneral "WMChannelViewed received" >> refreshChannelById cId
             | otherwise -> return ()
 
+        WMMultipleChannelsViewed ->
+            case wepChannelTimes $ weData we of
+                Nothing -> return ()
+                Just m ->
+                    forM_ (HM.keys m) refreshChannelById
+
         WMChannelUpdated
             | Just cId <- webChannelId $ weBroadcast we -> do
                 mChan <- preuse (csChannel(cId))