diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for glirc2 +## 2.24 + +* `/query` now takes a message parameter and tab-completes + like `/msg`. + ## 2.23 * CONFIGURATION FILE CHANGE: Relative paths are now resolved diff --git a/glirc.cabal b/glirc.cabal --- a/glirc.cabal +++ b/glirc.cabal @@ -1,5 +1,5 @@ name: glirc -version: 2.23 +version: 2.24 synopsis: Console IRC client description: Console IRC client . @@ -154,7 +154,7 @@ unix >=2.7 && <2.8, unordered-containers >=0.2.7 && <0.3, vector >=0.11 && <0.13, - vty >=5.11.1 && <5.16 + vty >=5.11.1 && <5.18 test-suite test type: exitcode-stdio-1.0 diff --git a/src/Client/Commands.hs b/src/Client/Commands.hs --- a/src/Client/Commands.hs +++ b/src/Client/Commands.hs @@ -483,7 +483,35 @@ $ ClientCommand cmdFocus tabFocus , Command - ("query" :| ["c", "channel"]) + ("query" :| ["q"]) + (liftA2 (,) (simpleToken "target") (remainingArg "message")) + "\^BParameters:\^B\n\ + \\n\ + \ target: Focus name\n\ + \ message: Optional message\n\ + \\n\ + \\^BDescription:\^B\n\ + \\n\ + \ This command switches the client focus to the given\n\ + \ target and optionally sends a message to that target.\n\ + \\n\ + \ Channel: \^_#channel\^_\n\ + \ Channel: \^_network\^_:\^_#channel\^_\n\ + \ User: \^_nick\^_\n\ + \ User: \^_network\^_:\^_nick\^_\n\ + \\n\ + \\^BExamples:\^B\n\ + \\n\ + \ /q fn:#haskell\n\ + \ /q #haskell\n\ + \ /q lambdabot @messages\n\ + \ /q irc_friend How are you?\n\ + \\n\ + \\^BSee also:\^B msg channel focus\n" + $ ClientCommand cmdQuery simpleClientTab + + , Command + ("c" :| ["channel"]) (simpleToken "focus") "\^BParameters:\^B\n\ \\n\ @@ -510,7 +538,7 @@ \ /c *:\n\ \\n\ \\^BSee also:\^B focus\n" - $ ClientCommand cmdQuery tabQuery + $ ClientCommand cmdChannel tabChannel , Command (pure "clear") @@ -1779,20 +1807,43 @@ commandSuccess $ changeFocus (ChannelFocus network channelId) st - -- | @/query@ command. Takes a channel or nickname and switches -- focus to that target on the current network. -cmdQuery :: ClientCommand String -cmdQuery st channel = +cmdQuery :: ClientCommand (String, String) +cmdQuery st (target, msg) = + case parseFocus (views clientFocus focusNetwork st) target of + Just (ChannelFocus net tgt) + + | null msg -> commandSuccess st' + + | Just cs <- preview (clientConnection net) st -> + do let tgtTxt = idText tgt + msgTxt = Text.pack msg + sendMsg cs (ircPrivmsg tgtTxt msgTxt) + chatCommand + (\src tgt1 -> Privmsg src tgt1 msgTxt) + tgtTxt cs st' + where + firstTgt = mkId (Text.takeWhile (','/=) (idText tgt)) + st' = changeFocus (ChannelFocus net firstTgt) st + + _ -> commandFailureMsg "Bad target" st + + +-- | @/channel@ command. Takes a channel or nickname and switches +-- focus to that target on the current network. +cmdChannel :: ClientCommand String +cmdChannel st channel = case parseFocus (views clientFocus focusNetwork st) channel of Just focus -> commandSuccess (changeFocus focus st) Nothing -> commandFailureMsg "No current network" st --- | Tab completion for @/query@ -tabQuery :: +-- | Tab completion for @/channel@. Tab completion uses pre-existing +-- windows. +tabChannel :: Bool {- ^ reversed order -} -> ClientCommand String -tabQuery isReversed st _ = +tabChannel isReversed st _ = simpleTabCompletion plainWordCompleteMode [] completions isReversed st where completions = currentNet <> allWindows diff --git a/src/Client/Commands/Arguments/Parser.hs b/src/Client/Commands/Arguments/Parser.hs --- a/src/Client/Commands/Arguments/Parser.hs +++ b/src/Client/Commands/Arguments/Parser.hs @@ -61,5 +61,5 @@ do xs <- get let (t, xs') = break (' '==) (dropWhile (' '==) xs) guard (not (null t)) - put (drop 1 xs') + put xs' return t diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -2,7 +2,7 @@ {-| Module : Main Description : Tests for the glirc library -Copyright : (c) Eric Mertens, 2016 +Copyright : (c) Eric Mertens, 2017 License : ISC Maintainer : emertens@gmail.com @@ -11,7 +11,9 @@ -} module Main (main) where -import Client.Commands.Arguments +import Client.Commands.Arguments.Spec +import Client.Commands.Arguments.Parser +import Control.Applicative import System.Exit import Test.HUnit @@ -29,27 +31,43 @@ argumentParserTests = test [ assertEqual "no arg empty" (Just ()) - (parseArguments NoArg "") + (parse () (pure ()) "") , assertEqual "no arg white" (Just ()) - (parseArguments NoArg " ") + (parse () (pure ()) " ") , assertEqual "no arg fail" Nothing - (parseArguments NoArg " a") + (parse () (pure ()) " a") , assertEqual "required" - (Just ("argument",())) - (parseArguments (ReqTokenArg "field" NoArg) " argument ") + (Just "argument") + (parse () (simpleToken "field") " argument ") , assertEqual "optional 1" - (Just (Just ("argument",()))) - (parseArguments (OptTokenArg "field" NoArg) " argument ") + (Just (Just "argument")) + (parse () (optionalArg (simpleToken "field")) " argument ") , assertEqual "optional 2" (Just Nothing) - (parseArguments (OptTokenArg "field" NoArg) " ") + (parse () (optionalArg (simpleToken "field")) " ") , assertEqual "remaining" (Just "some stuff ") - (parseArguments (RemainingArg "field") " some stuff ") + (parse () (remainingArg "field") " some stuff ") + + , assertEqual "token and empty remaining" + (Just ("some", "")) + (parse () (liftA2 (,) (simpleToken "first") (remainingArg "second")) " some") + + , assertEqual "token and empty remaining 1" + (Just ("some", "")) + (parse () (liftA2 (,) (simpleToken "first") (remainingArg "second")) " some ") + + , assertEqual "token and remaining" + (Just ("some", "text here")) + (parse () (liftA2 (,) (simpleToken "first") (remainingArg "second")) " some text here") + + , assertEqual "extra whitespace token and remaining" + (Just ("some", " text here")) + (parse () (liftA2 (,) (simpleToken "first") (remainingArg "second")) " some text here") ]