diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for glirc2 +## 2.16 + +* Add `/splits` to show multiple chat windows simultaneously + ## 2.15 * Add `/mentions` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -My IRC client +GLIRC - Advanced Console IRC Client ============= [![Build Status](https://secure.travis-ci.org/glguy/irc-core.svg)](http://travis-ci.org/glguy/irc-core) @@ -41,20 +41,24 @@ Client Features =============== +* All views and transformation are dynamic and don't change the underlying model. * Subsequent joins and parts fold into one line and do not scroll chat messages off the screen * Ignore support that folds ignored messages into the joins and parts. Toggle it off to see previously hidden messages * Detailed view to see all the messages in a channel in full detail with hostmask and timestamp (F2) -* Nick tab completion -* New message notification -* View ban, quiet, invex, and exception lists +* Context sensitive tab completion +* Searchable ban, quiet, invex, and exception view separate from chat messages +* Searchable user list, detailed view shows full hostmasks * WYSIWYG mIRC formatting input +* Multi-line editing +* Dynamic, in-place message searching * Chanserv integration -* Each user's nick is assigned a consistent color, when a user's nick is rendered in a chat message it uses that same color. +* Nicknames in chat messages are colored to match messages from that nickname * Support for /STATUSMSG/ messages (messages only voice or op users can see) * Run commands upon connection -* Ban lists don't obstruct chat messages -* Ban list and user list are searchable +* Command macros * CERTFP and SASL authentication +* Split-screen view +* Configurable color palette TLS === @@ -105,7 +109,8 @@ -- Override the defaults when connecting to specific servers servers: - * hostname: "chat.freenode.net" + * name: "fn" + hostname: "chat.freenode.net" sasl-username: "someuser" sasl-password: "somepass" socks-host: "socks5.example.com" @@ -129,6 +134,10 @@ * "clear" * "znc *status clearbuffer $channel" + * name: "mysplits" + commands: + * "splits fn:#haskell fn:#haskell-offtopic" + -- Example use of macro in combination with an extension * name: "extra" commands: @@ -155,61 +164,68 @@ Configuration sections: -------- -* `defaults` - These settings are used for all connections -* `servers` - These settings are used to override defaults when the hostname matches -* `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) +| 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) | -Settings --------- +Server Settings +--------------- -* `name` - text - name of server entry, defaults to `hostname` -* `hostname` - text - hostname used to connect and to specify the server -* `port` - number - port number, defaults to 6667 without TLS and 6697 with TLS -* `nick` - text or list of text - nicknames to try in order -* `username` - text - username -* `realname` - text - realname / GECOS -* `password` - text - server password -* `sasl-username` - text - SASL username -* `sasl-password` - text - SASL password -* `tls` - yes/yes-insecure/no - use TLS to connect (insecure mode disables certificate checks) -* `tls-client-cert` - text - path to TLS client certificate -* `tls-client-key` - text - path to TLS client key -* `connect-cmds` - list of text - client commands to send upon connection -* `socks-host` - text - hostname of SOCKS proxy to connect through -* `socks-port` - number - port number of SOCKS proxy to connect through -* `server-certificates` - list of text - list of CA certificates to use when validating certificates -* `chanserv-channels` - list of text - list of channels with chanserv op permission -* `flood-penalty` - number - cost in seconds per message -* `flood-threshold` - number - threshold of seconds for burst -* `message-hooks` - list of text - names of hooks to enable +| setting | type | description | +|-----------------------|----------------------|----------------------------------------------------------------| +| `name` | text | name of server entry, defaults to `hostname` | +| `hostname` | text | hostname used to connect and to specify the server | +| `port` | number | port number, defaults to 6667 without TLS and 6697 with TLS | +| `nick` | text or list of text | nicknames to try in order | +| `username` | text | server username | +| `realname` | text | real name / GECOS | +| `password` | text | server password | +| `sasl-username` | text | SASL username | +| `sasl-password` | text | SASL password | +| `tls` | yes/yes-insecure/no | use TLS to connect (insecure mode disables certificate checks) | +| `tls-client-cert` | text | path to TLS client certificate | +| `tls-client-key` | text | path to TLS client key | +| `connect-cmds` | list of text | client commands to send upon connection | +| `socks-host` | text | hostname of SOCKS proxy to connect through | +| `socks-port` | number | port number of SOCKS proxy to connect through | +| `server-certificates` | list of text | list of CA certificates to use when validating certificates | +| `chanserv-channels` | list of text | list of channels with chanserv op permission | +| `flood-penalty` | number | cost in seconds per message | +| `flood-threshold` | number | threshold in seconds for burst | +| `message-hooks` | list of text | names of hooks to enable | Palette ------- -* `nick-colors` - List of attr - Use for nick highlights -* `self` - attr - attr of our own nickname(s) outside of mentions -* `self-highlight` - attr - attr of our own nickname(s) in mentions -* `time` - attr - attr for timestamp -* `meta` - attr - attr for metadata -* `sigil` - attr - attr for sigils -* `label` - attr - attr for information labels -* `latency` - attr - attr for latency time -* `error` - attr - attr for error messages -* `textbox` - attr - attr for textbox edges -* `window-name` - attr - attr for current window name -* `activity` - attr - attr for activity notification -* `mention` - attr - attr for mention notification -* `command` - attr - attr for recognized command -* `command-prefix` - attr - attr for prefix of known command -* `command-ready` - attr - attr for recognized command with arguments filled -* `command-placeholder` - attr - attr for command argument placeholder +| entry | type | description | +|-----------------------|--------------|------------------------------------------| +| `nick-colors` | list of attr | Use for nick highlights | +| `self` | attr | our own nickname(s) outside of mentions | +| `self-highlight` | attr | our own nickname(s) in mentions | +| `time` | attr | timestamp on messages | +| `meta` | attr | metadata (joins/parts/etc.) | +| `sigil` | attr | sigils (+@) | +| `label` | attr | information labels | +| `latency` | attr | latency time | +| `error` | attr | error messages | +| `textbox` | attr | textbox edges (^$) | +| `window-name` | attr | current window name | +| `activity` | attr | activity notification | +| `mention` | attr | mention notification | +| `command` | attr | recognized command | +| `command-prefix` | attr | prefix of known command | +| `command-ready` | attr | recognized command with arguments filled | +| `command-placeholder` | attr | command argument placeholder | +| `window-divider` | attr | the dividing line between split windows | Text Attributes --------------- @@ -253,6 +269,7 @@ * `/extension ` - Send the given params to the named extension * `/exec [-n network] [-c channel] ` - Execute a command, If no network or channel are provided send output to client window, if network and channel are provided send output as messages, if network is provided send output as raw IRC messages. * `/url [n]` - Execute url-opener on the nth URL in the current window (defaults to first) +* `/splits [focuses...]` - Enable split-screen view. Focuses should be space delimited list of NETWORK:CHANNEL Connection commands diff --git a/glirc.cabal b/glirc.cabal --- a/glirc.cabal +++ b/glirc.cabal @@ -1,5 +1,5 @@ name: glirc -version: 2.15 +version: 2.16 synopsis: Console IRC client description: Console IRC client license: ISC diff --git a/src/Client/Commands.hs b/src/Client/Commands.hs --- a/src/Client/Commands.hs +++ b/src/Client/Commands.hs @@ -45,9 +45,11 @@ import Control.Monad import Data.Foldable import Data.HashSet (HashSet) +import Data.List (nub) import Data.List.NonEmpty (NonEmpty((:|))) import Data.List.Split import qualified Data.HashMap.Strict as HashMap +import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as Text import Data.Monoid ((<>)) @@ -370,6 +372,7 @@ \When \^Bnumber\^B is omitted it defaults to \^B1\^B. The number selects the URL to open counting back from the most recent.\n" $ ClientCommand cmdUrl noClientTab ) + , ( pure "help" , Command (OptTokenArg "command" NoArg) "Show command documentation.\n\ @@ -379,6 +382,19 @@ $ ClientCommand cmdHelp tabHelp ) + , ( pure "splits" + , Command (RemainingArg "focuses") + "Set the extra message view splits.\n\ + \\n\ + \\^Bfocues\^B: space delimited list of focus names.\n\ + \\n\ + \Client: *\n\ + \Network: \^BNETWORK\^B\n\ + \Channel: \^BNETWORK\^B:\^B#CHANNEL\^B\n\ + \User: \^BNETWORK\^B:\^BNICK\^B\n" + $ ClientCommand cmdSplits tabSplits + ) + -- -- Network commands -- @@ -824,6 +840,38 @@ cmdHelp st mb = commandSuccess (changeSubfocus focus st) where focus = FocusHelp (fmap (Text.pack . fst) mb) + +-- | Tab completion for @/splits@ +tabSplits :: Bool -> ClientCommand String +tabSplits isReversed st rest + | all (' '==) rest = + do let cmd = "/splits " ++ unwords (Text.unpack . render <$> currentExtras) + newline = Edit.endLine cmd + commandSuccess (set (clientTextBox . Edit.line) newline st) + + | otherwise = simpleTabCompletion id [] completions isReversed st + where + currentExtras = view clientExtraFocus st + + completions = map render + $ Map.keys + $ view clientWindows st + + render Unfocused = "*" + render (NetworkFocus x) = x + render (ChannelFocus x y) = x <> ":" <> idText y + +-- | Implementation of @/splits@ +cmdSplits :: ClientCommand String +cmdSplits st str = commandSuccess (set clientExtraFocus extras st) + where + extras = nub (map toFocus (words str)) + + toFocus x = + case break (==':') x of + ("*","") -> Unfocused + (net,"") -> NetworkFocus (Text.pack net) + (net,_:chan) -> ChannelFocus (Text.pack net) (mkId (Text.pack chan)) tabHelp :: Bool -> ClientCommand String tabHelp isReversed st _ = simpleTabCompletion id [] commandNames isReversed st diff --git a/src/Client/Image.hs b/src/Client/Image.hs --- a/src/Client/Image.hs +++ b/src/Client/Image.hs @@ -11,11 +11,14 @@ -} module Client.Image (clientPicture) where +import Client.Image.Palette import Client.Image.StatusLine import Client.Image.Textbox import Client.State +import Client.State.Focus import Client.View import Control.Lens +import Data.List import Graphics.Vty (Background(..), Picture(..), Cursor(..)) import Graphics.Vty.Image @@ -34,16 +37,34 @@ clientImage :: ClientState -> (Int, Image, ClientState) -- ^ text box cursor position, image, updated state -clientImage st = (pos, img, st') +clientImage st = (pos, img, st'') where - (mp, st') = messagePane st - (pos, tbImg) = textboxImage st' - img = mp <-> statusLineImage st' <-> tbImg + (st', mp) = messagePane mainHeight focus (view clientSubfocus st) st + (st'', extras) = mapAccumL renderExtra st' splits -messagePane :: ClientState -> (Image, ClientState) -messagePane st = (img, st') + (pos, tbImg) = textboxImage st'' + img = vertCat extras <-> + mp <-> + statusLineImage st'' <-> + tbImg + + focus = view clientFocus st + + (mainHeight, splitHeight) = clientWindowHeights st + splits = clientExtraFocuses st + + renderExtra stIn focus1 = (stOut, outImg) + where + (stOut,msgImg) = messagePane splitHeight focus1 FocusMessages stIn + pal = clientPalette st + divider = view palWindowDivider pal + outImg = msgImg <-> minorStatusLineImage focus1 st + <-> charFill divider ' ' (view clientWidth st) 1 + +messagePane :: Int -> Focus -> Subfocus -> ClientState -> (ClientState, Image) +messagePane h focus subfocus st = (st', img) where - images = viewLines st + images = viewLines focus subfocus st vimg = assemble emptyImage images vimg1 = cropBottom h vimg img = pad 0 (h - imageHeight vimg1) 0 0 vimg1 @@ -59,11 +80,6 @@ scroll = view clientScroll st vh = h + scroll - reservedLines - | view clientActivityBar st = 3 - | otherwise = 2 - - h = view clientHeight st - reservedLines w = view clientWidth st lineWrap :: Int -> Image -> Image diff --git a/src/Client/Image/Palette.hs b/src/Client/Image/Palette.hs --- a/src/Client/Image/Palette.hs +++ b/src/Client/Image/Palette.hs @@ -32,6 +32,7 @@ , palCommandPlaceholder , palCommandPrefix , palCommandError + , palWindowDivider , paletteMap @@ -64,6 +65,7 @@ , _palCommandPrefix :: Attr -- ^ prefix of known command , _palCommandError :: Attr -- ^ unknown command , _palCommandPlaceholder :: Attr -- ^ command argument placeholder + , _palWindowDivider :: Attr -- ^ Divider between split windows } deriving Show @@ -90,6 +92,7 @@ , _palCommandPrefix = withForeColor defAttr blue , _palCommandError = withForeColor defAttr red , _palCommandPlaceholder = withStyle defAttr reverseVideo + , _palWindowDivider = withStyle defAttr reverseVideo } -- | Default nick highlighting colors that look nice in my dark solarized @@ -119,4 +122,5 @@ , ("command-placeholder", Lens palCommandPlaceholder) , ("command-prefix" , Lens palCommandPrefix) , ("command-error" , Lens palCommandError) + , ("window-divider" , Lens palWindowDivider) ] 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 @@ -1,3 +1,4 @@ +{-# Language BangPatterns #-} {-| Module : Client.Image.StatusLine Description : Renderer for status line @@ -12,6 +13,7 @@ -} module Client.Image.StatusLine ( statusLineImage + , minorStatusLineImage ) where import Client.Image.Palette @@ -47,15 +49,19 @@ , latencyImage st ] +minorStatusLineImage :: Focus -> ClientState -> Image +minorStatusLineImage focus st = + content <|> charFill defAttr '─' fillSize 1 + where + content = infoBubble (focusImageMajor focus st) + fillSize = max 0 (view clientWidth st - imageWidth content) + scrollImage :: ClientState -> Image scrollImage st | 0 == view clientScroll st = emptyImage - | otherwise = horizCat - [ string defAttr "─(" - , string attr "scroll" - , string defAttr ")" - ] + | otherwise = infoBubble + $ string attr "scroll" where pal = clientPalette st attr = view palLabel pal @@ -168,7 +174,6 @@ Just cs -> string (view palSigil pal) myChanModes <|> text' defAttr (idText nick) <|> parens defAttr (string defAttr ('+' : view csModes cs)) - <|> char defAttr '─' where nick = view csNick cs myChanModes = @@ -178,57 +183,47 @@ focusImage :: ClientState -> Image -focusImage st = parens defAttr majorImage <|> renderedSubfocus +focusImage st = + infoBubble (focusImageMajor focus st) <|> + foldMap infoBubble (viewSubfocusLabel pal subfocus) where - majorImage = horizCat - [ char (view palWindowName pal) windowName - , char defAttr ':' - , renderedFocus - ] - pal = clientPalette st + !pal = clientPalette st focus = view clientFocus st + subfocus = view clientSubfocus st + +focusImageMajor :: Focus -> ClientState -> Image +focusImageMajor focus st = + horizCat + [ char (view palWindowName pal) windowName + , char defAttr ':' + , viewFocusLabel st focus + ] + where + !pal = clientPalette st windowNames = clientWindowNames st windowName = fromMaybe '?' $ do i <- Map.lookupIndex focus (view clientWindows st) preview (ix i) windowNames - subfocusName = - case view clientSubfocus st of - FocusMessages -> Nothing - FocusWindows -> Just $ string (view palLabel pal) "windows" - FocusInfo -> Just $ string (view palLabel pal) "info" - FocusUsers -> Just $ string (view palLabel pal) "users" - FocusMentions -> Just $ string (view palLabel pal) "mentions" - FocusPalette -> Just $ string (view palLabel pal) "palette" - FocusHelp mb -> Just $ string (view palLabel pal) "help" <|> - foldMap (\cmd -> char defAttr ':' <|> - text' (view palLabel pal) cmd) mb - FocusMasks m -> Just $ horizCat - [ string (view palLabel pal) "masks" - , char defAttr ':' - , char (view palLabel pal) m - ] - renderedSubfocus = - foldMap (\name -> horizCat - [ string defAttr "─(" - , name - , char defAttr ')' - ]) subfocusName +parens :: Attr -> Image -> Image +parens attr i = char attr '(' <|> i <|> char attr ')' - renderedFocus = - case focus of - Unfocused -> - char (view palError pal) '*' - NetworkFocus network -> - text' (view palLabel pal) network - ChannelFocus network channel -> - text' (view palLabel pal) network <|> - char defAttr ':' <|> - text' (view palLabel pal) (idText channel) <|> - channelModesImage network channel st +viewFocusLabel :: ClientState -> Focus -> Image +viewFocusLabel st focus = + let !pal = clientPalette st in + case focus of + Unfocused -> + char (view palError pal) '*' + NetworkFocus network -> + text' (view palLabel pal) network + ChannelFocus network channel -> + text' (view palLabel pal) network <|> + char defAttr ':' <|> + text' (view palLabel pal) (idText channel) <|> + channelModesImage network channel st channelModesImage :: Text -> Identifier -> ClientState -> Image channelModesImage network channel st = @@ -239,5 +234,20 @@ where (modes,args) = unzip (Map.toList modeMap) _ -> emptyImage -parens :: Attr -> Image -> Image -parens attr i = char attr '(' <|> i <|> char attr ')' +viewSubfocusLabel :: Palette -> Subfocus -> Maybe Image +viewSubfocusLabel pal subfocus = + case subfocus of + FocusMessages -> Nothing + FocusWindows -> Just $ string (view palLabel pal) "windows" + FocusInfo -> Just $ string (view palLabel pal) "info" + FocusUsers -> Just $ string (view palLabel pal) "users" + FocusMentions -> Just $ string (view palLabel pal) "mentions" + FocusPalette -> Just $ string (view palLabel pal) "palette" + FocusHelp mb -> Just $ string (view palLabel pal) "help" <|> + foldMap (\cmd -> char defAttr ':' <|> + text' (view palLabel pal) cmd) mb + FocusMasks m -> Just $ horizCat + [ string (view palLabel pal) "masks" + , char defAttr ':' + , char (view palLabel pal) m + ] diff --git a/src/Client/State.hs b/src/Client/State.hs --- a/src/Client/State.hs +++ b/src/Client/State.hs @@ -24,6 +24,7 @@ , clientEvents , clientVty , clientFocus + , clientExtraFocus , clientConnectionContext , clientConfig , clientScroll @@ -60,6 +61,9 @@ , clientWindowNames , clientPalette + , clientExtraFocuses + , clientWindowHeights + -- * Add messages to buffers , recordChannelMessage , recordNetworkMessage @@ -110,6 +114,7 @@ import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.IntMap (IntMap) +import Data.List import Data.Maybe import Data.Map (Map) import qualified Data.Map as Map @@ -136,6 +141,7 @@ , _clientPrevFocus :: !Focus -- ^ previously focused buffer , _clientFocus :: !Focus -- ^ currently focused buffer , _clientSubfocus :: !Subfocus -- ^ sec + , _clientExtraFocus :: ![Focus] -- ^ extra messages windows to view , _clientConnections :: !(IntMap NetworkState) -- ^ state of active connections , _clientNextConnectionId :: !Int @@ -222,6 +228,7 @@ , _clientPrevFocus = Unfocused , _clientFocus = Unfocused , _clientSubfocus = FocusMessages + , _clientExtraFocus = [] , _clientConnectionContext = cxt , _clientConfig = cfg , _clientScroll = 0 @@ -457,14 +464,18 @@ clientTick = set clientBell False . markSeen --- | Mark the messages on the current window as seen. +-- | Mark the messages on the current window (and any splits) as seen. markSeen :: ClientState -> ClientState markSeen st = case view clientSubfocus st of - FocusMessages -> - overStrict (clientWindows . ix (view clientFocus st)) windowSeen st + FocusMessages -> foldl' aux st focuses _ -> st + where + aux acc focus = overStrict (clientWindows . ix focus) windowSeen acc + focuses = view clientFocus st + : view clientExtraFocus st + -- | Add the textbox input to the edit history and clear the textbox. consumeInput :: ClientState -> ClientState consumeInput = over clientTextBox Edit.success @@ -474,8 +485,10 @@ currentCompletionList st = case view clientFocus st of NetworkFocus network -> networkChannelList network st - ChannelFocus network chan -> networkChannelList network st - ++ channelUserList network chan st + ChannelFocus network chan -> + chan -- might be a disconnected channel or a private chat + : networkChannelList network st + ++ channelUserList network chan st _ -> [] networkChannelList :: @@ -653,7 +666,40 @@ -- | Compute the number of lines in a page at the current window size scrollAmount :: ClientState -> Int -scrollAmount st = max 1 (view clientHeight st - 2) +scrollAmount st = max 1 (min main extra) + where + (main,extra) = clientWindowHeights st + + + + +-- | List of extra focuses to display as split windows +clientExtraFocuses :: ClientState -> [Focus] +clientExtraFocuses st = + case view clientSubfocus st of + FocusMessages -> view clientFocus st `delete` view clientExtraFocus st + _ -> [] + +-- | Number of lines to allocate for the focused window and the +-- main window. This doesn't include the textbox, activity bar, +-- or status line. +clientWindowHeights :: + ClientState {- ^ client state -} -> + (Int,Int) {- ^ main height, extra height -} +clientWindowHeights st = (max 0 (h - overhead - extras*d), max 0 (d-overhead)) + where + d = h `quot` (1 + extras) + + h = max 0 (view clientHeight st - reservedLines) -- lines available + + extras = length (clientExtraFocuses st) + + overhead = 2 -- status line and textbox/divider + + reservedLines + | view clientActivityBar st = 1 -- activity bar + | otherwise = 0 + ------------------------------------------------------------------------ diff --git a/src/Client/View.hs b/src/Client/View.hs --- a/src/Client/View.hs +++ b/src/Client/View.hs @@ -26,9 +26,9 @@ import Control.Lens import Graphics.Vty.Image -viewLines :: ClientState -> [Image] -viewLines !st = - case (view clientFocus st, view clientSubfocus st) of +viewLines :: Focus -> Subfocus -> ClientState -> [Image] +viewLines focus subfocus !st = + case (focus, subfocus) of (ChannelFocus network channel, FocusInfo) -> channelInfoImages network channel st (ChannelFocus network channel, FocusUsers) @@ -41,6 +41,6 @@ (_, FocusPalette) -> paletteViewLines pal (_, FocusHelp mb) -> helpImageLines mb pal - _ -> chatMessageImages st + _ -> chatMessageImages focus st where pal = clientPalette st diff --git a/src/Client/View/Mentions.hs b/src/Client/View/Mentions.hs --- a/src/Client/View/Mentions.hs +++ b/src/Client/View/Mentions.hs @@ -14,76 +14,63 @@ ( mentionsViewLines ) where -import Client.Image.Palette +import Client.Image.StatusLine import Client.State import Client.State.Focus import Client.State.Window import qualified Data.Map as Map import Control.Lens -import Data.Text (Text) import Data.Time (UTCTime) -import Irc.Identifier (idText) import Graphics.Vty.Image -- | Generate the list of message lines marked important ordered by -- time. Each run of lines from the same channel will be grouped -- together. Messages are headed by their window, network, and channel. mentionsViewLines :: ClientState -> [Image] -mentionsViewLines st = addMarkers pal entries +mentionsViewLines st = addMarkers st entries where - pal = clientPalette st - names = clientWindowNames st ++ repeat '?' detail = view clientDetailView st entries = merge - [windowEntries detail n net (idText chan) v - | (n,(ChannelFocus net chan, v)) + [windowEntries detail n focus v + | (n,(focus, v)) <- names `zip` Map.toList (view clientWindows st) ] data MentionLine = MentionLine { mlTimestamp :: UTCTime , mlWindowName :: Char - , mlNetwork :: Text - , mlChannel :: Text + , mlFocus :: Focus , mlImage :: Image } addMarkers :: - Palette {- ^ palette -} -> + ClientState {- ^ client state -} -> [MentionLine] {- ^ list of mentions in time order -} -> [Image] {- ^ mention images and channel labels -} addMarkers _ [] = [] -addMarkers !pal (!ml : xs) = - mlImage ml : map mlImage same ++ windowMarker : addMarkers pal rest +addMarkers !st (!ml : xs) + = map mlImage (ml:same) + ++ minorStatusLineImage (mlFocus ml) st + : addMarkers st rest where - isSame ml' = mlWindowName ml == mlWindowName ml' - && mlNetwork ml == mlNetwork ml' - && mlChannel ml == mlChannel ml' + isSame ml' = mlFocus ml == mlFocus ml' (same,rest) = span isSame xs - windowMarker = char (view palWindowName pal) (mlWindowName ml) <|> - char defAttr ':' <|> - text' (view palLabel pal) (mlNetwork ml) <|> - char defAttr ':' <|> - text' (view palLabel pal) (mlChannel ml) - windowEntries :: Bool {- ^ detailed view -} -> Char {- ^ window name -} -> - Text {- ^ network name -} -> - Text {- ^ channel name -} -> + Focus {- ^ window focus -} -> Window {- ^ window -} -> [MentionLine] -windowEntries !detailed name net chan w = +windowEntries !detailed name focus w = [ MentionLine { mlTimestamp = view wlTimestamp l , mlWindowName = name - , mlNetwork = net - , mlChannel = chan + , mlFocus = focus , mlImage = if detailed then view wlFullImage l else view wlImage l } | l <- view winMessages w 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 @@ -17,6 +17,7 @@ import Client.Image.Palette import Client.Image.Message import Client.State +import Client.State.Focus import Client.State.Network import Client.State.Window import Client.Message @@ -24,14 +25,14 @@ import Irc.Identifier import Graphics.Vty.Image -chatMessageImages :: ClientState -> [Image] -chatMessageImages st = windowLineProcessor focusedMessages +chatMessageImages :: Focus -> ClientState -> [Image] +chatMessageImages focus st = windowLineProcessor focusedMessages where matcher = clientMatcher st focusedMessages = filter (views wlText matcher) - $ view (clientWindows . ix (view clientFocus st) . winMessages) st + $ view (clientWindows . ix focus . winMessages) st windowLineProcessor