diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Revision history for glirc2 +## 2.20.3 + +* Nicer `/help` system, commands are grouped +* Added `/splits+` and `/splits-` for incremental updates to splits +* Jump-to-activity returns to original window after activity is visited +* Extended activity view makes use of empty space above text input +* Parse the timestamp and duration from `/whois` response + ## 2.20.2.1 * Support `vty-5.15` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -266,14 +266,12 @@ * `/disconnect` - Forcefully terminate connection to the current server * `/reconnect` - Reconnect to the current server * `/reload [path]` - Load a new configuration file (optional path) -* `/windows [filter]` - List all open windows (filters: networks, channels, users) * `/palette` - Show the client palette * `/digraphs` - Show the table of digraphs * `/mentions` - Show all the highlighted lines across all windows * `/extension ` - Send the given params to the named extension * `/exec [-n network] [-c channel] ` - Execute a command, If no network or channel are provided send output to client window, if network and channel are provided send output as messages, if network is provided send output as raw IRC messages. * `/url [n]` - Execute url-opener on the nth URL in the current window (defaults to first) -* `/splits [focuses...]` - Enable split-screen view. Focuses should be space delimited list of NETWORK:CHANNEL Connection commands @@ -282,11 +280,15 @@ Window management +* `/windows [filter]` - List all open windows (filters: networks, channels, users) * `/focus ` - Change focus to server window * `/focus ` - Change focus to channel window * `/clear [network] [channel]` - Clear contents of current or specified window * `/ignore ` - Toggle ignore of a user * `/channel ` - Change focus to channel on current network (alias: `/c`) +* `/splits [focuses...]` - Enable split-screen view. Focuses should be space delimited list of NETWORK:CHANNEL +* `/splits+ [focuses...]` - Incremental addition to splits +* `/splits- [focuses...]` - Incremental removal from splits Channel membership diff --git a/glirc.cabal b/glirc.cabal --- a/glirc.cabal +++ b/glirc.cabal @@ -1,5 +1,5 @@ name: glirc -version: 2.20.2.1 +version: 2.20.3 synopsis: Console IRC client description: Console IRC client . @@ -128,7 +128,7 @@ containers >=0.5.7 && <0.6, directory >=1.2.6 && <1.4, filepath >=1.4.1 && <1.5, - gitrev >=1.2 && <1.3, + gitrev >=1.2 && <1.4, hashable >=1.2.4 && <1.3, HsOpenSSL >=0.11 && <0.12, irc-core >=2.2 && <2.3, diff --git a/src/Client/Commands.hs b/src/Client/Commands.hs --- a/src/Client/Commands.hs +++ b/src/Client/Commands.hs @@ -18,6 +18,7 @@ , commandExpansion , tabCompletion -- * Commands + , CommandSection(..) , Command(..) , CommandImpl(..) , commands @@ -44,7 +45,7 @@ import Control.Monad import Data.Foldable import Data.HashSet (HashSet) -import Data.List (nub) +import Data.List (nub, (\\)) import Data.List.NonEmpty (NonEmpty((:|))) import Data.List.Split import qualified Data.HashMap.Strict as HashMap @@ -113,6 +114,13 @@ , cmdImplementation :: CommandImpl a } +-- | A command section is a logical grouping of commands. This allows for +-- showing more structure in the help menu system. +data CommandSection = CommandSection + { cmdSectionName :: Text + , cmdSectionCmds :: [Command] + } + -- | Consider the text entry successful and resume the client commandSuccess :: Monad m => ClientState -> m CommandResult commandSuccess = return . CommandSuccess @@ -274,67 +282,24 @@ -- | Map of built-in client commands to their implementations, tab completion -- logic, and argument structures. commands :: Recognizer Command -commands = fromCommands (expandAliases commandsList) +commands = fromCommands (expandAliases (concatMap cmdSectionCmds commandsList)) -- | Raw list of commands in the order used for @/help@ -commandsList :: [Command] +commandsList :: [CommandSection] commandsList = - -- - -- Client commands - -- - [ Command - (pure "connect") - (ReqTokenArg "network" NoArg) - "Connect to \^Bnetwork\^B by name.\n\ - \\n\ - \If no name is configured the hostname is the 'name'.\n" - $ ClientCommand cmdConnect tabConnect - , Command + ------------------------------------------------------------------------ + [ CommandSection "Client commands" + ------------------------------------------------------------------------ + + [ Command (pure "exit") NoArg "Exit the client immediately.\n" $ ClientCommand cmdExit noClientTab , Command - (pure "focus") - (ReqTokenArg "network" (OptTokenArg "channel" NoArg)) - "Change the focused window.\n\ - \\n\ - \When only \^Bnetwork\^B is specified this switches to the network status window.\n\ - \When \^Bnetwork\^B and \^Bchannel\^B are specified this switches to that chat window.\n\ - \\n\ - \Nicknames can be specified in the \^Bchannel\^B parameter to switch to private chat.\n\ - \See also: /channel (aliased /c) to switch to a channel on the current network.\n" - $ ClientCommand cmdFocus tabFocus - - , Command - (pure "clear") - (OptTokenArg "network" (OptTokenArg "channel" NoArg)) - "Clear a window.\n\ - \\n\ - \If no arguments are provided the current window is cleared.\n\ - \If \^Bnetwork\^B is provided the that network window is cleared.\n\ - \If \^Bnetwork\^B and \^Bchannel\^B are provided that chat window is cleared.\n\ - \If \^Bnetwork\^B is provided and \^Bchannel\^B is \^B*\^O all windows for that network are cleared.\n\ - \\n\ - \If a window is cleared and no longer active that window will be removed from the client.\n" - $ ClientCommand cmdClear tabFocus - - , Command - (pure "reconnect") - NoArg - "Reconnect to the current network.\n" - $ ClientCommand cmdReconnect noClientTab - - , Command - (pure "ignore") - (RemainingArg "nicks") - "Toggle the soft-ignore on each of the space-delimited given nicknames.\n" - $ ClientCommand cmdIgnore simpleClientTab - - , Command (pure "reload") (OptTokenArg "filename" NoArg) "Reload the client configuration file.\n\ @@ -352,21 +317,6 @@ $ ClientCommand cmdExtension simpleClientTab , Command - (pure "windows") - (OptTokenArg "kind" NoArg) - "Show a list of all windows with an optional argument to limit the kinds of windows listed.\n\ - \\n\ - \\^Bkind\^O: one of \^Bnetworks\^O, \^Bchannels\^O, \^Busers\^O\n\ - \\n" - $ ClientCommand cmdWindows tabWindows - - , Command - (pure "mentions") - NoArg - "Show a list of all message that were highlighted as important.\n" - $ ClientCommand cmdMentions noClientTab - - , Command (pure "palette") NoArg "Show the current palette settings and a color chart to help pick new colors.\n" @@ -421,7 +371,93 @@ \When \^Bcommand\^B is specified detailed help for that command is shown.\n" $ ClientCommand cmdHelp tabHelp + ------------------------------------------------------------------------ + ] , CommandSection "Connection commands" + ------------------------------------------------------------------------ + + [ Command + (pure "connect") + (ReqTokenArg "network" NoArg) + "Connect to \^Bnetwork\^B by name.\n\ + \\n\ + \If no name is configured the hostname is the 'name'.\n" + $ ClientCommand cmdConnect tabConnect + , Command + (pure "reconnect") + NoArg + "Reconnect to the current network.\n" + $ ClientCommand cmdReconnect noClientTab + + , Command + (pure "disconnect") + NoArg + "Immediately terminate the current network connection.\n\ + \\n\ + \See also: /quit /exit\n" + $ NetworkCommand cmdDisconnect noNetworkTab + + , Command + (pure "quit") + (RemainingArg "reason") + "Gracefully disconnect the current network connection.\n\ + \\n\ + \\^Breason\^B: optional quit reason\n\ + \\n\ + \See also: /disconnect /exit\n" + $ NetworkCommand cmdQuit simpleNetworkTab + + ------------------------------------------------------------------------ + ] , CommandSection "Window management" + ------------------------------------------------------------------------ + + [ Command + (pure "focus") + (ReqTokenArg "network" (OptTokenArg "channel" NoArg)) + "Change the focused window.\n\ + \\n\ + \When only \^Bnetwork\^B is specified this switches to the network status window.\n\ + \When \^Bnetwork\^B and \^Bchannel\^B are specified this switches to that chat window.\n\ + \\n\ + \Nicknames can be specified in the \^Bchannel\^B parameter to switch to private chat.\n\ + \See also: /channel (aliased /c) to switch to a channel on the current network.\n" + $ ClientCommand cmdFocus tabFocus + + , Command + ("channel" :| ["c"]) + (ReqTokenArg "channel" NoArg) + "Change the focused window.\n\ + \\n\ + \Changes the focus to the \^Bchannel\^B chat window on the current network.\n\ + \\n\ + \Nicknames can be specified in the \^Bchannel\^B parameter to switch to private chat.\n\ + \See also: /focus to switch to a channel on a different network.\n\ + \See also: /focus to switch to a channel on a different network.\n" + $ NetworkCommand cmdChannel tabChannel + + , Command + (pure "clear") + (OptTokenArg "network" (OptTokenArg "channel" NoArg)) + "Clear a window.\n\ + \\n\ + \If no arguments are provided the current window is cleared.\n\ + \If \^Bnetwork\^B is provided the that network window is cleared.\n\ + \If \^Bnetwork\^B and \^Bchannel\^B are provided that chat window is cleared.\n\ + \If \^Bnetwork\^B is provided and \^Bchannel\^B is \^B*\^O all windows for that network are cleared.\n\ + \\n\ + \If a window is cleared and no longer active that window will be removed from the client.\n" + $ ClientCommand cmdClear tabFocus + + , Command + (pure "windows") + (OptTokenArg "kind" NoArg) + "Show a list of all windows with an optional argument to limit the kinds of windows listed.\n\ + \\n\ + \\^Bkind\^O: one of \^Bnetworks\^O, \^Bchannels\^O, \^Busers\^O\n\ + \\n" + $ ClientCommand cmdWindows tabWindows + + , Command (pure "splits") (RemainingArg "focuses") "Set the extra message view splits.\n\ @@ -437,6 +473,38 @@ $ ClientCommand cmdSplits tabSplits , Command + (pure "splits+") + (RemainingArg "focuses") + "Add windows to the splits list.\n\ + \\n\ + \\^Bfocuses\^B: space delimited list of focus names.\n\ + \\n\ + \Client: *\n\ + \Network: \^BNETWORK\^B\n\ + \Channel: \^BNETWORK\^B:\^B#CHANNEL\^B\n\ + \User: \^BNETWORK\^B:\^BNICK\^B\n" + $ ClientCommand cmdSplitsAdd tabSplits + + , Command + (pure "splits-") + (RemainingArg "focuses") + "Remove windows from the splits list.\n\ + \\n\ + \\^Bfocuses\^B: space delimited list of focus names.\n\ + \\n\ + \Client: *\n\ + \Network: \^BNETWORK\^B\n\ + \Channel: \^BNETWORK\^B:\^B#CHANNEL\^B\n\ + \User: \^BNETWORK\^B:\^BNICK\^B\n" + $ ClientCommand cmdSplitsDel tabActiveSplits + + , Command + (pure "ignore") + (RemainingArg "nicks") + "Toggle the soft-ignore on each of the space-delimited given nicknames.\n" + $ ClientCommand cmdIgnore simpleClientTab + + , Command (pure "grep") (RemainingArg "regular-expression") "Set the persistent regular expression.\n\ @@ -458,17 +526,17 @@ \\^B/grepi\^O is case-insensitive.\n" $ ClientCommand (cmdGrep False) simpleClientTab - - -- - -- Network commands - -- , Command - (pure "quote") - (RemainingArg "raw IRC command") - "Send a raw IRC command.\n" - $ NetworkCommand cmdQuote simpleNetworkTab + (pure "mentions") + NoArg + "Show a list of all message that were highlighted as important.\n" + $ ClientCommand cmdMentions noClientTab - , Command + ------------------------------------------------------------------------ + ] , CommandSection "IRC commands" + ------------------------------------------------------------------------ + + [ Command ("join" :| ["j"]) (ReqTokenArg "channels" (OptTokenArg "keys" NoArg)) "Join a chat channel.\n\ @@ -478,33 +546,10 @@ $ NetworkCommand cmdJoin simpleNetworkTab , Command - ("channel" :| ["c"]) - (ReqTokenArg "channel" NoArg) - "Change the focused window.\n\ - \\n\ - \Changes the focus to the \^Bchannel\^B chat window on the current network.\n\ - \\n\ - \Nicknames can be specified in the \^Bchannel\^B parameter to switch to private chat.\n\ - \See also: /focus to switch to a channel on a different network.\n\ - \See also: /focus to switch to a channel on a different network.\n" - $ NetworkCommand cmdChannel tabChannel - - , Command - (pure "mode") - (RemainingArg "modes and parameters") - "Sets IRC modes.\n\ - \\n\ - \Examples:\n\ - \Setting a ban: /mode +b *!*@hostname\n\ - \Removing a quiet: /mode -q *!*@hostname\n\ - \Voicing two users: /mode +vv user1 user2\n\ - \Demoting an op to voice: /mode +v-o user1 user1\n\ - \\n\ - \When executed in a network window, mode changes are applied to your user.\n\ - \When executed in a channel window, mode changes are applied to the channel.\n\ - \\n\ - \This command has parameter sensitive tab-completion.\n" - $ NetworkCommand cmdMode tabMode + (pure "part") + (RemainingArg "reason") + "Part from the current channel.\n" + $ ChannelCommand cmdPart simpleChannelTab , Command (pure "msg") @@ -515,6 +560,20 @@ $ NetworkCommand cmdMsg simpleNetworkTab , Command + (pure "me") + (RemainingArg "message") + "Send an 'action' to the current chat window.\n" + $ ChatCommand cmdMe simpleChannelTab + + , Command + (pure "say") + (RemainingArg "message") + "Send a message to the current chat window.\n\ + \\n\ + \This can be useful for sending a chat message with a leading '/'.\n" + $ ChatCommand cmdSay simpleChannelTab + + , Command (pure "notice") (ReqTokenArg "target" (RemainingArg "message")) "Send a notice message to a user or a channel. Notices are typically used by bots.\n\ @@ -543,24 +602,39 @@ $ NetworkCommand cmdNick simpleNetworkTab , Command - (pure "quit") - (RemainingArg "reason") - "Gracefully disconnect the current network connection.\n\ - \\n\ - \\^Breason\^B: optional quit reason\n\ + (pure "away") + (RemainingArg "message") + "Set away status.\n\ \\n\ - \See also: /disconnect /exit\n" - $ NetworkCommand cmdQuit simpleNetworkTab + \When \^Bmessage\^B is omitted away status is cleared.\n" + $ NetworkCommand cmdAway simpleNetworkTab , Command - (pure "disconnect") + (pure "users") NoArg - "Immediately terminate the current network connection.\n\ + "Show the user list for the current channel.\n\ \\n\ - \See also: /quit /exit\n" - $ NetworkCommand cmdDisconnect noNetworkTab + \Detailed view (F2) shows full hostmask.\n\ + \Hostmasks can be populated with /who #channel.\n" + $ ChannelCommand cmdUsers noChannelTab , Command + (pure "channelinfo") + NoArg + "Show information about the current channel.\n" + $ ChannelCommand cmdChannelInfo noChannelTab + + , Command + (pure "quote") + (RemainingArg "raw IRC command") + "Send a raw IRC command.\n" + $ NetworkCommand cmdQuote simpleNetworkTab + + ------------------------------------------------------------------------ + ] , CommandSection "IRC queries" + ------------------------------------------------------------------------ + + [ Command (pure "who") (RemainingArg "arguments") "Send WHO query to server with given arguments.\n" @@ -591,14 +665,6 @@ $ NetworkCommand cmdUserhost simpleNetworkTab , Command - (pure "away") - (RemainingArg "message") - "Set away status.\n\ - \\n\ - \When \^Bmessage\^B is omitted away status is cleared.\n" - $ NetworkCommand cmdAway simpleNetworkTab - - , Command (pure "links") (RemainingArg "arguments") "Send LINKS query to server with given arguments.\n" @@ -616,30 +682,40 @@ "Send STATS query to server with given arguments.\n" $ NetworkCommand cmdStats simpleNetworkTab - , Command - (pure "znc") - (RemainingArg "arguments") - "Send command directly to ZNC.\n\ - \\n\ - \The advantage of this over /msg is that responses are not broadcast to call clients.\n" - $ NetworkCommand cmdZnc simpleNetworkTab + ------------------------------------------------------------------------ + ] , CommandSection "IRC channel management" + ------------------------------------------------------------------------ - , Command - (pure "znc-playback") - (OptTokenArg "time" (OptTokenArg "date" NoArg)) - "Request playback from the ZNC 'playback' module.\n\ + [ Command + (pure "mode") + (RemainingArg "modes and parameters") + "Sets IRC modes.\n\ \\n\ - \\^Btime\^B determines the time to playback since.\n\ - \\^Bdate\^B determines the date to playback since.\n\ + \Examples:\n\ + \Setting a ban: /mode +b *!*@hostname\n\ + \Removing a quiet: /mode -q *!*@hostname\n\ + \Voicing two users: /mode +vv user1 user2\n\ + \Demoting an op to voice: /mode +v-o user1 user1\n\ \\n\ - \When both \^Btime\^B and \^Bdate\^B are omitted, all playback is requested.\n\ - \When both \^Bdate\^B is omitted it is defaulted the most recent date in the past that makes sense.\n\ + \When executed in a network window, mode changes are applied to your user.\n\ + \When executed in a channel window, mode changes are applied to the channel.\n\ \\n\ - \Time format: HOURS:MINUTES (example: 7:00)\n\ - \Date format: YEAR-MONTH-DAY (example: 2016-06-16)\n\ + \This command has parameter sensitive tab-completion.\n" + $ NetworkCommand cmdMode tabMode + + , Command + (pure "masks") + (ReqTokenArg "mode" NoArg) + "Show mask lists for current channel.\n\ \\n\ - \Note that the playback module is not installed in ZNC by default!\n" - $ NetworkCommand cmdZncPlayback noNetworkTab + \Common \^Bmode\^B values:\n\ + \\^Bb\^B: bans\n\ + \\^Bq\^B: quiets\n\ + \\^BI\^B: invite exemptions (op view only)\n\ + \\^Be\^B: ban exemption (op view only)s\n\ + \\n\ + \To populate the mask lists for the first time use: /mode \^Bmode\^B\n" + $ ChannelCommand cmdMasks noChannelTab , Command (pure "invite") @@ -681,56 +757,37 @@ \See also: /kick /kickban\n" $ ChannelCommand cmdRemove simpleChannelTab - , Command - (pure "part") - (RemainingArg "reason") - "Part from the current channel.\n" - $ ChannelCommand cmdPart simpleChannelTab + ------------------------------------------------------------------------ + ] , CommandSection "ZNC Support" + ------------------------------------------------------------------------ - , Command - (pure "users") - NoArg - "Show the user list for the current channel.\n\ + [ Command + (pure "znc") + (RemainingArg "arguments") + "Send command directly to ZNC.\n\ \\n\ - \Detailed view (F2) shows full hostmask.\n\ - \Hostmasks can be populated with /who #channel.\n" - $ ChannelCommand cmdUsers noChannelTab - - , Command - (pure "channelinfo") - NoArg - "Show information about the current channel.\n" - $ ChannelCommand cmdChannelInfo noChannelTab + \The advantage of this over /msg is that responses are not broadcast to call clients.\n" + $ NetworkCommand cmdZnc simpleNetworkTab , Command - (pure "masks") - (ReqTokenArg "mode" NoArg) - "Show mask lists for current channel.\n\ + (pure "znc-playback") + (OptTokenArg "time" (OptTokenArg "date" NoArg)) + "Request playback from the ZNC 'playback' module.\n\ \\n\ - \Common \^Bmode\^B values:\n\ - \\^Bb\^B: bans\n\ - \\^Bq\^B: quiets\n\ - \\^BI\^B: invite exemptions (op view only)\n\ - \\^Be\^B: ban exemption (op view only)s\n\ + \\^Btime\^B determines the time to playback since.\n\ + \\^Bdate\^B determines the date to playback since.\n\ \\n\ - \To populate the mask lists for the first time use: /mode \^Bmode\^B\n" - $ ChannelCommand cmdMasks noChannelTab - - , Command - (pure "me") - (RemainingArg "message") - "Send an 'action' to the current chat window.\n" - $ ChatCommand cmdMe simpleChannelTab - - , Command - (pure "say") - (RemainingArg "message") - "Send a message to the current chat window.\n\ + \When both \^Btime\^B and \^Bdate\^B are omitted, all playback is requested.\n\ + \When both \^Bdate\^B is omitted it is defaulted the most recent date in the past that makes sense.\n\ \\n\ - \This can be useful for sending a chat message with a leading '/'.\n" - $ ChatCommand cmdSay simpleChannelTab - ] + \Time format: HOURS:MINUTES (example: 7:00)\n\ + \Date format: YEAR-MONTH-DAY (example: 2016-06-16)\n\ + \\n\ + \Note that the playback module is not installed in ZNC by default!\n" + $ NetworkCommand cmdZncPlayback noNetworkTab + ]] + -- | Provides no tab completion for client commands noClientTab :: Bool -> ClientCommand String noClientTab _ st _ = commandFailure st @@ -970,11 +1027,13 @@ where focus = FocusHelp (fmap (Text.pack . fst) mb) --- | Tab completion for @/splits@ +-- | Tab completion for @/splits[+]@. When given no arguments this +-- populates the current list of splits, otherwise it tab completes +-- all of the currently available windows. tabSplits :: Bool -> ClientCommand String tabSplits isReversed st rest | all (' '==) rest = - do let cmd = "/splits " ++ unwords (Text.unpack . render <$> currentExtras) + do let cmd = unwords ("/splits" : map (Text.unpack . renderFocus) currentExtras) newline = Edit.endLine cmd commandSuccess (set (clientTextBox . Edit.line) newline st) @@ -983,31 +1042,64 @@ where currentExtras = view clientExtraFocus st - completions = map render + completions = map renderFocus $ Map.keys $ view clientWindows st - render Unfocused = "*" - render (NetworkFocus x) = x - render (ChannelFocus x y) = x <> ":" <> idText y +-- | Tab completion for @/splits-@. This completes only from the list of active +-- entries in the splits list. +tabActiveSplits :: Bool -> ClientCommand String +tabActiveSplits isReversed st rest = + simpleTabCompletion plainWordCompleteMode [] completions isReversed st + where + completions = renderFocus <$> view clientExtraFocus st + +-- | Parses a list of entries in the format used by @/splits[+-]@ to specify windows. +parseFocuses :: String -> [Focus] +parseFocuses = map parseFocus . words + +-- | Parses a single entry in the format used by @/splits[+-]@ to specify windows. +parseFocus :: String -> Focus +parseFocus x = + case break (==':') x of + ("*","") -> Unfocused + (net,"") -> NetworkFocus (Text.pack net) + (net,_:chan) -> ChannelFocus (Text.pack net) (mkId (Text.pack chan)) + +-- | Render a entry from splits back to the textual format. +renderFocus :: Focus -> Text +renderFocus Unfocused = "*" +renderFocus (NetworkFocus x) = x +renderFocus (ChannelFocus x y) = x <> ":" <> idText y + + + -- | Implementation of @/splits@ cmdSplits :: ClientCommand String cmdSplits st str = commandSuccess (set clientExtraFocus extras st) where - extras = nub (map toFocus (words str)) + extras = nub (parseFocuses str) - toFocus x = - case break (==':') x of - ("*","") -> Unfocused - (net,"") -> NetworkFocus (Text.pack net) - (net,_:chan) -> ChannelFocus (Text.pack net) (mkId (Text.pack chan)) +-- | Implementation of @/splits+@ +cmdSplitsAdd :: ClientCommand String +cmdSplitsAdd st str = commandSuccess (over clientExtraFocus extras st) + where + extras prev = nub (parseFocuses str ++ prev) + +-- | Implementation of @/splits-@ +cmdSplitsDel :: ClientCommand String +cmdSplitsDel st str = commandSuccess (over clientExtraFocus extras st) + where + extras prev = prev \\ parseFocuses str + + tabHelp :: Bool -> ClientCommand String tabHelp isReversed st _ = simpleTabCompletion plainWordCompleteMode [] commandNames isReversed st where - commandNames = fst <$> expandAliases commandsList + commandNames = fst <$> expandAliases (concatMap cmdSectionCmds commandsList) simpleTabCompletion :: Prefix a => diff --git a/src/Client/EventLoop.hs b/src/Client/EventLoop.hs --- a/src/Client/EventLoop.hs +++ b/src/Client/EventLoop.hs @@ -409,7 +409,11 @@ ClientState {- ^ client state -} -> IO (Maybe ClientState) doKey vty key modifier st = - let continue !out = return (Just out) + + let continue !out -- detect when chains of M-a are broken + | modifier == [MMeta] && key == KChar 'a' = return (Just out) + | otherwise = return $! Just $! set clientActivityReturn (view clientFocus out) out + changeEditor f = continue (over clientTextBox f st) changeContent f = changeEditor $ over Edit.content f diff --git a/src/Client/Image.hs b/src/Client/Image.hs --- a/src/Client/Image.hs +++ b/src/Client/Image.hs @@ -45,7 +45,7 @@ (Int, Image, ClientState) {- ^ text box cursor position, image, updated state -} clientImage st = (pos, img, st') where - (mainHeight, splitHeight) = clientWindowHeights (imageHeight activityBar) st + (mainHeight, splitHeight) = clientWindowHeights (imageHeight statusLine) st splitFocuses = clientExtraFocuses st focus = view clientFocus st (pos , nextOffset, tbImg) = textboxImage st @@ -60,13 +60,10 @@ img = vertCat splits <-> msgs <-> - activityBar <-> - statusLineImage st' <-> + statusLine <-> tbImg - activityBar = activityBarImage st - -- must be st, not st', needed to compute window heights - -- before rendering the message panes + statusLine = statusLineImage st renderExtra stIn focus1 = outImg where @@ -111,23 +108,22 @@ scrollAmount st = max 1 (snd (clientWindowHeights actSize st)) -- extra will be equal to main or 1 smaller where - actSize = imageHeight (activityBarImage st) + actSize = imageHeight (statusLineImage st) -- | Number of lines to allocate for the focused window and the -- main window. This doesn't include the textbox, activity bar, -- or status line. clientWindowHeights :: - Int {- ^ activity bar height -} -> + Int {- ^ status bar height -} -> ClientState {- ^ client state -} -> (Int,Int) {- ^ main height, extra height -} -clientWindowHeights activityBar st = - (max 0 (h - overhead - extras*d), max 0 (d-overhead)) +clientWindowHeights statusBar st = (mainH, splitH) where - d = h `quot` (1 + extras) - - h = max 0 (view clientHeight st - activityBar) -- lines available + h = max 0 (view clientHeight st - overhead) + splitH = h `quot` (1+extras) + mainH = h - splitH*extras extras = length (clientExtraFocuses st) - - overhead = 2 -- status line and textbox/divider + textbox = 1 + overhead = textbox + statusBar + 2*extras diff --git a/src/Client/Image/Message.hs b/src/Client/Image/Message.hs --- a/src/Client/Image/Message.hs +++ b/src/Client/Image/Message.hs @@ -45,6 +45,7 @@ import Irc.Message import Irc.RawIrcMsg import Irc.UserInfo +import Text.Read -- | Parameters used when rendering messages data MessageRendererParams = MessageRendererParams @@ -288,13 +289,7 @@ parseIrcText reason Reply code params -> - renderReplyCode rm rp code <|> - char defAttr ' ' <|> - separatedParams (dropFst params) - where - dropFst = case rm of - DetailedRender -> id - NormalRender -> drop 1 + renderReplyCode rm rp code params UnknownMsg irc -> maybe emptyImage (\ui -> coloredUserInfo pal rm myNicks ui <|> char defAttr ' ') @@ -343,15 +338,27 @@ ircWords :: [Text] -> Image ircWords = horizCat . intersperse (char defAttr ' ') . map parseIrcText -renderReplyCode :: RenderMode -> MessageRendererParams -> ReplyCode -> Image -renderReplyCode rm rp code@(ReplyCode w) = +renderReplyCode :: RenderMode -> MessageRendererParams -> ReplyCode -> [Text] -> Image +renderReplyCode rm rp code@(ReplyCode w) params = case rm of - DetailedRender -> string attr (show w) + DetailedRender -> string attr (show w) <|> rawParamsImage NormalRender -> rightPad rm (rendNickPadding rp) (text' attr (Text.toLower (replyCodeText info))) <|> - char defAttr ':' + char defAttr ':' <|> + + case code of + RPL_WHOISIDLE -> whoisIdleParamsImage + _ -> rawParamsImage where + rawParamsImage = + char defAttr ' ' <|> + separatedParams params' + + params' = case rm of + DetailedRender -> params + NormalRender -> drop 1 params + info = replyCodeInfo code color = case replyCodeType info of @@ -361,6 +368,40 @@ UnknownReply -> yellow attr = withForeColor defAttr color + + whoisIdleParamsImage = + case params' of + [name, idle, signon, _txt] -> + char defAttr ' ' <|> + text' defAttr name <|> + text' defAttr " idle: " <|> + string defAttr (prettySeconds (Text.unpack idle)) <|> + text' defAttr " sign-on: " <|> + string defAttr (prettyUnixTime (Text.unpack signon)) + + _ -> rawParamsImage + +-- | Transform string representing seconds in POSIX time to pretty format. +prettyUnixTime :: String -> String +prettyUnixTime str = + case parseTimeM False defaultTimeLocale "%s" str of + Nothing -> str + Just t -> formatTime defaultTimeLocale "%A %B %e, %Y %H:%M:%S %Z" (t :: UTCTime) + +-- | Render string representing seconds into days, hours, minutes, and seconds. +prettySeconds :: String -> String +prettySeconds str = + case readMaybe str of + Nothing -> str + Just n -> intercalate " " + $ map (\(u,i) -> show i ++ [u]) + $ dropWhile (\x -> snd x == 0) + $ zip "dhms" [d,h,m,s] + where + (n1,s) = quotRem n 60 + (n2,m) = quotRem n1 60 + (d ,h) = quotRem n2 24 + data IdentifierColorMode = PrivmsgIdentifier -- ^ An identifier in a PRIVMSG diff --git a/src/Client/Image/StatusLine.hs b/src/Client/Image/StatusLine.hs --- a/src/Client/Image/StatusLine.hs +++ b/src/Client/Image/StatusLine.hs @@ -14,7 +14,6 @@ module Client.Image.StatusLine ( statusLineImage , minorStatusLineImage - , activityBarImage ) where import Client.Image.Palette @@ -35,15 +34,14 @@ -- | Renders the status line between messages and the textbox. statusLineImage :: - ClientState {- ^ client state -} -> - Image {- ^ activity bar, status bar -} + ClientState {- ^ client state -} -> + Image {- ^ status bar -} statusLineImage st = content <|> charFill defAttr '─' fillSize 1 where fillSize = max 0 (view clientWidth st - imageWidth content) - content = horizCat + contentSansActivity = horizCat [ myNickImage st , focusImage st - , activitySummary st , detailImage st , nometaImage st , scrollImage st @@ -51,7 +49,12 @@ , latencyImage st ] + content + | view clientActivityBar st = + makeLines (view clientWidth st) (contentSansActivity : activityBarImages st) + | otherwise = contentSansActivity <|> activitySummary st + -- | The minor status line is used when rendering the @/splits@ and -- @/mentions@ views to show the associated window name. minorStatusLineImage :: Focus -> ClientState -> Image @@ -162,16 +165,14 @@ | otherwise = view palActivity pal -- | Multi-line activity information enabled by F3 -activityBarImage :: ClientState -> Image -activityBarImage st - | view clientActivityBar st = activityBar' - | otherwise = emptyImage +activityBarImages :: ClientState -> [Image] +activityBarImages st + = catMaybes + $ zipWith baraux winNames + $ Map.toList + $ view clientWindows st + where - activityBar' = makeLines (view clientWidth st) - $ catMaybes - $ zipWith baraux winNames - $ Map.toList - $ view clientWindows st winNames = clientWindowNames st ++ repeat '?' @@ -197,7 +198,11 @@ ChannelFocus _ chan -> idText chan - +-- | 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 +-- the bottom left corner of the image. Each line will have at least one +-- of the component images in it, which might truncate that image in extreme +-- cases. makeLines :: Int {- ^ window width -} -> [Image] {- ^ components to pack -} -> diff --git a/src/Client/State.hs b/src/Client/State.hs --- a/src/Client/State.hs +++ b/src/Client/State.hs @@ -40,6 +40,7 @@ , clientExtensions , clientRegex , clientLogQueue + , clientActivityReturn -- * Client operations , withClientState @@ -146,6 +147,7 @@ data ClientState = ClientState { _clientWindows :: !(Map Focus Window) -- ^ client message buffers , _clientPrevFocus :: !Focus -- ^ previously focused buffer + , _clientActivityReturn :: !Focus -- ^ focus prior to jumping to activity , _clientFocus :: !Focus -- ^ currently focused buffer , _clientSubfocus :: !Subfocus -- ^ current view mode , _clientExtraFocus :: ![Focus] -- ^ extra messages windows to view @@ -239,6 +241,7 @@ , _clientHeight = 25 , _clientEvents = events , _clientPrevFocus = Unfocused + , _clientActivityReturn = Unfocused , _clientFocus = Unfocused , _clientSubfocus = FocusMessages , _clientExtraFocus = [] @@ -779,14 +782,15 @@ -- Some events like errors or chat messages mentioning keywords are -- considered important and will be jumped to first. jumpToActivity :: ClientState -> ClientState -jumpToActivity st = - case mplus highPriority lowPriority of - Just (focus,_) -> changeFocus focus st - Nothing -> st +jumpToActivity st = changeFocus newFocus st where windowList = views clientWindows Map.toAscList st highPriority = find (view winMention . snd) windowList lowPriority = find (\x -> view winUnread (snd x) > 0) windowList + newFocus = + case mplus highPriority lowPriority of + Just (focus,_) -> focus + Nothing -> view clientActivityReturn st -- | Jump the focus directly to a window based on its zero-based index. jumpFocus :: @@ -799,12 +803,13 @@ windows = view clientWindows st (focus,_) = Map.elemAt i windows + -- | Change the window focus to the given value, reset the subfocus -- to message view, reset the scroll, remember the previous focus -- if it changed. changeFocus :: - Focus {- ^ new focus -} -> - ClientState {- ^ client state -} -> + Focus {- ^ new focus -} -> + ClientState {- ^ client state -} -> ClientState changeFocus focus st = set clientScroll 0 @@ -814,6 +819,7 @@ $ st where oldFocus = view clientFocus st + updatePrevious | focus == oldFocus = id | otherwise = set clientPrevFocus oldFocus diff --git a/src/Client/View/Help.hs b/src/Client/View/Help.hs --- a/src/Client/View/Help.hs +++ b/src/Client/View/Help.hs @@ -22,7 +22,7 @@ import Client.Commands.Recognizer import Control.Lens import Data.Foldable (toList) -import Data.List (delete) +import Data.List (delete, intercalate) import Data.List.NonEmpty (NonEmpty((:|))) import Data.Monoid ((<>)) import Data.Text (Text) @@ -57,17 +57,17 @@ Exact Command{cmdNames = names, cmdImplementation = impl, cmdArgumentSpec = spec, cmdDocumentation = doc} -> reverse $ commandSummary pal (pure cmdName) spec - : emptyImage + : emptyLine : aliasLines ++ explainContext impl - : emptyImage + : emptyLine : map parseIrcText (Text.lines doc) where aliasLines = case delete cmdName (toList names) of [] -> [] ns -> [ text' defAttr (Text.unwords ("Aliases:":ns)) - , emptyImage ] + , emptyLine ] -- | Generate an explanation of the context where the given command -- implementation will be valid. @@ -88,11 +88,24 @@ listAllCommands :: Palette {- ^ palette -} -> [Image] {- ^ help lines -} -listAllCommands pal = - reverse - [ commandSummary pal names spec - | Command{ cmdNames = names, cmdArgumentSpec = spec } <- commandsList ] +listAllCommands pal + = intercalate [emptyLine] + $ map reverse + $ listCommandSection pal <$> commandsList +listCommandSection :: + Palette {- ^ palette -} -> + CommandSection {- ^ command section -} -> + [Image] {- ^ help lines -} +listCommandSection pal sec + = text' (withStyle defAttr bold) (cmdSectionName sec) + : [ commandSummary 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 :: @@ -107,3 +120,7 @@ where pal' = set palCommandPlaceholder defAttr pal + +-- Empty line used as a separator +emptyLine :: Image +emptyLine = text' defAttr " "