glirc 2.40.1 → 2.41

raw patch · 46 files changed

+1434/−635 lines, 46 filesdep ~basedep ~hashabledep ~irc-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, hashable, irc-core, lens, network, template-haskell, time, vty

API changes (from Hackage documentation)

Files

• ChangeLog.md +16/−0
• doc/cmds_chanop.adoc +55/−0
• doc/cmds_client.adoc +30/−3
• doc/cmds_oper.adoc +56/−3
• doc/cmds_queries.adoc +3/−3
• doc/cmds_window.adoc +3/−0
• exec/Main.hs +2/−1
• glirc.cabal +16/−12
• src/Client/Commands.hs +180/−88
• src/Client/Commands/Arguments/Parser.hs +1/−0
• src/Client/Commands/Arguments/Renderer.hs +2/−0
• src/Client/Commands/Arguments/Spec.hs +5/−0
• src/Client/Commands/Channel.hs +76/−25
• src/Client/Commands/Chat.hs +67/−20
• src/Client/Commands/Exec.hs +1/−1
• src/Client/Commands/Help.hs +222/−0
• src/Client/Commands/Operator.hs +36/−8
• src/Client/Commands/Queries.hs +13/−19
• src/Client/Commands/Types.hs +25/−6
• src/Client/Commands/Window.hs +49/−53
• src/Client/Configuration.hs +3/−3
• src/Client/Docs.hs +14/−4
• src/Client/EventLoop.hs +3/−4
• src/Client/EventLoop/Network.hs +1/−1
• src/Client/Hook/Snotice.hs +7/−7
• src/Client/Image/Focus.hs +86/−0
• src/Client/Image/Message.hs +9/−0
• src/Client/Image/PackedImage.hs +19/−5
• src/Client/Image/Palette.hs +4/−0
• src/Client/Image/StatusLine.hs +88/−127
• src/Client/Image/Textbox.hs +3/−2
• src/Client/Message.hs +13/−4
• src/Client/Network/Async.hs +8/−0
• src/Client/State.hs +28/−7
• src/Client/State/Channel.hs +10/−6
• src/Client/State/Focus.hs +48/−9
• src/Client/State/Help.hs +76/−0
• src/Client/State/Network.hs +30/−12
• src/Client/State/Target.hs +51/−0
• src/Client/State/Url.hs +4/−4
• src/Client/State/Window.hs +1/−1
• src/Client/View.hs +21/−21
• src/Client/View/ChannelList.hs +2/−2
• src/Client/View/Help.hs +0/−152
• src/Client/View/WindowSwitch.hs +40/−0
• src/Client/View/Windows.hs +7/−22

@@ -1,5 +1,21 @@ # Revision history for glirc +## 2.41++* glirc now requests the `extended-monitor`, `invite-notify`, and `message-tags` capabilities+* Add `/in` to run commands and macros on windows other than the focused one+* Add ChanServ-aware `/op`, `/deop`, `/quiet`, `/voice`, and `/devoice`+* Add `/dline`, `/resv`, `/xline`, and remote `/kline`+* Add server-side help and macro expansions to `/help`+* Retain channel metadata for channels glirc isn't joined to. `/clear` removes stale metadata+* Tidier status line+* Show window list while typing `/c` commands+* `jumpToActivity` (`M-a`) now prioritizes named windows+* Improve routing and display of `INVITE` and `MONITOR`-related messages+* Automatically split overlong `/join` commands+* Improve connection reliability when sending very large numbers of messages+* Build on GHC 9.10+ ## 2.40.1  * Fix exception on /exec with a non-zero exit code

@@ -1,14 +1,48 @@ = Channel Management Commands :toc: +== /op++Grant channel operator privileges to yourself or another user.++Sends an OP command to ChanServ if you are not opped and+the current channel is in your configured `chanserv-channels`.++== /deop++Remove channel operator privileges from yourself or another user.++Sends a DEOP command to ChanServ if you are not opped and+the current channel is in your configured `chanserv-channels`.++== /voice++Grant voice to yourself or another user.++Sends a VOICE command to ChanServ if you are not opped and+the current channel is in your configured `chanserv-channels`.++== /devoice++Remove voice from yourself or another user.++Sends a DEVOICE command to ChanServ if you are not opped and+the current channel is in your configured `chanserv-channels`.+ == /invite  Invite a user to the current channel. +Can acquire operator status from ChanServ if the current channel is in+your configured `chanserv-channels`.+ == /kick  Kick a user from the current channel. +Can acquire operator status from ChanServ if the current channel is in+your configured `chanserv-channels`.+ See also: kickban, remove  == /kickban@@ -17,6 +51,9 @@  Users are banned by hostname match. +Can acquire operator status from ChanServ if the current channel is in+your configured `chanserv-channels`.+ See also: kick, remove  == /masks@@ -39,6 +76,9 @@  This command has parameter sensitive tab-completion. +Can acquire operator status from ChanServ if the current channel is in+your configured `chanserv-channels`.+ See also: masks, channelinfo  === Examples@@ -49,6 +89,18 @@ `+/mode +vv user1 user2+`  - Voice two users + `+/mode +v-o user1 user1+` - Demote an op to voice +== /quiet++Quiet a user, preventing them from speaking unless voiced.++This command only works on networks that have+channel mode `q` as a list mode (e.g. Charybdis/Solanum-based networks).+Some networks implement this functionality as an extban,+which is not supported by this command.++Can acquire operator status from ChanServ if the current channel is in+your configured `chanserv-channels`.+ == /remove  Remove a user from the current channel.@@ -57,6 +109,9 @@  Not all servers support removal in this manner. Refer to your server/network's documentation.++Can acquire operator status from ChanServ if the current channel is in+your configured `chanserv-channels`.  See also: kick, kickban 

@@ -12,6 +12,22 @@ If `filename` is provided it will be used to reload. Otherwise the previously loaded configuration file will be reloaded. +== /in++Execute a command on a window other than the current one.++`focus` is the name of a window as would be used with the `channel` command.++`command` is the name of a command or macro followed by its arguments.+Macro expansions will be resolved as if `focus` was the current focus.++See also: channel++=== Examples++`+/in libera: list+` ++`+/in #glirc setwindow louder+`+ == /extension  Run a command provided by an extension.@@ -81,8 +97,19 @@  == /help -Show command documentation.+Show documentation. -When `command` is omitted, a list of all commands and macros is shown.-When `command` is specified, detailed help for that command is shown.+When `topic` is omitted, a list of all commands and macros is shown. +When `topic` contains a colon, sends the portion after the first colon+as a `+HELP+` message to the network specified before the first colon+(or the currently-focused network if empty), then shows the result.++Otherwise, interprets `topic` as a command name and shows its documentation.++=== Examples++`+/help+`+`+/help c+`+`+/help :index+`+`+/help libera:accept+`

@@ -13,22 +13,70 @@  Ban a client from the server. +Specify "on" to set bans on remote servers.++This command is intended for Charybdis/Solanum servers.+Refer to your IRCd's documentation before using it.++See also: unkline++== /dline++Ban an IP address from the server.++Specify "on" to set bans on remote servers.++This command is intended for Charybdis/Solanum servers.+Refer to your IRCd's documentation before using it.++See also: undline++== /xline++Ban a gecos from the server.++Specify "on" to set bans on remote servers.++This command is intended for Charybdis/Solanum servers.+Refer to your IRCd's documentation before using it.++See also: unxline++== /resv++Ban a channel or nickname from the server.++Specify "on" to set bans on remote servers.++This command is intended for Charybdis/Solanum servers.+Refer to your IRCd's documentation before using it.++See also: unresv+ == /unkline  Unban a client from the server. +See also: kline+ == /undline -Unban a client from the server.+Unban an IP address from the server. +See also: dline+ == /unxline  Unban a gecos from the server. +See also: xline+ == /unresv  Unban a channel or nickname from the server. +See also: resv+ == /testline  Check matching I/K/D lines for a `[[nick!]user@]host`.@@ -55,11 +103,16 @@  == /trace -Outputs a list users on a server.+Outputs a list of users on a server. +See also: etrace+ == /etrace -Outputs a list users on a server.+Outputs a list of users on a server,+including the contents of the USER messages they sent during registration.++See also: trace  == /map 

@@ -65,10 +65,10 @@ on larger networks, this may take several seconds to complete. The view may be exited while loading. -`clientarg` is an optionally-comma-separated list of options.+`clientopts` is an optionally-comma-separated list of options. A single comma may be used to denote an empty list. -`serverarg` is sent as-is to the server.+`elist` is sent as-is to the server. It is generally used as the ELIST parameter to LIST. glirc does not validate this parameter against the ELIST ISUPPORT token. @@ -83,7 +83,7 @@ `+/list+`          - List public channels. `+/list >99+`      - List public channels with at least 100 users. `+/list >50<1000+` - List public channels with between 51 and 999 users.-`+/list ~ <20+`    - List public channels with fewer than 20 users. +`+/list ~ <20+`    - List public channels with fewer than 20 users. `+/list , *-ops+`  - List public channels whose names end with "-ops".  == /links

@@ -5,6 +5,9 @@  Set the current focused window. +When the `+/c+` alias is used,+shows a list of applicable window names while typing the argument.+ See also: focus  === Examples

