[prev in list] [next in list] [prev in thread] [next in thread] 

List:       darcs-devel
Subject:    [darcs-devel] darcs patch: Implement gitCommitDate. (and 8 more)
From:       Juliusz Chroboczek <Juliusz.Chroboczek () pps ! jussieu ! fr>
Date:       2005-10-27 18:26:24
Message-ID: E1EVCSG-0002PT-DJ () lanthane ! pps ! jussieu ! fr
[Download RAW message or body]

Tue Oct 25 23:38:32 CEST 2005  Juliusz Chroboczek <jch@pps.jussieu.fr>
  * Implement gitCommitDate.

Tue Oct 25 23:55:22 CEST 2005  Juliusz Chroboczek <jch@pps.jussieu.fr>
  * Choose better ancestors for Git merges.
  The common ancestor will be chosen optimally assuming that the Git
  ancestry graph is a semilattice and commit dates are monotonic.  If
  the Git ancestry graph is unstructured, the youngest ancestor will
  be chosen.
  =

  If Git dates are not ordered, all bets are off.
  =

  The algorithm is at least O(h*w^2), where h is the height of the
  ancestry graph and w is the number of ancestors, but profiling shows
  that this doesn't matter much -- commuting patches is what takes all
  the time.

Wed Oct 26 01:13:44 CEST 2005  Juliusz Chroboczek <jch@pps.jussieu.fr>
  * Clarify docs for building darcs-git.

Wed Oct 26 02:52:36 CEST 2005  Juliusz Chroboczek <jch@pps.jussieu.fr>
  * Implement break2PS.

Wed Oct 26 02:53:23 CEST 2005  Juliusz Chroboczek <jch@pps.jussieu.fr>
  * Use packed strings when parsing Git commits.

Thu Oct 27 20:01:07 CEST 2005  Juliusz Chroboczek <jch@pps.jussieu.fr>
  * Change breakFirstPairPS to return slightly larger strings.

Thu Oct 27 20:01:38 CEST 2005  Juliusz Chroboczek <jch@pps.jussieu.fr>
  * Use the new breakFirstPairPS instead of break2PS.

Thu Oct 27 20:24:00 CEST 2005  Juliusz Chroboczek <jch@pps.jussieu.fr>
  * Use PackedStrings when parsing Git authors.

Thu Oct 27 20:24:21 CEST 2005  Juliusz Chroboczek <jch@pps.jussieu.fr>
  * Use gitCommitDatePS instead of gitCommitDate when choosing Git ancestor=
s.

