screened 2025-01-03 15:51:39+00:00

src/Darcs/UI/PatchHeader.hs

@@ -41,14 +41,15 @@ import Darcs.UI.External ( editFile )
 import Darcs.UI.Flags ( getEasyAuthor, promptAuthor, getDate )
 import Darcs.UI.Options ( Config, (?) )
 import qualified Darcs.UI.Options.All as O
+import Darcs.UI.Prompt ( promptYornorq )
 import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions(..) )
 import Darcs.UI.SelectChanges ( askAboutDepends )
 
 import qualified Darcs.Util.Diff as D ( DiffAlgorithm )
 import Darcs.Util.English ( capitalize )
 import Darcs.Util.Global ( darcsLastMessage )
 import Darcs.Util.Path ( FilePathLike, toFilePath )
-import Darcs.Util.Prompt ( PromptConfig(..), askUser, promptChar, promptYorn )
+import Darcs.Util.Prompt ( PromptConfig(..), askUser, promptChar )
 import Darcs.Util.Printer ( Doc, text, ($+$), vcat, prefixLines, renderString )
 import qualified Darcs.Util.Ratified as Ratified ( hGetContents )
 
@@ -184,11 +185,12 @@ getLog m_name has_pipe log_file ask_long m_old chs =
 
   is_badname = isJust . just_a_badname
 
-  prompt_long_comment oldname =
-    do let verb = case m_old of Nothing -> "add a"; Just _ -> "edit the"
-       y <- promptYorn $ "Do you want to "++verb++" long comment?"
-       if y then get_log_using_editor oldname
-            else return (oldname, default_log, Nothing)
+  prompt_long_comment oldname = do
+    let verb = case m_old of { Nothing -> "add a"; Just _ -> "edit the" }
+        edit = get_log_using_editor oldname
+        no_edit = return (oldname, default_log, Nothing)
+        prompt = "Do you want to " ++ verb ++ " long comment?"
+    promptYornorq prompt (verb ++ " long comment") edit no_edit
 
   get_log_using_editor p =
                        do let logf = darcsLastMessage

src/Darcs/UI/Prompt.hs

@@ -3,10 +3,12 @@ module Darcs.UI.Prompt
     ( PromptChoice(..)
     , PromptConfig(..)
     , runPrompt
+    , promptYornorq
     ) where
 
 import Darcs.Prelude
 import Data.List ( find, intercalate )
+import System.Exit ( exitSuccess )
 import qualified Darcs.Util.Prompt as P
 
 data PromptChoice a = PromptChoice
@@ -24,18 +26,23 @@ data PromptConfig a = PromptConfig
   }
 
 -- | Generate the help string from a verb and list of choice groups
-helpFor :: String -> [[PromptChoice a]] -> String
-helpFor jn choices =
+helpFor :: String -> [[PromptChoice a]] -> Maybe Char -> String
+helpFor jn choices def =
   unlines $
     [ "How to use " ++ jn ++ ":" ] ++
     intercalate [""] (map (map help . filter pcWhen) choices) ++
     [ ""
     , "?: show this help"
-    , ""
-    , "<Space>: accept the current default (which is capitalized)"
-    ]
+    ] ++ defaultHelp
   where
     help i = pcKey i : (": " ++ pcHelp i)
+    defaultHelp =
+      case def of
+        Nothing -> []
+        Just _ ->
+          [ ""
+          , "<Space>: accept the current default (which is capitalized)"
+          ]
 
 lookupAction :: Char -> [PromptChoice a] -> Maybe (IO a)
 lookupAction key choices = pcAction <$> find ((==key).pcKey) choices
@@ -48,4 +55,17 @@ runPrompt pcfg@PromptConfig{..} = do
       P.PromptConfig pPrompt (map pcKey choices) [] Nothing "?h"
   case lookupAction key choices of
     Just action -> action
-    Nothing -> putStrLn (helpFor pVerb pChoices) >> runPrompt pcfg
+    Nothing -> putStrLn (helpFor pVerb pChoices pDefault) >> runPrompt pcfg
+
+-- | Prompt the user for a yes or no or cancel
+promptYornorq :: String -> String -> IO a -> IO a -> IO a
+promptYornorq prompt verb yes no =
+    runPrompt (PromptConfig prompt verb choices Nothing)
+  where
+    quit = putStrLn "Command cancelled." >> exitSuccess
+    choices =
+      [ [ PromptChoice 'y' True yes ("yes, do " ++ verb)
+        , PromptChoice 'n' True no ("no, don't " ++ verb)
+        , PromptChoice 'q' True quit "quit (cancel command)"
+        ]
+      ]

tests/network/failing-issue2462-remote-darcs-transfer-mode.sh

@@ -0,0 +1,11 @@
+#!/usr/bin/env bash
+
+. lib
+. sshlib
+
+init_remote_repo R
+
+rm -rf R
+darcs clone --remote-darcs=xyzabc "${REMOTE}:${REMOTE_DIR}/R" --debug 2>LOG
+grep '"ssh" .* "xyzabc"' LOG
+not grep '"ssh" .* "darcs"' LOG