@@ -85,7 +85,8 @@ -- | Generate the initial 'Vty' value and enable the features glirc uses. buildVty :: IO Vty buildVty =- do vty <- mkVty defaultConfig+ do cfg <- userConfig+    vty <- mkVty cfg     setMode (outputIface vty) BracketedPaste True     setMode (outputIface vty) Focus True     pure vty

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                glirc-version:             2.40.1+version:             2.41 synopsis:            Console IRC client description:         Console IRC client                      .@@ -19,10 +19,10 @@ extra-doc-files:     glirc.1 ChangeLog.md README.md doc/*.adoc homepage:            https://github.com/glguy/irc-core bug-reports:         https://github.com/glguy/irc-core/issues-tested-with:         GHC == 9.0.2, GHC == 9.4.7, GHC == 9.8.1+tested-with:         GHC == 9.0.2, GHC == 9.4.8, GHC == 9.8.2  custom-setup-  setup-depends: base     >=4.12 && <4.20,+  setup-depends: base     >=4.12 && <4.21,                  filepath >=1.4  && <1.6,                  Cabal    >=2.2  && <4 @@ -78,6 +78,7 @@     Client.Commands.Connection     Client.Commands.Docs     Client.Commands.Exec+    Client.Commands.Help     Client.Commands.Interpolation     Client.Commands.Operator     Client.Commands.Queries@@ -106,6 +107,7 @@     Client.Hook.Znc.Buffextras     Client.Hooks     Client.Image+    Client.Image.Focus     Client.Image.Layout     Client.Image.LineWrap     Client.Image.Message@@ -126,7 +128,9 @@     Client.State.EditBox.Content     Client.State.Extensions     Client.State.Focus+    Client.State.Help     Client.State.Network+    Client.State.Target     Client.State.Url     Client.State.Window     Client.UserHost@@ -136,7 +140,6 @@     Client.View.ChannelList     Client.View.ChannelInfo     Client.View.Digraphs-    Client.View.Help     Client.View.IgnoreList     Client.View.KeyMap     Client.View.MaskList@@ -148,6 +151,7 @@     Client.View.UserList     Client.View.Who     Client.View.Windows+    Client.View.WindowSwitch    other-modules:     ContextFilter@@ -165,7 +169,7 @@     Build_glirc    build-depends:-    base                 >=4.15   && <4.20,+    base                 >=4.15   && <4.21,     HsOpenSSL            >=0.11   && <0.12,     async                >=2.2    && <2.3,     attoparsec           ^>=0.14,@@ -179,27 +183,27 @@     filepath             >=1.4.1  && <1.6,     free                 >=4.12   && <5.3,     githash              ^>=0.1.6,-    hashable             >=1.2.4  && <1.5,+    hashable             >=1.2.4  && <1.6,     hookup               ^>=0.8,-    irc-core             ^>=2.12,+    irc-core             ^>=2.13,     kan-extensions       >=5.0    && <5.3,-    lens                 >=4.14   && <5.3,+    lens                 >=4.14   && <5.4,     random               >=1.1    && <1.3,-    network              >=2.6.2  && <3.2,+    network              >=2.6.2  && <3.3,     typed-process        ^>=0.2.10,     psqueues             >=0.2.7  && <0.3,     regex-tdfa           >=1.3.1  && <1.4,     semigroupoids        >=5.1    && <6.1,     split                >=0.2    && <0.3,     stm                  >=2.4    && <2.6,-    template-haskell     >=2.11   && <2.22,+    template-haskell     >=2.11   && <2.23,     text                 >=1.2.2  && <2.2,-    time                 >=1.9    && <1.14,+    time                 >=1.9    && <1.15,     transformers         >=0.5.2  && <0.7,     unix                 >=2.7    && <2.9,     unordered-containers >=0.2.11 && <0.3,     vector               >=0.11   && <0.14,-    vty                  ^>=6.1,+    vty                  ^>=6.2,  test-suite test   type:                exitcode-stdio-1.0

@@ -1,15 +1,15 @@-{-# LANGUAGE BangPatterns, OverloadedStrings, TemplateHaskell, ExistentialQuantification #-}+    {-# LANGUAGE BangPatterns, OverloadedStrings, TemplateHaskell, ExistentialQuantification #-} -{-|-Module      : Client.Commands-Description : Implementation of slash commands-Copyright   : (c) Eric Mertens, 2016-License     : ISC-Maintainer  : emertens@gmail.com+    {-|+    Module      : Client.Commands+    Description : Implementation of slash commands+    Copyright   : (c) Eric Mertens, 2016+    License     : ISC+    Maintainer  : emertens@gmail.com -This module renders the lines used in the channel mask list. A mask list-can show channel bans, quiets, invites, and exceptions.--}+    This module renders the lines used in the channel mask list. A mask list+    can show channel bans, quiets, invites, and exceptions.+    -}  module Client.Commands   ( CommandResult(..)@@ -26,16 +26,17 @@   ) where  import Client.Commands.Arguments.Parser (parse)-import Client.Commands.Arguments.Spec (optionalArg, optionalNumberArg, remainingArg, simpleToken)+import Client.Commands.Arguments.Spec (optionalArg, optionalNumberArg, remainingArg, simpleToken, extensionArg, mapArgEnv, Args) import Client.Commands.Docs (clientDocs, cmdDoc) import Client.Commands.Exec-import Client.Commands.Interpolation (resolveMacroExpansions, Macro(Macro), MacroSpec(MacroSpec))+import Client.Commands.Interpolation (resolveMacroExpansions, Macro(Macro), MacroSpec(MacroSpec), ExpansionChunk) import Client.Commands.Recognizer (fromCommands, keys, recognize, Recognition(Exact), Recognizer) import Client.Commands.WordCompletion (caseText, plainWordCompleteMode, wordComplete) import Client.Configuration import Client.State import Client.State.Extensions (clientCommandExtension, clientStartExtensions) import Client.State.Focus+import Client.State.Help (hsQuery, helpQueryToText) import Client.State.Network (csNick, isChannelIdentifier, sendMsg) import Client.State.Url import Control.Applicative (liftA2, (<|>))@@ -43,6 +44,7 @@ import Control.Lens import Control.Monad (guard, foldM) import Data.Foldable (foldl', toList)+import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as Text import Data.Time (getZonedTime)@@ -57,13 +59,15 @@ import Client.Commands.Channel (channelCommands) import Client.Commands.Chat (chatCommands, chatCommand', executeChat) import Client.Commands.Connection (connectionCommands)+import Client.Commands.Help (cmdHelp) import Client.Commands.Operator (operatorCommands) import Client.Commands.Queries (queryCommands) import Client.Commands.TabCompletion import Client.Commands.Toggles (togglesCommands) import Client.Commands.Types-import Client.Commands.Window (windowCommands)+import Client.Commands.Window (windowCommands, focusNames) import Client.Commands.ZNC (zncCommands)+import Data.Maybe (maybeToList)  -- | Interpret the given chat message or command. Leading @/@ indicates a -- command. Otherwise if a channel or user query is focused a chat message will@@ -78,7 +82,7 @@   case dropWhile (' '==) str of     []          -> commandFailure st     '/':command -> executeUserCommand Nothing command st'-    _           -> executeChat str st'+    _           -> executeChat (view clientFocus st') str st'  -- | Execute command provided by user, resolve aliases if necessary. --@@ -90,52 +94,70 @@   String           {- ^ command            -} ->   ClientState      {- ^ client state       -} ->   IO CommandResult {- ^ command result     -}-executeUserCommand discoTime command st = do-  let key = Text.takeWhile (/=' ') (Text.pack command)-      rest = dropWhile (==' ') (dropWhile (/=' ') command)+executeUserCommand = executeUserCommandIn Nothing -  case views (clientConfig . configMacros) (recognize key) st of-    Exact (Macro _ (MacroSpec spec) cmdExs) ->-      case doExpansion spec cmdExs rest of-        Nothing   -> commandFailureMsg "macro expansions failed" st-        Just cmds -> process cmds st-    _ -> executeCommand Nothing command st+executeMacro ::+  Maybe Focus ->+  Maybe Text ->+  [[ExpansionChunk]] ->+  ClientState ->+  [String] ->+  IO CommandResult+executeMacro focusOverride discoTime cmdExs st args =+  case traverse (resolveMacro (map Text.pack args)) cmdExs of+    Nothing -> commandFailureMsg "macro expansions failed" st+    Just cmds -> process cmds st   where-    doExpansion spec cmdExs rest =-      do args <- parse st spec rest-         traverse (resolveMacro (map Text.pack args)) cmdExs--    resolveMacro args = resolveMacroExpansions (commandExpansion discoTime st) (expandInt args)-+    resolveMacro args' = resolveMacroExpansions (commandExpansion focusOverride discoTime st) (expandInt args')     expandInt :: [a] -> Integer -> Maybe a-    expandInt args i = preview (ix (fromInteger i)) args---+    expandInt args' i = preview (ix (fromInteger i)) args'     process [] st0 = commandSuccess st0     process (c:cs) st0 =-      do res <- executeCommand Nothing (Text.unpack c) st0+      do res <- executeCommand Nothing focusOverride (Text.unpack c) st0          case res of            CommandSuccess st1 -> process cs st1            CommandFailure st1 -> process cs st1 -- ?            CommandQuit st1    -> return (CommandQuit st1) +-- | Execute command provided by user, resolve aliases if necessary,+-- optionally in the provided focus instead of the current one.+--+-- The last disconnection time is stored in text form and is available+-- for substitutions in macros. It is only provided when running startup+-- commands during a reconnect event.+executeUserCommandIn ::+  Maybe Focus      {- ^ focus override     -} ->+  Maybe Text       {- ^ disconnection time -} ->+  String           {- ^ command            -} ->+  ClientState      {- ^ client state       -} ->+  IO CommandResult {- ^ command result     -}+executeUserCommandIn focusOverride discoTime command st = do+  let key = Text.takeWhile (/=' ') (Text.pack command)+      rest = dropWhile (==' ') (dropWhile (/=' ') command)+  case views (clientConfig . configMacros) (recognize key) st of+    Exact (Macro _ (MacroSpec spec) cmdExs) ->+      case parse st spec rest of+        Nothing -> commandFailureMsg "bad macro arguments" st+        Just args -> executeMacro focusOverride discoTime cmdExs st args+    _ -> executeCommand Nothing focusOverride command st+ -- | Compute the replacement value for the given expansion variable. commandExpansion ::+  Maybe Focus {- ^ focus override     -} ->   Maybe Text  {- ^ disconnect time    -} ->   ClientState {- ^ client state       -} ->   Text        {- ^ expansion variable -} ->   Maybe Text  {- ^ expansion value    -}-commandExpansion discoTime st v =+commandExpansion focusOverride discoTime st v =   case v of-    "network" -> views clientFocus focusNetwork st-    "channel" -> previews (clientFocus . _ChannelFocus . _2) idText st-    "nick"    -> do net <- views clientFocus focusNetwork st+    "network" -> focusNetwork focus+    "channel" -> previews (_ChannelFocus . _2) idText focus+    "nick"    -> do net <- focusNetwork focus                     cs  <- preview (clientConnection net) st                     return (views csNick idText cs)     "disconnect" -> discoTime     _         -> Nothing-+  where focus = fromMaybe (view clientFocus st) focusOverride  -- | Respond to the TAB key being pressed. This can dispatch to a command -- specific completion mode when relevant. Otherwise this will complete@@ -146,65 +168,114 @@   IO CommandResult {- ^ command result -} tabCompletion isReversed st =   case dropWhile (' ' ==) $ snd $ clientLine st of-    '/':command -> executeCommand (Just isReversed) command st+    '/':command -> executeCommand (Just isReversed) Nothing command st     _           -> nickTabCompletion isReversed st ---- | Parse and execute the given command. When the first argument is Nothing--- the command is executed, otherwise the first argument is the cursor--- position for tab-completion-executeCommand ::-  Maybe Bool       {- ^ tab-completion direction -} ->-  String           {- ^ command                  -} ->-  ClientState      {- ^ client state             -} ->-  IO CommandResult {- ^ command result           -}+data ContextFreeCommand = forall a. ContextFreeCommand+  { cfCmdCtx  :: ArgsContext+  , cfCmdArgs :: Args ArgsContext a+  , cfCmdExec :: ClientState -> a -> IO CommandResult+  , cfCmdTab  :: Bool -> ClientState -> String -> IO CommandResult+  } -executeCommand (Just isReversed) _ st-  | Just st' <- commandNameCompletion isReversed st = commandSuccess st'+executeContextFreeCommand :: ContextFreeCommand -> Maybe Bool -> String -> IO CommandResult+executeContextFreeCommand ContextFreeCommand{cfCmdCtx=ctx, cfCmdArgs=spec, cfCmdExec=exec, cfCmdTab=tab} tabComplete args =+  case tabComplete of+    Just isReversed -> tab isReversed (argsContextSt ctx) args+    Nothing ->+      case parse ctx spec args of+        Nothing -> commandFailureMsg "bad command arguments" (argsContextSt ctx)+        Just arg -> exec (argsContextSt ctx) arg -executeCommand tabCompleteReversed str st =-  let (cmd, rest) = break (==' ') str-      cmdTxt      = Text.toLower (Text.pack cmd)+cfCmdAsArgs :: ContextFreeCommand -> Args ArgsContext (ClientState -> IO CommandResult)+cfCmdAsArgs ContextFreeCommand{cfCmdArgs=spec, cfCmdExec=exec} = fmap (flip exec) spec -      finish spec exec tab =-        case tabCompleteReversed of-          Just isReversed -> tab isReversed st rest-          Nothing ->-            case parse st spec rest of-              Nothing -> commandFailureMsg "bad command arguments" st-              Just arg -> exec st arg-  in-  case recognize cmdTxt commands of+-- | Look up a command or macro by name and return a @ContextFreeCommand@s.+prepareMacro :: Focus -> String -> ClientState -> Either Text ContextFreeCommand+prepareMacro focus cmd st =+  case views (clientConfig . configMacros) (recognize $ Text.pack cmd) st of+    Exact (Macro _ (MacroSpec args) chunks) -> Right $ ContextFreeCommand+      { cfCmdCtx=ArgsContext {argsContextSt=st, argsContextFocus=focus}+      , cfCmdArgs=args+      , cfCmdExec=executeMacro (Just focus) Nothing chunks+      , cfCmdTab=(\rev st' _ -> nickTabCompletion rev st')+      }+    _ -> prepareCommand focus cmd st +-- | Look up a command by name and return a @ContextFreeCommand@.+prepareCommand :: Focus -> String -> ClientState -> Either Text ContextFreeCommand+prepareCommand focus cmd st =+  case recognize (Text.toLower $ Text.pack cmd) commands of     Exact Command{cmdImplementation=impl, cmdArgumentSpec=argSpec} ->-      case impl of+      let+        cfCmd exec tab = Right $ ContextFreeCommand+          { cfCmdCtx=ArgsContext {argsContextSt=st, argsContextFocus=focus}+          , cfCmdArgs=argSpec+          , cfCmdExec=exec+          , cfCmdTab=tab+          }+      in case impl of         ClientCommand exec tab ->-          finish argSpec exec tab+          cfCmd exec tab +        WindowCommand exec tab ->+          cfCmd (exec focus) (`tab` focus)+         NetworkCommand exec tab-          | Just network <- views clientFocus focusNetwork st+          | Just network <- focusNetwork focus           , Just cs      <- preview (clientConnection network) st ->-              finish argSpec (exec cs) (\x -> tab x cs)-          | otherwise -> commandFailureMsg "command requires focused network" st+              cfCmd (exec cs) (`tab` cs)+          | otherwise -> Left "command requires focused network" +        MaybeChatCommand exec tab+          | Just cs <- maybeNetwork ->+              cfCmd (exec maybeChat cs) (\x -> tab x maybeChat cs)+          | otherwise -> Left "command requires focused network"+          where+            maybeChat+              | ChannelFocus _ channel <- focus = Just channel+              | otherwise = Nothing+            maybeNetwork = do+              network <- focusNetwork focus+              preview (clientConnection network) st+         ChannelCommand exec tab-          | ChannelFocus network channelId <- view clientFocus st+          | ChannelFocus network channelId <- focus           , Just cs <- preview (clientConnection network) st           , isChannelIdentifier cs channelId ->-              finish argSpec (exec channelId cs) (\x -> tab x channelId cs)-          | otherwise -> commandFailureMsg "command requires focused channel" st+              cfCmd (exec channelId cs) (\x -> tab x channelId cs)+          | otherwise -> Left "command requires focused channel"          ChatCommand exec tab-          | ChannelFocus network channelId <- view clientFocus st+          | ChannelFocus network channelId <- focus           , Just cs <- preview (clientConnection network) st ->-              finish argSpec (exec channelId cs) (\x -> tab x channelId cs)-          | otherwise -> commandFailureMsg "command requires focused chat window" st+              cfCmd (exec channelId cs) (\x -> tab x channelId cs)+          | otherwise -> Left "command requires focused chat window" -    _ -> case tabCompleteReversed of-           Just isReversed -> nickTabCompletion isReversed st-           Nothing         -> commandFailureMsg "unknown command" st+    _ -> Left "unknown command" +-- | Parse and execute the given command. When the first argument is Nothing+-- the command is executed, otherwise the first argument is the cursor+-- position for tab-completion+executeCommand ::+  Maybe Bool       {- ^ tab-completion direction -} ->+  Maybe Focus      {- ^ focus override           -} ->+  String           {- ^ command                  -} ->+  ClientState      {- ^ client state             -} ->+  IO CommandResult {- ^ command result           -} +executeCommand (Just isReversed) _ _ st+  | Just st' <- commandNameCompletion isReversed st = commandSuccess st'++executeCommand tabComplete focusOverride str st =+  let (cmd, args) = break (==' ') str+      focus       = fromMaybe (view clientFocus st) focusOverride+  in case prepareCommand focus cmd st of+    Right cfCmd -> executeContextFreeCommand cfCmd tabComplete args+    Left errmsg -> case tabComplete of+      Just isReversed -> nickTabCompletion isReversed st+      Nothing         -> commandFailureMsg errmsg st+ -- | Expands each alias to have its own copy of the command callbacks expandAliases :: [Command] -> [(Text,Command)] expandAliases xs =@@ -238,6 +309,12 @@     $ ClientCommand cmdReload tabReload    , Command+      (pure "in")+      (extensionArg "focus command" inArgs)+      $(clientDocs `cmdDoc` "in")+    $ ClientCommand cmdIn tabIn++  , Command       (pure "extension")       (liftA2 (,) (simpleToken "extension") (remainingArg "arguments"))       $(clientDocs `cmdDoc` "extension")@@ -283,9 +360,9 @@    , Command       (pure "help")-      (optionalArg (simpleToken "[command]"))+      (optionalArg (simpleToken "[topic]"))       $(clientDocs `cmdDoc` "help")-    $ ClientCommand cmdHelp tabHelp+    $ WindowCommand (cmdHelp commandsList commands) tabHelp    ------------------------------------------------------------------------   ],@@ -320,16 +397,11 @@        Just{}  -> commandSuccess $ set clientRtsStats mb                                  $ changeSubfocus FocusRtsStats st --- | Implementation of @/help@ command. Set subfocus to Help.-cmdHelp :: ClientCommand (Maybe String)-cmdHelp st mb = commandSuccess (changeSubfocus focus st)-  where-    focus = FocusHelp (fmap Text.pack mb)--tabHelp :: Bool -> ClientCommand String-tabHelp isReversed st _ =-  simpleTabCompletion plainWordCompleteMode [] commandNames isReversed st+tabHelp :: Bool -> WindowCommand String+tabHelp isReversed _ st _ =+  simpleTabCompletion plainWordCompleteMode cached commandNames isReversed st   where+    cached = maybeToList $ helpQueryToText $ view (clientHelp . hsQuery) st     commandNames = fst <$> expandAliases (concatMap cmdSectionCmds commandsList)  -- | Implementation of @/reload@@@ -480,3 +552,23 @@      case res of        Left e  -> commandFailureMsg (Text.pack (displayException (e :: IOError))) st        Right{} -> commandSuccess st++inArgs :: ArgsContext -> String -> Maybe (Args ArgsContext (ClientState -> IO CommandResult))+inArgs ArgsContext{argsContextFocus=focus} focusOverride =+  fmap (\f -> mapArgEnv (changeArgsFocus f) $ extensionArg "command" inArgsCmd) parsedFocus+  where+    parsedFocus = parseFocus (focusNetwork focus) focusOverride+    changeArgsFocus focus' argsContext = argsContext {argsContextFocus=focus'}+    rightToMaybe (Right v) = Just v+    rightToMaybe _ = Nothing+    inArgsCmd :: ArgsContext -> String -> Maybe (Args ArgsContext (ClientState -> IO CommandResult))+    inArgsCmd ArgsContext{argsContextFocus=focus', argsContextSt=st'} cmdName =+      cfCmdAsArgs <$> (rightToMaybe $ prepareMacro focus' cmdName st')++-- | Implementation of @/in@.+cmdIn :: ClientCommand (ClientState -> IO CommandResult)+cmdIn st fn = fn st -- All the magic is in the Args parser.++tabIn :: Bool -> ClientCommand String+tabIn isReversed st _ = -- TOOD: Command completion. This right here is just tabChannel.+  simpleTabCompletion plainWordCompleteMode [] (focusNames st) isReversed st

@@ -43,6 +43,7 @@       do t <- token          subspec <- lift (parseFormat env t)          parseArgs env subspec+    MapEnv f inner -> parseArgs (f env) inner  argumentString :: ArgumentShape -> Parser String argumentString TokenArgument     = token

@@ -98,6 +98,8 @@          else            return (draw rest) +    MapEnv f inner -> getState $ renderArgs pal (f r) placeholders inner+ token :: String -> ((String, String), String) token xs =   let (lead, xs1) = span  (' '==) xs

@@ -19,6 +19,7 @@   , optionalNumberArg   , extensionArg   , tokenArg+  , mapArgEnv    , ArgumentShape(..)   , Arg(..)@@ -38,6 +39,7 @@   Argument  :: ArgumentShape -> String -> (r -> String -> Maybe a) -> Arg r a   Optional  :: Args r a -> Arg r (Maybe a)   Extension :: String -> (r -> String -> Maybe (Args r a)) -> Arg r a+  MapEnv    :: (r -> s) -> Args s a -> Arg r a  tokenArg :: String -> (r -> String -> Maybe a) -> Args r a tokenArg name parser = liftAp (Argument TokenArgument name parser)@@ -59,6 +61,9 @@  optionalNumberArg :: Args r (Maybe Int) optionalNumberArg = optionalArg (tokenArg "[number]" (\_ -> readMaybe))++mapArgEnv :: (r -> s) -> Args s a -> Args r a+mapArgEnv f = liftAp . MapEnv f  tokenList ::   [String] {- ^ required names -} ->

@@ -26,12 +26,13 @@ import Data.Foldable (traverse_) import Data.HashMap.Strict qualified as HashMap import Data.List.Split (chunksOf)-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, maybeToList) import Data.Text (Text) import Data.Text qualified as Text-import Irc.Commands (ircInvite, ircKick, ircMode, ircRemove)-import Irc.Identifier (Identifier, mkId)+import Irc.Commands (ircInvite, ircKick, ircMode, ircPrivmsg, ircRemove)+import Irc.Identifier (Identifier, mkId, idText) import Irc.Modes+import Irc.Message (isNickChar) import Irc.UserInfo (UserInfo(UserInfo), renderUserInfo)  channelCommands :: CommandSection@@ -41,7 +42,7 @@       (pure "mode")       (fromMaybe [] <$> optionalArg (extensionArg "[modes]" modeParamArgs))       $(chanopDocs `cmdDoc` "mode")-    $ NetworkCommand cmdMode tabMode+    $ MaybeChatCommand cmdMode tabMode    , Command       (pure "masks")@@ -74,11 +75,40 @@     $ ChannelCommand cmdKickBan simpleChannelTab    , Command+      (pure "quiet")+      (simpleToken "nick|mask")+      $(chanopDocs `cmdDoc` "quiet")+    $ ChannelCommand cmdQuiet simpleChannelTab++  , Command       (pure "remove")       (liftA2 (,) (simpleToken "nick") (remainingArg "reason"))       $(chanopDocs `cmdDoc` "remove")     $ ChannelCommand cmdRemove simpleChannelTab +  , Command+      (pure "op")+      (optionalArg $ simpleToken "[nick]")+      $(chanopDocs `cmdDoc` "op")+    $ ChannelCommand (cmdStatus "OP" "+o") simpleChannelTab++  , Command+      (pure "deop")+      (optionalArg $ simpleToken "[nick]")+      $(chanopDocs `cmdDoc` "deop")+    $ ChannelCommand (cmdStatus "DEOP" "-o") simpleChannelTab++  , Command+      (pure "voice")+      (optionalArg $ simpleToken "[nick]")+      $(chanopDocs `cmdDoc` "voice")+    $ ChannelCommand (cmdStatus "VOICE" "+v") simpleChannelTab++  , Command+      (pure "devoice")+      (optionalArg $ simpleToken "[nick]")+      $(chanopDocs `cmdDoc` "devoice")+    $ ChannelCommand (cmdStatus "DEVOICE" "-v") simpleChannelTab   ]  cmdRemove :: ChannelCommand (String, String)@@ -109,6 +139,16 @@      cs' <- sendModeration channelId cmds cs      commandSuccessUpdateCS cs' st +cmdQuiet :: ChannelCommand String+cmdQuiet channelId cs st who+  | elem 'q' $ view (csModeTypes . modesLists) cs = do+    let+      whoTxt = Text.pack who+      mask = if Text.all isNickChar whoTxt then renderUserInfo (computeBanUserInfo (mkId whoTxt) cs) else whoTxt+    cs' <- sendModeration channelId [ircMode channelId ["q", mask]] cs+    commandSuccessUpdateCS cs' st+  | otherwise = commandFailureMsg "no list mode q on network" st+ cmdInvite :: ChannelCommand String cmdInvite channelId cs st nick =   do let freeTarget = has (csChannels . ix channelId . chanModes . ix 'g') cs@@ -128,13 +168,27 @@            unless (connecting || listLoaded)              (sendMsg cs (ircMode channel [Text.singleton mode])) -           commandSuccess (changeSubfocus (FocusMasks mode) st)+           commandSuccess (changeSubfocus (FocusMasks (view csNetwork cs) channel mode) st)      _ -> commandFailureMsg "unknown mask mode" st +cmdStatus :: Text -> Text -> ChannelCommand (Maybe String)+cmdStatus servCmd modeChg chan cs st target+  | useChanServ chan cs = do+    let command = [servCmd, idText chan] ++ maybeToList targetText+    sendMsg cs $ ircPrivmsg "ChanServ" $ Text.unwords command+    commandSuccessUpdateCS cs st+  | otherwise = do+    let target' = fromMaybe (idText $ view csNick cs) targetText+    sendMsg cs $ ircMode chan [modeChg, target']+    commandSuccessUpdateCS cs st+  where+    targetText = Text.pack <$> target+ computeBanUserInfo :: Identifier -> NetworkState    -> UserInfo computeBanUserInfo who cs =   case view (csUser who) cs of+    -- TODO: Maybe have multiple ways of computing this.     Nothing                     -> UserInfo who "*" "*"     Just (UserAndHost _ host _) -> UserInfo "*" "*" host @@ -155,22 +209,22 @@    | otherwise = commandFailure st -cmdMode :: NetworkCommand [String]-cmdMode cs st xs = modeCommand (Text.pack <$> xs) cs st+cmdMode :: MaybeChatCommand [String]+cmdMode chan cs st xs = modeCommand chan (Text.pack <$> xs) cs st  modeCommand ::-  [Text] {- mode parameters -} ->-  NetworkState                 ->-  ClientState                  ->+  Maybe Identifier {- channel -} ->+  [Text] {- mode parameters -}   ->+  NetworkState                   ->+  ClientState                    ->   IO CommandResult-modeCommand modes cs st =-  case view clientFocus st of--    NetworkFocus _ ->+modeCommand maybeChan modes cs st =+  case maybeChan of+    Nothing ->       do sendMsg cs (ircMode (view csNick cs) modes)          commandSuccess st -    ChannelFocus _ chan ->+    Just chan ->       case modes of         [] -> success False [[]]         flags:params ->@@ -195,13 +249,10 @@                       else cs <$ traverse_ (sendMsg cs) cmds              commandSuccessUpdateCS cs' st -    _ -> commandFailure st--tabMode :: Bool -> NetworkCommand String-tabMode isReversed cs st rest =-  case view clientFocus st of--    ChannelFocus _ channel+tabMode :: Bool -> MaybeChatCommand String+tabMode isReversed maybeChan cs st rest =+  case maybeChan of+    Just channel       | flags:params     <- Text.words (Text.pack rest)       , Just parsedModes <- splitModes (view csModeTypes cs) flags params       , let parsedModesWithParams =@@ -215,9 +266,9 @@   where     paramIndex = length $ words $ uncurry take $ clientLine st -modeParamArgs :: ClientState -> String -> Maybe (Args ClientState [String])-modeParamArgs st str =-  case view clientFocus st of+modeParamArgs :: ArgsContext -> String -> Maybe (Args ArgsContext [String])+modeParamArgs ArgsContext{argsContextSt=st, argsContextFocus=focus} str =+  case focus of     Unfocused      -> Nothing     NetworkFocus _ -> Just (pure [str])     ChannelFocus net _ ->

@@ -1,4 +1,4 @@-{-# Language BangPatterns, OverloadedStrings, TemplateHaskell #-}+{-# Language BangPatterns, BlockArguments, OverloadedStrings, TemplateHaskell #-} {-| Module      : Client.Commands.Chat Description : Common user IRC commands@@ -15,17 +15,21 @@ import Client.Commands.Window (parseFocus) import Client.Message import Client.State+import Client.State.Channel (chanJoined) import Client.State.Extensions (clientChatExtension) import Client.State.Focus (focusNetwork, Focus(ChannelFocus), Subfocus(FocusInfo, FocusUsers))-import Client.State.Network (csNetwork, csUserInfo, sendMsg, NetworkState)+import Client.State.Network import Control.Applicative (liftA2, liftA3)-import Control.Lens (view, preview, views)-import Control.Monad (when)+import Control.Lens (filteredBy, has, ix, view, preview, views)+import Control.Monad (when, unless)+import Data.ByteString qualified as B import Data.Char (toUpper)-import Data.Foldable (foldl')+import Data.Foldable (foldl', traverse_)+import Data.HashMap.Strict qualified as HashMap import Data.List.NonEmpty (NonEmpty((:|))) import Data.Text (Text) import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text import Data.Time (getZonedTime) import Irc.Commands import Irc.Identifier (Identifier, idText, mkId)@@ -116,7 +120,7 @@     $ ChannelCommand cmdChanNames noChannelTab    , Command-      (pure "channelinfo")+      ("channelinfo" :| ["cinfo"])       (pure ())       $(chatDocs `cmdDoc` "channelinfo")     $ ChannelCommand cmdChannelInfo noChannelTab@@ -128,7 +132,7 @@     $ NetworkCommand cmdKnock simpleNetworkTab    , Command-      (pure "quote")+      ("quote" :| ["/"])       (remainingArg "raw IRC command")       $(chatDocs `cmdDoc` "quote")     $ NetworkCommand cmdQuote simpleNetworkTab@@ -141,7 +145,7 @@    ] -monitorArgs :: ClientState -> String -> Maybe (Args ClientState [String])+monitorArgs :: ArgsContext -> String -> Maybe (Args ArgsContext [String]) monitorArgs _ str =   case toUpper <$> str of     "+" -> Just (wrap '+' (simpleToken "target[,target2]*"))@@ -159,10 +163,23 @@      commandSuccess st  cmdChanNames :: ChannelCommand ()-cmdChanNames _ _ st _ = commandSuccess (changeSubfocus FocusUsers st)+cmdChanNames chan cs st _ = do+    -- TODO: Uncomment when RPL_NAMREPLY actually creates a ChannelState.+    -- let connecting = has (csPingStatus . _PingConnecting) cs+    --     isJoined   = has (csChannels . ix chan . filteredBy chanJoined) cs+    -- unless (connecting || isJoined)+    --   (sendMsg cs (ircNames chan))+    commandSuccess (changeSubfocus subfocus st)+  where subfocus = FocusUsers (view csNetwork cs) chan  cmdChannelInfo :: ChannelCommand ()-cmdChannelInfo _ _ st _ = commandSuccess (changeSubfocus FocusInfo st)+cmdChannelInfo chan cs st _ = do+    let connecting = has (csPingStatus . _PingConnecting) cs+        isJoined   = has (csChannels . ix chan . filteredBy chanJoined) cs+    unless (connecting || isJoined)+      (sendMsg cs (ircMode chan []) >> sendMsg cs (ircTopic chan ""))+    commandSuccess (changeSubfocus subfocus st)+  where subfocus = FocusInfo (view csNetwork cs) chan  cmdKnock :: NetworkCommand (String, String) cmdKnock cs st (chan,message) =@@ -170,13 +187,42 @@      commandSuccess st  cmdJoin :: NetworkCommand (String, Maybe String)-cmdJoin cs st (channels, mbKeys) =-  do let network = view csNetwork cs-     let channelId = mkId (Text.pack (takeWhile (/=',') channels))-     sendMsg cs (ircJoin (Text.pack channels) (Text.pack <$> mbKeys))-     commandSuccess-        $ changeFocus (ChannelFocus network channelId) st+cmdJoin cs st (channelsStr, mbKeys) =+ do let network = view csNetwork cs+    let channelId = mkId (Text.pack (takeWhile (',' /=) channelsStr))+    let channels = Text.split (',' ==) (Text.pack channelsStr)+    let keys = maybe [] (Text.split (',' ==) . Text.pack) mbKeys+    traverse_ (sendMsg cs) (chunkJoins channels keys)+    commandSuccess (changeFocus (ChannelFocus network channelId) st) +chunkJoins :: [Text] -> [Text] -> [RawIrcMsg]+chunkJoins cs0 ks0 =+  case (cs0, ks0) of+    (c:cs, k:ks) -> go (cost c + cost k) [c] [k] cs ks+    (c:cs, []) -> go (cost c) [c] [] cs []+    _ -> []+  where+    limit = 500 -- "JOIN__:\r\n"+    cost x = 1 + B.length (Text.encodeUtf8 x)++    finishChannels = Text.intercalate "," . reverse+    finishKeys [] = Nothing+    finishKeys ks = Just (finishChannels ks)++    go n acc1 acc2 (c:cs) []+      | n + x > limit = ircJoin (finishChannels acc1) (finishKeys acc2) : go x [c] [] cs []+      | otherwise = go (n + x) (c : acc1) acc2 cs []+      where+        x = cost c++    go n acc1 acc2 (c:cs) (k:ks)+      | n + x > limit = ircJoin (finishChannels acc1) (finishKeys acc2) : go x [c] [k] cs ks+      | otherwise = go (n + x) (c : acc1) (k : acc2) cs ks+      where+        x = cost c + cost k++    go _ acc1 acc2 [] _ = [ircJoin (finishChannels acc1) (finishKeys acc2)]+ -- | @/query@ command. Takes a channel or nickname and switches -- focus to that target on the current network. cmdQuery :: ClientCommand (String, String)@@ -255,9 +301,9 @@           (ircPrivmsg tgtTxt restTxt)           (\src tgt -> Privmsg src tgt restTxt)           tgtTxt cs st-          + -- | Common logic for @/msg@ and @/notice@ chatCommand ::   RawIrcMsg {- ^ irc command -} ->@@ -329,7 +375,7 @@ -- | This command is equivalent to chatting without a command. The primary use -- at the moment is to be able to send a leading @/@ to chat easily. cmdSay :: ChannelCommand String-cmdSay _ _ st rest = executeChat rest st+cmdSay focus cs st rest = executeChat (ChannelFocus (view csNetwork cs) focus) rest st  -- | Implementation of @/me@ cmdMe :: ChannelCommand String@@ -349,11 +395,12 @@  -- | Treat the current text input as a chat message and send it. executeChat ::+  Focus                                   ->   String           {- ^ chat message   -} ->   ClientState      {- ^ client state   -} ->   IO CommandResult {- ^ command result -}-executeChat msg st =-  case view clientFocus st of+executeChat focus msg st =+  case focus of     ChannelFocus network channel       | Just !cs <- preview (clientConnection network) st ->           do now <- getZonedTime

@@ -25,7 +25,7 @@   , runExecCmd   ) where -import Control.Exception (Exception(displayException), try)+import Control.Exception (Exception(displayException)) import Control.Lens (view, (??), set, makeLenses) import Data.ByteString.Lazy qualified as L import Data.List (unfoldr)

@@ -0,0 +1,222 @@+{-# LANGUAGE TransformListComp, OverloadedStrings #-}++{-|+Module      : Client.Commands.Help+Description : Implementation of the /help command+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++Implements the /help command, which is responsible for managing the help buffer.+Unfortunately, this makes this command somewhat unique in that it's responsible for rendering.+-}++module Client.Commands.Help ( cmdHelp ) where++import           Client.Commands.Arguments.Renderer+import           Client.Commands.Arguments.Spec+import           Client.Commands.Interpolation+import           Client.Commands.Recognizer+import           Client.Commands.Types+import           Client.Configuration (configMacros)+import           Client.Image.MircFormatting+import           Client.Image.PackedImage+import           Client.Image.Palette+import           Client.Image.Message+import           Client.State+import           Client.State.Focus (focusNetwork, Subfocus(FocusHelp))+import           Client.State.Help+import           Client.State.Network (sendMsg)+import           Control.Lens+import           Data.Foldable (toList)+import           Data.List (delete, intercalate, sortOn)+import           Data.List.NonEmpty (NonEmpty((:|)))+import           Data.Text (Text)+import qualified Data.Text as Text+import           Graphics.Vty.Attributes+import           Irc.Commands (ircHelp)++displayHelp :: ClientState -> HelpState -> IO CommandResult+displayHelp st help = commandSuccess . changeSubfocus FocusHelp $ set clientHelp help st++-- | Implementation of @/help@ command.+cmdHelp :: [CommandSection] -> Recognizer Command -> WindowCommand (Maybe String)+cmdHelp commandsList commands focus st (Just (':':queryStr)) =+  case focusNetwork focus of+    Nothing -> commandFailureMsg "empty network prefix requires focused network" st+    Just net -> cmdHelp commandsList commands focus st (Just (Text.unpack net ++ ':' : queryStr))+                -- Network name better not start with a colon! ;)+cmdHelp _ commands _ st (Just queryStr)+  | Just queryText == savedQueryText = commandSuccess (changeSubfocus FocusHelp st)+  | otherwise = loadHelp commands queryText st+  where+    savedQueryText = views (clientHelp . hsQuery) helpQueryToText st+    queryText = Text.pack queryStr+cmdHelp commandsList _ _ st Nothing = loadHelpList commandsList st++loadHelpList :: [CommandSection] -> ClientState -> IO CommandResult+loadHelpList commandList st = displayHelp st $ makeHelp Nothing $ listAllCommands commandList st++loadHelp :: Recognizer Command -> Text -> ClientState -> IO CommandResult+loadHelp commands query st =+  case Text.break (':' ==) query of+    (cmdName, "") -> loadHelpCmd commands cmdName st+    (net, topic) -> sendHelpQuery net (Text.tail topic) st++sendHelpQuery :: Text -> Text -> ClientState -> IO CommandResult+sendHelpQuery net topic st =+  case preview (clientConnection net) st of+    Just cs -> do+      sendMsg cs (ircHelp topic)+      displayHelp st (awaitHelp net topic)+    Nothing -> commandFailureMsg ("not connected to " <> net) st++loadHelpCmd :: Recognizer Command -> Text -> ClientState -> IO CommandResult+loadHelpCmd commands cmdName st =+  case views (clientConfig . configMacros) (recognize cmdName) st of+    Exact macro -> displayHelp st $ makeHelp (Just cmdName) $ macroHelpLines st cmdName macro+    Invalid -> commandCase []+    Prefix sfxs -> commandCase sfxs+  where+    commandCase macroSfxs =+      case recognize cmdName commands of+        Invalid -> failureCase macroSfxs+        Prefix sfxs -> failureCase (macroSfxs <> sfxs)+        Exact cmd -> displayHelp st $ makeHelp (Just cmdName) $ commandHelpLines st cmdName cmd++    failureCase sfxs+      | null sfxs = commandFailureMsg "unknown command, try /help with no argument" st+      | otherwise = commandFailureMsg ("unknown command, did you mean: " <> suggestions) st+        where suggestions = Text.intercalate " " ((cmdName <>) <$> sfxs)++-- | Generate detailed help for macro expansions+macroHelpLines ::+  ClientState {- ^ client state -} ->+  Text        {- ^ name         -} ->+  Macro       {- ^ macro        -} ->+  [Image']    {- ^ lines        -}+macroHelpLines+  st+  name+  Macro{ macroSpec = MacroSpec spec, macroCommands = commands }+  = reverse+      $ heading "Syntax: " <> commandSummary (makeArgsContext st) pal (pure name) spec+      : emptyLine+      : heading "Macro Expansion:"+      : map (\x -> "    " <> foldMap explainExpansion x) commands+  where+    pal = clientPalette st+    attr = withForeColor defAttr cyan+    explainExpansion chunk =+      case chunk of+        LiteralChunk txt -> text' defAttr (cleanText txt)+        VariableChunk var -> text' attr ("${" <> cleanText var <> "}")+        IntegerChunk i -> string attr ("${" <> show i <> "}")+        DefaultChunk c txt ->+          text' attr "${" <>+          explainExpansion c <>+          text' attr "|" <>+          text' defAttr (cleanText txt) <>+          text' attr "}"++-- | Generate detailed help lines for the command with the given name.+commandHelpLines ::+  ClientState {- ^ client state -} ->+  Text        {- ^ command name -} ->+  Command     {- ^ command      -} ->+  [Image']    {- ^ lines        -}+commandHelpLines+  st+  cmdName+  Command{cmdNames = names, cmdImplementation = impl, cmdArgumentSpec = spec, cmdDocumentation = doc}+  = reverse $ heading "Syntax: " <> commandSummary (makeArgsContext st) pal (pure cmdName) spec+      : emptyLine+      : aliasLines+     ++ explainContext impl+      : emptyLine+      : map (parseIrcText pal) (Text.lines doc)+  where+    pal = clientPalette st+    aliasLines =+      case delete cmdName (toList names) of+        [] -> []+        ns -> [ heading "Aliases: " <> text' defAttr (Text.intercalate ", " ns), emptyLine ]++heading :: Text -> Image'+heading = text' (withStyle defAttr bold)++-- | Generate an explanation of the context where the given command+-- implementation will be valid.+explainContext ::+  CommandImpl a {- ^ command implementation -} ->+  Image'        {- ^ help line              -}+explainContext impl =+  heading "Context: " <>+  case impl of+    ClientCommand {}   -> "client (works everywhere)"+    WindowCommand {}   -> "window (works on the current window)"+    NetworkCommand{}   -> "network (works when focused on active network)"+    MaybeChatCommand{} -> "network (works when focused on active network)" -- Intentional duplicate.+    ChatCommand{}      -> "chat (works when focused on an active channel or private message)"+    ChannelCommand{}   -> "channel (works when focused on active channel)"++-- | Generate the lines for the help window showing all commands.+listAllCommands ::+  [CommandSection] {- ^  commands  -} ->+  ClientState {- ^ client state    -} ->+  [Image']    {- ^ help lines      -}+listAllCommands commandsList st+  = intercalate [emptyLine]+  $ map reverse+  $ (listCommandSection st pal <$> commandsList)+ ++ [macroCommandSection st pal]+ where pal = clientPalette st++macroCommandSection ::+  ClientState    {- ^ client state    -} ->+  Palette        {- ^ palette         -} ->+  [Image']       {- ^ help lines      -}+macroCommandSection st pal+  | null macros = []+  | otherwise =+      text' (withStyle defAttr bold) "Macros" :+      [ commandSummary st pal (pure name) spec+      | Macro name (MacroSpec spec) _ <- macros+      , then sortOn by name+      ]+  where+    macros = toListOf (clientConfig . configMacros . folded) st++listCommandSection ::+  ClientState    {- ^ client state    -} ->+  Palette        {- ^ palette         -} ->+  CommandSection {- ^ command section -} ->+  [Image']       {- ^ help lines      -}+listCommandSection st pal sec+  = text' (withStyle defAttr bold) (cmdSectionName sec)+  : [ commandSummary (makeArgsContext st) pal names spec+    | -- pattern needed due to existential quantification+      Command { cmdNames        = names+              , cmdArgumentSpec = spec+              } <- cmdSectionCmds sec+    ]++-- | Generate the help line for the given command and its+-- specification for use in the list of commands.+commandSummary ::+  r                {- ^ client state             -} ->+  Palette          {- ^ palette                  -} ->+  NonEmpty Text    {- ^ command name and aliases -} ->+  Args r a         {- ^ argument specification   -} ->+  Image'           {- ^ summary help line        -}+commandSummary st pal (cmd :| _) args  =+  char defAttr '/' <>+  text' (view palCommandReady pal) cmd <>+  render pal' st True args ""++  where+    pal' = set palCommandPlaceholder defAttr pal++-- Empty line used as a separator+emptyLine :: Image'+emptyLine = char defAttr ' '

@@ -1,4 +1,4 @@-{-# Language OverloadedStrings, TemplateHaskell #-}+{-# Language BlockArguments, OverloadedStrings, TemplateHaskell #-} {-| Module      : Client.Commands.Operator Description : Operator command implementations@@ -9,13 +9,14 @@  module Client.Commands.Operator (operatorCommands) where -import Client.Commands.Arguments.Spec (optionalArg, remainingArg, simpleToken)+import Client.Commands.Arguments.Spec (Args, optionalArg, remainingArg, simpleToken, extensionArg) import Client.Commands.Docs (operDocs, cmdDoc) import Client.Commands.TabCompletion (noNetworkTab, simpleNetworkTab) import Client.Commands.Types import Client.State.Network (sendMsg) import Control.Applicative (liftA2, liftA3) import Data.Maybe (fromMaybe, maybeToList)+import Data.Text (Text) import Data.Text qualified as Text import Irc.Commands import Irc.RawIrcMsg (rawIrcMsg)@@ -37,11 +38,29 @@    , Command       (pure "kline")-      (liftA3 (,,) (simpleToken "minutes") (simpleToken "user@host") (remainingArg "reason"))+      (liftA3 (,,) (extensionArg "minutes|on" banLineArgs) (simpleToken "user@host") (remainingArg "reason"))       $(operDocs `cmdDoc` "kline")-    $ NetworkCommand cmdKline simpleNetworkTab+    $ NetworkCommand (cmdBanLine "KLINE") simpleNetworkTab -- Don't use ircKline because it doesn't do remotes.    , Command+      (pure "dline")+      (liftA3 (,,) (extensionArg "minutes|on" banLineArgs) (simpleToken "ip") (remainingArg "reason"))+      $(operDocs `cmdDoc` "dline")+    $ NetworkCommand (cmdBanLine "DLINE") noNetworkTab++  , Command+      (pure "xline")+      (liftA3 (,,) (extensionArg "minutes|on" banLineArgs) (simpleToken "gecos") (remainingArg "reason"))+      $(operDocs `cmdDoc` "xline")+    $ NetworkCommand (cmdBanLine "XLINE") noNetworkTab++  , Command+      (pure "resv")+      (liftA3 (,,) (extensionArg "minutes|on" banLineArgs) (simpleToken "nick|channel") (remainingArg "reason"))+      $(operDocs `cmdDoc` "resv")+    $ NetworkCommand (cmdBanLine "RESV") noNetworkTab++  , Command       (pure "unkline")       (liftA2 (,) (simpleToken "[user@]host") (optionalArg (simpleToken "[servername]")))       $(operDocs `cmdDoc` "unkline")@@ -231,10 +250,19 @@   do sendMsg cs (ircKill (Text.pack client) (Text.pack rest))      commandSuccess st -cmdKline :: NetworkCommand (String, String, String)-cmdKline cs st (minutes, mask, reason) =-  do sendMsg cs (ircKline (Text.pack minutes) (Text.pack mask) (Text.pack reason))-     commandSuccess st+cmdBanLine :: Text -> NetworkCommand ((Maybe String, String), String, String)+cmdBanLine lineName cs st ((server, duration), target, reason) = do+  let+    remote = case server of+      Just server' -> ["ON", Text.pack server']+      Nothing      -> []+    args = [Text.pack duration, Text.pack target] ++ remote ++ [Text.pack reason]+  sendMsg cs (rawIrcMsg lineName args)+  commandSuccess st++banLineArgs :: ArgsContext -> String -> Maybe (Args ArgsContext (Maybe String, String))+banLineArgs _ "on" = Just (liftA2 (,) (Just <$> simpleToken "servername") (simpleToken "minutes"))+banLineArgs _ mins = Just (liftA2 (,) (pure Nothing) (pure mins))  cmdUnkline :: NetworkCommand (String, Maybe String) cmdUnkline cs st (mask, server) =

@@ -11,13 +11,13 @@  module Client.Commands.Queries (queryCommands) where -import Client.Commands.Arguments.Spec (optionalArg, remainingArg, simpleToken, extensionArg, Args)+import Client.Commands.Arguments.Spec (optionalArg, remainingArg, simpleToken, tokenArg) import Client.Commands.Docs (queriesDocs, cmdDoc) import Client.Commands.TabCompletion (noNetworkTab, simpleNetworkTab) import Client.Commands.Types (commandSuccess, commandSuccessUpdateCS, Command(Command), CommandImpl(NetworkCommand), CommandSection(CommandSection), NetworkCommand)-import Client.State (changeSubfocus, ClientState)+import Client.State (changeSubfocus) import Client.State.Focus (Subfocus(FocusChanList, FocusWho))-import Client.State.Network (sendMsg, csChannelList, clsElist, csPingStatus, _PingConnecting, csWhoReply)+import Client.State.Network (sendMsg, csChannelList, clsElist, csPingStatus, _PingConnecting, csWhoReply, csNetwork) import Client.WhoReply (newWhoReply) import Control.Applicative (liftA2) import Control.Lens (has, set, view)@@ -109,7 +109,7 @@    , Command       (pure "list")-      (optionalArg (extensionArg "[clientarg]" listArgs))+      (optionalArg (liftA2 (,) (tokenArg "[clientopts]" (const lsaParse)) (optionalArg (simpleToken "[elist]"))))       $(queriesDocs `cmdDoc` "list")     $ NetworkCommand cmdList simpleNetworkTab @@ -139,34 +139,28 @@                                 Nothing -> ""      commandSuccess st -cmdList :: NetworkCommand (Maybe ListArgs)+cmdList :: NetworkCommand (Maybe (ListArgs, Maybe String)) cmdList cs st rest =     do-      let lsa = fromMaybe lsaDefault rest+      let (lsa, maybeElist) = fromMaybe (lsaDefault, Nothing) rest       let connecting = has (csPingStatus . _PingConnecting) cs-      let elist = Just (Text.pack (fromMaybe "" (_lsaElist lsa)))+      let elist = Just (Text.pack (fromMaybe "" maybeElist))       let cached = elist == view (csChannelList . clsElist) cs-      let sendM = sendMsg cs (ircList (Text.pack <$> maybeToList (_lsaElist lsa)))+      let sendM = sendMsg cs (ircList (Text.pack <$> maybeToList maybeElist))       unless (connecting || (cached && not (_lsaRefresh lsa))) sendM       let cs' = set (csChannelList . clsElist) elist cs -      let subfocus = FocusChanList (_lsaMin lsa) (_lsaMax lsa)+      let subfocus = FocusChanList (view csNetwork cs) (_lsaMin lsa) (_lsaMax lsa)       commandSuccessUpdateCS cs' (changeSubfocus subfocus st) -listArgs :: ClientState -> String -> Maybe (Args ClientState ListArgs)-listArgs _ = fmap (withElist (optionalArg (simpleToken "[serverarg]"))) . lsaParse-    where withElist arg a = fmap (\s -> a { _lsaElist = s }) arg- data ListArgs = ListArgs-  { _lsaElist   :: Maybe String-  , _lsaRefresh :: Bool+  { _lsaRefresh :: Bool   , _lsaMin     :: Maybe Int   , _lsaMax     :: Maybe Int   }  lsaDefault :: ListArgs lsaDefault = ListArgs-  { _lsaElist = Nothing-  , _lsaRefresh = False+  { _lsaRefresh = False   , _lsaMin = Nothing   , _lsaMax = Nothing   }@@ -240,14 +234,14 @@      commandSuccess st  cmdWho :: NetworkCommand (Maybe (String, Maybe String))-cmdWho _  st Nothing = commandSuccess (changeSubfocus FocusWho st)+cmdWho cs  st Nothing = commandSuccess $ changeSubfocus (FocusWho (view csNetwork cs)) st cmdWho cs st (Just (query, arg)) =   do     let query' = Text.pack query     let arg' = fromMaybe "" arg     let cs' = set csWhoReply (newWhoReply query' arg') cs     sendMsg cs (ircWho (query' : maybeToList (Text.pack <$> arg)))-    commandSuccessUpdateCS cs' (changeSubfocus FocusWho st)+    commandSuccessUpdateCS cs' $ changeSubfocus (FocusWho (view csNetwork cs)) st  cmdWhowas :: NetworkCommand String cmdWhowas cs st rest =

@@ -10,7 +10,8 @@ module Client.Commands.Types where  import Client.Commands.Arguments.Spec (Args)-import Client.State (ClientState, clientErrorMsg, clientConnection)+import Client.State (ClientState, clientErrorMsg, clientConnection, clientFocus)+import Client.State.Focus (Focus) import Client.State.Network (NetworkState, csNetwork) import Control.Lens (set, view) import Data.List.NonEmpty (NonEmpty)@@ -31,9 +32,15 @@ -- | Type of commands that always work type ClientCommand a = ClientState -> a {- ^ arguments -} -> IO CommandResult +-- | Type of commands that operate on a window+type WindowCommand a = Focus -> ClientCommand a+ -- | Type of commands that require an active network to be focused type NetworkCommand a = NetworkState {- ^ current network -} -> ClientCommand a +-- | Type of commands that require an active network to be focused and maybe a chat window.+type MaybeChatCommand a = Maybe Identifier {- ^ focused channel -} -> NetworkCommand a+ -- | Type of commands that require an active channel to be focused type ChannelCommand a = Identifier {- ^ focused channel -} -> NetworkCommand a @@ -43,15 +50,27 @@ -- indicating that tab completion should be reversed data CommandImpl a   -- | no requirements-  = ClientCommand  (ClientCommand  a) (Bool -> ClientCommand  String)+  = ClientCommand    (ClientCommand  a)   (Bool -> ClientCommand String)+  -- | operates on a window+  | WindowCommand    (WindowCommand a)    (Bool -> WindowCommand String)   -- | requires an active network-  | NetworkCommand (NetworkCommand a) (Bool -> NetworkCommand String)+  | NetworkCommand   (NetworkCommand a)   (Bool -> NetworkCommand String)+  -- | requires an active network and maybe a chat window+  | MaybeChatCommand (MaybeChatCommand a) (Bool -> MaybeChatCommand String)   -- | requires an active chat window-  | ChatCommand    (ChannelCommand a) (Bool -> ChannelCommand String)+  | ChatCommand      (ChannelCommand a)   (Bool -> ChannelCommand String)   -- | requires an active channel window-  | ChannelCommand (ChannelCommand a) (Bool -> ChannelCommand String)+  | ChannelCommand   (ChannelCommand a)   (Bool -> ChannelCommand String) +-- | Data available to the arguments parser at the time of parsing.+data ArgsContext = ArgsContext+  { argsContextSt    :: ClientState +  , argsContextFocus :: Focus+  } +makeArgsContext :: ClientState -> ArgsContext+makeArgsContext st = ArgsContext {argsContextSt=st, argsContextFocus=view clientFocus st}+ -- | A command is a list of aliases, an argument specification, implementation, -- and documentation. The arguments and implementation must match so that -- the parsed arguments will match what the implementation expects.@@ -59,7 +78,7 @@   { -- | Names of this command, first in the list is the "primary" name     cmdNames          :: NonEmpty Text   -- | Specification of the arguments of the command-  , cmdArgumentSpec   :: Args ClientState a+  , cmdArgumentSpec   :: Args ArgsContext a   -- | Multi-line IRC-formatted documentation text used for @/help@   , cmdDocumentation  :: Text   -- | Implementation of the command for both execution and tab completion

@@ -7,7 +7,7 @@ Maintainer  : emertens@gmail.com -} -module Client.Commands.Window (windowCommands, parseFocus) where+module Client.Commands.Window (windowCommands, parseFocus, focusNames) where  import Client.Commands.Arguments.Spec import Client.Commands.Docs (windowDocs, cmdDoc)@@ -19,6 +19,7 @@ import Client.State.EditBox qualified as Edit import Client.State.Focus import Client.State.Network (csChannels)+import Client.State.Channel (chanJoined) import Client.State.Window (windowClear, wlText, winMessages, winHidden, winActivityFilter, winName, activityFilterStrings, readActivityFilter) import Control.Applicative (liftA2) import Control.Exception (SomeException, Exception(displayException), try)@@ -55,7 +56,7 @@       (pure "clear")       (optionalArg (liftA2 (,) (simpleToken "[network]") (optionalArg (simpleToken "[channel]"))))       $(windowDocs `cmdDoc` "clear")-    $ ClientCommand cmdClear tabFocus+    $ WindowCommand cmdClear (\rev _ -> tabFocus rev)    , Command       (pure "windows")@@ -64,19 +65,19 @@     $ ClientCommand cmdWindows tabWindows    , Command-      (pure "splits")+      ("splits" :| ["s"])       (remainingArg "focuses")       $(windowDocs `cmdDoc` "splits")     $ ClientCommand cmdSplits tabSplits    , Command-      (pure "splits+")+      ("splits+" :| ["s+"])       (remainingArg "focuses")       $(windowDocs `cmdDoc` "splits")     $ ClientCommand cmdSplitsAdd tabSplits    , Command-      (pure "splits-")+      ("splits-" :| ["s-"])       (remainingArg "focuses")       $(windowDocs `cmdDoc` "splits")     $ ClientCommand cmdSplitsDel tabActiveSplits@@ -88,7 +89,7 @@     $ ClientCommand cmdIgnore tabIgnore    , Command-      (pure "grep")+      ("grep" :| ["g"])       (remainingArg "regular-expression")       $(windowDocs `cmdDoc` "grep")     $ ClientCommand cmdGrep simpleClientTab@@ -97,7 +98,7 @@       (pure "dump")       (simpleToken "filename")       $(windowDocs `cmdDoc` "dump")-    $ ClientCommand cmdDump simpleClientTab+    $ WindowCommand cmdDump (\rev _ -> simpleClientTab rev)    , Command       (pure "mentions")@@ -109,24 +110,23 @@       (pure "setwindow")       (simpleToken ("hide|show" ++ concatMap ('|':) activityFilterStrings))       $(windowDocs `cmdDoc` "setwindow")-    $ ClientCommand cmdSetWindow tabSetWindow+    $ WindowCommand cmdSetWindow tabSetWindow    , Command       (pure "setname")       (optionalArg (simpleToken "[letter]"))       $(windowDocs `cmdDoc` "setname")-    $ ClientCommand cmdSetWindowName noClientTab-+    $ WindowCommand cmdSetWindowName (\rev _ -> noClientTab rev)   ] -cmdSetWindowName :: ClientCommand (Maybe String)-cmdSetWindowName st arg =+cmdSetWindowName :: WindowCommand (Maybe String)+cmdSetWindowName focus st arg =   -- unset current name so that it becomes available-  let mbSt1 = failover (clientWindows . ix (view clientFocus st) . winName) (\_ -> Nothing) st in+  let mbSt1 = failover (clientWindows . ix focus . winName) (\_ -> Nothing) st in   case mbSt1 of     Nothing -> commandFailureMsg "no current window" st     Just st1 ->-      let next = clientNextWindowName (clientWindowHint (view clientFocus st) st) st+      let next = clientNextWindowName (clientWindowHint focus st) st           mbName =             case arg of               Just [n] | n `elem` clientWindowNames st -> Right n@@ -139,16 +139,16 @@         Right name ->           let unset n = if n == Just name then Nothing else n in           commandSuccess-            $ set  (clientWindows . ix (view clientFocus st) . winName) (Just name)-            $ over (clientWindows . each                     . winName) unset+            $ set  (clientWindows . ix focus . winName) (Just name)+            $ over (clientWindows . each     . winName) unset             $ st1 -cmdSetWindow :: ClientCommand String-cmdSetWindow st cmd =+cmdSetWindow :: WindowCommand String+cmdSetWindow focus st cmd =   case mbFun of     Nothing -> commandFailureMsg "bad window setting" st     Just f ->-      case failover (clientWindows . ix (view clientFocus st)) f st of+      case failover (clientWindows . ix focus) f st of         Nothing -> commandFailureMsg "no such window" st         Just st' -> commandSuccess st'   where@@ -158,8 +158,8 @@         "hide"    -> Just (set winName Nothing . set winHidden True)         other     -> set winActivityFilter <$> readActivityFilter other -tabSetWindow :: Bool {- ^ reversed -} -> ClientCommand String-tabSetWindow isReversed st _ =+tabSetWindow :: Bool {- ^ reversed -} -> WindowCommand String+tabSetWindow isReversed _ st _ =   simpleTabCompletion plainWordCompleteMode [] completions isReversed st   where     completions = "hide":"show": map Text.pack activityFilterStrings@@ -260,19 +260,6 @@            (parseFocus (views clientFocus focusNetwork st))            (words str) --- | Parses a single focus name given a default network.-parseFocus ::-  Maybe Text {- ^ default network    -} ->-  String {- ^ @[network:]target@ -} ->-  Maybe Focus-parseFocus mbNet x =-  case break (==':') x of-    ("*","")     -> pure Unfocused-    (net,_:"")   -> pure (NetworkFocus (Text.pack net))-    (net,_:chan) -> pure (ChannelFocus (Text.pack net) (mkId (Text.pack chan)))-    (chan,"")    -> mbNet <&> \net ->-                    ChannelFocus net (mkId (Text.pack chan))- cmdFocus :: ClientCommand (String, Maybe String) cmdFocus st (network, mbChannel)   | network == "*" = commandSuccess (changeFocus Unfocused st)@@ -310,10 +297,10 @@ -- joined to this command will clear the messages but -- preserve the window. When used on a window that the -- user is not joined to this command will delete the window.-cmdClear :: ClientCommand (Maybe (String, Maybe String))-cmdClear st args =+cmdClear :: WindowCommand (Maybe (String, Maybe String))+cmdClear focusDefault st args =   case args of-    Nothing                      -> clearFocus (view clientFocus st)+    Nothing                      -> clearFocus focusDefault     Just ("*",     Nothing     ) -> clearFocus Unfocused     Just (network, Nothing     ) -> clearFocus (NetworkFocus (Text.pack network))     Just (network, Just "*"    ) -> clearNetworkWindows network@@ -327,11 +314,19 @@      clearFocus focus = commandSuccess (clearFocus1 focus st) -    clearFocus1 focus st' = focusEffect (windowEffect st')+    clearFocus1 focus st' = channelEffect (focusEffect (windowEffect st'))       where+        channelEffect =+          case focus of+            ChannelFocus network channel | not isActive ->+              over (clientConnection network . csChannels) (sans channel)+            _ -> id++        -- clear or delete the window buffer         windowEffect = over (clientWindows . at focus)                            (if isActive then fmap windowClear else const Nothing) +        -- stay on the current focus or find a new one         focusEffect           | noChangeNeeded    = id           | prevExists        = changeFocus prev@@ -342,12 +337,13 @@              prev              = view clientPrevFocus st +        -- active windows are cleared instead of deleted         isActive =           case focus of-            Unfocused                    -> False-            NetworkFocus network         -> has (clientConnection network) st'-            ChannelFocus network channel -> has (clientConnection network-                                                .csChannels . ix channel) st'+            Unfocused -> False+            NetworkFocus network -> has (clientConnection network) st'+            ChannelFocus network channel ->+              orOf (clientConnection network . csChannels . ix channel . chanJoined) st'  -- | Tab completion for @/splits[+]@. When given no arguments this -- populates the current list of splits, otherwise it tab completes@@ -378,6 +374,14 @@ renderSplitFocus (NetworkFocus x)   = x <> ":" renderSplitFocus (ChannelFocus x y) = x <> ":" <> idText y +focusNames :: ClientState -> [Text]+focusNames st = currentNet <> allWindows+  where+    allWindows  = renderSplitFocus <$> views clientWindows Map.keys st+    currentNet  = case views clientFocus focusNetwork st of+                    Just net -> idText <$> channelWindowsOnNetwork net st+                    Nothing  -> []+ -- | When tab completing the first parameter of the focus command -- the current networks are used. tabFocus :: Bool -> ClientCommand String@@ -407,13 +411,7 @@   Bool {- ^ reversed order -} ->   ClientCommand String tabChannel isReversed st _ =-  simpleTabCompletion plainWordCompleteMode [] completions isReversed st-  where-    completions = currentNet <> allWindows-    allWindows  = renderSplitFocus <$> views clientWindows Map.keys st-    currentNet  = case views clientFocus focusNetwork st of-                    Just net -> idText <$> channelWindowsOnNetwork net st-                    Nothing  -> []+  simpleTabCompletion plainWordCompleteMode [] (focusNames st) isReversed st  -- | Return the list of identifiers for open channel windows on -- the given network name.@@ -427,16 +425,14 @@  -- | Implementation of @/dump@. Writes detailed contents of focused buffer -- to the given filename.-cmdDump :: ClientCommand String-cmdDump st fp =+cmdDump :: WindowCommand String+cmdDump focus st fp =   do res <- try (LText.writeFile fp (LText.unlines outputLines))      case res of        Left e  -> commandFailureMsg (Text.pack (displayException (e :: SomeException))) st        Right{} -> commandSuccess st    where-    focus = view clientFocus st-     outputLines       = reverse       $ clientFilter st id

@@ -365,7 +365,7 @@ actBindingSpec :: ValueSpec (KeyMap -> KeyMap) actBindingSpec = sectionsSpec "action-binding" $   do ~(m,k) <- reqSection' "bind" keySpec-               "Key to be bound (e.g. a, C-b, M-c C-M-d)"+               "Key to be bound (e.g. \"a\", \"C-b\", \"M-c\", \"C-M-d\")"      a      <- reqSection "action"                "Action name (see `/keymap`)"      return (addKeyBinding m k a)@@ -373,7 +373,7 @@ cmdBindingSpec :: ValueSpec (KeyMap -> KeyMap) cmdBindingSpec = sectionsSpec "command-binding" $   do ~(m,k) <- reqSection' "bind" keySpec-               "Key to be bound (e.g. a, C-b, M-c C-M-d)"+               "Key to be bound (e.g. \"a\", \"C-b\", \"M-c\", \"C-M-d\")"      cmd    <- reqSection "command"                "Client command to execute (exclude leading `/`)"      return (addKeyBinding m k (ActCommand cmd))@@ -381,7 +381,7 @@ unbindingSpec :: ValueSpec (KeyMap -> KeyMap) unbindingSpec = sectionsSpec "remove-binding" $   do ~(m,k) <- reqSection' "unbind" keySpec-               "Key to be unbound (e.g. a, C-b, M-c C-M-d)"+               "Key to be unbound (e.g. \"a\", \"C-b\", \"M-c\", \"C-M-d\")"      return (removeKeyBinding m k)  

@@ -1,4 +1,4 @@-{-# Language OverloadedStrings #-}+{-# Language CPP, OverloadedStrings #-}  {-| Module      : Client.Docs@@ -28,11 +28,21 @@ import           Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Lazy as LText+import qualified Data.Text.Lazy.Builder as Builder import           Data.Text.Encoding (decodeUtf8) import           Language.Haskell.TH (Exp, Q, runIO) import           Language.Haskell.TH.Syntax (lift)-import qualified Data.Text.Lazy.Builder as Builder+import           System.FilePath ((</>), (<.>)) +#if MIN_VERSION_template_haskell(2,19,0)+import Language.Haskell.TH.Syntax (addDependentFile, makeRelativeToProject)+addRelativeDependentFile :: FilePath -> Q ()+addRelativeDependentFile relPath = makeRelativeToProject relPath >>= addDependentFile+#else+addRelativeDependentFile :: FilePath -> Q ()+addRelativeDependentFile _ = return ()+#endif+ type Docs = HashMap String LText.Text  data Line@@ -45,9 +55,9 @@ makeHeader header = LText.append "\^B" (LText.append header ":\^B\n")  loadDoc :: (String -> String) -> FilePath -> Q Docs-loadDoc keymod path = runIO (readFile splicePath >>= renderDoc)+loadDoc keymod path = addRelativeDependentFile splicePath >> runIO (readFile splicePath >>= renderDoc)   where-    splicePath = "doc/" ++ path ++ ".adoc"+    splicePath = "doc" </> path <.> "adoc"     renderDoc doc = case Parse.parseOnly lineParser $ decodeUtf8 doc of       Right docs -> return $ buildDocs keymod docs       Left errorMsg -> fail ("Parser failed on `" ++ splicePath ++ "`: " ++ errorMsg)

@@ -37,6 +37,7 @@ import Client.State.Extensions import Client.State.Focus (Subfocus(FocusMessages)) import Client.State.Network+import Client.State.Target (msgTarget) import Control.Concurrent.STM import Control.Exception (SomeException, Exception(fromException), catch) import Control.Lens@@ -60,7 +61,7 @@ import Graphics.Vty import Hookup (ConnectionFailure(..)) import Irc.Codes (pattern RPL_STARTTLS)-import Irc.Message (IrcMsg(Reply, Notice), cookIrcMsg, msgTarget)+import Irc.Message (IrcMsg(Reply, Notice), cookIrcMsg) import Irc.RawIrcMsg (RawIrcMsg, TagEntry(..), asUtf8, msgTags, parseRawIrcMsg) import LensUtils (setStrict) import System.Process.Typed (startProcess, setStdin, setStdout, setStderr, nullStream)@@ -333,9 +334,7 @@                     let st2 =                           case viewHook irc of                             Nothing -> st1 -- Message hidden-                            Just irc'-                              | hideMessage irc' -> st1-                              | otherwise -> recordIrcMessage network target msg st1+                            Just irc' -> recordIrcMessage network target msg st1                               where                                 myNick = view csNick cs                                 target = msgTarget myNick irc

@@ -152,7 +152,7 @@              Text.pack . formatTime defaultTimeLocale "%H:%M:%S"                <$> utcToLocalZonedTime t      let failureCase e = recordError now (view csNetwork cs) ("Bad connect-cmd: " <> e)-     case resolveMacroExpansions (commandExpansion dc st0) (const Nothing) cmdTxt of+     case resolveMacroExpansions (commandExpansion Nothing dc st0) (const Nothing) cmdTxt of        Nothing -> return $! failureCase "Unable to expand connect command" st0        Just cmdTxt' ->          do res <- executeUserCommand dc (Text.unpack cmdTxt') st0

@@ -64,20 +64,18 @@ patterns = map toPattern     [     -- PATTERN LIST, most common snotes+    (1, "k", [str|^Rejecting [DKX]-Lined user|]),+     -- Client connecting, more complete regex: ^Client connecting: [^ ]+ \([^ ]+@[^ ]+\) \[[^ ]+\] \{[^ ]+\} \[.*\]$     (1, "c", [str|^Client connecting: |]),     -- Client exiting, more complete regex: ^Client exiting: [^ ]+ \([^ ]+@[^ ]+\) \[.*\] \[[^ ]+\]$     (0, "c", [str|^Client exiting: |]),     -- Nick change     (0, "c", [str|^Nick change: From |]),-    -- Connection limit, more complete regex: ^Too many user connections for [^ ]+![^ ]+@[^ ]+$-    (1, "u", [str|^Too many user connections for |]),     -- Join alerts, more complete regex: ^User [^ ]+ \([^ ]+@[^ ]+\) trying to join #[^ ]* is a possible spambot$     (1, "a", [str|^User [^ ]+ \([^ ]+\) trying to join #[^ ]* is a possible spambot|]),     -- Kline hitting user     (1, "k", [str|^K/DLINE active for|]),-    -- Connection limit, more complete regex: ^Too many local connections for [^ ]+![^ ]+@[^ ]+$-    (1, "u", [str|^Too many local connections for |]),     -- Global kline added, more complete regex: ^[^ ]+![^ ]+@[^ ]+\{[^ ]+\} added global [0-9]+ min. K-Line for \[[^ ]+\] \[.*\]$     (2, "k", [str|^[^ ]+ added global [0-9]+ min. K-Line for |]),     (2, "k", [str|^[^ ]+ added global [0-9]+ min. X-Line for |]),@@ -114,7 +112,6 @@     (1, "f", [str|^Failed (OPER|CHALLENGE) attempt - host mismatch|]),     (3, "f", [str|^Failed (OPER|CHALLENGE) attempt|]), -- ORDER IMPORTANT - catch all failed attempts that aren't host mismatch -    (1, "k", [str|^Rejecting [DKX]-Lined user|]),     (1, "k", [str|^Disconnecting [DKX]-Lined user|]),     (1, "k", [str|^KLINE active for|]),     (1, "k", [str|^XLINE active for|]),@@ -212,10 +209,13 @@     (3, "o", [str|^ERROR |]),     (3, "o", [str|^No response from [^ ]+, closing link$|]), -    (1, "u", [str|^Too many global connections for [^ ]+![^ ]+@[^ ]+$|]),+    (1, "u", [str|^Too many user connections for |]),+    (1, "u", [str|^Too many local connections for |]),+    (1, "u", [str|^Too many global connections for |]),+    (1, "u", [str|^I-line is full for |]),+     (0, "u", [str|^Invalid username: |]),     (0, "u", [str|^HTTP Proxy disconnected: |]),     (2, "u", [str|^Unauthorised client connection from |]),     (2, "u", [str|^[^ ]+( \([^ ]+\))? sent the password for the MARKED account|]),     (2, "u", [str|^Not restoring mark|])]--- -}

@@ -0,0 +1,86 @@+{-# Language OverloadedStrings, BangPatterns #-}+{-|+Module      : Client.Image.Focus+Description : Renderer for focus labels+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module provides image renderers used to construct+the labels for window names and activity boxes.+-}+module Client.Image.Focus+  ( FocusLabelType (..)+  , focusLabel+  , windowLabel+  ) where++import Client.Image.Message (cleanChar, cleanText, IdentifierColorMode (NormalIdentifier), coloredIdentifier, modesImage)+import Client.Image.PackedImage+import Client.Image.Palette+import Client.State+import Client.State.Channel (chanModes, chanUsers)+import Client.State.Focus (focusNetwork, Focus(..))+import Client.State.Network+import Client.State.Window+import Control.Lens (view, preview, Ixed(ix))+import Data.Map.Strict qualified as Map+import qualified Data.HashMap.Strict as HashMap+import Graphics.Vty.Attributes (defAttr)++windowLabel :: ClientState -> (Focus, Window) -> Image'+windowLabel st (focus, w) =+  jumpLabel <>+  focusLabel FocusLabelJump st focus <>+  activity+  where+    jumpLabel =+      case view winName w of+        Nothing   -> mempty+        Just name -> char (view palWindowName pal) name <>+                     char defAttr ':'+    n   = view winUnread w+    pal = clientPalette st+    activity+      | n == 0 = mempty+      | view winMention w == WLImportant = char defAttr ' ' <> string (view palMention pal) (show n)+      | otherwise = char defAttr ' ' <> string (view palActivity pal) (show n)++data FocusLabelType = FocusLabelJump | FocusLabelShort | FocusLabelLong++focusLabel :: FocusLabelType -> ClientState -> Focus -> Image'+focusLabel labelType st focus =+  let+    !pal = clientPalette st+    netpal = clientNetworkPalette st+    colon = char defAttr ':'+    networkLabel network = text' (view palLabel pal) (cleanText network)+    channelLabel         = coloredIdentifier pal NormalIdentifier HashMap.empty+  in case (focus, labelType) of+    (Unfocused, _) ->+      char (view palError pal) '*'+    (NetworkFocus network, FocusLabelJump) -> networkLabel network <> colon+    (NetworkFocus network, _) -> networkLabel network+    (ChannelFocus network channel, FocusLabelJump)+      | Just network == focusNetwork (view clientFocus st) -> channelLabel channel+    (ChannelFocus network channel, FocusLabelLong) ->+      networkLabel network <>+      colon <>+      string (view palSigil pal) (cleanChar <$> sigils) <>+      channelLabel channel <>+      channelModes+      where+        (sigils, channelModes) =+          case preview (clientConnection network) st of+            Just cs ->+               ( let nick = view csNick cs in+                 view (csChannels . ix channel . chanUsers . ix nick) cs+               , case preview (csChannels . ix channel . chanModes) cs of+                    Just modeMap | not (null modeMap) ->+                        " " <> modesImage (view palModes pal) (view palCModes netpal) ('+':Map.keys modeMap)+                    _ -> mempty+               )+            _ -> ("", mempty)+    (ChannelFocus network channel, _) ->+      networkLabel network <> colon <> channelLabel channel+

@@ -286,6 +286,7 @@      Account user _ -> who user <> " account:"     Chghost ui _ _ -> who ui <> " chghost:"+    Tagmsg{} -> mempty   -- | Render a chat message given a rendering mode, the sigils of the user@@ -308,6 +309,7 @@     Nick        {} -> mempty     Authenticate{} -> "***"     Away        {} -> mempty+    Tagmsg      {} -> mempty      Error                   txt -> parseIrcText pal txt     Topic _ _ txt ->@@ -544,7 +546,11 @@       string (view palUsrChg pal) "back " <>       who user +    Tagmsg user _ ->+      string quietAttr "tagm " <>+      who user + renderCapCmd :: CapCmd -> Text renderCapCmd cmd =   case cmd of@@ -1214,6 +1220,9 @@     AcctSummary who       -> Just (char (view palUsrChg pal) '*', who, Nothing)     AwaySummary who True  -> Just (char (view palAway pal)   'a', who, Nothing)     AwaySummary who False -> Just (char (view palUsrChg pal) 'b', who, Nothing)+    TagmSummary who       -> Just (char (view palTagmsg pal) 't', who, Nothing)+    MonSummary who True   -> Just (char (view palJoin pal `withStyle` italic) '+', who, Nothing)+    MonSummary who False  -> Just (char (view palPart pal `withStyle` italic) 'x', who, Nothing)     _                     -> Nothing  -- | Image used when treating ignored chat messages as metadata

@@ -64,19 +64,33 @@  instance IsString Image' where fromString = string defAttr +-- | Predicate for characters that should be output to screen.+isOutput :: Char -> Bool+isOutput '\x200b' = False -- zero-width space that terminals typically misdraw+isOutput _ = True+ text' :: Attr -> S.Text -> Image' text' a s-  | S.null s  = EmptyImage'-  | otherwise = HorizText' a s (wcswidth (S.unpack s)) (S.length s) EmptyImage'+  | S.null s         = EmptyImage'+  -- optimization to avoid copying the text if nothing will be filtered+  | S.all isOutput s = HorizText' a s (wcswidth (S.unpack s)) (S.length s) EmptyImage'+  | S.null s'        = EmptyImage'+  | otherwise        = HorizText' a s' (wcswidth (S.unpack s')) (S.length s') EmptyImage'+  where+    s' = S.filter isOutput s  char :: Attr -> Char -> Image'-char a c = HorizText' a (S.singleton c) (wcwidth c) 1 EmptyImage'+char a c+  | isOutput c = HorizText' a (S.singleton c) (wcwidth c) 1 EmptyImage'+  | otherwise = EmptyImage'  string :: Attr -> String -> Image' string a s   | null s    = EmptyImage'-  | otherwise = HorizText' a t (wcswidth s) (S.length t) EmptyImage'-  where t = S.pack s+  | otherwise = HorizText' a t (wcswidth s') (S.length t) EmptyImage'+  where+    s' = filter isOutput s+    t = S.pack s'  splitImage :: Int {- ^ image width -} -> Image' -> (Image',Image') splitImage _ EmptyImage' = (EmptyImage', EmptyImage')

@@ -42,6 +42,7 @@   , palModes   , palUsrChg   , palIgnore+  , palTagmsg    -- * Lenses (Network)   , palCModes@@ -95,6 +96,7 @@   , _palPart          :: Attr   , _palUsrChg        :: Attr   , _palIgnore        :: Attr+  , _palTagmsg        :: Attr -- ^ color of TAGMSG sigil   }   deriving Show @@ -139,6 +141,7 @@   , _palModes              = metaLo   , _palUsrChg             = metaLo   , _palIgnore             = withForeColor defAttr white+  , _palTagmsg             = metaLo   }   where     metaNo = withForeColor defAttr brightBlack@@ -200,4 +203,5 @@   , ("part"             , Lens palPart)   , ("user-change"      , Lens palUsrChg)   , ("ignore"           , Lens palIgnore)+  , ("tagmsg"           , Lens palTagmsg)   ]

@@ -17,32 +17,33 @@   , clientTitle   ) where -import Client.Image.Message (cleanChar, cleanText, IdentifierColorMode (NormalIdentifier), coloredIdentifier, modesImage)+import Client.Image.Focus+import Client.Image.Message (cleanChar, cleanText, modesImage) import Client.Image.PackedImage import Client.Image.Palette import Client.State-import Client.State.Channel (chanModes, chanUsers) import Client.State.Focus (focusNetwork, Focus(..), Subfocus(..), WindowsFilter(..))+import Client.State.Help (hsQuery, HelpQuery (..)) import Client.State.Network import Client.State.Window import Control.Lens (view, orOf, preview, views, _Just, Ixed(ix)) import Data.Foldable (for_) import Data.Map.Strict qualified as Map-import qualified Data.HashMap.Strict as HashMap import Data.Maybe (mapMaybe, maybeToList) import Data.Text (Text)-import Data.Text qualified as Text+import qualified Data.Text as Text import Data.Text.Lazy qualified as LText import Graphics.Vty.Attributes (Attr, defAttr, bold, withForeColor, withStyle, red) import Graphics.Vty.Image qualified as Vty-import Irc.Identifier (idText)+import Irc.Identifier (idText, mkId) import Numeric (showFFloat)+import Client.WhoReply (whoQuery)  clientTitle :: ClientState -> String clientTitle st   = map cleanChar   $ LText.unpack-  $ "glirc - " <> imageText (viewFocusLabel st (view clientFocus st))+  $ "glirc - " <> imageText (currentViewImage False st (view clientSubfocus st) (view clientFocus st))  bar :: Image' bar = char (withStyle defAttr bold) '─'@@ -56,13 +57,13 @@ statusLineImage w st =   makeLines w (common : activity ++ errorImgs)   where+    focus = view clientFocus st     common = Vty.horizCat $       myNickImage st :       map unpackImage-      [ focusImage (view clientFocus st) st-      , subfocusImage (view clientSubfocus st) st+      [ infoBubble $ currentViewImage True st (view clientSubfocus st) focus       , detailImage st-      , nometaImage (view clientFocus st) st+      , nometaImage focus st       , scrollImage st       , filterImage st       , lockImage st@@ -104,10 +105,8 @@ minorStatusLineImage focus subfocus w showHideMeta st =   content <> mconcat (replicate fillSize bar)   where-    content = focusImage focus st <>-              subfocusImage subfocus st <>-              if showHideMeta then nometaImage focus st else mempty-+    nometaImage' = if showHideMeta then nometaImage focus st else mempty+    content = infoBubble $ (currentViewImage True st subfocus focus <> nometaImage')     fillSize = max 0 (w - imageWidth content)  @@ -211,25 +210,35 @@ -- @-[15p]@ activitySummary :: ClientState -> Vty.Image activitySummary st-  | null indicators = Vty.emptyImage-  | otherwise       = unpackImage bar Vty.<|>-                      Vty.string defAttr "[" Vty.<|>-                      Vty.horizCat indicators Vty.<|>-                      Vty.string defAttr "]"-  where-    indicators = foldr aux [] windows-    windows    = views clientWindows Map.elems st+  | null indicators && anon == 0 = Vty.emptyImage+  | otherwise = unpackImage bar Vty.<|>+                Vty.string defAttr "[" Vty.<|>+                Vty.horizCat indicators Vty.<|>+                anonImage Vty.<|>+                Vty.string defAttr "]"+    where+      pal = clientPalette st+      (indicators, impanon, anon) = foldr aux ([], 0, 0) windows+      spacer+        | null indicators = Vty.string defAttr "+"+        | otherwise       = Vty.string defAttr " +"+      anonImage+        | anon == 0 = Vty.emptyImage+        | impanon == 0 = spacer Vty.<|>+                         Vty.string (view palActivity pal) (show anon)+        | otherwise = spacer Vty.<|>+                      Vty.string (view palMention pal) (show impanon) Vty.<|>+                      Vty.string defAttr "/" Vty.<|>+                      Vty.string (view palActivity pal) (show anon)+      windows    = views clientWindows Map.elems st -    aux w rest =-      let name = case view winName w of-                   Nothing -> '?'-                   Just i -> i in-      case view winMention w of-        WLImportant -> Vty.char (view palMention  pal) name : rest-        WLNormal    -> Vty.char (view palActivity pal) name : rest-        WLBoring    -> rest-      where-        pal = clientPalette st+      aux :: Window -> ([Vty.Image], Int, Int) -> ([Vty.Image], Int, Int)+      aux w (indicators', impanon', anon') = case (view winName w, view winMention w) of+          (Nothing, WLImportant)   -> (indicators', impanon'+1, anon'+1)+          (Nothing, WLNormal)      -> (indicators', impanon', anon'+1)+          (Just name, WLImportant) -> (Vty.char (view palMention pal) name : indicators', impanon', anon')+          (Just name, WLNormal)    -> (Vty.char (view palActivity pal) name : indicators', impanon', anon')+          _                        -> (indicators', impanon', anon')  -- | Multi-line activity information enabled by F3 activityBarImages :: ClientState -> [Vty.Image]@@ -237,36 +246,18 @@   = mapMaybe baraux   $ Map.toAscList   $ view clientWindows st-   where-    baraux (focus,w)+    baraux pair@(_,w)       | view winActivityFilter w == AFSilent = Nothing       | n == 0 = Nothing -- todo: make configurable-      | otherwise = Just-                  $ unpackImage bar Vty.<|>-                    Vty.char defAttr '[' Vty.<|>-                    jumpLabel Vty.<|>-                    focusLabel Vty.<|>-                    Vty.char defAttr ':' Vty.<|>-                    Vty.string attr (show n) Vty.<|>-                    Vty.char defAttr ']'+      | otherwise = Just $+        unpackImage bar Vty.<|>+        Vty.char defAttr '[' Vty.<|>+        unpackImage (windowLabel' pair) Vty.<|>+        Vty.char defAttr ']'       where-        jumpLabel =-          case view winName w of-            Nothing   -> mempty-            Just name -> Vty.char (view palWindowName pal) name Vty.<|>-                         Vty.char defAttr ':'-        n   = view winUnread w-        pal = clientPalette st-        attr = case view winMention w of-                 WLImportant -> view palMention pal-                 _           -> view palActivity pal-        focusLabel =-          unpackImage $ case focus of-            Unfocused           -> text' (view palLabel pal) (Text.pack "*")-            NetworkFocus net    -> text' (view palLabel pal) (cleanText net)-            ChannelFocus _ chan -> coloredIdentifier pal NormalIdentifier HashMap.empty chan-+        windowLabel' = windowLabel st+        n = view winUnread w  -- | Pack a list of images into a single image spanning possibly many lines. -- The images will stack upward with the first element of the list being in@@ -291,7 +282,6 @@       where         fillsize = max 0 (w - Vty.imageWidth acc) - myNickImage :: ClientState -> Vty.Image myNickImage st =   case view clientFocus st of@@ -321,81 +311,52 @@               | otherwise                = " " <>                 modesImage (view palModes pal) (view palSnomask netpal) ('+':view csSnomask cs) -subfocusImage :: Subfocus -> ClientState -> Image'-subfocusImage subfocus st = foldMap infoBubble (viewSubfocusLabel pal subfocus)-  where-    pal         = clientPalette st--focusImage :: Focus -> ClientState -> Image'-focusImage focus st =-  infoBubble $-  case preview (clientWindows . ix focus . winName . _Just) st of-    Nothing -> label-    Just n  -> char (view palWindowName pal) n <> ":" <> label-  where-    !pal        = clientPalette st-    label       = viewFocusLabel st focus- parens :: Attr -> Vty.Image -> Vty.Image parens attr i = Vty.char attr '(' Vty.<|> i Vty.<|> Vty.char attr ')' -viewFocusLabel :: ClientState -> Focus -> Image'-viewFocusLabel st focus =-  let-    !pal = clientPalette st-    netpal = clientNetworkPalette st-  in case focus of-    Unfocused ->-      char (view palError pal) '*'-    NetworkFocus network ->-      text' (view palLabel pal) (cleanText network)-    ChannelFocus network channel ->-      text' (view palLabel pal) (cleanText network) <>-      char defAttr ':' <>-      string (view palSigil pal) (cleanChar <$> sigils) <>-      coloredIdentifier pal NormalIdentifier HashMap.empty channel <>-      channelModes--      where-        (sigils, channelModes) =-          case preview (clientConnection network) st of-            Nothing -> ("", mempty)-            Just cs ->-               ( let nick = view csNick cs in-                 view (csChannels . ix channel . chanUsers . ix nick) cs--               , case preview (csChannels . ix channel . chanModes) cs of-                    Just modeMap | not (null modeMap) ->-                        " " <> modesImage (view palModes pal) (view palCModes netpal) ('+':Map.keys modeMap)-                    _ -> mempty-               )--viewSubfocusLabel :: Palette -> Subfocus -> Maybe Image'-viewSubfocusLabel pal subfocus =+currentViewImage :: Bool -> ClientState -> Subfocus -> Focus -> Image'+currentViewImage showFull st subfocus focus =   case subfocus of-    FocusMessages     -> Nothing-    FocusWindows filt -> Just $ string (view palLabel pal) "windows" <>-                                opt (windowFilterName filt)-    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"-    FocusDigraphs     -> Just $ string (view palLabel pal) "digraphs"-    FocusKeyMap       -> Just $ string (view palLabel pal) "keymap"-    FocusHelp mb      -> Just $ string (view palLabel pal) "help" <> opt mb-    FocusIgnoreList   -> Just $ string (view palLabel pal) "ignores"-    FocusRtsStats     -> Just $ string (view palLabel pal) "rtsstats"-    FocusCert{}       -> Just $ string (view palLabel pal) "cert"-    FocusChanList _ _ -> Just $ string (view palLabel pal) "channels"-    FocusWho          -> Just $ string (view palLabel pal) "who"-    FocusMasks m      -> Just $ mconcat-      [ string (view palLabel pal) "masks"-      , char defAttr ':'-      , char (view palLabel pal) m-      ]+    FocusMessages         -> windowName <> focusLabel labelType st focus+    FocusWindows filt     -> string defAttr "windows" <> opt (windowFilterName filt)+    FocusInfo net chan    -> string defAttr "info" <> ctxLabel (ChannelFocus net chan)+    FocusUsers net chan   -> string defAttr "names" <> ctxLabel (ChannelFocus net chan)+    FocusMentions         -> string defAttr "mentions"+    FocusPalette          -> string defAttr "palette"+    FocusDigraphs         -> string defAttr "digraphs"+    FocusKeyMap           -> string defAttr "keymap"+    FocusHelp             -> string defAttr "help" <> helpQuery+    FocusIgnoreList       -> string defAttr "ignores"+    FocusRtsStats         -> string defAttr "rtsstats"+    FocusCert{}           -> string defAttr "cert"+    FocusChanList net _ _ -> string defAttr "channels" <> ctxLabel (NetworkFocus net)+    FocusWho net          -> string defAttr "who" <> whoTarget net+    FocusMasks net chan m -> string defAttr "masks" <> maskLabel m <> ctxLabel (ChannelFocus net chan)   where-    opt = foldMap (\cmd -> char defAttr ':' <>+    labelType = if showFull then FocusLabelLong else FocusLabelShort+    !pal = clientPalette st+    ctxLabel focus' = char defAttr ' ' <> focusLabel FocusLabelShort st focus'+    maskLabel m = char defAttr ' ' <> char (view palLabel pal) m+    opt = foldMap (\cmd -> char defAttr ' ' <>                            text' (view palLabel pal) cmd)+    windowName+      | showFull = case preview (clientWindows . ix focus . winName . _Just) st of+          Just n -> char (view palWindowName pal) n <> ":"+          _      -> mempty+      | otherwise = mempty+    whoTarget net = case preview (clientConnection net . csWhoReply . whoQuery) st of+      Just (query, _) | Text.null query -> ctxLabel (NetworkFocus net)+      Just (query, _) -> ctxLabel (ChannelFocus net $ mkId query)+      _ -> mempty+    helpQuery = case view (clientHelp . hsQuery) st of+      HelpList ->+        mempty+      HelpCmd txt ->+        char defAttr ' ' <> text' defAttr txt+      HelpNet net txt ->+        char defAttr ' ' <> text' (view palLabel pal) (cleanText net) <> char defAttr ':' <> text' defAttr txt+      HelpNetPartial net txt _ ->+        char defAttr ' ' <> text' (view palLabel pal) (cleanText net) <> char defAttr ':' <> text' defAttr txt  windowFilterName :: WindowsFilter -> Maybe Text windowFilterName x =

@@ -21,6 +21,7 @@ import Client.Commands.Arguments.Parser (parse) import Client.Commands.Interpolation (Macro(macroSpec), MacroSpec(..)) import Client.Commands.Recognizer+import Client.Commands.Types (makeArgsContext) import Client.Image.LineWrap (fullLineWrap, terminate) import Client.Image.Message (cleanChar, parseIrcTextWithNicks, Highlight) import Client.Image.MircFormatting (parseIrcText', plainText)@@ -197,7 +198,7 @@                    <> string attr cleanCmd <> continue rest       where         specAttr spec =-          case parse st spec rest of+          case parse (makeArgsContext st) spec rest of             Nothing -> view palCommand      pal             Just{}  -> view palCommandReady pal @@ -209,7 +210,7 @@           = case recognize (Text.toLower (Text.pack cmd)) allCommands of               Exact (Right Command{cmdArgumentSpec = spec}) ->                 ( specAttr spec-                , render pal st focused spec+                , render pal (makeArgsContext st) focused spec                 )               Exact (Left (MacroSpec spec)) ->                 ( specAttr spec

@@ -39,11 +39,12 @@ import Control.Lens import Data.Maybe (isJust) import Data.Text (Text)+import Data.Text qualified as Text import Data.Time (ZonedTime)-import Irc.Codes (ReplyCode, pattern RPL_NOWAWAY, pattern RPL_UNAWAY )+import Irc.Codes (ReplyCode, pattern RPL_NOWAWAY, pattern RPL_UNAWAY, pattern RPL_MONONLINE, pattern RPL_MONOFFLINE ) import Irc.Identifier (Identifier, mkId) import Irc.Message (IrcMsg(..), ircMsgText, Source(srcUser))-import Irc.UserInfo ( UserInfo(userNick) )+import Irc.UserInfo (UserInfo(userNick), parseUserInfo, uiNick)  data MessageBody   = IrcBody    !IrcMsg@@ -71,11 +72,13 @@   | PartSummary {-# UNPACK #-} !Identifier   | NickSummary {-# UNPACK #-} !Identifier {-# UNPACK #-} !Identifier   | ReplySummary {-# UNPACK #-} !ReplyCode-  | ChatSummary {-# UNPACK #-} !UserInfo+  | ChatSummary {-# UNPACK #-} !UserInfo -- userinfo to help with ignore rules   | CtcpSummary {-# UNPACK #-} !Identifier   | ChngSummary {-# UNPACK #-} !Identifier -- ^ Chghost command   | AcctSummary {-# UNPACK #-} !Identifier -- ^ Account command   | AwaySummary {-# UNPACK #-} !Identifier !Bool+  | TagmSummary {-# UNPACK #-} !Identifier -- ^ TAGMSG command+  | MonSummary {-# UNPACK #-} !Identifier !Bool -- ^ MONITOR numeric replies   | NoSummary   deriving (Eq, Show) @@ -92,7 +95,6 @@ msgSummary (ErrorBody  _  ) = NoSummary msgSummary (NormalBody _  ) = NoSummary - ircSummary :: IrcMsg -> IrcSummary ircSummary msg =   case msg of@@ -107,10 +109,15 @@     CtcpNotice who _ _ _ -> ChatSummary (srcUser who)     Reply _ RPL_NOWAWAY (who:_) -> AwaySummary (mkId who) True     Reply _ RPL_UNAWAY  (who:_) -> AwaySummary (mkId who) False+    Reply _ RPL_MONONLINE [_,who]  | [who'] <- Text.split (==',') who ->+      MonSummary (view uiNick $ parseUserInfo who') True+    Reply _ RPL_MONOFFLINE [_,who] | [who'] <- Text.split (==',') who ->+      MonSummary (mkId who') False     Reply _ code _  -> ReplySummary code     Account who _   -> AcctSummary (userNick (srcUser who))     Chghost who _ _ -> ChngSummary (userNick (srcUser who))     Away who mb     -> AwaySummary (userNick (srcUser who)) (isJust mb)+    Tagmsg who _    -> TagmSummary (userNick (srcUser who))     _               -> NoSummary  quitKind :: Maybe Text -> QuitKind@@ -131,5 +138,7 @@     AcctSummary who   -> Just who     ChngSummary who   -> Just who     AwaySummary who _ -> Just who+    TagmSummary who   -> Just who     ReplySummary {}   -> Nothing+    MonSummary who _  -> Just who     NoSummary         -> Nothing

@@ -27,6 +27,7 @@   , NetworkEvent(..)   , createConnection   , Client.Network.Async.send+  , sendNext   , Client.Network.Async.recv   , upgrade @@ -120,6 +121,13 @@ -- newline terminator. send :: NetworkConnection -> ByteString -> IO () send c msg = atomically (writeTQueue (connOutQueue c) msg)++-- | Insert a message to be transmitted on the network connection immediately.+-- These messages are sent unmodified. The message should contain a+-- newline terminator. This should be used for very high priority messages+-- that must not get stuck in the queue.+sendNext :: NetworkConnection -> ByteString -> IO ()+sendNext c msg = atomically (unGetTQueue (connOutQueue c) msg)  recv :: NetworkConnection -> STM [NetworkEvent] recv = flushTQueue . connInQueue

@@ -79,6 +79,7 @@   , clientActiveCommand   , clientNextWindowName   , clientWindowHint+  , clientHelp    , clientExtraFocuses   , currentNickCompletionMode@@ -126,15 +127,17 @@ import           Client.State.Channel import qualified Client.State.EditBox as Edit import           Client.State.Focus+import           Client.State.Help import           Client.State.Network import           Client.State.Window+import           Client.State.Target (MessageTarget(..)) import           ContextFilter import           Control.Applicative import           Control.Concurrent.MVar import           Control.Concurrent.STM import           Control.Exception import           Control.Lens-import           Control.Monad+import           Control.Monad() import           Data.Foldable import           Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap@@ -153,7 +156,7 @@ import           Foreign.StablePtr import           Irc.Codes import           Irc.Identifier-import           Irc.Message+import           Irc.Message hiding (MessageTarget(..)) import           Irc.RawIrcMsg import           Irc.UserInfo import           LensUtils@@ -206,6 +209,7 @@    , _clientStsPolicy         :: !(HashMap Text StsPolicy) -- ^ STS policy entries   , _clientHighlights        :: !(HashMap Identifier Highlight) -- ^ highlights+  , _clientHelp              :: !HelpState                -- ^ cached help text   }  data Matcher = Matcher@@ -293,6 +297,7 @@         , _clientRtsStats          = Nothing         , _clientStsPolicy         = sts         , _clientHighlights        = HashMap.empty+        , _clientHelp              = makeHelp Nothing []         }  withExtensionState :: (ExtensionState -> IO a) -> IO a@@ -434,6 +439,8 @@                      | otherwise -> WLBoring         Kick _ _ kicked _ | isMe kicked -> WLImportant                           | otherwise   -> WLNormal+        Invite _ tgt _    | isMe tgt    -> WLImportant+                          | otherwise   -> WLNormal         Error{} -> WLImportant          -- away notices@@ -467,6 +474,7 @@     Ctcp who _ "ACTION" _ -> checkUser who     -- notice ctcp responses are not already metadata     CtcpNotice who _ _ _ -> checkUser who+    Invite who _ _       -> checkUser who     _                    -> Nothing   where     checkUser !who@@ -492,6 +500,7 @@ recordIrcMessage network target msg st =   updateTransientError (NetworkFocus network) msg $   case target of+    TargetDrop         -> st     TargetNetwork      -> recordNetworkMessage msg st     TargetExisting win -> recordChannelMessage' False network win  msg st     TargetWindow chan  -> recordChannelMessage' True  network chan msg st@@ -746,7 +755,9 @@   Maybe Matcher {- ^ optional predicate -} clientMatcher st =   case clientActiveCommand st of+    -- Refer to the grep command in Client.Commands.Window     Just ("grep" , reStr) -> buildMatcher reStr+    Just ("g" , reStr)    -> buildMatcher reStr     _ -> case view clientRegex st of            Nothing -> Nothing            Just r  -> Just r@@ -919,6 +930,7 @@   where     Apply reply cs' = applyMessage time irc cs     st' = applyWindowRenames network irc+        . applyHelpIfAwaiting network irc         $ set (clientConnections . ix network) cs' st  -- | When a nick change happens and there is an open query window for that nick@@ -950,6 +962,10 @@  applyWindowRenames _ _ st = st +applyHelpIfAwaiting :: Text {- ^ network -} -> IrcMsg -> ClientState -> ClientState+applyHelpIfAwaiting network irc st+  | awaitingHelp (_clientHelp st) == Just network = over clientHelp (applyHelpReply (clientPalette st) irc) st+  | otherwise = st  ------------------------------------------------------------------------ -- Scrolling@@ -976,16 +992,21 @@ -- considered important and will be jumped to first. jumpToActivity :: ClientState -> ClientState jumpToActivity st =-  case mplus highPriority lowPriority of-    Just (focus,_) -> changeFocus focus st+  case locate (Nothing, 1) windowList of+    Just focus -> changeFocus focus st     Nothing ->       case view clientActivityReturn st of         Just focus -> changeFocus focus st         Nothing    -> st   where-    windowList   = views clientWindows Map.toAscList st-    highPriority = find (\x -> WLImportant == view winMention (snd x)) windowList-    lowPriority  = find (\x -> view winUnread (snd x) > 0) windowList+    windowList = views clientWindows Map.toAscList st+    locate (v, _) [] = v+    locate vp@(_, vRank) ((f,w):wins)+      | fRank == 5 = Just f -- Short circuit+      | fRank > vRank = locate (Just f, fRank) wins+      | otherwise = locate vp wins+      where+        fRank = fromEnum (isJust $ view winName w) + 2 * fromEnum (view winMention w)  -- | Jump the focus directly to a window based on its zero-based index -- while ignoring hidden windows.

@@ -17,14 +17,15 @@   (   -- * Channel state     ChannelState(..)+  , chanCreation+  , chanJoined+  , chanLists+  , chanModes+  , chanQueuedModeration   , chanTopic   , chanTopicProvenance   , chanUrl   , chanUsers-  , chanModes-  , chanLists-  , chanCreation-  , chanQueuedModeration    -- * Mask list entries   , MaskListEntry(..)@@ -58,7 +59,9 @@  -- | Dynamic information about the state of an IRC channel data ChannelState = ChannelState-  { _chanTopic :: !Text+  { _chanJoined :: !Bool+        -- ^ client is currently connected to this channel+  , _chanTopic :: !Text         -- ^ topic text   , _chanTopicProvenance :: !(Maybe TopicProvenance)         -- ^ author and timestamp for topic@@ -94,7 +97,8 @@ -- | Construct an empty 'ChannelState' newChannel :: ChannelState newChannel = ChannelState-  { _chanTopic = Text.empty+  { _chanJoined = False+  , _chanTopic = Text.empty   , _chanUrl = Nothing   , _chanTopicProvenance = Nothing   , _chanUsers = HashMap.empty

@@ -19,7 +19,10 @@   , WindowsFilter(..)    -- * Focus operations+  , parseFocus   , focusNetwork+  , actualFocus+  , isPrefixOfFocus    -- * Focus Prisms   , _ChannelFocus@@ -27,9 +30,10 @@   , _Unfocused   ) where -import Control.Lens (makePrisms)-import Data.Text (Text)-import Irc.Identifier (Identifier)+import           Control.Lens (makePrisms, (<&>))+import           Data.Text (Text)+import qualified Data.Text as Text+import           Irc.Identifier (Identifier, idPrefix, mkId)  -- | Currently focused window data Focus@@ -43,20 +47,20 @@ -- | Subfocus view data Subfocus   = FocusMessages    -- ^ Show messages-  | FocusInfo        -- ^ Show channel metadata-  | FocusUsers       -- ^ Show channel user list-  | FocusMasks !Char -- ^ Show channel mask list for given mode+  | FocusInfo  !Text !Identifier       -- ^ Show channel metadata+  | FocusUsers !Text !Identifier       -- ^ Show channel user list+  | FocusMasks !Text !Identifier !Char -- ^ Show channel mask list for given mode   | FocusWindows WindowsFilter -- ^ Show client windows   | FocusPalette     -- ^ Show current palette   | FocusMentions    -- ^ Show all mentions   | FocusDigraphs    -- ^ Show all digraphs   | FocusKeyMap      -- ^ Show key bindings-  | FocusHelp (Maybe Text) -- ^ Show help window with optional command+  | FocusHelp        -- ^ Show help window   | FocusRtsStats    -- ^ Show GHC RTS statistics   | FocusIgnoreList  -- ^ Show ignored masks   | FocusCert        -- ^ Show rendered certificate-  | FocusChanList (Maybe Int) (Maybe Int) -- ^ Show channel list-  | FocusWho -- ^ Show last reply to a WHO query+  | FocusChanList !Text (Maybe Int) (Maybe Int) -- ^ Show channel list+  | FocusWho !Text -- ^ Show last reply to a WHO query   deriving (Eq,Show)  -- | Unfocused first, followed by focuses sorted by network.@@ -78,6 +82,41 @@ focusNetwork Unfocused = Nothing focusNetwork (NetworkFocus network) = Just network focusNetwork (ChannelFocus network _) = Just network++-- | Returns what focus a subfocus is actually for.+actualFocus :: Subfocus -> Focus -> Focus+actualFocus sf = case sf of+  FocusInfo  net chan   -> const (ChannelFocus net chan)+  FocusUsers net chan   -> const (ChannelFocus net chan)+  FocusMasks net chan _ -> const (ChannelFocus net chan)+  FocusChanList net _ _ -> const (NetworkFocus net)+  FocusWho net          -> const (NetworkFocus net)+  _ -> id++-- | Parses a single focus name given a default network.+parseFocus ::+  Maybe Text {- ^ default network    -} ->+  String {- ^ @[network:]target@ -} ->+  Maybe Focus+parseFocus mbNet x =+  case break (==':') x of+    ("*","")     -> pure Unfocused+    (net,_:"")   -> pure (NetworkFocus (Text.pack net))+    (net,_:chan) -> pure (ChannelFocus (Text.pack net) (mkId (Text.pack chan)))+    (chan,"")    -> mbNet <&> \net ->+                    ChannelFocus net (mkId (Text.pack chan))++isPrefixOfFocus :: String -> Focus -> Bool+isPrefixOfFocus prefix focus = case break (==':') prefix of+  ("","")  -> True+  ("*","") -> focus == Unfocused+  (chan,"") -> case focus of +    ChannelFocus _    chanF -> idPrefix (mkId $ Text.pack chan) chanF+    NetworkFocus netF       -> Text.isPrefixOf (Text.pack chan) netF+    Unfocused               -> False+  (net,_:chan) -> case focus of+    ChannelFocus netF chanF -> netF == Text.pack net && idPrefix (mkId $ Text.pack chan) chanF+    _ -> False  -- | Filter argument for 'FocusWindows' data WindowsFilter

@@ -0,0 +1,76 @@+{-# Language TemplateHaskell, OverloadedStrings #-}++{-|+Module      : Client.State.Help+Description : Type and utility functions for the help buffer+Copyright   : (c) TheDaemoness, 2024+License     : ISC+Maintainer  : emertens@gmail.com++The help buffer is basically a glorified list of @Image'@s with some additional bookkeeping data.+-}++module Client.State.Help+  (HelpState+  , HelpQuery(..)+  , hsQuery+  , hsImages+  , helpQueryToText+  , makeHelp+  , awaitHelp+  , awaitingHelp+  , applyHelpReply+  ) where++import Client.Image.PackedImage (Image')+import Control.Lens+import Data.Text (Text, append)+import Irc.Codes+import Irc.Message (IrcMsg (Reply))+import Client.Image.MircFormatting (parseIrcText)+import Client.Image.Palette (Palette)++data HelpQuery = HelpList | HelpCmd Text | HelpNet Text Text | HelpNetPartial Text Text (Maybe Text)++helpQueryToText :: HelpQuery -> Maybe Text+helpQueryToText (HelpList)                   = Nothing+helpQueryToText (HelpCmd txt)                = Just txt+helpQueryToText (HelpNet net topic)          = Just (net `append` ":" `append` topic)+helpQueryToText (HelpNetPartial net topic _) = Just (net `append` ":" `append` topic)++-- | Cached help query and rendered help text.+data HelpState = HelpState+  { _hsQuery  :: HelpQuery+  , _hsImages :: [Image']+  }++makeLenses ''HelpState++makeHelp :: Maybe Text -> [Image'] -> HelpState+makeHelp (Just cmd) images = HelpState { _hsQuery = HelpCmd cmd, _hsImages = images }+makeHelp Nothing    images = HelpState { _hsQuery = HelpList,    _hsImages = images }++awaitHelp :: Text -> Text -> HelpState+awaitHelp net query = HelpState { _hsQuery = HelpNetPartial net query Nothing, _hsImages = [] }++awaitingHelp :: HelpState -> Maybe Text+awaitingHelp hs = case _hsQuery hs of+  HelpNetPartial net _ _ -> Just net+  _                      -> Nothing++applyHelpReply :: Palette -> IrcMsg -> HelpState -> HelpState+applyHelpReply pal irc hs = case (irc, _hsQuery hs) of+  (Reply _ RPL_HELPSTART (_:rtopic':text:_), HelpNetPartial net topic Nothing) ->+    HelpState+       { _hsQuery = HelpNetPartial net topic (Just rtopic')+       , _hsImages = [parseIrcText pal text]+       }+  (Reply _ RPL_HELPTXT (_:rtopic':text:_), HelpNetPartial _ _ (Just rtopic)) | rtopic' == rtopic ->+    hs { _hsImages = parseIrcText pal text:_hsImages hs }+  (Reply _ RPL_ENDOFHELP (_:rtopic':text:_), HelpNetPartial net topic (Just rtopic)) | rtopic' == rtopic ->+    HelpState+      { _hsQuery = HelpNet net topic+      , _hsImages = parseIrcText pal text:_hsImages hs+      }+  _ -> hs+

@@ -51,6 +51,7 @@   , csAuthenticationState   , csSeed   , csAway+  , csJoinedChannels   , clsElist   , clsDone   , clsItems@@ -230,6 +231,11 @@ csNick :: Lens' NetworkState Identifier csNick = csUserInfo . uiNick +-- | Transmit a 'RawIrcMsg' with high priority. This is done without+-- the message splitting that 'sendMsg' usually does.+sendMsgNext :: NetworkState -> RawIrcMsg -> IO ()+sendMsgNext cs msg = send (view csSocket cs) (renderRawIrcMsg msg)+ -- | Transmit a 'RawIrcMsg' on the connection associated -- with the given network. For @PRIVMSG@ and @NOTICE@ overlong -- commands are detected and transmitted as multiple messages.@@ -351,8 +357,14 @@ reply :: [RawIrcMsg] -> NetworkState -> Apply reply = Apply +-- Fold over the channels we're currently joined+csJoinedChannels :: Fold NetworkState ChannelState+csJoinedChannels = csChannels . folded . filtered _chanJoined++-- | Apply an update function to a channel. If the channel doesn't+-- exist the update function is applied to a fresh channel overChannel :: Identifier -> (ChannelState -> ChannelState) -> NetworkState -> NetworkState-overChannel chan = overStrict (csChannels . ix chan)+overChannel chan f = overStrict (csChannels . at chan) (Just . f . fromMaybe newChannel)  overChannels :: (ChannelState -> ChannelState) -> NetworkState -> NetworkState overChannels = overStrict (csChannels . traverse)@@ -433,7 +445,7 @@   where     exitChannel chan nick       | nick == view csNick cs = noReply $ pruneUsers-                               $ over csChannels (sans chan) cs+                               $ set (csChannels . ix chan . chanJoined) False cs        | otherwise              = noReply $ forgetUser' nick                                $ overChannel chan (partChannel nick) cs@@ -443,7 +455,8 @@ pruneUsers :: NetworkState -> NetworkState pruneUsers cs = over csUsers (`HashMap.intersection` u) cs   where-    u = foldOf (csChannels . folded . chanUsers) cs+    -- only considers joined (actively updated) channels+    u = foldOf (csJoinedChannels . chanUsers) cs  -- | 001 'RPL_WELCOME' is the first message received when transitioning -- from the initial handshake to a connected state. At this point we know@@ -693,12 +706,10 @@   NetworkState -> NetworkState saveList mode tgt cs    = set csTransaction NoTransaction-   $ setStrict-        (csChannels . ix (mkId tgt) . chanLists . at mode)-        (Just $! newList)-        cs+   $ overChannel (mkId tgt) upd cs   where     newList = HashMap.fromList (view (csTransaction . _BanTransaction) cs)+    upd = set (chanLists . at mode) (Just $! newList)   -- | These replies are interpreted by the client and should only be shown@@ -729,6 +740,9 @@     RPL_LISTSTART       -> True     RPL_LIST            -> True     RPL_LISTEND         -> True+    RPL_HELPSTART       -> True+    RPL_HELPTXT         -> True+    RPL_ENDOFHELP       -> True     _                   -> False  -- | Return 'True' for messages that should be hidden outside of@@ -737,6 +751,7 @@ -- relevant information. squelchIrcMsg :: IrcMsg -> Bool squelchIrcMsg (Reply _ rpl _) = squelchReply rpl+squelchIrcMsg (Tagmsg _ _)    = True -- TODO: Remove after implementing TAGMSG filtering squelchIrcMsg _               = False  doMode ::@@ -766,7 +781,7 @@ -- | Predicate to test if the connection has op in a given channel. iHaveOp :: Identifier -> NetworkState -> Bool iHaveOp channel cs =-  elemOf (csChannels . ix channel . chanUsers . ix me . folded) '@' cs+  elemOf (csChannels . ix channel . filtered _chanJoined . chanUsers . ix me . folded) '@' cs   where     me = view csNick cs @@ -829,7 +844,7 @@       ["multi-prefix", "batch", "znc.in/playback", "znc.in/self-message"       , "cap-notify", "extended-join", "account-notify", "chghost"       , "userhost-in-names", "account-tag", "solanum.chat/identify-msg"-      , "solanum.chat/realhost", "away-notify"]+      , "solanum.chat/realhost", "away-notify", "extended-monitor", "invite-notify", "message-tags"]      -- logic for using IRCv3.2 server-time if available and falling back     -- to ZNC's specific extension otherwise.@@ -1032,8 +1047,10 @@ createOnJoin who chan cs   | userNick who == view csNick cs =         set csUserInfo who -- great time to learn our userinfo-      $ set (csChannels . at chan) (Just newChannel) cs+      $ set (csChannels . at chan) (Just newJoinedChannel) cs   | otherwise = cs+  where+    newJoinedChannel = newChannel { _chanJoined = True }  updateMyNick :: Identifier -> Identifier -> NetworkState -> NetworkState updateMyNick oldNick newNick cs@@ -1158,8 +1175,9 @@   where     infos = view (csTransaction . _WhoTransaction) cs +    -- users in channels we're joined to     channelUsers =-      HashSet.fromList (views (csChannels . folded . chanUsers) HashMap.keys cs)+      HashSet.fromList (views (csJoinedChannels . chanUsers) HashMap.keys cs)      updateUsers users = foldl' updateUser users infos @@ -1229,7 +1247,7 @@      TimedSendPing ->       do now <- getCurrentTime-         sendMsg cs (ircPing ["ping"])+         sendMsgNext cs (ircPing ["ping"])          return $! set csNextPingTime (Just $! addUTCTime 60 now)                 $  set csPingStatus   (PingSent now) cs 

@@ -0,0 +1,51 @@+{-# Language BlockArguments, TemplateHaskell, OverloadedStrings, BangPatterns #-}++{-|+Module      : Client.State.Target+Description : IRC message routing+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module contains glirc-specific overrides of the message routing provided by irc-core.+-}++module Client.State.Target+  (+    MessageTarget(..)+  , msgTarget+  ) where++import qualified Data.Text as Text+import           Irc.Codes+import           Irc.Identifier (Identifier, mkId)+import           Irc.Message (IrcMsg(..), srcUser)+import qualified Irc.Message as Msg+import           Irc.UserInfo (userNick, parseUserInfo)++data MessageTarget+  = TargetDrop                 -- ^ Do not record the message anywhere.+  | TargetUser     !Identifier -- ^ Record the message in all channels/PMs shared with the user.+  | TargetWindow   !Identifier -- ^ Directed message to channel or from user.+  | TargetExisting !Identifier -- ^ As @TargetWindow@ but only for existing windows.+  | TargetNetwork              -- ^ Record the message in the network window.++msgTarget :: Identifier -> IrcMsg -> MessageTarget+msgTarget nick msg =+  case msg of+    Authenticate{}  -> TargetDrop+    BatchStart{}    -> TargetDrop+    BatchEnd{}      -> TargetDrop+    Ping{}          -> TargetDrop+    Pong{}          -> TargetDrop+    Away user _     -> TargetExisting (userNick (srcUser user))+    Invite _ _ chan -> TargetWindow chan+    Reply _ RPL_MONONLINE [_,who]  | [who'] <- Text.split (==',') who ->+      TargetWindow (userNick $ parseUserInfo who')+    Reply _ RPL_MONOFFLINE [_,who] | [who'] <- Text.split (==',') who ->+      TargetWindow (mkId who')+    Reply _ RPL_WHOSPCRPL [_,"616",_,_,_,_] -> TargetDrop+    _ -> case Msg.msgTarget nick msg of+      Msg.TargetUser id'   -> TargetUser id'+      Msg.TargetWindow id' -> TargetWindow id'+      Msg.TargetNetwork    -> TargetNetwork

@@ -16,7 +16,7 @@  import           Client.Message (summaryActor) import           Client.State-import           Client.State.Focus (Subfocus(..), focusNetwork, Focus)+import           Client.State.Focus (Subfocus(..), focusNetwork, Focus, actualFocus) import           Client.State.Network import           Client.State.Window import           Client.WhoReply@@ -70,15 +70,15 @@  urlListForFocus :: Focus -> Subfocus -> ClientState -> [UrlPair] urlListForFocus focus subfocus st = case (netM, subfocus) of-  (Just cs, FocusChanList min' max') ->+  (Just cs, FocusChanList _ min' max') ->     matchesTopic st min' max' cs-  (Just cs, FocusWho) ->+  (Just cs, FocusWho _) ->     matchesWhoReply st cs   (_, _) ->     toListOf (clientWindows . ix focus . winMessages . each . folding (matchesMsg st)) st   where     netM = do-      net <- focusNetwork focus+      net <- focusNetwork $ actualFocus subfocus focus       view (clientConnections . at net) st  matchesMsg :: ClientState -> WindowLine -> [UrlPair]

@@ -110,7 +110,7 @@   = WLBoring -- ^ Don't update unread count   | WLNormal -- ^ Increment unread count   | WLImportant -- ^ Increment unread count and set important flag-  deriving (Eq, Ord, Show, Read)+  deriving (Eq, Ord, Show, Read, Enum)  data ActivityFilter   = AFSilent

@@ -16,11 +16,11 @@ import Client.Image.PackedImage (Image') import Client.State import Client.State.Focus+import Client.State.Help (hsImages) import Client.View.Cert (certViewLines) import Client.View.ChannelList (channelListLines) import Client.View.ChannelInfo (channelInfoImages) import Client.View.Digraphs (digraphLines)-import Client.View.Help (helpImageLines) import Client.View.IgnoreList (ignoreListLines) import Client.View.KeyMap (keyMapLines) import Client.View.MaskList (maskListImages)@@ -32,37 +32,37 @@ import Client.View.UserList (userInfoImages, userListImages) import Client.View.Who (whoLines) import Client.View.Windows (windowsImages)+import Client.View.WindowSwitch (windowSwitchImages) import Control.Lens (view)  viewLines :: Focus -> Subfocus -> Int -> ClientState -> [Image'] viewLines focus subfocus w !st =-  case (network', channel', subfocus) of+  case subfocus of     _ | Just ("url",arg) <- clientActiveCommand st ->-      urlSelectionView w focus arg st-    (Just network, Just channel, FocusInfo) ->+      urlSelectionView w focus' arg st+    _ | Just ("c",arg) <- clientActiveCommand st ->+      windowSwitchImages arg w st+    FocusInfo network channel ->       channelInfoImages network channel st-    (Just network, Just channel, FocusUsers)+    FocusUsers network channel       | view clientDetailView st -> userInfoImages network channel st       | otherwise                -> userListImages network channel w st-    (Just network, Just channel, FocusMasks mode) ->+    FocusMasks network channel mode ->       maskListImages mode network channel w st-    (_, _, FocusWindows filt) -> windowsImages filt st-    (_, _, FocusMentions)     -> mentionsViewLines w st-    (_, _, FocusPalette)      -> paletteViewLines pal-    (_, _, FocusDigraphs)     -> digraphLines w st-    (_, _, FocusKeyMap)       -> keyMapLines st-    (_, _, FocusHelp mb)      -> helpImageLines st mb pal-    (_, _, FocusRtsStats)     -> rtsStatsLines (view clientRtsStats st) pal-    (_, _, FocusIgnoreList)   -> ignoreListLines (view clientIgnores st) pal-    (_, _, FocusCert)         -> certViewLines st-    (Just network, _, FocusChanList min' max') ->+    FocusWindows filt -> windowsImages filt st+    FocusMentions     -> mentionsViewLines w st+    FocusPalette      -> paletteViewLines pal+    FocusDigraphs     -> digraphLines w st+    FocusKeyMap       -> keyMapLines st+    FocusRtsStats     -> rtsStatsLines (view clientRtsStats st) pal+    FocusIgnoreList   -> ignoreListLines (view clientIgnores st) pal+    FocusCert         -> certViewLines st+    FocusChanList network min' max' ->       channelListLines network w st (min', max')-    (Just network, _, FocusWho) ->+    FocusWho network ->       whoLines network w st+    FocusHelp         -> view (clientHelp . hsImages) st     _ -> chatMessageImages focus w st   where-    (network', channel') = case focus of-      Unfocused -> (Nothing, Nothing)-      NetworkFocus network -> (Just network, Nothing)-      ChannelFocus network channel -> (Just network, Just channel)     pal = clientPalette st+    focus' = actualFocus subfocus focus

@@ -57,8 +57,8 @@                  string defAttr (show (length entries))      queryPart = mconcat $-      [text' (view palLabel pal) " More-than: " <> string defAttr (show lo) | FocusChanList (Just lo) _ <- [st^.clientSubfocus]] ++-      [text' (view palLabel pal) " Less-than: " <> string defAttr (show hi) | FocusChanList _ (Just hi) <- [st^.clientSubfocus]] +++      [text' (view palLabel pal) " More-than: " <> string defAttr (show lo) | FocusChanList _ (Just lo) _ <- [st^.clientSubfocus]] +++      [text' (view palLabel pal) " Less-than: " <> string defAttr (show hi) | FocusChanList _ _ (Just hi) <- [st^.clientSubfocus]] ++       [text' (view palLabel pal) " Elist: " <> text' defAttr txt | Just txt <- [els], not (Text.null txt)]      entries = chanList^.clsItems

@@ -1,152 +0,0 @@-{-# Language BangPatterns, OverloadedStrings, TransformListComp #-}--{-|-Module      : Client.View.Help-Description : Renderer for help lines-Copyright   : (c) Eric Mertens, 2016-License     : ISC-Maintainer  : emertens@gmail.com--This module provides the rendering used for the @/help@ command.---}-module Client.View.Help-  ( helpImageLines-  ) where--import           Client.State (ClientState, clientConfig)-import           Client.Configuration (configMacros)-import           Client.Commands-import           Client.Commands.Interpolation-import           Client.Commands.Arguments.Spec-import           Client.Commands.Arguments.Renderer-import           Client.Commands.Recognizer-import           Client.Image.MircFormatting-import           Client.Image.PackedImage-import           Client.Image.Palette-import           Control.Lens-import           Data.Foldable (toList)-import           Data.List (delete, intercalate, sortOn)-import           Data.List.NonEmpty (NonEmpty((:|)))-import           Data.Text (Text)-import qualified Data.Text as Text-import           Graphics.Vty.Attributes---- | Generate either the list of all commands and their arguments,--- or when given a command name generate the detailed help text--- for that command.-helpImageLines ::-  ClientState {- ^ client state          -} ->-  Maybe Text  {- ^ optional command name -} ->-  Palette     {- ^ palette               -} ->-  [Image']    {- ^ help lines            -}-helpImageLines st mbCmd pal =-  case mbCmd of-    Nothing  -> listAllCommands st pal-    Just cmd -> commandHelpLines st cmd pal---- | Generate detailed help lines for the command with the given name.-commandHelpLines ::-  ClientState {- ^ client state -} ->-  Text        {- ^ command name -} ->-  Palette     {- ^ palette      -} ->-  [Image']    {- ^ lines        -}-commandHelpLines st cmdName pal =-  case recognize cmdName commands of-    Invalid -> [string (view palError pal) "Unknown command, try /help"]-    Prefix sfxs ->-      [string (view palError pal) $ "Unknown command, did you mean: " ++ suggestions]-      where-      suggestions = Text.unpack $ Text.intercalate " " ((cmdName <>) <$> sfxs)-    Exact Command{cmdNames = names, cmdImplementation = impl,-                  cmdArgumentSpec = spec, cmdDocumentation = doc} ->-      reverse $ heading "Syntax: " <> commandSummary st pal (pure cmdName) spec-              : emptyLine-              : aliasLines-             ++ explainContext impl-              : emptyLine-              : map (parseIrcText pal) (Text.lines doc)-      where-        aliasLines =-          case delete cmdName (toList names) of-            [] -> []-            ns -> [ heading "Aliases: " <>-                    text' defAttr (Text.intercalate ", " ns)-                  , emptyLine ]--heading :: Text -> Image'-heading = text' (withStyle defAttr bold)---- | Generate an explanation of the context where the given command--- implementation will be valid.-explainContext ::-  CommandImpl a {- ^ command implementation -} ->-  Image'        {- ^ help line              -}-explainContext impl =-  heading "Context: " <>-  case impl of-    ClientCommand {} -> "client (works everywhere)"-    NetworkCommand{} -> "network (works when focused on active network)"-    ChannelCommand{} -> "channel (works when focused on active channel)"-    ChatCommand   {} -> "chat (works when focused on an active channel or private message)"----- | Generate the lines for the help window showing all commands.-listAllCommands ::-  ClientState {- ^ client state    -} ->-  Palette     {- ^ palette         -} ->-  [Image']    {- ^ help lines      -}-listAllCommands st pal-  = intercalate [emptyLine]-  $ map reverse-  $ (listCommandSection st pal <$> commandsList)- ++ [macroCommandSection st pal]--macroCommandSection ::-  ClientState    {- ^ client state    -} ->-  Palette        {- ^ palette         -} ->-  [Image']       {- ^ help lines      -}-macroCommandSection st pal-  | null macros = []-  | otherwise =-      text' (withStyle defAttr bold) "Macros" :-      [ commandSummary st pal (pure name) spec-      | Macro name (MacroSpec spec) _ <- macros-      , then sortOn by name-      ]-  where-    macros = toListOf (clientConfig . configMacros . folded) st--listCommandSection ::-  ClientState    {- ^ client state    -} ->-  Palette        {- ^ palette         -} ->-  CommandSection {- ^ command section -} ->-  [Image']       {- ^ help lines      -}-listCommandSection st pal sec-  = text' (withStyle defAttr bold) (cmdSectionName sec)-  : [ commandSummary st pal names spec-    | -- pattern needed due to existential quantification-      Command { cmdNames        = names-              , cmdArgumentSpec = spec-              } <- cmdSectionCmds sec-    ]---- | Generate the help line for the given command and its--- specification for use in the list of commands.-commandSummary ::-  r                {- ^ client state             -} ->-  Palette          {- ^ palette                  -} ->-  NonEmpty Text    {- ^ command name and aliases -} ->-  Args r a         {- ^ argument specification   -} ->-  Image'           {- ^ summary help line        -}-commandSummary st pal (cmd :| _) args  =-  char defAttr '/' <>-  text' (view palCommandReady pal) cmd <>-  render pal' st True args ""--  where-    pal' = set palCommandPlaceholder defAttr pal---- Empty line used as a separator-emptyLine :: Image'-emptyLine = char defAttr ' '

@@ -0,0 +1,40 @@+{-# Language OverloadedStrings #-}+{-|+Module      : Client.View.WindowSwitch+Description : Line renderers for window switcher+Copyright   : (c) TheDaemoness, 2024+License     : ISC+Maintainer  : emertens@gmail.com++This module renders lines used in the preview for /c+-}+module Client.View.WindowSwitch ( windowSwitchImages ) where++import           Client.Image.Focus (windowLabel)+import           Client.Image.PackedImage+import           Client.State+import           Client.State.Focus+import           Client.State.Window (winMention)+import           Control.Lens+import qualified Data.Map.Strict as Map+import           Data.List+import           Data.List.Split+import           Graphics.Vty (defAttr)++-- | Render the lines used by the @/c@ command.+windowSwitchImages ::+  String      {- ^ filter       -} ->+  Int         {- ^ window width -} ->+  ClientState {- ^ client state -} ->+  [Image']+windowSwitchImages arg w st = reverse [mconcat (intersperse gap row) | row <- chunksOf columns paddedNames]+  where+    paddedNames = map (resizeImage maxWidth) nameImages+    nameImages = map (windowLabel st) windowList+    maxWidth   = maximum (map imageWidth nameImages)+    columns    = max 1 ((w+1) `quot` (maxWidth+2))+    gap = string defAttr "  "+    windowList = sortBy activity . filter filterByFocus . Map.toAscList $ view clientWindows st+      where+        filterByFocus (focus,_) = isPrefixOfFocus arg focus+        activity (_,wa) (_,wb) = compare (view winMention wa) (view winMention wb)

@@ -13,7 +13,7 @@   ( windowsImages   ) where -import           Client.Image.Message (coloredIdentifier, IdentifierColorMode (NormalIdentifier))+import           Client.Image.Focus (focusLabel, FocusLabelType(FocusLabelShort)) import           Client.Image.PackedImage import           Client.Image.Palette import           Client.State@@ -21,7 +21,6 @@ import           Client.State.Window import           Client.State.Network import           Control.Lens-import qualified Data.HashMap.Strict as HashMap import           Data.List import           Data.Maybe (fromMaybe) import qualified Data.Map as Map@@ -32,8 +31,8 @@ windowsImages filt st   = reverse   $ createColumns-  $ [ renderWindowColumns pal (char (view palError pal) 'h')    k v | (k,v) <- hiddenWindows ] ++-    [ renderWindowColumns pal (char (view palWindowName pal) (name v)) k v | (k,v) <- windows ]+  $ [ renderWindowColumns st (char (view palError pal) 'h')    k v | (k,v) <- hiddenWindows ] +++    [ renderWindowColumns st (char (view palWindowName pal) (name v)) k v | (k,v) <- windows ]   where     pal = clientPalette st     name = fromMaybe ' ' . view winName@@ -66,15 +65,13 @@  ------------------------------------------------------------------------ --renderWindowColumns :: Palette -> Image' -> Focus -> Window -> [Image']-renderWindowColumns pal name focus win =+renderWindowColumns :: ClientState -> Image' -> Focus -> Window -> [Image']+renderWindowColumns st name focus win =   [ name-  , renderedFocus pal focus-  , renderedWindowInfo pal win+  , focusLabel FocusLabelShort st focus+  , renderedWindowInfo (clientPalette st) win   ] - createColumns :: [[Image']] -> [Image'] createColumns xs = map makeRow xs   where@@ -82,18 +79,6 @@     makeRow = mconcat             . intersperse (char defAttr ' ')             . zipWith resizeImage columnWidths--renderedFocus :: Palette -> Focus -> Image'-renderedFocus pal focus =-  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 ':' <>-      coloredIdentifier pal NormalIdentifier HashMap.empty channel  renderedWindowInfo :: Palette -> Window -> Image' renderedWindowInfo pal win =