[Attachment #3 (text/x-darcs-patch)]

New patches:

[Implement gitCommitDate.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20051025213832] {
hunk ./Git.lhs 22
-             GitCommit, readGitCommit, gitCommitToPatchInfo,
+             GitCommit, readGitCommit, gitCommitToPatchInfo, gitCommitDate,
hunk ./Git.lhs 172
+-- the date of the commit -- not the date in the author header, which
+-- is available in the PatchInfo.
+gitCommitDate :: String -> GitCommit -> String
+gitCommitDate _ gc =
+    let committer = gitSingleCommitValue "committer" gc
+        (_, date) = parseAuthorLine committer
+    in date
+
}

[Choose better ancestors for Git merges.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20051025215522
 The common ancestor will be chosen optimally assuming that the Git
 ancestry graph is a semilattice and commit dates are monotonic.  If
 the Git ancestry graph is unstructured, the youngest ancestor will
 be chosen.
 
 If Git dates are not ordered, all bets are off.
 
 The algorithm is at least O(h*w^2), where h is the height of the
 ancestry graph and w is the number of ancestors, but profiling shows
 that this doesn't matter much -- commuting patches is what takes all
 the time.
] {
hunk ./GitRepo.lhs 27
-             applyToGitSlurpy, writeGitCommit, updateHead )
+             applyToGitSlurpy, writeGitCommit, updateHead, gitCommitDate )
hunk ./GitRepo.lhs 36
+import List ( find, sortBy )
hunk ./GitRepo.lhs 63
-               let (ancestor, history) = read_multiple_repos ps seen
+               let histories = read_multiple_repos ps seen
+                   (ancestor, history) = merge_multiple_sequences histories
hunk ./GitRepo.lhs 75
-              :: [String] -> GitSequence -> (Maybe String, GitSequence)
-          read_multiple_repos [] _ = (Nothing, [])
-          read_multiple_repos [p] seen' =
-              (Nothing, really_read_repo repo p seen')
+              :: [String] -> GitSequence -> [GitSequence]
+          read_multiple_repos [] _ = []
hunk ./GitRepo.lhs 79
-                  (_, psh) = read_multiple_repos ps ph
-                  ancestor = common_ancestor ph psh
-                  history = merge_sequences ancestor ph psh
-              in (ancestor, history)
+                  in ph:(read_multiple_repos ps ph)
+          merge_multiple_sequences ::
+              [GitSequence] -> (Maybe String, GitSequence)
+          merge_multiple_sequences [] = impossible
+          merge_multiple_sequences [_] = impossible
+          merge_multiple_sequences hs =
+              let (ancestor, h1, h2, otherhs) = find_merge_candidates repo hs
+                  history = merge_sequences ancestor h1 h2
+              in case otherhs of
+                     [] -> (ancestor, history)
+                     _ -> merge_multiple_sequences (history:otherhs)
hunk ./GitRepo.lhs 116
+-- given a list of histories, finds the two that should be merged
+-- first.  Returns the common ancestor, the two distinguished
+-- histories, and the remaining histories.
+find_merge_candidates ::
+    String -> [GitSequence] ->
+              (Maybe String, GitSequence, GitSequence, [GitSequence])
+find_merge_candidates _ [] = impossible
+find_merge_candidates _ [_] = impossible
+find_merge_candidates _ [h1, h2] = ((common_ancestor h1 h2), h1, h2, [])
+find_merge_candidates repo hs =
+    -- GitSequences don't implement Eq -- we need to number the
+    -- sequences to be able to find them again
+    let nhs = zip [(1::Int)..] hs
+        npairs = all_pairs nhs
+        pairs = map (\((_,h),(_,h')) -> (h,h')) npairs
+        ancestors = map (uncurry common_ancestor) pairs
+        ancestor = youngest ancestors
+        ((n1, h1), (n2, h2)) = snd (fromJust (find (\(a, _) -> (a == ancestor))
+                                                   (zip ancestors npairs)))
+        othernhs = filter (\(n,_) -> n /= n1 && n /= n2) nhs
+        otherhs = map snd othernhs
+    in (ancestor, h1, h2, otherhs)
+    where youngest :: [Maybe String] -> (Maybe String)
+          -- what we really need is an ancestor that is minimal in the
+          -- set of ancestors.  We assume that dates make sense, and
+          -- simply choose the youngest one.
+          youngest l = last (sortBy
+                             (\a b -> compare (ancestorDate a)
+                                              (ancestorDate b))
+                             l)
+          ancestorDate Nothing = Nothing
+          ancestorDate (Just a) =
+              Just $ gitCommitDate repo $ readGitCommit repo a
+          all_pairs [] = []
+          all_pairs (x:l) = [ (x,y) | y <- l ] ++ all_pairs l
+
}

[Clarify docs for building darcs-git.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20051025231344] {
hunk ./building_darcs.tex 138
-To enable git support, you first need to grab and compile a copy of the git
-source code.  Since darcs doesn't yet have the capability of accessing
+To enable git support, you first need to grab a copy of the git
+source code; since darcs doesn't yet have the capability of accessing
hunk ./building_darcs.tex 141
-git itself to clone a git repository.  Create a symlink to the git source
-directory named ``\verb!git!'' in your darcs source directory.  Build git
-itself, which will create libgit.a, which is used by darcs.  Finally, when
-you configure darcs, use the ``\verb!--enable-git!'' option.
+git itself to clone a git repository.  Compile git (no need to
+install); this will create a file ``\verb|libgit.a|''.  Then create a
+symlink to the git source directory named ``\verb!git!'' in your darcs
+source directory, configure darcs using the ``\verb!--enable-git!''
+option, and build darcs as usual.
}

[Implement break2PS.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20051026005236] {
hunk ./FastPackedString.hs 98
+        break2PS,
hunk ./FastPackedString.hs 554
+break2PS :: Char -> Char -> PackedString -> Maybe (PackedString, PackedString)
+break2PS c1 c2 ps =
+    let w1 = c2w c1
+        w2 = c2w c2
+    in case [ m | m <- [0..(lengthPS ps) - 2],
+                  (ps ! m) == w1, (ps ! (m + 1)) == w2 ] of
+       [] -> Nothing
+       (n:_) -> Just (takePS n ps, dropPS (n+2) ps)
+
}

[Use packed strings when parsing Git commits.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20051026005323] {
hunk ./Git.lhs 39
-import PatchInfo ( PatchInfo(..), patchinfo )
+import PatchInfo ( PatchInfo(..) )
hunk ./Git.lhs 116
-type GitCommit = ([(String, String)], String)
+type GitCommit = ([(PackedString, PackedString)], PackedString)
hunk ./Git.lhs 123
-                                 parseGitCommit `liftM` gitFileContents gf
+                                 parseGitCommit `liftM` gitFileContentsPS gf
hunk ./Git.lhs 125
-parseGitCommit :: String -> GitCommit
-parseGitCommit [] = ([],[])
-parseGitCommit ('\n' : s) = ([], s)
-parseGitCommit (' ' : s) = parseGitCommit s
-parseGitCommit s = let (line, rest) = parseGitCommitLine s []
-                   in let (a, b) = (parseGitCommit rest)
-                      in (line : a, b)
+parseGitCommit :: PackedString -> GitCommit
+parseGitCommit c = let (headers, body) = fromJust $ break2PS '\n' '\n' c
+                   in ((map parseGitHeaderLine (linesPS headers)), body)
hunk ./Git.lhs 129
-parseGitCommitLine :: String -> String -> ((String, String), String)
-parseGitCommitLine [] k = (((reverse k), []), [])
-parseGitCommitLine (' ' : s)  k = parseGitCommitLine' s [] (reverse k)
-parseGitCommitLine (c : s) k = parseGitCommitLine s (c : k)
+trimPS :: PackedString -> PackedString
+trimPS ps = if (lastPS ps) == '\n' then (initPS ps) else ps
hunk ./Git.lhs 132
-parseGitCommitLine' :: String -> String -> String -> ((String, String), String)
-parseGitCommitLine' [] k' k = ((k, (reverse k')) , [])
-parseGitCommitLine' ('\n' : s) k' k = ((k, (reverse k')), s)
-parseGitCommitLine' (c : s) k' k = parseGitCommitLine' s (c : k') k
+parseGitHeaderLine :: PackedString -> (PackedString, PackedString)
+parseGitHeaderLine l =
+    let (Just (k, rest)) = breakFirstPS ' ' l
+    in (k, trimPS rest)
hunk ./Git.lhs 138
-gitCommitValue key (kl, _) = gitCommitValue' kl []
+gitCommitValue s gc = map unpackPS $ gitCommitValuePS (packString s) gc
+
+gitCommitValuePS :: PackedString -> GitCommit -> [PackedString]
+gitCommitValuePS key (kl, _) = gitCommitValue' kl []
hunk ./Git.lhs 148
-gitSingleCommitValue key gc = case gitCommitValue key gc of
-                              [s] -> s
-                              [] -> error $ "There is no "++key
-                              _ -> error $ "More than one "++key
+gitSingleCommitValue s gc =
+    unpackPS $ gitSingleCommitValuePS (packString s) gc
+
+gitSingleCommitValuePS :: PackedString -> GitCommit -> PackedString
+gitSingleCommitValuePS key gc = case gitCommitValuePS key gc of
+                                [s] -> s
+                                [] -> error $ "There is no " ++ (unpackPS key)
+                                _ -> error $ "More than one " ++ (unpackPS key)
hunk ./Git.lhs 165
-        name = head (lines comment)
-        darcs_log' = tail (lines comment)
-        darcs_log = if (author == committer)
-                    then darcs_log'
-                    else (darcs_log' ++ [ gitCommitterHeader ++ committer ])
-        comment = snd gc
-    in patchinfo darcs_date name darcs_author darcs_log
+        comment = linesPS (snd gc)
+        name = head comment
+        darcs_log' = tail comment
+        darcs_log =
+            if (author == committer)
+               then darcs_log'
+               else (darcs_log' ++
+                     [(packString $ gitCommitterHeader ++ committer)])
+    in PatchInfo (packString darcs_date)
+                 name
+                 (packString darcs_author)
+                 darcs_log False
}

[Change breakFirstPairPS to return slightly larger strings.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20051027180107] {
hunk ./FastPackedString.hs 98
-        break2PS,
+        breakFirstPairPS,
hunk ./FastPackedString.hs 554
-break2PS :: Char -> Char -> PackedString -> Maybe (PackedString, PackedString)
-break2PS c1 c2 ps =
+breakFirstPairPS ::
+    Char -> Char -> PackedString -> Maybe (PackedString, PackedString)
+breakFirstPairPS c1 c2 ps =
hunk ./FastPackedString.hs 562
-       (n:_) -> Just (takePS n ps, dropPS (n+2) ps)
+       (n:_) -> Just (takePS (n+1) ps, dropPS (n+1) ps)
}

[Use the new breakFirstPairPS instead of break2PS.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20051027180138] {
hunk ./Git.lhs 128
+    where break2PS a b cc = (\(x,y) -> (initPS x, tailPS y)) `liftM`
+                            breakFirstPairPS a b cc
}

[Use PackedStrings when parsing Git authors.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20051027182400] {
hunk ./Git.lhs 22
-             GitCommit, readGitCommit, gitCommitToPatchInfo, gitCommitDate,
+             GitCommit, readGitCommit, gitCommitToPatchInfo,
+             gitCommitDate, gitCommitDatePS,
hunk ./Git.lhs 152
-    unpackPS $ gitSingleCommitValuePS (packString s) gc
+    unpackPS $ gitSingleCommitValuePS s gc
hunk ./Git.lhs 154
-gitSingleCommitValuePS :: PackedString -> GitCommit -> PackedString
-gitSingleCommitValuePS key gc = case gitCommitValuePS key gc of
+gitSingleCommitValuePS :: String -> GitCommit -> PackedString
+gitSingleCommitValuePS key gc = case gitCommitValuePS (packString key) gc of
hunk ./Git.lhs 157
-                                [] -> error $ "There is no " ++ (unpackPS key)
-                                _ -> error $ "More than one " ++ (unpackPS key)
+                                [] -> error $ "There is no " ++ key
+                                _ -> error $ "More than one " ++ key
hunk ./Git.lhs 165
-    let author = gitSingleCommitValue "author" gc
-        committer = gitSingleCommitValue "committer" gc
+    let author = gitSingleCommitValuePS "author" gc
+        committer = gitSingleCommitValuePS "committer" gc
hunk ./Git.lhs 175
-                     [(packString $ gitCommitterHeader ++ committer)])
-    in PatchInfo (packString darcs_date)
-                 name
-                 (packString darcs_author)
-                 darcs_log False
+                     [(packString $ gitCommitterHeader ++
+                                    (unpackPS committer))])
+    in PatchInfo darcs_date name darcs_author darcs_log False
hunk ./Git.lhs 181
-gitCommitDate :: String -> GitCommit -> String
-gitCommitDate _ gc =
-    let committer = gitSingleCommitValue "committer" gc
+gitCommitDatePS :: String -> GitCommit -> PackedString
+gitCommitDatePS _ gc =
+    let committer = gitSingleCommitValuePS "committer" gc
hunk ./Git.lhs 187
-parseAuthorLine :: String -> (String, String)
-parseAuthorLine s = parseAuthorLine' s []
-    where parseAuthorLine' ('>':' ':s') s'' =
-              (reverse ('>' : s''), (gitDateToDarcsDate s'))
-          parseAuthorLine' (a:s') s'' = parseAuthorLine' s' (a:s'')
-          parseAuthorLine' _ _ = error "Couldn't parse author line"
+gitCommitDate :: String -> GitCommit -> String
+gitCommitDate sha1 gc = unpackPS (gitCommitDatePS sha1 gc)
+
+parseAuthorLine :: PackedString -> (PackedString, PackedString)
+parseAuthorLine s =
+    let Just (a, d') = breakFirstPairPS '>' ' ' s
+        d = tailPS d'
+    in (a, (gitDateToDarcsDate d))
hunk ./Git.lhs 202
-upeek :: CString -> String
-upeek = unsafePerformIO . peekCString
-
-parseGitTime :: CULong -> String
-parseGitTime s = upeek (git_parse_time s)
+parseGitTime :: CULong -> PackedString
+parseGitTime s = unsafePerformIO $ mallocedCString2PS (git_parse_time s)
hunk ./Git.lhs 209
-gitDateToDarcsDate :: String -> String
-gitDateToDarcsDate d = parseGitTime (fst (head (reads d)))
+gitDateToDarcsDate :: PackedString -> PackedString
+gitDateToDarcsDate d = parseGitTime (fst (head (reads (unpackPS d))))
}

[Use gitCommitDatePS instead of gitCommitDate when choosing Git ancestors.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20051027182421] {
hunk ./GitRepo.lhs 27
-             applyToGitSlurpy, writeGitCommit, updateHead, gitCommitDate )
+             applyToGitSlurpy, writeGitCommit, updateHead, gitCommitDatePS )
hunk ./GitRepo.lhs 148
-              Just $ gitCommitDate repo $ readGitCommit repo a
+              Just $ gitCommitDatePS repo $ readGitCommit repo a
}

Context:

[Merge changes
Ian Lynagh <igloo@earth.li>**20051008225210] 
[specify default --author in whatsnew.pl.
David Roundy <droundy@darcs.net>**20051007235714] 
[fix bug in whatsnew on files without trailing newlines.
David Roundy <droundy@darcs.net>**20051004124355] 
[add test for whatsnew -s on file without newline.
David Roundy <droundy@darcs.net>**20050905123225] 
[remove old footnote that caused doc-building trouble.
David Roundy <droundy@darcs.net>**20051008002612] 
[use prefix and userchunkPS in coolContextHunk
Tommy Pettersson <ptp@lysator.liu.se>**20050923093032
 This makes escaping of trailing spaces work in unified output.
] 
[add changelog entry for bug #512.
David Roundy <droundy@darcs.net>**20051007123717] 
[make --summary have effect in interactive commands
David Roundy <droundy@darcs.net>**20051007123507] 
[make --dry-run --summary indent the summaries like changes does.
David Roundy <droundy@darcs.net>**20051007123427] 
[avoid excess printing in set_scripts_executable.pl.
David Roundy <droundy@darcs.net>**20051007112545] 
[fix documentation typos
Andres Loeh <loeh@iai.uni-bonn.de>**20050918175732] 
[description environment for explanation of --summary flags
Andres Loeh <loeh@iai.uni-bonn.de>**20050918175612] 
[remove/change/fix some quotation marks
Andres Loeh <loeh@iai.uni-bonn.de>**20050918171105] 
[remove occurrences of \bf, \tt, and \em
Andres Loeh <loeh@iai.uni-bonn.de>**20050918170214] 
[add executable bit support to Readable/WriteableDirectory.
David Roundy <droundy@darcs.net>**20051003123240] 
[fix bug in set_scripts_executable test, and related bug in apply.
David Roundy <droundy@darcs.net>**20051006111849] 
[clean up tests/set_scripts_executable.pl.
David Roundy <droundy@darcs.net>**20051004131951] 
[make --set-scripts-executable work once again.
David Roundy <droundy@darcs.net>**20051004131756] 
[remove occurances of "'" that messed up my emacs coloring...
David Roundy <droundy@darcs.net>**20050919122443] 
[add two changelog entries.
David Roundy <droundy@darcs.net>**20051004132328] 
[update copyright dates.
David Roundy <droundy@darcs.net>**20051004131936] 
[only use ascii chars in quoted escapes of non-printable chars
Tommy Pettersson <ptp@lysator.liu.se>**20050920163959
 Haskell interprets Char as unicode regardless of the systems locale,
 so isPrint can't be used the way it was used to find suitable escape
 quotings.  Ascii fortunately is unicode, so the simple fix is to restrict
 escape quotings to only use (printable) ascii chars.
] 
[Installation doc readability fixes
Thomas Zander <zander@kde.org>**20050924163649] 
[simplify docs-- why "CVS" is in the boring file is self-evident.
Mark Stosberg <mark@summersault.com>**20050927131847] 
[add two new changelog entries.
David Roundy <droundy@darcs.net>**20050910110115] 
[fix bug in resolve.pl test.
David Roundy <droundy@darcs.net>**20050910103833] 
[give better output on sftp errors.
David Roundy <droundy@darcs.net>**20050908125423] 
[make darcs not generate null binary patches when diffing.
David Roundy <droundy@darcs.net>**20050907125129] 
[make darcs able to eliminate null binary and hunk patches when coalescing.
David Roundy <droundy@darcs.net>**20050907125104] 
[add test that adding and removing binary files leaves no change.
David Roundy <droundy@darcs.net>**20050907122509] 
[fix some typos in comments
Conrad Parker <conrad@metadecks.org>**20050904225715] 
[Make print_dry_run_message_and_exit print summaries if All and Summary.
David Roundy <droundy@darcs.net>**20050904125434
 This is a somewhat hokey way to make --all --summary print summary
 messages.
] 
[add changelog entry for configure script checking on darcs being present.
David Roundy <droundy@darcs.net>**20050905113258] 
[fix bug where we tried to run darcs when darcs wasn't present.
David Roundy <droundy@darcs.net>**20050905112935] 
[revert accidental directory name change in Test.
David Roundy <droundy@darcs.net>**20050904123424] 
[add changelog entry for recent pristine bugfix.
David Roundy <droundy@darcs.net>**20050903134039] 
[Fix typos in description of unpull.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20051006204813
 Thanks to frithjof.
] 
[-add test script for --set-scripts-executable
Mark Stosberg <mark@summersault.com>**20050901015046
 
 It's currently failing because darcs is currently broken in this regard. I commented
 out a "TODO" test in case you want to make to this a TODO test until
 someone gets to it.
] 
[clean up docs on flags directly to darcs (not to a darcs command).
David Roundy <droundy@darcs.net>**20050903124050] 
[bump version to 1.0.4rc1.
David Roundy <droundy@darcs.net>**20050903114002] 
[update the web page to direct new users first to the precompiled binaries rather \
than first to the source zooko@zooko.com**20050902162737] 
[add test script that displays --no-pristine test-related bug.
David Roundy <droundy@darcs.net>**20050903132906] 
[fix bug triggered by --no-pristine-tree and running test.
David Roundy <droundy@darcs.net>**20050903132055
 The trouble was that the NoPristine version of createPristineDirectoryTree
 would fail if the directory already exists, which isn't the intended
 behavior.  I also took this opportunity to remove the "stubbornly" function
 and replace some stubborn directory creation with
 createDirectoryIfMissing.
] 
[don't create test directory if we don't want to actually run test.
David Roundy <droundy@darcs.net>**20050903130722] 
[Change an rm_rf to a cleanup in tests/disable.pl
Ian Lynagh <igloo@earth.li>**20050902024711] 
[TAG 1.0.4pre4
David Roundy <droundy@darcs.net>**20050901110418] 
[add changelog entry for makefile fix.
David Roundy <droundy@darcs.net>**20050901110353] 
[bump version to 1.0.4pre4.
David Roundy <droundy@darcs.net>**20050901110210] 
[fix DESTDIR syntax errors in makefile
Andres Loeh <loeh@iai.uni-bonn.de>**20050831192410] 
[fix "No root path(s) specified at ..." testsuite problem.
David Roundy <droundy@darcs.net>**20050830121603] 
[add test that triggers "too many open files" bug.
David Roundy <droundy@darcs.net>**20050827192215
 We just need to pull over 1024 patches at once to trigger this bug on my
 linux system.
] 
[TAG 1.0.4pre3
David Roundy <droundy@darcs.net>**20050831115448] 
[add two changelog entries.
David Roundy <droundy@darcs.net>**20050831113335] 
[only create directories on install if they don't exist (bug #494)
David Roundy <droundy@darcs.net>**20050831113142] 
[fix bug in whatsnew -l -l (rt#501).
David Roundy <droundy@darcs.net>**20050831110552] 
[fix typo in docs.
David Roundy <droundy@darcs.net>**20050831002520] 
[fix --posthook code to pass tests.
David Roundy <droundy@darcs.net>**20050830132225] 
[add test for --disable.
David Roundy <droundy@darcs.net>**20050830132122] 
[add changelog entry for --posthook.
David Roundy <droundy@darcs.net>**20050830132110] 
[add skeleton posthook test.
David Roundy <droundy@darcs.net>**20050827123744] 
[posthook documentation
Jason Dagit <dagit@codersbase.com>**20050825045706] 
[changed from --posthook-command to posthook
Jason Dagit <dagit@codersbase.com>**20050825043414] 
[now the posthook options appear for each command
Jason Dagit <dagit@codersbase.com>**20050825043305] 
[posthook for apply
Jason Dagit <dagit@codersbase.com>**20050803070343
 With this patch it is now possible to specify a command to run after every
 successful apply.
] 
[added run_posthook for actually running posthooks
Jason Dagit <dagit@codersbase.com>**20050803070156
 This adds the function run_posthook which should be used to run posthooks.
 The code was added to Test.lhs, but there may be a better place for this code.
] 
[added posthook command line switches
Jason Dagit <dagit@codersbase.com>**20050803065956
 Added generic posthook command line switches.  This patch does not add any
 posthooks to any command.
] 
[Rewrite gcau, add explanatory comment from David and some TODO notes
Ian Lynagh <igloo@earth.li>**20050830020943] 
[update building darcs section of manual.
David Roundy <droundy@darcs.net>**20050829120152] 
[add bench directory with a single script in it.
David Roundy <droundy@darcs.net>**20050828114118
 See bench/README for discussion of the idea behind this.
] 
[New implementation of comparePS, based on memcmp. 1/5 space usage, 96% faster
dons@cse.unsw.edu.au**20050827070030] 
[Use substrPS-less versions of initPS and tailPS
dons@cse.unsw.edu.au**20050827023214] 
[remove hideous malloc hack.
David Roundy <droundy@darcs.net>**20050818161411] 
[change my AUTHORS email to droundy@darcs.net.
David Roundy <droundy@abridgegame.org>**20050808124703] 
[fix mkstemp implementation for win32
Peter Strand <peter@zarquon.se>**20050810211303] 
[Implement parts of System.Posix.(IO|Files) for win32
peter@zarquon.se**20050809200433] 
[implement RawMode with library functions instead of ffi
peter@zarquon.se**20050809200148] 
[call hsc2hs without output filename argument
peter@zarquon.se**20050808220444] 
[Rename compat.c to c_compat.c to avoid object filename conflict with Compat.hs
peter@zarquon.se**20050731114011] 
[Move atomic_create/sloppy_atomic_create to Compat
Ian Lynagh <igloo@earth.li>**20050730141703] 
[Split the raw mode stuff out into its own .hsc file. Windows needs some TLC
Ian Lynagh <igloo@earth.li>**20050730134030] 
[Move maybe_relink out of compat.c
Ian Lynagh <igloo@earth.li>**20050730131205] 
[Remove is_symlink
Ian Lynagh <igloo@earth.li>**20050730122255] 
[Move mkstemp to Compat.hs
Ian Lynagh <igloo@earth.li>**20050730020918] 
[Remove unused function
Ian Lynagh <igloo@earth.li>**20050730010118] 
[Start Compat.hs, and move stdout_is_a_pipe from compat.c
Ian Lynagh <igloo@earth.li>**20050730004829] 
[fix for bug Ian found in apply.
David Roundy <droundy@abridgegame.org>**20050811162558
 This is the bug manifested in the cabal repository.
] 
[fix compilation errors with ghc-6.2.2 on win32
Peter Strand <peter@zarquon.se>**20050809192759] 
[Retain both Git's author and committer.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20050810000820] 
[Move slurping into syncPristine.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20050809232101
 Avoids creating a useless pristine tree when there is none.  Thanks to
 Ian for pointing this out.
] 
[Split --relink into --relink and --relink-pristine.
Juliusz Chroboczek <jch@pps.jussieu.fr>**20050809230951
 Relinking the pristine tree breaks handling of timestamps, which causes
 Darcs to compare file contents.  It should not be used unless you know
 what you are doing.
] 
[make repair work on partial repositories.
David Roundy <droundy@abridgegame.org>**20050805113001] 
[Cleanup --verbose handling in repair command
Matt Lavin <matt.lavin@gmail.com>**20050805020630] 
[clean up Printer.wrap_text.
David Roundy <droundy@abridgegame.org>**20050808114844] 
[add several changelog entries.
David Roundy <droundy@abridgegame.org>**20050808114800] 
[improve EOD message a tad.
David Roundy <droundy@abridgegame.org>**20050807112644
 This change also introduces a "wrapped_text" function in Printer, so we
 won't have to worry so often about manually wrapping lines.
] 
[changed ***DARCS*** to ***END OF DESCRIPTION***
Jason Dagit <dagit@codersbase.com>**20050729032543] 
[remove unused opts argument from apply_patches and apply_patches_with_feedback
Matt Lavin <matt.lavin@gmail.com>**20050807031038] 
[Use apply_patch_with_feedback from check and repair commands
Matt Lavin <matt.lavin@gmail.com>**20050805020830] 
[add code to read patch bundles with added CRs.
David Roundy <droundy@abridgegame.org>**20050806222631
 I think this'll address bug #291.
] 
[accept command-line flags in any order.
David Roundy <droundy@abridgegame.org>**20050806211828
 In particular, we no longer require that --flags precede filename and
 repository arguments.
] 
[show patch numbers instead of dots on get
Matt Lavin <matt.lavin@gmail.com>**20050804013649] 
[add obliterate command as alias for unpull.
David Roundy <droundy@abridgegame.org>**20050804104929] 
[Do not ask confirmation for revert -a
jani@iv.ro**20050627124011
 Giving -a as a parameter means the user expects all changes to be reverted.
 Just like for unrevert and record go ahead with it do not ask for confirmation.
] 
[clarify help text for 'd' in SelectPatches.
David Roundy <droundy@abridgegame.org>**20050806231117] 
[Add --with-static-libs configure flag for linking static versions of libraries.
v.haisman@sh.cvut.cz**20050729015539] 
[add changelog entry for bug #477.
David Roundy <droundy@abridgegame.org>**20050806212148] 
[changelog entry for bug #189.
David Roundy <droundy@abridgegame.org>**20050731132624] 
[add description of how to add changelog entries to ChangeLog.README.
David Roundy <droundy@abridgegame.org>**20050806225901] 
[Explain the missing ChangeLog
Mark Stosberg <mark@summersault.com>**20050526135421
 
 It should be easy for casual users and contributors to view and update the
 ChangeLog.
 
 Providing a README file in the place where people are most likely to look
 provides a very useful clue.
 
 However, it's still not clear to me exactly how the system works, so I have
 left a stub to complete that documentation.
 
     Mark
 
] 
[fix obsolete error explanation in get_extra bug.
David Roundy <droundy@abridgegame.org>**20050804130610] 
[simplify fix for bug 463; reuse /// from FilePathUtils
Matt Lavin <matt.lavin@gmail.com>**20050804021130] 
[Make curl exit with error on failed downloads
peter@zarquon.se**20050802192833] 
[Bump up AC_PREREQ version to 2.59.
v.haisman@sh.cvut.cz**20050801173925] 
[fix for bug 463 (with new test)
Matt Lavin <matt.lavin@gmail.com>**20050802002116] 
[bump version number, since I just made a release.
David Roundy <droundy@abridgegame.org>**20050731190756] 
[Use simpler curl_version() function to get version string.
Kannan Goundan <kannan@cakoose.com>**20050322221027] 
[fix documentation on --reorder-patches.
David Roundy <droundy@abridgegame.org>**20050731185406] 
[add changelog entry for bug #224.
David Roundy <droundy@abridgegame.org>**20050731133942] 
[fix bug when editing long comment leaves empty file.
David Roundy <droundy@abridgegame.org>**20050731133612] 
[TAG 1.0.4pre2
David Roundy <droundy@abridgegame.org>**20050731121029] 
Patch bundle hash:
e13247ba4351c980572e1eecce545772ba7708bd



_______________________________________________
darcs-devel mailing list
darcs-devel@darcs.net
http://www.abridgegame.org/cgi-bin/mailman/listinfo/darcs-devel

.

[prev in list] [next in list] [prev in thread] [next in thread] 

Configure | About | News | Add a list | Sponsored by KoreLogic