diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for glirc2 +## 2.20.2 + +* Remove `memory` dependency +* Add `indent-wrapped-lines` setting + ## 2.20.1.1 * Remove macro dependency on happy and alex being installed for version information diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -121,8 +121,7 @@ -- Specify additional certificates beyond the system CAs -- relative to home directory - server-certificates: - * "extra/certificate.pem" + tls-server-cert: "extra/certificate.pem" macros: * name: "wipe" @@ -160,20 +159,21 @@ Configuration sections: -------- -| setting | type | description | -|--------------------|---------------------|--------------------------------------------------------------------------------------------| -| `defaults` | server | These settings are used for all connections | -| `servers` | list of servers | These settings are used to override defaults when the hostname matches | -| `palette` | palette | Client color overrides | -| `window-names` | text | Names of windows (typically overridden on non QWERTY layouts) | -| `nick-padding` | nonnegative integer | Nicks are padded until they have the specified length | -| `extra-highlights` | list of text | Extra words/nicks to highlight | -| `extensions` | list of text | Filenames of extension to load | -| `url-opener` | text | Command to execute with URL parameter for `/url` e.g. gnome-open on GNOME or open on macOS | -| `ignores` | list of text | Initial list of nicknames to ignore | -| `activity-bar` | yes or no | Initial setting for visibility of activity bar (default no) | -| `bell-on-mention` | yes or no | Sound terminal bell on transition from not mentioned to mentioned (default no) | -| `macros` | list of macros | User-configurable client commands | +| setting | type | description | +|------------------------|---------------------|--------------------------------------------------------------------------------------------| +| `defaults` | server | These settings are used for all connections | +| `servers` | list of servers | These settings are used to override defaults when the hostname matches | +| `palette` | palette | Client color overrides | +| `window-names` | text | Names of windows (typically overridden on non QWERTY layouts) | +| `nick-padding` | nonnegative integer | Nicks are padded until they have the specified length | +| `indent-wrapped-lines` | nonnegative integer | How far to indent lines when they are wrapped | +| `extra-highlights` | list of text | Extra words/nicks to highlight | +| `extensions` | list of text | Filenames of extension to load | +| `url-opener` | text | Command to execute with URL parameter for `/url` e.g. gnome-open on GNOME or open on macOS | +| `ignores` | list of text | Initial list of nicknames to ignore | +| `activity-bar` | yes or no | Initial setting for visibility of activity bar (default no) | +| `bell-on-mention` | yes or no | Sound terminal bell on transition from not mentioned to mentioned (default no) | +| `macros` | list of macros | User-configurable client commands | Server Settings --------------- diff --git a/glirc.cabal b/glirc.cabal --- a/glirc.cabal +++ b/glirc.cabal @@ -1,5 +1,5 @@ name: glirc -version: 2.20.1.1 +version: 2.20.2 synopsis: Console IRC client description: Console IRC client . @@ -87,6 +87,7 @@ Client.Image.Palette Client.Image.StatusLine Client.Image.Textbox + Client.Image.Utils Client.Log Client.Message Client.Network.Async @@ -122,6 +123,7 @@ async >=2.1 && <2.2, attoparsec >=0.13 && <0.14, bytestring >=0.10.8 && <0.11, + base64-bytestring >=1.0.0.1 && <1.1, config-value >=0.5 && <0.6, containers >=0.5.7 && <0.6, data-default-class >=0.1.2 && <0.2, @@ -133,7 +135,6 @@ irc-core >=2.2 && <2.3, lens >=4.14 && <4.16, kan-extensions >=5.0 && <5.1, - memory >=0.13 && <0.14, network >=2.6.2 && <2.7, process >=1.4.2 && <1.5, regex-tdfa >=1.2 && <1.3, @@ -146,7 +147,7 @@ unix >=2.7 && <2.8, unordered-containers >=0.2.7 && <0.3, vector >=0.11 && <0.12, - vty >=5.11.1 && <5.12, + vty >=5.11.1 && <5.15, hookup >=0.1 && <0.2 if flag(ExportCApi) diff --git a/src/Client/Authentication/Ecdsa.hs b/src/Client/Authentication/Ecdsa.hs --- a/src/Client/Authentication/Ecdsa.hs +++ b/src/Client/Authentication/Ecdsa.hs @@ -22,7 +22,7 @@ import Client.Configuration (resolveConfigurationPath) import Control.Exception (displayException, try) -import Data.ByteArray.Encoding +import Data.ByteString.Base64 as Enc import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text @@ -42,7 +42,7 @@ encodeUsername :: Text {- ^ username -} -> Text {- ^ base-64 encoded username -} -encodeUsername = Text.decodeUtf8 . convertToBase Base64 . Text.encodeUtf8 +encodeUsername = Text.decodeUtf8 . Enc.encode . Text.encodeUtf8 -- | Compute the response for a given challenge using the @ecdsatool@ diff --git a/src/Client/Configuration.hs b/src/Client/Configuration.hs --- a/src/Client/Configuration.hs +++ b/src/Client/Configuration.hs @@ -1,7 +1,7 @@ -{-# Language OverloadedStrings #-} -{-# Language TemplateHaskell #-} -{-# Language BangPatterns #-} -{-# Language RecordWildCards #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} {-| Module : Client.Configuration @@ -25,6 +25,7 @@ , configPalette , configWindowNames , configNickPadding + , configIndentWrapped , configConfigPath , configMacros , configExtensions @@ -41,30 +42,30 @@ , resolveConfigurationPath ) where -import Client.Image.Palette -import Client.Configuration.Colors -import Client.Configuration.ServerSettings import Client.Commands.Interpolation import Client.Commands.Recognizer import Client.Commands.WordCompletion -import Control.Exception -import Control.Monad +import Client.Configuration.Colors +import Client.Configuration.ServerSettings +import Client.Image.Palette import Config import Config.FromConfig -import Control.Lens hiding (List) -import Data.Foldable (for_) -import Data.HashMap.Strict (HashMap) -import qualified Data.HashMap.Strict as HashMap -import Data.HashSet (HashSet) -import qualified Data.HashSet as HashSet -import Data.List.NonEmpty (NonEmpty) -import qualified Data.List.NonEmpty as NonEmpty +import Control.Exception +import Control.Lens hiding (List) +import Control.Monad +import Data.Foldable (for_) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.HashSet (HashSet) +import qualified Data.HashSet as HashSet +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import qualified Data.Vector as Vector -import Irc.Identifier (Identifier, mkId) +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import qualified Data.Vector as Vector +import Irc.Identifier (Identifier, mkId) import System.Directory import System.FilePath import System.IO.Error @@ -73,20 +74,21 @@ -- server configuration from '_configServers' is used where possible, -- otherwise '_configDefaults' is used. data Configuration = Configuration - { _configDefaults :: ServerSettings -- ^ Default connection settings - , _configServers :: (HashMap Text ServerSettings) -- ^ Host-specific settings - , _configPalette :: Palette - , _configWindowNames :: Text -- ^ Names of windows, used when alt-jumping) - , _configExtraHighlights :: HashSet Identifier -- ^ Extra highlight nicks/terms - , _configNickPadding :: Maybe Integer -- ^ Padding of nicks - , _configConfigPath :: Maybe FilePath + { _configDefaults :: ServerSettings -- ^ Default connection settings + , _configServers :: (HashMap Text ServerSettings) -- ^ Host-specific settings + , _configPalette :: Palette + , _configWindowNames :: Text -- ^ Names of windows, used when alt-jumping) + , _configExtraHighlights :: HashSet Identifier -- ^ Extra highlight nicks/terms + , _configNickPadding :: Maybe Integer -- ^ Padding of nicks + , _configIndentWrapped :: Maybe Int -- ^ How far to indent wrapped lines + , _configConfigPath :: Maybe FilePath -- ^ manually specified configuration path, used for reloading - , _configMacros :: Recognizer Macro -- ^ command macros - , _configExtensions :: [FilePath] -- ^ paths to shared library - , _configUrlOpener :: Maybe FilePath -- ^ paths to url opening executable - , _configIgnores :: HashSet Identifier -- ^ initial ignore list - , _configActivityBar :: Bool -- ^ initially visibility of the activity bar - , _configBellOnMention :: Bool -- ^ notify terminal on mention + , _configMacros :: Recognizer Macro -- ^ command macros + , _configExtensions :: [FilePath] -- ^ paths to shared library + , _configUrlOpener :: Maybe FilePath -- ^ paths to url opening executable + , _configIgnores :: HashSet Identifier -- ^ initial ignore list + , _configActivityBar :: Bool -- ^ initially visibility of the activity bar + , _configBellOnMention :: Bool -- ^ notify terminal on mention } deriving Show @@ -214,6 +216,8 @@ _configNickPadding <- sectionOpt "nick-padding" + _configIndentWrapped <- sectionOpt "indent-wrapped-lines" + _configIgnores <- maybe HashSet.empty HashSet.fromList <$> sectionOptWith (parseList parseIdentifier) "ignores" @@ -225,6 +229,11 @@ when (padding < 0) (liftConfigParser $ failure "nick-padding has to be a non negative number")) + + for_ _configIndentWrapped (\indent -> + when (indent < 0) + (liftConfigParser $ + failure "indent-wrapped-lines has to be a non negative number")) return Configuration{..} diff --git a/src/Client/Image.hs b/src/Client/Image.hs --- a/src/Client/Image.hs +++ b/src/Client/Image.hs @@ -1,4 +1,4 @@ -{-# Language BangPatterns #-} +{-# LANGUAGE BangPatterns #-} {-| Module : Client.Image Description : UI renderer @@ -17,13 +17,16 @@ import Client.Image.Palette import Client.Image.StatusLine import Client.Image.Textbox +import Client.Image.Utils import Client.State import Client.State.Focus import Client.View import Control.Lens -import Graphics.Vty (Background(..), Picture(..), Cursor(..)) +import Graphics.Vty (Background (..), Cursor (..), + Picture (..)) import Graphics.Vty.Image + -- | Generate a 'Picture' for the current client state. The resulting -- client state is updated for render specific information like scrolling. clientPicture :: ClientState -> (Picture, ClientState) @@ -93,25 +96,12 @@ assemble acc _ | imageHeight acc >= vh = cropTop vh acc assemble acc [] = acc - assemble acc (x:xs) = assemble (lineWrap w x <-> acc) xs + assemble acc (x:xs) = assemble (lineWrap w Nothing x <-> acc) xs scroll = view clientScroll st vh = h + scroll w = view clientWidth st - --- | Given an image, break the image up into chunks of at most the --- given width and stack the resulting chunks vertically top-to-bottom. -lineWrap :: - Int {- ^ maximum image width -} -> - Image {- ^ unwrapped image -} -> - Image {- ^ wrapped image -} -lineWrap w img - | imageWidth img > w = cropRight w img <-> - lineWrap w (cropLeft (imageWidth img - w) img) - | otherwise = img <|> char defAttr ' ' - -- trailing space with default attributes deals with bug in VTY - -- where the formatting will continue past the end of chat messages -- | Compute the number of lines in a page at the current window size diff --git a/src/Client/Image/StatusLine.hs b/src/Client/Image/StatusLine.hs --- a/src/Client/Image/StatusLine.hs +++ b/src/Client/Image/StatusLine.hs @@ -87,24 +87,28 @@ -- that the connection is being established or that a ping has been -- sent or long the previous ping round-trip was. latencyImage :: ClientState -> Image -latencyImage st - | Just network <- views clientFocus focusNetwork st - , Just cs <- preview (clientConnection network) st = - case view csPingStatus cs of - PingNever -> emptyImage - PingSent {} -> infoBubble (string (view palLatency pal) "sent") - PingLatency delta -> - infoBubble (string (view palLatency pal) (showFFloat (Just 2) delta "s")) - PingConnecting n _ -> - infoBubble (string (view palLabel pal) "connecting" <|> retryImage) - where - retryImage - | n > 0 = string defAttr ": " <|> - string (view palLabel pal) ("retry " ++ show n) - | otherwise = emptyImage - | otherwise = emptyImage +latencyImage st = + case views clientFocus focusNetwork st of + Nothing -> emptyImage + Just network -> + case preview (clientConnection network) st of + Nothing -> infoBubble (string (view palError pal) "offline") + Just cs -> + case view csPingStatus cs of + PingNever -> emptyImage + PingSent {} -> latency "ping sent" + PingLatency delta -> latency (showFFloat (Just 2) delta "s") + PingConnecting n _ -> + infoBubble (string (view palLatency pal) "connecting" <|> + retryImage n) where - pal = clientPalette st + pal = clientPalette st + latency = infoBubble . string (view palLatency pal) + + retryImage n + | n > 0 = string defAttr ": " <|> + string (view palLabel pal) ("retry " ++ show n) + | otherwise = emptyImage -- | Wrap some text in parentheses to make it suitable for inclusion in the diff --git a/src/Client/Image/Utils.hs b/src/Client/Image/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Client/Image/Utils.hs @@ -0,0 +1,66 @@ +{-| +Module : Client.Image.Utils +Description : Chat message view +Copyright : (c) Eric Mertens, 2016 +License : ISC +Maintainer : emertens@gmail.com + +Provides utilities for formatting Vty Images. +-} + +module Client.Image.Utils (lineWrap) where + +import Graphics.Vty.Image + +-- | Given an image, break the image up into chunks of at most the +-- given width and stack the resulting chunks vertically top-to-bottom. +lineWrap :: + Int {- ^ terminal width -} -> + Maybe Int {- ^ optional indentation -} -> + Image {- ^ unwrapped image -} -> + Image {- ^ wrapped image -} +lineWrap w mi img + | imageWidth img == 0 = emptyImage + | imageWidth img <= w = terminate w img + | otherwise = + terminate w (cropRight w img) <-> + maybe (lineWrapNoIndent w) (lineWrapIndent w) mi + (cropLeft (imageWidth img - w) img) + +-- | Trailing space with default attributes deals with bug in VTY +-- where the formatting will continue past the end of chat messages. +-- This adds an extra space if a line doesn't end on the terminal edge. +terminate :: + Int {- ^ terminal width -} -> + Image {- ^ unwrapped image -} -> + Image {- ^ wrapped image -} +terminate n img + | imageWidth img == n = img + | otherwise = img <|> char defAttr ' ' + +lineWrapNoIndent :: + Int {- ^ terminal width -} -> + Image {- ^ unwrapped image -} -> + Image {- ^ wrapped image -} +lineWrapNoIndent w img + | iw <= w = terminate w img + | otherwise = cropRight w img <-> + lineWrapNoIndent w (cropLeft (iw - w) img) + where + iw = imageWidth img + +lineWrapIndent :: + Int {- ^ terminal width -} -> + Int {- ^ indentation -} -> + Image {- ^ unwrapped image -} -> + Image {- ^ wrapped image -} +lineWrapIndent w i img + | 20 + i > w = lineWrapNoIndent w img -- ensure we stop wrapping when it doesn't make sense + | iw + i <= w = terminate w (leftPad i img) + | otherwise = leftPad i (cropRight (w-i) img) <-> + lineWrapIndent w i (cropLeft (iw - w + i) img) + where + iw = imageWidth img + +leftPad :: Int -> Image -> Image +leftPad i = pad i 0 0 0 diff --git a/src/Client/View/Messages.hs b/src/Client/View/Messages.hs --- a/src/Client/View/Messages.hs +++ b/src/Client/View/Messages.hs @@ -14,19 +14,22 @@ ( chatMessageImages ) where -import Client.Image.Palette +import Client.Configuration import Client.Image.Message +import Client.Image.Palette +import Client.Image.Utils +import Client.Message import Client.State import Client.State.Focus import Client.State.Network import Client.State.Window -import Client.Message import Control.Lens import Control.Monad +import Graphics.Vty.Image import Irc.Identifier import Irc.Message -import Graphics.Vty.Image + chatMessageImages :: Focus -> ClientState -> [Image] chatMessageImages focus st = windowLineProcessor focusedMessages where @@ -62,7 +65,10 @@ windowLinesToImages st wwls = case gatherMetadataLines st wwls of ([], []) -> [] - ([], w:ws) -> view wlImage w : windowLinesToImages st ws + ([], w:ws) -> lineWrap (view clientWidth st) + (view (clientConfig . configIndentWrapped) st) + (view wlImage w) + : windowLinesToImages st ws ((img,who,mbnext):mds, wls) | view clientShowMetadata st ->