Thu Nov 17 18:55:16 CET 2005 Juliusz Chroboczek <[EMAIL PROTECTED]>
* Add --no-working-dir and --working-dir flags.
Thu Dec 1 22:39:25 CET 2005 Juliusz Chroboczek <[EMAIL PROTECTED]>
* Implement --no-working-dir in remote_apply.
Thu Dec 1 23:08:53 CET 2005 Juliusz Chroboczek <[EMAIL PROTECTED]>
* Chdir in applyToPristine.
This is not necessary with the current code, but it's inconsistent with the
rest of the Repository interface.
Thu Dec 1 23:10:52 CET 2005 Juliusz Chroboczek <[EMAIL PROTECTED]>
* Implement apply --no-working-dir.
Thu Dec 1 23:35:33 CET 2005 Juliusz Chroboczek <[EMAIL PROTECTED]>
* Implement pull --no-working-dir.
New patches:
[Add --no-working-dir and --working-dir flags.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20051117175516] {
hunk ./DarcsArguments.lhs 56
- fancy_move_add, pristine_tree,
+ fancy_move_add, pristine_tree, working_dir,
hunk ./DarcsArguments.lhs 181
- logfile, rmlogfile, leave_test_dir, from_opt, set_default, pristine_tree
+ logfile, rmlogfile, leave_test_dir, from_opt, set_default, pristine_tree,
+ working_dir
hunk ./DarcsArguments.lhs 440
+working_dir =
+ DarcsMultipleChoiceOption
+ [DarcsNoArgOption [] ["working-dir"] WorkingDir
+ "Apply changes to the working directory [DEFAULT]",
+ DarcsNoArgOption [] ["no-working-dir"] NoWorkingDir
+ "Don't touch the working directory"]
+
hunk ./DarcsFlags.lhs 63
- | PristinePlain | PristineNone
+ | PristinePlain | PristineNone | NoWorkingDir | WorkingDir
}
[Implement --no-working-dir in remote_apply.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20051201213925] {
hunk ./RemoteApply.lhs 4
-import DarcsFlags ( DarcsFlag( ApplyAs ) )
+import DarcsFlags ( DarcsFlag( ApplyAs, NoWorkingDir ) )
hunk ./RemoteApply.lhs 8
+import Monad ( when )
hunk ./RemoteApply.lhs 17
-remote_apply opts repodir bundle
- = case apply_as opts of
+remote_apply opts repodir bundle =
+ let extraflags =
+ if NoWorkingDir `elem` opts then ["--no-working-dir"] else []
+ in case apply_as opts of
hunk ./RemoteApply.lhs 22
- then apply_via_ssh repodir bundle
+ then apply_via_ssh repodir extraflags bundle
hunk ./RemoteApply.lhs 24
- then apply_via_url repodir bundle
- else apply_via_local repodir bundle
+ then apply_via_url repodir extraflags bundle
+ else apply_via_local repodir extraflags bundle
hunk ./RemoteApply.lhs 27
- then apply_via_ssh_and_sudo repodir un bundle
- else apply_via_sudo un repodir bundle
+ then apply_via_ssh_and_sudo repodir un extraflags bundle
+ else apply_via_sudo un repodir extraflags bundle
hunk ./RemoteApply.lhs 34
-apply_via_sudo :: String -> String -> Doc -> IO Doc
-apply_via_sudo user repo bundle =
+apply_via_sudo :: String -> String -> [String] -> Doc -> IO Doc
+apply_via_sudo user repo extraflags bundle =
hunk ./RemoteApply.lhs 37
- ["-u",user,"darcs","apply","--all","--repodir",repo] bundle
-apply_via_local :: String -> Doc -> IO Doc
-apply_via_local repo bundle =
- execPipeIgnoreError "darcs" ["apply","--all","--repodir",repo] bundle
+ (["-u", user, "darcs", "apply", "--all"] ++ extraflags ++
+ ["--repodir", repo])
+ bundle
+apply_via_local :: String -> [String] -> Doc -> IO Doc
+apply_via_local repo extraflags bundle =
+ execPipeIgnoreError "darcs"
+ (["apply", "--all" ] ++ extraflags ++ ["--repodir", repo])
+ bundle
hunk ./RemoteApply.lhs 46
-apply_via_url :: String -> Doc -> IO Doc
-apply_via_url repo bundle =
+apply_via_url :: String -> [String] -> Doc -> IO Doc
+apply_via_url repo extraflags bundle =
hunk ./RemoteApply.lhs 50
- Nothing -> apply_via_local repo bundle
+ Nothing -> apply_via_local repo extraflags bundle
hunk ./RemoteApply.lhs 52
- do let cmd = head $ words apply
+ do when (extraflags /= []) $
+ fail
+ "Sorry, extra flags not supported when using external command."
+ let cmd = head $ words apply
hunk ./RemoteApply.lhs 59
-apply_via_ssh :: String -> Doc -> IO Doc
-apply_via_ssh repo bundle =
- pipeDoc_SSH_IgnoreError [addr,"cd '"++path++"' && darcs apply --all"] bundle
+apply_via_ssh :: String -> [String] -> Doc -> IO Doc
+apply_via_ssh repo extraflags bundle =
+ pipeDoc_SSH_IgnoreError
+ [addr,
+ "cd '" ++ path ++ "' && darcs apply --all " ++ (unwords extraflags) ]
+ bundle
hunk ./RemoteApply.lhs 67
-apply_via_ssh_and_sudo :: String -> String -> Doc -> IO Doc
-apply_via_ssh_and_sudo repo username bundle =
- pipeDoc_SSH_IgnoreError [addr,"sudo -u "++username++
- " darcs apply --all --repodir '"++path++"'"] bundle
+apply_via_ssh_and_sudo :: String -> String -> [String] -> Doc -> IO Doc
+apply_via_ssh_and_sudo repo username extraflags bundle =
+ pipeDoc_SSH_IgnoreError
+ [addr,
+ "sudo -u " ++ username ++ " darcs apply --all " ++
+ (unwords extraflags) ++ "--repodir '" ++ path ++ "'"] bundle
}
[Chdir in applyToPristine.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20051201220853
This is not necessary with the current code, but it's inconsistent with the
rest of the Repository interface.
] {
hunk ./Repository.lhs 251
-applyToPristine (Repo _ _ (DarcsRepository p)) patch = applyPristine p patch
+applyToPristine (Repo r _ (DarcsRepository p)) patch =
+ withCurrentDirectory r $ applyPristine p patch
}
[Implement apply --no-working-dir.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20051201221052] {
hunk ./Apply.lhs 32
- AllowConflicts, Verbose, HappyForwarding
+ AllowConflicts, Verbose, HappyForwarding,
+ NoWorkingDir
hunk ./Apply.lhs 42
- set_scripts_executable
+ set_scripts_executable, working_dir
hunk ./Apply.lhs 116
- set_scripts_executable]}
+ set_scripts_executable,
+ working_dir ]}
hunk ./Apply.lhs 160
- recorded_with_pending <- slurp_pending repository
- working <- co_slurp recorded_with_pending "."
- standard_resolved_pw <- standard_resolution work_patch
- announce_merge_conflicts opts standard_resolved_pw
- check_unrecorded_conflicts us_patch
hunk ./Apply.lhs 161
- if AllowConflicts `elem` opts
- then join_patches `liftM` no_resolution work_patch
- else case want_external_merge opts of
- Nothing -> return $ join_patches standard_resolved_pw
- Just c -> do pend <- get_unrecorded repository (AnyOrder:opts)
- join_patches `liftM` external_resolution c working
- (join_patches $ (++catMaybes [pend]) $
- map (fromJust.snd) $ reverse $ head us')
- (join_patches $ map (fromJust.snd) $ reverse $ head them')
- work_patch
+ if not (NoWorkingDir `elem` opts)
+ then Just `liftM` do
+ recorded_with_pending <- slurp_pending repository
+ working <- co_slurp recorded_with_pending "."
+ standard_resolved_pw <- standard_resolution work_patch
+ announce_merge_conflicts opts standard_resolved_pw
+ check_unrecorded_conflicts us_patch
+ if AllowConflicts `elem` opts
+ then join_patches `liftM` no_resolution work_patch
+ else case want_external_merge opts of
+ Nothing -> return $ join_patches standard_resolved_pw
+ Just c -> do pend <- get_unrecorded repository (AnyOrder:opts)
+ join_patches `liftM` external_resolution c working
+ (join_patches $ (++catMaybes [pend]) $
+ map (fromJust.snd) $ reverse $ head us')
+ (join_patches $ map (fromJust.snd) $
+ reverse $ head them')
+ work_patch
+ else return Nothing
hunk ./Apply.lhs 188
- let npend = join_patches [invert us_patch, fromMaybePatch mp, pw_resolved]
- withSignalsBlocked $ with_new_pending repository npend $ do
- applyToPristine repository us_patch `catch` \e ->
- fail ("Error applying patch to recorded!\nRunning 'darcs repair' on the target repo may help.\n" ++ show e)
- wait_a_moment -- so work will be more recent than rec
- updateInventory repository tokens
- Patch.apply opts pw_resolved `catch` \e ->
- fail ("Error applying patch to working dir:\n" ++ show e)
- sync_repo repository
+ withSignalsBlocked $
+ case pw_resolved of
+ Just pwr ->
+ let npend = join_patches [invert us_patch, fromMaybePatch mp, pwr]
+ in with_new_pending repository npend $ do
+ atp repository us_patch
+ wait_a_moment -- so work will be more recent than rec
+ updateInventory repository tokens
+ Patch.apply opts pwr `catch` \e ->
+ fail ("Error applying patch to working dir:\n" ++ show e)
+ sync_repo repository
+ Nothing -> -- --no-working-dir case
+ do atp repository us_patch
+ updateInventory repository tokens
hunk ./Apply.lhs 223
+ atp repo us = applyToPristine repo us `catch` \e ->
+ fail ("Error applying patch to recorded!\n" ++
+ "Running 'darcs repair' on the target repo " ++
+ "may help.\n" ++ show e)
+
}
[Implement pull --no-working-dir.
Juliusz Chroboczek <[EMAIL PROTECTED]>**20051201223533] {
hunk ./Pull.lhs 27
-import DarcsArguments ( DarcsFlag( AnyOrder, Test, Verbose, Quiet ),
+import DarcsArguments ( DarcsFlag( AnyOrder, Test, Verbose, Quiet,
+ NoWorkingDir ),
hunk ./Pull.lhs 36
- set_scripts_executable,
+ set_scripts_executable, working_dir
hunk ./Pull.lhs 104
- set_scripts_executable]}
+ set_scripts_executable,
+ working_dir ]}
hunk ./Pull.lhs 151
- (map fromJustPatch $ reverse $ head us', to_be_pulled)
- standard_resolved_pw <- standard_resolution pw
- announce_merge_conflicts standard_resolved_pw
- check_unrecorded_conflicts pc
- (_, working) <- slurp_recorded_and_unrecorded repository
+ (map fromJustPatch $ reverse $ head us', to_be_pulled)
hunk ./Pull.lhs 153
- case want_external_merge opts of
- Nothing -> return $ join_patches standard_resolved_pw
- Just c -> do pend <- get_unrecorded repository (AnyOrder:opts)
- join_patches `liftM` external_resolution c working
- (join_patches $ (++catMaybes [pend]) $
- map fromJustPatch $ reverse $ head us')
- (join_patches to_be_pulled) pw
+ if not (NoWorkingDir `elem` opts)
+ then Just `liftM` do
+ standard_resolved_pw <- standard_resolution pw
+ announce_merge_conflicts standard_resolved_pw
+ check_unrecorded_conflicts pc
+ (_, working) <- slurp_recorded_and_unrecorded repository
+ case want_external_merge opts of
+ Nothing -> return $ join_patches standard_resolved_pw
+ Just c -> do pend <- get_unrecorded repository (AnyOrder:opts)
+ join_patches `liftM` external_resolution c working
+ (join_patches $ (++catMaybes [pend]) $
+ map fromJustPatch $ reverse $ head us')
+ (join_patches to_be_pulled) pw
+ else return Nothing
hunk ./Pull.lhs 174
- mp <- get_unrecorded repository (AnyOrder:opts)
- let newpend = join_patches [invert pc, fromMaybePatch mp, pw_resolved]
- withSignalsBlocked $ with_new_pending repository newpend $ do
- repairable $ applyToPristine repository pc
- `catch` \e ->
- fail ("Error applying patch to recorded.\nRunning 'darcs repair' on the target repo may help.\n" ++ show e)
- updateInventory repository patchTokens
- -- so work will be more recent than rec:
- revertable wait_a_moment
- revertable $ apply opts pw_resolved `catch` \e ->
- fail ("Error applying patch to working dir:\n" ++ show e)
+ case pw_resolved of
+ Just pwr -> do
+ mp <- get_unrecorded repository (AnyOrder:opts)
+ let newpend = join_patches [invert pc, fromMaybePatch mp, pwr]
+ withSignalsBlocked $ with_new_pending repository newpend $ do
+ repairable $ atp repository pc
+ updateInventory repository patchTokens
+ -- so work will be more recent than rec:
+ revertable wait_a_moment
+ revertable $ apply opts pwr `catch` \e ->
+ fail ("Error applying patch to working dir:\n" ++ show e)
+ Nothing ->
+ withSignalsBlocked $ do
+ repairable $ atp repository pc
+ updateInventory repository patchTokens
hunk ./Pull.lhs 201
+ where atp repo us = applyToPristine repo us `catch` \e ->
+ fail ("Error applying patch to recorded!\n" ++
+ "Running 'darcs repair' on the target repo " ++
+ "may help.\n" ++ show e)
+
hunk ./Push.lhs 29
+ working_dir
hunk ./Push.lhs 76
- set_default]}
+ set_default, working_dir ]}
}
Context:
[Make send --ouput - to print to stdout
Esa Ilari Vuokko <[EMAIL PROTECTED]>**20051129201708]
[Support apply --verify for bundles signed by GnuPG in Windows
Esa Ilari Vuokko <[EMAIL PROTECTED]>**20051126223238]
[TAG 1.0.5rc1
Tommy Pettersson <[EMAIL PROTECTED]>**20051125191739]
Patch bundle hash:
4030c0e75f27f76b98cc3dc35d4da7d315e6a536
_______________________________________________
darcs-devel mailing list
[email protected]
http://www.abridgegame.org/cgi-bin/mailman/listinfo/darcs-devel
