glirc 2.15 → 2.16

raw patch · 11 files changed

+291/−158 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• README.md +74/−57
• glirc.cabal +1/−1
• src/Client/Commands.hs +48/−0
• src/Client/Image.hs +28/−12
• src/Client/Image/Palette.hs +4/−0
• src/Client/Image/StatusLine.hs +58/−48
• src/Client/State.hs +52/−6
• src/Client/View.hs +4/−4
• src/Client/View/Mentions.hs +14/−27
• src/Client/View/Messages.hs +4/−3

@@ -1,5 +1,9 @@ # Revision history for glirc2 +## 2.16++* Add `/splits` to show multiple chat windows simultaneously+ ## 2.15  * Add `/mentions`

@@ -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 <extension name> <params...>` - Send the given params to the named extension * `/exec [-n network] [-c channel] <command> <arguments...>` - 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 

@@ -1,5 +1,5 @@ name:                glirc-version:             2.15+version:             2.16 synopsis:            Console IRC client description:         Console IRC client license:             ISC

@@ -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

@@ -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

@@ -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)   ]

@@ -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+      ]

@@ -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+   ------------------------------------------------------------------------

@@ -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

@@ -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

@@ -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